support/majordomo.cgi

   1 #!/usr/bin/perl
   2 ##
   3 ##  majordomo.cgi -- Send a mail to Majordomo
   4 ##
   5
   6 use HTML::Entities;
   7
   8 #   switch to unbuffered I/O
   9 $|++;
  10
  11 #   generate a webpage
  12 sub send_page {
  13     my ($text) = @_;
  14
  15     $O = '';
  16     $O .= "Content-type: text/html\n" .
  17           "Connection: close\n" .
  18           "\n";
  19     open(FP, "</v/openssl/web/support/majordomo.head.html");
  20     $O .= $_ while (<FP>);
  21     close(FP);
  22     $O .= $text;
  23     open(FP, "</v/openssl/web/support/majordomo.foot.html");
  24     $O .= $_ while (<FP>);
  25     close(FP);
  26     print $O;
  27 }
  28
  29 #   let us catch runtime errors...
  30 eval {
  31
  32 #   PATH_INFO
  33 $path_info = $ENV{'PATH_INFO'};
  34
  35 #   QUERY_STRING
  36 $query_string = $ENV{'QUERY_STRING'};
  37 if ($ENV{'REQUEST_METHOD'} eq 'POST') {
  38     $query_string = '';
  39     while (<STDIN>) { $query_string .= $_; }
  40 }
  41 %qs = ();
  42 @pairs = split(/&/, $query_string);
  43 foreach $pair (@pairs) {
  44     my ($name, $value) = split(/=/, $pair);
  45     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
  46     if ($qs{$name} ne '') {
  47         $qs{$name} .= ",$value";
  48     }
  49     else {
  50         $qs{$name} = $value;
  51     }
  52 }
  53
  54 #   check for parameter consistency
  55 die "You supplied to Email address."
  56     if ($qs{email} eq '');
  57 die "Hmmm... <tt>your\@address.dom</tt> is certainly not correct, friend."
  58     if ($qs{email} eq 'your@address.dom');
  59 die "The Email address you entered doesn't look like a valid RFC822 mail address."
  60     if ($qs{email} !~ m|.+@.+|);
  61 die "At least one list has to be selected."
  62     if ($qs{list} eq '');
  63 die "At least one action has to be selected."
  64     if ($qs{action} eq '');
  65 die "Bogus action!"
  66     if ($qs{action} ne 'subscribe' and $qs{action} ne 'unsubscribe');
  67
  68 #   generate mail
  69 $mail = '';
  70 $mail .= "From: nobody\@openssl.org\n";
  71 $mail .= "Reply-To: $qs{email}\n";
  72 $mail .= "Subject: Subscription to OpenSSL mailing list(s)\n";
  73 $mail .= "To: majordomo\@openssl.org\n";
  74 $mail .= "\n";
  75 foreach $list (split(/,/, $qs{list})) {
  76     die "Bogus listname!"
  77         if ($list ne 'announce' and $list ne 'users' and $list ne 'dev' and $list ne 'cvs');
  78     $mail .= "$qs{action} openssl-$list $qs{email}\n";
  79 }
  80
  81 #  send out mail
  82 open(MAIL, "| /usr/sbin/sendmail -oi -oee majordomo\@openssl.org");
  83 print MAIL $mail;
  84 close(MAIL);
  85
  86 #  generate result page
  87 &send_page(
  88     "Ok, the ingredients of the form were successfully parsed " .
  89     "and forwarded to Majordomo via Email in the following format:" .
  90     "<p>" .
  91     "<table cellpadding=5 bgcolor=\"#f0f0f0\"><tr><td>" .
  92     "<pre>".HTML::Entities::encode($mail)."</pre>\n" .
  93     "</td></tr></table>" .
  94     "<p>" .
  95     "Expect a reply in your ".HTML::Entities::encode($qs{email})." Email folder the next minutes.\n"
  96 );
  97
  98 #   die gracefully
  99 exit(0);
 100
 101 #   ...the runtime error handler:
 102 };
 103 if ($@) {
 104     my $text = $@;
 105     $text =~ s|at /.*||;
 106     &send_page(
 107         "A fatal error occured while processing the ingredients of your" .
 108         "Majordomo-request.  Please check the error message below, go back to" .
 109         "the form and fix the problem." .
 110         "<p>\n" .
 111         "<font color=\"#cc3333\"><b>$text</b></font>\n"
 112     );
 113 }
 114
 115 ##EOF##