To: Bill Middleton <[email protected]>
Subject: Re: ftplib.pl ?
In-Reply-To: Message from Bill Middleton <[email protected]>  of
   "Wed, 06 Jan 93 19:08:50 -0600"
   <[email protected]>
Date: Wed, 06 Jan 93 23:11:28 -0500
From: Gene Spafford <[email protected]>
Status: OR

#
#   This is a set of ftp library routines using chat2.pl
#
#   Return code information taken from RFC 959

#   Written by Gene Spafford  <[email protected]>
#       Last update: 10 April 92,   Version 0.9
#

#
#   Most of these routines communicate over an open ftp channel
#   The channel is opened with the "ftp'open" call.
#

package ftp;
require "chat2.pl";
require "syscall.ph";


###########################################################################
#
#  The following are the variables local to this package.
#  I declare them all up front so I can remember what I called 'em. :-)
#
###########################################################################

LOCAL_VARS: {
   $Control;
   $Data_handle;
   $Host;
   $Myhost = "\0" x 65;
   (syscall(&SYS_gethostname, $Myhost, 65) == 0) ||
       die "Cannot 'gethostname' of local machine (in ftplib)\n";
   $Myhost =~ s/\0*$//;
   $NeedsCleanup;
   $NeedsClose;
   $ftp_error;
   $ftp_matched;
   $ftp_trans_flag;
   @ftp_list;

   local(@tmp) = getservbyname("ftp", "tcp");
   ($FTP = $tmp[2]) ||
       die "Unable to get service number for 'ftp' (in ftplib)!\n";

   @std_actions = (
           'TIMEOUT',
           q($ftp_error = "Connection timed out for $Host!\n"; undef),
           'EOF',
           q($ftp_error = "Connection to $Host timed out unexpectedly!\n"; undef)
   );

   @sigs = ('INT', 'HUP', 'TERM', 'QUIT');  # sigs we'll catch & terminate on
}



###########################################################################
#
#  The following are intended to be the user-callable routines.
#  Each of these does one of the ftp keyword functions.
#
###########################################################################

sub error { ## Public
   $ftp_error;
}

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

#   cd up a directory level

sub cdup { ## Public
   &do_ftp_cmd(200, "cdup");
}

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

# close an open ftp connection

sub close { ## Public
   return unless $NeedsClose;
   &do_ftp_cmd(221, "quit");
   &chat'close($Control);
   undef $NeedsClose;
   &do_ftp_signals(0);
}

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

# change remote directory

sub cwd { ## Public
   &do_ftp_cmd(250, "cwd", @_);
}

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

#  delete a remote file

sub delete { ## Public
    &do_ftp_cmd(250, "dele", @_);
}

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

#  get a directory listing of remote directory ("ls -l")

sub dir { ## Public
   &do_ftp_listing("list", @_);
}

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

#  get a remote file to a local file
#    get(remote[, local])

sub get { ## Public
   local($remote, $local) = @_;
   ($local = $remote) unless $local;

   unless (open(DFILE, ">$local")) {
       $ftp_error =  "Open of local file $local failed: $!";
       return undef;
   } else {
       $NeedsCleanup = $local;
   }

   return undef unless &do_open_dport;         # Open a data channel
   unless (&do_ftp_cmd(150, "retr $remote")) {
       $ftp_error .= "\nFile $remote not fetched from $Host\n";
       close DFILE;
       unlink $local;
       undef $NeedsCleanup;
       return;
   }

   $ftp_trans_flag = 0;

   do {
       &chat'expect($Data_handle, 60,
                    '.|\n', q{print DFILE ($chat'thisbuf) ||
                       ($ftp_trans_flag = 3); undef $chat'S},
                    'EOF',  '$ftp_trans_flag = 1',
                    'TIMEOUT', '$ftp_trans_flag = 2');
   } until $ftp_trans_flag;

   close DFILE;
   &chat'close($Data_handle);          # Close the data channel

   undef $NeedsCleanup;
   if ($ftp_trans_flag > 1) {
       unlink $local;
       $ftp_error = "Unexpected " . ($ftp_trans_flag == 2 ? "timeout" :
               ($ftp_trans_flag != 3 ? "failure" : "local write failure")) .
               " getting $remote\n";
   }

   &do_ftp_cmd(226);
}

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

#  Do a simple name list ("ls")

sub list { ## Public
   &do_ftp_listing("nlst", @_);
}

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

#   Make a remote directory

sub mkdir { ## Public
   &do_ftp_cmd(257, "mkd", @_);
}

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

#  Open an ftp connection to remote host

sub open {  ## Public
   if ($NeedsClose) {
       $ftp_error = "Connection still open to $Host!";
       return undef;
   }

   $Host = shift(@_);
   local($User, $Password, $Acct) = @_;
   $User = "anonymous" unless $User;
   $Password = "-" . $main'ENV{'USER'} . "@$Myhost" unless $Password;
   $ftp_error = '';

   unless($Control = &chat'open_port($Host, $FTP)) {
       $ftp_error = "Unable to connect to $Host ftp port: $!";
       return undef;
   }

   unless(&chat'expect($Control, 60,
                       "^220 .*\n",     "1",
                       "^\d\d\d .*\n",  "undef")) {
       $ftp_error = "Error establishing control connection to $Host";
       &chat'close($Control);
       return undef;
   }
   &do_ftp_signals($NeedsClose = 1);

   unless (&do_ftp_cmd(331, "user $User")) {
       $ftp_error .= "\nUser command failed establishing connection to $Host";
       return undef;
   }

   unless (&do_ftp_cmd("(230|332|202)", "pass $Password")) {
       $ftp_error .= "\nPassword command failed establishing connection to $Host";
       return undef;
   }

   return 1 unless $Acct;

   unless (&do_ftp_cmd("(230|202)", "pass $Password")) {
       $ftp_error .= "\nAcct command failed establishing connection to $Host";
       return undef;
   }
   1;
}

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

#  Get name of current remote directory

sub pwd { ## Public
   if (&do_ftp_cmd(257, "pwd")) {
       $ftp_matched =~ m/^257 (.+)\r?\n/;
       $1;
   } else {
       undef;
   }
}

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

#  Rename a remote file

sub rename { ## Public
   local($from, $to) = @_;

   &do_ftp_cmd(350, "rnfr $from") && &do_ftp_cmd(250, "rnto $to");
}

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

#  Set transfer type

sub type { ## Public
   &do_ftp_cmd(200, "type", @_);
}


###########################################################################
#
#  The following are intended to be utility routines used only locally.
#  Users should not call these directly.
#
###########################################################################

sub do_ftp_cmd {  ## Private
   local($okay, @commands, $val) = @_;

   $commands[0] &&
       &chat'print($Control, join(" ", @commands), "\r\n");

   &chat'expect($Control, 60,
                "^$okay .*\\n",        '$ftp_matched = $&; 1',
                '^(\d)\d\d .*\\n', '($String = $&) =~ y/\r\n//d;
                    $ftp_error = qq{Unexpected reply for ' .
                    "@commands" . ': $String};
                    $1 > 3 ? undef : 1',
                @std_actions
               );
}

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

sub do_ftp_listing { ## Private
   local(@lcmd) = @_;
   @ftp_list = ();
   $ftp_trans_flag = 0;

   return undef unless &do_open_dport;

   return undef unless &do_ftp_cmd(150, @lcmd);
   do {                        #  Following is grotty, but chat2 makes us do it
       &chat'expect($Data_handle, 30,
               "(.*)\r?\n",    'push(@ftp_list, $1)',
               "EOF",     '$ftp_trans_flag = 1');
   } until $ftp_trans_flag;

   &chat'close($Data_handle);
   return undef unless &do_ftp_cmd(226);

   grep(y/\r\n//d, @ftp_list);
   @ftp_list;
}

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

sub do_open_dport { ## Private
   local(@foo, $port) = &chat'open_listen;
   ($port, $Data_handle) = splice(@foo, 4, 2);

   unless ($Data_handle) {
       $ftp_error =  "Unable to open data port: $!";
       return undef;
   }

   push(@foo, $port >> 8, $port & 0xff);
   local($myhost) = (join(',', @foo));

   &do_ftp_cmd(200, "port $myhost");
}

#######################################################
#
#  To cleanup after a problem
#

sub do_ftp_abort {
   die unless $NeedsClose;

   &chat'print($Control, "abor", "\r\n");
   &chat'close($Data_handle);
   &chat'expect($Control, 10, '.', undef);
   &chat'close($Control);

   close DFILE;
   unlink($NeedsCleanup) if $NeedsCleanup;
   die;
}

#######################################################
#
#  To set signals to do the abort properly
#

sub do_ftp_signals {
   local($flag, $sig) = @_;

   local ($old, $new) = ('DEFAULT', "ftp'do_ftp_abort");
   $flag || (($old, $new) = ($new, $old));
   foreach $sig (@sigs) {
       ($SIG{$sig} == $old) && ($SIG{$sig} = $new);
   }
}

1;

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.