home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / comp / lang / perl / 5353 < prev    next >
Encoding:
Text File  |  1992-08-17  |  3.0 KB  |  97 lines
  1. Newsgroups: comp.lang.perl
  2. Path: sparky!uunet!decwrl!deccrl!news.crl.dec.com!quabbin!rwk
  3. From: rwk@crl.dec.com (Bob Kerns)
  4. Subject: Re: Sendmail and perl
  5. In-Reply-To: drich@sandman.lerc.nasa.gov's message of Wed, 5 Aug 1992 15:14:24 GMT
  6. Message-ID: <RWK.92Aug18170427@taunton.crl.dec.com>
  7. Lines: 84
  8. Sender: news@crl.dec.com (USENET News System)
  9. Organization: Cambridge Research Lab, Digital Equipment Corp.
  10. References: <1992Aug5.151424.6313@eagle.lerc.nasa.gov>
  11. Date: Tue, 18 Aug 1992 08:04:32 GMT
  12.  
  13. In article <1992Aug5.151424.6313@eagle.lerc.nasa.gov> drich@sandman.lerc.nasa.gov (Daniel Rich) writes:
  14.  
  15.    From: drich@sandman.lerc.nasa.gov (Daniel Rich)
  16.    Date: Wed, 5 Aug 1992 15:14:24 GMT
  17.  
  18.    I am in need of a perl script that will talk to sendmail (allow me to
  19.    send commands to the sendmail port on a specified machine, and process
  20.    the output).  While I could write this myself, I assume that this is
  21.    something that people have done before.  What is available out there?
  22.  
  23. Here's one I find very useful:  It expands mailing lists.  I use this
  24. to help figure out what the right place to send to is.
  25.  
  26. ----------------------------------------------------------------
  27. #!/usr/local/bin/perl
  28.  
  29. require 'chat2.pl';
  30.  
  31. select((select(STDOUT),$|=1)[0]);
  32.  
  33. (@ARGV[0] eq '-recursive') && ($recursive = shift(@ARGV));
  34.  
  35. (@ARGV >= 2) || die("Usage: $0 [-recursive] host address ...\n");
  36.  
  37. &expn(@ARGV);
  38.  
  39. %BUCKETS=();
  40.  
  41. sub address
  42. {   local($old_host,$old_user,$address) = @_;
  43.     local($user, $host) = ($address =~/<(.+)@(.+)>/);
  44.     $host=~tr/a-z/A-Z/;
  45.     print "    $address\n";
  46.     if ($host=~/^[^.]+$/) {
  47.     $host .= "." . $old_host;
  48.     }
  49.     if ($host && (($host ne $old_host) || ($user ne $old_user))) {
  50.     if (!($user=~/^".*"$/)) {
  51.         local($bucket) = $BUCKETS{$host};
  52.         $BUCKETS{$host} = ($bucket ? ($bucket . "\n" .  $user) : $user);
  53.     }
  54.     }
  55. }
  56.  
  57. sub expn
  58. {   local($host,@addresses) = @_;
  59.     local($addresses);
  60.     $host=~tr/a-z/A-Z/;
  61.     while (@addresses) {
  62.     print("Expanding users on $host.\n");
  63.     if (!&chat'open_port($host,25) # '
  64.         ) {
  65.         print("Could not connect to $host\n");
  66.     } else {
  67.         1  while &chat'expect(20,
  68.              '^(220-.*)\r?\n\r?','1',
  69.              '^(220 .*)\r?\n\r?','0',
  70.              '^(.*)\n\r?','warn("No header: $1\n");0'
  71.            );        # '
  72.         for $user (@addresses) {
  73.         print("  $user:\n");
  74.         &chat'print("expn $user\r\n"); # '
  75.         while (&chat'expect(40,
  76.                     '^250-(.*[^\r])\r?\n\r?',"&address('$host','$user',\$1); 1",
  77.                     '^250 (.*[^\r])\r?\n\r?',"&address('$host','$user',\$1); 0",
  78.                     '^550(.*)\n\r?', q!print "no such user as $user: $1\n"; 0!,
  79.                     '^5\d\d(.*)\n\r?', q!print "Error: $1\n"; 0!,
  80.                     TIMEOUT,'print("$host: timeout\n"); 0',
  81.                     '(.*)\n','print "Unknown response: $1\n";0'
  82.                  )        # '
  83.                ) {1;}
  84.         }
  85.         &chat'close();    # '
  86.     }
  87.     shift(@addresses);
  88.     if ($recursive) {
  89.         ($host,$addresses)=(%BUCKETS)[0,1];
  90.         delete $BUCKETS{$host};
  91.         push(@addresses,split("\n",$addresses));
  92.     } else {
  93.         next;
  94.     }
  95.     }
  96. }
  97.