Net-FTP-1.08b

10 files changed, 1445 insertions, 781 deletions

diff --git a/ftp/ChangeLog b/ftp/ChangeLog
new file mode 100644
index 0000000..9f1bb51
--- /dev/null
+++ b/ftp/ChangeLog
@@ -0,0 +1,19 @@
+Mon Dec 11 1995  Graham Barr <bodg@tiuk.ti.com>
+
+        o Introduced IO::Socket which eventually will be released
+          separetely.
+        o Comands that create a data connection noe return the data
+          connection socket
+        o Data connection now blessed into a package Net::FTP::type
+          where type is the connection type (eg A for ASCII)
+
+Mon Nov 20 1995  Graham Barr <bodg@tiuk.ti.com>
+
+        o Some perl -w clean ups
+
+
+Thu Nov  9 1995  Graham Barr <bodg@tiuk.ti.com>
+
+        o Modified FTP::new() to call croak when IP address cannot be
+          determined from name given.
+
diff --git a/ftp/FTP.pm b/ftp/FTP.pm
deleted file mode 100644
index fc70cf2..0000000
--- a/ftp/FTP.pm
+++ /dev/null
@@ -1,663 +0,0 @@
-# Net::FTP.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package Net::FTP;
-
-=head1 NAME
-
-FTP - implements FTP Client
-
-=head1 SYNOPSIS
-
-use Net::FTP;
-
-$ftp = Net::FTP->new(<host>,[port]);
-
-=head1 DESCRIPTION
-
-This package provides a class object which can be used for connecting to remote
-FTP servers and transfering data.
-
-=head2 NOTE: C<This Documentation is VERY incomplete>
-
-=cut
-
-require 5.001;
-use Socket;
-use Carp;
-
-sub Version { sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/) }
-
-BEGIN {
-
- # format to pack to build argment for socket call
- $sockaddr = 'S n a4 x8';
-
- $socksym = "ftp00000";
-}
-
-##
-## Really WANT FileHandle::new to return this !!!
-##
-sub gensym {\*{"FTP::Net::" . $socksym++}}
-
-sub new {
- my $pkg  = shift;
- my $host = shift;
- my $port = shift;
- my($destaddr, $destproc, $me);
- my $sock = gensym();
-
- if($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
-  $destaddr = pack('C4', $1, $2, $3, $4);
- }
- else {
-  $destaddr = (gethostbyname($host))[4] or
-    carp "Cannot get IP address of '$host'" and return undef;
- }
-
- # get ftp port; I'll use getservbyname, but assume port 21 if it fails
- $port = (getservbyname("ftp", "tcp"))[2] || 21 unless(defined $port);
-
- $destproc = pack($sockaddr, AF_INET, $port, $destaddr);
-
- # get protocol number for tcp, assume 6 if getprotobyname fails
- my $tcp = (getprotobyname("tcp"))[2] || 6;
-
- if(socket($sock, AF_INET, SOCK_STREAM, $tcp)) {
-  if(connect($sock, $destproc)) {
-
-   my $cmdaddr = (unpack ($sockaddr, getsockname($sock)))[2];
-   my $cmdname = pack($sockaddr, AF_INET, 0, $cmdaddr);
-
-   $me = {
-          SOCK    => $sock,     # Command socket connection
-          LISTEN  => undef,     # Listen socket
-          DATA    => undef,     # Data socket
-
-          CmdAddr => $cmdaddr,  # Address of command socket
-          CmdName => $cmdname,  # name of command socket
-
-          Type    => 'A',       # Ascii/Binary/etc mode
-          Timeout => 120,       # Timeout value
-          Resp    => [],        # Last response text
-          Code    => 0,         # Last response code
-          Debug   => 0          # Output debug information
-         };
-
-   bless $me, $pkg;
-
-   select((select($sock), $| = 1)[$[]);
-
-   $me->response();
-  }
- }
-
- $me;
-}
-
-##
-## User interface methods
-##
-
-=item * debug( [1|0] )
-
-Turn the printing of debug information on/off for this object. If no
-argument is given then the current state is returned. Otherwise the
-state is changed and the previous state returned.
-
-=cut
-
-sub debug {
- my $me = shift;
- my $debug = $me->{Debug};
- 
- $me->{Debug} = 0 + shift if(@_);
-
- $debug;
-}
-
-=item * quit
-
-Send the QUIT command to the remote FTP server and close the socket connection.
-
-=cut
-
-sub quit {
- my $me = shift;
-
- return undef unless($me->QUIT);
-
- close($me->{SOCK});
- delete $me->{SOCK};
-
- return 1;
-}
-
-=item * ascii/ebcdic/binary/byte
-
-Put the remote FTP server ant the FTP package into the given mode
-of data transfer.
-
-=cut
-
-sub ascii  { shift->type('A',@_); }
-sub ebcdic { shift->type('E',@_); }
-sub binary { shift->type('I',@_); }
-sub byte   { shift->type('L',@_); }
-
-# Allow the user to send a command directly, BE CAREFUL !!
-sub quot  { shift->cmd( uc shift, @_) }
-
-=item * login([user], [password], [account])
-
-Log onto the remote FTP server with the given information or
-with the defaults 
-
-     user = anonymous
- password = your email address
-  account =
-
-Returns 0 on failure
-
-=cut
-
-sub login {
- my $me = shift;
- my $user = shift || "anonymous";
- my $pass = shift || "-" . $ENV{USER} . "@";
- my $acct = shift || "";
- my $ok;
-
- $ok = $me->USER($user)
-  and $ok == 3 and $ok = $me->PASS($pass)
-  and $ok == 3 and $ok = $me->ACCT($acct);
-
- $ok == 2;
-}
-
-sub authorise {
- my($me,$auth,$resp) = @_;
- my $ok;
-
- carp "Net::FTP::authorise <auth> <resp>\n"
-   unless(defined $auth && defined $resp);
-
- $ok = $me->AUTH($auth)
-  and $ok == 3 and $ok = $me->RESP($resp);
-
- $ok == 2;
-}
-
-=item * rename( <oldname>, <newname> )
-
-Rename a file on the remote FTP server from C<oldname> to C<newname>
-
-Returns undef on failure
-
-=cut
-
-sub rename {
- my($me,$from,$to) = @_;
-
- croak "Net::FTP:rename <from> <to>\n"
-   unless(defined $from && defined $to);
-
- $me->RNFR($from)
-  and $me->RNTO($to)
-  or return undef;
-}
-
-sub get {
- my $me = shift;
- my $remote = shift;
- my $local  = shift;
- my $timeout = $me->{Timeout};
- my($rin,$rout,$len,$but,$partial,$data,$loc);
-
- $data = $me->retr($remote);
-
- return undef unless(fileno($data));
-
- ($local = $remote) =~ s#^.*/## unless(defined $local);
-
- if(ref($local) && fileno($local)) {
-  $loc = $local;
- }
- else {
-  $loc = gensym();
-  open($loc,">$local") or 
-   carp "Cannot open Local file $local: $!\n" and
-   return undef;
- }
-
- $partial = "";
-
- vec($rin,fileno($data),1) = 1;
- while(1) {
-  if(($timeout == 0) || select($rout=$rin, undef, undef, $timeout)) {
-   last unless($len=sysread($data,$buf,1024));
-   if($me->{Type} eq 'A') { 
-    substr($buf,0,0)=$partial;      ## prepend from last sysread
-    @buf=split(/\r?(?=\n)/,$buf);   ## break into lines
-    $partial = (substr($buf, -1, 1) eq "\n") ? '' : pop(@buf);
-    print $loc @buf;
-   }
-   else {
-    last unless ( (syswrite($loc,$buf,$len)==$len) );
-   }
-  }
-  else {
-   carp "Net::FTP::get $!";
-   return undef;
-  }
- }
- print $loc $partial if(length($partial));
-
- close($loc) unless(ref($local) && fileno($local));
- close($data);
- $me->response() == 2;
-}
-
-sub cwd {
- my $me = shift;
- my $dir = shift || "/";
-
- return ($dir eq "..") ? $me->CDUP() : $me->CWD($dir);
-}
-
-sub put        { shift->send("stor",@_) }
-sub put_unique { shift->send("stou",@_) }
-sub append     { shift->send("appe",@_) }
-
-sub type {
- my $me   = shift;
- my $type = shift;
- my $ok   = 0;
-
- return $me->{Type} unless defined $type;
-
- return undef unless($me->TYPE($type,@_));
-
- $me->{Type} = join(" ",$type,@_);
-}
-
-sub nlst { shift->data_cmd("NLST",@_) }
-sub list { shift->data_cmd("LIST",@_) }
-sub retr { shift->data_cmd("RETR",@_) }
-sub stor { shift->data_cmd("STOR",@_) }
-sub stou { shift->data_cmd("STOU",@_) }
-sub appe { shift->data_cmd("APPE",@_) }
-
-sub port {
- my $me = shift;
- my $port = shift;
- my $ok;
-
- unless(defined $port) {
-  my $listen;
-
-  if(defined $me->{LISTEN}) {
-   $listen = $me->{LISTEN};
-  }
-  else {
-   $listen = gensym();
-  
-   socket($listen, AF_INET, SOCK_STREAM, PROTO_TCP)
-     and bind($listen, $me->{CmdName})
-     and listen($listen,1)
-     or return undef;
-  
-   select((select($listen), $| = 1)[0]);
-  
-   $me->{LISTEN} = $listen;
-  }
-  
-  my($fam, $myport, @myaddr) = unpack('S n C C C C x8', getsockname($listen));
-
-  $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
- }
-
- $ok = $me->PORT($port);
-
- $me->{Port} = $port;
-
- $ok;
-}
-
-sub ls  { shift->list_cmd("NLST",@_); }
-sub lsl { shift->list_cmd("LIST",@_); }
-
-sub pasv {
- my $me = shift;
- my $hostport;
-
- return undef unless $me->PASV();
-
- ($hostport) = $me->message =~ /(\d+(,\d+)+)/;
-
- $me->{Pasv} = $hostport;
- return $hostport;
-}
-
-##
-## Communication methods
-##
-
-sub cleanup {
- my $me = shift;
-
- if(defined $me->{LISTEN}) {
-  close($me->{LISTEN}) if(ref($me->{LISTEN}) && fileno($me->{LISTEN}));
-  undef $me->{LISTEN};
- }
- if(defined $me->{DATA}) {
-  close($me->{DATA}) if(ref($me->{DATA}) && fileno($me->{DATA}));
-  undef $me->{DATA};
- }
-
- return shift; # Allow caller to pass return value
-}
-
-sub timeout {
- my $me = shift;
- my $timeout = $me->{Timeout};
-
- $me->{Timeout} = 0 + shift if(@_);
-
- $timeout;
-}
-
-sub send {
- my $me     = shift;
- my $cmd    = shift;
- my $local  = shift;
- my $remote = shift;
- my $infd = 0;
- my($loc,$sock);
-
- $infd = fileno($local) if(ref($local));
-
- unless(defined $remote) {
-  croak "Must specify remote filename with stream input\n" if($infd);
-
-  ($remote = $local) =~ s%.*/%%;
- }
-
- $cmd = lc $cmd;
-
- $sock = $me->$cmd($remote);
- return $me->cleanup() unless fileno($sock);
-
- if($infd) {
-  $loc = $local;
- }
- else {
-  $loc = gensym();
-
-  open($loc,"<$local") or 
-   carp "Cannot open Local file $local: $!\n" and
-   return $me->cleanup();
- }
-
- if($me->{Type} eq 'A') { # Ascii
-  while(<$loc>) {
-   s/\n\Z/\r\n/;
-   print $sock $_;
-  }
- }
- else {
-  my($len,$buf);
-
-  do {
-   $len = sysread($loc,$buf,1024);
-  } while($len && syswrite($sock,$buf,$len) == $len);
- }
-
- close($loc) unless($infd);
-
- $me->cleanup();
- $me->response();
-
- ($remote) = $me->message =~ /unique file name:\s*(\S*)\s*\)/
-    if($cmd eq 'stou');
-
- return $remote;
-}
-
-sub accept {
- my $me = shift;
- my $data = gensym();
- 
- return undef unless defined $me->{LISTEN};
-
- unless(accept($data,$me->{LISTEN})) {
-  carp "Cannot accept data connetion: $!\n";
-  close($data);
-  return undef;
- }
-
- close($me->{LISTEN});
- delete $me->{LISTEN};
-
- $me->{DATA} = $data;
-}
-
-sub message {
- my $me = shift;
- join("\n", @{$me->{Resp}});
-}
-
-sub ok {
- my $me = shift;
- my $code = $me->{Code} || 0;
-
- 0 < $code && $code < 400;
-}
-
-sub list_cmd {
- my $me = shift;
- my $cmd = lc shift;
- my $data = $me->$cmd(@_);
- my $partial = "";
- my $timeout = $me->{Timeout} || 0;
- my($rin,$rout,$buf,$list);
-
- $list = [];
-
- vec($rin,fileno($data),1) = 1;
-
- while(1) {
-  if(($timeout == 0) || select($rout=$rin, undef, undef, $timeout)) {
-
-   last unless($len=sysread($data,$buf,1024));
-
-   substr($buf,0,0)=$partial;      ## prepend from last sysread
-
-   push(@{$list}, split(/\r?\n/,$buf));   ## break into lines
-
-   $partial = (substr($buf, -1, 1) eq "\n") ? ''
-                                            : pop(@{$list});
-  }
-  else {
-   carp "Net::FTP::list_cmd Timeout";
-   return $me->cleanup();
-  }
- }
-
- push(@{$list}, $partial) if(length($partial));
-
- $me->cleanup();
- $me->response();
-
- wantarray ? @{$list} : $list;
-}
-
-sub data_cmd {
- my $me = shift;
- my $ok = 1;
- my $pasv = defined $me->{Pasv} ? 1 : 0;
- my $cmd = uc shift;
-
- $ok = $me->port unless($pasv || defined $me->{Port});
- $ok = $me->$cmd(@_) if($ok);
-
- return $ok ? ($pasv ? 1 : $me->accept()) : undef;
-}
-
-sub cmd {
- my $me = shift;
- my $sock = $me->{SOCK};
-
-
- if(scalar(@_)) {     
-  my $cmd = join(" ", @_);
-
-  delete $me->{Pasv};
-  delete $me->{Port};
-
-  print $sock $cmd,"\r\n";
-
-  printf STDERR "$me>> %s\n", $cmd=~/^(pass|resp)/i ? "$1 ...." : $cmd
-     if($me->debug);
- }
- $me->response();                                          
-}
-
-sub pasv_wait {
- my $me = shift;
- my $non_pasv = shift;
- my $sock = $me->{SOCK};
- my($rin,$rout,$file);
-
- vec($rin,fileno($sock),1) = 1;
- while(1) {
-  last if select($rout=$rin, undef, undef, 120);
- }
-
- $me->response();
- $non_pasv->response();
-
- return undef unless($me->ok() && $non_pasv->ok());
-
- return $1 if($me->message =~ /unique file name:\s*(\S*)\s*\)/);
- return $1 if($non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/);
-
- return 1;
-}
-
-sub response {
- my $me = shift;
- my $sock = $me->{SOCK};
- my $timeout = $me->{Timeout};
- my($code,@resp,$rin,$rout,$partial,@buf,$buf);
-
- vec($rin,fileno($sock),1) = 1;
- $more = 0;
- @resp = ();
- $partial = '';
-
- do {
-  if (($timeout==0) || select($rout=$rin, undef, undef, $timeout)) {
-
-   unless(sysread($sock, $buf, 1024)) {
-    carp "Unexpected EOF on command channel";
-    return undef;
-   } 
-
-   substr($buf,0,0) = $partial;    ## prepend from last sysread
-
-   @buf = split(/\r?\n/, $buf);  ## break into lines
-
-   $partial = (substr($buf, -1, 1) eq "\n") ? ''
-                                            : pop(@buf); 
-
-   foreach $cmd (@buf) {
-    print STDERR "$me<< $cmd\n" if($me->debug);
-
-    ($code,$more) = ($1,$2) if $cmd =~ /^(\d\d\d)(.)/;
-    push(@resp,$');
-   } 
-  } 
-  else {
-   carp "$me: Timeout" if($me->debug);
-   return undef;
-  }
- } while(length($partial) || (defined $more && $more eq "-"));
-
- $me->{Code} = $code;
- $me->{Resp} = [ @resp ];
-
- substr($code,0,1);
-}
-
-
-##
-## RFC959 commands
-##
-
-sub no_imp { croak "Not implemented\n"; }
-
-sub ABOR { shift->cmd("ABOR")     == 2}
-sub ALLO { no_imp; }
-sub DELE { shift->cmd("DELE", @_) == 2}
-sub CWD  { shift->cmd("CWD",  @_) == 2}
-sub CDUP { shift->cmd("CDUP")     == 2}
-sub SMNT { no_imp; }
-sub HELP { no_imp; }
-sub MODE { no_imp; }
-sub NOOP { shift->cmd("NOOP")     == 2}
-sub PASV { shift->cmd("PASV")     == 2}
-sub QUIT { shift->cmd("QUIT")     == 2}
-sub SITE { no_imp; }
-sub PORT { shift->cmd("PORT", @_) == 2}
-sub SYST { no_imp; }
-sub STAT { no_imp; }
-sub RMD  { shift->cmd("RMD",  @_) == 2}
-sub MKD  { shift->cmd("MKD",  @_) == 2}
-sub PWD  { shift->cmd("PWD",  @_) == 2}
-sub STRU { no_imp; }
-sub TYPE { shift->cmd("TYPE", @_) == 2}
-
-sub APPE { shift->cmd("APPE", @_) == 1}
-sub LIST { shift->cmd("LIST", @_) == 1}
-sub NLST { shift->cmd("NLST", @_) == 1}
-sub REIN { no_imp; }
-sub RETR { shift->cmd("RETR", @_) == 1}
-sub STOR { shift->cmd("STOR", @_) == 1}
-sub STOU { shift->cmd("STOU", @_) == 1}
-
-sub RNFR { shift->cmd("RNFR", @_) == 3}
-sub RNTO { shift->cmd("RNTO", @_) == 2}
-sub REST { no_imp; }
-
-sub USER { my $ok = shift->cmd("USER",@_);($ok == 2 || $ok == 3) ? $ok : 0;}
-sub PASS { my $ok = shift->cmd("PASS",@_);($ok == 2 || $ok == 3) ? $ok : 0;}
-sub ACCT { shift->cmd("ACCT", @_) == 2}
-
-sub AUTH { my $ok = shift->cmd("AUTH",@_);($ok == 2 || $ok == 3) ? $ok : 0;}
-sub RESP { shift->cmd("RESP", @_) == 2}
-
-=back
-
-=head2 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head2 REVISION
-
-$Revision: 1.2 $
-
-=head2 COPYRIGHT
-
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
-
-=cut
-
-1;
-
diff --git a/ftp/History.pl b/ftp/History.pl
deleted file mode 100644
index 114ce99..0000000
--- a/ftp/History.pl
+++ /dev/null
@@ -1,10 +0,0 @@
-$Version = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
-__END__
-14-Aug-95
-        Added Net::SMTP
-
-17-Jul-95
-        Re-implemented without use of the following modules
-                 Net::Telnet
-                 IPC::Chat
-                 Hostname
diff --git a/ftp/MANIFEST b/ftp/MANIFEST
index af76ac5..9bd1df5 100644
--- a/ftp/MANIFEST
+++ b/ftp/MANIFEST
@@ -1,6 +1,7 @@
-History.pl
-MANIFEST
-Makefile.PL
-README
-FTP.pm
-tst
+ChangeLog
+MANIFEST                        This file
+Makefile.PL                        Makemaker makefile
+README                                Copyright
+lib/IO/Socket.pm                (v1.01) Generic socket package
+lib/Net/FTP.pm                        (v1.08) FTP package
+t/dummy.t
diff --git a/ftp/Makefile.PL b/ftp/Makefile.PL
index ac31b80..a399259 100644
--- a/ftp/Makefile.PL
+++ b/ftp/Makefile.PL
@@ -1,17 +1,69 @@
+# This -*- perl -*- script makes the Makefile
+# $Id: Makefile.PL,v 1.4 1995/12/11 13:16:04 gbarr Exp gbarr $
+
 use ExtUtils::MakeMaker;
+use ExtUtils::Manifest qw(maniread);
+use lib qw(./lib);
+
+sub initialize {
+ local($_);
+
+ my $manifest = maniread();
+
+ $Version = eval { require "./lib/Net/FTP.pm"; Net::FTP->Version . "b"; } || "0.00";
+
+ my %pl_files = ();
+ my @exe_files = ();
+
+ foreach (keys %$manifest) {
+  $pl_files{$_} = $1 if(/(.*)\.PL\Z/ && !/^Makefile.PL$/);
+  push(@exe_files,$_) if(m#\bbin/# && !m#demo#);
+ }
+
+ my $hash = {
+        VERSION   => $Version,
+        NAME      => 'Net::FTP',
+        SKIP      => [qw(static dynamic)],
+        PL_FILES  => \%pl_files,
+        EXE_FILES => \@exe_files,
+
+        'dist'    => {COMPRESS => 'gzip -9f',
+                      SUFFIX   => 'gz', 
+                      POSTOP   => 'mv $(DISTNAME)-$(VERSION).tar.gz ../',
+                      DIST_DEFAULT => 'all tardist',
+                      CI => 'ci -l'
+                     },
+
+        'linkext' => {LINKTYPE => '' },
+        'clean'   => {FILES => '*% *.html *.bak *.old lib/*% lib/*/*% $(EXE_FILES)'},
+ };
+
+ $hash;
+}
+
+if ($ExtUtils::MakeMaker::Version < 4.17) {
+ my $hash = initialize();
+ WriteMakefile( %$hash ) ;
+}
+else {
+ WriteMakefile( CONFIGURE => \&initialize ) ;
+}
+
+
+sub MY::test {
+    q{
+TEST_VERBOSE=0
 
-$Version = "0.00a";
+test:
+        $(FULLPERL) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' t/*.t
 
-require "./History.pl" if(-f "./History.pl");
+};
+}
 
-WriteMakefile(
-              VERSION   => $Version,
-              NAME  => 'Net::FTP',
-              SKIP      => [qw(static dynamic)],
-              'dist'    => {COMPRESS=> 'gzip -9f', SUFFIX=>'gz', 
-                             POSTOP => 'mv $(DISTNAME)-$(VERSION).tar.gz ../'
-                           },
-              'linkext' => {LINKTYPE => '' }, #not needed for MakeMakers > 5
-              'clean'   => {FILES => "*% *.html"}
-             );
+sub MY::libscan {
+    return '' if m:/(RCS|CVS)/:;
+    return '' if m/[~%]$/;
+    return '' if m/\.(orig|rej)$/;
+    $_;
+}
 
diff --git a/ftp/README b/ftp/README
index 1365fdf..cf9c75f 100644
--- a/ftp/README
+++ b/ftp/README
@@ -2,6 +2,18 @@ Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
 reserved. This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
 
-Please report any bugs/suggestions to <Graham.Barr@tiuk.ti.com>.
+This release has got a significant number of changes sine the last release
+so is probably prone to a few bugs.
+
+*** NOTE *** NOTE *** NOTE *** NOTE *** NOTE *** NOTE *** NOTE *** NOTE ***
+
+My intention is to attempt to make this package so that it can be used in
+a non-blocking manner. This may, in future, cause the interface to change.
 
+Although I will try to limit the impact of this I cannot gaurantee that
+future releases will be 100% compatable.
+
+*** NOTE *** NOTE *** NOTE *** NOTE *** NOTE *** NOTE *** NOTE *** NOTE ***
+
+Please report any bugs/suggestions to <Graham.Barr@tiuk.ti.com>.
 
diff --git a/ftp/lib/IO/Socket.pm b/ftp/lib/IO/Socket.pm
new file mode 100644
index 0000000..a0f77a0
--- /dev/null
+++ b/ftp/lib/IO/Socket.pm
@@ -0,0 +1,355 @@
+package IO::Socket;
+
+=head1 NAME
+
+IO::Socket - Socket filedescriptor class
+
+=head1 SYNOPSIS
+
+ use IO::Socket;
+
+ $sock = IO::Socket->new(Peer         => $host, 
+                          Service => 'ftp', 
+                         );
+
+ $sock = IO::Socket->new(Listen  => 5,
+                          Proto   => 'tcp'
+                         );
+
+
+=head1 DESCRIPTION
+
+C<IO::Socket> is a class which simplifies the creating of a socket. With
+one function call it will do all the required lookups and system calls
+to create the required socket.
+
+To create a socket connection to a foreign host C<ftp.uu.net> using
+the C<ftp> service
+
+ $sock = IO::Socket->new(Peer         => $host, 
+                          Service => 'ftp', 
+                         );
+
+If you want to use the same protocal as the C<ftp> service but provide
+your own port number to connect to
+
+ $sock = IO::Socket->new(Peer         => $host, 
+                          Service => 'ftp', 
+                          Port    => 2001,
+                         );
+
+=cut
+
+require 5.001;
+use Socket 1.3;
+use Carp;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = @Socket::EXPORT;
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
+sub Version { $VERSION }
+
+##
+## Really WANT FileHandle::new to return this !!!
+##
+my $seq = 0;
+sub _gensym {
+    my $pkg = @_ ? ref($_[0]) || $_[0] : "";
+    local *{$pkg . "::GLOB" . ++$seq};
+    \delete ${$pkg . "::"}{'GLOB' . $seq};
+}
+
+my %socket_type = (
+ tcp => SOCK_STREAM,
+ udp => SOCK_DGRAM,
+ rpc => SOCK_DGRAM,
+);
+
+# Peer     => remote host name for a 'connect' socket
+# Proto    => specifiy protocol by it self (but override by Service)
+# Service  => require service eg 'ftp' or 'ftp/tcp', overrides Proto
+# Port     => port num for connect eg 'ftp' or 21, defaults to Service
+# Bind     => port to bind to, defaults to INADDR_ANY
+# Listen   => queue size for listen
+#
+# if Listen is defined then a listen socket is created, else if the socket
+# type, which is derived from the protocol, is SOCK_STREAM then a connect
+# is called
+
+=head2 new( %args )
+
+The new constructor takes its arguments in the form of a hash. Accepted 
+arguments are
+
+ Peer     => remote host name for a 'connect' socket
+ Proto    => specifiy protocol by it self (but override by Service)
+ Service  => require service eg 'ftp' or 'ftp/tcp', overrides Proto
+ Port     => port num for connect eg 'ftp' or 21, defaults to Service
+ Bind     => port to bind to, defaults to INADDR_ANY
+ Listen   => queue size for listen
+
+=cut
+
+sub new {
+ my $pkg = shift;
+ my %arg = @_;
+
+ my $proto    = $arg{Proto} || "";
+ my $bindport = $arg{Bind}  || 0;
+ my $servport = $arg{Port}  || 0;
+
+ my $service  = $arg{Service} || $servport || $bindport;
+
+ ($service,$proto) = split(m,/,, $service)
+        if $service =~ m,/,;
+
+ my @serv  = $service =~ /\D/ ? getservbyname($service,$proto)
+                              : getservbyport($service,$proto);
+
+ $proto = $proto || $serv[3];
+
+ croak "cannot determine protocol"
+        unless $proto;
+
+ my @proto = $proto =~ /\D/ ? getprotobyname($proto)
+                            : getprotobynumber($proto);
+
+ croak "unknown protocol"
+        unless @proto;
+
+ my $type = $arg{Type} || $socket_type{$proto[0]} or
+        croak "Unknown socket type";
+
+ my $bindaddr = exists $arg{Addr} ? inet_aton($arg{Addr}) 
+                                  : INADDR_ANY;
+
+ croak "bad bind address $arg{Addr}"
+        unless $bindaddr;
+
+ my $sock = bless _gensym(), ref($pkg) || $pkg;
+
+ socket($sock, AF_INET, $type, $proto[2]) or
+        croak "socket: $!";
+ 
+ $bindport = (getservbyname($bindport,$proto))[2]
+        if $bindport =~ /\D/;
+
+ bind($sock, sockaddr_in($bindport, $bindaddr)) or
+        croak "bind: $!";
+
+ if(defined $arg{Listen})
+  {
+   my $queue = $arg{Listen} || 1;
+ 
+   listen($sock, $queue) or
+        croak "listen: $!";
+  }
+ else
+  {
+   $servport = $serv[2] || 0
+        unless $servport =~ /^\d+$/ && $servport > 0;
+
+   croak "cannot determine port"
+        unless($servport);
+
+   my $destaddr = defined $arg{Peer} ? inet_aton($arg{Peer})
+                                     : undef;
+
+   my $peername = defined $destaddr ? sockaddr_in($servport,$destaddr)
+                                    : undef;
+   
+   
+   if($type == SOCK_STREAM)
+    {
+     croak "bad peer address"
+        unless defined $destaddr;
+     
+     connect($sock, $peername) or
+        croak "connect: $!";
+
+     ${*$sock}{Peername} = getpeername($sock);
+    }
+   else
+    {
+     ${*$sock}{Peername} = $peername;
+    }
+  }
+ 
+ ${*$sock}{Sockname} = getsockname($sock);
+
+ $sock;
+}
+
+=head2 autoflush( [$val] )
+
+Set the file descriptor to autoflush, depending on C<$val>
+
+=cut
+
+sub autoflush {
+ my $sock = shift;
+ my $val = @_ ? shift : 0;
+
+ select((select($sock), $| = $val)[$[]);
+}
+
+=head2 accept
+
+perform the system call C<accept> on the socket and return a new IO::Soscket
+object. This object can be used to communicate with the client that was trying
+to connect.
+
+=cut
+
+sub accept {
+ my $sock = shift;
+
+ my $new = bless _gensym();
+
+ accept($new,$sock) or
+        croak "accept: $!";
+
+ $new;
+}
+
+=head2 close
+
+Close the file descriptor
+
+=cut
+
+sub close {
+ my $sock = shift;
+
+ delete ${*$sock}{Sockname};
+ delete ${*$sock}{Peername};
+
+ close($sock);
+}
+
+=head2 dup
+
+Create a duplicate of the socket object
+
+=cut
+
+sub dup {
+ my $sock = shift;
+ my $dup = bless _gensym(), ref($sock);
+
+ if(open($dup,">&" . fileno($sock))) { 
+  # Copy all the internals
+  ${*$dup} = ${*$sock};
+  @{*$dup} = @{*$sock};
+  %{*$dup} = %{*$sock};
+ }
+ else {
+  undef $dup;
+ }
+
+ $dup;
+}
+
+# Some info about the local socket
+
+=head2 sockname
+
+Return a packed sockaddr structure for the socket
+
+=head2 sockaddr
+
+Return the address part of the sockaddr structure for the socket
+
+=head2 sockport
+
+Return the port number that the socket is using on the local host
+
+=head2 sockhost
+
+Return the address part of the sockaddr structure for the socket in a
+text form xx.xx.xx.xx
+
+=cut
+
+sub sockname { my $sock = shift;  ${*$sock}{Sockname} }
+sub sockaddr { (sockaddr_in(shift->sockname))[1]}
+sub sockport { (sockaddr_in(shift->sockname))[0]}
+sub sockhost { inet_ntoa( shift->sockaddr);}
+
+# Some info about the remote socket, for connect-d sockets
+
+=head2 peername, peeraddr, peerport, peerhost
+
+Same as for the sock* functions, but returns the data about the peer
+host instead of the local host.
+
+=cut
+
+sub peername { my $sock = shift;  ${*$sock}{Peername} or croak "no peer" }
+sub peeraddr { (sockaddr_in(shift->peername))[1]}
+sub peerport { (sockaddr_in(shift->peername))[0]}
+sub peerhost { inet_ntoa( shift->peeraddr);}
+
+=head2 send( $buf [, $flags [, $to]] )
+
+For a udp socket, send the contents of C<$buf> to the remote host C<$to> using
+flags C<$flags>. 
+
+If C<$to> is not specified then the data is sent to the host which the socket
+last communicated with, ie sent to or recieved from.
+
+If C<$flags> is ommited then 0 is used
+
+=cut
+
+sub send {
+ my $sock = shift;
+ local *buf = \$_[0]; shift;
+ my $flags = shift || 0;
+ my $to = shift || $sock->peername;
+
+ # remember who we send to
+ ${*$sock}{Peername} = $to;
+
+ send($sock, $buf, $flags, $to);
+}
+
+=head2 recv( $buf, $len [, $flags] )
+
+Receive C<$len> bytes of data from the socket and place into C<$buf>
+
+If C<$flags> is ommited then 0 is used
+
+=cut
+
+sub recv {
+ my $sock = shift;
+ local *buf = \$_[0]; shift;
+ my $len = shift;
+ my $flags = shift || 0;
+
+ # remember who we recv'd from
+ ${*$sock}{Peername} = recv($sock, $buf='', $len, $flags);
+}
+
+=head1 AUTHOR
+
+Graham Barr <Graham.Barr@tiuk.ti.com>
+
+=head1 REVISION
+
+$Revision: 1.1 $
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+1; # Keep require happy
+
+
diff --git a/ftp/lib/Net/FTP.pm b/ftp/lib/Net/FTP.pm
new file mode 100644
index 0000000..a10c483
--- /dev/null
+++ b/ftp/lib/Net/FTP.pm
@@ -0,0 +1,979 @@
+;# Net::FTP.pm
+;#
+;# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
+;# reserved. This program is free software; you can redistribute it and/or
+;# modify it under the same terms as Perl itself.
+
+;#Notes
+;# should I have a dataconn::close sub which calls response ??
+;# FTP should hold state reguarding cmds sent
+;# A::read needs some more thought
+;# A::write What is previous pkt ended in \r or not ??
+;# need to do some heavy tidy-ing up !!!!
+;# need some documentation
+
+package Net::FTP;
+
+=head1 NAME
+
+Net::FTP - FTP Client class
+
+=head1 SYNOPSIS
+
+ require Net::FTP;
+
+ $ftp = Net::FTP->new("some.host.name");
+ $ftp->login("anonymous","me@here.there");
+ $ftp->cwd("/pub");
+ $ftp->get("that.file");
+ $ftp->quit;
+
+=head1 DESCRIPTION
+
+C<Net::FTP> is a class implementing a simple FTP client in Perl.
+
+=head2 TO BE CONTINUED ...
+
+=cut
+
+require 5.001;
+use Socket 1.3;
+use Carp;
+use IO::Socket;
+
+@ISA = qw(IO::Socket);
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
+sub Version { $VERSION }
+
+use strict;
+
+=head1 METHODS
+
+All methods return 0 or undef upon failure
+
+=head2 * new($host [, option => value [,...]] )
+
+Constructor for the FTP client. It will create the connection to the
+remote host. Possible options are:
+
+ Port         => port to use for FTP connection
+ Timeout => set timeout value (defaults to 120)
+ Debug         => debug level
+
+=cut
+
+sub FTP_READY    { 0 }
+sub FTP_RESPONSE { 1 }
+sub FTP_XFER     { 2 }
+
+sub new {
+ my $pkg  = shift;
+ my $host = shift;
+ my %arg  = @_; 
+ my $me = bless IO::Socket->new(Peer        => $host, 
+                                Service        => 'ftp', 
+                                Port        => $arg{Port} || 'ftp'
+                                ), $pkg;
+
+ @{*$me} = ();                                        # Last response text
+
+ %{*$me} = (%{*$me},                                # Copy current values
+            Code    => 0,                        # Last response code
+            Type    => 'A',                        # Ascii/Binary/etc mode
+            Timeout => $arg{Timeout} || 120,        # Timeout value
+            Debug   => $arg{Debug}   || 0,        # Output debug information
+            FtpHost => $host,                        # Remote hostname
+            State   => FTP_RESPONSE,                # Current state
+
+            ##############################################################
+            # Other elements used during the lifetime of the object are
+            #
+            # LISTEN  Listen socket
+            # DATA    Data socket
+           );
+
+ $me->autoflush(1);
+
+ unless(2 == $me->response())
+  {
+   $me->close();
+   undef $me;
+  }
+
+ $me;
+}
+
+##
+## User interface methods
+##
+
+=head2 * debug( $value )
+
+Set the level of debug information for this object. If no argument is given
+then the current state is returned. Otherwise the state is changed to 
+C<$value>and the previous state returned.
+
+=cut
+
+sub debug {
+ my $me = shift;
+ my $debug = ${*$me}{Debug};
+ 
+ ${*$me}{Debug} = 0 + shift
+        if @_;
+
+ $debug;
+}
+
+=head2 quit
+
+Send the QUIT command to the remote FTP server and close the socket connection.
+
+=cut
+
+sub quit {
+ my $me = shift;
+
+ return undef
+        unless $me->QUIT;
+
+ close($me);
+
+ return 1;
+}
+
+=head2 ascii/ebcdic/binary/byte
+
+Put the remote FTP server ant the FTP package into the given mode
+of data transfer.
+
+=cut
+
+sub ascii  { shift->type('A',@_); }
+sub ebcdic { shift->type('E',@_); }
+sub binary { shift->type('I',@_); }
+sub byte   { shift->type('L',@_); }
+
+# Allow the user to send a command directly, BE CAREFUL !!
+
+sub quot  { 
+ my $me = shift;
+ my $cmd = shift;
+
+ $me->send_cmd( uc $cmd, @_);
+
+ $me->response();
+}
+
+=head2 login([$login [, $password [, $account]]])
+
+Log into the remote FTP server with the given login information. If
+no arguments are given then the users $HOME/.netrc file is searched
+for the remote server's hostname. If no information is found then
+a login of I<anonymous> is used. If no password is given and the login
+is anonymous then the users Email address will be used for a password
+
+=cut
+
+sub login {
+ my $me = shift;
+ my $user = shift;
+ my $pass = shift if(defined $user);
+ my $acct = shift if(defined $pass);
+ my $ok;
+
+ ($user,$pass,$acct) = netrc(${*$me}{FtpHost})
+        unless defined $user;
+
+ $user = "anonymous"
+        unless defined $user;
+
+ $pass = "-" . (getpwuid($>))[0] . "@" 
+        if !defined $pass && $user eq "anonymous";
+
+ $ok = $me->USER($user);
+
+ $ok = $me->PASS($pass)
+        if $ok == 3;
+
+ $ok = $me->ACCT($acct || "")
+        if $ok == 3;
+
+ $ok == 2;
+}
+
+=head2 authorise($auth, $resp)
+
+This is a protocol used by some firewall ftp proxies. It is used
+to authorise the user to send data out.
+
+=cut
+
+sub authorise {
+ my($me,$auth,$resp) = @_;
+ my $ok;
+
+ carp "Net::FTP::authorise <auth> <resp>\n"
+        unless defined $auth && defined $resp;
+
+ $ok = $me->AUTH($auth);
+
+ $ok = $me->RESP($resp)
+        if $ok == 3;
+
+ $ok == 2;
+}
+
+=head2 rename( $oldname, $newname)
+
+Rename a file on the remote FTP server from C<$oldname> to C<$newname>
+
+=cut
+
+sub rename {
+ my($me,$from,$to) = @_;
+
+ croak "Net::FTP:rename <from> <to>\n"
+        unless defined $from && defined $to;
+
+ $me->RNFR($from) and $me->RNTO($to);
+}
+
+sub type {
+ my $me          = shift;
+ my $type = shift;
+ my $ok          = 0;
+
+ return ${*$me}{Type}
+        unless defined $type;
+
+ return undef
+        unless($me->TYPE($type,@_));
+
+ ${*$me}{Type} = join(" ",$type,@_);
+}
+
+sub abort {
+ my $me = shift;
+
+ ${*$me}{DATA}->abort()
+        if defined ${*$me}{DATA};
+}
+
+sub get {
+ my $me = shift;
+ my $remote = shift;
+ my $local  = shift;
+ my($loc,$len,$buf,$resp,$localfd,$data);
+ local *FD;
+
+ $localfd = ref($local) ? fileno($local)
+                        : 0;
+
+ ($local = $remote) =~ s#^.*/## unless(defined $local);
+
+ if($localfd)
+  {
+   $loc = $local;
+  }
+ else
+  {
+   $loc = \*FD;
+
+   unless(open($loc,">$local"))
+    {
+     carp "Cannot open Local file $local: $!\n";
+     return undef;
+    }
+  }
+
+ $data = $me->retr($remote) or
+        return undef;
+
+ $buf = '';
+
+ do
+  {
+   $len = $data->read($buf,1024);
+  }
+ while($len > 0 && syswrite($loc,$buf,$len) == $len);
+
+ close($loc)
+        unless $localfd;
+ 
+ $resp = $data->close();
+
+ 200 <= $resp && $resp < 300;
+}
+
+sub cwd {
+ my $me = shift;
+ my $dir = shift || "/";
+
+ return $dir eq ".." ? $me->CDUP()
+                     : $me->CWD($dir);
+}
+
+sub put               { shift->send("stor",@_) }
+sub put_unique { shift->send("stou",@_) }
+sub append     { shift->send("appe",@_) }
+
+sub nlst { shift->data_cmd("NLST",@_) }
+sub list { shift->data_cmd("LIST",@_) }
+sub retr { shift->data_cmd("RETR",@_) }
+sub stor { shift->data_cmd("STOR",@_) }
+sub stou { shift->data_cmd("STOU",@_) }
+sub appe { shift->data_cmd("APPE",@_) }
+
+sub send {
+ my $me            = shift;
+ my $cmd    = shift;
+ my $local  = shift;
+ my $remote = shift;
+ my($loc,$sock,$len,$buf,$localfd);
+ local *FD;
+
+ $localfd = ref($local) ? fileno($local)
+                        : 0;
+
+ unless(defined $remote)
+  {
+   croak "Must specify remote filename with stream input\n"
+        if $localfd;
+
+   ($remote = $local) =~ s%.*/%%;
+  }
+
+ if($localfd)
+  {
+   $loc = $local;
+  }
+ else
+  {
+   $loc = \*FD;
+
+   unless(open($loc,"<$local"))
+    {
+     carp "Cannot open Local file $local: $!\n";
+     return undef;
+    }
+  }
+
+ $cmd = lc $cmd;
+
+ $sock = $me->$cmd($remote) or
+        return undef;
+
+ do
+  {
+   $len = sysread($loc,$buf,1024);
+  }
+ while($len && $sock->write($buf,$len) == $len);
+
+ close($loc)
+        unless $localfd;
+
+ $sock->close();
+
+ ($remote) = $me->message =~ /unique file name:\s*(\S*)\s*\)/
+        if $cmd eq 'stou' ;
+
+ return $remote;
+}
+
+sub port {
+ my $me = shift;
+ my $port = shift;
+ my $ok;
+
+ unless(defined $port)
+  {
+   my $listen;
+
+   if(defined ${*$me}{LISTEN})
+    {
+     ${*$me}{LISTEN}->close();
+     delete ${*$me}{LISTEN};
+    }
+
+   # create a Listen socket at same address as the command socket
+
+   $listen = IO::Socket->new(Listen  => 5,
+                             Service => 'ftp',
+                             Addr    => $me->sockhost, 
+                            );
+  
+   ${*$me}{LISTEN} = $listen;
+
+   my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
+
+   $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
+  }
+
+ $ok = $me->PORT($port);
+
+ ${*$me}{Port} = $port;
+
+ $ok;
+}
+
+sub ls        { shift->list_cmd("NLST",@_); }
+sub lsl { shift->list_cmd("LIST",@_); }
+
+sub pasv {
+ my $me = shift;
+ my $hostport;
+
+ return undef
+        unless $me->PASV();
+
+ ($hostport) = $me->message =~ /(\d+(,\d+)+)/;
+
+ ${*$me}{Pasv} = $hostport;
+}
+
+##
+## Communication methods
+##
+
+sub timeout {
+ my $me = shift;
+ my $timeout = ${*$me}{Timeout};
+
+ ${*$me}{Timeout} = 0 + shift if(@_);
+
+ $timeout;
+}
+
+sub accept {
+ my $me = shift;
+ 
+ return undef unless defined ${*$me}{LISTEN};
+
+ my $data = ${*$me}{LISTEN}->accept;
+
+ ${*$me}{LISTEN}->close();
+ delete ${*$me}{LISTEN};
+
+ ${*$data}{Timeout} = ${*$me}{Timeout};
+ ${*$data}{Cmd} = $me;
+ ${*$data} = "";
+
+ ${*$me}{State} = FTP_XFER;
+ ${*$me}{DATA}  = bless $data, "Net::FTP::" . ${*$me}{Type};
+}
+
+sub message {
+ my $me = shift;
+ join("\n", @{*$me});
+}
+
+sub ok {
+ my $me = shift;
+ my $code = ${*$me}{Code} || 0;
+
+ 0 < $code && $code < 400;
+}
+
+sub code {
+ my $me = shift;
+
+ ${*$me}{Code};
+}
+
+sub list_cmd {
+ my $me = shift;
+ my $cmd = lc shift;
+ my $data = $me->$cmd(@_);
+
+ die "undef" unless(defined $data);
+
+ bless $data, "Net::FTP::A"; # Force ASCII mode
+
+ my $databuf = '';
+ my $list = [];
+
+ while($data->read($databuf,1024)) {
+   push(@{$list}, split(/\n/,$databuf)); ## break into lines
+ }
+
+ wantarray ? @{$list} : $list;
+}
+
+sub data_cmd {
+ my $me = shift;
+ my $ok = 1;
+ my $pasv = defined ${*$me}{Pasv} ? 1 : 0;
+ my $cmd = uc shift;
+
+ $ok = $me->port
+        unless $pasv || defined ${*$me}{Port};
+
+ $ok = $me->$cmd(@_)
+        if $ok;
+
+ return $pasv ? $ok
+              : $ok ? $me->accept()
+                    : undef;
+}
+
+sub cmd {
+ my $me = shift;
+
+ $me->send_cmd(@_);
+ $me->response();
+}
+
+sub send_cmd {
+ my $me = shift;
+
+ if(scalar(@_)) {     
+  my $cmd = join(" ", @_) . "\r\n";
+
+  delete ${*$me}{Pasv};
+  delete ${*$me}{Port};
+
+  syswrite($me,$cmd,length $cmd);
+
+  ${*$me}{State} = FTP_RESPONSE;
+
+  printf STDERR "$me>> %s\n", $cmd=~/^(pass|resp)/i ? "$1 ...." : $cmd
+        if $me->debug;
+ }
+
+ $me;
+}
+
+sub pasv_wait {
+ my $me = shift;
+ my $non_pasv = shift;
+ my $file;
+
+ my($rin,$rout);
+ vec($rin,fileno($me),1) = 1;
+ select($rout=$rin, undef, undef, undef);
+
+ $me->response();
+ $non_pasv->response();
+
+ return undef
+        unless $me->ok() && $non_pasv->ok();
+
+ return $1
+        if $me->message =~ /unique file name:\s*(\S*)\s*\)/;
+
+ return $1
+        if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
+
+ return 1;
+}
+
+sub response {
+ my $me = shift;
+ my $timeout = ${*$me}{Timeout};
+ my($code,$more,$rin,$rout,$partial,$buf) = (undef,0,'','','','');
+
+ @{*$me} = (); # the responce
+
+ vec($rin,fileno($me),1) = 1;
+
+ do
+  {
+   if(($timeout==0) || select($rout=$rin, undef, undef, $timeout))
+    {
+     unless(sysread($me, $buf, 1024))
+      {
+       carp "Unexpected EOF on command channel";
+       return undef;
+      } 
+
+     substr($buf,0,0) = $partial;    ## prepend from last sysread
+
+     my @buf = split(/\r?\n/, $buf);  ## break into lines
+
+     $partial = (substr($buf, -1, 1) eq "\n") ? ''
+                                              : pop(@buf); 
+
+     my $cmd;
+     foreach $cmd (@buf)
+      {
+       print STDERR "$me<< $cmd\n"
+         if $me->debug;
+ 
+       ($code,$more) = ($1,$2)
+        if $cmd =~ /^(\d\d\d)(.)/;
+ 
+       push(@{*$me},$');
+      } 
+    }
+   else
+    {
+     carp "$me: Timeout" if($me->debug);
+     return undef;
+    }
+  }
+ while(length($partial) || (defined $more && $more eq "-"));
+
+ ${*$me}{Code} = $code;
+ ${*$me}{State} = FTP_READY;
+
+ substr($code,0,1);
+}
+
+sub netrc {
+ my $host = shift;
+ my $file = (getpwuid($>))[7] . "/.netrc";
+ my($login,$pass,$acct) = (undef,undef,undef);
+ local *NETRC;
+ local $_;
+
+ my @stat = stat($file);
+
+ if(@stat)
+  {
+   if($stat[2] & 077)
+    {
+     carp "Bad permissions: $file";
+     return ();
+    }
+   if($stat[4] != $<)
+    {
+     carp "Not owner: $file";
+     return ();
+    }
+  }
+
+ if(open(NETRC,$file))
+  {
+   my($mach,$macdef,$tok,@tok) = (0,0);
+
+LINE_LOOP:
+   while(<NETRC>) 
+    {
+     $macdef = 0 if /\A\n\Z/;
+
+     next if $macdef;
+
+     push(@tok, split(/[\s\n]+/, $_));
+
+TOKEN_LOOP:
+     while(@tok)
+      {
+       if($tok[0] eq "default")
+        {
+         last LINE_LOOP if $mach;
+
+         shift(@tok);
+         $mach = 1;
+         ($login,$pass,$acct) = (undef,undef,undef);
+
+         next TOKEN_LOOP;
+        }
+
+       last TOKEN_LOOP unless @tok > 1;
+       $tok = shift(@tok);
+
+       if($tok eq "machine")
+        {
+         last LINE_LOOP if $mach;
+         $mach = 1 if $host eq shift(@tok);
+         ($login,$pass,$acct) = (undef,undef,undef);
+        }
+       elsif($tok eq "login")
+        {
+         $login = shift(@tok);
+        }
+       elsif($tok eq "password")
+        {
+         $pass = shift(@tok);
+        }
+       elsif($tok eq "account")
+        {
+         $acct = shift(@tok);
+        }
+       elsif($tok eq "macdef")
+        {
+         $macdef = 1;
+        }
+      }
+    }
+   close(NETRC);
+
+   return ($login,$pass,$acct)
+        if $mach;
+  }
+
+ return ();
+}
+
+sub file_mode {
+ local $_ = shift;
+ my $mode = 0;
+ my($type,$ch);
+
+ s/^(.)// and $type = $1;
+
+ foreach $ch (split(//,$_))
+  {
+   $mode <<= 1;
+   $mode |= 1 unless $ch eq "-";
+  }
+
+ $type eq "d" and $mode |= 0040000 or        # Directory
+   $type eq "l" and $mode |= 0120000 or        # Symbolic Link
+   $mode |= 0100000;                        # Regular File
+
+ $mode |= 0004000 if /^...s....../i;
+ $mode |= 0002000 if /^......s.../i;
+ $mode |= 0001000 if /^.........t/i;
+
+ $mode;
+}
+
+sub parse_dir
+{
+ my $me = shift;
+ my $dir = shift;
+ my @files = ();
+
+ local $_;
+
+ foreach (@$dir)
+  {
+   if(/^([\-FlrwxsStTdD]{10}).*(\w+)\s+(\w*\D)\s*(\d+)\s+(\w{3}\s+\d+\s*(\d+:\d+|\d{4}))\s+(\S+)(\s+->\s+(\S+))?/ )
+    {
+     my($mode,$owner,$group,$size,$date,$file,$link) = ($1,$2,$3,$4,$5,$7,$9);
+
+     $mode = file_mode($mode);
+     push(@files, [$mode, $owner, $group, $size, $date, $file, $link]);
+    }
+  }
+ wantarray ? @files : \@files;
+}
+
+
+;########################################
+;#
+;# RFC959 commands
+;#
+
+sub no_imp { croak "Not implemented\n"; }
+
+sub ABOR { shift->send_cmd("ABOR")->response()        == 2}
+sub CDUP { shift->send_cmd("CDUP")->response()        == 2}
+sub NOOP { shift->send_cmd("NOOP")->response()        == 2}
+sub PASV { shift->send_cmd("PASV")->response()        == 2}
+sub QUIT { shift->send_cmd("QUIT")->response()        == 2}
+sub DELE { shift->send_cmd("DELE",@_)->response() == 2}
+sub CWD  { shift->send_cmd("CWD", @_)->response() == 2}
+sub PORT { shift->send_cmd("PORT",@_)->response() == 2}
+sub RMD  { shift->send_cmd("RMD", @_)->response() == 2}
+sub MKD  { shift->send_cmd("MKD", @_)->response() == 2}
+sub PWD  { shift->send_cmd("PWD", @_)->response() == 2}
+sub TYPE { shift->send_cmd("TYPE",@_)->response() == 2}
+sub APPE { shift->send_cmd("APPE",@_)->response() == 1}
+sub LIST { shift->send_cmd("LIST",@_)->response() == 1}
+sub NLST { shift->send_cmd("NLST",@_)->response() == 1}
+sub RETR { shift->send_cmd("RETR",@_)->response() == 1}
+sub STOR { shift->send_cmd("STOR",@_)->response() == 1}
+sub STOU { shift->send_cmd("STOU",@_)->response() == 1}
+sub RNFR { shift->send_cmd("RNFR",@_)->response() == 3}
+sub RNTO { shift->send_cmd("RNTO",@_)->response() == 2}
+sub ACCT { shift->send_cmd("ACCT",@_)->response() == 2}
+sub RESP { shift->send_cmd("RESP",@_)->response() == 2}
+sub USER { my $ok = shift->send_cmd("USER",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;}
+sub PASS { my $ok = shift->send_cmd("PASS",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;}
+sub AUTH { my $ok = shift->send_cmd("AUTH",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;}
+
+sub ALLO { no_imp; }
+sub SMNT { no_imp; }
+sub HELP { no_imp; }
+sub MODE { no_imp; }
+sub SITE { no_imp; }
+sub SYST { no_imp; }
+sub STAT { no_imp; }
+sub STRU { no_imp; }
+sub REIN { no_imp; }
+sub REST { no_imp; }
+
+package Net::FTP::dataconn;
+use Carp;
+
+sub abort {
+ my $fd = shift;
+ my $ftp = ${*$fd}{Cmd};
+
+ $ftp->send_cmd("ABOR");
+ $fd->close();
+}
+
+sub close {
+ my $fd = shift;
+ my $ftp = ${*$fd}{Cmd};
+
+ $fd->IO::Socket::close();
+ delete ${*$ftp}{DATA};
+
+ $ftp->response();
+}
+
+sub _select {
+ my $fd = shift;
+ my $timeout = shift;
+ my $rw = shift;
+ my($rin,$win);
+
+ return 1 unless $timeout;
+
+ $rin = '';
+ vec($rin,fileno($fd),1) = 1;
+
+ $win = $rw ? undef : $rin;
+ $rin = undef unless $rw;
+
+ my $nfound = select($rin, $win, undef, $timeout);
+
+ croak "select: $!"
+        if $nfound < 0;
+
+ return $nfound;
+}
+
+sub can_read {
+ my $fd = shift;
+ my $timeout = shift;
+
+ $fd->_select($timeout,1);
+}
+
+sub can_write {
+ my $fd = shift;
+ my $timeout = shift;
+
+ $fd->_select($timeout,0);
+}
+
+sub cmd {
+ my $me = shift;
+
+ ${*$me}{Cmd};
+}
+
+# should I have a close sub which calls response ??
+
+
+@Net::FTP::L::ISA = qw(Net::FTP::I);
+@Net::FTP::E::ISA = qw(Net::FTP::I);
+
+package Net::FTP::A;
+@Net::FTP::A::ISA = qw(Net::FTP::dataconn);
+use Carp;
+
+no strict 'vars';
+
+sub read {
+ my $fd = shift;
+ local *buf = \$_[0]; shift;
+ my $size = shift || croak 'read($buf,$size,[$timeout])';
+ my $timeout = @_ ? shift : ${*$fd}{Timeout};
+
+ $fd->can_read($timeout) or
+        croak "Timeout";
+
+ # this needs a bit more thought so I return the correct number of bytes !!
+
+ $buf = '';
+
+ my $n = sysread($fd, $buf, $size);
+
+ if($n >= 0)
+  {
+   substr($buf,0,0) = ${*$fd};
+   $buf =~ s/\r\n/\n/g;
+   $buf =~ s/([^\n]*)\Z//so;
+   ${*$fd} = $1;
+
+   $n = length $buf;
+  }
+
+ $n;
+}
+
+sub write {
+ my $fd = shift;
+ local *buf = \$_[0]; shift;
+ my $size = shift || croak 'write($buf,$size,[$timeout])';
+ my $timeout = @_ ? shift : ${*$fd}{Timeout};
+
+ $fd->can_write($timeout) or
+        croak "Timeout";
+
+ # What is previous pkt ended in \r or not ??
+
+ my $tmp;
+ ($tmp = $buf) =~ s/(?!\r)\n/\r\n/g;
+
+ my $len = $size + length($tmp) - length($buf);
+ my $wrote = syswrite($fd, $tmp, $len);
+
+ if($wrote >= 0)
+  {
+   $wrote = $wrote == $len ? $size
+                           : $len - $wrote
+  }
+
+ return $wrote;
+}
+
+package Net::FTP::I;
+@Net::FTP::I::ISA = qw(Net::FTP::dataconn);
+use Carp;
+
+no strict 'vars';
+
+sub read {
+ my $fd = shift;
+ local *buf = \$_[0]; shift;
+ my $size = shift || croak 'read($buf,$size,[$timeout])';
+ my $timeout = @_ ? shift : ${*$fd}{Timeout};
+
+ $fd->can_read($timeout) or
+        croak "Timeout";
+
+ my $n = sysread($fd, $buf, $size);
+
+ $n;
+}
+
+sub write {
+ my $fd = shift;
+ local *buf = \$_[0]; shift;
+ my $size = shift || croak 'write($buf,$size,[$timeout])';
+ my $timeout = @_ ? shift : ${*$fd}{Timeout};
+
+ $fd->can_write($timeout) or
+        croak "Timeout";
+
+ syswrite($fd, $buf, $size);
+}
+
+=head2 AUTHOR
+
+Graham Barr <Graham.Barr@tiuk.ti.com>
+
+=head2 REVISION
+
+$Revision: 1.8 $
+
+=head2 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+
+1;
+
diff --git a/ftp/t/dummy.t b/ftp/t/dummy.t
new file mode 100644
index 0000000..eb361d0
--- /dev/null
+++ b/ftp/t/dummy.t
@@ -0,0 +1,8 @@
+# 
+# Dummy test file
+#
+
+
+print "1..1\n";
+
+print "ok 1\n";
diff --git a/ftp/tst b/ftp/tst
deleted file mode 100755
index 455bca6..0000000
--- a/ftp/tst
+++ /dev/null
@@ -1,89 +0,0 @@
-#!/usr/local/bin/perl
-
-BEGIN { unshift @INC, "./lib", "./blib" }
-use Net::FTP;
-
-sub test_gate {
- my $ftp = Net::FTP->new('gate.ti.com');
- my($user,$pswd) = @_;
-
- $ftp->login('anonymous@ftp.icnet.uk',"$ENV{USER}\@tiuk.ti.com");
-
-# if($user && $pswd) {
-#  $ftp->auth($user) || warn $ftp->message;
-#  $ftp->resp($pswd) || warn $ftp->message;
-# }
- $ftp->authorise($user,$pswd);
- print @{$ftp->lsl};
-
- $ftp->quit;
-}
-
-sub test_mosftp {
- my $ftp = Net::FTP->new('mosftp.tiuk.ti.com');
-
- $ftp->login(); # anonymous
- $ftp->chdir("pub");
-
- $file =  "MANIFEST";
- 
- $file = $ftp->put_unique($file);
-
- print @{$ftp->ls};
- 
-# if(defined $file && defined($sock = $ftp->retr($file))) {
-#  print <$sock>;
-#  close $sock;
-#  $ftp->response();
-# }
-
- if(defined $file) {
-  $ftp->get($file,\*STDOUT) || warn $ftp->message;
-  $ftp->get($file) || warn $ftp->message;
-  warn $ftp->message;
- }
-
- $ftp->quit;
-}
-
-sub test_passive {
- my $ftpf = Net::FTP->new('mosftp.tiuk.ti.com');
- my $ftpt = Net::FTP->new('mosftp.tiuk.ti.com');
-
-# $ftpt->debug(0);
-
- $ftpf->login();
- $ftpt->login();
-
- $ftpf->chdir("pub");                                                   
- $ftpt->chdir("pub");                                                    
-
- $ftpf->put("MANIFEST","testfile");
-
- $ftpf->port($ftpt->pasv) || die $ftpt->message;
-
- $ftpf->retr("testfile"); # Non passive server first !!!
- $ftpt->stou("testfile");
-
- $file = $ftpt->pasv_wait($ftpf);
-
- print $ftpt->lsl(),"\n";
- warn $file;
- $ftpf->get($file,"OUTPUT");
- 
- $ftpt->quit;
- $ftpf->quit;
-}
-
-sub test_solaris {
- my $ftp = Net::FTP->new("lum");
- $ftp->login("a909937","d5txba");
- print $ftp->lsl(),"\n";
- $ftp->get(".cshrc","cshrc");
- $ftp->quit();
-}
-
-#test_gate(@_);
-#test_mosftp;
-#test_passive;
-test_solaris;