This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
64b21fe751c8659529e2082c6f55b73764662fd3
[perl5.git] / lib / Net / FTP.pm
1 ;# Net::FTP.pm
2 ;#
3 ;# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
4 ;# reserved. This program is free software; you can redistribute it and/or
5 ;# modify it under the same terms as Perl itself.
6
7 ;#Notes
8 ;# should I have a dataconn::close sub which calls response ??
9 ;# FTP should hold state reguarding cmds sent
10 ;# A::read needs some more thought
11 ;# A::write What is previous pkt ended in \r or not ??
12 ;# need to do some heavy tidy-ing up !!!!
13 ;# need some documentation
14
15 package Net::FTP;
16
17 =head1 NAME
18
19 Net::FTP - FTP Client class
20
21 =head1 SYNOPSIS
22
23  require Net::FTP;
24
25  $ftp = Net::FTP->new("some.host.name");
26  $ftp->login("anonymous","me@here.there");
27  $ftp->cwd("/pub");
28  $ftp->get("that.file");
29  $ftp->quit;
30
31 =head1 DESCRIPTION
32
33 C<Net::FTP> is a class implementing a simple FTP client in Perl as described
34 in RFC959
35
36 =head2 TO BE CONTINUED ...
37
38 =cut
39
40 require 5.001;
41 use Socket 1.3;
42 use Carp;
43 use Net::Socket;
44
45 @ISA = qw(Net::Socket);
46
47 $VERSION = sprintf("%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/);
48 sub Version { $VERSION }
49
50 use strict;
51
52 =head1 METHODS
53
54 All methods return 0 or undef upon failure
55
56 =head2 * new($host [, option => value [,...]] )
57
58 Constructor for the FTP client. It will create the connection to the
59 remote host. Possible options are:
60
61  Port    => port to use for FTP connection
62  Timeout => set timeout value (defaults to 120)
63  Debug   => debug level
64
65 =cut
66
67 sub FTP_READY    { 0 } # Ready 
68 sub FTP_RESPONSE { 1 } # Waiting for a response
69 sub FTP_XFER     { 2 } # Doing data xfer
70
71 sub new {
72  my $pkg  = shift;
73  my $host = shift;
74  my %arg  = @_; 
75  my $me = bless Net::Socket->new(Peer   => $host, 
76                                 Service => 'ftp', 
77                                 Port    => $arg{Port} || 'ftp'
78                                 ), $pkg;
79
80  ${*$me} = "";                                  # partial response text
81  @{*$me} = ();                                  # Last response text
82
83  %{*$me} = (%{*$me},                            # Copy current values
84             Code    => 0,                       # Last response code
85             Type    => 'A',                     # Ascii/Binary/etc mode
86             Timeout => $arg{Timeout} || 120,    # Timeout value
87             Debug   => $arg{Debug}   || 0,      # Output debug information
88             FtpHost => $host,                   # Remote hostname
89             State   => FTP_RESPONSE,            # Current state
90
91             ##############################################################
92             # Other elements used during the lifetime of the object are
93             #
94             # LISTEN  Listen socket
95             # DATA    Data socket
96            );
97
98  $me->autoflush(1);
99
100  $me->debug($arg{Debug})
101    if(exists $arg{Debug});
102
103  unless(2 == $me->response())
104   {
105    $me->close();
106    undef $me;
107   }
108
109  $me;
110 }
111
112 ##
113 ## User interface methods
114 ##
115
116 =head2 * debug( $value )
117
118 Set the level of debug information for this object. If no argument is given
119 then the current state is returned. Otherwise the state is changed to 
120 C<$value>and the previous state returned.
121
122 =cut
123
124 sub debug {
125  my $me = shift;
126  my $debug = ${*$me}{Debug};
127  
128  if(@_)
129   {
130    ${*$me}{Debug} = 0 + shift;
131
132    printf STDERR "\n$me VERSION %s\n", $Net::FTP::VERSION
133      if(${*$me}{Debug});
134   }
135
136  $debug;
137 }
138
139 =head2 quit
140
141 Send the QUIT command to the remote FTP server and close the socket connection.
142
143 =cut
144
145 sub quit {
146  my $me = shift;
147
148  return undef
149         unless $me->QUIT;
150
151  close($me);
152
153  return 1;
154 }
155
156 =head2 ascii/ebcdic/binary/byte
157
158 Put the remote FTP server ant the FTP package into the given mode
159 of data transfer.
160
161 =cut
162
163 sub ascii  { shift->type('A',@_); }
164 sub ebcdic { shift->type('E',@_); }
165 sub binary { shift->type('I',@_); }
166 sub byte   { shift->type('L',@_); }
167
168 # Allow the user to send a command directly, BE CAREFUL !!
169
170 sub quot  { 
171  my $me = shift;
172  my $cmd = shift;
173
174  $me->send_cmd( uc $cmd, @_);
175
176  $me->response();
177 }
178
179 =head2 login([$login [, $password [, $account]]])
180
181 Log into the remote FTP server with the given login information. If
182 no arguments are given then the users $HOME/.netrc file is searched
183 for the remote server's hostname. If no information is found then
184 a login of I<anonymous> is used. If no password is given and the login
185 is anonymous then the users Email address will be used for a password
186
187 =cut
188
189 sub login {
190  my $me = shift;
191  my $user = shift;
192  my $pass = shift if(defined $user);
193  my $acct = shift if(defined $pass);
194  my $ok;
195
196  unless(defined $user)
197   {
198    require Net::Netrc;
199    my $rc = Net::Netrc->lookup(${*$me}{FtpHost});
200
201    ($user,$pass,$acct) = $rc->lpa()
202         if $rc;
203   }
204
205  $user = "anonymous"
206         unless defined $user;
207
208  $pass = "-" . (getpwuid($>))[0] . "@" 
209         if !defined $pass && $user eq "anonymous";
210
211  $ok = $me->USER($user);
212
213  $ok = $me->PASS($pass)
214         if $ok == 3;
215
216  $ok = $me->ACCT($acct || "")
217         if $ok == 3;
218
219  $ok == 2;
220 }
221
222 =head2 authorise($auth, $resp)
223
224 This is a protocol used by some firewall ftp proxies. It is used
225 to authorise the user to send data out.
226
227 =cut
228
229 sub authorise {
230  my($me,$auth,$resp) = @_;
231  my $ok;
232
233  carp "Net::FTP::authorise <auth> <resp>\n"
234         unless defined $auth && defined $resp;
235
236  $ok = $me->AUTH($auth);
237
238  $ok = $me->RESP($resp)
239         if $ok == 3;
240
241  $ok == 2;
242 }
243
244 =head2 rename( $oldname, $newname)
245
246 Rename a file on the remote FTP server from C<$oldname> to C<$newname>
247
248 =cut
249
250 sub rename {
251  my($me,$from,$to) = @_;
252
253  croak "Net::FTP:rename <from> <to>\n"
254         unless defined $from && defined $to;
255
256  $me->RNFR($from) and $me->RNTO($to);
257 }
258
259 sub type {
260  my $me   = shift;
261  my $type = shift;
262  my $ok   = 0;
263
264  return ${*$me}{Type}
265         unless defined $type;
266
267  return undef
268         unless($me->TYPE($type,@_));
269
270  ${*$me}{Type} = join(" ",$type,@_);
271 }
272
273 sub abort {
274  my $me = shift;
275
276  ${*$me}{DATA}->abort()
277         if defined ${*$me}{DATA};
278 }
279
280 sub get {
281  my $me = shift;
282  my $remote = shift;
283  my $local  = shift;
284  my $where  = shift || 0;
285  my($loc,$len,$buf,$resp,$localfd,$data);
286  local *FD;
287
288  $localfd = ref($local) ? fileno($local)
289                         : 0;
290
291  ($local = $remote) =~ s#^.*/## unless(defined $local);
292
293  if($localfd)
294   {
295    $loc = $local;
296   }
297  else
298   {
299    $loc = \*FD;
300
301    unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
302     {
303      carp "Cannot open Local file $local: $!\n";
304      return undef;
305     }
306   }
307
308  if ($where) {   
309    $data = $me->rest_cmd($where,$remote) or
310         return undef; 
311  }
312  else {
313    $data = $me->retr($remote) or
314      return undef;
315  }
316
317  $buf = '';
318
319  do
320   {
321    $len = $data->read($buf,1024);
322   }
323  while($len > 0 && syswrite($loc,$buf,$len) == $len);
324
325  close($loc)
326         unless $localfd;
327  
328  $data->close() == 2; # implied $me->response
329 }
330
331 sub cwd {
332  my $me = shift;
333  my $dir = shift || "/";
334
335  return $dir eq ".." ? $me->CDUP()
336                      : $me->CWD($dir);
337 }
338
339 sub pwd {
340  my $me = shift;
341
342  $me->PWD() ? ($me->message =~ /\"([^\"]+)/)[0]
343             : undef;
344 }
345
346 sub put        { shift->send("stor",@_) }
347 sub put_unique { shift->send("stou",@_) }
348 sub append     { shift->send("appe",@_) }
349
350 sub nlst { shift->data_cmd("NLST",@_) }
351 sub list { shift->data_cmd("LIST",@_) }
352 sub retr { shift->data_cmd("RETR",@_) }
353 sub stor { shift->data_cmd("STOR",@_) }
354 sub stou { shift->data_cmd("STOU",@_) }
355 sub appe { shift->data_cmd("APPE",@_) }
356
357 sub send {
358  my $me     = shift;
359  my $cmd    = shift;
360  my $local  = shift;
361  my $remote = shift;
362  my($loc,$sock,$len,$buf,$localfd);
363  local *FD;
364
365  $localfd = ref($local) ? fileno($local)
366                         : 0;
367
368  unless(defined $remote)
369   {
370    croak "Must specify remote filename with stream input\n"
371         if $localfd;
372
373    ($remote = $local) =~ s%.*/%%;
374   }
375
376  if($localfd)
377   {
378    $loc = $local;
379   }
380  else
381   {
382    $loc = \*FD;
383
384    unless(open($loc,"<$local"))
385     {
386      carp "Cannot open Local file $local: $!\n";
387      return undef;
388     }
389   }
390
391  $cmd = lc $cmd;
392
393  $sock = $me->$cmd($remote) or
394         return undef;
395
396  do
397   {
398    $len = sysread($loc,$buf,1024);
399   }
400  while($len && $sock->write($buf,$len) == $len);
401
402  close($loc)
403         unless $localfd;
404
405  $sock->close();
406
407  ($remote) = $me->message =~ /unique file name:\s*(\S*)\s*\)/
408         if $cmd eq 'stou' ;
409
410  return $remote;
411 }
412
413 sub port {
414  my $me = shift;
415  my $port = shift;
416  my $ok;
417
418  unless(defined $port)
419   {
420    my $listen;
421
422    if(defined ${*$me}{LISTEN})
423     {
424      ${*$me}{LISTEN}->close();
425      delete ${*$me}{LISTEN};
426     }
427
428    # create a Listen socket at same address as the command socket
429
430    $listen = Net::Socket->new(Listen  => 5,
431                              Service => 'ftp',
432                              Addr    => $me->sockhost, 
433                             );
434   
435    ${*$me}{LISTEN} = $listen;
436
437    my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
438
439    $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
440   }
441
442  $ok = $me->PORT($port);
443
444  ${*$me}{Port} = $port;
445
446  $ok;
447 }
448
449 sub ls  { shift->list_cmd("NLST",@_); }
450 sub lsl { shift->list_cmd("LIST",@_); }
451
452 sub pasv {
453  my $me = shift;
454  my $hostport;
455
456  return undef
457         unless $me->PASV();
458
459  ($hostport) = $me->message =~ /(\d+(,\d+)+)/;
460
461  ${*$me}{Pasv} = $hostport;
462 }
463
464 ##
465 ## Communication methods
466 ##
467
468 sub timeout {
469  my $me = shift;
470  my $timeout = ${*$me}{Timeout};
471
472  ${*$me}{Timeout} = 0 + shift if(@_);
473
474  $timeout;
475 }
476
477 sub accept {
478  my $me = shift;
479
480  return undef unless defined ${*$me}{LISTEN};
481
482  my $data = ${*$me}{LISTEN}->accept;
483
484  ${*$me}{LISTEN}->close();
485  delete ${*$me}{LISTEN};
486
487  ${*$data}{Timeout} = ${*$me}{Timeout};
488  ${*$data}{Cmd} = $me;
489  ${*$data} = "";
490
491  ${*$me}{State} = FTP_XFER;
492  ${*$me}{DATA}  = bless $data, "Net::FTP::" . ${*$me}{Type};
493 }
494
495 sub message {
496  my $me = shift;
497  join("\n", @{*$me});
498 }
499
500 sub ok {
501  my $me = shift;
502  my $code = ${*$me}{Code} || 0;
503
504  0 < $code && $code < 400;
505 }
506
507 sub code {
508  my $me = shift;
509
510  ${*$me}{Code};
511 }
512
513 sub list_cmd {
514  my $me = shift;
515  my $cmd = lc shift;
516  my $data = $me->$cmd(@_);
517
518  return undef
519         unless(defined $data);
520
521  bless $data, "Net::FTP::A"; # Force ASCII mode
522
523  my $databuf = '';
524  my $buf = '';
525
526  while($data->read($databuf,1024)) {
527    $buf .= $databuf;
528  }
529
530  my $list = [ split(/\n/,$buf) ];
531
532  $data->close();
533
534  wantarray ? @{$list} : $list;
535 }
536
537 sub data_cmd {
538  my $me = shift;
539  my $cmd = uc shift;
540  my $ok = 1;
541  my $pasv = defined ${*$me}{Pasv} ? 1 : 0;
542
543  $ok = $me->port
544         unless $pasv || defined ${*$me}{Port};
545
546  $ok = $me->$cmd(@_)
547         if $ok;
548
549  return $pasv ? $ok
550               : $ok ? $me->accept()
551                     : undef;
552 }
553
554 sub rest_cmd {
555  my $me = shift;
556  my $ok = 1;
557  my $pasv = defined ${*$me}{Pasv} ? 1 : 0;
558  my $where = shift;
559  my $file = shift;
560
561  $ok = $me->port
562         unless $pasv || defined ${*$me}{Port};
563
564  $ok = $me->REST($where)
565         if $ok;
566
567  $ok = $me->RETR($file)
568         if $ok;
569
570  return $pasv ? $ok
571               : $ok ? $me->accept()
572                     : undef;
573 }
574
575 sub cmd {
576  my $me = shift;
577
578  $me->send_cmd(@_);
579  $me->response();
580 }
581
582 sub send_cmd {
583  my $me = shift;
584
585  if(scalar(@_)) {     
586   my $cmd = join(" ", @_) . "\r\n";
587
588   delete ${*$me}{Pasv};
589   delete ${*$me}{Port};
590
591   syswrite($me,$cmd,length $cmd);
592
593   ${*$me}{State} = FTP_RESPONSE;
594
595   printf STDERR "\n$me>> %s", $cmd=~/^(pass|resp)/i ? "$1 ....\n" : $cmd
596         if $me->debug;
597  }
598
599  $me;
600 }
601
602 sub pasv_wait {
603  my $me = shift;
604  my $non_pasv = shift;
605  my $file;
606
607  my($rin,$rout);
608  vec($rin,fileno($me),1) = 1;
609  select($rout=$rin, undef, undef, undef);
610
611  $me->response();
612  $non_pasv->response();
613
614  return undef
615         unless $me->ok() && $non_pasv->ok();
616
617  return $1
618         if $me->message =~ /unique file name:\s*(\S*)\s*\)/;
619
620  return $1
621         if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
622
623  return 1;
624 }
625
626 sub response {
627  my $me = shift;
628  my $timeout = ${*$me}{Timeout};
629  my($code,$more,$rin,$rout,$partial,$buf) = (undef,0,'','','','');
630
631  @{*$me} = (); # the responce
632  $buf = ${*$me};
633  my @buf = ();
634
635  vec($rin,fileno($me),1) = 1;
636
637  do
638   {
639    if(length($buf) || ($timeout==0) || select($rout=$rin, undef, undef, $timeout))
640     {
641      unless(length($buf) || sysread($me, $buf, 1024))
642       {
643        carp "Unexpected EOF on command channel";
644        return undef;
645       } 
646
647      substr($buf,0,0) = $partial;    ## prepend from last sysread
648
649      @buf = split(/\r?\n/, $buf);  ## break into lines
650
651      $partial = (substr($buf, -1, 1) eq "\n") ? ''
652                                               : pop(@buf); 
653
654      $buf = "";
655
656      while (@buf)
657       {
658        my $cmd = shift @buf;
659        print STDERR "$me<< $cmd\n"
660          if $me->debug;
661  
662        ($code,$more) = ($1,$2)
663         if $cmd =~ /^(\d\d\d)(.)/;
664
665        push(@{*$me},$');
666
667        last unless(defined $more && $more eq "-");
668       } 
669     }
670    else
671     {
672      carp "$me: Timeout" if($me->debug);
673      return undef;
674     }
675   }
676  while((scalar(@{*$me}) == 0) || (defined $more && $more eq "-"));
677
678  ${*$me} = @buf ? join("\n",@buf,"") : "";
679  ${*$me} .= $partial;
680
681  ${*$me}{Code} = $code;
682  ${*$me}{State} = FTP_READY;
683
684  substr($code,0,1);
685 }
686
687 ;########################################
688 ;#
689 ;# RFC959 commands
690 ;#
691
692 sub no_imp { croak "Not implemented\n"; }
693
694 sub ABOR { shift->send_cmd("ABOR")->response()  == 2}
695 sub CDUP { shift->send_cmd("CDUP")->response()  == 2}
696 sub NOOP { shift->send_cmd("NOOP")->response()  == 2}
697 sub PASV { shift->send_cmd("PASV")->response()  == 2}
698 sub QUIT { shift->send_cmd("QUIT")->response()  == 2}
699 sub DELE { shift->send_cmd("DELE",@_)->response() == 2}
700 sub CWD  { shift->send_cmd("CWD", @_)->response() == 2}
701 sub PORT { shift->send_cmd("PORT",@_)->response() == 2}
702 sub RMD  { shift->send_cmd("RMD", @_)->response() == 2}
703 sub MKD  { shift->send_cmd("MKD", @_)->response() == 2}
704 sub PWD  { shift->send_cmd("PWD", @_)->response() == 2}
705 sub TYPE { shift->send_cmd("TYPE",@_)->response() == 2}
706 sub APPE { shift->send_cmd("APPE",@_)->response() == 1}
707 sub LIST { shift->send_cmd("LIST",@_)->response() == 1}
708 sub NLST { shift->send_cmd("NLST",@_)->response() == 1}
709 sub RETR { shift->send_cmd("RETR",@_)->response() == 1}
710 sub STOR { shift->send_cmd("STOR",@_)->response() == 1}
711 sub STOU { shift->send_cmd("STOU",@_)->response() == 1}
712 sub RNFR { shift->send_cmd("RNFR",@_)->response() == 3}
713 sub RNTO { shift->send_cmd("RNTO",@_)->response() == 2}
714 sub ACCT { shift->send_cmd("ACCT",@_)->response() == 2}
715 sub RESP { shift->send_cmd("RESP",@_)->response() == 2}
716 sub REST { shift->send_cmd("REST",@_)->response() == 3}
717 sub USER { my $ok = shift->send_cmd("USER",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;}
718 sub PASS { my $ok = shift->send_cmd("PASS",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;}
719 sub AUTH { my $ok = shift->send_cmd("AUTH",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;}
720
721 sub ALLO { no_imp; }
722 sub SMNT { no_imp; }
723 sub HELP { no_imp; }
724 sub MODE { no_imp; }
725 sub SITE { no_imp; }
726 sub SYST { no_imp; }
727 sub STAT { no_imp; }
728 sub STRU { no_imp; }
729 sub REIN { no_imp; }
730
731 package Net::FTP::dataconn;
732 use Carp;
733 no strict 'vars';
734
735 sub abort {
736  my $fd = shift;
737  my $ftp = ${*$fd}{Cmd};
738
739  $ftp->send_cmd("ABOR");
740  $fd->close();
741 }
742
743 sub close {
744  my $fd = shift;
745  my $ftp = ${*$fd}{Cmd};
746
747  $fd->Net::Socket::close();
748  delete ${*$ftp}{DATA};
749
750  $ftp->response();
751 }
752
753 sub timeout {
754  my $me = shift;
755  my $timeout = ${*$me}{Timeout};
756
757  ${*$me}{Timeout} = 0 + shift if(@_);
758
759  $timeout;
760 }
761
762 sub _select {
763  my $fd = shift;
764  local *timeout = \$_[0]; shift;
765  my $rw = shift;
766  my($rin,$win);
767
768  return 1 unless $timeout;
769
770  $rin = '';
771  vec($rin,fileno($fd),1) = 1;
772
773  $win = $rw ? undef : $rin;
774  $rin = undef unless $rw;
775
776  my $nfound = select($rin, $win, undef, $timeout);
777
778  croak "select: $!"
779         if $nfound < 0;
780
781  return $nfound;
782 }
783
784 sub can_read {
785  my $fd = shift;
786  local *timeout = \$_[0];
787
788  $fd->_select($timeout,1);
789 }
790
791 sub can_write {
792  my $fd = shift;
793  local *timeout = \$_[0];
794
795  $fd->_select($timeout,0);
796 }
797
798 sub cmd {
799  my $me = shift;
800
801  ${*$me}{Cmd};
802 }
803
804
805 @Net::FTP::L::ISA = qw(Net::FTP::I);
806 @Net::FTP::E::ISA = qw(Net::FTP::I);
807
808 package Net::FTP::A;
809 @Net::FTP::A::ISA = qw(Net::FTP::dataconn);
810 use Carp;
811
812 no strict 'vars';
813
814 sub read {
815  my $fd = shift;
816  local *buf = \$_[0]; shift;
817  my $size = shift || croak 'read($buf,$size,[$offset])';
818  my $offset = shift || 0;
819  my $timeout = ${*$fd}{Timeout};
820  my $l;
821
822  croak "Bad offset"
823         if($offset < 0);
824
825  $offset = length $buf
826         if($offset > length $buf);
827
828  $l = 0;
829  READ:
830   {
831    $fd->can_read($timeout) or
832         croak "Timeout";
833
834    my $n = sysread($fd, ${*$fd}, $size, length ${*$fd});
835
836    return $n
837         unless($n >= 0);
838
839 #   my $lf = substr(${*$fd},-1,1) eq "\r" ? chop(${*$fd})
840 #                                        : "";
841
842    my $lf = (length ${*$fd} > 0 && substr(${*$fd},-1,1) eq "\r") ? chop(${*$fd})
843                      : "";
844
845    ${*$fd} =~ s/\r\n/\n/go;
846
847    substr($buf,$offset) = ${*$fd};
848
849    $l += length(${*$fd});
850    $offset += length(${*$fd});
851
852    ${*$fd} = $lf;
853    
854    redo READ
855      if($l == 0 && $n > 0);
856
857    if($n == 0 && $l == 0)
858     {
859      substr($buf,$offset) = ${*$fd};
860      ${*$fd} = "";
861     }
862   }
863
864  return $l;
865 }
866
867 sub write {
868  my $fd = shift;
869  local *buf = \$_[0]; shift;
870  my $size = shift || croak 'write($buf,$size,[$timeout])';
871  my $timeout = @_ ? shift : ${*$fd}{Timeout};
872
873  $fd->can_write($timeout) or
874         croak "Timeout";
875
876  # What is previous pkt ended in \r or not ??
877
878  my $tmp;
879  ($tmp = $buf) =~ s/(?!\r)\n/\r\n/g;
880
881  my $len = $size + length($tmp) - length($buf);
882  my $wrote = syswrite($fd, $tmp, $len);
883
884  if($wrote >= 0)
885   {
886    $wrote = $wrote == $len ? $size
887                            : $len - $wrote
888   }
889
890  return $wrote;
891 }
892
893 package Net::FTP::I;
894 @Net::FTP::I::ISA = qw(Net::FTP::dataconn);
895 use Carp;
896
897 no strict 'vars';
898
899 sub read {
900  my $fd = shift;
901  local *buf = \$_[0]; shift;
902  my $size = shift || croak 'read($buf,$size,[$timeout])';
903  my $timeout = @_ ? shift : ${*$fd}{Timeout};
904
905  $fd->can_read($timeout) or
906         croak "Timeout";
907
908  my $n = sysread($fd, $buf, $size);
909
910  $n;
911 }
912
913 sub write {
914  my $fd = shift;
915  local *buf = \$_[0]; shift;
916  my $size = shift || croak 'write($buf,$size,[$timeout])';
917  my $timeout = @_ ? shift : ${*$fd}{Timeout};
918
919  $fd->can_write($timeout) or
920         croak "Timeout";
921
922  syswrite($fd, $buf, $size);
923 }
924
925 =head2 AUTHOR
926
927 Graham Barr <Graham.Barr@tiuk.ti.com>
928
929 =head2 REVISION
930
931 $Revision: 1.17 $
932
933 =head2 COPYRIGHT
934
935 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
936 software; you can redistribute it and/or modify it under the same terms
937 as Perl itself.
938
939 =cut
940
941
942 1;
943