Blame


1 7d6d378a 2022-08-24 op #!/usr/bin/env perl
2 1bcb9899 2022-08-29 op #
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
5 1bcb9899 2022-08-29 op # code.
6 7d6d378a 2022-08-24 op
7 7d6d378a 2022-08-24 op use open ":std", ":encoding(UTF-8)";
8 7d6d378a 2022-08-24 op use utf8;
9 7d6d378a 2022-08-24 op use strict;
10 7d6d378a 2022-08-24 op use warnings;
11 7d6d378a 2022-08-24 op use v5.32;
12 7d6d378a 2022-08-24 op
13 1edd511a 2023-04-01 op use List::Util qw(max min);
14 1edd511a 2023-04-01 op
15 38232a0a 2023-05-07 op use SMArc qw(parse san urlencode initpage endpage thread_header
16 a3c4c223 2023-04-04 op threntry thrslice thrnav);
17 04eab9af 2022-08-25 op
18 7d6d378a 2022-08-24 op my $outdir = $ENV{'OUTDIR'};
19 7d6d378a 2022-08-24 op die 'Set $OUTDIR' unless defined $outdir;
20 7d6d378a 2022-08-24 op
21 1d565e04 2023-05-06 op if (`uname` =~ "OpenBSD") {
22 1d565e04 2023-05-06 op use OpenBSD::Pledge;
23 1d565e04 2023-05-06 op use OpenBSD::Unveil;
24 d3d07147 2022-08-30 op
25 1d565e04 2023-05-06 op unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
26 1d565e04 2023-05-06 op unveil($outdir, "rwc") or die "unveil $outdir: $!";
27 66e1cf97 2022-08-27 op
28 1d565e04 2023-05-06 op pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
29 1d565e04 2023-05-06 op }
30 1d565e04 2023-05-06 op
31 f3481d06 2022-09-13 op sub export_part {
32 f3481d06 2022-09-13 op my ($fh, $n, $fname) = @_;
33 f3481d06 2022-09-13 op
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: $!";
41 f3481d06 2022-09-13 op }
42 f3481d06 2022-09-13 op
43 f3481d06 2022-09-13 op waitpid $pid, 0;
44 f3481d06 2022-09-13 op die "mshow exited with $? ($n, $fname)" if $?;
45 f3481d06 2022-09-13 op }
46 f3481d06 2022-09-13 op
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);
52 6240f9b8 2022-09-13 op
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];
57 6240f9b8 2022-09-13 op }
58 6240f9b8 2022-09-13 op }
59 6240f9b8 2022-09-13 op }
60 6240f9b8 2022-09-13 op
61 1edd511a 2023-04-01 op sub export_one {
62 1edd511a 2023-04-01 op my ($mail, $prev, $next) = @_;
63 bbdbef1a 2023-04-01 op my $dest = "$outdir/mail/$mail->{mid}.html";
64 c971fcee 2022-08-25 op
65 7d6d378a 2022-08-24 op open(my $fh, '>', "$dest") or die "can't open $dest: $!";
66 7d6d378a 2022-08-24 op
67 bbdbef1a 2023-04-01 op initpage $fh, $mail->{subj};
68 7d6d378a 2022-08-24 op
69 bbdbef1a 2023-04-01 op open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
70 7d6d378a 2022-08-24 op or die "can't exec mshow: $!";
71 7d6d378a 2022-08-24 op
72 bbdbef1a 2023-04-01 op open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
73 bbdbef1a 2023-04-01 op or die "can't open $outdir/text/$mail->{mid}.txt: $!";
74 84989e10 2022-08-24 op
75 9d8482ab 2022-08-27 op my @hdrs;
76 7d6d378a 2022-08-24 op while (<$mshow>) {
77 7d6d378a 2022-08-24 op last if /^$/;
78 7d6d378a 2022-08-24 op
79 7d6d378a 2022-08-24 op # drop the (1 day ago) string
80 6e04f5f4 2022-08-27 op s/ \(.*\)// if /^Date:/;
81 6797be46 2022-08-27 op print $text $_;
82 9d8482ab 2022-08-27 op push @hdrs, san($_);
83 7d6d378a 2022-08-24 op }
84 6797be46 2022-08-27 op say $text "";
85 7d6d378a 2022-08-24 op
86 487f3ddc 2023-04-04 op thread_header $fh, \@hdrs, $mail, $prev, $next;
87 9d8482ab 2022-08-27 op
88 7d6d378a 2022-08-24 op print $fh "<pre>";
89 5b01d758 2022-08-25 op while (<$mshow>) {
90 5b01d758 2022-08-25 op print $text $_;
91 5b01d758 2022-08-25 op print $fh san($_);
92 5b01d758 2022-08-25 op }
93 7d6d378a 2022-08-24 op print $fh "</pre>";
94 7d6d378a 2022-08-24 op
95 f1ceade9 2022-08-24 op # generate the listing for the exported parts
96 bbdbef1a 2023-04-01 op open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
97 f3481d06 2022-09-13 op or die "can't exec mshow: $!";
98 f3481d06 2022-09-13 op
99 53bed501 2023-03-29 op my $partno = 0;
100 f3481d06 2022-09-13 op while (<$parts>) {
101 f3481d06 2022-09-13 op my ($n, $mime, $size, $name) =
102 f3481d06 2022-09-13 op m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
103 f3481d06 2022-09-13 op
104 4ad9fe9b 2023-04-03 op next if $mime =~ m(application/pgp-signature);
105 f3481d06 2022-09-13 op next if $mime =~ m(audio/*);
106 f3481d06 2022-09-13 op next if $mime =~ m(video/*);
107 f3481d06 2022-09-13 op
108 f3481d06 2022-09-13 op my $ext = "bin";
109 f3481d06 2022-09-13 op if ($mime =~ m(image/*)) {
110 f3481d06 2022-09-13 op if ($mime eq "image/gif") {
111 f3481d06 2022-09-13 op $ext = "gif";
112 f3481d06 2022-09-13 op } elsif ($mime eq "image/jpeg") {
113 f3481d06 2022-09-13 op $ext = "jpg";
114 f3481d06 2022-09-13 op } elsif ($mime eq "image/png") {
115 f3481d06 2022-09-13 op $ext = "png";
116 f3481d06 2022-09-13 op } else {
117 f3481d06 2022-09-13 op # skip other image types for now.
118 f3481d06 2022-09-13 op next;
119 f3481d06 2022-09-13 op }
120 f3481d06 2022-09-13 op }
121 f3481d06 2022-09-13 op
122 f3481d06 2022-09-13 op # text/* is bundled in the body by mshow(1).
123 f3481d06 2022-09-13 op
124 53bed501 2023-03-29 op say $fh "<ul class='parts'>" if $partno == 0;
125 53bed501 2023-03-29 op $partno++;
126 f3481d06 2022-09-13 op
127 bbdbef1a 2023-04-01 op my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
128 53bed501 2023-03-29 op open my $p, '>', $path
129 bbdbef1a 2023-04-01 op or die "can't open $mail->{fname}: $!";
130 bbdbef1a 2023-04-01 op export_part($p, $n, $mail->{fname});
131 f3481d06 2022-09-13 op close($p);
132 f3481d06 2022-09-13 op
133 f3481d06 2022-09-13 op $path =~ s,^.*/parts/,/parts/,;
134 f3481d06 2022-09-13 op
135 53bed501 2023-03-29 op my $url = san($path);
136 6240f9b8 2022-09-13 op my $hs = humanize $size;
137 6240f9b8 2022-09-13 op say $fh "<li><a href='$url'>$name ($hs)</a></li>";
138 f1ceade9 2022-08-24 op }
139 53bed501 2023-03-29 op say $fh "</ul>" if $partno > 0;
140 f1ceade9 2022-08-24 op
141 afe95dd5 2023-04-04 op thrnav $fh, $prev, $next;
142 85fd8f63 2023-04-01 op thrslice $fh, $mail, $prev, $next;
143 f0fb0f08 2022-08-30 op
144 04eab9af 2022-08-25 op endpage $fh;
145 7d6d378a 2022-08-24 op
146 84989e10 2022-08-24 op close($text);
147 7d6d378a 2022-08-24 op close($mshow);
148 f3481d06 2022-09-13 op close($parts);
149 7d6d378a 2022-08-24 op close($fh);
150 f1ceade9 2022-08-24 op
151 66e1cf97 2022-08-27 op unlink $parts;
152 66e1cf97 2022-08-27 op }
153 1edd511a 2023-04-01 op
154 1edd511a 2023-04-01 op sub export {
155 1edd511a 2023-04-01 op my @thread = @_;
156 1edd511a 2023-04-01 op
157 1edd511a 2023-04-01 op for (my $i = 0; $i < @thread; $i++) {
158 1edd511a 2023-04-01 op my (@prev, @next);
159 85fd8f63 2023-04-01 op @prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
160 85fd8f63 2023-04-01 op @next = @thread[$i+1..min($i+2, @thread - 1)]
161 1edd511a 2023-04-01 op if $i + 1 < @thread;
162 1edd511a 2023-04-01 op export_one $thread[$i], \@prev, \@next;
163 1edd511a 2023-04-01 op }
164 1edd511a 2023-04-01 op }
165 1edd511a 2023-04-01 op
166 1edd511a 2023-04-01 op my $tid;
167 1edd511a 2023-04-01 op my @thread;
168 1edd511a 2023-04-01 op while (<>) {
169 1edd511a 2023-04-01 op my $mail = parse $_;
170 1edd511a 2023-04-01 op
171 1edd511a 2023-04-01 op if ($mail->{level} == 0 && @thread) {
172 1edd511a 2023-04-01 op export @thread;
173 1edd511a 2023-04-01 op @thread = ();
174 1edd511a 2023-04-01 op }
175 1edd511a 2023-04-01 op
176 1edd511a 2023-04-01 op $tid = $mail->{mid} if $mail->{level} == 0;
177 1edd511a 2023-04-01 op die "unknown tid" unless defined $tid;
178 1edd511a 2023-04-01 op $mail->{tid} = $tid;
179 1edd511a 2023-04-01 op
180 1edd511a 2023-04-01 op # export_one $mail, $tid
181 1edd511a 2023-04-01 op push @thread, $mail;
182 1edd511a 2023-04-01 op }
183 1edd511a 2023-04-01 op
184 1edd511a 2023-04-01 op export @thread if @thread;