moderated, File::Copy giving "Bad File Descriptor" from sysread

1. File::Copy giving "Bad File Descriptor" from sysread

I'm modifying a CMS modperl app (WebGUI) and am getting "Bad File
Descriptor" from a call to "copy" from the File::Copy module.

My setup- perl v5.8.2, OpenBSD OpenBSD 3.5, Apache/1.3.29 with
mod_perl/1.27, mysql 4.0.18

The problem seems to be with copying ANY file from within the app- but
if I run "perl -Mfile::Copy -de 1" I can copy the same files using
"copy" just fine.

To debug, I created a simple small text file:
echo foo > /tmp/a
chmod a+r /tmp/a

And to be sure I knew which part of File::Copy failed, I edited
/usr/libdata/perl5/File/Copy.pm:
       defined($r = sysread($from_h, $buf, $size))
            or goto fail_inner0;
...
 fail_inner0:
print "Cannot sysread<br>\n";
 fail_inner:
...

Then I added the following to my WebGUI subroutine-
copy('/tmp/a','/tmp/b') or print "Cannot copy a to b: $! <br>\n";

which prints:
Cannot sysread
Cannot copy a to b: Bad file descriptor 

It does create an empty "/tmp/b"- it can open /tmp/a for reading
without error, set it to binmode without error, can open /tmp/b for
writing without error, but then the sysread fails!

Replacing "copy('/tmp/a/','/tmp/b')" with
"system('cp','/tmp/a/','/tmp/b')" works... but it's not as portable,
and this is going to be a public patch.

and as a sanity check:
perl -MFile::Copy -e "copy ('/tmp/a','/tmp/b') or die 'Cannot copy a
to b: ',\$! "
cat /tmp/b

that prints "foo"- so the copy works "simply" but fails inside the
modperl app.

Any answers? Even help on debugging this further? I'm stuck.

Thanks
-y

2. syswrite "Bad file descriptor" after successfully writing to that file handle - Perl

3. readline: bad file descriptor

Hello,

I'm trying to subclass IO::File to die() whenever an operation fails:

# Overload IO::File to die on errors
package IO::File::Fatal;
use strict;
use warnings;
use Carp;
use IO::File;
use base 'IO::File';
sub print { shift()->SUPER::print(@_) or croak $!; }
sub printf { shift()->SUPER::printf(@_) or croak $!; }
sub close { shift()->SUPER::close(@_) or croak $!; }
sub open { shift()->SUPER::open(@_) or croak $!; }
sub read { defined shift()->SUPER::read(@_) or croak $!; }
sub write { defined shift()->SUPER::write(@_) or croak $!; }
sub getline {
    my $this = shift;
    my $ret = readline($this);
    print $ret; # debugging...
    croak $! if $!;
    return $ret;
}

However, the getline function behaves strangely: $! is always set to
"Bad file descriptor" after the invocation, but $ret contains the next
line in the file, so the function actually succeeded.

Can somebody explain this behaviour? What's the proper way of doing
what I want to do? (I know about Fatal, but it doesn't work for
getline, print and printf).

Thanks,

   --Nikolaus

-- 
In Linux werden mehr Sicherheitslcken gefunden.
In Windows sind mehr Sicherheitslcken drin.
                                    -- Lutz Donnerhacke

4. System call returning Bad file Descriptor - Perl

5. why "Bad file descriptor at line 94 "

Hi all,

Can someone give me a hand understanding why I am getting this error.

This script telnets into a telnet server (cisco) then telnets into other
cisco router to grab there configs. I get these errors when trying to
connect to certain routers (5, 11,12,13,14). If I look in my dump logs I see
that the device didn't echo anything back. I have play with some control and
break commnads wich help but doesn't fix all of them. I have a feeling it
has something to so with the filehandle or buffer but not sure.

Either case can anyone tell me why I am getting Bad file descriptor at line
94 ??     I have the line marked ****

This is my first perl script so please don't laugh ;-(


This is ussing active state on an XP machine.
This is perl, v5.6.1 built for MSWin32-x86-multi-thread
(with 1 registered patch, see perl -V for more detail)

thanks for any help

#!/perl/bin/



# Uses Net::Telnet::Cisco module

# Uses Net::Telnet module

# Uses Time-local module



## **My $vars

$host = "10.4.1.10";

$TFTPSERVER  = "10.4.1.238";

$username = "user";

$password = "pass";

$enpassword = "pass";

$filename = "dump.txt";

$file = "input.txt";

$errorlogfilelast = "c:/perl/bin/myerrorloglast.txt";

$errorlogfileall = "c:/perl/bin/myerrorlogall.txt";

$count = 1;

$termconfg = "term1-confg";

$secs = 25;                                          # Timeout when sending
commnads If its a slow router with a big config this could take time

$match = "Term1";

$port = 2005;

$line = $port - 2000;

$error = 0;

$totalerrors = 0;

$RYT = 10;

$Xsec = 2;                                           # Pause before sending
command to router 2 seconds is to slow

$mycommand = "show run";

$maxportrange = 2015;   # put things you don't whant affected at the end





# system("cls");

$thetime = localtime();

print "\nStarting program at $thetime\n";









use Net::Telnet::Cisco;

            $session = Net::Telnet::Cisco->new(

                                                            Host => $host,

                                        Dump_Log =>
"c:/perl/bin/".$filename,

                                        Input_log => "c:/perl/bin/".$file,

                                                            Timeout =>
$secs);



# Conect to Term server



            $session->login(Name => $username,

                  Password => $password);

            print "\nLoged into Term router as username: $username\n";



            $session->enable($enpassword);

            #print "Enable mode on Term\n";

            print "Clearing line: ";

                        while ($count < 17)      {          # Clear all TTY
and 4 vty

                                    $session->cmd("clear line $count\n");

                                    print "$count ";

                                    $count = $count + 1;

                        }

                        print "\nFinished disconecting all lines\n";



$session->close;

################################################



while ($port <= $maxportrange) {



            print
"\n\nooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
oooo \n\n";

            # $file = "input.txt" + '$line';

            print "\nOutput filesname is router$line.txt,  Time is
$thetime\n";



            use Net::Telnet::Cisco;

                        $session = Net::Telnet::Cisco->new(

                                                            Host => $host,

                                                            Port => $port,

                                        Dump_Log =>
"c:/perl/bin/routerdump".$line.".txt",

                                        Input_log =>
"c:/perl/bin/router".$line.".txt",

                                                            Timeout =>
$secs,

                                                            Errmode => sub {


#print "\n\n!!Bad command ? ". "port: $port!!!!! $! \n";


$error = $error + 1; #  1 means error has occurred.

                                                                        warn
$!; # option are die return and warn   ***THIS IS LINE 94 *************

                                                                        }

                                                                        );



            #WAIT FOR A FEW SECONDS

        $wait = time() + $Xsec;

            print "\nGetting ready to log into Line:$line, Port:$port - ";

                        while (time () < $wait) {

                        }



                                    $session->cmd("!\n");  #these lines are
out of desperation tryint to figure out why this works sometimes

                                    $session->cmd("!\n"); # some routers
respond some don't code and versions are amess but seem unrelated

                                    $session->cmd("!\n");

                                    $session->cmd("!\n");

                                    $session->send_wakeup( 'connect' ); #
fixes line 5 11 12

                                    $session->send_wakeup( 'connect' ); #
fixes line 5 11 12

                                    $session->send_wakeup( 'connect' ); #
fixes line 5 11 12

                                    $session->send_wakeup( 'connect' ); #
fixes line 5 11 12

                                    $session->cmd("!\n");

                                    $session->ios_break;

                                    $session->cmd("!\n");

                                    $session->send_wakeup( 'connect' ); #
fixes line 5 11 12

                                    $session->cmd("!\n");

                                    $session->cmd("!\n");

                                    $session->cmd('terminal length 0');





            $session->cmd('terminal length 0');   # default is 24

            if ($error < 1){

                        #Conect to LineX

#                                  $session->cmd("disable\n");

                                    $session->login(Name => $username,

                                  Password => $password);

                                    $session->enable($enpassword);

                                    print "Loged into LINE:$line  \n";

                                    print "Getting ver from device attached
to line : $line - ";

                                    $session->cmd($mycommand);

                                    print "Done with Line:$line\n";

                                    $session->cmd('terminal length 24');   #
default is 24

                                    $port = $port +1;

                                    $line = $line +1;

                                    } else {

                                                print "E";

                                                $session->close;

                                                $totalerrors = $totalerrors
+ 1;

                                                if ($totalerrors > 4 )
{


open(MYERRORLOGOUTLAST, ">>$errorlogfilelast");


print MYERRORLOGOUTLAST "Connection failed for ". "port: $port   at Time =
$thetime\n";


close(MYERRORLOGOUTLAST);


$error = 0; # reset error level to none


print "failed and increaseing port count";


$port = $port +1;


$line = $line +1;

                                                                            
                    } else {

                                                                            
                                }

                                                }







$session->close;

}

print
"\n\nooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo\n
\n";

#############################################################





print "\n Exiting the program on $thetime \n";

print "\nThe proagram finished with $totalerrors errors.\n";

if ($totalerrors > 0) {

                                    open(MYERRORLOGINLAST,
"$errorlogfilelast");

                                    @myerrorlogstufflast =
<MYERRORLOGINLAST>;

                                    print "The following files have errors
in them\n";

                                    print @myerrorlogstufflast;

                                    } else {

                                                open(MYERRORLOGOUTLAST,
">$errorlogfilelast");

                                                print MYERRORLOGOUTLAST "No
errors occurred on $thetime\n";



                                                open(MYERRORLOGOUTALL,
">>$errorlogfileall");

                                                print MYERRORLOGOUTALL "No
errors occurred on $thetime\n";

                                                close(MYERRORLOGOUTLAST);

                                                close(MYERRORLOGOUTALL);

                                                }

6. why "bad file descriptor"?

7. IPC::Open2 - Bad File Descriptor

8. Bad file descriptor - Perl