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 ");
}
}
! 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(), ' ');
}
}
! $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