1#!/usr/bin/perl -T 2# $File: //depot/libOurNet/BBS/script/bbsboard $ $Author: autrijus $ 3# $Revision: #1 $ $Change: 3790 $ $DateTime: 2003/01/24 19:08:46 $ 4 5$VERSION = '0.05'; 6$REVISION = "rev$1\[\@$2\]" 7 if ('$Revision: #1 $ $Change: 3790 $' =~ /(\d+)[^\d]+(\d+)/); 8 9use strict; 10 11use MIME::Words ':all'; 12use MIME::Parser; 13use Mail::Internet; 14use OurNet::BBS '1.6'; 15 16=head1 NAME 17 18bbsboard - Internet to BBS email-post handler 19 20=head1 SYNOPSIS 21 22In F</usr/local/etc/bbs.rc> or F</etc/bbs.rc>; 23 24 # $DUMP = '/tmp/msgdump.tmp'; # Dump message to disk; halt 25 $MAIL_LOG = '/var/log/bbsmail.log'; # Log of bbsmail 26 $BOARD_LOG = '/var/log/bsboard.log'; # Log of bbsboard 27 $SIZE_LIMIT = 204800; # Size limit of attachments 28 $NO_ATTACH = '\.(?i-xsm:exe|scr|pif|bat)$';# Block matched attachments 29 30 # Set virutal hosts; The C<bbs.> prefix of keys should be omitted. 31 %DOMAINS = ( 32 'elixus.org' => { 33 BASEURL => 'http://elixus.org', 34 WWWHOME => '/srv/www/elixir', 35 PARAM => ['MELIX', '/home/melix'], 36 OWNER => 'melix', 37 GROUP => 'melix', 38 }, 39 'cvic.org' => { 40 BASEURL => 'http://cvic.org', 41 WWWHOME => '/srv/www/cvic', 42 PARAM => ['CVIC', '/srv/bbs/cvic', 43 1003, 2500, 1005, 250, 1004, 50000], # needs utmp 44 OWNER => 'cvic', 45 GROUP => 'bbs', 46 PERMIT => 1, # 'permit' file required to post 47 }, 48 'm543.com' => { 49 BASEURL => 'http://m543.com', 50 WWWHOME => '/srv/www/m543', 51 PARAM => ['CVIC', '/srv/bbs/m543', 52 1103, 2500, 1105, 250, 1104, 50000], # needs utmp 53 OWNER => 'cvic', 54 GROUP => 'bbs', 55 }, 56 ); 57 58 # multiple domains, same IP 59 $DOMAINS{'m543.org'} = $DOMAINS{'music543.org'} = 60 $DOMAINS{'music543.com'} = $DOMAINS{'m543.com'}; 61 62 # fallback using the 'true' hostname 63 $DOMAINS{'geb.elixus.org'} = $DOMAINS{'elixus.org'}; 64 65 # default domain for in-site mails 66 $DEFAULT_DOMAIN = 'elixus.org' 67 68To configure it with sendmail, modify F<sendmail.cf> like this: 69 70 ###################################### 71 ### Ruleset 0 -- Parse Address ### 72 ###################################### 73 74 R$+.bbs < @ $=w .> $#bbsmail $: $1 bbs mail gateway 75 R$+.board < @ $=w .> $#bbsboard $: $1 bbs board gateway 76 77 # handle locally delivered names 78 79 R$+.bbs $#bbsmail $:$1 bbs mail gateway 80 R$+.board $#bbsboard $:$1 bbs board gateway 81 82 ################################################## 83 ### Local and Program Mailer specification ### 84 ################################################## 85 86 Mbbsmail, P=/usr/local/bin/bbsmail, F=lsSDFMuhP, S=10, R=20, 87 A=bbsmail $u 88 Mbbsboard, P=/usr/local/bin/bbsboard, F=lsSDFMuhP, S=10, R=20, 89 A=bbsboard $u 90 91To feed it a MIME mail directly at the command line: 92 93 % bbsmail < message.txt 94 95=head1 DESCRIPTION 96 97This script relays e-mails sent to C<*.bbs@domain> as mails to 98BBS user mailboxes; it is designed to be a drop-in replacement for 99the MAPLE BBS utility of the same name. 100 101This program could be used serve multiple BBS sites, each distinguished 102by its domain name. MIME encodings, multipart messages, quoted words 103are all handled correctly. 104 105If supplied with a web directory, attachments could be saved for 106later download. You could restrict the max. allowed size of each 107attachments. 108 109If the optional C<HTML::Parse> and C<HTML::FromText> modules were 110installed, HTML-only mails and simple HTML attachments could be 111rendered as plain text. 112 113=head1 CAVEATS 114 115Currently this script does not check proper permissions; you could 116use the C<OurNet> backend to achieve restricted permission. See 117L<bbscomd> for how to run an OurNet node. 118 119However, authentication is currently not implemented; while sending 120password via e-mail is easy, the author finds it distasteful. A 121proper way to parse PGP-signed mail might be the only viable route, 122and any contributions on that front will be most welcomed. 123 124=cut 125 126our ($SIZE_LIMIT, $DUMP, $LOG, $MAIL_LOG, $BOARD_LOG, $NO_ATTACH); 127our (%DOMAINS, $DEFAULT_DOMAIN); 128our ($Postfix, $Element, $Container, $RCFile); 129our ($MsgAttach, $MsgTooLarge, $MsgDownload); 130 131$Postfix ||= '.board'; 132$Element ||= 'boards'; 133$Container ||= 'articles'; 134$RCFile ||= 'bbs.rc'; 135$MsgAttach ||= "\n�� [�H����: %s]\n"; 136$MsgTooLarge ||= "�� (���[�ɮ� %s �W�L�W��: %s �줸�աC)\n"; 137$MsgDownload ||= "�� (���[�ɮץi�� %s �U���C)\n"; 138 139foreach my $path ('/etc', '/usr/local/etc', '/usr/local/bin', '.') { 140 do "$path/$RCFile" and last if -e "$path/$RCFile"; 141} 142 143die 'bbs.rc not found!' unless %DOMAINS; 144 145$DOMAINS{"bbs.$_"} = $DOMAINS{$_} for keys(%DOMAINS); 146 147if ($DUMP) { open _, ">$DUMP"; local $/; print _ <STDIN>; close _; exit 0; } 148 149my $mail = Mail::Internet->new(*STDIN); 150my $timeseq = scalar time; 151 152# Extract headers 153my ($to, $cc, $received, $date, $bcc, $from, 154 $subject, $replyto, $sender, $xorig) = ( map { 155 substr($mail->head->get($_), 0, -1) 156 } qw/To Cc Received Date Bcc From Subject Reply-To X-Sender X-Originator/, 157); 158 159# Parse MIME Quoted Words 160for ($subject, $from, $to, $sender, $replyto) { 161 if (/=\?\w/) { 162 $_ .= '?=' unless index($_, '?=') > -1; 163 $_ = decode_mimewords($_); 164 } 165} 166 167my $DOMAIN; 168foreach my $dom (keys(%DOMAINS)) { 169 if (index(uc($to), uc("\@".$dom)) > -1) { 170 $DOMAIN = $dom; last; 171 } 172 elsif (index(uc($cc), uc("\@".$dom)) > -1) { 173 $to = $cc; 174 $DOMAIN = $dom; last; 175 } 176 elsif (index(uc($bcc), uc("\@".$dom)) > -1) { 177 $to = $bcc; 178 $DOMAIN = $dom; last; 179 } 180 elsif (index(uc($received), uc("$Postfix\@".$dom)) > -1) { 181 $to = $received; 182 $to =~ s/.* for //s; $to =~ s/;.*//s; 183 $DOMAIN = $dom; last; 184 } 185 elsif (index($received, "-owner\@".$dom) > -1) { # mailing list 186 $to = $received; 187 $to =~ s/.* for //s; $to =~ s/;.*//s; 188 $DOMAIN = $dom; last; 189 } 190 elsif (index($received, "contact\@".$dom) > -1) { # special case 191 $to = 'General.board'; $DOMAIN = $dom; last; 192 } 193 else { 194 $DOMAIN = $DEFAULT_DOMAIN; 195 } 196} 197 198die "Cannot find domain in: $received\n $to $cc $bcc!\n" 199 unless defined($DOMAIN); 200 201my ($BASEURL, $WWWHOME, $OWNER, $GROUP, $PERMIT) = 202 @{$DOMAINS{$DOMAIN}}{qw/BASEURL WWWHOME OWNER GROUP PERMIT/}; 203 204if ($OWNER) { 205 # change ownership / group to the designated id 206 my ($uid, $gid) = (getpwnam($OWNER))[2,3] or die "no uid of $OWNER"; 207 $gid = (getgrnam($GROUP))[2] or die "no gid of $GROUP" if $GROUP; 208 ($>, $)) = ($uid, $gid) or die "seteuid/setegid failed: $OWNER, $GROUP"; 209} 210 211my $BBS = OurNet::BBS->new(map { untaint($_) } @{$DOMAINS{$DOMAIN}{PARAM}}); 212my $OBJ = $BBS->{untaint($Element)}; 213 214# Parse sender's address 215my ($user, $nick, $email); 216($nick, $user) = ($1, $2) if (($user = $from) =~ /"?([^"]+)"? <([^>]+)>/); 217$email = $user; 218$user =~ s/(?:.bbs)?\@.+$//i; 219$nick ||= $user; 220 221# Strip to angled brackets 222$to = $1 if $to =~ m/<([^>]+)>/; 223 224my $parser = MIME::Parser->new; 225$parser->output_to_core(1); 226 227my $entity = $parser->parse_data([ @{$mail->header}, "\n", @{$mail->body} ]); 228my ($parsed, $attach) = (0, 0); 229my $body = ''; 230 231if ($LOG ||= ($0 =~ /bbsmail/i ? $MAIL_LOG : $BOARD_LOG)) { 232 open _, ">>$LOG"; 233 print _ (scalar localtime)." : $to : $from : $subject\n"; 234 close _; 235} 236 237# determine the target 238 239die "cannot parse target: $to" unless $to =~ m|^([\w\-]+)(\Q$Postfix\E)?(?:\@.+)?$|i; 240 241my $target = $1; 242 243unless (exists $OBJ->{$target}) { 244 # do case sensitivity check 245 foreach (keys %{$OBJ}) { 246 $target = untaint($_) and last 247 if (uc($target) eq uc($_) and exists $OBJ->{$_}); 248 } 249} 250 251# blocks duplication 252exit 0 if index($xorig, "$target$Postfix\@") > -1; 253 254# check for existence 255die "no such target: $target" unless exists $OBJ->{$target}; 256 257my $obj = $OBJ->{$target}; 258 259die "no permission settings in $target" if ( 260 $PERMIT and ($Container ne 'mailbox') and ( 261 !exists($obj->{permit}) or # no permission file 262 $obj->{permit} =~ /^\s*$/ # empty permission file 263 ) 264); 265 266# check {permit} if there's one 267die "no permission to post: $target from $email" unless ( 268 not exists($obj->{permit}) or # 1) no permission 269 $obj->{permit} =~ /^\s*$/ or ( # 2) it's empty 270 grep { $email =~ /^$_$/i } # 3) email matches 271 grep { length } # nonempty 272 map { s/\\\*/.*/g; s/\\\?/./g; $_ } # wildcard-expanded 273 map { quotemeta } # escaped 274 map { s/^\s+//; s/\s+$//; $_ } # trimmed 275 split(/(?:\015?\012)+/, $obj->{permit}) # entries 276 ) 277); 278 279# post permitted -- handle attachments 280foreach my $chunk ($entity->parts_DFS) { 281 # skip Outlook special case! 282 next if $chunk->head->recommended_filename eq 'winmail.dat'; 283 284 if ($chunk->head->recommended_filename) { 285 $body .= sprintf($MsgAttach, $chunk->head->recommended_filename); 286 } 287 288 if ($chunk->effective_type eq 'text/plain' or 289 $chunk->effective_type eq 'message/rfc822') { 290 $body .= eval { $chunk->bodyhandle->as_string }; 291 $parsed++; 292 } 293 elsif ($chunk->effective_type eq 'application/pgp-signature') { 294 # ignore signatures for now 295 } 296 elsif ($chunk->effective_type eq 'text/html' 297 and (!$parsed # HTML only! Gasp! 298 or $chunk->head->recommended_filename) 299 and eval "use HTML::Parse; use HTML::FormatText; 1" 300 ) { 301 # Display HTML attachments. 302 $body .= HTML::FormatText->new( 303 leftmargin => 0, rightmargin => 70 304 )->format(HTML::Parse::parse_html( 305 $chunk->bodyhandle->as_string 306 )); 307 } 308 elsif ($chunk->bodyhandle and $WWWHOME and $BASEURL) { 309 my $file = $chunk->head->recommended_filename 310 || ('file'.(++$attach).'.dat'); 311 exit if defined $NO_ATTACH and $file =~ /$NO_ATTACH/i; 312 313 if ($file =~ /^=\?\w/) { 314 $file .= '?=' unless index($file, '?=') > -1; 315 $file = decode_mimewords($_); 316 } 317 318 $file =~ tr/\\\/\:\*\?\"\<\>\|//; 319 320 my $content; 321 322 if ($file !~ /^\.+$/ and $content = $chunk->bodyhandle->as_string) { 323 if (length($content) > $SIZE_LIMIT) { 324 $body .= sprintf($MsgTooLarge, $file, $SIZE_LIMIT); 325 next; 326 } 327 328 next unless mkdir "$WWWHOME/$timeseq" 329 and open _, ">$WWWHOME/$timeseq/$file"; 330 print _ $content; 331 close _; 332 333 $body .= sprintf($MsgDownload, "$BASEURL/$timeseq/$file"); 334 } 335 } 336} 337 338$subject =~ s/^\[$target\]\s?//i; # strip mailing list header tag 339 340# do the real work 341$obj->{$Container}{''} = { 342 title => substr($subject, 0, 60), 343 body => $body, 344 header => { 345 (map { $_ => substr($mail->head->get($_), 0, -1) } $mail->head->tags), 346 From => "$email ($nick)", 347 Subject => $subject, 348 Board => $target, 349 Date => scalar localtime, 350 }, 351}; 352 353sub untaint { 354 $_[0] =~ m/(.*)/s; return $1; 355} 356 3571; 358 359__END__ 360 361=head1 SEE ALSO 362 363L<OurNet::BBS>, L<bbsmail>. 364 365=head1 AUTHORS 366 367Autrijus Tang E<lt>autrijus@autrijus.orgE<gt> 368 369=head1 COPYRIGHT 370 371Copyright 2001-2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>. 372 373This program is free software; you can redistribute it and/or 374modify it under the same terms as Perl itself. 375 376See L<http://www.perl.com/perl/misc/Artistic.html> 377 378=cut 379