Index: harvest/ChangeLog
diff -c harvest/ChangeLog:2.8 harvest/ChangeLog:2.9
*** harvest/ChangeLog:2.8	Sat May  3 18:13:41 1997
--- harvest/ChangeLog	Sat May  3 18:13:41 1997
***************
*** 1,4 ****
--- 1,5 ----
  Changes in current version
+ 	- Added missing ftp files ftp.pl and chat2.pl (Simon Wilkinson)
  	- Fix for Year 2000 logging and file naming problem (logs
  	  should now be produced using 4 digits for the year) (Simon Wilkinson,
  	  suggested by Craig Counterman)
Index: harvest/src/common/url/Makefile.in
diff -c harvest/src/common/url/Makefile.in:2.4 harvest/src/common/url/Makefile.in:2.5
*** harvest/src/common/url/Makefile.in:2.4	Sun Mar 23 23:09:05 1997
--- harvest/src/common/url/Makefile.in	Sat May  3 17:46:38 1997
***************
*** 1,7 ****
  #
  #  Makefile for simple liburl
  #
! #  Makefile.in,v 2.4 1997/03/23 23:09:05 sxw Exp
  #
  prefix = @prefix@
  INSTALL_BINDIR	= $(prefix)/bin
--- 1,7 ----
  #
  #  Makefile for simple liburl
  #
! #  Makefile.in,v 2.5 1997/05/03 16:46:38 sxw Exp
  #
  prefix = @prefix@
  INSTALL_BINDIR	= $(prefix)/bin
***************
*** 58,66 ****
  		  $(MD5_LIB) $(CACHE_LIBS) $(CCACHE_LIBS) $(DEBUG_LIBS) \
  		  $(XTRA_LIBS)
  LIBFILE		= liburl.a
  SOCKET_PH	= socket.ph
  
! all:	$(LIBFILE) $(PROGS) $(UTILS) $(SOCKET_PH)
  
  $(LIBFILE):	$(OBJS)
  	ar r $@ $(OBJS)
--- 58,67 ----
  		  $(MD5_LIB) $(CACHE_LIBS) $(CCACHE_LIBS) $(DEBUG_LIBS) \
  		  $(XTRA_LIBS)
  LIBFILE		= liburl.a
+ PERLS		= chat2.pl ftp.pl
  SOCKET_PH	= socket.ph
  
! all:	$(LIBFILE) $(PROGS) $(PERLS) $(UTILS) $(SOCKET_PH)
  
  $(LIBFILE):	$(OBJS)
  	ar r $@ $(OBJS)
***************
*** 94,100 ****
  	-rm -f Makefile
  
  install:	all
! 	@for f in $(PROGS) $(GENPROGS) $(UTILS); do \
  		echo $(INSTALL_BIN) $$f $(INSTALL_LIBDIR); \
  		$(INSTALL_BIN) $$f $(INSTALL_LIBDIR); \
  	done
--- 95,101 ----
  	-rm -f Makefile
  
  install:	all
! 	@for f in $(PROGS) $(GENPROGS) $(UTILS) $(PERLS); do \
  		echo $(INSTALL_BIN) $$f $(INSTALL_LIBDIR); \
  		$(INSTALL_BIN) $$f $(INSTALL_LIBDIR); \
  	done
Index: harvest/src/common/url/chat2.pl
diff -c /dev/null harvest/src/common/url/chat2.pl:2.2
*** /dev/null	Sat May  3 18:06:59 1997
--- harvest/src/common/url/chat2.pl	Sat May  3 18:04:07 1997
***************
*** 0 ****
--- 1,411 ----
+ # chat.pl: chat with a server
+ # Based on: V2.01.alpha.7 91/06/16
+ # Randal L. Schwartz (was <merlyn@iwarp.intel.com>)
+ # multihome additions by A.Macpherson@bnr.co.uk
+ # allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
+ # chat2.pl,v 1.8 1995/05/17 19:12:55 wessels Exp
+ # Revision 2.2  1993/12/14  11:09:03  lmjm
+ # Only include sys/socket.ph if not already there.
+ # Allow for system 5.
+ #
+ # Revision 2.1  1993/06/28  15:11:07  lmjm
+ # Full 2.1 release
+ #
+ 
+ package chat;
+ 
+ unless( defined &'PF_INET ){
+ 	do 'socket.ph';		 # include local Harvest copy of socket.ph
+ }
+ 
+ 
+ if( defined( &main'PF_INET ) ){
+ 	$pf_inet = &main'PF_INET;
+ 	$sock_stream = &main'SOCK_STREAM;
+ 	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+ 	$tcp_proto = $proto;
+ }
+ else {
+ 	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+ 	# but who the heck would change these anyway? (:-)
+ 	$pf_inet = 2;
+ 	$sock_stream = 1;
+ 	$tcp_proto = 6;
+ }
+ 
+ 
+ $sockaddr = 'S n a4 x8';
+ chop ($thishost = `(hostname || uname -n || uuname -l) 2>/dev/null`);
+ 
+ # *S = symbol for current I/O, gets assigned *chatsymbol....
+ $next = "chatsymbol000000"; # next one
+ $nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
+ 
+ 
+ ## $handle = &chat'open_port("server.address",$port_number);
+ ## opens a named or numbered TCP server
+ 
+ sub open_port { ## public
+ 	local($server, $port) = @_;
+ 
+ 	local($serveraddr,$serverproc);
+ 
+ 	# We may be multi-homed, start with 0, fixup once connexion is made
+ 	$thisaddr = "\0\0\0\0" ;
+ 	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+ 
+ 	*S = ++$next;
+ 	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+ 		$serveraddr = pack('C4', $1, $2, $3, $4);
+ 	} else {
+ 		local(@x) = gethostbyname($server);
+ 		$chat'errmsg = 'Unknown host' unless @x;
+ 		return undef unless @x;
+ 		$serveraddr = $x[4];
+ 	}
+ 	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
+ 	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
+ 		$chat'errmsg = $!;
+ 		($!) = ($!, close(S)); # close S while saving $!
+ 		return undef;
+ 	}
+ #	unless (bind(S, $thisproc)) {
+ #		($!) = ($!, close(S)); # close S while saving $!
+ #		return undef;
+ #	}
+ 	unless (connect(S, $serverproc)) {
+ 		$chat'errmsg = $!;
+ 		($!) = ($!, close(S)); # close S while saving $!
+ 		return undef;
+ 	}
+ # We opened with the local address set to ANY, at this stage we know
+ # which interface we are using.  This is critical if our machine is
+ # multi-homed, with IP forwarding off, so fix-up.
+ 	local($fam,$lport);
+ 	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
+ 	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+ # end of post-connect fixup
+ 	select((select(S), $| = 1)[0]);
+ 	$next; # return symbol for switcharound
+ }
+ 
+ ## ($host, $port, $handle) = &chat'open_listen([$port_number]);
+ ## opens a TCP port on the current machine, ready to be listened to
+ ## if $port_number is absent or zero, pick a default port number
+ ## process must be uid 0 to listen to a low port number
+ 
+ sub open_listen { ## public
+ 
+ 	*S = ++$next;
+ 	local($thisport) = shift || 0;
+ 	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
+ 	local(*NS) = "__" . time;
+ 	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
+ 		($!) = ($!, close(NS));
+ 		return undef;
+ 	}
+ 	unless (bind(NS, $thisproc_local)) {
+ 		($!) = ($!, close(NS));
+ 		return undef;
+ 	}
+ 	unless (listen(NS, 1)) {
+ 		($!) = ($!, close(NS));
+ 		return undef;
+ 	}
+ 	select((select(NS), $| = 1)[0]);
+ 	local($family, $port, @myaddr) =
+ 		unpack("S n C C C C x8", getsockname(NS));
+ 	$S{"needs_accept"} = *NS; # so expect will open it
+ 	(@myaddr, $port, $next); # returning this
+ }
+ 
+ ## $handle = &chat'open_proc("command","arg1","arg2",...);
+ ## opens a /bin/sh on a pseudo-tty
+ 
+ sub open_proc { ## public
+ 	local(@cmd) = @_;
+ 
+ 	*S = ++$next;
+ 	local(*TTY) = "__TTY" . time;
+ 	local($pty,$tty) = &_getpty(S,TTY);
+ 	die "Cannot find a new pty" unless defined $pty;
+ 	$pid = fork;
+ 	die "Cannot fork: $!" unless defined $pid;
+ 	unless ($pid) {
+ 		close STDIN; close STDOUT; close STDERR;
+ 		setpgrp(0,$$);
+ 		if (open(DEVTTY, "/dev/tty")) {
+ 		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
+ 		    close DEVTTY;
+ 		}
+ 		open(STDIN,"<&TTY");
+ 		open(STDOUT,">&TTY");
+ 		open(STDERR,">&STDOUT");
+ 		die "Oops" unless fileno(STDERR) == 2;	# sanity
+ 		close(S);
+ 		exec @cmd;
+ 		die "Cannot exec @cmd: $!";
+ 	}
+ 	close(TTY);
+ 	$next; # return symbol for switcharound
+ }
+ 
+ # &chat'read([$handle,] $buf, $ntoread )
+ # blocking read. returns no. of bytes read and puts data in $buf.
+ # If called with ntoread < 0 then just do the accept and return 0.
+ sub read { ## public
+ 	if ($_[0] =~ /$nextpat/) {
+ 		*S = shift;
+ 	}
+ 	*chatreadbuf = shift;
+ 	$chatreadn = shift;
+ 	
+ 	if (defined $S{"needs_accept"}) { # is it a listen socket?
+ 		local(*NS) = $S{"needs_accept"};
+ 		delete $S{"needs_accept"};
+ 		$S{"needs_close"} = *NS;
+ 		unless(accept(S,NS)) {
+ 			($!) = ($!, close(S), close(NS));
+ 			return undef;
+ 		}
+ 		select((select(S), $| = 1)[0]);
+ 	}
+ 	if( $chatreadn > 0 ){
+ 		return sysread(S, $chatreadbuf, $chatreadn );
+ 	}
+ }
+ 
+ # $S is the read-ahead buffer
+ 
+ ## $return = &chat'expect([$handle,] $timeout_time,
+ ## 	$pat1, $body1, $pat2, $body2, ... )
+ ## $handle is from previous &chat'open_*().
+ ## $timeout_time is the time (either relative to the current time, or
+ ## absolute, ala time(2)) at which a timeout event occurs.
+ ## $pat1, $pat2, and so on are regexs which are matched against the input
+ ## stream.  If a match is found, the entire matched string is consumed,
+ ## and the corresponding body eval string is evaled.
+ ##
+ ## Each pat is a regular-expression (probably enclosed in single-quotes
+ ## in the invocation).  ^ and $ will work, respecting the current value of $*.
+ ## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
+ ## If pat is 'EOF', the body is executed if the process exits before
+ ## the other patterns are seen.
+ ##
+ ## Pats are scanned in the order given, so later pats can contain
+ ## general defaults that won't be examined unless the earlier pats
+ ## have failed.
+ ##
+ ## The result of eval'ing body is returned as the result of
+ ## the invocation.  Recursive invocations are not thought
+ ## through, and may work only accidentally. :-)
+ ##
+ ## undef is returned if either a timeout or an eof occurs and no
+ ## corresponding body has been defined.
+ ## I/O errors of any sort are treated as eof.
+ 
+ $nextsubname = "expectloop000000"; # used for subroutines
+ 
+ sub expect { ## public
+ 	if ($_[0] =~ /$nextpat/) {
+ 		*S = shift;
+ 	}
+ 	local($endtime) = shift;
+ 
+ 	local($timeout,$eof) = (1,1);
+ 	local($caller) = caller;
+ 	local($rmask, $nfound, $timeleft, $thisbuf);
+ 	local($cases, $pattern, $action, $subname);
+ 	$endtime += time if $endtime < 600_000_000;
+ 
+ 	if (defined $S{"needs_accept"}) { # is it a listen socket?
+ 		local(*NS) = $S{"needs_accept"};
+ 		delete $S{"needs_accept"};
+ 		$S{"needs_close"} = *NS;
+ 		unless(accept(S,NS)) {
+ 			($!) = ($!, close(S), close(NS));
+ 			return undef;
+ 		}
+ 		select((select(S), $| = 1)[0]);
+ 	}
+ 
+ 	# now see whether we need to create a new sub:
+ 
+ 	unless ($subname = $expect_subname{$caller,@_}) {
+ 		# nope.  make a new one:
+ 		$expect_subname{$caller,@_} = $subname = $nextsubname++;
+ 
+ 		$cases .= <<"EDQ"; # header is funny to make everything elsif's
+ sub $subname {
+ 	LOOP: {
+ 		if (0) { ; }
+ EDQ
+ 		while (@_) {
+ 			($pattern,$action) = splice(@_,0,2);
+ 			if ($pattern =~ /^eof$/i) {
+ 				$cases .= <<"EDQ";
+ 		elsif (\$eof) {
+ 	 		package $caller;
+ 			$action;
+ 		}
+ EDQ
+ 				$eof = 0;
+ 			} elsif ($pattern =~ /^timeout$/i) {
+ 			$cases .= <<"EDQ";
+ 		elsif (\$timeout) {
+ 		 	package $caller;
+ 			$action;
+ 		}
+ EDQ
+ 				$timeout = 0;
+ 			} else {
+ 				$pattern =~ s#/#\\/#g;
+ 			$cases .= <<"EDQ";
+ 		elsif (\$S =~ /$pattern/) {
+ 			\$S = \$';
+ 		 	package $caller;
+ 			$action;
+ 		}
+ EDQ
+ 			}
+ 		}
+ 		$cases .= <<"EDQ" if $eof;
+ 		elsif (\$eof) {
+ 			undef;
+ 		}
+ EDQ
+ 		$cases .= <<"EDQ" if $timeout;
+ 		elsif (\$timeout) {
+ 			undef;
+ 		}
+ EDQ
+ 		$cases .= <<'ESQ';
+ 		else {
+ 			$rmask = "";
+ 			vec($rmask,fileno(S),1) = 1;
+ 			($nfound, $rmask) =
+ 		 		select($rmask, undef, undef, $endtime - time);
+ 			if ($nfound) {
+ 				$nread = sysread(S, $thisbuf, 1024);
+ 				if( $chat'debug ){
+ 					print STDERR "sysread $nread ";
+ 					print STDERR ">>$thisbuf<<\n";
+ 				}
+ 				if ($nread > 0) {
+ 					$S .= $thisbuf;
+ 				} else {
+ 					$eof++, redo LOOP; # any error is also eof
+ 				}
+ 			} else {
+ 				$timeout++, redo LOOP; # timeout
+ 			}
+ 			redo LOOP;
+ 		}
+ 	}
+ }
+ ESQ
+ 		eval $cases; die "$cases:\n$@" if $@;
+ 	}
+ 	$eof = $timeout = 0;
+ 	do $subname();
+ }
+ 
+ ## &chat'print([$handle,] @data)
+ ## $handle is from previous &chat'open().
+ ## like print $handle @data
+ 
+ sub print { ## public
+ 	if ($_[0] =~ /$nextpat/) {
+ 		*S = shift;
+ 	}
+ 	print S @_;
+ 	if( $chat'debug ){
+ 		print STDERR "printed:";
+ 		print STDERR @_;
+ 	}
+ }
+ 
+ ## &chat'close([$handle,])
+ ## $handle is from previous &chat'open().
+ ## like close $handle
+ 
+ sub close { ## public
+ 	if ($_[0] =~ /$nextpat/) {
+ 	 	*S = shift;
+ 	}
+ 	close(S);
+ 	if (defined $S{"needs_close"}) { # is it a listen socket?
+ 		local(*NS) = $S{"needs_close"};
+ 		delete $S{"needs_close"};
+ 		close(NS);
+ 	}
+ }
+ 
+ ## @ready_handles = &chat'select($timeout, @handles)
+ ## select()'s the handles with a timeout value of $timeout seconds.
+ ## Returns an array of handles that are ready for I/O.
+ ## Both user handles and chat handles are supported (but beware of
+ ## stdio's buffering for user handles).
+ 
+ sub select { ## public
+ 	local($timeout) = shift;
+ 	local(@handles) = @_;
+ 	local(%handlename) = ();
+ 	local(%ready) = ();
+ 	local($caller) = caller;
+ 	local($rmask) = "";
+ 	for (@handles) {
+ 		if (/$nextpat/o) { # one of ours... see if ready
+ 			local(*SYM) = $_;
+ 			if (length($SYM)) {
+ 				$timeout = 0; # we have a winner
+ 				$ready{$_}++;
+ 			}
+ 			$handlename{fileno($_)} = $_;
+ 		} else {
+ 			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
+ 		}
+ 	}
+ 	for (sort keys %handlename) {
+ 		vec($rmask, $_, 1) = 1;
+ 	}
+ 	select($rmask, undef, undef, $timeout);
+ 	for (sort keys %handlename) {
+ 		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
+ 	}
+ 	sort keys %ready;
+ }
+ 
+ # ($pty,$tty) = $chat'_getpty(PTY,TTY):
+ # internal procedure to get the next available pty.
+ # opens pty on handle PTY, and matching tty on handle TTY.
+ # returns undef if can't find a pty.
+ # Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
+ 
+ sub _getpty { ## private
+ 	local($_PTY,$_TTY) = @_;
+ 	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+ 	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+ 	local($pty, $tty, $kind);
+ 	if( -e "/dev/pts000" ){		## mods by Joe Doupnik Dec 1992
+ 		$kind = "pts";		## SVR4 Streams
+ 	} else {
+ 		$kind = "pty";		## BSD Clist stuff
+ 	}
+ 	for $bank (112..127) {
+ 		next unless -e sprintf("/dev/$kind%c0", $bank);
+ 		for $unit (48..57) {
+ 			$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
+ 			open($_PTY,"+>$pty") || next;
+ 			select((select($_PTY), $| = 1)[0]);
+ 			($tty = $pty) =~ s/pty/tty/;
+ 			open($_TTY,"+>$tty") || next;
+ 			select((select($_TTY), $| = 1)[0]);
+ 			system "stty nl>$tty";
+ 			return ($pty,$tty);
+ 		}
+ 	}
+ 	undef;
+ }
+ 
+ 1;
Index: harvest/src/common/url/ftp.pl
diff -c /dev/null harvest/src/common/url/ftp.pl:2.2
*** /dev/null	Sat May  3 18:07:00 1997
--- harvest/src/common/url/ftp.pl	Sat May  3 18:04:07 1997
***************
*** 0 ****
--- 1,1373 ----
+ #-*-perl-*-
+ #
+ # ftp.pl,v 1.15 1995/08/01 19:14:58 duane Exp
+ #
+ # This is a wrapper to the chat2.pl routines that make life easier
+ # to do ftp type work.
+ # Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
+ # based on original version by Alan R. Martello <al@ee.pitt.edu>
+ # And by A.Macpherson@bnr.co.uk for multi-homed hosts
+ #
+ # Basic usage:
+ #  $ftp_port = 21;
+ #  $retry_call = 1;
+ #  $attempts = 2;
+ #  if( &ftp'open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){
+ #   die "failed to open ftp connection";
+ #  }
+ #  if( ! &ftp'login( $user, $pass ) ){
+ #   die "failed to login";
+ #  }
+ #  &ftp'type( $text_mode ? 'A' : 'I' );
+ #  if( ! &ftp'get( $remote_filename, $local_filename, 0 ) ){
+ #   die "failed to get file;
+ #  }
+ #  &ftp'quit();
+ #
+ #
+ # ftp.pl,v 1.15 1995/08/01 19:14:58 duane Exp
+ # Revision 2.4  1994/01/26  14:59:07  lmjm
+ # Added DG result code.
+ #
+ # Revision 2.3  1994/01/18  21:58:18  lmjm
+ # Reduce calls to sigset.
+ # Reset to old signal after use.
+ #
+ # Revision 2.2  1993/12/14  11:09:06  lmjm
+ # Use installed socket.ph.
+ # Allow for more returns.
+ #
+ # Revision 2.1  1993/06/28  15:02:00  lmjm
+ # Full 2.1 release
+ #
+ # Wednesday, March 8 1995  -Duane Wessels
+ #  - require socket before chat
+ #  - created $chat'errmsg to track down socket/connect errs
+ #
+ $ENV{'HARVEST_HOME'} = "/usr/local/harvest" if (!defined($ENV{'HARVEST_HOME'}));
+ unshift(@INC, "$ENV{'HARVEST_HOME'}/lib");	# use local installation
+ 
+ require 'socket.ph';	# list this first so socket subs don't go in chat2
+ require 'chat2.pl';
+ 
+ package ftp;
+ 
+ # Support for using an FTP proxy/gateway
+ #
+ $proxy = 0;				# off by default
+ $proxy_gateway = 'beta';		# proxy's hostname
+ $proxy_ftp_port = 4514;			# the port
+ %domains = (				# domains inside the firewall
+ 	'.mydomain.com', 1,
+ );
+ @ipmasks = (				# Netmasks of addresses inside
+ 	0xff000000,
+ 	0xff000000,
+ 	0xffffff00,
+ );
+ @ipaddresses = (			# IP addresses inside the firewall
+ 	0x0d000000,
+ 	0x7f000000,
+ 	0x1234abcd,
+ );
+ 
+ #
+ # END proxy config section
+ 
+ 
+ $retry_pause = 60;	# Pause before retrying a login.
+ 
+ if( defined( &main'PF_INET ) ){
+ 	$pf_inet = &main'PF_INET;
+ 	$sock_stream = &main'SOCK_STREAM;
+ 	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+ 	$tcp_proto = $proto;
+ }
+ else {
+ 	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+ 	# but who the heck would change these anyway? (:-)
+ 	# Answer: !@#*$# Sun.  
+ 	$pf_inet = 2;
+ 	$sock_stream = 1;
+ 	$tcp_proto = 6;
+ }
+ 
+ # If the remote ftp daemon doesn't respond within this time presume its dead
+ # or something.
+ $timeout = 120;
+ 
+ # Timeout a read if I don't get data back within this many seconds
+ $timeout_read = 3 * $timeout;
+ 
+ # Timeout an open
+ $timeout_open = $timeout;
+ 
+ $version = '1.15';
+ 
+ # This is a "global" it contains the last response from the remote ftp server
+ # for use in error messages
+ $response = "";
+ # Also NS is the socket containing the data coming in from the remote ls
+ # command.
+ 
+ # The size of block to be read or written when talking to the remote
+ # ftp server
+ $ftpbufsize = 4096;
+ 
+ # How often to print a hash out, when debugging
+ $hashevery = 1024;
+ # Output a newline after this many hashes to prevent outputing very long lines
+ $hashnl = 70;
+ 
+ # Is there a connection open?
+ $service_open = 0;
+ 
+ # If a proxy connection then who am I really talking to?
+ $real_site = "";
+ 
+ # Where error/log reports are sent to
+ $showfd = 'STDERR';
+ 
+ # Name of a function to call on a pathname to map it into a remote
+ # pathname.
+ $mapunixout = '';
+ $manunixin = '';
+ 
+ # Maximum number of bytes we should transfer
+ $MAX_TRANSFER_SIZE = 10 * 1024 * 1024;
+ 
+ # This is just a tracing aid.
+ $ftp_show = 0;
+ 
+ sub ftp'debug
+ {
+ 	$ftp_show = @_[0];
+ 	if( $ftp_show > 9 ){
+ 		$chat'debug = 1;
+ 	}
+ }
+ 
+ sub ftp'set_timeout
+ {
+ 	local( $to ) = @_;
+ 	return if $to == $timeout;
+ 	$timeout = $to;
+ 	$timeout_open = $timeout;
+ 	$timeout_read = 3 * $timeout;
+ 	if( $ftp_show ){
+ 		print $showfd "ftp timeout set to $timeout\n";
+ 	}
+ }
+ 
+ 
+ sub ftp'open_alarm
+ {
+ 	die "timeout: open";
+ }
+ 
+ sub ftp'timed_open
+ {
+ 	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+ 	local( $connect_site, $connect_port );
+ 	local( $res );
+ 
+ 	alarm( $timeout_open );
+ 
+ 	while( $attempts-- ){
+ 		if( $ftp_show ){
+ 			print $showfd "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
+ 			print $showfd "Connecting to $site";
+ 			if( $ftp_port != 21 ){
+ 				print $showfd " [port $ftp_port]";
+ 			}
+ 			print $showfd "\n";
+ 		}
+ 		
+ 		if( $proxy ) {
+ 			if( ! $proxy_gateway ) {
+ 				# if not otherwise set
+ 				$proxy_gateway = "internet-gateway";
+ 			}
+ 			if( $debug ) {
+ 				print $showfd "using proxy services of $proxy_gateway, ";
+ 				print $showfd "at $proxy_ftp_port\n";
+ 			}
+ 			$connect_site = $proxy_gateway;
+ 			$connect_port = $proxy_ftp_port;
+ 			$real_site = $site;
+ 		}
+ 		else {
+ 			$connect_site = $site;
+ 			$connect_port = $ftp_port;
+ 		}
+ 		if( ! &chat'open_port( $connect_site, $connect_port ) ){
+ 			if( $retry_call ){
+ 				print $showfd "Failed to connect\n" if $ftp_show;
+ 				next;
+ 			}
+ 			else {
+ 				print $showfd "proxy connection failed " if $proxy;
+ 				print $showfd "$connect_site: $chat'errmsg\n" if $ftp_show;
+ 				$response = $chat'errmsg
+ 					if ($response eq '' && $chat'errmsg ne '');
+ 				return 0;
+ 			}
+ 		}
+ 		$res = &ftp'expect( $timeout,
+ 			120, 0, # service unavailable to $site
+ 			220, 1, # ready for login to $site
+ 			421, 0); #service unavailable to $site closing connection
+ 		if( ! $res ){
+ 			&chat'close();
+ 			next;
+ 		}
+ 		return 1;
+ 	}
+ 	continue {
+ 		print $showfd "Pausing between retries\n";
+ 		sleep( $retry_pause );
+ 	}
+ 	return 0;
+ }
+ 
+ sub main'ftp__sighandler
+ {
+ 	local( $sig ) = @_;
+ 	local( $msg ) = "Caught a SIG$sig flagging connection down";
+ 	$service_open = 0;
+ 	if( $ftp_logger ){
+ 		eval "&$ftp_logger( \$msg )";
+ 	}
+ }
+ 
+ sub ftp'set_signals
+ {
+ 	$ftp_logger = @_;
+ 	$SIG{ 'PIPE' } = "ftp__sighandler";
+ }
+ 
+ # Set the mapunixout and mapunixin functions
+ sub ftp'set_namemap
+ {
+ 	($mapunixout, $mapunixin) = @_;
+ 	if( $debug ) {
+ 		print $showfd "mapunixout = $mapunixout, $mapunixin = $mapunixin\n";
+ 	}
+ }
+ 
+ sub ftp'set_proxy {
+ 	local($_) = @_;
+ 
+ 	return(0) unless /\./; # proxy off for local address
+ 
+ 	if(/^\d+\.\d+\.\d+\.\d+$/) { # check ip address aa.bb.cc.dd
+ 		local($val) = 0;
+ 
+ 		for(split(/\./)) {
+ 			$val = 256 * $val + $_;
+ 		}
+ 		for($[ .. $#ipaddresses) {
+ 			return(0) if ($val & $ipmasks[$_]) == $ipaddresses[$_];
+ 		}
+ 		return(1);
+ 	}
+ 
+ 	# check host name
+ 	tr/A-Z/a-z/;
+ 	local(@parts) = split(/\./);
+ 	local($i);
+ 	local($tail) = undef;
+ 
+ 	foreach $i (($[ + 1)..$#parts) {
+ 		$_ = $#parts + $[ - $i + 1;
+ 		$tail = join($parts[$_], '.', $tail);
+ 		return(0) if $domains{$tail};
+ 	}
+ 	return(1);
+ }
+ 
+ sub ftp'open
+ {
+ 	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+ 
+ 	# turn off proxying if site is within the firewall as determined
+ 	# by %domains and @ipaddresses.
+ 	$proxy = &set_proxy($site) if $proxy;
+ 
+ 	local( $old_sig ) = $SIG{ 'ALRM' };
+ 	$SIG{ 'ALRM' } = "ftp\'open_alarm";
+ 
+ 	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
+ 	alarm( 0 );
+ 	$SIG{ 'ALRM' } = $old_sig;
+ 
+ 	if( $@ =~ /^timeout/ ){
+ 		return -1;
+ 	}
+ 
+ 	if( $ret ){
+ 		$service_open = 1;
+ 	}
+ 
+ 	return $ret;
+ }
+ 
+ sub ftp'login
+ {
+ 	local( $remote_user, $remote_password ) = @_;
+         local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $proxy ){
+ 		&ftp'send( "USER $remote_user\@$real_site" );
+ 	}
+ 	else {
+ 		&ftp'send( "USER $remote_user" );
+ 	}
+ 	$ret = &ftp'expect( $timeout,
+ 		230, 1, # $remote_user logged in
+ 		331, 2, # send password for $remote_user
+ 
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		530, 0, # not logged in
+ 		332, 0, # account for login not supported
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	if( $ret == 1 ){
+ 		# Logged in no password needed
+ 		return 1;
+ 	}
+ 	elsif( $ret == 2 ){
+ 		# A password is needed
+ 		&ftp'send( "PASS $remote_password" );
+ 
+ 		$ret = &ftp'expect( $timeout,
+ 			230, 1, # $remote_user logged in
+ 
+ 			202, 0, # command not implemented
+ 			332, 0, # account for login not supported
+ 
+ 			530, 0, # not logged in
+ 			500, 0, # syntax error
+ 			501, 0, # syntax error
+ 			503, 0, # bad sequence of commands
+ 			550, 0, # Can't set guest privileges
+ 
+ 			421, 99 ); # service unavailable, closing connection
+ 		if( $ret == 99 ){
+ 			&service_closed();
+ 			$ret = 0;
+ 		}
+ 		if( $ret == 1 ){
+ 			# Logged in
+ 			return 1;
+ 		}
+ 	}
+ 	# If I got here I failed to login
+ 	return 0;
+ }
+ 
+ sub service_closed
+ {
+ 	$service_open = 0;
+ 	&chat'close();
+ }
+ 
+ sub ftp'close
+ {
+ 	&ftp'quit();
+ 	$service_open = 0;
+ 	&chat'close();
+ }
+ 
+ # Change directory
+ # return 1 if successful
+ # 0 on a failure
+ sub ftp'cwd
+ {
+ 	local( $dir ) = @_;
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $mapunixout ){
+ 		$dir = eval "&$mapunixout( \$dir, 'd' )";
+ 	}
+ 
+ 	&ftp'send( "CWD $dir" );
+ 
+ 	$ret = &ftp'expect( $timeout,
+ 		200, 1, # working directory = $dir
+ 		250, 1, # working directory = $dir
+ 		251, 1, # working directory = $dir		# DG/UX
+ 		257, 1, # working directory = $dir
+ 
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+                 502, 0, # command not implemented
+ 		530, 0, # not logged in
+                 550, 0, # cannot change directory
+ 		421, 99 ); # service unavailable, closing connection
+ 
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	return $ret;
+ }
+ 
+ # Get a full directory listing:
+ # &ftp'dir( remote LIST options )
+ # Start a list going with the given options.
+ # Presuming that the remote deamon uses the ls command to generate the
+ # data to send back then then you can send it some extra options (eg: -lRa)
+ # return 1 if sucessful and 0 on a failure
+ sub ftp'dir_open
+ {
+ 	local( $options ) = @_;
+ 	local( $ret );
+ 	
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( ! &ftp'open_data_socket() ){
+ 		return 0;
+ 	}
+ 
+ 	if( $options ){
+ 		&ftp'send( "LIST $options" );
+ 	}
+ 	else {
+ 		&ftp'send( "LIST" );
+ 	}
+ 	
+ 	$ret = &ftp'expect( $timeout,
+ 		150, 1, # reading directory
+ 	
+ 		125, 0, # data connection already open?
+ 	
+ 		450, 0, # file unavailable
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		502, 0, # command not implemented
+ 		530, 0, # not logged in
+ 		550, 2, # Error executing /bin/ls, DW
+ 	
+ 	        421, 99 ); # service unavailable, closing connection
+ 
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	if( $ret != 1 ) {
+ 		if( $options ){
+ 			&ftp'send( "NLST $options" );
+ 		}
+ 		else {
+ 			&ftp'send( "NLST" );
+ 		}
+ 		
+ 		$ret = &ftp'expect( $timeout,
+ 			150, 1, # reading directory
+ 			125, 0, # data connection already open?
+ 			450, 0, # file unavailable
+ 			500, 0, # syntax error
+ 			501, 0, # syntax error
+ 			502, 0, # command not implemented
+ 			530, 0, # not logged in
+ 			550, 2, # Error executing /bin/ls, DW
+ 	        	421, 99 ); # service unavailable, closing connection
+ 	}
+ 
+ 	if( $ret != 1 ){
+ 		&ftp'close_data_socket;
+ 		return $ret;
+ 	}
+ 	
+ 	accept( NS, S ) || die "accept failed $!";
+ 
+ 	# 
+ 	# the data should be coming at us now
+ 	#
+ 	
+ 	return 1;
+ }
+ 
+ 
+ # Close down reading the result of a remote ls command
+ # return 1 if successful and 0 on failure
+ sub ftp'dir_close
+ {
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	# shut down our end of the socket
+ 	&ftp'close_data_socket;
+ 
+ 	# read the close
+ 	#
+ 	$ret = &ftp'expect($timeout,
+         	226, 1, # transfer complete, closing connection
+         	250, 1, # action completed
+ 
+ 	        425, 0, # can't open data connection
+         	426, 0, # connection closed, transfer aborted
+ 	        451, 0, # action aborted, local error
+ 	        421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	if( ! $ret ){
+ 		return 0;
+ 	}
+ 
+ 	return 1;
+ }
+ 
+ # Quit from the remote ftp server
+ # return 1 if successful and 0 on failure
+ sub ftp'quit
+ {
+ 	local( $ret );
+ 
+ 	$site_command_check = 0;
+ 	@site_command_list = ();
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	&ftp'send( "QUIT" );
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		221, 1, # transfer complete, closing connection
+ 		500, 0, # error quitting??
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	return $ret;
+ }
+ 
+ # Support for ftp'read
+ sub ftp'read_alarm
+ {
+ 	die "timeout: read";
+ }
+ 
+ # Support for ftp'read
+ sub ftp'timed_read
+ {
+ 	alarm( $timeout_read );
+ 
+ 	return sysread( NS, $ftpbuf, $ftpbufsize );
+ }
+ 
+ # Do not use this routing use ftp'get
+ sub ftp'read
+ {
+ 	if( ! $service_open ){
+ 		return -1;
+ 	}
+ 
+ 	local( $ret ) = eval '&timed_read()';
+ 	alarm( 0 );
+ 
+ 	if( $@ =~ /^timeout/ ){
+ 		return -1;
+ 	}
+ 	return $ret;
+ }
+ 
+ # Get a remote file back into a local file.
+ # If no loc_fname passed then uses rem_fname.
+ # returns 1 on success and 0 on failure
+ sub ftp'get
+ {
+ 	local($rem_fname, $loc_fname, $restart ) = @_;
+ 	local( $ret );
+ 	
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $loc_fname eq "" ){
+ 		$loc_fname = $rem_fname;
+ 	}
+ 	
+ 	if( ! &ftp'open_data_socket() ){
+ 		print $showfd "Cannot open data socket\n";
+ 		return 0;
+ 	}
+ 
+ 	if( $loc_fname ne '-' ){
+ 		# Find the size of the target file
+ 		local( $restart_at ) = &ftp'filesize( $loc_fname );
+ 		if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
+ 			$restart = 1;
+ 			# Make sure the file can be updated
+ 			chmod( 0644, $loc_fname );
+ 		}
+ 		else {
+ 			$restart = 0;
+ 			unlink( $loc_fname );
+ 		}
+ 	}
+ 
+ 	if( $mapunixout ){
+ 		$rem_fname = eval "&$mapunixout( \$rem_fname, 'f' )";
+ 	}
+ 
+ 	&ftp'send( "RETR $rem_fname" );
+ 	
+ 	$ret = &ftp'expect( $timeout, 
+ 		150, 1, # receiving $rem_fname
+ 
+ 		125, 0, # data connection already open?
+ 		450, 2, # file unavailable
+ 		550, 2, # file unavailable
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		530, 0, # not logged in
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	if( $ret != 1 ){
+ 		print $showfd "Failure on 'RETR $rem_fname' command\n";
+ 
+ 		# shut down our end of the socket
+ 		&ftp'close_data_socket;
+ 
+ 		return 0;
+ 	}
+ 
+ 	accept( NS, S ) || die "accept failed $!";
+ 
+ 	# 
+ 	# the data should be coming at us now
+ 	#
+ 
+ 	#
+ 	#  open the local fname
+ 	#  concatenate on the end if restarting, else just overwrite
+ 	if( !open( FH, ($restart ? '>>' : '>') . $loc_fname ) ){
+ 		print $showfd "Cannot create local file $loc_fname\n";
+ 
+ 		# shut down our end of the socket
+ 		&ftp'close_data_socket;
+ 
+ 		return 0;
+ 	}
+ 
+ 	local( $start_time ) = time;
+ 	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
+ 	local( $old_sig ) = $SIG{ 'ALRM' };
+ 	$SIG{ 'ALRM' } = "ftp\'read_alarm";
+ 	while( ($len = &ftp'read()) > 0 ){
+ 		$bytes += $len;
+ 		if( $strip_cr ){
+ 			$buf =~ s/\r//g;
+ 		}
+ 		if( $ftp_show ){
+ 			while( $bytes > ($lasthash + $hashevery) ){
+ 				print $showfd '#';
+ 				$lasthash += $hashevery;
+ 				$hashes++;
+ 				if( ($hashes % $hashnl) == 0 ){
+ 					print $showfd "\n";
+ 				}
+ 			}
+ 		}
+ 		if( ! print FH $ftpbuf ){
+ 			print $showfd "\nfailed to write data";
+ 			$bytes = -1;
+ 			last;
+ 		}
+ 		if ($bytes > $MAX_TRANSFER_SIZE) {
+ 			printf $showfd ("ftp.pl: WARNING!: transfer has exceeded %d bytes of data, aborting.\n", $MAX_TRANSFER_SIZE);
+ 			last;
+ 		}
+ 	}
+ 	$SIG{ 'ALRM' } = $old_sig;
+ 	close( FH );
+ 
+ 	# shut down our end of the socket
+ 	&ftp'close_data_socket;
+ 
+ 	if( $len < 0 ){
+ 		print $showfd "\ntimed out reading data!\n";
+ 
+ 		return 0;
+ 	}
+ 		
+ 	if( $ftp_show && $bytes > 0 ){
+ 		if( $hashes && ($hashes % $hashnl) != 0 ){
+ 			print $showfd "\n";
+ 		}
+ 		local( $secs ) = (time - $start_time);
+ 		if( $secs <= 0 ){
+ 			$secs = 1; # To avoid a divide by zero;
+ 		}
+ 
+ 		local( $rate ) = int( $bytes / $secs );
+ 		print $showfd "Got $bytes bytes ($rate bytes/sec)\n";
+ 	}
+ 
+ 	#
+ 	# read the close
+ 	#
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		226, 1, # transfer complete, closing connection
+ 	        250, 1, # action completed
+ 	
+ 	        110, 0, # restart not supported
+ 	        425, 0, # can't open data connection
+ 	        426, 0, # connection closed, transfer aborted
+ 	        451, 0, # action aborted, local error
+ 		550, 0, # permission denied
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	if( $ret && $bytes < 0 ){
+ 		$ret = 0;
+ 	}
+ 
+ 	return $ret;
+ }
+ 
+ sub ftp'delete
+ {
+ 	local( $rem_fname ) = @_;
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $mapunixout ){
+ 		$rem_fname = eval "&$mapunixout( \$rem_fname, 'f' )";
+ 	}
+ 
+ 	&ftp'send( "DELE $rem_fname" );
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		250, 1, # Deleted $rem_fname
+ 		550, 0, # Permission denied
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	return $ret == 1;
+ }
+ 
+ sub ftp'deldir
+ {
+     local( $fname ) = @_;
+ 
+     # not yet implemented
+     # RMD
+ }
+ 
+ # UPDATE ME!!!!!!
+ # Add in the hash printing and newline conversion
+ sub ftp'put
+ {
+ 	local( $loc_fname, $rem_fname ) = @_;
+ 	local( $strip_cr );
+ 	
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $loc_fname eq "" ){
+ 		$loc_fname = $rem_fname;
+ 	}
+ 	
+ 	if( ! &ftp'open_data_socket() ){
+ 		return 0;
+ 	}
+ 	
+ 	if( $mapunixout ){
+ 		$rem_fname = eval "&$mapunixout( \$rem_fname, 'f' )";
+ 	}
+ 
+ 	&ftp'send( "STOR $rem_fname" );
+ 	
+ 	# 
+ 	# the data should be coming at us now
+ 	#
+ 	
+ 	local( $ret ) =
+ 	&ftp'expect( $timeout, 
+ 		150, 1, # sending $loc_fname
+ 
+ 		125, 0, # data connection already open?
+ 		450, 0, # file unavailable
+ 		532, 0, # need account for storing files
+ 		452, 0, # insufficient storage on system
+ 		553, 0, # file name not allowed
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		530, 0, # not logged in
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	if( $ret != 1 ){
+ 		# shut down our end of the socket
+ 		&ftp'close_data_socket;
+ 
+ 		return 0;
+ 	}
+ 
+ 
+ 	accept( NS, S ) || die "accept failed $!";
+ 
+ 	# 
+ 	# the data should be coming at us now
+ 	#
+ 	
+ 	#
+ 	#  open the local fname
+ 	#
+ 	if( !open( FH, "<$loc_fname" ) ){
+ 		print $showfd "Cannot open local file $loc_fname\n";
+ 
+ 		# shut down our end of the socket
+ 		&ftp'close_data_socket;
+ 
+ 		return 0;
+ 	}
+ 	
+ 	while( <FH> ){
+ 		if( ! $service_open ){
+ 			last;
+ 		}
+ 		print NS ;
+ 	}
+ 	close( FH );
+ 	
+ 	# shut down our end of the socket to signal EOF
+ 	&ftp'close_data_socket;
+ 	
+ 	#
+ 	# read the close
+ 	#
+ 	
+ 	$ret = &ftp'expect( $timeout, 
+ 		226, 1, # transfer complete, closing connection
+ 		250, 1, # action completed
+ 	
+ 		110, 0, # restart not supported
+ 		425, 0, # can't open data connection
+ 		426, 0, # connection closed, transfer aborted
+ 		451, 0, # action aborted, local error
+ 		551, 0, # page type unknown
+ 		552, 0, # storage allocation exceeded
+ 	
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	if( ! $ret ){
+ 		print $showfd "Failure on 'STOR $loc_fname' command\n";
+ 	}
+ 	return $ret;
+ }
+ 
+ sub ftp'restart
+ {
+ 	local( $restart_point, $ret ) = @_;
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	&ftp'send( "REST $restart_point" );
+ 
+ 	# 
+ 	# see what they say
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		350, 1, # restarting at $restart_point
+ 			   
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		502, 2, # REST not implemented
+ 		530, 0, # not logged in
+ 		545, 2, # REST not implemented
+ 		554, 2, # REST not implemented
+ 			   
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	return $ret;
+ }
+ 
+ # Set the file transfer type
+ sub ftp'type
+ {
+ 	local( $type ) = @_;
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	&ftp'send( "TYPE $type" );
+ 
+ 	# 
+ 	# see what they say
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		200, 1, # file type set to $type
+ 			   
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		504, 0, # Invalid form or byte size for type $type
+ 			   
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	return $ret;
+ }
+ 
+ $site_command_check = 0;
+ @site_command_list = ();
+ 
+ # routine to query the remote server for 'SITE' commands supported
+ sub ftp'site_commands
+ {
+ 	local( $ret );
+ 	
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	# if we havent sent a 'HELP SITE', send it now
+ 	if( !$site_command_check ){
+ 	
+ 		$site_command_check = 1;
+ 	
+ 		&ftp'send( "HELP SITE" );
+ 	
+ 		# assume the line in the HELP SITE response with the 'HELP'
+ 		# command is the one for us
+ 		$ret = &ftp'expect( $timeout,
+ 			".*HELP.*", "\$1",
+ 			214, "0",
+ 			202, "0",
+ 			421, "99" ); # service unavailable, closing connection
+ 		if( $ret == 99 ){
+ 			&service_closed();
+ 			$ret = "0";
+ 		}
+ 	
+ 		if( $ret eq "0" ){
+ 			print $showfd "No response from HELP SITE\n" if( $ftp_show );
+ 		}
+ 	
+ 		@site_command_list = split(/\s+/, $ret);
+ 	}
+ 	
+ 	return @site_command_list;
+ }
+ 
+ # return the pwd, or null if we can't get the pwd
+ sub ftp'pwd
+ {
+ 	local( $ret, $cwd );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	&ftp'send( "PWD" );
+ 
+ 	# 
+ 	# see what they say
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		251, 1, # working dir is		# DG/UX
+ 		257, 1, # working dir is
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		502, 0, # PWD not implemented
+ 		550, 0, # file unavailable
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	if( $ret ){
+ 		if( $response =~ /^25[0-9]\s"(.*)"\s.*$/ ){
+ 			$cwd = $1;
+ 		}
+ 	}
+ 	return $cwd;
+ }
+ 
+ # return 1 for success, 0 for failure
+ sub ftp'mkdir
+ {
+ 	local( $path ) = @_;
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $mapunixout ){
+ 		$path = eval "&$mapunixout( \$path, 'f' )";
+ 	}
+ 
+ 	&ftp'send( "MKD $path" );
+ 
+ 	# 
+ 	# see what they say
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		257, 1, # made directory $path
+ 			   
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		502, 0, # MKD not implemented
+ 		530, 0, # not logged in
+ 		550, 0, # file unavailable
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	return $ret;
+ }
+ 
+ # return 1 for success, 0 for failure
+ sub ftp'chmod
+ {
+ 	local( $path, $mode ) = @_;
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $mapunixout ){
+ 		$path = eval "&$mapunixout( \$path, 'f' )";
+ 	}
+ 
+ 	&ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
+ 
+ 	# 
+ 	# see what they say
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		200, 1, # chmod $mode $path succeeded
+ 			   
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		502, 0, # CHMOD not implemented
+ 		530, 0, # not logged in
+ 		550, 0, # file unavailable
+ 
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	return $ret;
+ }
+ 
+ # rename a file
+ sub ftp'rename
+ {
+ 	local( $old_name, $new_name ) = @_;
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	if( $mapunixout ){
+ 		$old_name = eval "&$mapunixout( \$old_name, 'f' )";
+ 	}
+ 
+ 	&ftp'send( "RNFR $old_name" );
+ 
+ 	# 
+ 	# see what they say
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		350, 1, #  OK
+ 			   
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		502, 0, # RNFR not implemented
+ 		530, 0, # not logged in
+ 		550, 0, # file unavailable
+ 		450, 0, # file unavailable
+ 			   
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 
+ 	# check if the "rename from" occurred ok
+ 	if( $ret ){
+ 		if( $mapunixout ){
+ 			$new_name = eval "&$mapunixout( \$new_name, 'f' )";
+ 		}
+ 
+ 		&ftp'send( "RNTO $new_name" );
+ 	
+ 		# 
+ 		# see what they say
+ 	
+ 		$ret = &ftp'expect( $timeout, 
+ 			250, 1,  # rename $old_name to $new_name
+ 
+ 			500, 0, # syntax error
+ 			501, 0, # syntax error
+ 			502, 0, # RNTO not implemented
+ 			503, 0, # bad sequence of commands
+ 			530, 0, # not logged in
+ 			532, 0, # need account for storing files
+ 			553, 0, # file name not allowed
+ 
+ 			421, 99 ); # service unavailable, closing connection
+ 		if( $ret == 99 ){
+ 			&service_closed();
+ 			$ret = 0;
+ 		}
+ 	}
+ 
+ 	return $ret;
+ }
+ 
+ 
+ sub ftp'quote
+ {
+ 	local( $cmd ) = @_;
+ 	local( $ret );
+ 
+ 	if( ! $service_open ){
+ 		return 0;
+ 	}
+ 
+ 	&ftp'send( $cmd );
+ 
+ 	$ret = &ftp'expect( $timeout, 
+ 		200, 1, # Remote '$cmd' OK
+                 213, 1, # SIZE command OK
+ 		500, 0, # error in remote '$cmd'
+ 		421, 99 ); # service unavailable, closing connection
+ 	if( $ret == 99 ){
+ 		&service_closed();
+ 		$ret = 0;
+ 	}
+ 	return $ret;
+ }
+ 
+ # ------------------------------------------------------------------------------
+ # These are the lower level support routines
+ 
+ sub ftp'expectgot
+ {
+ 	($response, $fatalerror) = @_;
+ 	if( $ftp_show ){
+ 		print $showfd "$response\n";
+ 	}
+ }
+ 
+ #
+ #  create the list of parameters for chat'expect
+ #
+ #  ftp'expect(time_out, {value, return value});
+ #  the last response is stored in $response
+ #
+ sub ftp'expect
+ {
+ 	local( $ret );
+ 	local( $time_out );
+ 	local( @expect_args );
+ 	local( $code, $pre );
+ 	
+ 	$response = '';
+ 	$fatalerror = 0;
+ 
+ 	$time_out = shift( @_ );
+ 	
+ 	while( @_ ){
+ 		$code = shift( @_ );
+ 		$pre = '^';
+ 		if( $code =~ /^\d+$/ ){
+ 			$pre = "[.|\n]*^";
+ 		}
+ 		push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
+ 		push( @expect_args, 
+ 			"&expectgot( \$1, 0 ); " . shift( @_ ) );
+ 	}
+ 	
+ 	# Treat all unrecognised lines as continuations
+ 	push( @expect_args, "^(.*)\\015\\n" );
+ 	push( @expect_args, "&expectgot( \$1, 0 ); 100" );
+ 	
+ 	# add patterns TIMEOUT and EOF
+ 	
+ 	push( @expect_args, 'TIMEOUT' );
+ 	push( @expect_args, "&expectgot( 'timed out', 0 ); 0" );
+ 	
+ 	push( @expect_args, 'EOF' );
+ 	push( @expect_args, "&expectgot( 'remote server gone away', 1 ); 99" );
+ 	
+ 	if( $ftp_show > 9 ){
+ 		&printargs( $time_out, @expect_args );
+ 	}
+ 	
+ 	$ret = &chat'expect( $time_out, @expect_args );
+ 	if( $ret == 100 ){
+ 		# we saw a continuation line, wait for the end
+ 		push( @expect_args, "^.*\n" );
+ 		push( @expect_args, "100" );
+ 	
+ 		while( $ret == 100 ){
+ 			if( $ftp_show > 9 ){
+ 				&printargs( $time_out, @expect_args );
+ 			}
+ 			$ret = &chat'expect( $time_out, @expect_args );
+ 		}
+ 	}
+ 
+ 	return $ret;
+ }
+ 
+ 
+ #
+ #  opens NS for io
+ #
+ sub ftp'open_data_socket
+ {
+ 	local( $sockaddr, $port );
+ 	local( $type, $myaddr, $a, $b, $c, $d );
+ 	local( $mysockaddr, $family, $hi, $lo );
+ 	
+ 	$sockaddr = 'S n a4 x8';
+ 
+ 	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
+ 	$this = $chat'thisproc;
+ 	
+ 	socket( S, $pf_inet, $sock_stream, $tcp_proto ) || die "socket: $!";
+ 	bind( S, $this ) || die "bind: $!";
+ 	
+ 	# get the port number
+ 	$mysockaddr = getsockname( S );
+ 	($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
+ 	
+ 	$hi = ($port >> 8) & 0x00ff;
+ 	$lo = $port & 0x00ff;
+ 	
+ 	#
+ 	# we MUST do a listen before sending the port otherwise
+ 	# the PORT may fail
+ 	#
+ 	listen( S, 5 ) || die "listen";
+ 	
+ 	&ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
+ 	
+ 	return &ftp'expect($timeout,
+ 		200, 1, # PORT command successful
+ 		250, 1, # PORT command successful
+ 
+ 		500, 0, # syntax error
+ 		501, 0, # syntax error
+ 		530, 0, # not logged in
+ 
+ 		421, 0); # service unavailable, closing connection
+ }
+ 	
+ sub ftp'close_data_socket
+ {
+ 	close( NS );
+ }
+ 
+ sub ftp'send
+ {
+ 	local( $send_cmd ) = @_;
+ 
+ 	if( $send_cmd =~ /\n/ ){
+ 		print $showfd "ERROR, \\n in send string for $send_cmd\n";
+ 	}
+ 	
+ 	if( $ftp_show ){
+ 		local( $sc ) = $send_cmd;
+ 
+ 		if( $send_cmd =~ /^PASS/){
+ 			$sc = "PASS <somestring>";
+ 		}
+ 		print $showfd "---> $sc\n";
+ 	}
+ 	
+ 	&chat'print( "$send_cmd\r\n" );
+ }
+ 
+ sub ftp'printargs
+ {
+ 	while( @_ ){
+ 		print $showfd shift( @_ ) . "\n";
+ 	}
+ }
+ 
+ sub ftp'filesize
+ {
+ 	local( $fname ) = @_;
+ 
+ 	if( ! -f $fname ){
+ 		return -1;
+ 	}
+ 
+ 	return (stat( _ ))[ 7 ];
+ 	
+ }
+ 
+ # make this package return true
+ 1;

