summaryrefslogtreecommitdiff
path: root/src/pop
blob: 826a9751ed9e402b5097756cb980a5d7fccbdc6e (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
133
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;