lib/ftp.pl

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