gnu/libexec/uucp/contrib/uureroute.perl

   1 #!/usr/local/bin/perl
   2 eval ' exec /usr/local/bin/perl $0 "$@" '
   3         if $running_under_some_shell;
   4
   5 # From a script by <Bill.Campbell@celestial.com>
   6 # Newsgroups: comp.sources.misc
   7 # Subject: v28i073:  uureroute - Reroute HDB queued mail, Part01/01
   8 # Date: 26 Feb 92 02:28:37 GMT
   9 #
  10 # This is a Honey DanBer specific routine written in perl to reroute all
  11 # mail queued up for a specific host.  It needs to be run as "root" since
  12 # uucp will not allow itself to remove others requests.
  13 #
  14 # Revision ***  92/21/09:  Francois Pinard <pinard@iro.umontreal.ca>
  15 #       1.      adapted for Taylor UUCP
  16 #
  17 # Revision 1.3  91/10/08  09:01:21  src
  18 #       1.      Rewritten in perl
  19 #       2.      Add -v option for debugging.
  20 #
  21 # Revision 1.2  91/10/07  23:57:42  root
  22 #       1.      Fix mail program path.
  23 #       2.      Truncate directory name to 7 characters
  24
  25 ($progname = $0) =~ s!.*/!!;    # save this very early
  26
  27 $USAGE = "
  28 #   Reroute uucp mail
  29 #
  30 #   Usage: $progname [-v] host [host...]
  31 #
  32 # Options   Argument    Description
  33 #   -v                  Verbose (doesn't execute /bin/sh)
  34 #
  35 ";
  36
  37 $UUSTAT = "/usr/local/bin/uustat";
  38 $SHELL = "/bin/sh";
  39 $SMAIL = "/bin/smail";
  40
  41 sub usage
  42 {
  43     die join ("\n", @_) . "\n$USAGE\n";
  44 }
  45
  46 do "getopts.pl";
  47
  48 &usage ("Invalid Option") unless do Getopts ("vV");
  49
  50 $verbose = ($opt_v ? '-v' : ());
  51 $suffix = ($verbose ? '' : $$);
  52
  53 &usage ("No system specified") if $#ARGV < 0;
  54
  55 if (!$verbose)
  56 {
  57     open (SHELL, "| $SHELL");
  58     select SHELL;
  59 }
  60
  61 while ($system = shift)
  62 {
  63     $sysprefix = substr ($system, 0, 7);
  64     $directory = "/usr/spool/uucp/$sysprefix";
  65     open (UUSTAT, "$UUSTAT -s $system -c rmail |");
  66     print "set -ex\n";
  67     while (<UUSTAT>)
  68     {
  69         ($jobid, ) = split;
  70         ($cfile) = substr ($jobid, length ($jobid) - 5);
  71         $cfilename = "$directory/C./C.$cfile";
  72         open (CFILE, $cfilename) || die "Cannot open $cfilename\n";
  73         $_ = <CFILE>;
  74         close CFILE;
  75         if (/^E D\.(....) [^ ]+ [^ ]+ -CR D\.\1 0666 [^ ]+ 0 rmail (.*)/)
  76         {
  77             $datafile = "$directory/D./D.$1";
  78             $address = $2;
  79         }
  80         else
  81         {
  82             print STDERR;
  83             die "Cannot parse previous line from $cfilename\n";
  84         }
  85         print "$SMAIL -R $system!$address < $datafile && $UUSTAT -k $jobid\n";
  86     }
  87     close UUSTAT;
  88 }
  89 close SHELL unless $verbose;
  90
  91 exit 0;