lib/perl5/5.6.1/ftp.pl

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