1 files changed, 132 insertions, 0 deletions
diff --git a/src/m-pop b/src/m-pop
new file mode 100755
index 0000000..1a0e0ff
--- /dev/null
+++ b/src/m-pop
@@ -0,0 +1,132 @@
+#!/usr/bin/perl
+
+# m-pop -- retrieve (new) messages via POP3
+
+use strict;
+use warnings;
+
+use Getopt::Std;
+use Net::POP3;
+use POSIX;
+use Sys::Hostname;
+
+our $VERSION = '0.01';
+
+# Process arguments
+my %opt;
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+getopts('m:i:j:', \%opt);
+HELP_MESSAGE() unless $opt{m} and $opt{i};
+sub HELP_MESSAGE {
+	print STDERR <<USAGE;
+usage: $0 -m mbox -i mbox.i [-j mbox.i.out]
+USAGE
+	exit 1;
+}
+
+# Open TTY for reading and writing
+open my $tty, '+<:unix', '/dev/tty' or die "Could not open /dev/tty: $!";
+
+# Get UIDs of existing messages
+my ($mbox, $index, @existing_uids);
+if (-e $opt{i}) {
+	open $index, '<', $opt{i} or die "Could not open $opt{i}: $!";
+	local $/ = ''; # paragraph mode
+	while (<$index>) {
+		push @existing_uids, $1 if /^M-UID: (.*)$/m;
+	}
+	close $index;
+}
+
+# Open mbox and index files for appending
+open $mbox, '>>', $opt{m} or die "Could not open $opt{m}: $!";
+$opt{j} = $opt{i} if not $opt{j};
+open $index, '>>', $opt{j} or die "Could not open $opt{j}: $!";
+
+# Get POP3 server, username and password
+my $server = 'pop3.mailbox.org';
+my $ssl = 1;
+my $timeout = 5;
+
+die "USERNAME variable not set\n" if not $ENV{USERNAME};
+die "PASSWORD variable not set\n" if not $ENV{PASSWORD};
+
+# Connect to POP3 server
+my $pop = Net::POP3->new($server, SSL => $ssl, Timeout => $timeout)
+	or die "Could not connect to POP3 server $server: $!\n";
+$pop->login($ENV{USERNAME}, $ENV{PASSWORD}) or die "Could not log into server\n";
+
+# Retrieve ids and uids of all messages
+my @ids = sort { $a <=> $b } keys %{$pop->list};
+my %uids = %{$pop->uidl};
+
+# Handle SIGINT
+my $sigint = 0;
+$SIG{INT} = sub {
+	print $tty "\nSafely ending retrieval...\n";
+	$sigint = 1;
+};
+
+# 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 $tty "\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";
+
+	# Calculate message length
+	my ($head_length, $body_length, $message_length);
+	$head_length += length($_)+1 for (@msg[0..$j-1]);
+	$body_length += length($_)+1 for (@msg[$j..$#msg]);
+	$message_length = length($from_) + 1 + $head_length + $body_length;
+
+	# 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_
+M-Offset: $offset
+M-Length: $message_length
+M-Status: 00
+M-UID: $uids{$id}
+@msg[0..$j-1]
+
+INDEX
+
+	exit 130 if $sigint;
+
+	# Set offset for next message
+	$offset += $message_length + 1;
+}
+print $tty "\n";
+
+close $index;
+close $mbox;
+$pop->quit;