home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
em-reply.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
11KB
|
348 lines
# FILE: em-reply.pl
# DESCRIPTION: Reply by e-mail
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
# http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
use strict;
use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
###
### reply_pipe_input
###
### For piping data into e-mail reply script
###
sub reply_pipe_input {
error_message("Access Error", "This script cannot be accessed via the World Wide Web", 0, 1) if $ENV{'REQUEST_METHOD'} ne "";
error_message("Access Error", "This script cannot be accessed via the World Wide Web", 0, 1) if $ENV{'REMOTE_ADDR'} ne "";
my $buf = "\0" x 1024;
my $text = "";
if ($ARGV[0] eq "") {
binmode STDIN;
while (length($buf) == 1024) {
read(STDIN, $buf, 1024);
$text .= $buf;
}
}
$text eq "" ? email_reply_pop3_handler() : email_reply_text_handler($text);
program_exit(0);
}
###
### email_reply_pop3_handler
###
### Checks POP3 mailbox and then runs the handler
###
sub email_reply_pop3_handler {
pop3_retrieve(@_);
my $dir = join("/", $DCONF->{admin_dir}, "data", "pop3_in");
opendir(DIR, $dir);
my @dir = map {"$dir/$_"} grep {not /^\.\.?$/} readdir DIR;
closedir(DIR);
foreach my $file (@dir) {
next if ! -f $file;
my $tmp = $/; undef $/;
open (FILE, "< $file");
my $rf = <FILE>;
close (FILE);
$/ = $tmp;
unlink $file;
email_reply_text_handler($rf);
}
}
###
### email_reply_text_handler
###
### Handles incoming messages, posting them as appropriate
###
sub email_reply_text_handler {
my ($text) = @_;
my $DEBUG = 1;
my $textnew = $text;
$text =~ s/\r\n/\n/g; $text =~ s/\r/\n/g;
my ($header_text, $body) = split(/\n\n/, $text, 2);
my $headers = parse_mail_headers($header_text);
my $hash = parse_mail_body($body);
if ($DEBUG) {
my $char = $DCONF->{'debug_email_reply_append'} ? ">>" : ">";
open (DEBUGFILE, "$char $DCONF->{admin_dir}/data/debug-email-reply");
print DEBUGFILE "--------------------------------------------------------------\n";
print DEBUGFILE "Message received at ", scalar localtime(time), "\n";
print DEBUGFILE "--------------------------------------------------------------\n";
while ($textnew =~ /^(.{1,40})/s) {
$textnew = $';
my $x = $1;
$x =~ s/(.)/sprintf("%02x", ord($1))/ges;
print DEBUGFILE $x, "\n";
}
print DEBUGFILE "--------------------------------------------------------------\n";
print DEBUGFILE "Headers:\n\n";
print DEBUGFILE $header_text, "\n";
print DEBUGFILE "-" x 60, "\n";
print DEBUGFILE "Body:\n\n";
print DEBUGFILE $body, "\n";
print DEBUGFILE "-" x 60, "\n";
print DEBUGFILE "Header List:\n";
foreach my $k (keys(%{ $headers })) {
print DEBUGFILE "$k -> '$headers->{$k}'\n";
}
print DEBUGFILE "-" x 60, "\n";
print DEBUGFILE "Body List:\n";
foreach my $k (keys(%{ $hash })) {
if ($k eq "message") {
print DEBUGFILE "$k -> length ", length($hash->{$k}), "\n";
} else {
print DEBUGFILE "$k -> '$hash->{$k}'\n";
}
}
if (ref $hash->{'codes'} eq 'ARRAY') {
print DEBUGFILE "Administer from here codes:\n";
foreach my $z (@{ $hash->{'codes'} }) {
print "Code =: $z\n";
}
}
print DEBUGFILE "-" x 60, "\n";
print DEBUGFILE "Message Text:\n";
print DEBUGFILE "'$hash->{'message'}'\n";
close (DEBUGFILE);
}
return undef if $headers->{'x-mailer'} =~ /^Discus/;
my $frh = {};
$frh->{username} = $hash->{username};
$frh->{COOKIE}->{cpwd} = $hash->{password};
$frh->{COOKIE}->{rpwd} = "xxxxxxxx";
$frh->{password} = "adminlogin";
$frh->{topic} = $hash->{topic};
$frh->{page} = $hash->{page};
$frh->{passwd} = "xxxxxxxx";
if ($hash->{'topic'} eq "0") {
dreq("authpass");
my $result = check_password($frh->{username}, $frh->{password}, { type_required => 'moderator' }, $frh->{COOKIE});
if ($result->[0]->{'user'} eq $DCONF->{superuser}) {
dreq("mailer", "template");
my $par = email_configuration_read();
my $mm = {};
$mm->{general}->{test} = 1;
my $txt = templ_int("testmail", $mm);
send_email_message({ to => $par->{test_email_address}, subject => read_language()->{EMAIL_NOTIFICATION_TEST_SUBJECT} }, $txt, $par);
}
} else {
if ($DCONF->{pro}) {
dreq("em-admin-PRO");
}
my $flag = $DCONF->{pro} ? email_perform_commands($hash, $headers, $frh) : 1;
$flag *= $hash->{is_message};
if ($flag) {
dreq("posting");
my %qp_headers = map { lc($_), 1 } ('quoted-printable', '8bit');
if ($GLOBAL_OPTIONS->{always_quoted_printable} || defined $qp_headers{lc($headers->{'content-transfer-encoding'})}) {
$hash->{message} =~ s/=(\s)/$1/g;
$hash->{message} =~ s/=([A-F0-9][A-F0-9])/chr(hex($1))/gie;
}
$frh->{message} = $hash->{message}; ##remove_html($hash->{message});
if ($frh->{message} =~ /\\\w+\{/) {
$frh->{active_links} = 0;
} else {
$frh->{active_links} = 1;
$frh->{message} = remove_html($hash->{message});
}
$frh->{html} = 0;
$PARAMS->{no_exit} = sub {
my ($errormsg) = @_;
if ($headers->{from} =~ /([\w\+\-\.]+)\@([\w\+\-\.]+)/) {
my $subst = {};
my $addr = $&;
dreq("mailer", "template");
$errormsg =~ s%<h3>(.*?)</h3>%$1\n\n%gi;
$errormsg = remove_html($errormsg);
$subst->{general}->{failed} = $errormsg;
$subst->{general}->{topic} = $frh->{topic};
$subst->{general}->{page} = $frh->{page};
my $text = templ_int("erfailed", $subst);
send_email_message({ to => $addr, subject => uc(read_language()->{EMAIL_REPLY_FAILED}) }, $text);
}
program_exit(0);
};
my $pc = posting_control(undef, $frh);
$PARAMS->{no_exit} = undef;;
if ($pc eq "OK") {
return 1;
}
}
}
}
###
### parse_mail_body
###
### Determines parameters from the message
###
sub parse_mail_body {
my ($text_in) = @_;
my %out = {};
my $toparrow = quotemeta '--\/--\/--\/--\/--\/--\/--\/--\/--\/--\/--\/--';
my $botarrow = quotemeta '--/\--/\--/\--/\--/\--/\--/\--/\--/\--/\--/\--';
if ($text_in =~ /$toparrow(.*?)$botarrow/s) {
my ($beforemessage, $message, $aftermessage) = ($`, $1, $');
$out{'sane'} = 1;
$message =~ s/<br[^>]*>/\n/gi; ## So HTML formatted messages can work
$message = $1 if $message =~ /\n+(.*)\n+/s; ## For newline after top arrow and before bottom arrow
my @msgline = split(/\n/, $message);
$out{'is_message'} = 1;
$out{'is_message'} = 0 if $msgline[0] =~ /\[.*\]\s*$/ && scalar(@msgline) == 1;
my @portions = split(/\n\n/, $message);
foreach my $portion (@portions) {
$portion =~ s/\s+/ /g;
}
$out{'message'} = join("\n\n", @portions);
if ($DCONF->{pro}) {
dreq("em-admin-PRO");
$out{'codes'} = email_scan_for_commands($beforemessage, $aftermessage);
}
if ($aftermessage =~ m|/(\d+)/(\d+)/(\d+)/([^\s\/]+)/(\S+)\s*\n|) {
$out{'topic'} = $1;
$out{'page'} = $2;
$out{'post'} = $3;
$out{'username'} = $4;
$out{'password'} = $5;
$out{'password'} =~ s/<.*?>//g;
}
} elsif ($text_in =~ m|/0/0/0/([^\s\/]+)/(\S+)\s*\n|) {
$out{'topic'} = '0';
$out{'username'} = $1;
$out{'password'} = $2;
$out{'password'} =~ s/<.*?>//g;
} elsif ($DCONF->{pro}) {
dreq("em-admin-PRO");
$out{'codes'} = email_scan_for_commands($text_in);
if ($text_in =~ m|/(\d+)/(\d+)/(\d+)/([^\s\/]+)/(\S+)\s*\n|) {
$out{'topic'} = $1;
$out{'page'} = $2;
$out{'post'} = $3;
$out{'username'} = $4;
$out{'password'} = $5;
$out{'password'} =~ s/<.*?>//g;
}
$out{'is_message'} = 0;
}
return \%out;
}
###
### parse_mail_headers
###
### Reads mail headers and dumps them into an array
###
sub parse_mail_headers {
my ($text) = @_;
my @lines = split(/\n/, $text);
my %out = {};
foreach my $line (@lines) {
if ($line =~ /([^:]+):\s*(.*\S)\s*$/) {
my ($key, $val) = (case_lower($1), $2);
$out{$key} = $val;
}
}
return \%out;
}
###
### pop3_retrieve
###
### Retrieves appropriate messages from a POP3 mailbox, and deletes the
### messages it's retrieved.
###
sub pop3_retrieve {
my ($param) = @_;
my $pop3_user = defined $param->{user} ? $param->{user} : $GLOBAL_OPTIONS->{pop3_user};
my $pop3_pass = defined $param->{pass} ? $param->{pass} : $GLOBAL_OPTIONS->{pop3_pass};
my $pop3_host = defined $param->{host} ? $param->{host} : $GLOBAL_OPTIONS->{pop3_host};
my $scan = defined $param->{scan} ? $param->{scan} : $GLOBAL_OPTIONS->{pop3_scan};
my $addr = defined $param->{addr} ? $param->{addr} : $GLOBAL_OPTIONS->{pop3_addr};
my $as_text = defined $param->{as_text} ? $param->{as_text} : 0;
my $pop = eval '
use Net::POP3;
my $pop = Net::POP3->new($pop3_host, Timeout => 30);
$pop; ';
if (! defined $pop) {
if ($@ ne "") {
log_error("em-reply.pl", "pop3_retrieve", "Initialization of POP3 connect object failed on this error: $@");
} else {
log_error("em-reply.pl", "pop3_retrieve", "Could not connect to POP3 host '$pop3_host' (unknown reason; perhaps a timeout occurred)");
}
return 1;
}
my $msg_count = $pop->login($pop3_user, $pop3_pass);
if (! defined $msg_count) {
log_error("em-reply.pl", "pop3_retrieve", "Could not log in to POP3 host '$pop3_host' (username/password was probably incorrect)");
$pop->quit();
return 2;
}
$pop->quit() if $msg_count == 0;
return 0 if $msg_count eq "0E0";
return 2 if $msg_count == 0;
my @result = ();
if ($scan) {
my $qaddr = quotemeta($addr);
for (my $i = 1; $i <= $msg_count; $i++) {
my $j = $pop->top($i, 0);
next if ! grep(/^to:.*$qaddr/i, @{ $j });
push @result, $i;
}
} else {
@result = ( 1 .. $msg_count );
}
my $dir = join("/", $DCONF->{admin_dir}, "data", "pop3_in");
if (! $as_text) {
if (! -e $dir) {
mkdir($dir, oct($DCONF->{perms0777})) || error_message("Directory Creation Error", "Could not create incoming POP3 directory");
chmod(oct($DCONF->{perms0777}), $dir);
}
}
my @out = ();
my $uidl = {};
$uidl = $pop->uidl() if ! $as_text;
foreach my $msg_get (@result) {
if (! $as_text) {
$uidl->{$msg_get} =~ s%\W%%g;
my $filename = join("/", $dir, $uidl->{$msg_get});
my $tries = 0;
while (-e $filename) {
$filename .= int(rand(10));
$tries++;
error_message("File Creation Error", "Could not create a unique file name for incoming POP3 message $uidl->{$msg_get}", 0, 1) if $tries > 10;
}
my $u = $pop->get($msg_get);
next if ref $u ne 'ARRAY';
open (FH, "> $filename");
print FH @{$u};
close (FH);
$pop->delete($msg_get);
push @out, @{$u};
} else {
my $u = $pop->get($msg_get);
push @out, @{$u} if ref $u eq 'ARRAY';
$pop->delete($msg_get);
}
}
$pop->quit();
return \@out;
}
1;