Add 'pop' script

1 files changed, 134 insertions, 0 deletions

diff --git a/src/pop b/src/pop
new file mode 100755
index 0000000..826a975
--- /dev/null
+++ b/src/pop
@@ -0,0 +1,134 @@
+#!/usr/bin/perl
+
+# pop -- retrieve (new) messages via POP3
+
+use strict;
+use warnings;
+
+use Net::POP3;
+use POSIX;
+use Term::ReadKey;
+use Sys::Hostname;
+
+# Handle SIGINT
+my $sigint = 0;
+$SIG{INT} = sub { $sigint = 1 };
+
+# Flush STDERR
+select STDERR; $|++; select STDOUT;
+
+# Process arguments
+if (@ARGV != 2) {
+	print STDERR "usage: $0 mbox mbox.i\n";
+	exit 1;
+}
+
+# Get UIDs of existing messages
+my ($mbox, $index, @existing_uids);
+if (-e $ARGV[1]) {
+	open $index, '<', $ARGV[1] or die "Could not open $ARGV[1]: $!";
+	{
+		local $/ = ''; # paragraph mode
+		while (<$index>) {
+			push @existing_uids, $1 if /^UID: (.*)$/m;
+		}
+	}
+	close $index;
+}
+
+# Open mbox and index files for appending
+open $mbox, '>>', $ARGV[0] or die "Could not open $ARGV[0]: $!";
+open $index, '>>', $ARGV[1] or die "Could not open $ARGV[1]: $!";
+
+# Get POP3 server, username and password
+print 'Enter password: ';
+ReadMode 'noecho';
+chomp(my $password = ReadLine(0));
+print "\n";
+ReadMode 0;
+
+# Connect to POP3 server
+my $pop = Net::POP3->new('pop3.mailbox.org', SSL => 1, Timeout => 5);
+$pop->login('john@ankarstrom.se', $password) or die "$!";
+
+# Retrieve ids and uids of all messages
+my @ids = sort { $a <=> $b } keys %{$pop->list};
+my %uids = %{$pop->uidl};
+
+# Append new messages to mbox and index files
+chomp(my $date = asctime(localtime(time)));
+my $offset = 0;
+my $i = 0;
+
+for my $id (@ids) {
+	next if grep { $_ eq $uids{$id} } @existing_uids;
+	print STDERR "\r$id/$ids[-1]";
+
+	my @msg;
+	{
+		local $/ = "\r\n";
+		chomp(@msg = @{$pop->get($id)});
+	}
+
+	# Make From_ line
+	my ($from, $from_alt);
+	my $j = 0; # index of empty line before message body
+	for (@msg) {
+		last if /^$/;
+		$j++;
+		$from = $1 if /^From: (.*)$/;
+		$from_alt = $1 if /^from: (.*)$/;
+	}
+	$from = $from_alt if $from_alt and not $from;
+	$from = $1 if $from and $from =~ /^.* <(.*?@.*?)>$/;
+	$from = 'MAILER-DAEMON@' . hostname if not $from;
+	my $from_ = "From $from $date";
+
+	# Add UID header
+	unshift @msg, "UID: $uids{$id}"; $j++;
+
+	# Add Content-Length header
+	my ($header_length, $body_length, $content_length);
+	$header_length += length($_)+1 for (@msg[0..$j-1]);
+	$body_length += length($_)+1 for (@msg[$j..$#msg]);
+	$content_length = length($from_) + 1 + $header_length + $body_length;
+
+	# - Add length of Content-Length header to Content-Length
+	my $new = $content_length;
+	my $prev = 0;
+	until ($new == $prev) {
+		$prev = $new;
+		$new = $content_length + length "Content-Length: $content_length\n";
+	}
+	$content_length = $new;
+
+	unshift @msg, "Content-Length: $content_length"; $j++;
+
+	# Append message to mbox and index files
+	local $" = "\n";
+	print $mbox <<MBOX;
+$from_
+@msg[0..$j-1]
+@msg[$j..$#msg]
+
+MBOX
+	print $index <<INDEX;
+$from_
+Offset: $offset
+@msg[0..$j-1]
+
+INDEX
+
+	if ($sigint) {
+		print STDERR "\n";
+		exit 130;
+	}
+
+	# Set offset for next message
+	$offset += $content_length + 1;
+}
+print STDERR "\n";
+
+close $index;
+close $mbox;
+$pop->quit;