summaryrefslogtreecommitdiff
path: root/src/m-pop
blob: 1a0e0ff1931c8fdf526d224600bc3888569cf329 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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;