#!/usr/bin/perl -T
$VERSION = '0.05';
$REVISION = "rev$1\[\@$2\]"
if ('$Revision: #1 $ $Change: 3790 $' =~ /(\d+)[^\d]+(\d+)/);
our ($SIZE_LIMIT, $DUMP, $LOG, $MAIL_LOG, $BOARD_LOG, $NO_ATTACH);
our (%DOMAINS, $DEFAULT_DOMAIN);
our ($Postfix, $Element, $Container, $RCFile);
our ($MsgAttach, $MsgTooLarge, $MsgDownload);
$Postfix ||= '.board';
$Element ||= 'boards';
$Container ||= 'articles';
$RCFile ||= 'bbs.rc';
$MsgAttach ||= "\n¡° [«H¥ó§¨ÀÉ: %s]\n";
$MsgTooLarge ||= "¡° (ªþ¥[ÀÉ®× %s ¶W¹L¤W: %s ¦ì¤¸²Õ¡C)\n";
$MsgDownload ||= "¡° (ªþ¥[ÀÉ®×¥i©ó %s ¤U¸ü¡C)\n";
foreach my $path ('/etc', '/usr/local/etc', '/usr/local/bin', '.') {
do "$path/$RCFile" and last if -e "$path/$RCFile";
}
die 'bbs.rc not found!' unless %DOMAINS;
$DOMAINS{"bbs.$_"} = $DOMAINS{$_} for keys(%DOMAINS);
if ($DUMP) { open _, ">$DUMP"; local $/; print _ <STDIN>; close _; exit 0; }
my $mail = Mail::Internet->new(*STDIN);
my $timeseq = scalar time;
my ($to, $cc, $received, $date, $bcc, $from,
$subject, $replyto, $sender, $xorig) = ( map {
substr($mail->head->get($_), 0, -1)
} qw/To Cc Received Date Bcc From Subject Reply-To X-Sender X-Originator/,
);
for ($subject, $from, $to, $sender, $replyto) {
if (/=\?\w/) {
$_ .= '?=' unless index($_, '?=') > -1;
$_ = decode_mimewords($_);
}
}
my $DOMAIN;
foreach my $dom (keys(%DOMAINS)) {
if (index(uc($to), uc("\@".$dom)) > -1) {
$DOMAIN = $dom; last;
}
elsif (index(uc($cc), uc("\@".$dom)) > -1) {
$to = $cc;
$DOMAIN = $dom; last;
}
elsif (index(uc($bcc), uc("\@".$dom)) > -1) {
$to = $bcc;
$DOMAIN = $dom; last;
}
elsif (index(uc($received), uc("$Postfix\@".$dom)) > -1) {
$to = $received;
$to =~ s/.* for //s; $to =~ s/;.*//s;
$DOMAIN = $dom; last;
}
elsif (index($received, "-owner\@".$dom) > -1) {
$to = $received;
$to =~ s/.* for //s; $to =~ s/;.*//s;
$DOMAIN = $dom; last;
}
elsif (index($received, "contact\@".$dom) > -1) {
$to = 'General.board'; $DOMAIN = $dom; last;
}
else {
$DOMAIN = $DEFAULT_DOMAIN;
}
}
die "Cannot find domain in: $received\n $to $cc $bcc!\n"
unless defined($DOMAIN);
my ($BASEURL, $WWWHOME, $OWNER, $GROUP, $PERMIT) =
@{$DOMAINS{$DOMAIN}}{qw/BASEURL WWWHOME OWNER GROUP PERMIT/};
if ($OWNER) {
my ($uid, $gid) = (getpwnam($OWNER))[2,3] or die "no uid of $OWNER";
$gid = (getgrnam($GROUP))[2] or die "no gid of $GROUP" if $GROUP;
($>, $)) = ($uid, $gid) or die "seteuid/setegid failed: $OWNER, $GROUP";
}
my $BBS = OurNet::BBS->new(map { untaint($_) } @{$DOMAINS{$DOMAIN}{PARAM}});
my $OBJ = $BBS->{untaint($Element)};
my ($user, $nick, $email);
($nick, $user) = ($1, $2) if (($user = $from) =~ /"?([^"]+)"? <([^>]+)>/);
$email = $user;
$user =~ s/(?:.bbs)?\@.+$//i;
$nick ||= $user;
$to = $1 if $to =~ m/<([^>]+)>/;
my $parser = MIME::Parser->new;
$parser->output_to_core(1);
my $entity = $parser->parse_data([ @{$mail->header}, "\n", @{$mail->body} ]);
my ($parsed, $attach) = (0, 0);
my $body = '';
if ($LOG ||= ($0 =~ /bbsmail/i ? $MAIL_LOG : $BOARD_LOG)) {
open _, ">>$LOG";
print _ (scalar localtime)." : $to : $from : $subject\n";
close _;
}
die "cannot parse target: $to" unless $to =~ m|^([\w\-]+)(\Q$Postfix\E)?(?:\@.+)?$|i;
my $target = $1;
unless (exists $OBJ->{$target}) {
foreach (keys %{$OBJ}) {
$target = untaint($_) and last
if (uc($target) eq uc($_) and exists $OBJ->{$_});
}
}
exit 0 if index($xorig, "$target$Postfix\@") > -1;
die "no such target: $target" unless exists $OBJ->{$target};
my $obj = $OBJ->{$target};
die "no permission settings in $target" if (
$PERMIT and ($Container ne 'mailbox') and (
!exists($obj->{permit}) or
$obj->{permit} =~ /^\s*$/
)
);
die "no permission to post: $target from $email" unless (
not exists($obj->{permit}) or
$obj->{permit} =~ /^\s*$/ or (
grep { $email =~ /^$_$/i }
grep { length }
map { s/\\\*/.*/g; s/\\\?/./g; $_ }
map { quotemeta }
map { s/^\s+//; s/\s+$//; $_ }
split(/(?:\015?\012)+/, $obj->{permit})
)
);
foreach my $chunk ($entity->parts_DFS) {
next if $chunk->head->recommended_filename eq 'winmail.dat';
if ($chunk->head->recommended_filename) {
$body .= sprintf($MsgAttach, $chunk->head->recommended_filename);
}
if ($chunk->effective_type eq 'text/plain' or
$chunk->effective_type eq 'message/rfc822') {
$body .= eval { $chunk->bodyhandle->as_string };
$parsed++;
}
elsif ($chunk->effective_type eq 'application/pgp-signature') {
}
elsif ($chunk->effective_type eq 'text/html'
and (!$parsed
or $chunk->head->recommended_filename)
and eval "use HTML::Parse; use HTML::FormatText; 1"
) {
$body .= HTML::FormatText->new(
leftmargin => 0, rightmargin => 70
)->format(HTML::Parse::parse_html(
$chunk->bodyhandle->as_string
));
}
elsif ($chunk->bodyhandle and $WWWHOME and $BASEURL) {
my $file = $chunk->head->recommended_filename
|| ('file'.(++$attach).'.dat');
exit if defined $NO_ATTACH and $file =~ /$NO_ATTACH/i;
if ($file =~ /^=\?\w/) {
$file .= '?=' unless index($file, '?=') > -1;
$file = decode_mimewords($_);
}
$file =~ tr/\\\/\:\*\?\"\<\>\|//;
my $content;
if ($file !~ /^\.+$/ and $content = $chunk->bodyhandle->as_string) {
if (length($content) > $SIZE_LIMIT) {
$body .= sprintf($MsgTooLarge, $file, $SIZE_LIMIT);
next;
}
next unless mkdir "$WWWHOME/$timeseq"
and open _, ">$WWWHOME/$timeseq/$file";
print _ $content;
close _;
$body .= sprintf($MsgDownload, "$BASEURL/$timeseq/$file");
}
}
}
$subject =~ s/^\[$target\]\s?//i;
$obj->{$Container}{''} = {
title => substr($subject, 0, 60),
body => $body,
header => {
(map { $_ => substr($mail->head->get($_), 0, -1) } $mail->head->tags),
From => "$email ($nick)",
Subject => $subject,
Board => $target,
Date => scalar localtime,
},
};
sub untaint {
$_[0] =~ m/(.*)/s; return $1;
}
1;