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