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 >
Text File  |  1992-04-05  |  9KB  |  360 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # usage:
  4. #           g2ftpd [-p port] [-D] [-h hostname] [-l logfile]
  5. #
  6. # $Log: g2ftpd,v $
  7. # Revision 1.0.1.?  1992/03/10 fxa
  8. # - hacked in double nslook to get full local domainname
  9. # Revision 1.0.1.6  1992/03/09  23:55:03  jladwig
  10. # - Changed domainname (myDomain) parsing to strip only up to first dot,
  11. # without regard to total number of dots.
  12. #
  13. # - Now do double fork() for each accepted process, to try to eliminate
  14. # zombies reported on A/UX by Farhad.
  15. #
  16. # Revision 1.0.1.5  1992/03/07  13:28:41  jladwig
  17. # - Program now puts itself into background successfully.
  18. # - Rewrote getRemoteHost to use socket information instead of passed
  19. # hostname, and return IP address if gethostybyaddr fails.
  20. #
  21. # Revision 1.0.1.4  1992/03/07  02:55:30  jladwig
  22. # - Runs as a proper daemon now, although it must be initialized as a
  23. # background process.
  24. # - Has command-line option handling for debugging, port to listen on, log
  25. # file, and local hostname.
  26. # - Prints date and time to log file for all transactions.
  27. #
  28. # Revision 1.0.1.3  1992/03/06  23:30:11  jladwig
  29. # Reworked program logic to something more like original version.
  30. # Added "err_msgs" array for ftp error handling
  31. #  - WARNING - ftp error handling not tested beyond first error.
  32. # Fixed bug in binary file type retrieval.
  33. # Known to work on:
  34. #   unix 0.7  client w/ type 9 extensions for types 0,1,9
  35. #   mac  1.21 client for types 0,1,4
  36. #
  37. # Revision 1.0.1.2  1992/03/05  10:03:15  jladwig
  38. # Folded in error reporting changes from official v0.3
  39. #
  40. #
  41. # Version 0.3 with a minor patches....
  42. #
  43. #  - jladwig -     Slightly more perl-like syntax.
  44. #        Added simple configuration arrays 
  45. #
  46. # Version 0.2 with a good many bugfixes and logging....
  47. #----Stuff here may need to be customized for your machine----
  48. $def_port = "7996";
  49. $def_log = "/home/mudhoney/g2ftp.log"; #Leave this empty "" for no logging
  50. $ftp = "/usr/ucb/ftp";        #whereever on your box this lives
  51. #
  52. # FTP error messages list
  53. @err_msgs = (': No such file or directory.');
  54. #
  55. # File type extensions lists
  56. #
  57. @type_4 = ('HQX');
  58. @type_5 = ( 'ZIP','ZOO','ARJ','ARC','LZH','HYP','PAK',
  59.        'EXE','COM','PS','GIF','PICT','PCT','TIFF','TIF'
  60.        );
  61. @type_9 = ('TAR','Z');
  62. @binfspec = ( @type_5, @type_9 );
  63. #----end local customizations-------
  64.  
  65. require 'ctime.pl';
  66. require 'getopts.pl';
  67.  
  68. do Getopts('Dh:p:l:');
  69.  
  70. if ($opt_D) {            # Debugging switch
  71.     $debugging = 1;
  72. }
  73.  
  74. if ($opt_h) {            # Use passed hostname
  75.     $myName=$opt_h;
  76. } else {            # calculate hostname 
  77.     chop($myHost=`hostname`);    # get hostname
  78.     $myName = &nslook($myHost);   #ie: gets dotted num
  79.     $myName = &nslook($myName);   #ie: foo.moo.umn.edu
  80. }
  81.  
  82. if ($opt_p) {            # port at which to listen
  83.     $myPort = $opt_p;
  84. } else {
  85.     $myPort = $def_port;
  86. }
  87.  
  88. if ($opt_l) {
  89.     $logFile = $opt_;
  90. } else {
  91.     $logFile = $def_log;    # log file
  92. }
  93.  
  94. # Catch signals...
  95. #
  96. $SIG{'INT'} = 'CLEANUP';
  97. $SIG{'HUP'} = 'CLEANUP';
  98. $SIG{'QUIT'} = 'CLEANUP';
  99. $SIG{'PIPE'} = 'CLEANUP';
  100. $SIG{'ALRM'} = 'CLEANUP';
  101. $tmp = "/tmp/gf$$";            #I'll clean up; Promise!
  102. $tmpData = "/tmp/gfd$$";        #This one's for spooling
  103. $separator = "@";            #For encoding selector with hostname
  104. $host = "";
  105. $getBinary = "";
  106.  
  107. # shuffle off to the background...
  108. #
  109. (fork && exit) unless $debugging;
  110. setpgrp(0,$$);
  111.  
  112. # Begin main program
  113. #
  114. #  tcp server code ripped liberally from _Programming_Perl_
  115. #
  116. $sockaddr = 'S n a4 x8';
  117. #  $myName = &getLocalHost;
  118. ($name, $aliases, $proto) = getprotobyname('tcp');
  119. if ($myPort !~ /^\d+$/) {
  120.     ($name, $aliases, $myPort) = getservbyport($myPort, 'tcp');
  121. }
  122.  
  123. print "Port = $myPort\n" if $debugging;
  124.  
  125. $this = pack($sockaddr, &AF_INET, $myPort, "\0\0\0\0");
  126.  
  127. select(NS); $| = 1; select(stdout);
  128.  
  129. socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  130. bind(S,$this) || die "bind: $!";
  131. listen(S,5) || die "connect: $!";
  132.  
  133. select(S); $| = 1; select(stdout);
  134.  
  135. $con = 0;
  136. print "Listening for connection 1....\n" if $debugging;
  137. for(;;) {
  138.     ($addr = accept(NS,S)) || die $!;
  139.  
  140.     $con++;
  141.     if (($child[$con] = fork()) == 0) {
  142.     print "accept ok\n" if $debugging;
  143.     unless (fork) {
  144.         sleep 1 until getppid == 1;
  145.  
  146.         ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  147.         @inetaddr = unpack('C4',$inetaddr);
  148.         print "$con: $af $port @inetaddr\n" if $debugging;
  149.         
  150.         &send_query;
  151.         &handle_results;
  152.         
  153.         printf("Closing connection %d\n",$con) if $debugging;
  154.         close(NS);
  155.         exit 0;
  156.     }
  157.     exit 0;
  158.     }
  159.     wait;
  160.     close(NS);
  161.  
  162.     printf("Listening for connection %d\n",$con+1) if $debugging;
  163. }
  164.  
  165. exit;
  166.  
  167.  
  168. # Support routines
  169. #
  170. # Handle the query and send it to the ftp server
  171. #
  172. sub send_query {
  173.     $query = <NS>;
  174.     chop($query);
  175.     chop($query);
  176.     if ( $logFile ) {
  177.     $remoteHost = &getRemoteHost;
  178.     open(LOG, ">>$logFile");
  179.     chop($date = &ctime(time));
  180.     print LOG $date, "\t$$\t$remoteHost \t- $query\n";
  181.     close(LOG);
  182.     }
  183.     if ($query eq "") {
  184.     print NS "3 Incorrectly specified request for FTP (No hostname)\r\n.\r\n";
  185.     exit; 
  186.     }
  187.     ($host, $thing) = split(/@/, $query, 2);
  188.     $thing = "/" if ($thing eq "");
  189.     open(FTP, "| $ftp -n $host >$tmp") 
  190.     || do {print NS "3 Error. Couldn't connect to server\r\n.\r\n"; exit;};
  191.     print FTP "user anonymous -gopher@$myName\n";
  192.     $thing2 = $thing;
  193.     $dir = chop($thing2);
  194.     if ($dir eq "/") {        #asking for a dir
  195.     print FTP "cd $thing2\n" if ($thing2 ne "");
  196.     print FTP "ls -F\n";
  197.     $tmpData = "";
  198.     } else  {            #asking for a file 
  199.     $thing = $thing2 if (($dir eq "*") || ($dir eq "@"));
  200.     if ($thing =~ /\.(\w+)$/) {    # Grab file extension if there is one
  201.         $ext = $1;
  202.         $getBinary = grep (/^$ext$/, @binfspec); # Is it a binary-type extension?
  203.     } 
  204.     print FTP "binary\n" 
  205.         if $getBinary ;
  206.     print FTP "get $thing $tmpData\n"; 
  207.     }
  208.     print FTP "quit\n";
  209.     close(FTP);        #re-use the fileHandle
  210. }
  211.  
  212. # Handle the results of the ftp transfer
  213. #
  214. sub handle_results {
  215.     if ($tmpData eq "") {    #maybe use an exists instead?
  216.     open(FTP, "$tmp") 
  217.         || do {print NS "3 Error. Could not return list.\r\n.\r\n"; die;};
  218.     while (<FTP>) {
  219.         chop;
  220.         /^.+(:.+)$/;        # Extract error message, if any
  221.         if (grep (/^$1$/, @err_msgs)) { # ftp error
  222.         print NS "3 Error. ftp reports \"$1\".\r\n.\r\n";
  223.         exit;
  224.         } 
  225.         s/\*$//;        # Hack out stars
  226.         s#\@$#/#;        # Hack out ats
  227.         if (s#/$##) {        # It's a directory
  228.         print NS "1$_\t$host$separator$thing$_/";
  229.         } elsif ( /\.(\w+)$/ ) { # It's a file, Grab file extension
  230.         $ext = $1;
  231.         if (grep (/^$ext$/i, @type_4)) { # binhex file
  232.             print NS "4$_\t$host$separator$thing$_";
  233.         } elsif (grep (/^$ext$/i, @type_5)) { # DOS scrap
  234.             print NS "5$_\t$host$separator$thing$_";
  235.         } elsif (grep (/^$ext$/i, @type_9)) { # .tar .Z
  236.             print NS "9$_\t$host$separator$thing$_";
  237.         } else { # Default text file (w/ extension)
  238.             print NS "0$_\t$host$separator$thing$_";
  239.         }
  240.         } else { # Default text file (w/o extension)
  241.         print NS "0$_\t$host$separator$thing$_";
  242.         }
  243.         print NS "\t$myName\t$myPort\r\n";
  244.     }
  245.     
  246.     print NS ".\r\n";
  247.     } elsif ($getBinary) {
  248.     open(FTP, "$tmpData") 
  249.         || do {print NS "3 Error.  Could not transfer file.\r\n.\r\n"; exit;};
  250.     while (read(FTP, $buf, 16384)) {
  251.         print NS $buf;
  252.     }
  253.     } elsif (-T $tmpData) { 
  254.     open(FTP, "$tmpData") 
  255.         || do {print NS "3 Error. Could not transfer file.\r\n.\r\n"; exit;};
  256.     while (<FTP>) {
  257.         chop;
  258.         print NS "$_\r\n";
  259.     }
  260.     print NS ".\r\n";
  261.     } else {
  262.     print NS "3 Sorry.  Requested file did not appear to contain text.\r\n.\r\n";
  263.     }
  264.     close(FTP);
  265.     unlink("$tmp");
  266.     unlink("$tmpData") if ($tmpData ne "");
  267. }
  268.  
  269.  
  270. sub CLEANUP {
  271.     print NS "3 Error in FTP transaction.\r\n.\r\n";
  272.     unlink("$tmp");
  273.     unlink("$tmpData") if ($tmpData ne "");
  274. }
  275.  
  276. sub AF_INET {2;}
  277.  
  278. sub SOCK_STREAM {1;}
  279.  
  280. sub getRemoteHost {
  281.     local(@ans);
  282.     local($ans);
  283.     @ans = gethostbyaddr($inetaddr, &AF_INET);
  284.     if (!defined @ans) {
  285.     $ans = join('.', @inetaddr);
  286.     } else {
  287.     $ans = $ans[0];
  288.     }
  289. }
  290.  
  291.  
  292. #-----------
  293. # nslook
  294. # Idea from a program of the same name posted in alt.sources
  295. # by Juergen Nickelsen <nickel@cs.tu-berlin.de>, 10 Sep 91.
  296. # From: DaviD W. Sanderson
  297. # Modified for g2ftpd by Farhad Anklesaria 3/92
  298. #-------
  299. # These convert between the decimal quartet and the internal form of
  300. # the internet addresses.
  301. #-------
  302. sub inet2str
  303. {
  304.     sprintf('%u.%u.%u.%u', unpack('C4', $_[0]));
  305. }
  306. sub str2inet
  307. {
  308.     $_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
  309.     pack('C4', $1, $2, $3, $4);
  310. }
  311.  
  312. #-------
  313. # Return a description of the results of a gethost* function.
  314. #-------
  315. sub HostDesc
  316. {
  317.     local    ($name, $aliases, $addrtype, $length, @addrs) = @_;
  318.     local    ($desc);
  319.  
  320.     $desc .= 'Name:    '. $name.    "\n"    if $name ne '';
  321.     $desc .= 'Alias:   '. $aliases. "\n"    if $aliases ne '';
  322.  
  323.     foreach (@addrs)
  324.     {
  325.         $desc .= 'Address: '. &inet2str($_). "\n";
  326.     }
  327.  
  328.     $desc;
  329. }
  330.  
  331. #-------
  332. # Look up the address or hostname.
  333. #-------
  334. sub nslook
  335. {
  336.     local(@ans);
  337.     local($ans);
  338.     $_ = $_[0];
  339.     if(/^\d+\.\d+\.\d+\.\d+$/)
  340.     {
  341.         @ans = gethostbyaddr(&str2inet($_), &AF_INET);
  342.         if (!defined @ans) {
  343.         $ans = "$0: $_: unknown address";
  344.         } else {
  345.         $ans = $ans[0];
  346.         }
  347.     }
  348.     else
  349.     {
  350.         @ans = gethostbyname($_);
  351.         if (!defined @ans) {
  352.         $ans = "$0: $_: unknown name";
  353.         } else {
  354.         $ans = &inet2str($ans[4]);
  355.         }
  356.     }
  357. }
  358.  
  359.  
  360.