#/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 <[email protected]>, 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]);
               }
       }
}

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.