Adding examples and documents

1 files changed, 177 insertions, 0 deletions

diff --git a/examples/drhyde-news2mail-and-mail2news/news2mail b/examples/drhyde-news2mail-and-mail2news/news2mail
new file mode 100644
index 0000000..e91bea6
--- /dev/null
+++ b/examples/drhyde-news2mail-and-mail2news/news2mail
@@ -0,0 +1,177 @@
+#!/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;