#!/usr/local/bin/perl5 # # $Id: info-dylan-mail2news.pl,v 1.13 1999/12/17 16:33:29 gregs Exp gregs $ # # source in ~gregs/info-dylan/tools, copied to /com/mailer, # called from /com/mailer/aliases at the "info-dylan-outgoing" target. # # Greg SullivanJuly, 1999. # NOTE: as of Oct. 1999, news.lcs.mit.edu seems to update itself much # more frequently than news.mit.edu sub leave; sub munge_header_mail2news; ## open (LOG, "|/usr/lib/sendmail gregs\@ai.mit.edu"); ## *LOG = *STDOUT; open (LOG, ">> /dev/null"); print LOG "Subject: info-dylan-mail2news output\n\n"; $TimeString = localtime(time); print LOG "\ninfo-dylan-mail2news.pl, $TimeString\n"; @Headers = (); @Body = (); $inheaders = 1; while ($line = ) { if ($inheaders == 1 and $line =~ /^\s*$/) { # a blank line signifies end of headers $inheaders = 0; } elsif ($inheaders == 1) { # line not blank and still in headers push (@Headers, $line); } else { # not in headers push (@Body, $line); } if ($line =~ /X-mailer:.*mail2news/) { print LOG "(noticed X-mailer.*mail2news header: $line)\n"; } if ($line =~ /X-news2mail:/) { print LOG "(noticed X-news2mail header: $line)\n"; } } $NewHeaderRef = munge_header_mail2news(\@Headers); @NewHeader = @$NewHeaderRef; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $MailToAddress = "mail2news\@anon.lcs.mit.edu"; ## $MailToAddress = "gregs\@ai.mit.edu"; ## $MailToAddress = sprintf("mail2news-19%02d%02d%02d-mit.test\@anon.lcs.mit.edu", ## $year, $mon + 1, $mday); ## $MailToAddress = sprintf("mail2news-19%02d%02d%02d-comp.lang.dylan\@anon.lcs.mit.edu", ## $year, $mon + 1, $mday); print LOG "sending mail to $MailToAddress\n"; print LOG "info-dylan-mail2news.pl done, $TimeString\n" if LOG; close LOG if LOG; open (SENDMAIL, "|/usr/lib/sendmail -oi -fowner-info-dylan\@ai.mit.edu $MailToAddress"); ## *SENDMAIL = *STDOUT; print SENDMAIL @NewHeader; print SENDMAIL "\n"; print SENDMAIL @Body; &leave; sub leave { close SENDMAIL if SENDMAIL; exit 0; } sub munge_header_mail2news { $OldHeaderRef = shift(@_); @OldHeader = @$OldHeaderRef; print LOG "Incoming header:\n"; print LOG @OldHeader; print LOG "[eoh]\n"; @NewHeader = (); ## push @NewHeader, "Newsgroups: mit.test\n"; push @NewHeader, "Newsgroups: comp.lang.dylan\n"; my $linenum = 0; foreach $line (@OldHeader) { $linenum++; ## not sure if this is a good idea... if ($linenum == 1 and $line =~ /^From/) { next; } ## strip some headers: if ($line =~ /^Posted:/) { next; } if ($line =~ /^Newsgroups:/) { next; } if ($line =~ /^nntp-posting-host:/i) { next; } if ($line =~ /^Lines:/) { next; } if ($line =~ /^Length:/) { next; } if ($line =~ /^Via:/) { next; } if ($line =~ /^Path:/) { next; } if ($line =~ /^Distribution:/) { next; } # overwritten below if ($line =~ /^x-mailer:/i) { next; } # overwritten below ## X-ise some headers: $line =~ s/^Date:/X-Date:/; $line =~ s/^Received:/X-Received:/; $line =~ s/^Message-Id:/X-Message-Id:/; $line =~ s/^To:/X-To:/; $line =~ s/^Sender:/X-Sender:/; $line =~ s/^Cc:/X-Cc:/; ### $line =~ s/^In-Reply-To:/X-In-Reply-To:/; push @NewHeader, $line; } # foreach $line in header ## push @NewHeader, "Cc: gregs\@ai.mit.edu\n"; push @NewHeader, "Distribution: world\n"; push @NewHeader, "X-mailer: info-dylan-mail2news.pl, $TimeString\n"; print LOG "New header = \n"; print LOG @NewHeader; print LOG "[eonh]\n"; return(\@NewHeader); } # sub munge_header