#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#               "End of shell archive."
# Contents:  ftp.pl ftpget ftpget.1
# Wrapped by maffeis@sebastian on Mon Jul 27 18:14:03 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ftp.pl' -a "${1}" != "-c" ; then
 echo shar: Will not clobber existing file \"'ftp.pl'\"
else
echo shar: Extracting \"'ftp.pl'\" \(22453 characters\)
sed "s/^X//" >'ftp.pl' <<'END_OF_FILE'
X#-*-perl-*-
X# This is a wrapper to the chat2.pl routines that make life easier
X# to do ftp type work.
X# Written by Alan R. Martello <[email protected]>
X# Some bug fixes and extensions by Lee McLoughlin <[email protected]>
X# And by [email protected] for multi-homed hosts
X#
X# $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.13 1992/03/20 21:01:03 lmjm Exp lmjm $
X# $Log: ftp.pl,v $
X# Revision 1.13  1992/03/20  21:01:03  lmjm
X# Added in the proxy ftp code from Edwards Reed <[email protected]>
X# Added  ftp'delete from Aaron Wohl <[email protected]>
X#
X# Revision 1.12  1992/02/06  23:25:56  lmjm
X# Moved code around so can use this as a lib for both mirror and ftpmail.
X# Time out opens.  In case Unix doesn't bother to.
X#
X# Revision 1.11  1991/11/27  22:05:57  lmjm
X# Match the response code number at the start of a line allowing
X# for any leading junk.
X#
X# Revision 1.10  1991/10/23  22:42:20  lmjm
X# Added better timeout code.
X# Tried to optimise file transfer
X# Moved open/close code to not leak file handles.
X# Cleaned up the alarm code.
X# Added $fatalerror to show wether the ftp link is really dead.
X#
X# Revision 1.9  1991/10/07  18:30:35  lmjm
X# Made the timeout-read code work.
X# Added restarting file gets.
X# Be more verbose if ever have to call die.
X#
X# Revision 1.8  1991/09/17  22:53:16  lmjm
X# Spot when open_data_socket fails and return a failure rather than dying.
X#
X# Revision 1.7  1991/09/12  22:40:25  lmjm
X# Added Andrew Macpherson's patches for hosts without ip forwarding.
X#
X# Revision 1.6  1991/09/06  19:53:52  lmjm
X# Relaid out the code the way I like it!
X# Changed the debuggin to produce more "appropriate" messages
X# Fixed bugs in the ordering of put and dir listing.
X# Allow for hash printing when getting files (a la ftp).
X# Added the new commands from Al.
X# Don't print passwords in debugging.
X#
X# Revision 1.5  1991/08/29  16:23:49  lmjm
X# Timeout reads from the remote ftp server.
X# No longer call die expect on fatal errors.  Just return fail codes.
X# Changed returns so higher up routines can tell whats happening.
X# Get expect/accept in correct order for dir listing.
X# When ftp_show is set then print hashes every 1k transfered (like ftp).
X# Allow for stripping returns out of incoming data.
X# Save last error in a global string.
X#
X# Revision 1.4  1991/08/14  21:04:58  lmjm
X# ftp'get now copes with ungetable files.
X# ftp'expect code changed such that the string_to_print is
X# ignored and the string sent back from the remote system is printed
X# instead.
X# Implemented patches from al.  Removed spuiours tracing statements.
X#
X# Revision 1.3  1991/08/09  21:32:18  lmjm
X# Allow for another ok code on cwd's
X# Rejigger the log levels
X# Send \r\n for some odd ftp daemons
X#
X# Revision 1.2  1991/08/09  18:07:37  lmjm
X# Don't print messages unless ftp_show says to.
X#
X# Revision 1.1  1991/08/08  20:31:00  lmjm
X# Initial revision
X#
X
Xrequire 'chat2.pl';
Xrequire 'socket.ph';
X
X
Xpackage ftp;
X
X# If the remote ftp daemon doesn't respond within this time presume its dead
X# or something.
X$timeout = 30;
X
X# Timeout a read if I don't get data back within this many seconds
X$timeout_read = 20 * $timeout;
X
X# Timeout an open
X$timeout_open = $timeout;
X
X# This is a "global" it contains the last response from the remote ftp server
X# for use in error messages
X$ftp'response = "";
X# Also ftp'NS is the socket containing the data coming in from the remote ls
X# command.
X
X# The size of block to be read or written when talking to the remote
X# ftp server
X$ftp'ftpbufsize = 4096;
X
X# How often to print a hash out, when debugging
X$ftp'hashevery = 1024;
X# Output a newline after this many hashes to prevent outputing very long lines
X$ftp'hashnl = 70;
X
X# If a proxy connection then who am I really talking to?
X$real_site = "";
X
X# This is just a tracing aid.
X$ftp_show = 0;
Xsub ftp'debug
X{
X       $ftp_show = @_[0];
X#      if( $ftp_show ){
X#              print "ftp debugging on\n";
X#      }
X}
X
Xsub ftp'set_timeout
X{
X       $timeout = @_[0];
X       $timeout_open = $timeout;
X       $timeout_read = 20 * $timeout;
X       if( $ftp_show ){
X               print "ftp timeout set to $timeout\n";
X       }
X}
X
X
Xsub ftp'open_alarm
X{
X       die "timeout: open";
X}
X
Xsub ftp'timed_open
X{
X       local( $site, $ftp_port, $retry_call, $attempts ) = @_;
X       local( $connect_site, $connect_port );
X       local( $res );
X
X       alarm( $timeout_open );
X
X       while( $attempts-- ){
X               if( $ftp_show ){
X                       print "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
X                       print "Connecting to $site";
X                       if( $ftp_port != 21 ){
X                               print " [port $ftp_port]";
X                       }
X                       print "\n";
X               }
X
X               if( $proxy ) {
X                       if( ! $proxy_gateway ) {
X                               # if not otherwise set
X                               $proxy_gateway = "internet-gateway";
X                       }
X                       if( $debug ) {
X                               print "using proxy services of $proxy_gateway, ";
X                               print "at $proxy_ftp_port\n";
X                       }
X                       $connect_site = $proxy_gateway;
X                       $connect_port = $proxy_ftp_port;
X                       $real_site = $site;
X               }
X               else {
X                       $connect_site = $site;
X                       $connect_port = $ftp_port;
X               }
X               if( ! &chat'open_port( $connect_site, $connect_port ) ){
X                       if( $retry_call ){
X                               print "Failed to connect\n" if $ftp_show;
X                               next;
X                       }
X                       else {
X                               print "proxy connection failed " if $proxy;
X                               print "Cannot open ftp to $connect_site\n" if $ftp_show;
X                               return 0;
X                       }
X               }
X               $res = &ftp'expect( $timeout,
X                                   120, "service unavailable to $site", 0,
X                                   220, "ready for login to $site", 1,
X                                   421, "service unavailable to $site, closing connection", 0);
X               if( ! $res ){
X                       &chat'close();
X                       next;
X               }
X               return 1;
X       }
X       continue {
X               print "Pausing between retries\n";
X               sleep( $retry_pause );
X       }
X       return 0;
X}
X
Xsub ftp'open
X{
X       local( $site, $ftp_port, $retry_call, $attempts ) = @_;
X
X       $SIG{ 'ALRM' } = "ftp\'open_alarm";
X
X       local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
X       alarm( 0 );
X
X       if( $@ =~ /^timeout/ ){
X               return -1;
X       }
X       return $ret;
X}
X
Xsub ftp'login
X{
X       local( $remote_user, $remote_password ) = @_;
X
X       if( $proxy ){
X               &ftp'send( "USER $remote_user@$site" );
X       }
X       else {
X               &ftp'send( "USER $remote_user" );
X       }
X        local( $val ) =
X               &ftp'expect($timeout,
X                  230, "$remote_user logged in", 1,
X                  331, "send password for $remote_user", 2,
X
X                  500, "syntax error", 0,
X                  501, "syntax error", 0,
X                  530, "not logged in", 0,
X                  332, "account for login not supported", 0,
X
X                  421, "service unavailable, closing connection", 0);
X       if( $val == 1 ){
X               return 1;
X       }
X       if( $val == 2 ){
X               # A password is needed
X               &ftp'send( "PASS $remote_password" );
X
X               $val = &ftp'expect( $timeout,
X#                 "[.|\n]*^230", "$remote_user logged in", 1,
X                  230, "$remote_user logged in", 1,
X
X                  202, "command not implemented", 0,
X                  332, "account for login not supported", 0,
X
X                  530, "not logged in", 0,
X                  500, "syntax error", 0,
X                  501, "syntax error", 0,
X                  503, "bad sequence of commands", 0,
X
X                  421, "service unavailable, closing connection", 0);
X               if( $val == 1){
X                       # Logged in
X                       return 1;
X               }
X       }
X       # If I got here I failed to login
X       return 0;
X}
X
Xsub ftp'close
X{
X       &ftp'quit();
X       &chat'close();
X}
X
X# Change directory
X# return 1 if successful
X# 0 on a failure
Xsub ftp'cwd
X{
X       local( $dir ) = @_;
X
X       &ftp'send( "CWD $dir" );
X
X       return &ftp'expect( $timeout,
X               200, "working directory = $dir", 1,
X               250, "working directory = $dir", 1,
X
X               500, "syntax error", 0,
X               501, "syntax error", 0,
X                502, "command not implemented", 0,
X               530, "not logged in", 0,
X                550, "cannot change directory", 0,
X               421, "service unavailable, closing connection", 0 );
X}
X
X# Get a full directory listing:
X# &ftp'dir( remote LIST options )
X# Start a list goin with the given options.
X# Presuming that the remote deamon uses the ls command to generate the
X# data to send back then then you can send it some extra options (eg: -lRa)
X# return 1 if sucessful and 0 on a failure
Xsub ftp'dir_open
X{
X       local( $options ) = @_;
X       local( $ret );
X
X       if( ! &ftp'open_data_socket() ){
X               return 0;
X       }
X
X       if( $options ){
X               &ftp'send( "LIST $options" );
X       }
X       else {
X               &ftp'send( "LIST" );
X       }
X
X       $ret = &ftp'expect( $timeout,
X               150, "reading directory", 1,
X
X               125, "data connection already open?", 0,
X
X               450, "file unavailable", 0,
X               500, "syntax error", 0,
X               501, "syntax error", 0,
X               502, "command not implemented", 0,
X               530, "not logged in", 0,
X
X                  421, "service unavailable, closing connection", 0 );
X       if( ! $ret ){
X               &ftp'close_data_socket;
X               return 0;
X       }
X
X       #
X       # the data should be coming at us now
X       #
X
X       # now accept
X       accept(NS,S) || die "accept failed $!";
X
X       return 1;
X}
X
X
X# Close down reading the result of a remote ls command
X# return 1 if successful and 0 on failure
Xsub ftp'dir_close
X{
X       local( $ret );
X
X       # read the close
X       #
X       $ret = &ftp'expect($timeout,
X               226, "", 1,     # transfer complete, closing connection
X               250, "", 1,     # action completed
X
X               425, "can't open data connection", 0,
X               426, "connection closed, transfer aborted", 0,
X               451, "action aborted, local error", 0,
X               421, "service unavailable, closing connection", 0);
X
X       # shut down our end of the socket
X       &ftp'close_data_socket;
X
X       if( ! $ret ){
X               return 0;
X       }
X
X       return 1;
X}
X
X# Quit from the remote ftp server
X# return 1 if successful and 0 on failure
Xsub ftp'quit
X{
X       $site_command_check = 0;
X       @site_command_list = ();
X
X       &ftp'send("QUIT");
X
X       return &ftp'expect($timeout,
X               221, "Goodbye", 1,     # transfer complete, closing connection
X
X               500, "error quitting??", 0);
X}
X
Xsub ftp'read_alarm
X{
X       die "timeout: read";
X}
X
Xsub ftp'timed_read
X{
X       alarm( $timeout_read );
X       return sysread( NS, $buf, $ftpbufsize );
X}
X
Xsub ftp'read
X{
X       $SIG{ 'ALRM' } = "ftp\'read_alarm";
X
X       local( $ret ) = eval '&timed_read()';
X       alarm( 0 );
X
X       if( $@ =~ /^timeout/ ){
X               return -1;
X       }
X       return $ret;
X}
X
X# Get a remote file back into a local file.
X# If no loc_fname passed then uses rem_fname.
X# returns 1 on success and 0 on failure
Xsub ftp'get
X{
X       local($rem_fname, $loc_fname, $restart ) = @_;
X
X       if ($loc_fname eq "") {
X               $loc_fname = $rem_fname;
X       }
X
X       if( ! &ftp'open_data_socket() ){
X               print "Cannot open data socket\n";
X               return 0;
X       }
X
X       # Find the size of the target file
X       local( $restart_at ) = &ftp'filesize( $loc_fname );
X       if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
X               $restart = 1;
X               # Make sure the file can be updated
X               chmod( 0644, $loc_fname );
X       }
X       else {
X               $restart = 0;
X               unlink( $loc_fname );
X       }
X
X       &ftp'send( "RETR $rem_fname" );
X
X       local( $ret ) =
X               &ftp'expect($timeout,
X                   150, "receiving $loc_fname", 1,
X
X                   125, "data connection already open?", 0,
X
X                   450, "file unavailable", 2,
X                   550, "file unavailable", 2,
X
X                  500, "syntax error", 0,
X                  501, "syntax error", 0,
X                  530, "not logged in", 0,
X
X                  421, "service unavailable, closing connection", 0);
X       if( $ret != 1 ){
X               print "Failure on RETR command\n";
X
X               # shut down our end of the socket
X               &ftp'close_data_socket;
X
X               return 0;
X       }
X
X       #
X       # the data should be coming at us now
X       #
X
X       # now accept
X       accept(NS,S) || die "accept failed: $!";
X
X       #
X       #  open the local fname
X       #  concatenate on the end if restarting, else just overwrite
X       if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
X               print "Cannot create local file $loc_fname\n";
X
X               # shut down our end of the socket
X               &ftp'close_data_socket;
X
X               return 0;
X       }
X
X#    while (<NS>) {
X#        print FH ;
X#    }
X
X       local( $start_time ) = time;
X       local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
X       while( ($len = &ftp'read()) > 0 ){
X               $bytes += $len;
X               if( $strip_cr ){
X                       $ftp'buf =~ s/\r//g;
X               }
X               if( $ftp_show ){
X                       while( $bytes > ($lasthash + $ftp'hashevery) ){
X                               print '#';
X                               $lasthash += $ftp'hashevery;
X                               $hashes++;
X                               if( ($hashes % $ftp'hashnl) == 0 ){
X                                       print "\n";
X                               }
X                       }
X               }
X               print FH $ftp'buf;
X       }
X       close( FH );
X
X       # shut down our end of the socket
X       &ftp'close_data_socket;
X
X       if( $len < 0 ){
X               print "\ntimed out reading data!\n";
X
X               return 0;
X       }
X
X       if( $ftp_show ){
X               if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
X                       print "\n";
X               }
X               local( $secs ) = (time - $start_time);
X               if( $secs <= 0 ){
X                       $secs = 1; # To avoid a devide by zero;
X               }
X
X               local( $rate ) = int( $bytes / $secs );
X               print "Got $bytes bytes ($rate bytes/sec)\n";
X       }
X
X       #
X       # read the close
X       #
X
X       $ret = &ftp'expect($timeout,
X               226, "Got file", 1,     # transfer complete, closing connection
X               250, "Got file", 1,     # action completed
X
X               110, "restart not supported", 0,
X               425, "can't open data connection", 0,
X               426, "connection closed, transfer aborted", 0,
X               451, "action aborted, local error", 0,
X               421, "service unavailable, closing connection", 0);
X
X       return $ret;
X}
X
Xsub ftp'delete
X{
X       local( $rem_fname, $val ) = @_;
X
X       &ftp'send("DELE $rem_fname" );
X       $val = &ftp'expect( $timeout,
X                          250,"Deleted $rem_fname", 1,
X                          550,"Permission denied",0
X                          );
X       return $val == 1;
X}
X
Xsub ftp'deldir
X{
X    local( $fname ) = @_;
X
X    # not yet implemented
X    # RMD
X}
X
X# UPDATE ME!!!!!!
X# Add in the hash printing and newline conversion
Xsub ftp'put
X{
X       local( $loc_fname, $rem_fname ) = @_;
X       local( $strip_cr );
X
X       if ($loc_fname eq "") {
X               $loc_fname = $rem_fname;
X       }
X
X       if( ! &ftp'open_data_socket() ){
X               return 0;
X       }
X
X       &ftp'send("STOR $rem_fname");
X
X       #
X       # the data should be coming at us now
X       #
X
X       local( $ret ) =
X       &ftp'expect($timeout,
X               150, "sending $loc_fname", 1,
X
X               125, "data connection already open?", 0,
X               450, "file unavailable", 0,
X
X               532, "need account for storing files", 0,
X               452, "insufficient storage on system", 0,
X               553, "file name not allowed", 0,
X
X               500, "syntax error", 0,
X               501, "syntax error", 0,
X               530, "not logged in", 0,
X
X               421, "service unavailable, closing connection", 0);
X
X       if( $ret != 1 ){
X               # shut down our end of the socket
X               &ftp'close_data_socket;
X
X               return 0;
X       }
X
X
X       #
X       # the data should be coming at us now
X       #
X
X       # now accept
X       accept(NS,S) || die "accept failed: $!";
X
X       #
X       #  open the local fname
X       #
X       if( !open(FH, "<$loc_fname") ){
X               print "Cannot open local file $loc_fname\n";
X
X               # shut down our end of the socket
X               &ftp'close_data_socket;
X
X               return 0;
X       }
X
X       while (<FH>) {
X               print NS ;
X       }
X       close(FH);
X
X       # shut down our end of the socket to signal EOF
X       &ftp'close_data_socket;
X
X       #
X       # read the close
X       #
X
X       $ret = &ftp'expect($timeout,
X               226, "file put", 1,     # transfer complete, closing connection
X               250, "file put", 1,     # action completed
X
X               110, "restart not supported", 0,
X               425, "can't open data connection", 0,
X               426, "connection closed, transfer aborted", 0,
X               451, "action aborted, local error", 0,
X               551, "page type unknown", 0,
X               552, "storage allocation exceeded", 0,
X
X               421, "service unavailable, closing connection", 0);
X       if( ! $ret ){
X               print "error putting $loc_fname\n";
X       }
X       return $ret;
X}
X
Xsub ftp'restart
X{
X       local( $restart_point, $ret ) = @_;
X
X       &ftp'send("REST $restart_point");
X
X       #
X       # see what they say
X
X       $ret = &ftp'expect($timeout,
X                          350, "restarting at $restart_point", 1,
X
X                          500, "syntax error", 0,
X                          501, "syntax error", 0,
X                          502, "REST not i
mplemented", 2,
X                          530, "not logged in", 0,
X
X                          421, "service unavailable, closing connection", 0);
X       return $ret;
X}
X
X# Set the file transfer type
Xsub ftp'type
X{
X       local( $type ) = @_;
X
X       &ftp'send("TYPE $type");
X
X       #
X       # see what they say
X
X       $ret = &ftp'expect($timeout,
X                          200, "file type set to $type", 1,
X
X                          500, "syntax error", 0,
X                          501, "syntax error", 0,
X                          504, "Invalid form or byte size for type $type", 0,
X
X                          421, "service unavailable, closing connection", 0);
X       return $ret;
X}
X
X$site_command_check = 0;
X@site_command_list = ();
X
X# routine to query the remote server for 'SITE' commands supported
Xsub ftp'site_commands
X{
X       local( $ret );
X
X       # if we havent sent a 'HELP SITE', send it now
X       if( !$site_command_check ){
X
X               $site_command_check = 1;
X
X               &ftp'send( "HELP SITE" );
X
X               # assume the line in the HELP SITE response with the 'HELP'
X               # command is the one for us
X               $ret = &ftp'expect( $timeout,
X                       ".*HELP.*", "", "\$1",
X                       214, "", "0",
X                       202, "", "0" );
X
X               if( $ret eq "0" ){
X                       print "No response from HELP SITE\n" if( $ftp_show );
X               }
X
X               @site_command_list = split(/\s+/, $ret);
X       }
X
X       return @site_command_list;
X}
X
X# return the pwd, or null if we can't get the pwd
Xsub ftp'pwd
X{
X       local( $ret, $cwd );
X
X       &ftp'send( "PWD" );
X
X       #
X       # see what they say
X
X       $ret = &ftp'expect( $timeout,
X#                         "257.*\\\"(.*)\\\"", "working directory is \$2", "\$2",
X                          257, "working dir is", 1,
X                          500, "syntax error", 0,
X                          501, "syntax error", 0,
X                          502, "PWD not implemented", 0,
X                          550, "file unavailable", 0,
X
X                          421, "service unavailable, closing connection", 0 );
X       if( $ret ){
X               if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
X                       $cwd = $1;
X               }
X       }
X       return $cwd;
X}
X
X# return 1 for success, 0 for failure
Xsub ftp'mkdir
X{
X       local( $path ) = @_;
X       local( $ret );
X
X       &ftp'send( "MKD $path" );
X
X       #
X       # see what they say
X
X       $ret = &ftp'expect( $timeout,
X                          257, "made directory $path", 1,
X
X                          500, "syntax error", 0,
X                          501, "syntax error", 0,
X                          502, "MKD not implemented", 0,
X                          530, "not logged in", 0,
X                          550, "file unavailable", 0,
X
X                          421, "service unavailable, closing connection", 0 );
X       return $ret;
X}
X
X# return 1 for success, 0 for failure
Xsub ftp'chmod
X{
X       local( $path, $mode ) = @_;
X       local( $ret );
X
X       &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
X
X       #
X       # see what they say
X
X       $ret = &ftp'expect( $timeout,
X                          200, "chmod $mode $path succeeded", 1,
X
X                          500, "syntax error", 0,
X                          501, "syntax error", 0,
X                          502, "CHMOD not implemented", 0,
X                          530, "not logged in", 0,
X                          550, "file unavailable", 0,
X
X                          421, "service unavailable, closing connection", 0 );
X       return $ret;
X}
X
X# rename a file
Xsub ftp'rename
X{
X       local( $old_name, $new_name ) = @_;
X       local( $ret );
X
X       &ftp'send( "RNFR $old_name" );
X
X       #
X       # see what they say
X
X       $ret = &ftp'expect( $timeout,
X
X                          350, "", 1,
X
X                          500, "syntax error", 0,
X                          501, "syntax error", 0,
X                          502, "RNFR not implemented", 0,
X                          530, "not logged in", 0,
X                          550, "file unavailable", 0,
X                          450, "file unavailable", 0,
X
X                          421, "service unavailable, closing connection", 0);
X
X
X       # check if the "rename from" occurred ok
X       if( $ret ) {
X               &ftp'send( "RNTO $new_name" );
X
X               #
X               # see what they say
X
X               $ret = &ftp'expect( $timeout,
X
X                                  250, "rename $old_name to $new_name", 1,
X
X                                  500, "syntax error", 0,
X                                  501, "syntax error", 0,
X                                  502, "RNTO not implemented", 0,
X                                  503, "bad sequence of commands", 0,
X                                  530, "not logged in", 0,
X                                  532, "need account for storing files", 0,
X                                  553, "file name not allowed", 0,
X
X                                  421, "service unavailable, closing connection", 0);
X       }
X
X       return $ret;
X}
X
X# ------------------------------------------------------------------------------
X# These are the lower level support routines
X
Xsub ftp'expectgot
X{
X       ($ftp'response, $ftp'fatalerror) = @_;
X       if( $ftp_show ){
X               print "$ftp'response\n";
X       }
X}
X
X#
X#  create the list of parameters for chat'expect
X#
X#  ftp'expect(time_out, {value, string_to_print, return value});
X#     if the string_to_print is "" then nothing is printed
X#  the last response is stored in $ftp'response
X#
X# NOTE: lmjm has changed this code such that the string_to_print is
X# ignored and the string sent back from the remote system is printed
X# instead.
X#
Xsub ftp'expect {
X       local( $ret );
X       local( $time_out );
X       local( $expect_args );
X
X       $ftp'response = '';
X       $ftp'fatalerror = 0;
X
X       @expect_args = ();
X
X       $time_out = shift(@_);
X
X       while( @_ ){
X               local( $code ) = shift( @_ );
X               local( $pre ) = '^';
X               if( $code =~ /^\d/ ){
X                       $pre =~ "[.|\n]*^";
X               }
X               push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
X               shift( @_ );
X               push( @expect_args,
X                       "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
X       }
X
X       # Treat all unrecognised lines as continuations
X       push( @expect_args, "^(.*)\\015\\n" );
X       push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
X
X       # add patterns TIMEOUT and EOF
X
X       push( @expect_args, 'TIMEOUT' );
X       push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
X
X       push( @expect_args, 'EOF' );
X       push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
X
X       if( $ftp_show > 9 ){
X               &printargs( $time_out, @expect_args );
X       }
X
X       $ret = &chat'expect( $time_out, @expect_args );
X       if( $ret == 100 ){
X               # we saw a continuation line, wait for the end
X               push( @expect_args, "^.*\n" );
X               push( @expect_args, "100" );
X
X               while( $ret == 100 ){
X                       $ret = &chat'expect( $time_out, @expect_args );
X               }
X       }
X
X       return $ret;
X}
X
X#
X#  opens NS for io
X#
Xsub ftp'open_data_socket
X{
X       local( $ret );
X       local( $hostname );
X       local( $sockaddr, $name, $aliases, $proto, $port );
X       local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
X       local( $mysockaddr, $family, $hi, $lo );
X
X
X       $sockaddr = 'S n a4 x8';
X       chop( $hostname = `hostname` );
X
X       $port = "ftp";
X
X       ($name, $aliases, $proto) = getprotobyname( 'tcp' );
X       ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
X
X#      ($name, $aliases, $type, $len, $thisaddr) =
X#      gethostbyname( $hostname );
X       ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
X
X#      $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
X       $this = $chat'thisproc;
X
X       socket(S, &main'PF_INET, &main'SOCK_STREAM, $proto ) || die "socket: $!";
X       bind(S, $this) || die "bind: $!";
X
X       # get the port number
X       $mysockaddr = getsockname(S);
X       ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
X
X       $hi = ($port >> 8) & 0x00ff;
X       $lo = $port & 0x00ff;
X
X       #
X       # we MUST do a listen before sending the port otherwise
X       # the PORT may fail
X       #
X       listen( S, 5 ) || die "listen";
X
X       &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
X
X       return &ftp'expect($timeout, 200, "", 1,
X
X               500, "syntax error", 0,
X               501, "syntax error", 0,
X               530, "not logged in", 0,
X               421, "service unavailable, closing connection", 0);
X}
X
Xsub ftp'close_data_socket
X{
X       close(NS);
X}
X
Xsub ftp'send
X{
X       local($send_cmd) = @_;
X       if( $send_cmd =~ /\n/ ){
X               print "ERROR, \\n in send string for $send_cmd\n";
X       }
X
X       if( $ftp_show ){
X               local( $sc ) = $send_cmd;
X
X               if( $send_cmd =~ /^PASS/){
X                       $sc = "PASS <somestring>";
X               }
X               print "---> $sc\n";
X       }
X
X       &chat'print( "$send_cmd\r\n" );
X}
X
Xsub ftp'printargs
X{
X       while( @_ ){
X               print shift( @_ ) . "\n";
X       }
X}
X
Xsub ftp'filesize
X{
X       local( $fname ) = @_;
X
X       if( ! -f $fname ){
X               return -1;
X       }
X
X       return (stat( _ ))[ 7 ];
X
X}
X
X# make this package return true
X1;
END_OF_FILE
if test 22453 -ne `wc -c <'ftp.pl'`; then
   echo shar: \"'ftp.pl'\" unpacked with wrong size!
fi
chmod +x 'ftp.pl'
# end of 'ftp.pl'
fi
if test -f 'ftpget' -a "${1}" != "-c" ; then
 echo shar: Will not clobber existing file \"'ftpget'\"
else
echo shar: Extracting \"'ftpget'\" \(1174 characters\)
sed "s/^X//" >'ftpget' <<'END_OF_FILE'
X#!/local/bin/perl
X# ftpget. (C) S.Maffeis 1992. [email protected]
X
Xrequire 'ftp.pl';
X
Xsub usage{
X  print STDERR
X    "usage: ftpget remotehost [username passwd] remotefile localfile\n";
X};
X
Xif(scalar(@ARGV) != 3 && scalar(@ARGV) != 5){ &usage(); exit 1;};
X
Xif(scalar(@ARGV) == 3){
X  chop($hostname = `/bin/hostname`);
X
X  if(!&ftp'open(@ARGV[0], 21, 0, 1)){
X    print STDERR "cannot open connection to @ARGV[0]\n";
X    exit 1;
X  };
X  if(!&ftp'login("anonymous", "ftpget@$hostname")){
X    print STDERR "cannot login as anonymous\n";
X    exit 1;
X  };
X  if( ! &ftp'type('I')){
X    print STDERR "cannot set file type to I\n";
X    exit 1;
X  };
X  if(!&ftp'get(@ARGV[1], @ARGV[2])){
X    print STDERR "@ARGV[1]: file not found\n";
X    exit 1;
X  };
X  &ftp'quit();
X
X  exit 0;
X};
X
Xif(!&ftp'open(@ARGV[0], 21, 1, 1)){
X  print STDERR "cannot open connection to @ARGV[0]\n";
X  exit 1;
X};
Xif(!&ftp'login(@ARGV[1], @ARGV[2])){
X  print STDERR "cannot login as @ARGV[1]\n";
X  exit 1;
X};
Xif( ! &ftp'type('I')){
X  print STDERR "cannot set file type to I\n";
X  exit 1;
X};
Xif(!&ftp'get(@ARGV[3], @ARGV[4])){
X  print STDERR "@ARGV[3]: file not found\n";
X  exit 1;
X};
X&ftp'quit();
X
Xexit 0;
X
END_OF_FILE
if test 1174 -ne `wc -c <'ftpget'`; then
   echo shar: \"'ftpget'\" unpacked with wrong size!
fi
chmod +x 'ftpget'
# end of 'ftpget'
fi
if test -f 'ftpget.1' -a "${1}" != "-c" ; then
 echo shar: Will not clobber existing file \"'ftpget.1'\"
else
echo shar: Extracting \"'ftpget.1'\" \(710 characters\)
sed "s/^X//" >'ftpget.1' <<'END_OF_FILE'
X.TH FTPGET 1 "2 March 1992" IfI
X.SH NAME
Xftpget \- automatically get files via ftp
X.SH SYNOPSIS
X.B ftpget
X.I remotehost
X[
X.I username passwd
X]
X.IR remotefile
X.IR localfile
X.br
X.SH DESCRIPTION
XThe program
X.B ftpget
Xis a simple and easy-to-use perl script which allows you to automatically download
Xfiles via ftp. It uses the
X.B ftp.pl
Xpackage written by Alan R. Martello
X<[email protected]> which comes along with the mirror package.
X.SH OPTIONS
XIf you don't specify any
X.IR username
Xand
X.IR passwd
X,then anonymous ftp is performed. Per default,
X.B ftpget
Xuses binary transfer mode.
X.SH EXAMPLE
Xftpget claude.ifi.unizh.ch pub/techreports INDEX INDEX
X.SH AUTHOR
XSilvano Maffeis <[email protected]> March 1992
END_OF_FILE
if test 710 -ne `wc -c <'ftpget.1'`; then
   echo shar: \"'ftpget.1'\" unpacked with wrong size!
fi
# end of 'ftpget.1'
fi
echo shar: End of shell archive.
exit 0
--
Silvano Maffeis    CS Dept. University of Zurich, Switzerland
 RFC822: [email protected]          voice: +411 257 43 27
 X.400:   C=CH; ADMD=ARCOM; PRMD=SWITCH; O=UNIZH; S=MAFFEIS;

You are viewing proxied material from gopher.floodgap.com. 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.