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 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", 0,
 312                 501, "syntax error", 0,
 313                 502, "command not implemented", 0,
 314                 530, "not logged in", 0,
 315                 550, "cannot change directory", 0,
 316                 421, "service unavailable, closing connection", 0 );
 317 }
 318
 319 # Get a full directory listing:
 320 # &ftp'dir( remote LIST options )
 321 # Start a list goin with the given options.
 322 # Presuming that the remote deamon uses the ls command to generate the
 323 # data to send back then then you can send it some extra options (eg: -lRa)
 324 # return 1 if sucessful and 0 on a failure
 325 sub ftp'dir_open
 326 {
 327         local( $options ) = @_;
 328         local( $ret );
 329
 330         if( ! &ftp'open_data_socket() ){
 331                 return 0;
 332         }
 333
 334         if( $options ){
 335                 &ftp'send( "LIST $options" );
 336         }
 337         else {
 338                 &ftp'send( "LIST" );
 339         }
 340
 341         $ret = &ftp'expect( $timeout,
 342                 150, "reading directory", 1,
 343
 344                 125, "data connection already open?", 0,
 345
 346                 450, "file unavailable", 0,
 347                 500, "syntax error", 0,
 348                 501, "syntax error", 0,
 349                 502, "command not implemented", 0,
 350                 530, "not logged in", 0,
 351
 352                    421, "service unavailable, closing connection", 0 );
 353         if( ! $ret ){
 354                 &ftp'close_data_socket;
 355                 return 0;
 356         }
 357
 358         #
 359         # the data should be coming at us now
 360         #
 361
 362         # now accept
 363         accept(NS,S) || die "accept failed $!";
 364
 365         return 1;
 366 }
 367
 368
 369 # Close down reading the result of a remote ls command
 370 # return 1 if successful and 0 on failure
 371 sub ftp'dir_close
 372 {
 373         local( $ret );
 374
 375         # read the close
 376         #
 377         $ret = &ftp'expect($timeout,
 378                 226, "", 1,     # transfer complete, closing connection
 379                 250, "", 1,     # action completed
 380
 381                 425, "can't open data connection", 0,
 382                 426, "connection closed, transfer aborted", 0,
 383                 451, "action aborted, local error", 0,
 384                 421, "service unavailable, closing connection", 0);
 385
 386         # shut down our end of the socket
 387         &ftp'close_data_socket;
 388
 389         if( ! $ret ){
 390                 return 0;
 391         }
 392
 393         return 1;
 394 }
 395
 396 # Quit from the remote ftp server
 397 # return 1 if successful and 0 on failure
 398 sub ftp'quit
 399 {
 400         $site_command_check = 0;
 401         @site_command_list = ();
 402
 403         &ftp'send("QUIT");
 404
 405         return &ftp'expect($timeout,
 406                 221, "Goodbye", 1,     # transfer complete, closing connection
 407
 408                 500, "error quitting??", 0);
 409 }
 410
 411 sub ftp'read_alarm
 412 {
 413         die "timeout: read";
 414 }
 415
 416 sub ftp'timed_read
 417 {
 418         alarm( $timeout_read );
 419         return sysread( NS, $buf, $ftpbufsize );
 420 }
 421
 422 sub ftp'read
 423 {
 424         $SIG{ 'ALRM' } = "ftp\'read_alarm";
 425
 426         local( $ret ) = eval '&timed_read()';
 427         alarm( 0 );
 428
 429         if( $@ =~ /^timeout/ ){
 430                 return -1;
 431         }
 432         return $ret;
 433 }
 434
 435 # Get a remote file back into a local file.
 436 # If no loc_fname passed then uses rem_fname.
 437 # returns 1 on success and 0 on failure
 438 sub ftp'get
 439 {
 440         local($rem_fname, $loc_fname, $restart ) = @_;
 441
 442         if ($loc_fname eq "") {
 443                 $loc_fname = $rem_fname;
 444         }
 445
 446         if( ! &ftp'open_data_socket() ){
 447                 print STDERR "Cannot open data socket\n";
 448                 return 0;
 449         }
 450
 451         if( $loc_fname ne '-' ){
 452                 # Find the size of the target file
 453                 local( $restart_at ) = &ftp'filesize( $loc_fname );
 454                 if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
 455                         $restart = 1;
 456                         # Make sure the file can be updated
 457                         chmod( 0644, $loc_fname );
 458                 }
 459                 else {
 460                         $restart = 0;
 461                         unlink( $loc_fname );
 462                 }
 463         }
 464
 465         &ftp'send( "RETR $rem_fname" );
 466
 467         local( $ret ) =
 468                 &ftp'expect($timeout,
 469                    150, "receiving $rem_fname", 1,
 470
 471                    125, "data connection already open?", 0,
 472
 473                    450, "file unavailable", 2,
 474                    550, "file unavailable", 2,
 475
 476                    500, "syntax error", 0,
 477                    501, "syntax error", 0,
 478                    530, "not logged in", 0,
 479
 480                    421, "service unavailable, closing connection", 0);
 481         if( $ret != 1 ){
 482                 print STDERR "Failure on RETR command\n";
 483
 484                 # shut down our end of the socket
 485                 &ftp'close_data_socket;
 486
 487                 return 0;
 488         }
 489
 490         #
 491         # the data should be coming at us now
 492         #
 493
 494         # now accept
 495         accept(NS,S) || die "accept failed: $!";
 496
 497         #
 498         #  open the local fname
 499         #  concatenate on the end if restarting, else just overwrite
 500         if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
 501                 print STDERR "Cannot create local file $loc_fname\n";
 502
 503                 # shut down our end of the socket
 504                 &ftp'close_data_socket;
 505
 506                 return 0;
 507         }
 508
 509 #    while (<NS>) {
 510 #        print FH ;
 511 #    }
 512
 513         local( $start_time ) = time;
 514         local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
 515         while( ($len = &ftp'read()) > 0 ){
 516                 $bytes += $len;
 517                 if( $strip_cr ){
 518                         $ftp'buf =~ s/\r//g;
 519                 }
 520                 if( $ftp_show ){
 521                         while( $bytes > ($lasthash + $ftp'hashevery) ){
 522                                 print STDERR '#';
 523                                 $lasthash += $ftp'hashevery;
 524                                 $hashes++;
 525                                 if( ($hashes % $ftp'hashnl) == 0 ){
 526                                         print STDERR "\n";
 527                                 }
 528                         }
 529                 }
 530                 if( ! print FH $ftp'buf ){
 531                         print STDERR "\nfailed to write data";
 532                         return 0;
 533                 }
 534         }
 535         close( FH );
 536
 537         # shut down our end of the socket
 538         &ftp'close_data_socket;
 539
 540         if( $len < 0 ){
 541                 print STDERR "\ntimed out reading data!\n";
 542
 543                 return 0;
 544         }
 545
 546         if( $ftp_show ){
 547                 if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
 548                         print STDERR "\n";
 549                 }
 550                 local( $secs ) = (time - $start_time);
 551                 if( $secs <= 0 ){
 552                         $secs = 1; # To avoid a divide by zero;
 553                 }
 554
 555                 local( $rate ) = int( $bytes / $secs );
 556                 print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
 557         }
 558
 559         #
 560         # read the close
 561         #
 562
 563         $ret = &ftp'expect($timeout,
 564                 226, "Got file", 1,     # transfer complete, closing connection
 565                 250, "Got file", 1,     # action completed
 566
 567                 110, "restart not supported", 0,
 568                 425, "can't open data connection", 0,
 569                 426, "connection closed, transfer aborted", 0,
 570                 451, "action aborted, local error", 0,
 571                 421, "service unavailable, closing connection", 0);
 572
 573         return $ret;
 574 }
 575
 576 sub ftp'delete
 577 {
 578         local( $rem_fname, $val ) = @_;
 579
 580         &ftp'send("DELE $rem_fname" );
 581         $val = &ftp'expect( $timeout,
 582                            250,"Deleted $rem_fname", 1,
 583                            550,"Permission denied",0
 584                            );
 585         return $val == 1;
 586 }
 587
 588 sub ftp'deldir
 589 {
 590     local( $fname ) = @_;
 591
 592     # not yet implemented
 593     # RMD
 594 }
 595
 596 # UPDATE ME!!!!!!
 597 # Add in the hash printing and newline conversion
 598 sub ftp'put
 599 {
 600         local( $loc_fname, $rem_fname ) = @_;
 601         local( $strip_cr );
 602
 603         if ($loc_fname eq "") {
 604                 $loc_fname = $rem_fname;
 605         }
 606
 607         if( ! &ftp'open_data_socket() ){
 608                 return 0;
 609         }
 610
 611         &ftp'send("STOR $rem_fname");
 612
 613         #
 614         # the data should be coming at us now
 615         #
 616
 617         local( $ret ) =
 618         &ftp'expect($timeout,
 619                 150, "sending $loc_fname", 1,
 620
 621                 125, "data connection already open?", 0,
 622                 450, "file unavailable", 0,
 623
 624                 532, "need account for storing files", 0,
 625                 452, "insufficient storage on system", 0,
 626                 553, "file name not allowed", 0,
 627
 628                 500, "syntax error", 0,
 629                 501, "syntax error", 0,
 630                 530, "not logged in", 0,
 631
 632                 421, "service unavailable, closing connection", 0);
 633
 634         if( $ret != 1 ){
 635                 # shut down our end of the socket
 636                 &ftp'close_data_socket;
 637
 638                 return 0;
 639         }
 640
 641
 642         #
 643         # the data should be coming at us now
 644         #
 645
 646         # now accept
 647         accept(NS,S) || die "accept failed: $!";
 648
 649         #
 650         #  open the local fname
 651         #
 652         if( !open(FH, "<$loc_fname") ){
 653                 print STDERR "Cannot open local file $loc_fname\n";
 654
 655                 # shut down our end of the socket
 656                 &ftp'close_data_socket;
 657
 658                 return 0;
 659         }
 660
 661         while (<FH>) {
 662                 print NS ;
 663         }
 664         close(FH);
 665
 666         # shut down our end of the socket to signal EOF
 667         &ftp'close_data_socket;
 668
 669         #
 670         # read the close
 671         #
 672
 673         $ret = &ftp'expect($timeout,
 674                 226, "file put", 1,     # transfer complete, closing connection
 675                 250, "file put", 1,     # action completed
 676
 677                 110, "restart not supported", 0,
 678                 425, "can't open data connection", 0,
 679                 426, "connection closed, transfer aborted", 0,
 680                 451, "action aborted, local error", 0,
 681                 551, "page type unknown", 0,
 682                 552, "storage allocation exceeded", 0,
 683
 684                 421, "service unavailable, closing connection", 0);
 685         if( ! $ret ){
 686                 print STDERR "error putting $loc_fname\n";
 687         }
 688         return $ret;
 689 }
 690
 691 sub ftp'restart
 692 {
 693         local( $restart_point, $ret ) = @_;
 694
 695         &ftp'send("REST $restart_point");
 696
 697         #
 698         # see what they say
 699
 700         $ret = &ftp'expect($timeout,
 701                            350, "restarting at $restart_point", 1,
 702
 703                            500, "syntax error", 0,
 704                            501, "syntax error", 0,
 705                            502, "REST not implemented", 2,
 706                            530, "not logged in", 0,
 707                            554, "REST not implemented", 2,
 708
 709                            421, "service unavailable, closing connection", 0);
 710         return $ret;
 711 }
 712
 713 # Set the file transfer type
 714 sub ftp'type
 715 {
 716         local( $type ) = @_;
 717
 718         &ftp'send("TYPE $type");
 719
 720         #
 721         # see what they say
 722
 723         $ret = &ftp'expect($timeout,
 724                            200, "file type set to $type", 1,
 725
 726                            500, "syntax error", 0,
 727                            501, "syntax error", 0,
 728                            504, "Invalid form or byte size for type $type", 0,
 729
 730                            421, "service unavailable, closing connection", 0);
 731         return $ret;
 732 }
 733
 734 $site_command_check = 0;
 735 @site_command_list = ();
 736
 737 # routine to query the remote server for 'SITE' commands supported
 738 sub ftp'site_commands
 739 {
 740         local( $ret );
 741
 742         # if we havent sent a 'HELP SITE', send it now
 743         if( !$site_command_check ){
 744
 745                 $site_command_check = 1;
 746
 747                 &ftp'send( "HELP SITE" );
 748
 749                 # assume the line in the HELP SITE response with the 'HELP'
 750                 # command is the one for us
 751                 $ret = &ftp'expect( $timeout,
 752                         ".*HELP.*", "", "\$1",
 753                         214, "", "0",
 754                         202, "", "0" );
 755
 756                 if( $ret eq "0" ){
 757                         print STDERR "No response from HELP SITE\n" if( $ftp_show );
 758                 }
 759
 760                 @site_command_list = split(/\s+/, $ret);
 761         }
 762
 763         return @site_command_list;
 764 }
 765
 766 # return the pwd, or null if we can't get the pwd
 767 sub ftp'pwd
 768 {
 769         local( $ret, $cwd );
 770
 771         &ftp'send( "PWD" );
 772
 773         #
 774         # see what they say
 775
 776         $ret = &ftp'expect( $timeout,
 777                            257, "working dir is", 1,
 778                            500, "syntax error", 0,
 779                            501, "syntax error", 0,
 780                            502, "PWD not implemented", 0,
 781                            550, "file unavailable", 0,
 782
 783                            421, "service unavailable, closing connection", 0 );
 784         if( $ret ){
 785                 if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
 786                         $cwd = $1;
 787                 }
 788         }
 789         return $cwd;
 790 }
 791
 792 # return 1 for success, 0 for failure
 793 sub ftp'mkdir
 794 {
 795         local( $path ) = @_;
 796         local( $ret );
 797
 798         &ftp'send( "MKD $path" );
 799
 800         #
 801         # see what they say
 802
 803         $ret = &ftp'expect( $timeout,
 804                            257, "made directory $path", 1,
 805
 806                            500, "syntax error", 0,
 807                            501, "syntax error", 0,
 808                            502, "MKD not implemented", 0,
 809                            530, "not logged in", 0,
 810                            550, "file unavailable", 0,
 811
 812                            421, "service unavailable, closing connection", 0 );
 813         return $ret;
 814 }
 815
 816 # return 1 for success, 0 for failure
 817 sub ftp'chmod
 818 {
 819         local( $path, $mode ) = @_;
 820         local( $ret );
 821
 822         &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
 823
 824         #
 825         # see what they say
 826
 827         $ret = &ftp'expect( $timeout,
 828                            200, "chmod $mode $path succeeded", 1,
 829
 830                            500, "syntax error", 0,
 831                            501, "syntax error", 0,
 832                            502, "CHMOD not implemented", 0,
 833                            530, "not logged in", 0,
 834                            550, "file unavailable", 0,
 835
 836                            421, "service unavailable, closing connection", 0 );
 837         return $ret;
 838 }
 839
 840 # rename a file
 841 sub ftp'rename
 842 {
 843         local( $old_name, $new_name ) = @_;
 844         local( $ret );
 845
 846         &ftp'send( "RNFR $old_name" );
 847
 848         #
 849         # see what they say
 850
 851         $ret = &ftp'expect( $timeout,
 852                            350, "", 1,
 853
 854                            500, "syntax error", 0,
 855                            501, "syntax error", 0,
 856                            502, "RNFR not implemented", 0,
 857                            530, "not logged in", 0,
 858                            550, "file unavailable", 0,
 859                            450, "file unavailable", 0,
 860
 861                            421, "service unavailable, closing connection", 0);
 862
 863
 864         # check if the "rename from" occurred ok
 865         if( $ret ) {
 866                 &ftp'send( "RNTO $new_name" );
 867
 868                 #
 869                 # see what they say
 870
 871                 $ret = &ftp'expect( $timeout,
 872                                    250, "rename $old_name to $new_name", 1,
 873
 874                                    500, "syntax error", 0,
 875                                    501, "syntax error", 0,
 876                                    502, "RNTO not implemented", 0,
 877                                    503, "bad sequence of commands", 0,
 878                                    530, "not logged in", 0,
 879                                    532, "need account for storing files", 0,
 880                                    553, "file name not allowed", 0,
 881
 882                                    421, "service unavailable, closing connection", 0);
 883         }
 884
 885         return $ret;
 886 }
 887
 888
 889 sub ftp'quote
 890 {
 891       local( $cmd ) = @_;
 892
 893       &ftp'send( $cmd );
 894
 895       return &ftp'expect( $timeout,
 896               200, "Remote '$cmd' OK", 1,
 897               500, "error in remote '$cmd'", 0 );
 898 }
 899
 900 # ------------------------------------------------------------------------------
 901 # These are the lower level support routines
 902
 903 sub ftp'expectgot
 904 {
 905         ($ftp'response, $ftp'fatalerror) = @_;
 906         if( $ftp_show ){
 907                 print STDERR "$ftp'response\n";
 908         }
 909 }
 910
 911 #
 912 #  create the list of parameters for chat'expect
 913 #
 914 #  ftp'expect(time_out, {value, string_to_print, return value});
 915 #     if the string_to_print is "" then nothing is printed
 916 #  the last response is stored in $ftp'response
 917 #
 918 # NOTE: lmjm has changed this code such that the string_to_print is
 919 # ignored and the string sent back from the remote system is printed
 920 # instead.
 921 #
 922 sub ftp'expect {
 923         local( $ret );
 924         local( $time_out );
 925         local( $expect_args );
 926
 927         $ftp'response = '';
 928         $ftp'fatalerror = 0;
 929
 930         @expect_args = ();
 931
 932         $time_out = shift(@_);
 933
 934         while( @_ ){
 935                 local( $code ) = shift( @_ );
 936                 local( $pre ) = '^';
 937                 if( $code =~ /^\d/ ){
 938                         $pre =~ "[.|\n]*^";
 939                 }
 940                 push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
 941                 shift( @_ );
 942                 push( @expect_args,
 943                         "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
 944         }
 945
 946         # Treat all unrecognised lines as continuations
 947         push( @expect_args, "^(.*)\\015\\n" );
 948         push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
 949
 950         # add patterns TIMEOUT and EOF
 951
 952         push( @expect_args, 'TIMEOUT' );
 953         push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
 954
 955         push( @expect_args, 'EOF' );
 956         push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
 957
 958         if( $ftp_show > 9 ){
 959                 &printargs( $time_out, @expect_args );
 960         }
 961
 962         $ret = &chat'expect( $time_out, @expect_args );
 963         if( $ret == 100 ){
 964                 # we saw a continuation line, wait for the end
 965                 push( @expect_args, "^.*\n" );
 966                 push( @expect_args, "100" );
 967
 968                 while( $ret == 100 ){
 969                         $ret = &chat'expect( $time_out, @expect_args );
 970                 }
 971         }
 972
 973         return $ret;
 974 }
 975
 976 #
 977 #  opens NS for io
 978 #
 979 sub ftp'open_data_socket
 980 {
 981         local( $ret );
 982         local( $hostname );
 983         local( $sockaddr, $name, $aliases, $proto, $port );
 984         local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
 985         local( $mysockaddr, $family, $hi, $lo );
 986
 987
 988         $sockaddr = 'S n a4 x8';
 989         chop( $hostname = `hostname` );
 990
 991         $port = "ftp";
 992
 993         ($name, $aliases, $proto) = getprotobyname( 'tcp' );
 994         ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
 995
 996 #       ($name, $aliases, $type, $len, $thisaddr) =
 997 #       gethostbyname( $hostname );
 998         ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
 999
1000 #       $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
1001         $this = $chat'thisproc;
1002
1003         socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
1004         bind(S, $this) || die "bind: $!";
1005
1006         # get the port number
1007         $mysockaddr = getsockname(S);
1008         ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
1009
1010         $hi = ($port >> 8) & 0x00ff;
1011         $lo = $port & 0x00ff;
1012
1013         #
1014         # we MUST do a listen before sending the port otherwise
1015         # the PORT may fail
1016         #
1017         listen( S, 5 ) || die "listen";
1018
1019         &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
1020
1021         return &ftp'expect($timeout,
1022                 200, "PORT command successful", 1,
1023                 250, "PORT command successful", 1 ,
1024
1025                 500, "syntax error", 0,
1026                 501, "syntax error", 0,
1027                 530, "not logged in", 0,
1028
1029                 421, "service unavailable, closing connection", 0);
1030 }
1031
1032 sub ftp'close_data_socket
1033 {
1034         close(NS);
1035 }
1036
1037 sub ftp'send
1038 {
1039         local($send_cmd) = @_;
1040         if( $send_cmd =~ /\n/ ){
1041                 print STDERR "ERROR, \\n in send string for $send_cmd\n";
1042         }
1043
1044         if( $ftp_show ){
1045                 local( $sc ) = $send_cmd;
1046
1047                 if( $send_cmd =~ /^PASS/){
1048                         $sc = "PASS <somestring>";
1049                 }
1050                 print STDERR "---> $sc\n";
1051         }
1052
1053         &chat'print( "$send_cmd\r\n" );
1054 }
1055
1056 sub ftp'printargs
1057 {
1058         while( @_ ){
1059                 print STDERR shift( @_ ) . "\n";
1060         }
1061 }
1062
1063 sub ftp'filesize
1064 {
1065         local( $fname ) = @_;
1066
1067         if( ! -f $fname ){
1068                 return -1;
1069         }
1070
1071         return (stat( _ ))[ 7 ];
1072
1073 }
1074
1075 # make this package return true
1076 1;