Article 527 of alt.sources:
Xref: feenix.metronet.com alt.sources:527
Newsgroups: alt.sources
Path: feenix.metronet.com!news.utdallas.edu!wupost!psuvax1!postscript.cs.psu.edu!fenner
From: fenner@postscript.cs.psu.edu (Bill Fenner)
#Subject: rftp server, do FTP via UUCP to a directly-connected Internet host
Message-ID: <C370pv.4yC@cs.psu.edu>
Sender: news@cs.psu.edu (Usenet)
Nntp-Posting-Host: postscript.cs.psu.edu
Organization: Penn State Computer Science
Date: Mon, 1 Mar 1993 04:34:42 GMT
Lines: 678

This is an alpha release of my "rftp" server.

"rftp" is designed to run on a directly-connected Internet host, and allows
its UUCP neighbors to use it as an FTP server.  The Internet host can ftp for
a file and UUCP it back to the requesting site.

"rftp" has currently only been tested under SunOS 4.1, since that's what's
running on the only site that I have a UUCP connection to.  It will probably
require modification to work with a BSD-ish UUCP system.  If you do this,
I'd appreciate it if you'd send me your mods and I'll incorporate them.

Note that this rftp server is compatible with the UUPSI "uuftp" client
available from ftp.psi.com.

Bill Fenner
fenner@cs.psu.edu


#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 1 (of 1)."
# Contents:  MANIFEST README ftplib.pl rftp
# Wrapped by fenner@postscript on Sun Feb 28 23:34:19 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'MANIFEST' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'MANIFEST'\"
else
echo shar: Extracting \"'MANIFEST'\" \(300 characters\)
sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
X   File Name		Archive #	Description
X-----------------------------------------------------------
X MANIFEST                   1	This file
X README                     1	Meager documentation
X ftplib.pl                  1	Gene Spafford's perl-ftp library
X rftp                       1	My rftp perl script
END_OF_FILE
if test 300 -ne `wc -c <'MANIFEST'`; then
    echo shar: \"'MANIFEST'\" unpacked with wrong size!
fi
# end of 'MANIFEST'
fi
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(1978 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XThis is an alpha release of my "rftp" server.
X
X"rftp" is designed to run on a directly-connected Internet host, and allows
Xits UUCP neighbors to use it as an FTP server.  The Internet host can ftp for
Xa file and UUCP it back to the requesting site.
X
X"rftp" has currently only been tested under SunOS 4.1, since that's what's
Xrunning on the only site that I have a UUCP connection to.  It will probably
Xrequire modification to work with a BSD-ish UUCP system.  If you do this,
XI'd appreciate it if you'd send me your mods and I'll incorporate them.
X
XTo install "rftp", you must:
X0) install perl
X1) put "rftp" in a place that uuxqt can find it
X2) put "ftplib.pl" in a place that "rftp" can find it [see the first couple
X    of lines of "rftp"]
X3) modify "rftp" as noted in the comments - change the maintainer if
X    needed (maintainer will probably get a lot of mail)
X4) modify your Permissions file to allow execution of "rftp".  An example
Xfrom psuvax1's Permissions file:
XMACHINE=hogbbs LOGNAME=uuhogbbs \
X	COMMANDS=rmail:/usr/local/bin/rnews:/home/curly/fenner/bin/rftp \
X	REQUEST=yes SENDFILES=yes
X5) make sure that uucp is allowed to use "at", or come up with some other
X    scheme of rescheduling failed connections.
X
X
XTo use "rftp", you must create a command file:
X
Xuser=(username on UUCP site doing the request)
Xnode=(nodename of UUCP site doing the request)
Xname=(filename to be UUCP'd back to on originating site)
Xfile=(filename to be FTP'd, or "/DIR" or "/LIST")
Xpath=(directory file is in, or directory to be listed)
Xhost=(host to FTP to)
Xtype=(ascii or binary)
X
XExample:
X
Xuser=wcf
Xnode=hogbbs
Xname=~/uuftp/waf165.zip
Xfile=waf165.zip
Xpath=/mirrors/msdos/waffle
Xhost=wuarchive.wustl.edu
Xtype=binary
X
XThen, on the UUCP host, simply
X
Xuux - <neighbor>!rftp < file
X
XNote that this rftp server is compatible with the UUPSI "uuftp" client
Xavailable from ftp.psi.com.
X
XPlease let me know if you have any problems, suggestions, enhancements...
X
XBill Fenner
Xfenner@cs.psu.edu
END_OF_FILE
if test 1978 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'ftplib.pl' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ftplib.pl'\"
else
echo shar: Extracting \"'ftplib.pl'\" \(8490 characters\)
sed "s/^X//" >'ftplib.pl' <<'END_OF_FILE'
X#
X#   This is a set of ftp library routines using chat2.pl
X# 
X#   Return code information taken from RFC 959
X
X#   Written by Gene Spafford  <spaf@cs.purdue.edu>
X#       Last update: 10 April 92,   Version 0.9
X#
X#   Modified by Bill Fenner   <fenner@cs.psu.edu>
X#    to handle some multi-line responses.
X
X#
X#   Most of these routines communicate over an open ftp channel
X#   The channel is opened with the "ftp'open" call.
X#
X
Xpackage ftp;
Xrequire "chat2.pl";
Xrequire "syscall.ph";
X
X
X###########################################################################
X#
X#  The following are the variables local to this package.
X#  I declare them all up front so I can remember what I called 'em. :-)
X#
X###########################################################################
X
XLOCAL_VARS: {	
X    $Control;
X    $Data_handle;
X    $Host;
X    $Myhost = "\0" x 65;
X    (syscall(&SYS_gethostname, $Myhost, 65) == 0) || 
X	die "Cannot 'gethostname' of local machine (in ftplib)\n";
X    $Myhost =~ s/\0*$//;
X    $NeedsCleanup;
X    $NeedsClose;
X    $ftp_error;
X    $ftp_matched;
X    $ftp_trans_flag;
X    @ftp_list;
X
X    local(@tmp) = getservbyname("ftp", "tcp");
X    ($FTP = $tmp[2]) || 
X	die "Unable to get service number for 'ftp' (in ftplib)!\n";
X
X    @std_actions = (
X	    'TIMEOUT',
X	    q($ftp_error = "Fatal conversastion timeout for $Host!\n"; undef),
X	    'EOF', 
X	    q($ftp_error = "Connection to $Host closed unexpectedly!\n"; undef)
X    );
X
X    @sigs = ('INT', 'HUP', 'TERM', 'QUIT');  # sigs we'll catch & terminate on
X}
X
X
X
X###########################################################################
X#
X#  The following are intended to be the user-callable routines.
X#  Each of these does one of the ftp keyword functions.
X#
X###########################################################################
X
Xsub error { ## Public
X    $ftp_error;
X}
X  
X#######################################################
X
X#   cd up a directory level
X
Xsub cdup { ## Public
X    &do_ftp_cmd(200, "cdup");
X}
X
X#######################################################
X
X# close an open ftp connection
X
Xsub close { ## Public
X    return unless $NeedsClose;
X    &do_ftp_cmd(221, "quit");
X    &chat'close($Control);
X    undef $NeedsClose;
X    &do_ftp_signals(0);
X}
X
X#######################################################
X
X# change remote directory
X
Xsub cwd { ## Public
X    &do_ftp_cmd(250, "cwd", @_);
X}
X  
X#######################################################
X
X#  delete a remote file
X
Xsub delete { ## Public
X     &do_ftp_cmd(250, "dele", @_); 
X}
X
X#######################################################
X
X#  get a directory listing of remote directory ("ls -l")
X
Xsub dir { ## Public
X    &do_ftp_listing("list", @_);
X}
X
X#######################################################
X
X#  get a remote file to a local file
X#    get(remote[, local])
X
Xsub get { ## Public
X    local($remote, $local) = @_;
X    ($local = $remote) unless $local;
X
X    unless (open(DFILE, ">$local")) {
X	$ftp_error =  "Open of local file $local failed: $!";
X	return undef;
X    } else {
X	$NeedsCleanup = $local;
X    }
X
X    return undef unless &do_open_dport; 	# Open a data channel
X    unless (&do_ftp_cmd(150, "retr $remote")) {
X	$ftp_error .= "\nFile $remote not fetched from $Host\n";
X	close DFILE;
X	unlink $local;
X	undef $NeedsCleanup;
X	return;
X    }
X
X    $ftp_trans_flag = 0;
X
X    do {
X	&chat'expect($Data_handle, 60,
X		     '.|\n', q{print DFILE ($chat'thisbuf) ||
X			($ftp_trans_flag = 3); undef $chat'S},
X		     'EOF',  '$ftp_trans_flag = 1',
X		     'TIMEOUT', '$ftp_trans_flag = 2');
X    } until $ftp_trans_flag;
X
X    close DFILE;
X    &chat'close($Data_handle);		# Close the data channel
X
X    undef $NeedsCleanup;
X    if ($ftp_trans_flag > 1) {
X	unlink $local;
X	$ftp_error = "Unexpected " . ($ftp_trans_flag == 2 ? "timeout" :
X		($ftp_trans_flag != 3 ? "failure" : "local write failure")) .
X                " getting $remote\n";
X    }
X    
X    &do_ftp_cmd(226);
X}
X
X#######################################################
X
X#  Do a simple name list ("ls")
X
Xsub list { ## Public
X    &do_ftp_listing("nlst", @_);
X}
X
X#######################################################
X
X#   Make a remote directory
X
Xsub mkdir { ## Public
X    &do_ftp_cmd(257, "mkd", @_);
X}
X
X#######################################################
X
X#  Open an ftp connection to remote host
X
Xsub open {  ## Public
X    if ($NeedsClose) {
X	$ftp_error = "Connection still open to $Host!";
X	return undef;
X    }
X
X    $Host = shift(@_);
X    local($User, $Password, $Acct) = @_;
X    $User = "anonymous" unless $User;
X    $Password = "-" . $main'ENV{'USER'} . "@$Myhost" unless $Password;
X    $ftp_error = '';
X
X    unless($Control = &chat'open_port($Host, $FTP)) {
X	$ftp_error = "Unable to connect to $Host ftp port: $!";
X	return undef;
X    }
X
X    while(($i=&chat'expect($Control, 60,
X			"^220-.*\n",	 "2",
X		        "^220 .*\n",	 "1",
X		        "^\d\d\d .*\n",  "undef"))==2) {
X    }
X
X    if (!$i) {
X	$ftp_error = "Error establishing control connection to $Host";
X        &chat'close($Control);
X	return undef;
X    }
X    &do_ftp_signals($NeedsClose = 1);
X
X    unless (&do_ftp_cmd(331, "user $User")) {
X	$ftp_error .= "\nUser command failed establishing connection to $Host";
X	return undef;
X    }
X
X    unless (&do_ftp_cmd("(230|332|202)", "pass $Password")) {
X	$ftp_error .= "\nPassword command failed establishing connection to $Host";
X	return undef;
X    }
X
X    return 1 unless $Acct;
X
X    unless (&do_ftp_cmd("(230|202)", "pass $Password")) {
X	$ftp_error .= "\nAcct command failed establishing connection to $Host";
X	return undef;
X    }
X    1;
X}
X
X#######################################################
X
X#  Get name of current remote directory
X
Xsub pwd { ## Public
X    if (&do_ftp_cmd(257, "pwd")) {
X	$ftp_matched =~ m/^257 (.+)\r?\n/;
X	$1;
X    } else {
X	undef;
X    }    
X}
X
X#######################################################
X
X#  Rename a remote file
X
Xsub rename { ## Public
X    local($from, $to) = @_;
X
X    &do_ftp_cmd(350, "rnfr $from") && &do_ftp_cmd(250, "rnto $to");
X}
X
X#######################################################
X
X#  Set transfer type
X
Xsub type { ## Public
X    &do_ftp_cmd(200, "type", @_); 
X}
X
X
X###########################################################################
X#
X#  The following are intended to be utility routines used only locally.
X#  Users should not call these directly.
X#
X###########################################################################
X
Xsub do_ftp_cmd {  ## Private
X    local($okay, @commands, $val) = @_;
X
X    $commands[0] && 
X	&chat'print($Control, join(" ", @commands), "\r\n");
X
X    &chat'expect($Control, 60, 
X		 "^$okay .*\\n",        '$ftp_matched = $&; 1',
X		 '^(\d)\d\d .*\\n', '($String = $&) =~ y/\r\n//d; 
X		     $ftp_error = qq{Unexpected reply for ' .
X		     "@commands" . ': $String}; 
X		     $1 > 3 ? undef : 1',
X		 @std_actions
X		);
X}
X
X#######################################################
X
Xsub do_ftp_listing { ## Private
X    local(@lcmd) = @_;
X    @ftp_list = ();
X    $ftp_trans_flag = 0;
X
X    return undef unless &do_open_dport;
X
X    return undef unless &do_ftp_cmd(150, @lcmd);
X    do {			#  Following is grotty, but chat2 makes us do it
X        &chat'expect($Data_handle, 30,
X		"(.*)\r?\n",    'push(@ftp_list, $1)',
X		"EOF",     '$ftp_trans_flag = 1');
X    } until $ftp_trans_flag;
X
X    &chat'close($Data_handle);
X    return undef unless &do_ftp_cmd(226);
X
X    grep(y/\r\n//d, @ftp_list);
X    @ftp_list;
X}  
X
X#######################################################
X
Xsub do_open_dport { ## Private
X    local(@foo, $port) = &chat'open_listen;
X    ($port, $Data_handle) = splice(@foo, 4, 2);
X
X    unless ($Data_handle) {
X	$ftp_error =  "Unable to open data port: $!";
X	return undef;
X    }
X
X    push(@foo, $port >> 8, $port & 0xff);
X    local($myhost) = (join(',', @foo));
X    
X    &do_ftp_cmd(200, "port $myhost");
X}
X
X#######################################################
X#
X#  To cleanup after a problem
X#
X
Xsub do_ftp_abort {
X    die unless $NeedsClose;
X
X    &chat'print($Control, "abor", "\r\n");
X    &chat'close($Data_handle);
X    &chat'expect($Control, 10, '.', undef);
X    &chat'close($Control);
X
X    close DFILE;
X    unlink($NeedsCleanup) if $NeedsCleanup;
X    die;
X}
X
X#######################################################
X#
X#  To set signals to do the abort properly
X#
X
Xsub do_ftp_signals {
X    local($flag, $sig) = @_;
X
X    local ($old, $new) = ('DEFAULT', "ftp'do_ftp_abort");
X    $flag || (($old, $new) = ($new, $old));
X    foreach $sig (@sigs) {
X	($SIG{$sig} == $old) && ($SIG{$sig} = $new);
X    }
X}
X
X1;
END_OF_FILE
if test 8490 -ne `wc -c <'ftplib.pl'`; then
    echo shar: \"'ftplib.pl'\" unpacked with wrong size!
fi
# end of 'ftplib.pl'
fi
if test -f 'rftp' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'rftp'\"
else
echo shar: Extracting \"'rftp'\" \(4296 characters\)
sed "s/^X//" >'rftp' <<'END_OF_FILE'
X#!/usr/bin/perl
X#
X# RFTP - uuftp server
X#
X# $Id: rftp,v 1.5 1993/03/01 04:27:15 fenner Exp $
X#
X# This goes in a place that UUXQT can get to it, and gets put into
X# Permissions (or your equivalent; I forget what the BSD thing is... OKCMDS?)
X#
X#
X# The following is where ftplib.pl is on your system.  You can remove
X# the unshift if ftplib.pl is in the default perl library directory.
Xunshift(@INC,"/home/curly/fenner/lib/perl");
Xrequire 'ftplib.pl';
X
X## touch this part
X#
X# This is a place to put files temporarily.  Could be /tmp.
X$localspool="/usr/spool/uucppublic";
X#
X# This is who to send mail to when something goes wrong.
X$maintainer="root";
X#
X# This is the shell to make at give us.  /bin/sh is a good one.
X$atshell="/bin/sh";
X## don't touch the rest (unless it breaks =) )
X
X$*=1;
X# $*=1 is required because sunsite.unc.edu returns messages like
X# 331-foo foo bar
X# 331 bar baz bip
X#
X# and ftplib.pl matches stuff like ^331 .*\n
X# and $* must be 1 to match multiline strings
X#
X
X$outfile="/tmp/rftp.$$";
X
X$SIG{'INT'}="cleanup";
X
X@reqinfo=('user','node','name','file','path','host','type');
X
Xopen(STDOUT,">$outfile");
X
Xwhile (<STDIN>) {
X	chop;
X	($key,$val)=split(/=/,$_,2);
X	$config{$key}=$val;
X}
X
X# If you're not running HDB, you might have to change the authentication
X# mechanism, or eliminate it (once again, I don't remember how BSD does it.)
X$user=$ENV{'UU_USER'};
X$host=$ENV{'UU_MACHINE'};
X
X$die=0;
Xforeach $i (@reqinfo) {
X	if (!defined($config{$i})) {
X		print "Missing required parameter $i!\n";
X		$die=1;
X	}
X}
Xif ($die) {
X	&cleanup;
X}
X
X# We must allow host!user in the UU_USER env variable... sigh...
Xif ((($user ne $config{'user'}) && ($user ne $host.'!'.$config{'user'})) || ($host ne $config{'node'})) {
X	print "You're $user@$host, not $config{'user'}@$config{'node'}!\n";
X	print "We don't like charlatans!\n";
X	$copymaint=1;
X	&cleanup;
X}
Xif ($config{'file'} eq '/LIST') {
X	$dironly=1;
X	$dir=0;
X} elsif ($config{'file'} eq '/DIR') {
X	$dironly=1;
X	$dir=1;
X} elsif ($config{'file'} =~ m#/#) {
X	print "Filenames may not have slashes in them; directory information\n";
X	print "goes in the 'path=' config line.\n";
X	$copymaint=1;
X	&cleanup;
X}
X$config{'tries'}++;
Xprint "This is try number $config{'tries'}.\n";
Xprint "Opening connection to $config{'host'}...\n";
X&ftp'open($config{'host'},undef,undef) || &fail(1);
Xif ($dironly) {
X	print "Getting list of files...\n";
X	if ($dir) {
X		(@files = &ftp'dir($config{'path'})) || &fail(0);
X	} else {
X		(@files = &ftp'list($config{'path'})) || &fail(0);
X	}
X	print "List of files in $config{'host'}:$config{'path'} follows:\n";
X	$\ = "\n";
X	grep (print,@files);
X	$\ = "";
X	print "End of list.\n";
X} else {
X	print "Setting file type $config{'type'}...\n";
X	&ftp'type(($config{'type'} eq 'ascii') ? "a" : "i") || &fail(0);
X	print "Getting file $config{'path'}/$config{'file'}...\n";
X	&ftp'get($config{'path'}."/".$config{'file'},$localspool."/".$config{'file'}) || &fail(0);
X}
X&ftp'close;
X
Xif (!$dironly) {
X	print "Copying file back to your system...\n";
X	system("/usr/bin/uucp","-C",$localspool."/".$config{'file'},$host."!".$config{'name'});
X	# check return value of uucp?...
X}
X
X&cleanup;
X
Xsub cleanup {
X	close(STDOUT);
X#	system("cat $outfile 1>&2");
X	system("/usr/ucb/mail -s \"Your rftp request to $config{'host'}\" $user@$host.uucp < $outfile");
X	if ($copymaint) {
X		system("/usr/ucb/mail -s \"rftp request from $user@$host\" $maintainer < $outfile");
X	}
X	unlink $outfile;
X	unlink $localspool."/".$config{'file'};	# if we created the file, 
X						# we can remove it, since
X						# uucp made a copy of it
X	exit 0;
X}
X
Xsub fatalerr {
X	local($_)=@_;
X
X	return 0 if /Network is unreachable/;
X	return 0 if /Host is unreachable/;
X	return 0 if /Connection timed out/;
X	1;
X}
X
Xsub fail {
X	local($okretry)=@_;
X
X	print "FTP failed:\n";
X	print &ftp'error,"\n";
X	if (!$okretry || &fatalerr(&ftp'error) || $config{'tries'} > 5) {
X		print "\n";
X		print "Your request will not be retried.\n";
X	} else {
X		print "\n";
X		print "Your request will be retried in $config{'tries'} hour(s).\n";
X		$ENV{'SHELL'}=$atshell;	# else we get uucico...
X		open(ATJOB,"|at now + ".$config{'tries'}." hour");
X		print ATJOB "$0 << EOF\n";
X		foreach $i (keys %config) {
X			print ATJOB "$i=$config{$i}\n";
X		}
X		print ATJOB "EOF\n";
X		close(ATJOB);
X	}
X	$copymaint=1;
X	&cleanup;
X}
END_OF_FILE
if test 4296 -ne `wc -c <'rftp'`; then
    echo shar: \"'rftp'\" unpacked with wrong size!
fi
chmod +x 'rftp'
# end of 'rftp'
fi
echo shar: End of archive 1 \(of 1\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have the archive.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0