"SfR Fresh" - the SfR Freeware/Shareware Archive

Member "tulp-4.2.1/src/deliver.pl" of archive tulp-4.2.1.tar.gz:

    1 #! /usr/local/bin/perl
    2 
    3 ## Put here your local delivery agent (see sendmail.cf)
    4 $mail = "/usr/local/etc/tulp/queue";
    5 
    6 ## Path to Sendmail
    7 $sendmail = "/usr/sbin/sendmail";
    8 
    9 ## Who gets the rejected messages
   10 $mgr = "wolf";
   11 
   12 ## Should the UNIX From line be removed ?  True on many systems.
   13 $nofrom = 0;
   14 
   15 ## Regexps for the unwanted strings.
   16 @avoid_hdr = (
   17 	'help',
   18 	'ind(ex)?',
   19 	'lists?',
   20 	'(please\s+)?(add|unsub|remove|del|sub(\s|scribe)?|sign?o?f?f?)',
   21 	'rev(iew)?\s+\S+'
   22              );
   23 @avoid_msg = (
   24 	'help',
   25 	'ind(ex)?',
   26 	'lists?',
   27 	'(please\s+)?(add|unsub|remove|del|sub(\s|scribe)?|sign?o?f?f?)',
   28 	'rev(iew)?\s+\S+'
   29              );
   30 
   31 $arg = $ARGV[0];
   32 @ARGV = ();
   33 
   34 ## Paragraph mode
   35 $/ = "";
   36 $* =  1;
   37 
   38 ## Get the header.
   39 $hdr = <>;
   40 $hdr =~ s/^From\s+.+\n//i if ($nofrom == 1);
   41 
   42 ## Get the entire message
   43 $* = 0;
   44 $/ = "\n";
   45 while (<>) {
   46    push(@line, $_);
   47 }
   48 
   49 
   50 ## If more than 10 lines or to listserv then it should be okay.
   51 &putMsg() if ($arg =~ /^listserv$/i);
   52 &putMsg() if ($#line > 10);
   53 
   54 $nhdr = $hdr;
   55 
   56 $/ = "";
   57 $* =  1;
   58 
   59 $nhdr =~ s/\n\s+//g;
   60 
   61 $from = $1 if ($hdr =~ /^From:\s+(.+)\s*$/i);
   62 $subject = $1 if ($hdr =~ /^Subject:\s+(.+)\s*$/i);
   63 
   64 if ($subject) {
   65    foreach $avoid (@avoid_hdr) {
   66       if ($subject =~ /^\s*($avoid)\s*/i) {  ## We have a suspicious header
   67          &mailMsg();
   68       }
   69    }
   70 }
   71 
   72 $* = 0;
   73 $/ = "\n";
   74 
   75 foreach $line (@line) {
   76    foreach $avoid (@avoid_msg) {
   77       if ($line =~ /^\s*($avoid)\s*/i) {  ## We have a suspicious header
   78          &mailMsg();
   79       }
   80    }
   81 }
   82 
   83 &putMsg();
   84 exit(0);
   85 
   86 sub putMsg {
   87    open(STDOUT, "| $mail $arg");
   88    print $hdr;
   89    print @line;
   90    close(STDOUT);
   91    exit(0);
   92 }
   93 
   94 sub mailMsg {
   95    $from = $mgr if (!$from);
   96    open(STDOUT, "| $sendmail -f listserv-request -t");
   97    print "To: $from\n";
   98    print "Subject: [listserv]: Erreur d'aiguillage?\n";
   99    print "Bcc: $mgr\n\n";
  100    print "
  101 Le message suivant a ete adresse a la liste $arg alors qu'il semble
  102 contenir des commandes telles subscribe, signoff, help, index, get...
  103 
  104 Si effectivement votre message contenait une commande, sachez
  105 que les commandes ne doivent en aucun cas etre adresses aux listes
  106 (en vous abonnant a cette liste vous aviez recu les instructions
  107 d'utilisation, qu'en avez-vous fait ?).
  108 Sachez que les commandes doivent etre envoyees a l'adresse
  109 listserv@grasp.insa-lyon.fr uniquement.
  110 
  111 Si votre message etait effectivement destine a la liste, celui-ci
  112 a malheureusement ete interprete par le logiciel comme une
  113 commande. Veuillez contacter le gestionnaire du service:
  114 $arg-request@grasp.insa-lyon.fr afin qu'il s'occupe de votre
  115 message.     Merci de votre attention.
  116 
  117 ------ Debut message suspect --------
  118 X-Listserv-To: $arg\n";
  119    print $hdr;
  120    print @line;
  121    print "------- Fin message suspect ---------\n";
  122    exit(0);
  123 }