home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / SLAKWARE / D12 / PERL1.TGZ / perl1.tar / usr / lib / perl5 / ftp.pl < prev    next >
Perl Script  |  1996-06-28  |  24KB  |  1,077 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: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.17 1993/04/21 10:06:54 lmjm Exp lmjm $
  9. # $Log: ftp.pl,v $
  10. # Revision 1.17  1993/04/21  10:06:54  lmjm
  11. # Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
  12. # Allow target file to be '-' meaning STDOUT
  13. # Added ftp'quote
  14. #
  15. # Revision 1.16  1993/01/28  18:59:05  lmjm
  16. # Allow socket arguemtns to come from main.
  17. # Minor cleanups - removed old comments.
  18. #
  19. # Revision 1.15  1992/11/25  21:09:30  lmjm
  20. # Added another REST return code.
  21. #
  22. # Revision 1.14  1992/08/12  14:33:42  lmjm
  23. # Fail ftp'write if out of space.
  24. #
  25. # Revision 1.13  1992/03/20  21:01:03  lmjm
  26. # Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
  27. # Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
  28. #
  29. # Revision 1.12  1992/02/06  23:25:56  lmjm
  30. # Moved code around so can use this as a lib for both mirror and ftpmail.
  31. # Time out opens.  In case Unix doesn't bother to.
  32. #
  33. # Revision 1.11  1991/11/27  22:05:57  lmjm
  34. # Match the response code number at the start of a line allowing
  35. # for any leading junk.
  36. #
  37. # Revision 1.10  1991/10/23  22:42:20  lmjm
  38. # Added better timeout code.
  39. # Tried to optimise file transfer
  40. # Moved open/close code to not leak file handles.
  41. # Cleaned up the alarm code.
  42. # Added $fatalerror to show wether the ftp link is really dead.
  43. #
  44. # Revision 1.9  1991/10/07  18:30:35  lmjm
  45. # Made the timeout-read code work.
  46. # Added restarting file gets.
  47. # Be more verbose if ever have to call die.
  48. #
  49. # Revision 1.8  1991/09/17  22:53:16  lmjm
  50. # Spot when open_data_socket fails and return a failure rather than dying.
  51. #
  52. # Revision 1.7  1991/09/12  22:40:25  lmjm
  53. # Added Andrew Macpherson's patches for hosts without ip forwarding.
  54. #
  55. # Revision 1.6  1991/09/06  19:53:52  lmjm
  56. # Relaid out the code the way I like it!
  57. # Changed the debuggin to produce more "appropriate" messages
  58. # Fixed bugs in the ordering of put and dir listing.
  59. # Allow for hash printing when getting files (a la ftp).
  60. # Added the new commands from Al.
  61. # Don't print passwords in debugging.
  62. #
  63. # Revision 1.5  1991/08/29  16:23:49  lmjm
  64. # Timeout reads from the remote ftp server.
  65. # No longer call die expect on fatal errors.  Just return fail codes.
  66. # Changed returns so higher up routines can tell whats happening.
  67. # Get expect/accept in correct order for dir listing.
  68. # When ftp_show is set then print hashes every 1k transfered (like ftp).
  69. # Allow for stripping returns out of incoming data.
  70. # Save last error in a global string.
  71. #
  72. # Revision 1.4  1991/08/14  21:04:58  lmjm
  73. # ftp'get now copes with ungetable files.
  74. # ftp'expect code changed such that the string_to_print is
  75. # ignored and the string sent back from the remote system is printed
  76. # instead.
  77. # Implemented patches from al.  Removed spuiours tracing statements.
  78. #
  79. # Revision 1.3  1991/08/09  21:32:18  lmjm
  80. # Allow for another ok code on cwd's
  81. # Rejigger the log levels
  82. # Send \r\n for some odd ftp daemons
  83. #
  84. # Revision 1.2  1991/08/09  18:07:37  lmjm
  85. # Don't print messages unless ftp_show says to.
  86. #
  87. # Revision 1.1  1991/08/08  20:31:00  lmjm
  88. # Initial revision
  89. #
  90.  
  91. require 'chat2.pl';
  92. eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
  93.  
  94.  
  95. package ftp;
  96.  
  97. if( defined( &main'PF_INET ) ){
  98.     $pf_inet = &main'PF_INET;
  99.     $sock_stream = &main'SOCK_STREAM;
  100.     local($name, $aliases, $proto) = getprotobyname( 'tcp' );
  101.     $tcp_proto = $proto;
  102. }
  103. else {
  104.     # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
  105.     # but who the heck would change these anyway? (:-)
  106.     $pf_inet = 2;
  107.     $sock_stream = 1;
  108.     $tcp_proto = 6;
  109. }
  110.  
  111. # If the remote ftp daemon doesn't respond within this time presume its dead
  112. # or something.
  113. $timeout = 30;
  114.  
  115. # Timeout a read if I don't get data back within this many seconds
  116. $timeout_read = 20 * $timeout;
  117.  
  118. # Timeout an open
  119. $timeout_open = $timeout;
  120.  
  121. # This is a "global" it contains the last response from the remote ftp server
  122. # for use in error messages
  123. $ftp'response = "";
  124. # Also ftp'NS is the socket containing the data coming in from the remote ls
  125. # command.
  126.  
  127. # The size of block to be read or written when talking to the remote
  128. # ftp server
  129. $ftp'ftpbufsize = 4096;
  130.  
  131. # How often to print a hash out, when debugging
  132. $ftp'hashevery = 1024;
  133. # Output a newline after this many hashes to prevent outputing very long lines
  134. $ftp'hashnl = 70;
  135.  
  136. # If a proxy connection then who am I really talking to?
  137. $real_site = "";
  138.  
  139. # This is just a tracing aid.
  140. $ftp_show = 0;
  141. sub ftp'debug
  142. {
  143.     $ftp_show = @_[0];
  144. #    if( $ftp_show ){
  145. #        print STDERR "ftp debugging on\n";
  146. #    }
  147. }
  148.  
  149. sub ftp'set_timeout
  150. {
  151.     $timeout = @_[0];
  152.     $timeout_open = $timeout;
  153.     $timeout_read = 20 * $timeout;
  154.     if( $ftp_show ){
  155.         print STDERR "ftp timeout set to $timeout\n";
  156.     }
  157. }
  158.  
  159.  
  160. sub ftp'open_alarm
  161. {
  162.     die "timeout: open";
  163. }
  164.  
  165. sub ftp'timed_open
  166. {
  167.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  168.     local( $connect_site, $connect_port );
  169.     local( $res );
  170.  
  171.     alarm( $timeout_open );
  172.  
  173.     while( $attempts-- ){
  174.         if( $ftp_show ){
  175.             print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
  176.             print STDERR "Connecting to $site";
  177.             if( $ftp_port != 21 ){
  178.                 print STDERR " [port $ftp_port]";
  179.             }
  180.             print STDERR "\n";
  181.         }
  182.         
  183.         if( $proxy ) {
  184.             if( ! $proxy_gateway ) {
  185.                 # if not otherwise set
  186.                 $proxy_gateway = "internet-gateway";
  187.             }
  188.             if( $debug ) {
  189.                 print STDERR "using proxy services of $proxy_gateway, ";
  190.                 print STDERR "at $proxy_ftp_port\n";
  191.             }
  192.             $connect_site = $proxy_gateway;
  193.             $connect_port = $proxy_ftp_port;
  194.             $real_site = $site;
  195.         }
  196.         else {
  197.             $connect_site = $site;
  198.             $connect_port = $ftp_port;
  199.         }
  200.         if( ! &chat'open_port( $connect_site, $connect_port ) ){
  201.             if( $retry_call ){
  202.                 print STDERR "Failed to connect\n" if $ftp_show;
  203.                 next;
  204.             }
  205.             else {
  206.                 print STDERR "proxy connection failed " if $proxy;
  207.                 print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
  208.                 return 0;
  209.             }
  210.         }
  211.         $res = &ftp'expect( $timeout,
  212.                     120, "service unavailable to $site", 0, 
  213.                                 220, "ready for login to $site", 1,
  214.                     421, "service unavailable to $site, closing connection", 0);
  215.         if( ! $res ){
  216.             &chat'close();
  217.             next;
  218.         }
  219.         return 1;
  220.     }
  221.     continue {
  222.         print STDERR "Pausing between retries\n";
  223.         sleep( $retry_pause );
  224.     }
  225.     return 0;
  226. }
  227.  
  228. sub ftp'open
  229. {
  230.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  231.  
  232.     $SIG{ 'ALRM' } = "ftp\'open_alarm";
  233.  
  234.     local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
  235.     alarm( 0 );
  236.  
  237.     if( $@ =~ /^timeout/ ){
  238.         return -1;
  239.     }
  240.     return $ret;
  241. }
  242.  
  243. sub ftp'login
  244. {
  245.     local( $remote_user, $remote_password ) = @_;
  246.  
  247.     if( $proxy ){
  248.         &ftp'send( "USER $remote_user@$site" );
  249.     }
  250.     else {
  251.         &ftp'send( "USER $remote_user" );
  252.     }
  253.         local( $val ) =
  254.                &ftp'expect($timeout,
  255.                230, "$remote_user logged in", 1,
  256.            331, "send password for $remote_user", 2,
  257.  
  258.            500, "syntax error", 0,
  259.            501, "syntax error", 0,
  260.            530, "not logged in", 0,
  261.            332, "account for login not supported", 0,
  262.  
  263.            421, "service unavailable, closing connection", 0);
  264.     if( $val == 1 ){
  265.         return 1;
  266.     }
  267.     if( $val == 2 ){
  268.         # A password is needed
  269.         &ftp'send( "PASS $remote_password" );
  270.  
  271.         $val = &ftp'expect( $timeout,
  272.            230, "$remote_user logged in", 1,
  273.  
  274.            202, "command not implemented", 0,
  275.            332, "account for login not supported", 0,
  276.  
  277.            530, "not logged in", 0,
  278.            500, "syntax error", 0,
  279.            501, "syntax error", 0,
  280.            503, "bad sequence of commands", 0, 
  281.  
  282.            421, "service unavailable, closing connection", 0);
  283.         if( $val == 1){
  284.             # Logged in
  285.             return 1;
  286.         }
  287.     }
  288.     # If I got here I failed to login
  289.     return 0;
  290. }
  291.  
  292. sub ftp'close
  293. {
  294.     &ftp'quit();
  295.     &chat'close();
  296. }
  297.  
  298. # Change directory
  299. # return 1 if successful
  300. # 0 on a failure
  301. sub ftp'cwd
  302. {
  303.     local( $dir ) = @_;
  304.  
  305.     &ftp'send( "CWD $dir" );
  306.  
  307.     return &ftp'expect( $timeout,
  308.         200, "working directory = $dir", 1,
  309.         250, "working directory = $dir", 1,
  310.  
  311.         500, "syntax error