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