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