home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3624 / archie < prev    next >
Encoding:
Text File  |  1991-07-13  |  6.8 KB  |  292 lines
  1. #!/u3/thesis/clipper/bin/perl                            # -*-perl-*-
  2. # Copyright (C) Khun Yee Fung clipper@csd.uwo.ca 1991
  3. # You can do anything to this program except selling it for profit or
  4. # pretending you wrote it. The copyright notice must be preserved in all 
  5. # copies.
  6. # $Id: archie,v 1.2 1991/07/12 06:04:31 clipper Exp clipper $
  7. eval "exec perl -S $0 $*"
  8.     if $running_under_some_shell;
  9.  
  10. require 'archie.depend';
  11. require $socket;
  12. require 'resolver.pl';
  13. require 'newgetopt.pl';
  14. &NGetOpt('match=i', 'reg', 'exact', 'nocase', 'case', 'host=s',
  15.      'ffile=s', 'format=s', 'along');
  16. @prog = split('/', $0);
  17. $prog = $prog[$#prog];
  18. $usage = 
  19. "Usage: $prog [-case, -exact, -reg, -nocase, -match count, -host host] word
  20.   -case    Case sensitive
  21.   -nocase  Case insensitive
  22.   -exact   Exact match
  23.   -reg     Regular expression match
  24.   -match \# Max hits
  25.   -host    Instead of quiche.cs.mcgill.ca
  26.   -ffile   Use a format file
  27.   -format  Specify a format string
  28.   -along   Print output along the way, instead of all as once at the end
  29. ";
  30. if ($#ARGV < 0 || $#ARGV > 0) {
  31.     die $usage;
  32. }
  33. @month = ('', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
  34.       'Sep', 'Oct', 'Nov', 'Dec');
  35. $string = $ARGV[0];
  36. $port = 1525;
  37. $sockaddr = 'nna4C8';
  38. $hostname = '132.206.2.3';
  39. ($dum, $dum, $dum, $dum, $thisaddr) = gethostbyname($thishost);
  40. $match = 100; $case = 'S'; $along = 0;
  41. ($user) = getpwuid($<);
  42. $ffile = 0;
  43. $format = 'Host $host
  44.  
  45.     Location: $dir
  46.       $type $modes $size $date $name
  47.  
  48. ';
  49. if ($opt_along) {
  50.     $along = 1;
  51. }
  52. if ($opt_match) {
  53.     $match = $opt_match;
  54. }
  55. if ($opt_ffile) {
  56.     $ffile = 1;
  57.     if (!open(FFILE, "$opt_ffile")) {
  58.     die "Can't open format file $opt_ffile\n";
  59.     }
  60.     $format = '';
  61.     while ($_ = <FFILE>) {
  62.     $format .= $_;
  63.     }
  64.     close(FFILE);
  65. }
  66. if ($opt_format) {
  67.     if ($opt_ffile) {
  68.     print "Format string ignored: a format file was specified\n";
  69.     }
  70.     $ffile = 0;
  71.     $format = $opt_format;
  72. }
  73. if ($opt_case) {
  74.     $case = 'C';
  75. }
  76. if ($opt_nocase) {
  77.     $case = 'S';
  78. }
  79. if ($opt_host) {
  80.     $hostname = $opt_host;
  81. }
  82. if ($opt_reg) {
  83.     $case = 'R';
  84. }
  85. if ($opt_exact) {
  86.     $case = '=';
  87. }
  88. if ($hostname =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  89.   $thataddr = pack("CCCC", $1, $2, $3, $4);
  90. }
  91. elsif (!(($name, $aliases, $type, $len, $thataddr) = 
  92.      gethostbyname($hostname))) {
  93.     $thataddr = &resolver($hostname, $server) || die "No such host";
  94. }
  95.  
  96. $them = pack($sockaddr, &AF_INET, $port, $thataddr);
  97. $us = pack("n2C12", &AF_INET, 0, 0, 0, 0, 0);
  98. socket(DATA, &AF_INET, &SOCK_DGRAM, 0) || die "socket:$!\n";
  99. bind(DATA, $us) || die "bind: $!\n";
  100. select(STDOUT); $| = 1;
  101. $hosts = &list($them, $us, "VERSION 1\n",
  102.            "AUTHENTICATOR UNAUTHENTICATED $user\n",
  103.            "DIRECTORY ASCII ARCHIE/MATCH($match,0,$case)/$string\n",
  104.            "LIST ATTRIBUTES COMPONENTS \n");
  105. if (!$along) {
  106.     &output($hosts);
  107. }
  108. close(DATA);
  109.  
  110. sub list {
  111.     local($them, $us, @lines) = @_;
  112.     local($answer, $ans, $timeout, $retries, $lines);
  113.     local($nd_pkts, $no_pkts, $seq, $rin, $timeleft, $rout, $nfound);
  114.     local($hdr_len, $id, $dum, $backoff, $ctlptr, $pkt_cid);
  115.     local($packet) = 0;
  116.     
  117.     $timeout = 4;
  118.     $retries = 3;
  119.     $lines = join('', @lines);
  120.   retry:
  121.     send(DATA, $lines, 0, $them);
  122.     $nd_pkts = 0;
  123.     while (1) {
  124.     $seq = 0;
  125.     $rin = '';
  126.     vec($rin, fileno(DATA), 1) = 1;
  127.     ($nfound, $timeleft) = select($rout = $rin, '', '', $timeout);
  128.     if ($timeleft == 0 && ($retries-- > 0)) {
  129.         $timeout *= 2;
  130.         goto retry;
  131.     }
  132.     $ans = '';
  133.     if (!(recv(DATA, $ans, 10000, 0))) {
  134.         die "recv: Can't recv. Die.\n";
  135.     }
  136.     $packet++;
  137.     if (($hdr_len = ord(substr($ans, 0, 1))) < 20) {
  138.         $seq = 0;
  139.         ($hdr_len, $id, $seq, $nd_pkts, $dum, $backoff) = 
  140.         unpack("Cn*", $ans);
  141.         if ($hdr_len < 5) {
  142.         $seq = $nd_pkts = 1;
  143.         }
  144.         if ($hdr_len >= 11 && $backoff != 0) {
  145.         $timeout = $backoff;
  146.         }
  147.         next if ($seq == 0);
  148.         substr($ans, 0, $hdr_len) = '';
  149.     }
  150.     else {
  151.         $id = 0;
  152.         if (length($ans) - 20 > 0) {
  153.         $ctlptr = length($ans) - 20;
  154.         }
  155.         else {
  156.         $ctlptr = 0;
  157.         }
  158.         while (ord(substr($ans, $ctlptr, 1)) > 0) {
  159.         $ctlptr++;
  160.         }
  161.         $ctlptr++;
  162.         if ($ctlptr < length($ans) - 4) {
  163.         $dum = unpack("n", substr($ans, $ctlptr, 2));
  164.         if ($dum) {
  165.             $pkt_cid = $dum;
  166.         }
  167.         $ctlptr += 2;
  168.         if ($ctlptr < (length($ans))) {
  169.             $seq = unpack("n", substr($ans, $ctlptr, 2));
  170.             $ctlptr += 2;
  171.         }
  172.         if ($ctlptr < length($ans)) {
  173.             $dum = unpack("n", substr($ans, $ctlptr, 2));
  174.             if ($dum) {
  175.             $nd_pkts = $dum;
  176.             }
  177.             $ctlptr += 2;
  178.         }
  179.         if ($ctlptr < length($ans)) {
  180.             $ctlptr += 2;
  181.         }
  182.         if ($ctlptr < length($ans)) {
  183.             $backoff = unpack("n", substr($ans, $ctlptr, 2));
  184.             if ($backoff) {
  185.             $timeout = $backoff;
  186.             }
  187.             $ctlptr += 2;
  188.         }
  189.         next if ($seq == 0);
  190.         last;
  191.         }
  192.         else {
  193.         if ($ans =~ /.*MULTI-PACKET\s*(\d+)\s+OF\s+(\d+)/) {
  194.             $seq = $1;
  195.             $nd_pkts = $2;
  196.         }
  197.         else {
  198.             if ($along) {
  199.             &output($ans);
  200.             }
  201.             return($ans);
  202.         }
  203.         }
  204.     }
  205.     $no_pkts++;
  206.     $retries = 3;
  207.     if ($along) {
  208.         &output($ans);
  209.     }
  210.     $answer .= $ans;
  211.     if ($nd_pkts == 0 || $no_pkts < $nd_pkts) {
  212.         next;
  213.     }
  214.     last;
  215.     }
  216.     return($answer);
  217. }
  218.  
  219. sub output {
  220.     local($list) = @_;
  221.     local(@lines, $dum, $arcmod, $lastmod, $modes, $host, $size, $dir);
  222.     local($name);
  223.  
  224.     @lines = split(/\n/, $list);
  225.     $host = '';
  226.     while ($line = shift(@lines)) {
  227.     if ($line =~ /LINK L/) {
  228.         if ($host ne '') {
  229.         &write($host, $isdir, $dir, $size, $arcmod, $modes,
  230.                $lastmod, $name);
  231.         }
  232.         ($dum, $dum, $isdir, $name, $dum, $host, $dum, $dir, $dum, $dum) =
  233.         split(/ /, $line);
  234.     }
  235.     elsif ($line =~ /LINK-INFO/) {
  236.         ($dum, $dum, $attr, $dum, @info) = split(/ /, $line);
  237.         if ($attr eq 'SIZE') {
  238.         $size = join(' ', @info);
  239.         }
  240.         elsif ($attr eq 'UNIX-MODES') {
  241.         $modes = join(' ', @info);
  242.         }
  243.         elsif ($attr eq 'ARC-MODTIME') {
  244.         $arcmod = join(' ', @info);
  245.         }
  246.         elsif ($attr eq 'LAST-MODIFIED') {
  247.         $lastmod = join(' ', @info);
  248.         }
  249.     }
  250.     }
  251.     if ($host ne '') {
  252.     &write($host, $isdir, $dir, $size, $arcmod, $modes, $lastmod, $name);
  253.     }
  254. }
  255.  
  256. sub write {
  257.     local($host, $isdir, $dir, $size, $arcmod, $modes, $lastmod, $name) = @_;
  258.  
  259.     $size = sprintf("%10d", $size);
  260.     if ($isdir eq 'DIRECTORY') {
  261.     $type = 'Directory';
  262.     }
  263.     else {
  264.     $type = '     File';
  265.     }
  266.     $date = &date($lastmod);
  267.     @path = split('/', $dir);
  268.     pop(@path);
  269.     $path = join('/', @path);
  270.     $for = $format;
  271.     $for =~ s/\$host/$host/g;
  272.     $for =~ s/\$date/$date/g;
  273.     $for =~ s/\$type/$type/g;
  274.     $for =~ s/\$modes/$modes/g;
  275.     $for =~ s/\$name/$name/g;
  276.     $for =~ s/\$size/$size/g;
  277.     $for =~ s/\$dir/$path/g;
  278.     print $for;
  279. }
  280.  
  281. sub date {
  282.     local($date) = @_;
  283.  
  284.     $year = substr($date, 0, 4);
  285.     $month = substr($date, 4, 2);
  286.     $day = substr($date, 6, 2);
  287.     $min = substr($date, 8, 2);
  288.     $sec = substr($date, 10, 2);
  289.     return "$year $month[$month] $day $min:$sec GMT";
  290. }
  291.  
  292.