diff options
Diffstat (limited to 'examples/drhyde-news2mail-and-mail2news/news2mail')
| -rw-r--r-- | examples/drhyde-news2mail-and-mail2news/news2mail | 177 |
1 files changed, 0 insertions, 177 deletions
diff --git a/examples/drhyde-news2mail-and-mail2news/news2mail b/examples/drhyde-news2mail-and-mail2news/news2mail deleted file mode 100644 index e91bea6..0000000 --- a/examples/drhyde-news2mail-and-mail2news/news2mail +++ /dev/null @@ -1,177 +0,0 @@ -#!/usr/local/bin/perl - -use strict; -use warnings; - -use Net::NNTP::Client; -use GDBM_File; -use Email::Send; -use Data::Dumper; - -use constant DEBUG => 0; - -select(STDERR); $| = 1; select(STDOUT); - -my $confdir = "$ENV{HOME}/.news2mail"; -unless(-d $confdir && -f $confdir.'/config.pl') { - mkdir $confdir || die("Couldn't create $confdir\n"); - open(FILE, ">$confdir/config.pl") || die("Couldn't create $confdir/config.pl\n"); - print FILE join("\n", - "smtphost => 'localhost',", - "address => 'myaddress\@example.com',", - "'user:pass\@news.example.com:119' => {", - " 'misc.test' => { post => 1 },", - " 'alt.config' => { post => 1 },", - "},", - "'privateserver.localdomain' => {", - " 'my.secret.newsgroup' => { post => 1 },", - "}" - ); - close(FILE); - - print "You need to configure me! Take a look in $confdir\n"; - exit; -} - -tie my %seen, 'GDBM_File', "$confdir/seen.dbm", GDBM_WRCREAT, 0640; - -my $subscriptions = { do $confdir.'/config.pl' }; - -my $smtphost = $subscriptions->{smtphost}; -my $address = $subscriptions->{address}; -delete $subscriptions->{smtphost}; -delete $subscriptions->{address}; - -SERVERS: foreach my $server (keys %{$subscriptions}) { - unless(-d "$confdir/$server") { - mkdir("$confdir/$server") || die("Can't create $confdir/$server\n"); - } - my($auth, $host) = split('@', $server); - ($auth, $host) = (':', $auth) if(!$host); - my($user, $pass) = split(':', $auth); - ($host, my $port) = split(':', $host); - $port ||= 119; - print "Connecting to $host:$port with credentials [$user,$pass]\n" if(DEBUG); - my $client = Net::NNTP::Client->new( - "$host:$port", - server => $host, - port => $port, - (($user) ? (user => $user, pass => $pass) : ()), - debug => 0, # set to 1 by default - hate! - ); - # refresh groups list if this is a new server or the list is more - # than 7 days old - if(!-f "$confdir/groups.$server" || -M "$confdir/groups.$server" > 7) { - my $list = eval { $client->list() }; - if($@) { - print STDERR "$@\n"; - next SERVERS; - } - open(FILE, ">$confdir/groups.$server") || die("Can't write $confdir/groups.$server\n"); - print FILE "$_\n" foreach(sort keys %{$list}); - close(FILE); - print "Updated groups list, see $confdir/groups.$server\n"; - } - - GROUPS: foreach my $group (keys %{$subscriptions->{$server}}) { - my($articles, $firstarticle) = eval { $client->group($group); }; - if($@) { - print STDERR "$@\n"; - next SERVERS; - } - if(!-e "$confdir/$server/$group.lastretrieved") { - # new subscription, so set lastretrieved to current - open(FOO, ">$confdir/$server/$group.lastretrieved") || - die("Can't write $confdir/$server/$group.lastretrieved\n"); - print FOO $firstarticle + $articles - 1; - close(FOO); - print "New subscription: $server/$group\n first: $firstarticle\n articles: $articles\n" if(DEBUG); - next GROUPS; - } - open(FOO, "$confdir/$server/$group.lastretrieved") || - die("Can't read $confdir/$server/$group.lastretrieved\n"); - chomp(my $lastretrieved = <FOO>); - $client->nntpstat($lastretrieved); - close(FOO); - FETCHNEWS: while(my $msgid = $client->next()) { - if(exists($seen{$msgid})) { # already got this article - print "$group: $msgid already seen\n" if(DEBUG); - $seen{$msgid} = time(); # update timestamp - $lastretrieved++; - open(FOO, ">$confdir/$server/$group.lastretrieved") || - die("Can't write $confdir/$server/$group.lastretrieved\n"); - print FOO $lastretrieved; - close(FOO); - next FETCHNEWS; - } - my $article = [map { chomp; $_; } @{$client->head($msgid)}]; - # filter based on headers here - push @{$article}, '', map { chomp; $_; } @{$client->body($msgid)}; - - print "$group: fetched $msgid\n" if(DEBUG); - - my @newsheaders; - my @headers = ( - "To: $address", - "Reply-To: ". - ($subscriptions->{$server}->{$group}->{post} || 'dave.null'), - "X-Newsgroup: $group" - ); - while((my $line = shift(@{$article})) ne '') { - if($line =~ /^\s+/) { $newsheaders[-1] .= $line; } - else { push @newsheaders, $line; } - } - foreach my $line (@newsheaders) { - if($line =~ /^(Message-Id|Date|Subject|From)/i) { - # headers common to mail and news - push @headers, $line; - } elsif($line =~ /^Path: (.*)$/i) { - push @headers, "Received: from $host with NNTP path $1"; - } elsif($line =~ /^References: (.*)$/i) { - my @refs = split(/\s+/, $1); - push @headers, $line, "In-Reply-To: $refs[-1]"; - } else { - push @headers, "X-NNTP-Header-$line"; - } - } - - my $body = $article; - - my $sender = Email::Send->new({mail => 'SMTP'}); - $sender->mailer_args([Host => $smtphost]); - $sender->send( - join("\n\n", - join("\n", sort { $a cmp $b } @headers), - join("\n", @{$body}) - ) - ); - - $seen{$msgid} = time(); # so we never fetch this one again - $lastretrieved++; - open(FOO, ">$confdir/$server/$group.lastretrieved") || - die("Can't write $confdir/$server/$group.lastretrieved\n"); - print FOO $lastretrieved; - close(FOO); - } - } -} - -# while(my($msgid, $time) = each(%seen)) { -# if(time() - $time > 2 * 86400) { -# delete $seen{$msgid}; -# } -# } - -# now optimise seendb -# delete anything from 'seen' more than a year old. This is partially for -# dropping cross-posts, (we use lastretrieved to avoid going back in time) -# but also for when a server shits its pants -my %newseen; -$newseen{$_} = $seen{$_} foreach( - grep { time() - $seen{$_} < 365 * 86400 } keys %seen -); -untie %seen; -unlink "$confdir/seen.dbm"; -tie %seen, 'GDBM_File', "$confdir/seen.dbm", GDBM_WRCREAT, 0640; -$seen{$_} = $newseen{$_} foreach(keys %newseen); -untie %seen; |