home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / ftp.pl < prev    next >
Text File  |  1997-05-19  |  24KB  |  1,092 lines
  1. #-*-perl-*-
  2. # This is a wrapper to the chat2.pl routines that make life easier
  3. # to do ftp type work.
  4. # Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  5. # based on original version by Alan R. Martello <al@ee.pitt.edu>
  6. # And by A.Macpherson@bnr.co.uk for multi-homed hosts
  7. #
  8. # $Header: /home/neeri/MacCVS/MacPerl/perl/lib/ftp.pl,v 1.4 1997/05/19 20:25:44 neeri Exp $
  9. # $Log: ftp.pl,v $
  10. # Revision 1.4  1997/05/19 20:25:44  neeri
  11. # 5.004 merge, round 2
  12. #
  13. # Revision 1.3  1997/05/19 12:32:01  neeri
  14. # 5.004 merge, round 1
  15. #
  16. # Revision 1.1.1.2  1997/05/17 21:41:21  neeri
  17. # Import of Perl 5.004
  18. #
  19. # Revision 1.2  1997/04/07 20:51:51  neeri
  20. # Synchronized with MacPerl 5.1.4a1
  21. #
  22. # Revision 1.1.1.1  1997/04/06 21:06:28  neeri
  23. # Import of Perl 5.002
  24. #
  25. # Revision 1.17  1993/04/21  10:06:54  lmjm
  26. # Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
  27. # Allow target file to be '-' meaning STDOUT
  28. # Added ftp'quote
  29. #
  30. # Revision 1.16  1993/01/28  18:59:05  lmjm
  31. # Allow socket arguemtns to come from main.
  32. # Minor cleanups - removed old comments.
  33. #
  34. # Revision 1.15  1992/11/25  21:09:30  lmjm
  35. # Added another REST return code.
  36. #
  37. # Revision 1.14  1992/08/12  14:33:42  lmjm
  38. # Fail ftp'write if out of space.
  39. #
  40. # Revision 1.13  1992/03/20  21:01:03  lmjm
  41. # Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
  42. # Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
  43. #
  44. # Revision 1.12  1992/02/06  23:25:56  lmjm
  45. # Moved code around so can use this as a lib for both mirror and ftpmail.
  46. # Time out opens.  In case Unix doesn't bother to.
  47. #
  48. # Revision 1.11  1991/11/27  22:05:57  lmjm
  49. # Match the response code number at the start of a line allowing
  50. # for any leading junk.
  51. #
  52. # Revision 1.10  1991/10/23  22:42:20  lmjm
  53. # Added better timeout code.
  54. # Tried to optimise file transfer
  55. # Moved open/close code to not leak file handles.
  56. # Cleaned up the alarm code.
  57. # Added $fatalerror to show wether the ftp link is really dead.
  58. #
  59. # Revision 1.9  1991/10/07  18:30:35  lmjm
  60. # Made the timeout-read code work.
  61. # Added restarting file gets.
  62. # Be more verbose if ever have to call die.
  63. #
  64. # Revision 1.8  1991/09/17  22:53:16  lmjm
  65. # Spot when open_data_socket fails and return a failure rather than dying.
  66. #
  67. # Revision 1.7  1991/09/12  22:40:25  lmjm
  68. # Added Andrew Macpherson's patches for hosts without ip forwarding.
  69. #
  70. # Revision 1.6  1991/09/06  19:53:52  lmjm
  71. # Relaid out the code the way I like it!
  72. # Changed the debuggin to produce more "appropriate" messages
  73. # Fixed bugs in the ordering of put and dir listing.
  74. # Allow for hash printing when getting files (a la ftp).
  75. # Added the new commands from Al.
  76. # Don't print passwords in debugging.
  77. #
  78. # Revision 1.5  1991/08/29  16:23:49  lmjm
  79. # Timeout reads from the remote ftp server.
  80. # No longer call die expect on fatal errors.  Just return fail codes.
  81. # Changed returns so higher up routines can tell whats happening.
  82. # Get expect/accept in correct order for dir listing.
  83. # When ftp_show is set then print hashes every 1k transfered (like ftp).
  84. # Allow for stripping returns out of incoming data.
  85. # Save last error in a global string.
  86. #
  87. # Revision 1.4  1991/08/14  21:04:58  lmjm
  88. # ftp'get now copes with ungetable files.
  89. # ftp'expect code changed such that the string_to_print is
  90. # ignored and the string sent back from the remote system is printed
  91. # instead.
  92. # Implemented patches from al.  Removed spuiours tracing statements.
  93. #
  94. # Revision 1.3  1991/08/09  21:32:18  lmjm
  95. # Allow for another ok code on cwd's
  96. # Rejigger the log levels
  97. # Send \r\n for some odd ftp daemons
  98. #
  99. # Revision 1.2  1991/08/09  18:07:37  lmjm
  100. # Don't print messages unless ftp_show says to.
  101. #
  102. # Revision 1.1  1991/08/08  20:31:00  lmjm
  103. # Initial revision
  104. #
  105.  
  106. require 'chat2.pl';
  107. eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
  108.  
  109.  
  110. package ftp;
  111.  
  112. if( defined( &main'PF_INET ) ){
  113.     $pf_inet = &main'PF_INET;
  114.     $sock_stream = &main'SOCK_STREAM;
  115.     local($name, $aliases, $proto) = getprotobyname( 'tcp' );
  116.     $tcp_proto = $proto;
  117. }
  118. else {
  119.     # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
  120.     # but who the heck would change these anyway? (:-)
  121.     $pf_inet = 2;
  122.     $sock_stream = 1;
  123.     $tcp_proto = 6;
  124. }
  125.  
  126. # If the remote ftp daemon doesn't respond within this time presume its dead
  127. # or something.
  128. $timeout = 30;
  129.  
  130. # Timeout a read if I don't get data back within this many seconds
  131. $timeout_read = 20 * $timeout;
  132.  
  133. # Timeout an open
  134. $timeout_open = $timeout;
  135.  
  136. # This is a "global" it contains the last response from the remote ftp server
  137. # for use in error messages
  138. $ftp'response = "";
  139. # Also ftp'NS is the socket containing the data coming in from the remote ls
  140. # command.
  141.  
  142. # The size of block to be read or written when talking to the remote
  143. # ftp server
  144. $ftp'ftpbufsize = 4096;
  145.  
  146. # How often to print a hash out, when debugging
  147. $ftp'hashevery = 1024;
  148. # Output a newline after this many hashes to prevent outputing very long lines
  149. $ftp'hashnl = 70;
  150.  
  151. # If a proxy connection then who am I really talking to?
  152. $real_site = "";
  153.  
  154. # This is just a tracing aid.
  155. $ftp_show = 0;
  156. sub ftp'debug
  157. {
  158.     $ftp_show = $_[0];
  159. #    if( $ftp_show ){
  160. #        print STDERR "ftp debugging on\n";
  161. #    }
  162. }
  163.  
  164. sub ftp'set_timeout
  165. {
  166.     $timeout = $_[0];
  167.     $timeout_open = $timeout;
  168.     $timeout_read = 20 * $timeout;
  169.     if( $ftp_show ){
  170.         print STDERR "ftp timeout set to $timeout\n";
  171.     }
  172. }
  173.  
  174.  
  175. sub ftp'open_alarm
  176. {
  177.     die "timeout: open";
  178. }
  179.  
  180. sub ftp'timed_open
  181. {
  182.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  183.     local( $connect_site, $connect_port );
  184.     local( $res );
  185.  
  186.     alarm( $timeout_open );
  187.  
  188.     while( $attempts-- ){
  189.         if( $ftp_show ){
  190.             print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
  191.             print STDERR "Connecting to $site";
  192.             if( $ftp_port != 21 ){
  193.                 print STDERR " [port $ftp_port]";
  194.             }
  195.             print STDERR "\n";
  196.         }
  197.         
  198.         if( $proxy ) {
  199.             if( ! $proxy_gateway ) {
  200.                 # if not otherwise set
  201.                 $proxy_gateway = "internet-gateway";
  202.             }
  203.             if( $debug ) {
  204.                 print STDERR "using proxy services of $proxy_gateway, ";
  205.                 print STDERR "at $proxy_ftp_port\n";
  206.             }
  207.             $connect_site = $proxy_gateway;
  208.             $connect_port = $proxy_ftp_port;
  209.             $real_site = $site;
  210.         }
  211.         else {
  212.             $connect_site = $site;
  213.             $connect_port = $ftp_port;
  214.         }
  215.         if( ! &chat'open_port( $connect_site, $connect_port ) ){
  216.             if( $retry_call ){
  217.                 print STDERR "Failed to connect\n" if $ftp_show;
  218.                 next;
  219.             }
  220.             else {
  221.                 print STDERR "proxy connection failed " if $proxy;
  222.                 print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
  223.                 return 0;
  224.             }
  225.         }
  226.         $res = &ftp'expect( $timeout,
  227.                     120, "service unavailable to $site", 0, 
  228.                                 220, "ready for login to $site", 1,
  229.                     421, "service unavailable to $site, closing connection", 0);
  230.         if( ! $res ){
  231.             &chat'close();
  232.             next;
  233.         }
  234.         return 1;
  235.     }
  236.     continue {
  237.         print STDERR "Pausing between retries\n";
  238.         sleep( $retry_pause );
  239.     }
  240.     return 0;
  241. }
  242.  
  243. sub ftp'open
  244. {
  245.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  246.  
  247.     $SIG{ 'ALRM' } = "ftp\'open_alarm";
  248.  
  249.     local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
  250.     alarm( 0 );
  251.  
  252.     if( $@ =~ /^timeout/ ){
  253.         return -1;
  254.     }
  255.     return $ret;
  256. }
  257.  
  258. sub ftp'login
  259. {
  260.     local( $remote_user, $remote_password ) = @_;
  261.  
  262.     if( $proxy ){
  263.         &ftp'send( "USER $remote_user\@$site" );
  264.     }
  265.     else {
  266.         &ftp'send( "USER $remote_user" );
  267.     }
  268.         local( $val ) =
  269.                &ftp'expect($timeout,
  270.                230, "$remote_user logged in", 1,
  271.            331, "send password for $remote_user", 2,
  272.  
  273.            500, "syntax error", 0,
  274.            501, "syntax error", 0,
  275.            530, "not logged in", 0,
  276.            332, "account for login not supported", 0,
  277.  
  278.            421, "service unavailable, closing connection", 0);
  279.     if( $val == 1 ){
  280.         return 1;
  281.     }
  282.     if( $val == 2 ){
  283.         # A password is needed
  284.         &ftp'send( "PASS $remote_password" );
  285.  
  286.         $val = &ftp'expect( $timeout,
  287.            230, "$remote_user logged in", 1,
  288.  
  289.            202, "command not implemented", 0,
  290.            332, "account for login not supported", 0,
  291.  
  292.            530, "not logged in", 0,
  293.            500, "syntax error", 0,
  294.            501, "syntax error", 0,
  295.            503, "bad sequence of commands", 0, 
  296.  
  297.            421, "service unavailable, closing connection", 0);
  298.         if( $val == 1){
  299.             # Logged in
  300.             return 1;
  301.         }
  302.     }
  303.     # If I got here I failed to login
  304.     return 0;
  305. }
  306.  
  307. sub ftp'close
  308. {
  309.     &ftp'quit();
  310.     &chat'close();
  311. }
  312.  
  313. # Change directory
  314. # return 1 if successful
  315. # 0 on a failure
  316. sub ftp'cwd
  317. {
  318.     local( $dir ) = @_;
  319.  
  320.     &ftp'send( "CWD $dir" );
  321.  
  322.     return &ftp'expect( $timeout,
  323.         200, "working directory = $dir", 1,
  324.         250, "working directory = $dir", 1,
  325.  
  326.         500, "syntax error", 0,
  327.         501, "syntax error", 0,
  328.                 502, "command not implemented", 0,
  329.         530, "not logged in", 0,
  330.                 550, "cannot change directory", 0,
  331.         421, "service unavailable, closing connection", 0 );
  332. }
  333.  
  334. # Get a full directory listing:
  335. # &ftp'dir( remote LIST options )
  336. # Start a list goin with the given options.
  337. # Presuming that the remote deamon uses the ls command to generate the
  338. # data to send back then then you can send it some extra options (eg: -lRa)
  339. # return 1 if sucessful and 0 on a failure
  340. sub ftp'dir_open
  341. {
  342.     local( $options ) = @_;
  343.     local( $ret );
  344.     
  345.     if( ! &ftp'open_data_socket() ){
  346.         return 0;
  347.     }
  348.     
  349.     if( $options ){
  350.         &ftp'send( "LIST $options" );
  351.     }
  352.     else {
  353.         &ftp'send( "LIST" );
  354.     }
  355.     
  356.     $ret = &ftp'expect( $timeout,
  357.         150, "reading directory", 1,
  358.     
  359.         125, "data connection already open?", 0,
  360.     
  361.         450, "file unavailable", 0,
  362.         500, "syntax error", 0,
  363.         501, "syntax error", 0,
  364.         502, "command not implemented", 0,
  365.         530, "not logged in", 0,
  366.     
  367.            421, "service unavailable, closing connection", 0 );
  368.     if( ! $ret ){
  369.         &ftp'close_data_socket;
  370.         return 0;
  371.     }
  372.     
  373.     # 
  374.     # the data should be coming at us now
  375.     #
  376.     
  377.     # now accept
  378.     accept(NS,S) || die "accept failed $!";
  379.     
  380.     return 1;
  381. }
  382.  
  383.  
  384. # Close down reading the result of a remote ls command
  385. # return 1 if successful and 0 on failure
  386. sub ftp'dir_close
  387. {
  388.     local( $ret );
  389.  
  390.     # read the close
  391.     #
  392.     $ret = &ftp'expect($timeout,
  393.             226, "", 1,     # transfer complete, closing connection
  394.             250, "", 1,     # action completed
  395.  
  396.             425, "can't open data connection", 0,
  397.             426, "connection closed, transfer aborted", 0,
  398.             451, "action aborted, local error", 0,
  399.             421, "service unavailable, closing connection", 0);
  400.  
  401.     # shut down our end of the socket
  402.     &ftp'close_data_socket;
  403.  
  404.     if( ! $ret ){
  405.         return 0;
  406.     }
  407.  
  408.     return 1;
  409. }
  410.  
  411. # Quit from the remote ftp server
  412. # return 1 if successful and 0 on failure
  413. sub ftp'quit
  414. {
  415.     $site_command_check = 0;
  416.     @site_command_list = ();
  417.  
  418.     &ftp'send("QUIT");
  419.  
  420.     return &ftp'expect($timeout, 
  421.         221, "Goodbye", 1,     # transfer complete, closing connection
  422.     
  423.         500, "error quitting??", 0);
  424. }
  425.  
  426. sub ftp'read_alarm
  427. {
  428.     die "timeout: read";
  429. }
  430.  
  431. sub ftp'timed_read
  432. {
  433.     alarm( $timeout_read );
  434.     return sysread( NS, $buf, $ftpbufsize );
  435. }
  436.  
  437. sub ftp'read
  438. {
  439.     $SIG{ 'ALRM' } = "ftp\'read_alarm";
  440.  
  441.     local( $ret ) = eval '&timed_read()';
  442.     alarm( 0 );
  443.  
  444.     if( $@ =~ /^timeout/ ){
  445.         return -1;
  446.     }
  447.     return $ret;
  448. }
  449.  
  450. # Get a remote file back into a local file.
  451. # If no loc_fname passed then uses rem_fname.
  452. # returns 1 on success and 0 on failure
  453. sub ftp'get
  454. {
  455.     local($rem_fname, $loc_fname, $restart ) = @_;
  456.     
  457.     if ($loc_fname eq "") {
  458.         $loc_fname = $rem_fname;
  459.     }
  460.     
  461.     if( ! &ftp'open_data_socket() ){
  462.         print STDERR "Cannot open data socket\n";
  463.         return 0;
  464.     }
  465.  
  466.     if( $loc_fname ne '-' ){
  467.         # Find the size of the target file
  468.         local( $restart_at ) = &ftp'filesize( $loc_fname );
  469.         if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
  470.             $restart = 1;
  471.             # Make sure the file can be updated
  472.             chmod( 0644, $loc_fname );
  473.         }
  474.         else {
  475.             $restart = 0;
  476.             unlink( $loc_fname );
  477.         }
  478.     }
  479.  
  480.     &ftp'send( "RETR $rem_fname" );
  481.     
  482.     local( $ret ) =
  483.         &ftp'expect($timeout, 
  484.                    150, "receiving $rem_fname", 1,
  485.  
  486.                    125, "data connection already open?", 0,
  487.  
  488.                    450, "file unavailable", 2,
  489.                    550, "file unavailable", 2,
  490.  
  491.            500, "syntax error", 0,
  492.            501, "syntax error", 0,
  493.            530, "not logged in", 0,
  494.  
  495.            421, "service unavailable, closing connection", 0);
  496.     if( $ret != 1 ){
  497.         print STDERR "Failure on RETR command\n";
  498.  
  499.         # shut down our end of the socket
  500.         &ftp'close_data_socket;
  501.  
  502.         return 0;
  503.     }
  504.  
  505.     # 
  506.     # the data should be coming at us now
  507.     #
  508.  
  509.     # now accept
  510.     accept(NS,S) || die "accept failed: $!";
  511.  
  512.     #
  513.     #  open the local fname
  514.     #  concatenate on the end if restarting, else just overwrite
  515.     if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
  516.         print STDERR "Cannot create local file $loc_fname\n";
  517.  
  518.         # shut down our end of the socket
  519.         &ftp'close_data_socket;
  520.  
  521.         return 0;
  522.     }
  523.  
  524. #    while (<NS>) {
  525. #        print FH ;
  526. #    }
  527.  
  528.     local( $start_time ) = time;
  529.     local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
  530.     while( ($len = &ftp'read()) > 0 ){
  531.         $bytes += $len;
  532.         if( $strip_cr ){
  533.             $ftp'buf =~ s/\r//g;
  534.         }
  535.         if( $ftp_show ){
  536.             while( $bytes > ($lasthash + $ftp'hashevery) ){
  537.                 print STDERR '#';
  538.                 $lasthash += $ftp'hashevery;
  539.                 $hashes++;
  540.                 if( ($hashes % $ftp'hashnl) == 0 ){
  541.                     print STDERR "\n";
  542.                 }
  543.             }
  544.         }
  545.         if( ! print FH $ftp'buf ){
  546.             print STDERR "\nfailed to write data";
  547.             return 0;
  548.         }
  549.     }
  550.     close( FH );
  551.  
  552.     # shut down our end of the socket
  553.     &ftp'close_data_socket;
  554.  
  555.     if( $len < 0 ){
  556.         print STDERR "\ntimed out reading data!\n";
  557.  
  558.         return 0;
  559.     }
  560.         
  561.     if( $ftp_show ){
  562.         if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
  563.             print STDERR "\n";
  564.         }
  565.         local( $secs ) = (time - $start_time);
  566.         if( $secs <= 0 ){
  567.             $secs = 1; # To avoid a divide by zero;
  568.         }
  569.  
  570.         local( $rate ) = int( $bytes / $secs );
  571.         print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
  572.     }
  573.  
  574.     #
  575.     # read the close
  576.     #
  577.  
  578.     $ret = &ftp'expect($timeout, 
  579.         226, "Got file", 1,     # transfer complete, closing connection
  580.             250, "Got file", 1,     # action completed
  581.     
  582.             110, "restart not supported", 0,
  583.             425, "can't open data connection", 0,
  584.             426, "connection closed, transfer aborted", 0,
  585.             451, "action aborted, local error", 0,
  586.         421, "service unavailable, closing connection", 0);
  587.  
  588.     return $ret;
  589. }
  590.  
  591. sub ftp'delete
  592. {
  593.     local( $rem_fname, $val ) = @_;
  594.  
  595.     &ftp'send("DELE $rem_fname" );
  596.     $val = &ftp'expect( $timeout, 
  597.                250,"Deleted $rem_fname", 1,
  598.                550,"Permission denied",0
  599.                );
  600.     return $val == 1;
  601. }
  602.  
  603. sub ftp'deldir
  604. {
  605.     local( $fname ) = @_;
  606.  
  607.     # not yet implemented
  608.     # RMD
  609. }
  610.  
  611. # UPDATE ME!!!!!!
  612. # Add in the hash printing and newline conversion
  613. sub ftp'put
  614. {
  615.     local( $loc_fname, $rem_fname ) = @_;
  616.     local( $strip_cr );
  617.     
  618.     if ($loc_fname eq "") {
  619.         $loc_fname = $rem_fname;
  620.     }
  621.     
  622.     if( ! &ftp'open_data_socket() ){
  623.         return 0;
  624.     }
  625.     
  626.     &ftp'send("STOR $rem_fname");
  627.     
  628.     # 
  629.     # the data should be coming at us now
  630.     #
  631.     
  632.     local( $ret ) =
  633.     &ftp'expect($timeout, 
  634.         150, "sending $loc_fname", 1,
  635.  
  636.         125, "data connection already open?", 0,
  637.         450, "file unavailable", 0,
  638.  
  639.         532, "need account for storing files", 0,
  640.         452, "insufficient storage on system", 0,
  641.         553, "file name not allowed", 0,
  642.  
  643.         500, "syntax error", 0,
  644.         501, "syntax error", 0,
  645.         530, "not logged in", 0,
  646.  
  647.         421, "service unavailable, closing connection", 0);
  648.  
  649.     if( $ret != 1 ){
  650.         # shut down our end of the socket
  651.         &ftp'close_data_socket;
  652.  
  653.         return 0;
  654.     }
  655.  
  656.  
  657.     # 
  658.     # the data should be coming at us now
  659.     #
  660.     
  661.     # now accept
  662.     accept(NS,S) || die "accept failed: $!";
  663.     
  664.     #
  665.     #  open the local fname
  666.     #
  667.     if( !open(FH, "<$loc_fname") ){
  668.         print STDERR "Cannot open local file $loc_fname\n";
  669.  
  670.         # shut down our end of the socket
  671.         &ftp'close_data_socket;
  672.  
  673.         return 0;
  674.     }
  675.     
  676.     while (<FH>) {
  677.         print NS ;
  678.     }
  679.     close(FH);
  680.     
  681.     # shut down our end of the socket to signal EOF
  682.     &ftp'close_data_socket;
  683.     
  684.     #
  685.     # read the close
  686.     #
  687.     
  688.     $ret = &ftp'expect($timeout, 
  689.         226, "file put", 1,     # transfer complete, closing connection
  690.         250, "file put", 1,     # action completed
  691.     
  692.         110, "restart not supported", 0,
  693.         425, "can't open data connection", 0,
  694.         426, "connection closed, transfer aborted", 0,
  695.         451, "action aborted, local error", 0,
  696.         551, "page type unknown", 0,
  697.         552, "storage allocation exceeded", 0,
  698.     
  699.         421, "service unavailable, closing connection", 0);
  700.     if( ! $ret ){
  701.         print STDERR "error putting $loc_fname\n";
  702.     }
  703.     return $ret;
  704. }
  705.  
  706. sub ftp'restart
  707. {
  708.     local( $restart_point, $ret ) = @_;
  709.  
  710.     &ftp'send("REST $restart_point");
  711.  
  712.     # 
  713.     # see what they say
  714.  
  715.     $ret = &ftp'expect($timeout, 
  716.                350, "restarting at $restart_point", 1,
  717.                
  718.                500, "syntax error", 0,
  719.                501, "syntax error", 0,
  720.                502, "REST not implemented", 2,
  721.                530, "not logged in", 0,
  722.                554, "REST not implemented", 2,
  723.                
  724.                421, "service unavailable, closing connection", 0);
  725.     return $ret;
  726. }
  727.  
  728. # Set the file transfer type
  729. sub ftp'type
  730. {
  731.     local( $type ) = @_;
  732.  
  733.     &ftp'send("TYPE $type");
  734.  
  735.     # 
  736.     # see what they say
  737.  
  738.     $ret = &ftp'expect($timeout, 
  739.                200, "file type set to $type", 1,
  740.                
  741.                500, "syntax error", 0,
  742.                501, "syntax error", 0,
  743.                504, "Invalid form or byte size for type $type", 0,
  744.                
  745.                421, "service unavailable, closing connection", 0);
  746.     return $ret;
  747. }
  748.  
  749. $site_command_check = 0;
  750. @site_command_list = ();
  751.  
  752. # routine to query the remote server for 'SITE' commands supported
  753. sub ftp'site_commands
  754. {
  755.     local( $ret );
  756.     
  757.     # if we havent sent a 'HELP SITE', send it now
  758.     if( !$site_command_check ){
  759.     
  760.         $site_command_check = 1;
  761.     
  762.         &ftp'send( "HELP SITE" );
  763.     
  764.         # assume the line in the HELP SITE response with the 'HELP'
  765.         # command is the one for us
  766.         $ret = &ftp'expect( $timeout,
  767.             ".*HELP.*", "", "\$1",
  768.             214, "", "0",
  769.             202, "", "0" );
  770.     
  771.         if( $ret eq "0" ){
  772.             print STDERR "No response from HELP SITE\n" if( $ftp_show );
  773.         }
  774.     
  775.         @site_command_list = split(/\s+/, $ret);
  776.     }
  777.     
  778.     return @site_command_list;
  779. }
  780.  
  781. # return the pwd, or null if we can't get the pwd
  782. sub ftp'pwd
  783. {
  784.     local( $ret, $cwd );
  785.  
  786.     &ftp'send( "PWD" );
  787.  
  788.     # 
  789.     # see what they say
  790.  
  791.     $ret = &ftp'expect( $timeout, 
  792.                257, "working dir is", 1,
  793.                500, "syntax error", 0,
  794.                501, "syntax error", 0,
  795.                502, "PWD not implemented", 0,
  796.                        550, "file unavailable", 0,
  797.  
  798.                421, "service unavailable, closing connection", 0 );
  799.     if( $ret ){
  800.         if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
  801.             $cwd = $1;
  802.         }
  803.     }
  804.     return $cwd;
  805. }
  806.  
  807. # return 1 for success, 0 for failure
  808. sub ftp'mkdir
  809. {
  810.     local( $path ) = @_;
  811.     local( $ret );
  812.  
  813.     &ftp'send( "MKD $path" );
  814.  
  815.     # 
  816.     # see what they say
  817.  
  818.     $ret = &ftp'expect( $timeout, 
  819.                257, "made directory $path", 1,
  820.                
  821.                500, "syntax error", 0,
  822.                501, "syntax error", 0,
  823.                502, "MKD not implemented", 0,
  824.                530, "not logged in", 0,
  825.                        550, "file unavailable", 0,
  826.  
  827.                421, "service unavailable, closing connection", 0 );
  828.     return $ret;
  829. }
  830.  
  831. # return 1 for success, 0 for failure
  832. sub ftp'chmod
  833. {
  834.     local( $path, $mode ) = @_;
  835.     local( $ret );
  836.  
  837.     &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
  838.  
  839.     # 
  840.     # see what they say
  841.  
  842.     $ret = &ftp'expect( $timeout, 
  843.                200, "chmod $mode $path succeeded", 1,
  844.                
  845.                500, "syntax error", 0,
  846.                501, "syntax error", 0,
  847.                502, "CHMOD not implemented", 0,
  848.                530, "not logged in", 0,
  849.                        550, "file unavailable", 0,
  850.  
  851.                421, "service unavailable, closing connection", 0 );
  852.     return $ret;
  853. }
  854.  
  855. # rename a file
  856. sub ftp'rename
  857. {
  858.     local( $old_name, $new_name ) = @_;
  859.     local( $ret );
  860.  
  861.     &ftp'send( "RNFR $old_name" );
  862.  
  863.     # 
  864.     # see what they say
  865.  
  866.     $ret = &ftp'expect( $timeout, 
  867.                350, "", 1,
  868.                
  869.                500, "syntax error", 0,
  870.                501, "syntax error", 0,
  871.                502, "RNFR not implemented", 0,
  872.                530, "not logged in", 0,
  873.                        550, "file unavailable", 0,
  874.                        450, "file unavailable", 0,
  875.                
  876.                421, "service unavailable, closing connection", 0);
  877.  
  878.  
  879.     # check if the "rename from" occurred ok
  880.     if( $ret ) {
  881.         &ftp'send( "RNTO $new_name" );
  882.     
  883.         # 
  884.         # see what they say
  885.     
  886.         $ret = &ftp'expect( $timeout, 
  887.                        250, "rename $old_name to $new_name", 1, 
  888.  
  889.                    500, "syntax error", 0,
  890.                    501, "syntax error", 0,
  891.                    502, "RNTO not implemented", 0,
  892.                    503, "bad sequence of commands", 0,
  893.                    530, "not logged in", 0,
  894.                            532, "need account for storing files", 0,
  895.                            553, "file name not allowed", 0,
  896.                    
  897.                    421, "service unavailable, closing connection", 0);
  898.     }
  899.  
  900.     return $ret;
  901. }
  902.  
  903.  
  904. sub ftp'quote
  905. {
  906.       local( $cmd ) = @_;
  907.  
  908.       &ftp'send( $cmd );
  909.  
  910.       return &ftp'expect( $timeout, 
  911.               200, "Remote '$cmd' OK", 1,
  912.               500, "error in remote '$cmd'", 0 );
  913. }
  914.  
  915. # ------------------------------------------------------------------------------
  916. # These are the lower level support routines
  917.  
  918. sub ftp'expectgot
  919. {
  920.     ($ftp'response, $ftp'fatalerror) = @_;
  921.     if( $ftp_show ){
  922.         print STDERR "$ftp'response\n";
  923.     }
  924. }
  925.  
  926. #
  927. #  create the list of parameters for chat'expect
  928. #
  929. #  ftp'expect(time_out, {value, string_to_print, return value});
  930. #     if the string_to_print is "" then nothing is printed
  931. #  the last response is stored in $ftp'response
  932. #
  933. # NOTE: lmjm has changed this code such that the string_to_print is
  934. # ignored and the string sent back from the remote system is printed
  935. # instead.
  936. #
  937. sub ftp'expect {
  938.     local( $ret );
  939.     local( $time_out );
  940.     local( $expect_args );
  941.     
  942.     $ftp'response = '';
  943.     $ftp'fatalerror = 0;
  944.  
  945.     @expect_args = ();
  946.     
  947.     $time_out = shift(@_);
  948.     
  949.     while( @_ ){
  950.         local( $code ) = shift( @_ );
  951.         local( $pre ) = '^';
  952.         if( $code =~ /^\d/ ){
  953.             $pre =~ "[.|\n]*^";
  954.         }
  955.         push( @expect_args, "$pre(" . $code . " .*)\\015\\012" );
  956.         shift( @_ );
  957.         push( @expect_args, 
  958.             "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
  959.     }
  960.     
  961.     # Treat all unrecognised lines as continuations
  962.     push( @expect_args, "^(.*)\\015\\012" );
  963.     push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
  964.     
  965.     # add patterns TIMEOUT and EOF
  966.     
  967.     push( @expect_args, 'TIMEOUT' );
  968.     push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
  969.     
  970.     push( @expect_args, 'EOF' );
  971.     push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
  972.     
  973.     if( $ftp_show > 9 ){
  974.         &printargs( $time_out, @expect_args );
  975.     }
  976.     
  977.     $ret = &chat'expect( $time_out, @expect_args );
  978.     if( $ret == 100 ){
  979.         # we saw a continuation line, wait for the end
  980.         push( @expect_args, "^.*\n" );
  981.         push( @expect_args, "100" );
  982.     
  983.         while( $ret == 100 ){
  984.             $ret = &chat'expect( $time_out, @expect_args );
  985.         }
  986.     }
  987.     
  988.     return $ret;
  989. }
  990.  
  991. #
  992. #  opens NS for io
  993. #
  994. sub ftp'open_data_socket
  995. {
  996.     local( $ret );
  997.     local( $hostname );
  998.     local( $sockaddr, $name, $aliases, $proto, $port );
  999.     local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
  1000.     local( $mysockaddr, $family, $hi, $lo );
  1001.     
  1002.     
  1003.     $sockaddr = 'S n a4 x8';
  1004.     chop( $hostname = `hostname` );
  1005.     
  1006.     $port = "ftp";
  1007.     
  1008.     ($name, $aliases, $proto) = getprotobyname( 'tcp' );
  1009.     ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
  1010.     
  1011. #    ($name, $aliases, $type, $len, $thisaddr) =
  1012. #    gethostbyname( $hostname );
  1013.     ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
  1014.     
  1015. #    $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
  1016.     $this = $chat'thisproc;
  1017.     
  1018.     socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
  1019.     bind(S, $this) || die "bind: $!";
  1020.     
  1021.     # get the port number
  1022.     $mysockaddr = getsockname(S);
  1023.     ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
  1024.     
  1025.     $hi = ($port >> 8) & 0x00ff;
  1026.     $lo = $port & 0x00ff;
  1027.     
  1028.     #
  1029.     # we MUST do a listen before sending the port otherwise
  1030.     # the PORT may fail
  1031.     #
  1032.     listen( S, 5 ) || die "listen";
  1033.     
  1034.     &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
  1035.     
  1036.     return &ftp'expect($timeout,
  1037.         200, "PORT command successful", 1,
  1038.         250, "PORT command successful", 1 ,
  1039.  
  1040.         500, "syntax error", 0,
  1041.         501, "syntax error", 0,
  1042.         530, "not logged in", 0,
  1043.  
  1044.         421, "service unavailable, closing connection", 0);
  1045. }
  1046.     
  1047. sub ftp'close_data_socket
  1048. {
  1049.     close(NS);
  1050. }
  1051.  
  1052. sub ftp'send
  1053. {
  1054.     local($send_cmd) = @_;
  1055.     if( $send_cmd =~ /\n/ ){
  1056.         print STDERR "ERROR, \\n in send string for $send_cmd\n";
  1057.     }
  1058.     
  1059.     if( $ftp_show ){
  1060.         local( $sc ) = $send_cmd;
  1061.  
  1062.         if( $send_cmd =~ /^PASS/){
  1063.             $sc = "PASS <somestring>";
  1064.         }
  1065.         print STDERR "---> $sc\n";
  1066.     }
  1067.     
  1068.     &chat'print( "$send_cmd\015\012" );
  1069. }
  1070.  
  1071. sub ftp'printargs
  1072. {
  1073.     while( @_ ){
  1074.         print STDERR shift( @_ ) . "\n";
  1075.     }
  1076. }
  1077.  
  1078. sub ftp'filesize
  1079. {
  1080.     local( $fname ) = @_;
  1081.  
  1082.     if( ! -f $fname ){
  1083.         return -1;
  1084.     }
  1085.  
  1086.     return (stat( _ ))[ 7 ];
  1087.     
  1088. }
  1089.  
  1090. # make this package return true
  1091. 1;
  1092.