mhonarc-commits
[Top] [All Lists]

CVS: mhonarc/MHonArc/contrib mhastart.pl,1.4,1.5

2004-03-09 00:15:39
Update of /home/users/mhonarc.org/ehood/cvs/mhonarc/mhonarc/MHonArc/contrib
In directory denethor.mallorn.com:/tmp/cvs-serv27133

Modified Files:
	mhastart.pl 
Log Message:


Index: mhastart.pl
===================================================================
RCS file: /home/users/mhonarc.org/ehood/cvs/mhonarc/mhonarc/MHonArc/contrib/mhastart.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** mhastart.pl	6 Feb 2003 01:40:33 -0000	1.4
--- mhastart.pl	9 Mar 2004 07:15:32 -0000	1.5
***************
*** 1,4 ****
--- 1,5 ----
  #!/usr/bin/perl
  
+ package MHAStart;
  # $Id$
  
***************
*** 28,52 ****
  
  BEGIN	{
!     if ($ENV{'HTTP_USER_AGENT'} and $ENV{'HTTP_USER_AGENT'} !~ /^libwww-perl/
!       and $ENV{'QUERY_STRING'} ne 'update') {
          require CGI::Carp;
          errordir();
!         if ($errordir and $errordir ne '') {
              import CGI::Carp 'carpout';
!             open (LOG, ">>$errordir/ERRORLOG.TXT") or
!               exit (print "Content-type: text/html\n\n", "<h1>Error</h1>\n",
!                           "<pre>Couldn't open $errordir/ERRORLOG.TXT\n$!");
              carpout(\*LOG);
          } else {
!             unless (eval { CGI::Carp -> VERSION(1.20) }) {
                  # previous versions don't handle eval properly with fatalsToBrowser
!                 exit (print "Content-type: text/html\n\n", "<h1>Error</h1>\n<tt>", $@,
!                             '<p>You should either upgrade to v1.20 or higher, or ',
!                             "use the 'carpout' routine by setting the \$errordir ",
!                             'configuration variable.');
              }
              import CGI::Carp 'fatalsToBrowser';
          }
      }
      sub errordir {
  
--- 29,65 ----
  
  BEGIN	{
!     if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} !~ /^(?:libwww-perl|LWP::Simple)/
!       and $ENV{QUERY_STRING} ne 'update') {
          require CGI::Carp;
          errordir();
!         if ($errordir) {
              import CGI::Carp 'carpout';
!             open LOG, ">> $errordir/ERRORLOG.TXT" or
!               mhaexit(prtheader(), "<h1>Error</h1>\n",
!                       "<pre>Couldn't open $errordir/ERRORLOG.TXT\n$!");
              carpout(\*LOG);
          } else {
!             unless ( eval { CGI::Carp -> VERSION(1.20) } ) {
                  # previous versions don't handle eval properly with fatalsToBrowser
!                 mhaexit(prtheader(), "<h1>Error</h1>\n<tt>", $@,
!                         '<p>You should either upgrade to v1.20 or higher, or ',
!                         "use the 'carpout' routine by setting the \$errordir ",
!                         'configuration variable.');
              }
              import CGI::Carp 'fatalsToBrowser';
          }
      }
+ 
+     sub mhaexit {
+         print @_ if @_;
+         if ($ENV{MOD_PERL}) {
+             eval "use Apache";
+             Apache::exit() unless $@;
+         }
+         exit;
+     }
+ 
+     sub prtheader { "Content-Type: text/html; charset=ISO-8859-1\n\n" }
+ 
      sub errordir {
  
***************
*** 101,105 ****
  
  ## Max size for a message to pass to this script
! $msgmaxsize = 100;  # KiB (kibibytes, i.e. bytes / 1,024)
  
  ## Update $mbox from pop account (requires the Net::POP3 module)
--- 114,118 ----
  
  ## Max size for a message to pass to this script
! $msgmaxsize = 128;  # KiB (kibibytes, i.e. bytes / 1,024)
  
  ## Update $mbox from pop account (requires the Net::POP3 module)
***************
*** 230,234 ****
  =head1 AUTHOR
  
!   Copyright  2002-2003 Gunnar Hjalmarsson
    http://www.gunnar.cc/cgi-bin/contact.pl
  
--- 243,247 ----
  =head1 AUTHOR
  
!   Copyright  2002-2004 Gunnar Hjalmarsson
    http://www.gunnar.cc/cgi-bin/contact.pl
  
***************
*** 240,255 ****
  
  checkpath();
! $in{'pw'} = $in{'routine'} = '';         # prevents "uninitialized" warnings
! unshift (@INC, $lib);
! ($scriptname = $0 ? $0 : $ENV{'SCRIPT_FILENAME'}) =~ s/.*[\/\\]//;
! 
! if (!$ENV{'HTTP_USER_AGENT'}) {                        #
!     exit (autoupdate(''));                             # if not invoked from a browser
! } elsif ($ENV{'HTTP_USER_AGENT'} =~ /^libwww-perl/) {  #
!     exit (autoupdate('fwd'));
! }
! 
! if ($ENV{'QUERY_STRING'} eq 'update') {  # intended for update via hyperlink
!     exit (refresh());                    # on the main index page
  }
  
--- 253,272 ----
  
  checkpath();
! $in{pw} = $in{routine} = '';             # prevents "uninitialized" warnings
! unshift @INC, $lib;
! use File::Basename;
! $scriptname = basename( $0 or $ENV{SCRIPT_FILENAME} );
! 
! unless ($ENV{HTTP_USER_AGENT}) {                                      #
!     autoupdate('');                                                   # if not invoked
!     mhaexit();                                                        # from a browser
! } elsif ($ENV{HTTP_USER_AGENT} =~ /^(?:libwww-perl|LWP::Simple)/) {   #
!     autoupdate('fwd');
!     mhaexit();
! }
! 
! if ($ENV{QUERY_STRING} eq 'update') {    # intended for update via hyperlink
!     refresh();                           # on the main index page
!     mhaexit();
  }
  
***************
*** 257,272 ****
  if (defined $adminpw and $adminpw ne '') {
      die "You need to set some other password than \"PASSWORD\".\n" if $adminpw eq 'PASSWORD';
!     exit (print loginpage()) unless checkpw();
  }
  
! if    (!$in{'routine'})                        { print frames() }
! elsif ($in{'routine'} eq 'forms')              { print forms() }
! elsif ($in{'routine'} eq 'adminstart')         { print adminstart() }
! elsif ($in{'routine'} eq 'add')                { add() }
! elsif ($in{'routine'} eq 'Remove')             { remove() }
! elsif ($in{'routine'} eq 'Remove latest msg')  { remove_mbox() }
! elsif ($in{'routine'} eq 'shell')              { shell() }
  else {
!     print "Content-type: text/html\n\n", 'Incorrect routine value!';
  }
  
--- 274,289 ----
  if (defined $adminpw and $adminpw ne '') {
      die "You need to set some other password than \"PASSWORD\".\n" if $adminpw eq 'PASSWORD';
!     mhaexit( loginpage() ) unless checkpw();
  }
  
! unless ($in{routine})                         { print frames() }
! elsif  ($in{routine} eq 'forms')              { print forms() }
! elsif  ($in{routine} eq 'adminstart')         { print adminstart() }
! elsif  ($in{routine} eq 'add')                { add() }
! elsif  ($in{routine} eq 'Remove')             { remove() }
! elsif  ($in{routine} eq 'Remove latest msg')  { remove_mbox() }
! elsif  ($in{routine} eq 'shell')              { shell() }
  else {
!     print prtheader(), 'Incorrect routine value!';
  }
  
***************
*** 286,310 ****
  sub autoupdate {
      my $fwd = shift;
!     my $size = $ENV{'CONTENT_LENGTH'} ? $ENV{'CONTENT_LENGTH'} : (stat(STDIN))[7];
      if ($pop3) {
          if ($size) {
!             exit (print "Status: 403 Script Config Obstacle\n\n") if $fwd eq 'fwd';
              print "Requested action aborted:\n",
                    "$scriptname is not configured to process messages directly.\n\n";
          } else {
!             updatearchive ('-add', '-quiet') if popretrieve();  # for invoking via cron
!         }                                                       # (or the command line)
      } else {
!         $size = sprintf ("%.f", $size / 1024);
          unless ($size > $msgmaxsize) {
!             my $newmail = join ('', <STDIN>);     # grabs message, that was passed to this
              $newmail =~ s/^(.+)\r?\n(From )/$2/;  # script, for instant update of the archive
!             my $pw = $1 ? $1 : '';
              if (defined $msgpw and $pw ne $msgpw) {
!                 exit (print "Status: 403 Password Check Failed\n\n") if $fwd eq 'fwd';
                  print "Requested action aborted:\nPassword check failed\n\n";
              } elsif ($newmail =~ /^From /) {
!                 updatembox (\$newmail);
!                 updatearchive ('-add', '-quiet');
                  print "Status: 204 No Content\n\n" if $fwd eq 'fwd';
              } else {
--- 303,327 ----
  sub autoupdate {
      my $fwd = shift;
!     my $size = ($ENV{CONTENT_LENGTH} or (stat STDIN)[7]);
      if ($pop3) {
          if ($size) {
!             mhaexit("Status: 403 Script Config Obstacle\n\n") if $fwd eq 'fwd';
              print "Requested action aborted:\n",
                    "$scriptname is not configured to process messages directly.\n\n";
          } else {
!             updatearchive('-add', '-quiet') if popretrieve();  # for invoking via cron
!         }                                                      # (or the command line)
      } else {
!         $size = sprintf '%.f', $size / 1024;
          unless ($size > $msgmaxsize) {
!             my $newmail = do {local $/; <STDIN>}; # grabs message, that was passed to this
              $newmail =~ s/^(.+)\r?\n(From )/$2/;  # script, for instant update of the archive
!             my $pw = ($1 or '');
              if (defined $msgpw and $pw ne $msgpw) {
!                 mhaexit("Status: 403 Password Check Failed\n\n") if $fwd eq 'fwd';
                  print "Requested action aborted:\nPassword check failed\n\n";
              } elsif ($newmail =~ /^From /) {
!                 updatembox(\$newmail);
!                 updatearchive('-add', '-quiet');
                  print "Status: 204 No Content\n\n" if $fwd eq 'fwd';
              } else {
***************
*** 312,316 ****
              }
          } else {
!             exit (print "Status: 413 Message Too Large\n\n") if $fwd eq 'fwd';
              print "Requested action aborted:\n",
                    "The message size ($size KiB) exceeds the maximum size\n",
--- 329,333 ----
              }
          } else {
!             mhaexit("Status: 413 Message Too Large\n\n") if $fwd eq 'fwd';
              print "Requested action aborted:\n",
                    "The message size ($size KiB) exceeds the maximum size\n",
***************
*** 322,340 ****
  sub refresh {
      popretrieve() if $pop3;
!     updatearchive ('-add', '-quiet');
!     print "Location: $indexURL\n\n";       # loads the updated main index page
  }
  
  sub readinput {
!     my $in = my $name = my $value = '';
!     if ($ENV{'REQUEST_METHOD'} eq 'POST')	{
!         read (STDIN, $in, $ENV{'CONTENT_LENGTH'});
      } else {
!         $in = $ENV{'QUERY_STRING'};
      }
!     $in =~ s/\+/ /g;
!     for (split (/[&;]/, $in)) {
!         ($name, $value) = split(/=/);
!         $value =~ s/%(..)/pack("c",hex($1))/ge if $value;
          $in{$name} = $value;
      }
--- 339,359 ----
  sub refresh {
      popretrieve() if $pop3;
!     updatearchive('-add', '-quiet');
!     print "Location: $indexURL\n\n";     # loads the updated main index page
  }
  
  sub readinput {
!     my $in = '';
!     if ($ENV{REQUEST_METHOD} eq 'POST') {
!         my $len = $ENV{CONTENT_LENGTH};
!         $len <= 131072 or die "Too much data submitted.\n";
!         read(STDIN, $in, $len) == $len or die "Reading of posted data failed.\n";
      } else {
!         $in = $ENV{QUERY_STRING};
      }
!     $in =~ tr/+/ /;
!     for (split /[&;]/, $in) {
!         my ($name, $value) = split /=/, $_, 2;
!         $value =~ s/%(..)/chr(hex $1)/eg if $value;
          $in{$name} = $value;
      }
***************
*** 345,353 ****
      $wrongpw = '';
      (my $cookiename = $name) =~ s/\W/_/g;
!     if ($ENV{'HTTP_COOKIE'}) {
!         for (split (/; /, $ENV{'HTTP_COOKIE'})) {
!             my ($key, $val) = split (/=/, $_);
              if ($key eq $cookiename) {
!                 $result = $val eq $adminpw ? 1 : 0;
                  last;
              }
--- 364,372 ----
      $wrongpw = '';
      (my $cookiename = $name) =~ s/\W/_/g;
!     if ($ENV{HTTP_COOKIE}) {
!         for (split /; /, $ENV{HTTP_COOKIE}) {
!             my ($key, $val) = split /=/;
              if ($key eq $cookiename) {
!                 $result = 1 if $val eq ($encrypt ? $adminpw : crypt $adminpw, 'pw');
                  last;
              }
***************
*** 355,362 ****
      }
      unless ($result) {
!         if ($in{'pw'}) {
!             my $pw = $encrypt ? crypt ($in{'pw'}, $adminpw) : $in{'pw'};
!             print "Set-cookie: $cookiename=$pw\n";
              if ($pw eq $adminpw) {
                  $result = 1;
              } else {
--- 374,381 ----
      }
      unless ($result) {
!         if ($in{pw}) {
!             my $pw = $encrypt ? crypt $in{pw}, $adminpw : $in{pw};
              if ($pw eq $adminpw) {
+                 print "Set-cookie: $cookiename=", ($encrypt ? $pw : crypt $pw, 'pw'), "\n";
                  $result = 1;
              } else {
***************
*** 364,376 ****
                            ."arial, helvetica, sans-serif\">Incorrect password!</h4>\n";
              }
!         } elsif ($in{'routine'} eq 'forms') {
!             exit (print "Content-type: text/html\n\n",
!                         "Your browser is set to refuse cookies.<br />Change that\n",
!                         'setting to accept at least session cookies, and try again.');
!         } elsif ($in{'routine'}) {
!             exit (print "Content-type: text/html\n\n&nbsp;");
          }
      }
!     return $result;
  }
  
--- 383,395 ----
                            ."arial, helvetica, sans-serif\">Incorrect password!</h4>\n";
              }
!         } elsif ($in{routine} eq 'forms') {
!             mhaexit(prtheader(),
!                     "Your browser is set to refuse cookies.<br />Change that\n",
!                     'setting to accept at least session cookies, and try again.');
!         } elsif ($in{routine}) {
!             mhaexit(prtheader(), '&nbsp;');
          }
      }
!     $result
  }
  
***************
*** 389,393 ****
  
  sub frames	{
!     return "Content-type: text/html\n\n", qq|<html>
  <head><title>$name - Admin</title></head>
  <frameset rows="190,*">
--- 408,412 ----
  
  sub frames	{
!     return prtheader(), qq|<html>
  <head><title>$name - Admin</title></head>
  <frameset rows="190,*">
***************
*** 400,404 ****
  
  sub htmlbegin {
!     return "Content-type: text/html\n\n", qq|<html>
  <head>
  <style type="text/css">
--- 419,423 ----
  
  sub htmlbegin {
!     return prtheader(), qq|<html>
  <head>
  <style type="text/css">
***************
*** 473,506 ****
  
  sub adminstart {
!     return "Content-type: text/html\n\n<pre>", '<b>Output will appear here</b>';
  }
  
  sub add {
!     print "Content-type: text/html\n\n<pre>", "<b>Add messages to $name</b>\n\n";
      popretrieve() if $pop3;
!     updatearchive ('-add');
  }
  
  sub remove {
!     print "Content-type: text/html\n\n<pre>", "<b>Remove messages from $name</b>\n\n";
!     updatearchive ('-rmm', $in{'msgnumber'});
  }
  
  sub remove_mbox {
!     my @msgs = read_mbox ($mbox);
      my $deleted = $mbox . '_deleted';
      my $latestmsg = pop @msgs;
  
!     open (FILE, ">>$deleted") or die "Couldn't open $deleted\n$!";
!     flock (FILE, 2);
      print FILE @$latestmsg;
!     close (FILE);
  
!     open (FILE, ">$mbox") or die "Couldn't open $mbox\n$!";
!     flock (FILE, 2);
!     for (@msgs) { print FILE @$_ }
!     close (FILE);
  
!     print "Content-type: text/html\n\n<pre>", "<b>Remove raw messages from $name</b>\n\n",
            "The latest message was removed from $mbox\nand appended to $deleted.\n\n",
            'The mailbox file now includes ', scalar @msgs, ' message',
--- 492,525 ----
  
  sub adminstart {
!     return prtheader(), '<pre>', '<b>Output will appear here</b>';
  }
  
  sub add {
!     print prtheader(), '<pre>', "<b>Add messages to $name</b>\n\n";
      popretrieve() if $pop3;
!     updatearchive('-add');
  }
  
  sub remove {
!     print prtheader(), '<pre>', "<b>Remove messages from $name</b>\n\n";
!     updatearchive('-rmm', $in{msgnumber});
  }
  
  sub remove_mbox {
!     my @msgs = read_mbox($mbox);
      my $deleted = $mbox . '_deleted';
      my $latestmsg = pop @msgs;
  
!     open FILE, ">> $deleted" or die "Couldn't open $deleted\n$!";
!     flock FILE, 2;
      print FILE @$latestmsg;
!     close FILE;
  
!     open FILE, "> $mbox" or die "Couldn't open $mbox\n$!";
!     flock FILE, 2;
!     print FILE @$_ for @msgs;
!     close FILE;
  
!     print prtheader(), '<pre>', "<b>Remove raw messages from $name</b>\n\n",
            "The latest message was removed from $mbox\nand appended to $deleted.\n\n",
            'The mailbox file now includes ', scalar @msgs, ' message',
***************
*** 511,516 ****
      my $checkpop;
      require 'shellwords.pl';
!     @ARGV = shellwords ($in{'command'});  # the list of entered options is assigned
!     my $command = shift @ARGV;            # to @ARGV, and with that passed to MHonArc
      for my $element (@ARGV)	{
          if    ($element eq '$archive') { $element = $archive }
--- 530,535 ----
      my $checkpop;
      require 'shellwords.pl';
!     @ARGV = shellwords($in{command});    # the list of entered options is assigned
!     my $command = shift @ARGV;           # to @ARGV, and with that passed to MHonArc
      for my $element (@ARGV)	{
          if    ($element eq '$archive') { $element = $archive }
***************
*** 519,523 ****
          elsif ($element eq '-add')     { $checkpop = 1 }
      }
!     print "Content-type: text/html\n\n<pre>";
      if ($command eq 'mhonarc' or $command =~ /^mha-d/) {
          print "<b>Command executed:</b>\n$command @ARGV\n\n<b>Output:</b>\n";
--- 538,542 ----
          elsif ($element eq '-add')     { $checkpop = 1 }
      }
!     print prtheader(), '<pre>';
      if ($command eq 'mhonarc' or $command =~ /^mha-d/) {
          print "<b>Command executed:</b>\n$command @ARGV\n\n<b>Output:</b>\n";
***************
*** 533,545 ****
  sub updatembox {
      my $msgref = shift;
!     open (FILE, ">>$mbox") or die "Couldn't open $mbox\n$!";
!     flock (FILE, 2);
!     print FILE ($pop3 ? join ('', @$msgref) : $$msgref) . "\n\n";
!     close (FILE);
  }
  
  sub updatearchive {
      @ARGV = (@_, '-outdir', $archive);
!     push (@ARGV, $mbox) unless $in{'routine'} eq 'remove';
      require 'mhamain.pl' or die "Couldn't require mhamain.pl\n$!";
      mhonarc::initialize();         # skipped the 'mhonarc' program file in
--- 552,564 ----
  sub updatembox {
      my $msgref = shift;
!     open FILE, ">> $mbox" or die "Couldn't open $mbox\n$!";
!     flock FILE, 2;
!     print FILE ($pop3 ? join '', @$msgref : $$msgref), "\n\n";
!     close FILE;
  }
  
  sub updatearchive {
      @ARGV = (@_, '-outdir', $archive);
!     push @ARGV, $mbox unless $in{routine} eq 'remove';
      require 'mhamain.pl' or die "Couldn't require mhamain.pl\n$!";
      mhonarc::initialize();         # skipped the 'mhonarc' program file in
***************
*** 553,557 ****
  
      POP: {
!         $cnt = $pop->login ($user, $password);
          my $msgs = $pop->list();
          last POP unless $cnt > 0;
--- 572,576 ----
  
      POP: {
!         $cnt = $pop->login($user, $password);
          my $msgs = $pop->list();
          last POP unless $cnt > 0;
***************
*** 561,565 ****
          ## Loop thru each message and append to $newmail
          foreach $msgnum (sort { $a <=> $b } keys %$msgs) {
!             $msg = $pop->get ($msgnum);
              next unless defined $msg;
  
--- 580,584 ----
          ## Loop thru each message and append to $newmail
          foreach $msgnum (sort { $a <=> $b } keys %$msgs) {
!             $msg = $pop->get($msgnum);
              next unless defined $msg;
  
***************
*** 576,597 ****
                  if ($tmp =~ s/^([^:]+):\s*//) {
                      $key = lc $1;
!                     if (defined ($header{$key})) { $aref = $header{$key} }
!                     else                         { $aref = $header{$key} = [ ] }
!                     push (@$aref, $tmp);
                      next;
                  }
              }
  
!             unshift (@$msg, 'From username(_at_)domain(_dot_)com Sat Jan  1 00:00:00 2000');
!             updatembox ($msg);
!             $pop->delete ($msgnum);
          }
          $pop->quit();
          undef $pop;
!         print "$cnt message".($cnt > 1 ? 's' : '')." from $user\(_at_)$pophost\n"
!              ."appended to $mbox\n\n" if $in{'routine'} eq ('add' or 'shell');
      }
      $pop->quit() if defined $pop;
!     return $cnt;
  }
  
--- 595,616 ----
                  if ($tmp =~ s/^([^:]+):\s*//) {
                      $key = lc $1;
!                     if (defined $header{$key}) { $aref = $header{$key} }
!                     else                       { $aref = $header{$key} = [ ] }
!                     push @$aref, $tmp;
                      next;
                  }
              }
  
!             unshift @$msg, 'From username(_at_)domain(_dot_)com Sat Jan  1 00:00:00 2000';
!             updatembox($msg);
!             $pop->delete($msgnum);
          }
          $pop->quit();
          undef $pop;
!         print "$cnt message".($cnt > 1 ? 's' : '')." from $user\(_at_)$pophost\n",
!               "appended to $mbox\n\n" if $in{routine} eq ('add' or 'shell');
      }
      $pop->quit() if defined $pop;
!     $cnt
  }
  
***************
*** 606,623 ****
      local *FH;
      local $_;
!     open(FH,"< $file") or die "Couldn't open '$file'\n$!";
!     while(<FH>) {
!         if($blank && /\AFrom .*\d{4}/) {
!             push(@mail, $mail) if scalar(@{$mail});
              $mail = [ $_ ];
              $blank = 0;
          } else {
              $blank = m#\A\Z#o ? 1 : 0;
!             push(@{$mail}, $_);
          }
      }
!     push(@mail, $mail) if scalar(@{$mail});
!     close(FH);
!     return @mail;
  }
  
--- 625,642 ----
      local *FH;
      local $_;
!     open FH, "< $file" or die "Couldn't open '$file'\n$!";
!     while (<FH>) {
!         if ($blank and /\AFrom .*\d{4}/) {
!             push @mail, $mail if @$mail;
              $mail = [ $_ ];
              $blank = 0;
          } else {
              $blank = m#\A\Z#o ? 1 : 0;
!             push @$mail, $_;
          }
      }
!     push @mail, $mail if @$mail;
!     close FH;
!     @mail
  }
  

---------------------------------------------------------------------
To sign-off this list, send email to majordomo(_at_)mhonarc(_dot_)org with the
message text UNSUBSCRIBE MHONARC-COMMITS