-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathmdmovemail
131 lines (102 loc) · 3.96 KB
/
mdmovemail
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
From: Jonathan Kamens <[email protected]>
Subject: Re: "movemail.pl" which works with maildirs
Date: Mon, 20 Dec 1999 14:23:28 -0500
Here's yet another update to my maildir movemail.pl script.
#!/usr/bin/perl
# mdmovemail.pl - a replacement for the Emacs "movemail" program which
# understands how to read mail from a qmail-style maildir.
#
# Install it somewhere, make it executable, and then set
# rmail-movemail-program to point to it. If you don't want the script
# to automatically strip out duplicate messages (defined as messages
# with the same message ID and the same body checksum), set the
# $strip_duplicates variable below to undef (it's enabled by default).
#
# Then create an empty file inside your maildir. The name is
# irrelevant, although you might want to start it with a period to
# make it hidden when the directory is listed. Personally, I
# recommend ".rmail-is-too-smart" (because that's why this flag file
# is needed).
#
# You'll then need to modify rmail-primary-inbox-list to point at that
# file. For example:
#
# (setq rmail-primary-inbox-list
# (list (expand-file-name "~/Maildir/.rmail-is-too-smart")))
#
# Written by Jonathan Kamens <[email protected]>. Please
# send comments, corrections, etc. to me.
$strip_duplicates = 1;
($whoami = $0) =~ s,.*/,,;
$usage = "Usage: $whoami [-p] maildir destfile\n";
if ($ARGV[0] eq '-p') {
shift;
$preserve++;
}
die $usage if (! ($maildir = shift));
die $usage if (! ($destfile = shift));
# Perhaps you are wondering why this is necessary. It's necessary
# because if rmail-primary-inbox-list contains a path name which is
# actually a directory, i.e., it contains your maildir, Rmail mode
# isn't content to just leave it alone -- it'll append a slash and
# your username to the end of it. Then, it'll discover that the
# resulting path doesn't exist, so it will decide there's no new mail
# to retrieve. This hack avoids the problem by using an empty flag
# file in the maildir, as described in the comment at the top of this
# file.
if (-f $maildir) {
($parent = $maildir) =~ s,/[^/]+$,,;
$maildir = $parent if (-d "$parent/new");
}
die "$whoami: $maildir does not exist\n$usage" if (! -e $maildir);
die "$whoami: $maildir is not a directory\n$usage" if (! -d $maildir);
die "$whoami: $destfile already exists\n$usage" if (-e $destfile);
$msg_dir = "$maildir/new";
$message_start = "\f\n0, unseen,,\n";
$message_end = "\037";
die "$whoami: opening $msg_dir: $!\n" if (! opendir(DIR, $msg_dir));
exit 0 if (! (@dirfiles = sort readdir(DIR)));
closedir(DIR);
foreach $file (@dirfiles) {
next if ($file eq '.');
next if ($file eq '..');
next if (! -f "$msg_dir/$file");
&output_file($file);
}
die "$whoami: closing $destfile: $!\n" if ($dest_created && !close(OUTPUT));
unlink(@output_files) if (! $preserve);
sub output_file {
my($basename) = @_;
my($inpath) = "$msg_dir/$basename";
local($/) = undef;
my($contents);
if (! $dest_created++) {
open(OUTPUT, ">$destfile") || die "$whoami: opening $destfile: $!\n";
}
open(INPUT, $inpath) || die "$whoami: opening $inpath: $!\n";
die "$whoami: reading $inpath: $!\n" if (! defined($contents = <INPUT>));
close(INPUT);
$contents =~ s/([^\n])$/$1\n/;
if ($strip_duplicates && &is_duplicate($contents)) {
push(@output_files, $inpath);
return;
}
print(OUTPUT $message_start, $contents, $message_end) ||
die "$whoami: writing to $destfile: $!\n";
push(@output_files, $inpath);
}
sub is_duplicate {
my($contents) = @_;
my($head, $body, $checksum, $id);
($head, $body) = split(/\n\n/, $contents, 2);
$head =~ s/\n+$//;
$body =~ s/^\n+//;
$body =~ s/\n+$//;
$checksum = unpack("%16C*", $body);
return undef if ($head !~ /(^|\n)\bmessage-id:\s*(\S+)\s*(\n|$)/i);
$id = $2;
return 1 if (defined($checksums{$id}) && $checksums{$id} == $checksum);
$checksums{$id} = $checksum;
return undef;
}