home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume28 / bmw-5 / part01 / bmw next >
Text File  |  1994-07-09  |  26KB  |  1,079 lines
  1. #! /usr/bin/perl
  2. ## Set the above path to your path to perl.
  3. ##
  4. ## BMW - The Black Marble Wombat Mailing List Manager
  5. ## Copyright (c) 1994 by Clay Luther, All rights reserved.
  6. ## THIS SOFTWARE IS COVERED BY THE GNU SOFTWARE LICENSE.
  7. ## YOU MAY USE THIS SOFTWARE AS YOU PLEASE SO LONG AS YOU DO NOT REMOVE
  8. ## THE COPYRIGHT NOTICES.
  9. ##
  10.  
  11. $USAGE = "$0 <listname>";
  12.  
  13. ##
  14. ## General operation.
  15. ## BMW accepts a single mail message on standard input.  It expects the
  16. ## message to obey standard UN*X mail format, that is:
  17. ##
  18. ## FROMSPACE line
  19. ## HEADERS
  20. ## <blank line>
  21. ## DATA
  22. ##
  23. ## BMW will attempt to extract the user's address from the message.  However,
  24. ## if the environment variable SENDER is set, BMW will use it instead.
  25. ##
  26. ## BMW will parse the mail message looking for commands from the user.
  27. ## Commands should appear either on the subject line or at the beginning of
  28. ## a line in the DATA section.  The user may issue an unlimited number of
  29. ## commands.
  30. ##
  31. ## Commands are significant to 3-letters and are not case-sensitive.
  32. ## The commands are:
  33. ##
  34. ##  subscribe
  35. ##  unsubscribe
  36. ##  who
  37. ##  dir
  38. ##  cd
  39. ##  get
  40. ##  ping
  41. ##  help
  42. ##  digest
  43. ##  undigest
  44. ##
  45.  
  46. # BEGIN
  47.  
  48. $LF = "\n";
  49. $TRACE = 0;          # Trace debug.  This will be set by the global routines.
  50.  
  51. sub trace            # The trace routine.
  52. {
  53.   local($i) = @_;
  54.   print $i,$LF if $TRACE;
  55. }
  56.  
  57.  
  58. srand;
  59. umask("000");
  60.  
  61. if ($#ARGV != 0)
  62. {
  63. # We must have at least one argument!
  64.   die "USAGE: ",$USAGE,$LF;
  65. }
  66.  
  67. $LISTNAME = $ARGV[0];
  68. $LISTNAME =~ tr/A-Z/a-z/;  # Convert everything to lower case for now.
  69.  
  70. %GLOBALS = ();
  71.  
  72. ## We need to set the hostname.  You this is done by querying hostname and
  73. ## domainname.  You can override this here or set your FQDN global explicitly
  74. ## in the bmw.cf file.
  75.  
  76. $HOSTNAME = `hostname`; chop($HOSTNAME);
  77. $DOMAINNAME = `domainname`; chop($DOMAINNAME);
  78.  
  79. ## Path to bmw.cf - CHANGE THIS FOR YOUR SYSTEM
  80. #$BMWCF = "/etc/bmw.cf";
  81. $BMWCF = "/home/bmw/bmw.cf";
  82.  
  83. ## Process the config file and learn about all the globals.
  84. ## FORMAT OF CONFIG FILE:
  85. ##   Each line of the config file should have the format
  86. ##     <globalname> = <value>
  87. ##   for example,
  88. ##     BASEDIR = /usr/local/lib/bmw
  89. ##
  90. ## I now set the defaults.  You should override these in your bmw.cf file.
  91. ##
  92. $GLOBALS{'SENDMAIL'} = "/usr/lib/sendmail";
  93. $GLOBALS{'SENDMAILOPTS'} = "";
  94. $GLOBALS{'ENCODE'} = "/usr/bin/uuencode";
  95. $GLOBALS{'COMPRESS'} = "/bin/gzip";
  96. $GLOBALS{'COMPSUFFIX'} = ".gz";
  97. $GLOBALS{'ARCDIR'} = "/home/ftp/pub/lists";
  98. $GLOBALS{'ARCOWNER'} = "ftp";
  99. $GLOBALS{'OWNER'} = "postmaster";
  100. $GLOBALS{'DEBUG'} = 0;
  101. $GLOBALS{'LOG'} = 0;
  102. $GLOBALS{'MAXGETS'} = 5;
  103. $GLOBALS{'PREFERFTP'} = 0;
  104. $GLOBALS{'TRACE'} = 0;
  105. $GLOBALS{'BASEDIR'} = "/usr/local/lib/bmw";
  106. $GLOBALS{'FQDN'} = $HOSTNAME . "." . $DOMAINNAME;
  107. $GLOBALS{'DIGEST'} = 0;
  108. $GLOBALS{'TMPDIR'} = "/var/tmp";
  109. $GLOBALS{'USER'} = "bmw";
  110. $GLOBALS{'GROUP'} = "bin";
  111.  
  112.  
  113. @VALIDGLOBALS = ("SENDMAIL", "SENDMAILOPTS", "TMPDIR", "ENCODE",
  114.                  "COMPRESS", "COMPSUFFIX", "ARCDIR", "ARCOWNER",
  115.          "OWNER", "DEBUG", "LOG", "MAXGETS", "PREFERFTP",
  116.          "TRACE", "BASEDIR", "FQDN", "DIGEST", "USER", "GROUP");
  117.  
  118.  
  119.  
  120. sub validGlobal {
  121. ## Determine if the string is a valid global reference.
  122.   local($s) = @_;
  123.   local($i);
  124.   for ($i=0; $i<=$#VALIDGLOBALS; $i++) {
  125.     if ($s eq $VALIDGLOBALS[$i]) { return 1; }
  126.   }
  127.   return 0;
  128. }
  129.  
  130.  
  131.  
  132. ## Load the globals from the cf file.
  133. if (-e $BMWCF) {
  134.   local($lno) = 0;
  135.   local(@LINE);
  136.   open(CF, "<$BMWCF") || die "Cannot open $BMWCF: $!\n";
  137.   while (<CF>) {
  138.     $lno++;
  139.     chop;
  140.     tr/\t //d;
  141.     @LINE = split("=");
  142.     if (!$LINE[0]) { die "ERROR in $BMWCF line $lno; $_\n"; }
  143.     $LINE[0] =~ tr/a-z/A-Z/;
  144.     if (!&validGlobal($LINE[0])) { 
  145.       die "ERROR in $BMWCF line $lno; Unknown global \"$LINE[0]\"\n"; 
  146.     }
  147. ## Good.  We have a valid global
  148.     $GLOBALS{$LINE[0]} = $LINE[1];
  149.   }
  150. }
  151. else {
  152.   die "$BMWCF does not exist!\n";
  153. }
  154.  
  155. if ($GLOBALS{'DEBUG'}) {
  156.   local($key);
  157.   foreach $key (keys %GLOBALS) {
  158.     print "$key = $GLOBALS{$key}",$LF;
  159.   }
  160. }
  161.  
  162.  
  163. ## Internal global values.  Do not fiddle with these without good reason.
  164. $VERSION = "5.0";
  165. $LISTDIR = $GLOBALS{'BASEDIR'} . "/$LISTNAME";
  166. $LISTARC = $GLOBALS{'ARCDIR'} . "/$LISTNAME";
  167. $LISTFILE = "$LISTDIR/subscribers";
  168. $DIGESTFILE = "$LISTDIR/subscribers.d";
  169. $LOGFILE = "$LISTDIR/log";
  170. $MESSAGE = $GLOBALS{'BASEDIR'} . "/message";
  171. $MESSAGE = "$LISTDIR/message" if (-e "$LISTDIR/message");
  172. $HELP = $GLOBALS{'BASEDIR'} . "/help";
  173. $HELP = "$LISTDIR/help" if (-e "$LISTDIR/help");
  174. $WDIR = "";                   # working directory suffix for gets
  175.  
  176. $TMPFILE = $GLOBALS{'TMPDIR'} . "/bmw$$";
  177. $REPLYFILE = "$TMPFILE.reply";
  178. $TMPLOGFILE = "$TMPFILE.log";
  179.  
  180. $LISTOWNER = "$LISTNAME-owner";
  181. $LISTREQUEST = "$LISTNAME-request";
  182.  
  183. @ERRORS = ();
  184. %LOCKS = ();
  185.  
  186. ##
  187. ## Exit routines.  These make sure everything is cleaned up.
  188. ##
  189. sub finish {
  190.   local($rc) = @_;
  191.   local($i);
  192.   system("rm -f $TMPFILE $REPLYFILE $TMPLOGFILE");
  193.   if ($#ERRORS > -1) {
  194.     open(T, ">$TMPFILE");
  195.     print T "From: $LISTOWNER\n";
  196.     print T "Subject: Errors from $LISTREQUEST\n";
  197.     print T "To: $LISTOWNER\n\n";
  198.     for ($i = 0; $i <= $#ERRORS; $i++) {
  199.       print T $ERRORS[$i],$LF;
  200.     }
  201.     close(T);
  202.     system("cat $TMPFILE | $GLOBALS{'SENDMAIL'} \'$LISTOWNER\'");
  203.     system("rm -f $TMPFILE")
  204.   }
  205.   exit($rc);
  206. }
  207.  
  208.  
  209.  
  210. sub DIE {
  211.   local($msg) = @_;
  212.   print STDERR "$msg",$LF;
  213.   $ERRORS[$#ERRORS+1] = $msg;
  214.   local($key);
  215.   foreach $key (keys %LOCKS) {
  216.     system("rm -f $key");
  217.   }
  218.   &finish(-1);
  219. }
  220.  
  221.  
  222. # Test for things that must exist.
  223.  
  224. &DIE("$LISTDIR does not exist!\n") if (! -d $LISTDIR);
  225.  
  226. if (! -e $LISTFILE) {
  227. ## Create a list file.
  228.   open(LF,">$LISTFILE") || &DIE("Could not create $LISTFILE: $!\n");
  229.   print LF "$LISTOWNER\n";
  230.   close(LF);
  231.   chown $GLOBALS{'USER'}, $GLOBALS{'GROUP'}, $LISTFILE;
  232.   chmod 0664,$LISTFILE;
  233. }
  234.  
  235. if (! -e $DIGESTFILE) {
  236. ## Create a digest file.
  237.   open(LF,">$DIGESTFILE") || &DIE("Could not create $DIGESTFILE: $!\n");
  238.   print LF "$LISTOWNER\n";
  239.   close(LF);
  240.   chown $GLOBALS{'USER'}, $GLOBALS{'GROUP'}, $DIGESTFILE;
  241.   chmod 0664,$DIGESTFILE;
  242. }
  243.  
  244. if (! -d $LISTARC) {
  245.   $ARCTHERE = 0;
  246. }
  247. else {
  248.   $ARCTHERE = 1;
  249. }
  250.  
  251. ## Start parsing the message.
  252.  
  253. $FROM = "";      ## who from?
  254. $OFROM = "";     ## original from? overrides From:
  255. $REPLYTO = "";   ## reply to? overrides Originally-From:
  256. $SUBJECT = "";   ## subject line
  257. $REPLYOPEN = 0;  ## is the reply file open?
  258. $STOPEN = 0;     ## used for sending text files
  259. $LOGOPEN = 0;    ## is the logfile open?
  260. $NUMGETS = 0;    ## how many gets so far?
  261. $HEADERS = 1;    ## location of the parse
  262. $INFROM = 0;     ## deal with problem Froms:
  263.  
  264. @COMMANDS = ();
  265.  
  266. shift;
  267.  
  268. while (<>) {
  269.   if ($HEADERS) {
  270.     if ($INFROM && /^\s/) {
  271.       local($morefrom);
  272.       $morefrom = $1 if m/^\s*(.*)\n/;
  273.       $FROM = $FROM . $morefrom;
  274.     }
  275.     else {
  276.       $INFROM = 0;
  277.       if (/^Subject:/) { $SUBJECT = $1 if m/^Subject:\s*(.*)\n/; }
  278.       if (/^From:/) { $FROM = $1 if m/^From:\s*(.*)\n/; $INFROM = 1; }
  279.       if (/^Original-From:/) { $OFROM = $1 if m/^Original-From:\s*(.*)\n/; }
  280.       if (/^Reply-To:/) { $REPLYTO = $1 if m/^Reply-To:\s*(.*)\n/; }
  281.       
  282.       if ($_ eq "\n") {
  283. ## Blank line ends headers.
  284.     $HEADERS = 0;
  285.     &debug("Subject = $SUBJECT\n") if $SUBJECT;
  286.         &loadCommand($SUBJECT) if $SUBJECT;
  287.       }
  288.     }
  289.   }
  290.   else {
  291.     &loadCommand($_);
  292.   }
  293. }
  294.  
  295.  
  296. ## We have attempted to parse the entire message.  First, let's fix up
  297. ## set the $ADDRESS, which will be used in the rest of the program.
  298. ## $ADDRESS is the address of the person using the bmw at the moment.
  299.  
  300. $ADDRESS = "";
  301. if ($ENV{'SENDER'}) {
  302.   $ADDRESS = $ENV{'SENDER'};
  303. }
  304. else {
  305.   $ADDRESS = $FROM if $FROM;
  306.   $ADDRESS = $OFROM if $OFROM;
  307.   $ADDRESS = $REPLYTO if $REPLYTO;
  308.   $ADDRESS = &fixAddress($ADDRESS);
  309. }
  310.  
  311. &debug("Address = $ADDRESS\n");
  312.  
  313. if (!$ADDRESS) {
  314.   &DIE("Invalid address: $ADDRESS\n");
  315. }
  316.  
  317. ## Commands loaded, a good address.  What more could we want?
  318.  
  319. &processCommands();
  320.  
  321. &finish(0);
  322.  
  323. ## WE'RE DONE!
  324.  
  325. #### SUBROUTINES BELOW ####
  326.  
  327. sub fixAddress {
  328. ## fixAddress attempts to expunge an address string of all extraneous
  329. ## text except for the actual address.  It assumes that addresses have the
  330. ## forms:
  331. ##
  332. ##  <address> username
  333. ##  username <address>
  334. ##  (username) address
  335. ##  address (username)
  336.   local($a) = @_;
  337.   $_ = $a;
  338.   if ($a =~ /.*\<.*\>.*/) {
  339. ## <> format?  pretty easy.
  340.     $a = $1 if m/.*\<(.*)\>.*/;
  341.   }
  342.   elsif ($a =~ /.*\(.*\).*/) {
  343.     $a = ($1 . $2) if m/(.*)\(.*\)(.*)/;
  344.   }
  345.   $_ = $a;
  346.   tr/ \t//d;
  347.   return $_;
  348. }
  349.  
  350.  
  351. sub loadCommand {
  352. ## parse the parameter.
  353.   local($_) = @_;
  354.   $COMMANDS[$#COMMANDS+1] = "SUB" if m/^\s*sub.*/i;
  355.   $COMMANDS[$#COMMANDS+1] = "UNS" if m/^\s*uns.*/i;
  356.   $COMMANDS[$#COMMANDS+1] = "WHO" if m/^\s*who.*/i;
  357.   $COMMANDS[$#COMMANDS+1] = "DIR $1" if m/^\s*dir\s*(\S*)/i;
  358.   $COMMANDS[$#COMMANDS+1] = "GET $1" if m/^\s*get\s*(\S*)/i;
  359.   $COMMANDS[$#COMMANDS+1] = "HEL" if m/^\s*hel.*/i;
  360.   $COMMANDS[$#COMMANDS+1] = "PIN" if m/^\s*pin.*/i;
  361.   $COMMANDS[$#COMMANDS+1] = "DIG" if m/^\s*dig.*/i;
  362.   $COMMANDS[$#COMMANDS+1] = "UND" if m/^\s*und.*/i;
  363.   $COMMANDS[$#COMMANDS+1] = "CD $1" if m/^\s*cd\s*(\S*)/i;
  364. }
  365.  
  366.  
  367. sub processCommands {
  368.   if ($#COMMANDS > -1) {
  369.     local($i);
  370.     &startReply();
  371.     for ($i=0; $i <= $#COMMANDS; $i++)
  372.     {
  373.       $_ = $COMMANDS[$i];
  374.       if (/^SUB/) { &doSub($_); }
  375.       elsif (/^UNS/) { &doUns($_); }
  376.       elsif (/^WHO/) { &doWho($_); }
  377.       elsif (/^DIR/) { &doDir($_); }
  378.       elsif (/^GET/) { &doGet($_); }
  379.       elsif (/^HEL/) { &doHel($_); }
  380.       elsif (/^PIN/) { &doPin($_); }
  381.       elsif (/^DIG/) { &doDig($_); }
  382.       elsif (/^UND/) { &doUnd($_); }
  383.       elsif (/^CD/)  { &doCD($_);  }
  384.       else {
  385.         &reply("Unknown command: $_.\nNow how'd that happen?\n");
  386.         &error("Unknown command: $_\n");
  387.       }
  388.     }
  389.   }
  390.   else {
  391.     &standardReply();
  392.   }
  393.   &sendReply();
  394. }
  395.  
  396. sub standardReply {
  397.   &startReply();
  398.   &reply("\nI could not detect any commands in your mail to me.\n" .
  399.          "Need help?  Set your subject line to HELP.\n");
  400.   &sendReply();
  401. }
  402.  
  403. sub startReply {
  404.   local($FQDN) = $GLOBALS{'FQDN'};
  405.   if ($REPLYOPEN) { return; }
  406.   open(REPLY, ">$REPLYFILE") || &DIE("Cannot open $REPLYFILE: $!\n");
  407.   print REPLY "To: $ADDRESS\n";
  408.   print REPLY "Subject: Reply from $LISTREQUEST\n";
  409.   print REPLY "Errors-To: $LISTOWNER@$FQDN\n";
  410.   print REPLY "Reply-To: $LISTREQUEST@$FQDN\n";
  411.   print REPLY "From: $LISTOWNER@$FQDN\n";
  412.   print REPLY "Sender: $LISTOWNER@$FQDN\n";
  413.   print REPLY "X-bmw: Black Marble Wombat Version $VERSION\n";
  414.   print REPLY "X-list: $LISTNAME@$FQDN\n\n";
  415.   if (-e $MESSAGE)
  416.   {
  417.     local($listname) = $LISTNAME;
  418.     $listname =~ tr/a-z/A-Z/;
  419.     open(MESSAGE, "<$MESSAGE") || &DIE("Cannot open $MESSAGE: $!\n");
  420.     while (<MESSAGE>) 
  421.     { 
  422.       s/LISTNAME/$listname/g;
  423.       s/LISTOWNER/$LISTOWNER@$FQDN/g;
  424.       s/LISTREQUEST/$LISTREQUEST@$FQDN/g;
  425.       s/LISTADDR/$LISTNAME@$FQDN/g;
  426.       print REPLY $_; 
  427.     }
  428.     close(MESSAGE);
  429.   }
  430.   else {
  431.     &error("No message file for $LISTNAME.\n");
  432.     print REPLY "Black Marble Wombat, Version $VERSION\n";
  433.   }
  434.   print REPLY "\n" . 
  435.               "List addresses:\n" . 
  436.               "  Post messsages to        -> $LISTNAME@$FQDN\n" .
  437.               "  Automatic administration -> $LISTREQUEST@$FQDN\n" .
  438.               "  List owner (a person)    -> $LISTOWNER@$FQDN\n";
  439.   print REPLY "\nHello $ADDRESS.\n";
  440.   $REPLYOPEN = 1;
  441. }
  442.  
  443. sub sendReply {
  444.   if (!$REPLYOPEN) { &startReply(); }
  445.   &reply("\nThe Black Marble Wombat Mailing List Manager, " .
  446.          "Version $VERSION\n" .
  447.          "By Clay Luther, clay@gojira.monsta.com\n" . 
  448.          "Copyright (c) 1994 Monsta, Inc.\n");
  449.   close(REPLY);
  450.   $REPLYOPEN = 0;
  451.   &Mail($REPLYFILE);
  452. }
  453.  
  454. sub reply {
  455.   local($s) = @_;
  456.   if (!$REPLYOPEN) { &startReply(); }
  457.   print REPLY $s;
  458. }
  459.  
  460. sub Mail {
  461. ## Send a file by mail.
  462.   local($f) = @_;
  463.   local($mailstr) = $GLOBALS{'SENDMAIL'} . " " .
  464.                     $GLOBALS{'SENDMAILOPTS'} . " " .
  465.                     $ADDRESS;
  466.   if (-r $f) {
  467.     local($cmd) = `cat $f | $mailstr`;
  468.     $cmd =~ tr/\s//d;
  469.     &error("Mail command ($mailstr) returned $cmd\n") if $cmd;
  470.   }
  471.   else {
  472.     &error("Could not read $r\n");
  473.   }
  474. }
  475.  
  476. sub error {
  477.   local($e) = @_;
  478.   $ERRORS[$#ERRORS+1] = $e;
  479. }
  480.  
  481. ##
  482. ## Command processing
  483. ##
  484.  
  485. sub doPin {
  486.   &reply("\nCommand: PING\n");
  487.   &reply("The Black Marble Wombat, Version $VERSION\n");
  488.   &log("PIN $ADDRESS");
  489. }
  490.  
  491. sub doWho {
  492. ## Attempt to display the list (and digest list) subscribers.
  493.   local($cnt) = 0;
  494.   &reply("\nCommand: WHO\n");
  495.   if (open(LF, "<$LISTFILE")) {
  496.      while (<LF>) { &reply($_) && $cnt++ if (!/$LISTOWNER/); }
  497.      close(LF);
  498.    }
  499.    else {
  500.      &error("doWho: could not open $LISTFILE: $!\n");
  501.    }
  502.  
  503.    if ($GLOBALS{'DIGEST'} && -e $DIGESTFILE)
  504.    {
  505.      if (open(LF, "<$DIGESTFILE")) {
  506.        while (<LF>) { &reply($_) && $cnt++ if (!/$LISTOWNER/); }
  507.        close(LF);
  508.      }
  509.      else {
  510.        &error("doWho: could not open $DIGESTFILE: $!\n");
  511.      }
  512.    }
  513.  
  514.    &reply("\n$cnt subscriber(s).\n");
  515. }
  516.  
  517.  
  518. sub doSub {
  519. ## Allow the user to subscribe to the mailing list or its digest.
  520.   &reply("\nCommand: SUBSCRIBE\n");
  521.   if ($GLOBALS{'DIGEST'} && &inList($DIGESTFILE)) {
  522.     if (&removeFromList($DIGESTFILE)) {
  523.       &reply("You have been removed from the digest list.\n")
  524.     }
  525.     else {
  526.       &reply("There was an error on this end and you were not removed\n" .
  527.              "from the digest list.\n");
  528.     }
  529.   }
  530.   if (!&inList($LISTFILE)) {
  531.     if (&addToList($LISTFILE)) {
  532.       &reply("You have been added to the mailing list.\n");
  533.       &log("SUB $ADDRESS");
  534.     }
  535.     else {
  536.       &reply("There was an error on this end and you were not added\n" .
  537.              "to the mailing list.\n");
  538.     }
  539.   }
  540.   else {
  541.     &reply("You are already subscribed to the mailing list.\n");
  542.   }
  543. }
  544.  
  545.  
  546. sub doDig {
  547.   &reply("\nCommand: DIGEST\n");
  548.   if ($GLOBALS{'DIGEST'}) {
  549.     if (&inList($LISTFILE)) {
  550.       if (&removeFromList($LISTFILE)) {
  551.         &reply("You have been removed from the mailing list.\n");
  552.       }
  553.       else {
  554.         &reply("There was an error on this end and you were not removed\n" .
  555.                "from the mailing list file.\n");
  556.       }
  557.     }
  558.     if (!&inList($DIGESTFILE)) {
  559.       if (&addToList($DIGESTFILE)) {
  560.         &reply("You have been added to the digest list.\n");
  561.         &log("DIG $ADDRESS");
  562.       }
  563.       else {
  564.         &reply("There was an error on this end and you were not added\n" .
  565.                "to the digest list.\n");
  566.       }
  567.     }
  568.     else {
  569.       &reply("You are already on the digest list.\n");
  570.     }
  571.   }
  572.   else {
  573.     &reply("This list does not currently support a digest format.\n");
  574.   }
  575. }
  576.  
  577.  
  578.  
  579. sub doUns {
  580.   &reply("\nCommand: UNSUBSCRIBE\n");
  581.   if (&inList($LISTFILE)) {
  582.     if (&removeFromList($LISTFILE)) {
  583.       &reply("You have been removed from the mailing list.\n");
  584.       &log("UNS $ADDRESS");
  585.     }
  586.     else {
  587.       &reply("There was an error on this end and you were not removed\n" .
  588.              "from the mailing list.\n");
  589.     }
  590.   }
  591.   else {
  592.     &reply("I could not find your address:\n" .
  593.            "  $ADDRESS\n" .
  594.            "in the mailing list file.  Perhaps you subscribed from a\n" .
  595.            "different address or you need to send an UNDIGEST request\n" .
  596.            "instead.\n");
  597.     &doOther($DIGESTFILE);
  598.   }
  599. }
  600.  
  601.  
  602.  
  603. sub doUnd {
  604.   &reply("\nCommand: UNDIGEST\n");
  605.   if ($GLOBALS{'DIGEST'}) {
  606.     if (&inList($DIGESTFILE)) {
  607.       if (&removeFromList($DIGESTFILE)) {
  608.         &reply("You have been removed from the digest list.\n");
  609.         &log("UND $ADDRESS");
  610.       }
  611.       else {
  612.         &reply("There was an error on this end and you were not removed\n" .
  613.                "from the digest list.\n");
  614.       }
  615.     }
  616.     else {
  617.       &reply("I could not find your address:\n" .
  618.              "  $ADDRESS\n" .
  619.              "in the digest list file.  Perhaps you subscribed from a\n" .
  620.              "different address or you need to send a UNSUBSCRIBE request\n" .
  621.              "instead.\n");
  622.       &doOther($LISTFILE);
  623.     }
  624.   }
  625.   else {
  626.     &reply("The mailing list does not support a digest format.\n");
  627.   }
  628. }
  629.  
  630. sub doOther {
  631.   local($OTHERFILE) = @_;
  632.   if (-e $OTHERFILE) {
  633.     &reply("\nAttempting to find you in the other list...\n");
  634.     if (&inList($OTHERFILE)) {
  635.       if (&removeFromList($OTHERFILE)) {
  636.         &reply("\nYou have been removed from the other list.\n");
  637.         &log("OTH $ADDRESS");
  638.       }
  639.       else {
  640.         &reply("There was an error on this end and you were not removed\n" .
  641.                "from the other list.\n");
  642.       }
  643.     }
  644.     else {
  645.       &reply("\nI could not find your address:\n" .
  646.              "  $ADDRESS\n" .
  647.              "in the other list file.  Please feel free to contact the list owner,\n" .
  648.              "  $LISTOWNER@$FQDN\n" .
  649.              "for help.\n");
  650.     }
  651.   }
  652.   else {
  653.     &reply("The mailing list does not support the other format.\n");
  654.   }
  655. }
  656.  
  657.  
  658.  
  659. sub inList {
  660.   local($l) = @_;
  661.   if (open(LF,"<$l")) {
  662.     while (<LF>) {
  663.       if (/$ADDRESS/i) {
  664.         close(LF);
  665.         return 1;
  666.       }
  667.     }
  668.     close(LF);
  669.   }
  670.   else {
  671.     &error("inList: could not open $l: $!\n");
  672.   }
  673.   return 0;
  674. }
  675.  
  676.  
  677.  
  678. sub addToList {
  679.   local($l) = @_;
  680.   local($ret) = 0;
  681.   local($cmd);
  682.   if (&lockFile($l)) {
  683.     $cmd = `cp $l $l.bak`; chop($cmd); 
  684.     chmod 0664, "$l.bak";
  685.     chown $GLOBALS{'USER'},$GLOBALS{'GROUP'}, "$l.bak";
  686.  
  687.     &error("addToList: Cmd returned $cmd\n") if $cmd;
  688.     if (open(LF,">>$l")) {
  689.       print LF $ADDRESS . $LF;
  690.       close(LF);
  691.       $ret = 1;
  692.     }
  693.     else {
  694.       &error("addToList: could not open $l: $!\n");
  695.     }
  696.     &unlockFile($l);
  697.   }
  698.   else {
  699.     &error("addToList: $l locked!\n");
  700.   }
  701.   return $ret;
  702. }
  703.  
  704.  
  705. sub removeFromList {
  706.   local($l) = @_;
  707.   local($ret) = 0;
  708.   if (&lockFile($l)) {
  709. ## move the list to a temp file, then open it and copy it back, except for
  710. ## the user we want to delete.
  711.     system("cp $l $TMPFILE");
  712.     if (open(TMPFILE, "<$TMPFILE")) {
  713.       if (open(LF, ">$l")) {
  714.         while (<TMPFILE>) {
  715.           print LF $_ if (!/$ADDRESS/i)
  716.         }
  717.         close(TMPFILE);
  718.         close(LF);
  719.         $ret = 1;
  720.       }
  721.       else {
  722.         &error("removeFromList: could not open $l: $!\n");
  723.         close(TMPFILE);
  724.       }
  725.     }
  726.     else {
  727.       &error("removeFromList: could not open $TMPFILE: $!\n");
  728.     }
  729.     &unlockFile($l);
  730.   }
  731.   else {
  732.     &error("removeFromList: $l locked!\n");
  733.   }
  734.   return $ret;
  735. }
  736.  
  737.  
  738.  
  739. sub doDir {
  740.   local($v) = @_;
  741.   local($cmd, $p) = split(/ /,$v);
  742. ## Show the user a directory listing.
  743.   &reply("\nCommand: DIR $p\n");
  744.   if (-d $LISTARC) {
  745.     local($dir);
  746.     if ($WDIR) {
  747.       $dir = $LISTARC . "/" . $WDIR . "/" . $p;
  748.     }
  749.     else {
  750.       $dir = $LISTARC . "/" . $p;
  751.     }
  752.     if ($dir =~ /\.\./) {
  753.       &reply("Invalid directory.\n");
  754.       &log("INVDIR $ADDRESS, $p");
  755.       &error("$ADDRESS attempted a dir of $p.\n");
  756.     }
  757.     elsif (-d $dir) {
  758. ## Good directory case
  759.       if (opendir(DIR, $dir)) {
  760.         rewinddir(DIR);
  761.         local(@dirl) = readdir(DIR);
  762.         local($fpath);
  763.         @dirl = sort(@dirl);
  764.         while ($dirl[0]) {
  765.           if ($dirl[0] !~ /^\./ && $dirl[0] !~ /^\.\./) {
  766.             $fpath = $dir . "/" . $dirl[0];
  767.             if (-d $fpath) { &reply("d    $dirl[0]\n"); }
  768.             else { &reply("f    $dirl[0]\n"); }
  769.           }
  770.           shift(@dirl);
  771.         }
  772.         closedir(DIR);
  773.         &reply("--\n");
  774.         &log("DIR $ADDRESS");
  775.       }
  776.       else {
  777.         &reply("There was an error on this end.\n");
  778.         &error("doDir: could not opendir $dir: $!\n");
  779.       }
  780.     }
  781.     else {
  782.       &reply("Invalid directory.\n");
  783.     }
  784.   }
  785.   else {
  786.     &reply("The list does not currently support archives.\n");
  787.   }
  788. }
  789.  
  790.  
  791. sub doCD {
  792.   local($v) = @_;
  793.   local($cmd, $cdir) = split(/ /, $v);
  794.   &reply("\nCommand: CD $cdir\n");
  795.   if (-d $LISTARC) {
  796.     if ($cdir) {
  797.       if ($cdir !~ /\.\./) {
  798.         local($wpath);
  799.         if ($WDIR) {
  800.           $wpath = $LISTARC . "/" . $WDIR . "/" . $cdir;
  801.         }
  802.         else {
  803.           $wpath = $LISTARC . "/" . $cdir;
  804.         }
  805.         if (-d $wpath) {
  806.           $WDIR = $cdir;
  807.           &reply("Working directory set to $WDIR\n");
  808.         }
  809.         else {
  810.           &reply("Invalid directory.\n");
  811.         }
  812.       }
  813.       else {
  814.         &reply("Invalid directory specification.\n");
  815.         &log("INVDIR $ADDRESS, $cdir");
  816.         &error("$ADDRESS attempted a CD $cdir.\n");
  817.       }
  818.     }
  819.     else {
  820.       $WDIR = "";
  821.       &reply("Working directory reset.\n");
  822.     }
  823.   }
  824.   else {
  825.     &reply("The list does not currently support archives.\n");
  826.   }
  827. }
  828.  
  829.  
  830.  
  831. sub doGet {
  832. ## Get a file from the archives.
  833.   local($v) = @_;
  834.   local($cmd, $f) = split(/ /, $v);
  835.   &reply("\nCommand: GET $f\n");
  836.   if (-d $LISTARC) {
  837.     local($fname);
  838.     if ($WDIR) {
  839.       $fname = $LISTARC . "/" . $WDIR . "/" . $f;
  840.     }
  841.     else {
  842.       $fname = $LISTARC . "/" . $f;
  843.     }
  844.     local(@ff) = split(/\//, $f);
  845.     local($ffname) = $ff[$#ff];   # This is the "absolute" name of the file
  846.     if ($f !~ /\.\./ && $f !~ /^\./) {
  847.       if (-e $fname && ! -d $fname && -r $fname) {
  848.         &reply("Sending file '$ffname'...\n");
  849.         &sendFile($fname, $ffname);
  850.         &reply("--\n");
  851.         &log("GET $ADDRESS, $f");
  852.       }
  853.       else {
  854.         &reply("That file does not exist.\n");
  855.       }
  856.     }
  857.     else {
  858.       &reply("Invalid file specification.\n");
  859.       &error("$ADDRESS attempted GET $f\n");
  860.       &log("INVFIL $ADDRESS, $f");
  861.     }
  862.   }
  863.   else {
  864.     &reply("The list does not currently support archives.\n");
  865.   }
  866.   system("rm -f $TMPFILE.st");
  867. }
  868.  
  869.  
  870. sub sendFile {
  871.   local($f, $ff) = @_;
  872.   if (-T $f) {
  873.     &sendTextFile($f, $ff);
  874.   }
  875.   else {
  876.     &sendBinaryFile($f, $ff);
  877.   }
  878. }
  879.  
  880. sub sendTextFile {
  881. # We have been passed the name of a text file to send.  This text file
  882. # might be very large (greater than 30000 bytes).  If so, break it up
  883. # and send the chunks.
  884.   local($f, $ff) = @_;
  885.   local($fsize) = -s $f;
  886.   &debug("$f, $ff, $fsize\n");
  887.   if ($fsize > 30000) {
  888.     local($pnum) = 1;
  889.     local($maxnum) = int(0.5 + ($fsize / 30000));
  890.     local($psize) = -1;
  891.     if (open(TF, "<$f")) {
  892.       while (<TF>) {
  893.         if ($psize < 0) { # first time through
  894.           &debug("psize == -1\n");
  895.           &startST($pnum, $maxnum, $ff);
  896.           &printST("---cut here---\n");
  897.           $psize = 0;
  898.         }
  899.         $psize += length();
  900.         &printST($_);
  901.         if ($psize > 30000) {
  902.           &printST("---cut here---\n");
  903.           &sendST();
  904.           &reply("Package $pnum/$maxnum sent.\n");
  905.           $pnum += 1;
  906.           $psize = -1;
  907.           &debug("Sending $ff $pnum/$maxnum $psize\n");
  908.         }
  909.       }
  910.       close(TF);
  911.       if ($STOPEN) {
  912.         &sendST();
  913.         &reply("Package $pnum/$maxnum sent.\n");
  914.       }
  915.     }
  916.     else {
  917.       &reply("There was an error on this end.\n");
  918.       &error("sendTextFile: could not open $f: $!\n");
  919.     }
  920.   }
  921.   else {
  922.     &startST(1, 1, $ff);
  923.     if (open(TF,"<$f")) {
  924.       while (<TF>) { &printST($_) };
  925.       close(TF);
  926.       &sendST();
  927.     }
  928.     else {
  929.       &error("sendTextFile: could not open $f: $!\n");
  930.       &reply("There was an error on this end.\n");
  931.     }
  932.   }
  933. }
  934.  
  935.  
  936. sub startST {
  937.   local($n1, $n2, $ff) = @_;
  938.   local($FQDN) = $GLOBALS{'FQDN'};
  939.   if ($STOPEN) { return 1; }
  940.   if (open(ST, ">$TMPFILE.st")) {
  941.     &debug("$TMPFILE.st opened.\n");
  942.     print ST "From: $LISTREQUEST@$FQDN\n";
  943.     print ST "To: $ADDRESS\n";
  944.     print ST "Sender: $LISTOWNER@$FQDN\n";
  945.     print ST "Errors-To: $LISTOWNER@$FQDN\n";
  946.     print ST "Subject: $ff: Part $n1 of $n2\n\n";
  947.     $STOPEN = 1;
  948.   }
  949.   else {
  950.     &error("startST: could not open $TMPFILE.st: $!\n");
  951.   }
  952.   return $STOPEN;
  953. }
  954.  
  955.  
  956.  
  957. sub printST {
  958.   local($s) = @_;
  959.   if ($STOPEN) {
  960.     print ST $s;
  961.   }
  962. }
  963.  
  964.  
  965. sub sendST {
  966.   local($cmd, $ret);
  967.   if ($STOPEN) {
  968.     close(ST);
  969.     $cmd = $GLOBALS{'SENDMAIL'} . "  " . $ADDRESS;
  970.     $ret = `cat $TMPFILE.st | $cmd`; chop($ret);
  971.     if ($ret) {
  972.       &error("sendST: cmd returned $ret.\n");
  973.     }
  974.     &debug("Sent text file.\n");
  975.   }
  976.   system("rm -f $TMPFILE.st");
  977.   $STOPEN = 0;
  978. }
  979.  
  980.  
  981. sub sendBinaryFile {
  982. # When sending a binary file, we must convert it to text with an encoding
  983. # program, then send it to the user as text.
  984.   local($f, $ff) = @_;
  985.   local($cmd, $ret);
  986.   &reply("This file was converted with uuencode.\n");
  987.   $cmd = $GLOBALS{'ENCODE'} . " " . $f . " " . $ff . " > " . $TMPFILE;
  988. # The cmd should look like "uuencode /dir/dir/filename filename > tmpfile"
  989.   $ret = `$cmd`; chop($ret);
  990.   if ($ret) {
  991.     &error($GLOBALS{'ENCODE'} . " returned $ret.\n");
  992.     &reply("There was an error on this end.\n");
  993.   }
  994.   &sendTextFile($TMPFILE, $ff);
  995. }
  996.  
  997.  
  998.  
  999. sub doHel {
  1000.   &reply("\nCommand: HELP\n");
  1001.   if (-e $HELP) {
  1002.     if (open(HELP,"<$HELP")) {
  1003.       while (<HELP>) { &reply($_); }
  1004.       close(HELP);
  1005.       &log("HEL $ADDRESS");
  1006.     }
  1007.     else {
  1008.       &reply("There was an error on this end.\n");
  1009.       &error("doHel: could not open $HELP: $!\n");
  1010.     }
  1011.   }
  1012.   else {
  1013.     &reply("Sorry, there is no help currently available.\n");
  1014.   }
  1015. }
  1016.  
  1017.  
  1018.  
  1019. sub lockFile {
  1020.   local($f) = @_;
  1021.   local($lockf) = $f . ".LOCK";
  1022.   local($backoff) = 5;
  1023.   local($boc) = 0;
  1024.  
  1025.   while (-e $lockf) {
  1026.     sleep(5);
  1027.     $boc++;
  1028.     if ($boc > $backoff) {
  1029.       &debug("Lock file collision!\n");
  1030.       return 0;
  1031.     }
  1032.   }
  1033.   system("touch $lockf");
  1034.   chmod 0664, $lockf;
  1035.   chown $GLOBALS{'USER'}, $GLOBALS{'GROUP'}, $lockf;
  1036.   $LOCKS{$lockf} = 1;
  1037.   &debug("$f locked.\n");
  1038.   return 1;
  1039. }
  1040.  
  1041.  
  1042. sub unlockFile {
  1043.   local($f) = @_;
  1044.   local($lockf) = $f . ".LOCK";
  1045.   if (-e $lockf) { system("rm -f $lockf"); }
  1046.   delete $LOCKS{$lockf};
  1047.   &debug("$f unlocked.\n");
  1048. }
  1049.  
  1050. sub log {
  1051.   local($s) = @_;
  1052.   return if (!$GLOBALS{'LOG'});
  1053.   if (&lockFile($LOGFILE)) {
  1054.     if (! -e $LOGFILE) {
  1055.       system("touch $LOGFILE");
  1056.       chown $GLOBALS{'USER'}, $GLOBALS{'GROUP'}, $LOGFILE;
  1057.       chmod 0664,$LOGFILE;
  1058.     }
  1059.     if (open(LOGFILE, ">>$LOGFILE")) {
  1060.       local($date) = `date`; chop($date);
  1061.       print LOGFILE $date . ": " . $s . "\n";
  1062.       close(LOGFILE);
  1063.     }
  1064.     else {
  1065.       &error("log: could not open $LOGFILE: $!\n");
  1066.     }
  1067.     &unlockFile($LOGFILE);
  1068.   }
  1069.   else {
  1070.     &error("log: $LOGFILE locked!\n");
  1071.   }
  1072. }
  1073.  
  1074.  
  1075. sub debug {
  1076.   local($s) = @_;
  1077.   print $s if $GLOBALS{'DEBUG'};
  1078. }
  1079.