home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.muug.mb.ca
/
2014.06.ftp.muug.mb.ca.tar
/
ftp.muug.mb.ca
/
pub
/
src
/
gopher
/
gopher1.01
/
misc
/
gopher2ftp
/
gopherftp
< prev
next >
Wrap
Text File
|
1992-04-05
|
9KB
|
360 lines
#!/usr/local/bin/perl
#
# usage:
# g2ftpd [-p port] [-D] [-h hostname] [-l logfile]
#
# $Log: g2ftpd,v $
# Revision 1.0.1.? 1992/03/10 fxa
# - hacked in double nslook to get full local domainname
# Revision 1.0.1.6 1992/03/09 23:55:03 jladwig
# - Changed domainname (myDomain) parsing to strip only up to first dot,
# without regard to total number of dots.
#
# - Now do double fork() for each accepted process, to try to eliminate
# zombies reported on A/UX by Farhad.
#
# Revision 1.0.1.5 1992/03/07 13:28:41 jladwig
# - Program now puts itself into background successfully.
# - Rewrote getRemoteHost to use socket information instead of passed
# hostname, and return IP address if gethostybyaddr fails.
#
# Revision 1.0.1.4 1992/03/07 02:55:30 jladwig
# - Runs as a proper daemon now, although it must be initialized as a
# background process.
# - Has command-line option handling for debugging, port to listen on, log
# file, and local hostname.
# - Prints date and time to log file for all transactions.
#
# Revision 1.0.1.3 1992/03/06 23:30:11 jladwig
# Reworked program logic to something more like original version.
# Added "err_msgs" array for ftp error handling
# - WARNING - ftp error handling not tested beyond first error.
# Fixed bug in binary file type retrieval.
# Known to work on:
# unix 0.7 client w/ type 9 extensions for types 0,1,9
# mac 1.21 client for types 0,1,4
#
# Revision 1.0.1.2 1992/03/05 10:03:15 jladwig
# Folded in error reporting changes from official v0.3
#
#
# Version 0.3 with a minor patches....
#
# - jladwig - Slightly more perl-like syntax.
# Added simple configuration arrays
#
# Version 0.2 with a good many bugfixes and logging....
#----Stuff here may need to be customized for your machine----
$def_port = "7996";
$def_log = "/home/mudhoney/g2ftp.log"; #Leave this empty "" for no logging
$ftp = "/usr/ucb/ftp"; #whereever on your box this lives
#
# FTP error messages list
@err_msgs = (': No such file or directory.');
#
# File type extensions lists
#
@type_4 = ('HQX');
@type_5 = ( 'ZIP','ZOO','ARJ','ARC','LZH','HYP','PAK',
'EXE','COM','PS','GIF','PICT','PCT','TIFF','TIF'
);
@type_9 = ('TAR','Z');
@binfspec = ( @type_5, @type_9 );
#----end local customizations-------
require 'ctime.pl';
require 'getopts.pl';
do Getopts('Dh:p:l:');
if ($opt_D) { # Debugging switch
$debugging = 1;
}
if ($opt_h) { # Use passed hostname
$myName=$opt_h;
} else { # calculate hostname
chop($myHost=`hostname`); # get hostname
$myName = &nslook($myHost); #ie: gets dotted num
$myName = &nslook($myName); #ie: foo.moo.umn.edu
}
if ($opt_p) { # port at which to listen
$myPort = $opt_p;
} else {
$myPort = $def_port;
}
if ($opt_l) {
$logFile = $opt_;
} else {
$logFile = $def_log; # log file
}
# Catch signals...
#
$SIG{'INT'} = 'CLEANUP';
$SIG{'HUP'} = 'CLEANUP';
$SIG{'QUIT'} = 'CLEANUP';
$SIG{'PIPE'} = 'CLEANUP';
$SIG{'ALRM'} = 'CLEANUP';
$tmp = "/tmp/gf$$"; #I'll clean up; Promise!
$tmpData = "/tmp/gfd$$"; #This one's for spooling
$separator = "@"; #For encoding selector with hostname
$host = "";
$getBinary = "";
# shuffle off to the background...
#
(fork && exit) unless $debugging;
setpgrp(0,$$);
# Begin main program
#
# tcp server code ripped liberally from _Programming_Perl_
#
$sockaddr = 'S n a4 x8';
# $myName = &getLocalHost;
($name, $aliases, $proto) = getprotobyname('tcp');
if ($myPort !~ /^\d+$/) {
($name, $aliases, $myPort) = getservbyport($myPort, 'tcp');
}
print "Port = $myPort\n" if $debugging;
$this = pack($sockaddr, &AF_INET, $myPort, "\0\0\0\0");
select(NS); $| = 1; select(stdout);
socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind(S,$this) || die "bind: $!";
listen(S,5) || die "connect: $!";
select(S); $| = 1; select(stdout);
$con = 0;
print "Listening for connection 1....\n" if $debugging;
for(;;) {
($addr = accept(NS,S)) || die $!;
$con++;
if (($child[$con] = fork()) == 0) {
print "accept ok\n" if $debugging;
unless (fork) {
sleep 1 until getppid == 1;
($af,$port,$inetaddr) = unpack($sockaddr,$addr);
@inetaddr = unpack('C4',$inetaddr);
print "$con: $af $port @inetaddr\n" if $debugging;
&send_query;
&handle_results;
printf("Closing connection %d\n",$con) if $debugging;
close(NS);
exit 0;
}
exit 0;
}
wait;
close(NS);
printf("Listening for connection %d\n",$con+1) if $debugging;
}
exit;
# Support routines
#
# Handle the query and send it to the ftp server
#
sub send_query {
$query = <NS>;
chop($query);
chop($query);
if ( $logFile ) {
$remoteHost = &getRemoteHost;
open(LOG, ">>$logFile");
chop($date = &ctime(time));
print LOG $date, "\t$$\t$remoteHost \t- $query\n";
close(LOG);
}
if ($query eq "") {
print NS "3 Incorrectly specified request for FTP (No hostname)\r\n.\r\n";
exit;
}
($host, $thing) = split(/@/, $query, 2);
$thing = "/" if ($thing eq "");
open(FTP, "| $ftp -n $host >$tmp")
|| do {print NS "3 Error. Couldn't connect to server\r\n.\r\n"; exit;};
print FTP "user anonymous -gopher@$myName\n";
$thing2 = $thing;
$dir = chop($thing2);
if ($dir eq "/") { #asking for a dir
print FTP "cd $thing2\n" if ($thing2 ne "");
print FTP "ls -F\n";
$tmpData = "";
} else { #asking for a file
$thing = $thing2 if (($dir eq "*") || ($dir eq "@"));
if ($thing =~ /\.(\w+)$/) { # Grab file extension if there is one
$ext = $1;
$getBinary = grep (/^$ext$/, @binfspec); # Is it a binary-type extension?
}
print FTP "binary\n"
if $getBinary ;
print FTP "get $thing $tmpData\n";
}
print FTP "quit\n";
close(FTP); #re-use the fileHandle
}
# Handle the results of the ftp transfer
#
sub handle_results {
if ($tmpData eq "") { #maybe use an exists instead?
open(FTP, "$tmp")
|| do {print NS "3 Error. Could not return list.\r\n.\r\n"; die;};
while (<FTP>) {
chop;
/^.+(:.+)$/; # Extract error message, if any
if (grep (/^$1$/, @err_msgs)) { # ftp error
print NS "3 Error. ftp reports \"$1\".\r\n.\r\n";
exit;
}
s/\*$//; # Hack out stars
s#\@$#/#; # Hack out ats
if (s#/$##) { # It's a directory
print NS "1$_\t$host$separator$thing$_/";
} elsif ( /\.(\w+)$/ ) { # It's a file, Grab file extension
$ext = $1;
if (grep (/^$ext$/i, @type_4)) { # binhex file
print NS "4$_\t$host$separator$thing$_";
} elsif (grep (/^$ext$/i, @type_5)) { # DOS scrap
print NS "5$_\t$host$separator$thing$_";
} elsif (grep (/^$ext$/i, @type_9)) { # .tar .Z
print NS "9$_\t$host$separator$thing$_";
} else { # Default text file (w/ extension)
print NS "0$_\t$host$separator$thing$_";
}
} else { # Default text file (w/o extension)
print NS "0$_\t$host$separator$thing$_";
}
print NS "\t$myName\t$myPort\r\n";
}
print NS ".\r\n";
} elsif ($getBinary) {
open(FTP, "$tmpData")
|| do {print NS "3 Error. Could not transfer file.\r\n.\r\n"; exit;};
while (read(FTP, $buf, 16384)) {
print NS $buf;
}
} elsif (-T $tmpData) {
open(FTP, "$tmpData")
|| do {print NS "3 Error. Could not transfer file.\r\n.\r\n"; exit;};
while (<FTP>) {
chop;
print NS "$_\r\n";
}
print NS ".\r\n";
} else {
print NS "3 Sorry. Requested file did not appear to contain text.\r\n.\r\n";
}
close(FTP);
unlink("$tmp");
unlink("$tmpData") if ($tmpData ne "");
}
sub CLEANUP {
print NS "3 Error in FTP transaction.\r\n.\r\n";
unlink("$tmp");
unlink("$tmpData") if ($tmpData ne "");
}
sub AF_INET {2;}
sub SOCK_STREAM {1;}
sub getRemoteHost {
local(@ans);
local($ans);
@ans = gethostbyaddr($inetaddr, &AF_INET);
if (!defined @ans) {
$ans = join('.', @inetaddr);
} else {
$ans = $ans[0];
}
}
#-----------
# nslook
# Idea from a program of the same name posted in alt.sources
# by Juergen Nickelsen <nickel@cs.tu-berlin.de>, 10 Sep 91.
# From: DaviD W. Sanderson
# Modified for g2ftpd by Farhad Anklesaria 3/92
#-------
# These convert between the decimal quartet and the internal form of
# the internet addresses.
#-------
sub inet2str
{
sprintf('%u.%u.%u.%u', unpack('C4', $_[0]));
}
sub str2inet
{
$_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
pack('C4', $1, $2, $3, $4);
}
#-------
# Return a description of the results of a gethost* function.
#-------
sub HostDesc
{
local ($name, $aliases, $addrtype, $length, @addrs) = @_;
local ($desc);
$desc .= 'Name: '. $name. "\n" if $name ne '';
$desc .= 'Alias: '. $aliases. "\n" if $aliases ne '';
foreach (@addrs)
{
$desc .= 'Address: '. &inet2str($_). "\n";
}
$desc;
}
#-------
# Look up the address or hostname.
#-------
sub nslook
{
local(@ans);
local($ans);
$_ = $_[0];
if(/^\d+\.\d+\.\d+\.\d+$/)
{
@ans = gethostbyaddr(&str2inet($_), &AF_INET);
if (!defined @ans) {
$ans = "$0: $_: unknown address";
} else {
$ans = $ans[0];
}
}
else
{
@ans = gethostbyname($_);
if (!defined @ans) {
$ans = "$0: $_: unknown name";
} else {
$ans = &inet2str($ans[4]);
}
}
}