1 7d6d378a 2022-08-24 op #!/usr/bin/env perl
3 1bcb9899 2022-08-29 op # mexp was written by Omar Polo <op@openbsd.org> and is placed in the
4 1bcb9899 2022-08-29 op # public domain. The author hereby disclaims copyright to this source
7 7d6d378a 2022-08-24 op use open ":std", ":encoding(UTF-8)";
13 1edd511a 2023-04-01 op use List::Util qw(max min);
15 054f3fd4 2022-08-25 op use OpenBSD::Pledge;
16 054f3fd4 2022-08-25 op use OpenBSD::Unveil;
19 bd3babdf 2023-04-02 op use GotMArc qw(parse san urlencode initpage endpage thread_header threntry);
21 7d6d378a 2022-08-24 op my $outdir = $ENV{'OUTDIR'};
22 7d6d378a 2022-08-24 op die 'Set $OUTDIR' unless defined $outdir;
24 054f3fd4 2022-08-25 op unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
25 054f3fd4 2022-08-25 op unveil($outdir, "rwc") or die "unveil $outdir: $!";
27 66e1cf97 2022-08-27 op unveil(".", "r") or die "unveil .: $!";
29 53bed501 2023-03-29 op pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
31 f3481d06 2022-09-13 op sub export_part {
32 f3481d06 2022-09-13 op my ($fh, $n, $fname) = @_;
34 f3481d06 2022-09-13 op my $pid = fork;
35 f3481d06 2022-09-13 op die "fork: $!" unless defined $pid;
36 f3481d06 2022-09-13 op if ($pid == 0) {
37 f3481d06 2022-09-13 op open \*STDOUT, '>&', $fh
38 f3481d06 2022-09-13 op or die "can't redirect stdout: $!";
39 f3481d06 2022-09-13 op exec 'mshow', '-F', '-O', $fname, $n
40 f3481d06 2022-09-13 op or die "can't exec mshow: $!";
43 f3481d06 2022-09-13 op waitpid $pid, 0;
44 f3481d06 2022-09-13 op die "mshow exited with $? ($n, $fname)" if $?;
47 6240f9b8 2022-09-13 op # like libutil' fmt_scaled
48 6240f9b8 2022-09-13 op sub humanize {
49 6240f9b8 2022-09-13 op my $number = shift;
50 6240f9b8 2022-09-13 op my @units = qw( G M K B);
51 6240f9b8 2022-09-13 op my @scale = (1024*1024*1024, 1024*1024, 1024, 1);
53 6240f9b8 2022-09-13 op for (my $i = 0; $i < @scale; $i++) {
54 6240f9b8 2022-09-13 op if ($scale[$i] < $number) {
55 6240f9b8 2022-09-13 op my $r = $number / $scale[$i];
56 6240f9b8 2022-09-13 op return sprintf "%.0f%s", $r, $units[$i];
62 1edd511a 2023-04-01 op my ($fh, $p, $n, $mid, $tid) = @_;
63 1edd511a 2023-04-01 op my @prev = @{$p};
64 1edd511a 2023-04-01 op my @next = @{$n};
66 1edd511a 2023-04-01 op return if !@prev && !@next;
67 1edd511a 2023-04-01 op print $fh "<nav>";
70 1edd511a 2023-04-01 op my $mail = $prev[-1];
71 1edd511a 2023-04-01 op my $encmid = $mail->{mid};
72 1edd511a 2023-04-01 op say $fh "<a href='/mail/$encmid.html'>Previous</a>";
74 1edd511a 2023-04-01 op say $fh "<span>Previous</span>";
77 1edd511a 2023-04-01 op if (defined($mid) && defined($tid)) {
78 1edd511a 2023-04-01 op my $encmid = urlencode $mid;
79 1edd511a 2023-04-01 op my $enctid = urlencode $tid;
80 1edd511a 2023-04-01 op say $fh "<a href='/text/$encmid.txt'>Raw body</a>";
81 1edd511a 2023-04-01 op say $fh "<a href='/thread/$enctid.html#$encmid'>Thread</a>";
85 1edd511a 2023-04-01 op my $mail = $next[0];
86 1edd511a 2023-04-01 op my $encmid = $mail->{mid};
87 1edd511a 2023-04-01 op say $fh "<a href='/mail/$encmid.html'>Next</a>";
89 1edd511a 2023-04-01 op say $fh "<span>Next</span>";
92 1edd511a 2023-04-01 op print $fh "</nav>";
95 85fd8f63 2023-04-01 op sub min_level {
97 85fd8f63 2023-04-01 op return 0 unless @_;
99 85fd8f63 2023-04-01 op $l = $_->{level} if $_->{level} < $l;
104 85fd8f63 2023-04-01 op sub thrslice {
105 85fd8f63 2023-04-01 op my ($fh, $mail, $p, $n) = @_;
106 85fd8f63 2023-04-01 op my @prev = @{$p};
107 85fd8f63 2023-04-01 op my @next = @{$n};
108 85fd8f63 2023-04-01 op my @thread = (@prev, $mail, @next);
109 85fd8f63 2023-04-01 op return unless @thread;
110 85fd8f63 2023-04-01 op my $base = min_level @thread;
111 85fd8f63 2023-04-01 op my $level = 0;
112 85fd8f63 2023-04-01 op print $fh "<div class='thread'>";
113 85fd8f63 2023-04-01 op print $fh "<ul class='mails'>";
114 bd3babdf 2023-04-02 op $level = threntry $fh, "mail", $base, $level, $_, $mail for @thread;
115 85fd8f63 2023-04-01 op print $fh "</ul></li>" x $level;
116 85fd8f63 2023-04-01 op print $fh "</ul></div>";
119 1edd511a 2023-04-01 op sub export_one {
120 1edd511a 2023-04-01 op my ($mail, $prev, $next) = @_;
121 bbdbef1a 2023-04-01 op my $dest = "$outdir/mail/$mail->{mid}.html";
123 7d6d378a 2022-08-24 op open(my $fh, '>', "$dest") or die "can't open $dest: $!";
125 bbdbef1a 2023-04-01 op initpage $fh, $mail->{subj};
127 bbdbef1a 2023-04-01 op open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
128 7d6d378a 2022-08-24 op or die "can't exec mshow: $!";
130 bbdbef1a 2023-04-01 op open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
131 bbdbef1a 2023-04-01 op or die "can't open $outdir/text/$mail->{mid}.txt: $!";
134 7d6d378a 2022-08-24 op while (<$mshow>) {
135 7d6d378a 2022-08-24 op last if /^$/;
137 7d6d378a 2022-08-24 op # drop the (1 day ago) string
138 6e04f5f4 2022-08-27 op s/ \(.*\)// if /^Date:/;
139 6797be46 2022-08-27 op print $text $_;
140 9d8482ab 2022-08-27 op push @hdrs, san($_);
142 6797be46 2022-08-27 op say $text "";
144 1edd511a 2023-04-01 op thread_header $fh, $mail->{tid}, $mail->{mid}, \@hdrs;
146 7d6d378a 2022-08-24 op print $fh "<pre>";
147 5b01d758 2022-08-25 op while (<$mshow>) {
148 5b01d758 2022-08-25 op print $text $_;
149 5b01d758 2022-08-25 op print $fh san($_);
151 7d6d378a 2022-08-24 op print $fh "</pre>";
153 f1ceade9 2022-08-24 op # generate the listing for the exported parts
154 bbdbef1a 2023-04-01 op open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
155 f3481d06 2022-09-13 op or die "can't exec mshow: $!";
157 53bed501 2023-03-29 op my $partno = 0;
158 f3481d06 2022-09-13 op while (<$parts>) {
159 f3481d06 2022-09-13 op my ($n, $mime, $size, $name) =
160 f3481d06 2022-09-13 op m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
162 f3481d06 2022-09-13 op next if $mime =~ m(application/application/pgp-signature);
163 f3481d06 2022-09-13 op next if $mime =~ m(audio/*);
164 f3481d06 2022-09-13 op next if $mime =~ m(video/*);
166 f3481d06 2022-09-13 op my $ext = "bin";
167 f3481d06 2022-09-13 op if ($mime =~ m(image/*)) {
168 f3481d06 2022-09-13 op if ($mime eq "image/gif") {
169 f3481d06 2022-09-13 op $ext = "gif";
170 f3481d06 2022-09-13 op } elsif ($mime eq "image/jpeg") {
171 f3481d06 2022-09-13 op $ext = "jpg";
172 f3481d06 2022-09-13 op } elsif ($mime eq "image/png") {
173 f3481d06 2022-09-13 op $ext = "png";
175 f3481d06 2022-09-13 op # skip other image types for now.
180 f3481d06 2022-09-13 op # text/* is bundled in the body by mshow(1).
182 53bed501 2023-03-29 op say $fh "<ul class='parts'>" if $partno == 0;
185 bbdbef1a 2023-04-01 op my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
186 53bed501 2023-03-29 op open my $p, '>', $path
187 bbdbef1a 2023-04-01 op or die "can't open $mail->{fname}: $!";
188 bbdbef1a 2023-04-01 op export_part($p, $n, $mail->{fname});
191 f3481d06 2022-09-13 op $path =~ s,^.*/parts/,/parts/,;
193 53bed501 2023-03-29 op my $url = san($path);
194 6240f9b8 2022-09-13 op my $hs = humanize $size;
195 6240f9b8 2022-09-13 op say $fh "<li><a href='$url'>$name ($hs)</a></li>";
197 53bed501 2023-03-29 op say $fh "</ul>" if $partno > 0;
199 1edd511a 2023-04-01 op thrnav $fh, $prev, $next, $mail->{mid}, $mail->{tid};
200 85fd8f63 2023-04-01 op thrslice $fh, $mail, $prev, $next;
204 84989e10 2022-08-24 op close($text);
205 7d6d378a 2022-08-24 op close($mshow);
206 f3481d06 2022-09-13 op close($parts);
209 66e1cf97 2022-08-27 op unlink $parts;
213 1edd511a 2023-04-01 op my @thread = @_;
215 1edd511a 2023-04-01 op for (my $i = 0; $i < @thread; $i++) {
216 1edd511a 2023-04-01 op my (@prev, @next);
217 85fd8f63 2023-04-01 op @prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
218 85fd8f63 2023-04-01 op @next = @thread[$i+1..min($i+2, @thread - 1)]
219 1edd511a 2023-04-01 op if $i + 1 < @thread;
220 1edd511a 2023-04-01 op export_one $thread[$i], \@prev, \@next;
227 1edd511a 2023-04-01 op my $mail = parse $_;
229 1edd511a 2023-04-01 op if ($mail->{level} == 0 && @thread) {
230 1edd511a 2023-04-01 op export @thread;
231 1edd511a 2023-04-01 op @thread = ();
234 1edd511a 2023-04-01 op $tid = $mail->{mid} if $mail->{level} == 0;
235 1edd511a 2023-04-01 op die "unknown tid" unless defined $tid;
236 1edd511a 2023-04-01 op $mail->{tid} = $tid;
238 1edd511a 2023-04-01 op # export_one $mail, $tid
239 1edd511a 2023-04-01 op push @thread, $mail;
242 1edd511a 2023-04-01 op export @thread if @thread;