Viewing file:  common.pl (13.02 KB) -rwxr-xr-x
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/perl
###########################################################################
# common.pl - Common stuff to include
###########################################################################
use CGI;
use CGI::Carp qw(fatalsToBrowser);
require "config.pl";
###########################################################################
# Feature hacks
###########################################################################
if ($feature_forward == 0){
$feature_folders = 1;
$feature_pop = 1;
}
###########################################################################
# The database
###########################################################################
mkdir $dbdir, 0700;
$passdb = $dbdir."pass";
$serverdb = $dbdir."server";
$popdb = $dbdir."pop";
$maildb = $dbdir."mail";
$sigdb = $dbdir."sig";
$reserveddb = $dbdir."reserved";
$hintdb = $dbdir."hints";
$sessiondb = $dbdir."session";
$headerdb = $dbdir."header";
$buttondb = $dbdir."buttons";
$defaultdb = $dbdir."default";
if($feature_abook == 1){
$addbookdir = $dbdir."addbooks";
}
if($feature_folders == 1){
$folderdir = $dbdir."folders";
}
###########################################################################
# All the form variables come from here - don't modify
###########################################################################
$query = new CGI;
$sid = $query->param('SESSIONID');
dbmopen(%sess, $sessiondb, 0600) || die "Error opening db $sessiondb";
$session = $sess{$sid};
dbmclose(%sess);
($cryptsess, $cryptpass, $cryptip) = split(/\0/, $session, 5);
$sessionid = unpack("u*", $cryptsess);
#$remip = unpack("u*", $cryptip);
$remip = '0.0.0.0';
$popserver = $query->param('POPSERVER');
$popusername = $query->param('POPUSERNAME');
$email = $query->param('EMAIL');
$button = $query->param('BUTTON');
$butns = $query->param('BUTNS');
$curpass = $query->param('CURPASS');
$password = $query->param('PASSWORD');
$pass2 = $query->param('PASS2');
$hint = $query->param('HINT');
$signature = $query->param('SIGNATURE');
$username = $query->param('USERNAME');
$username = lc $username;
$message = $query->param('MESSAGE');
$attachment = $query->param('ATTACHMENT');
@messages = $query->param('MESSAGES');
$mess = $query->param('MESS');
$poppass = $query->param('POPPASS');
$from = $query->param('FROM');
$resent = $query->param('RESENT');
$to = $query->param('TO');
$subject = $query->param('SUBJECT');
$cc = $query->param('CC');
$bcc = $query->param('BCC');
$entry = $query->param('ENTRY');
$folder = $query->param('FOLDER');
$newfolder = $query->param('NEWFOLDER');
$was = $query->param('WAS');
$default = $query->param('DEFAULT');
$fullheader = $query->param('FULLHEADER');
#$fromip = $query->remote_host();
$fromip = '0.0.0.0';
dbmopen(%butndb, $buttondb, 0600) || die "Error opening db $buttondb";
($uname, $junk) = split(/ /, $sessionid);
$btns = $butndb{$uname};
dbmclose(%butndb);
if (!$btns) { $btns = 'bottom'; }
$inbox = 'INBOX';
$faq_url = "http://www.atdot.org/faq.shtml";
return 1;
###########################################################################
# update_sess - updates the session id for idle timer
###########################################################################
sub update_sess {
dbmopen(%sess, $sessiondb, 0600) || die "Error opening db $sessiondb";
$current = $sess{$sid};
($cryptsess, $cryptpass, $remip) = split(/\0/, $current);
$sess = unpack("u*", $cryptsess);
($username, $time) = split(/ /, $sess);
$sess = $username . " " . time;
$cryptsess = pack("u*", $sess);
$sess{$sid} = $cryptsess . "\0" . $cryptpass . "\0" . $remip;
dbmclose(%sess);
###########################################################################
# Also clean out old entries - formerly in AtDot-cleand.pl daemon
###########################################################################
dbmopen(%sess, $sessiondb, 0600) || die "Error opening db $sessiondb";
$current_time = time;
@keys = keys %sess;
foreach $key (@keys) {
$line = $sess{$key};
($line, @junk) = split (/\0/, $line);
$line = unpack("u*", $line);
($name, $time) = split (/ /, $line);
$age = $current_time - $time;
if ($age > $expire_time) {
delete $sess{$key};
}
}
dbmclose(%sess);
}
###########################################################################
# print_options - prints the options
###########################################################################
sub print_options {
if ($sessionid eq "NONE") {
#do nothing
}
if ($sessionid =~ /\@/) {
print "<TABLE WIDTH=\"100%\">\n";
print "<TR><TD WIDTH=\"33%\" ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";
print $query->startform($method, $checkmail_pl, $CGI::URL_ENCODED);
if ($feature_forward == 1){
print $query->hidden('FOLDER', 'POP');
} else {
print $query->hidden('FOLDER', 'INBOX');
}
print $query->hidden('SESSIONID', $sid);
print $query->submit('BUTTON', $check_button);
print $query->endform;
print "</TD><TD WIDTH=\"33%\" ALIGN=\"CENTER\" VALIGN=\"TOP\">\n";
print $query->startform($method, $options_pl, $CGI::URL_ENCODED);
print $query->hidden('SESSIONID', $sid);
print $query->submit('BUTTON', $sendmsg_button);
print "</TD><TD WIDTH=\"33%\" ALIGN=\"RIGHT\" VALIGN=\"TOP\">\n";
print $query->submit('BUTTON', $logout_button);
print $query->endform;
print "</TD></TR></TABLE>";
} elsif ($sessionid ne "NONE") {
print "<TABLE WIDTH=\"100%\">";
print "<TR><TD WIDTH=\"25%\" ALIGN=\"LEFT\" VALIGN=\"TOP\">";
print $query->endform;
print $query->startform($method, $options_pl, $CGI::URL_ENCODED);
print $query->hidden('SESSIONID', $sid);
print $query->submit('BUTTON', $sendmsg_button);
print "</TD><TD WIDTH=\"25%\" ALIGN=\"CENTER\" VALIGN=\"TOP\">";
print $query->submit('BUTTON', $chacct_button);
print "</TD><TD WIDTH=\"25%\" ALIGN=\"CENTER\" VALIGN=\"TOP\">";
print $query->submit('BUTTON', $chpass_button);
print "</TD><TD WIDTH=\"25%\" ALIGN=\"RIGHT\" VALIGN=\"TOP\">";
print $query->submit('BUTTON', $logout_button);
print "</TD></TR><TR><TD WIDTH=\"25%\" ALIGN=\"LEFT\" VALIGN=\"TOP\">";
print $query->submit('BUTTON', $delacct_button);
print $query->endform;
print "</TD><TD WIDTH=\"25%\" ALIGN=\"CENTER\" VALIGN=\"TOP\">";
if ($feature_abook == 1){
print $query->startform($method, $addbook_pl, $CGI::URL_ENCODED);
print $query->hidden('SESSIONID', $sid);
print $query->submit('BUTTON', $abook_button);
print $query->endform;
}
print "</TD><TD WIDTH=\"25%\" ALIGN=\"CENTER\" VALIGN=\"TOP\">";
print $query->startform($method, $checkmail_pl, $CGI::URL_ENCODED);
if ($feature_forward == 1){
print $query->hidden('FOLDER', 'POP');
} else {
print $query->hidden('FOLDER', 'INBOX');
}
print $query->hidden('SESSIONID', $sid);
print $query->submit('BUTTON', $check_button);
print $query->endform;
print "</TD><TD WIDTH=\"25%\" ALIGN=\"RIGHT\" VALIGN=\"TOP\">";
if ($feature_folders == 1){
print $query->startform($method, $folder_pl, $CGI::URL_ENCODED);
print $query->hidden('SESSIONID', $sid);
print $query->submit('BUTTON', $folder_button);
print $query->endform;
}
print "</TD></TR>";
print "</TABLE>";
}
}
###########################################################################
# cancel - what to do when an action is cancelled
###########################################################################
sub cancel {
&print_header;
print $cancel_info;
if ($sid) {
&print_options;
} else {
print $thank_you_info;
}
&print_footer;
exit;
}
###########################################################################
# diffip - when the user makes a request from a different IP
###########################################################################
sub diffip {
&print_header;
$date = localtime();
($user, $junk) = split(/ /, $sessionid);
open LOGFILE, ">> $logfile";
print LOGFILE "At $date: ";
if($user){
print $hack_info;
print LOGFILE "User on $fromip tried to access the session of ";
print LOGFILE "the user $user on $remip.";
} else {
print $timed_out_info;
print LOGFILE "It appears that user on $fromip timed out.";
}
print LOGFILE "\n---\n";
close LOGFILE;
&print_footer;
exit;
}
###########################################################################
# send_form() - for sending mail, a common form
###########################################################################
sub send_form{
@username = split(/ /, $sessionid);
$username = $username[0];
if (!($username =~ /\@/)) {
dbmopen(%sig, $sigdb, 0600) || die "Error opening db $sigdb";
$signature = $sig{$username};
dbmclose(%sig);
dbmopen(%mail, $maildb, 0600) || die "Error opening db $maildb";
$email = $mail{$username};
dbmclose(%mail);
$usermail = $username . "\@" . $domain;
dbmopen(%def, $defaultdb, 0600) || die "Error opening db $defaultdb";
$def = $def{$username};
dbmclose(%def);
} else {
$signature = "";
$email = "";
($userid, $server) = split(/\@/, $username);
$usermail = $userid . "@" . $domain;
}
if ($to){
@to = split(/\,/, $to);
}
print $query->startform($method, $send_pl, &CGI::MULTIPART);
print $query->hidden('SESSIONID', $sid);
print "<TABLE BORDER=0><TR><TD>";
print $from_input;
print "</TD><TD>";
if ($feature_pop == 1) {
print $query->hidden('FROM', $usermail);
print $usermail;
} else {
print $query->popup_menu('FROM', [$email, $usermail], $def);
}
print "</TD></TR><TR><TD>";
print $to_input;
print "</TD><TD>";
if ($to[0]){
unless ($bad eq 'Yes') {
print $query->popup_menu('TO', \@to, $to[0]);
} else {
print $query->textfield('TO', $to, 65);
}
} else {
print $query->textfield('TO', '', 65);
}
print "</TD></TR><TR><TD>";
print $cc_input;
print "</TD><TD>";
if ($to[1]){
print $query->textfield('CC', $to, 65);
} else {
print $query->textfield('CC', '', 65);
}
print "</TD></TR><TR><TD>";
print $bcc_input;
print "</TD><TD>";
print $query->textfield('BCC', '', 65);
print "</TD></TR><TR><TD>";
print $attach_input;
print "</TD><TD>";
print $query->filefield('ATTACHMENT', '', 65);
print "</TD></TR><TR><TD>";
print $subj_input;
print "</TD><TD>";
print $query->textfield('SUBJECT', $subject, 65);
print "</TD></TR></TABLE>";
print $mess_input;
print $query->br;
if ($hide_mess eq 'yes'){
print $query->hidden('MESSAGE', $mess);
print $query->pre($mess);
} else {
if ($disp_mess){
$disp_mess =~ s/>\;/>/g;
$disp_mess =~ s/<\;/</g;
print $query->textarea('MESSAGE', $disp_mess, 20, 80);
} else {
print $query->textarea('MESSAGE', $signature, 20, 80);
}
}
print $query->br;
print $query->submit('BUTTON', $send_button);
print $query->submit('BUTTON', $cancel_button);
print $query->reset($reset_button);
print $query->endform;
}
###########################################################################
# greatest() - returns the largest number from an array
###########################################################################
sub greatest{
my @arr = @_;
$big = $arr[0];
for ($i = 1; $i < $#arr; $i++){
if ($arr[$i] > $big) { $big = $arr[$i]; }
}
return $big;
}
###########################################################################
# MIME code below used from the CPAN module MIME::Base64 for handling
# MIME attachments
# The following copyright notice appears in the file Base64.pm, from which
# this code is derived:
#
# Copyright 1995-1998 Gisle Aas.
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
###########################################################################
sub encode_base64 ($;$)
{
my $res = "";
my $eol = $_[1];
$eol = "\n" unless defined $eol;
pos($_[0]) = 0; # ensure start at the beginning
while ($_[0] =~ /(.{1,45})/gs) {
$res .= substr(pack('u', $1), 1);
chop($res);
}
$res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
# fix padding at the end
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
# break encoded string into lines of no more than 76 characters each
if (length $eol) {
$res =~ s/(.{1,76})/$1$eol/g;
}
$res;
}
sub decode_base64 ($)
{
local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
my $str = shift;
my $res = "";
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
$str =~ s/=+$//; # remove padding
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
while ($str =~ /(.{1,60})/gs) {
my $len = chr(32 + length($1)*3/4); # compute length byte
$res .= unpack("u", $len . $1 ); # uudecode
}
$res;
}
sub decode_qp ($)
{
my $res = shift;
$res =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted)
$res =~ s/=\r?\n//g; # rule #5 (soft line breaks)
$res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
$res;
}
|