#!/usr/local/bin/perl5 # # $Id: info-dylan-news2mail.pl,v 1.6 1999/12/17 16:33:10 gregs Exp gregs $ # # Check comp.lang.dylan newsgroup for new posts, and forward # them to the info-dylan mailing list. # # Called from my (gregs) crontab on soggy-fibers.ai.mit.edu # every 15 minutes. # # Greg SullivanJuly, 1999. ## print "not doing news2mail right now.\n"; ## exit 1; ## gregs -- what's this?: use blib; ## use Getopt::Long; use Net::NNTP; $NewsServer = 'news.lcs.mit.edu'; ## $NewsServer = 'news.mit.edu'; ## $GroupName = 'mit.test'; $GroupName = 'comp.lang.dylan'; $MailToName = 'info-dylan-from-news@ai.mit.edu'; $BaseDir = '/home/ai/gregs/info-dylan/tools/data'; $LastArticleNumberSent = undef; $opt_debug = undef; $TimeString = localtime(time); ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $logFileName = sprintf("%s/%s/news2mail-19%2d%02d%02d.log", $BaseDir, $GroupName, $year, $mon + 1, $mday); sub check_for_skippable_header; sub munge_header_news2mail; open(LOG, ">>$logFileName"); ## *LOG = *STDOUT; $nntp = Net::NNTP->new($NewsServer, Debug => $opt_debug ? 1 : 0); if (not $nntp) { print LOG "Could not connect to $NewsServer\n"; die "Could not connect to $NewsServer"; } print LOG "Opened connection to $NewsServer at $TimeString\n"; # find the last article sent out open(LAST, "<$BaseDir/$GroupName/lastsent"); $LastArticleNumberSent = *LAST ? : 0; print LOG "Last article number mailed from group $GroupName = $LastArticleNumberSent\n"; close LAST; # look at the group on the server, and get article number range ($NumArticles, $FirstNum, $LastNum, $RealGroupName) = $nntp->group($GroupName); print LOG "From server, num = $num_articles, first = $FirstNum, last = $LastNum, name = $RealGroupName.\n"; $GetArtNum = ($FirstNum > $LastArticleNumberSent) ? $FirstNum : $LastArticleNumberSent + 1; while ($GetArtNum <= $LastNum) { $ArtID = $nntp->nntpstat($GetArtNum); $BodyRef = $nntp->body(); @Body = @$BodyRef; $BodyLen = @Body; if ($BodyLen > 0) { # skip empty articles $HeadRef = $nntp->head(); @HeadArr = @$HeadRef; print LOG "\n\nGot article number $GetArtNum, with header: \n"; print LOG @HeadArr; print LOG "[eoh]\n"; print LOG "\nwith body:\n"; print LOG @Body; print LOG "[eob]\n"; if (check_for_skippable_header(\@HeadArr)) { $GetArtNum = $GetArtNum + 1; next; } $NewHeaderRef = munge_header_news2mail($HeadRef); @NewHeader = @$NewHeaderRef; print LOG "\nNew header:\n"; print LOG @NewHeader; print LOG "[eonh]\n"; open (MAIL, "|rmail $MailToName"); ## open (MAIL, ">>news2mail.mail"); print MAIL @NewHeader; print MAIL "\n"; print MAIL @Body; close MAIL; print LOG "sent to $MailToName\n"; } $GetArtNum = $GetArtNum + 1; } ## update LASTSENT counter open(LAST, ">$BaseDir/$GroupName/lastsent"); print LAST $LastNum; close LAST; print LOG "Updated lastsent to $LastNum.\n"; print LOG "Done ($TimeString).\n"; $nntp->quit; close LOG; exit 0; # Check for loops in mail<->news: # Fail if X-mailer is ".*mail2news" and Organization is "mail2news@nym.alias.net". # *** this will fail if: # 1. someone sends to info-dylan, which is mail2news'ed to comp.lang.dylan, then # 2. someone else follows up with a post to comp.lang.dylan, AND uses # nym.alias.net/anon.lcs.mit.edu to do it (!!!!!) AND their news software # keeps the X-* headers intact. sub check_for_skippable_header { my $headerRef = shift(@_); my @header = @$headerRef; $organization = undef; $sentFromMail2News = 0; foreach $line (@header) { if ($line =~ /^Organization:/) { ($organization = $line) =~ s/^Organization:\s*//; } if ($line =~ /^x-mailer:.*info-dylan-mail2news/i) {$sentFromMail2News = 1;} ## if ($line =~ /mail gatewayed to news/i) {$sentFromMail2News = 1;} ## if ($line =~ /news2mail/i) {$sentFromMail2News = 1;} } if (($organization and $organization =~ /mail2news\@nym/ and $sentFromMail2News) or (!$organization and $sentFromMail2News)) { print LOG "Found Organization = $organization or X-mailer.*mail2news, so skipping article!\n"; return 1; } else { return 0; } } # sub check_for_skippable_header sub munge_header_news2mail { $OldHeaderRef = shift(@_); @OldHeader = @$OldHeaderRef; @NewHeader = (); push @NewHeader, "To: info-dylan\@ai.mit.edu\n"; foreach $line (@OldHeader) { ## strip some headers: if ($line =~ /^Posted:/) { next; } if ($line =~ /^Control:/) { next; } if ($line =~ /^Distribution:/) { next; } if ($line =~ /^NNTP-Posting-Host:/) { next; } if ($line =~ /^Nntp-Posting-Host:/) { next; } if ($line =~ /^Path:/) { next; } if ($line =~ /^X-mailer:/) { next; } if ($line =~ /^X-news2mail:/) { next; } ## X-ise some headers: $line =~ s/^Date:/X-Date:/; $line =~ s/^Received:/X-Received:/; $line =~ s/^To:/X-To:/; $line =~ s/^Cc:/X-Cc:/; $line =~ s/^Newsgroups:/X-Newsgroups:/; $line =~ s/^In-Reply-To:/X-In-Reply-To:/; $line =~ s/^Message-Id:/X-Message-Id:/; push @NewHeader, $line; } # foreach $line in header push @NewHeader, "X-news2mail: $TimeString\n"; return(\@NewHeader); } # sub munge_header