ftp.muug.mb.ca/2014.06.ftp.muug.mb.ca.tar/ftp.muug.mb.ca/pub/src/gopher/gopher1.01/misc/gopher2ftp/gopherftp

Text File | 1992-04-05 | 8.9 KB | 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 <[e-mail]>, 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]);
        }
    }
}