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 054f3fd4 2022-08-25 op use OpenBSD::Pledge;
 16 054f3fd4 2022-08-25 op use OpenBSD::Unveil;
 17 054f3fd4 2022-08-25 op 
 18 04eab9af 2022-08-25 op use lib ".";
 19 f0fb0f08 2022-08-30 op use GotMArc qw(parse san urlencode initpage endpage thread_header);
 20 04eab9af 2022-08-25 op 
 21 7d6d378a 2022-08-24 op my $outdir = $ENV{'OUTDIR'};
 22 7d6d378a 2022-08-24 op die 'Set $OUTDIR' unless defined $outdir;
 23 7d6d378a 2022-08-24 op 
 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: $!";
 26 d3d07147 2022-08-30 op 
 27 66e1cf97 2022-08-27 op unveil(".", "r") or die "unveil .: $!";
 28 054f3fd4 2022-08-25 op 
 29 53bed501 2023-03-29 op pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
 30 66e1cf97 2022-08-27 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 thrnav {
 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};
 65 7d6d378a 2022-08-24 op 
 66 1edd511a 2023-04-01 op 	return if !@prev && !@next;
 67 1edd511a 2023-04-01 op 	print $fh "<nav>";
 68 7d6d378a 2022-08-24 op 
 69 1edd511a 2023-04-01 op 	if (@prev) {
 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>";
 73 1edd511a 2023-04-01 op 	} else {
 74 1edd511a 2023-04-01 op 		say $fh "<span>Previous</span>";
 75 1edd511a 2023-04-01 op 	}
 76 1edd511a 2023-04-01 op 
 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>";
 82 1edd511a 2023-04-01 op 	}
 83 1edd511a 2023-04-01 op 
 84 1edd511a 2023-04-01 op 	if (@next) {
 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>";
 88 1edd511a 2023-04-01 op 	} else {
 89 1edd511a 2023-04-01 op 		say $fh "<span>Next</span>";
 90 1edd511a 2023-04-01 op 	}
 91 1edd511a 2023-04-01 op 
 92 1edd511a 2023-04-01 op 	print $fh "</nav>";
 93 1edd511a 2023-04-01 op }
 94 1edd511a 2023-04-01 op 
 95 85fd8f63 2023-04-01 op sub min_level {
 96 85fd8f63 2023-04-01 op 	my $l = 999;
 97 85fd8f63 2023-04-01 op 	return 0 unless @_;
 98 85fd8f63 2023-04-01 op 	for (@_) {
 99 85fd8f63 2023-04-01 op 		$l = $_->{level} if $_->{level} < $l;
100 85fd8f63 2023-04-01 op 	}
101 85fd8f63 2023-04-01 op 	return $l;
102 85fd8f63 2023-04-01 op }
103 85fd8f63 2023-04-01 op 
104 85fd8f63 2023-04-01 op sub threntry {
105 85fd8f63 2023-04-01 op 	my ($fh, $base, $last_level, $cur, $mail) = @_;
106 85fd8f63 2023-04-01 op 	my $level = $mail->{level} - $base;
107 85fd8f63 2023-04-01 op 
108 85fd8f63 2023-04-01 op 	say $fh "</ul></li>" x ($last_level - $level) if $last_level > $level;
109 85fd8f63 2023-04-01 op 	say $fh "<li><ul>" if $last_level < $level;
110 85fd8f63 2023-04-01 op 
111 85fd8f63 2023-04-01 op 	my $encmid = urlencode $mail->{mid};
112 85fd8f63 2023-04-01 op 
113 85fd8f63 2023-04-01 op 	print $fh "<li id='$encmid' class='mail'>";
114 85fd8f63 2023-04-01 op 	print $fh "<p class='mail-meta'>";
115 85fd8f63 2023-04-01 op 	print $fh "<time>$mail->{date}</time> ";
116 85fd8f63 2023-04-01 op 	print $fh "<span class='from'>$mail->{from}</span>";
117 85fd8f63 2023-04-01 op 	print $fh "<span class='colon'>:</span>";
118 85fd8f63 2023-04-01 op 	print $fh "</p>";
119 85fd8f63 2023-04-01 op 	print $fh "<p class='subject'>";
120 85fd8f63 2023-04-01 op 
121 85fd8f63 2023-04-01 op 	my $subj = $mail->{subj};
122 85fd8f63 2023-04-01 op 	if ($mail->{mid} ne $cur->{mid}) {
123 85fd8f63 2023-04-01 op 		print $fh "<a href='/mail/$encmid.html'>$subj</a>";
124 85fd8f63 2023-04-01 op 	} else {
125 85fd8f63 2023-04-01 op 		print $fh "<span>$subj</span>";
126 85fd8f63 2023-04-01 op 	}
127 85fd8f63 2023-04-01 op 
128 85fd8f63 2023-04-01 op 	print $fh "</p>";
129 85fd8f63 2023-04-01 op 	print $fh "</li>\n";
130 85fd8f63 2023-04-01 op 
131 85fd8f63 2023-04-01 op 	return $level;
132 85fd8f63 2023-04-01 op }
133 85fd8f63 2023-04-01 op 
134 85fd8f63 2023-04-01 op sub thrslice {
135 85fd8f63 2023-04-01 op 	my ($fh, $mail, $p, $n) = @_;
136 85fd8f63 2023-04-01 op 	my @prev = @{$p};
137 85fd8f63 2023-04-01 op 	my @next = @{$n};
138 85fd8f63 2023-04-01 op 	my @thread = (@prev, $mail, @next);
139 85fd8f63 2023-04-01 op 	return unless @thread;
140 85fd8f63 2023-04-01 op 	my $base = min_level @thread;
141 85fd8f63 2023-04-01 op 	my $level = 0;
142 85fd8f63 2023-04-01 op 	print $fh "<div class='thread'>";
143 85fd8f63 2023-04-01 op 	print $fh "<ul class='mails'>";
144 85fd8f63 2023-04-01 op 	$level = threntry $fh, $base, $level, $mail, $_ for @thread;
145 85fd8f63 2023-04-01 op 	print $fh "</ul></li>" x $level;
146 85fd8f63 2023-04-01 op 	print $fh "</ul></div>";
147 85fd8f63 2023-04-01 op }
148 85fd8f63 2023-04-01 op 
149 1edd511a 2023-04-01 op sub export_one {
150 1edd511a 2023-04-01 op 	my ($mail, $prev, $next) = @_;
151 bbdbef1a 2023-04-01 op 	my $dest = "$outdir/mail/$mail->{mid}.html";
152 c971fcee 2022-08-25 op 
153 7d6d378a 2022-08-24 op 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
154 7d6d378a 2022-08-24 op 
155 bbdbef1a 2023-04-01 op 	initpage $fh, $mail->{subj};
156 7d6d378a 2022-08-24 op 
157 bbdbef1a 2023-04-01 op 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
158 7d6d378a 2022-08-24 op 	    or die "can't exec mshow: $!";
159 7d6d378a 2022-08-24 op 
160 bbdbef1a 2023-04-01 op 	open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
161 bbdbef1a 2023-04-01 op 	    or die "can't open $outdir/text/$mail->{mid}.txt: $!";
162 84989e10 2022-08-24 op 
163 9d8482ab 2022-08-27 op 	my @hdrs;
164 7d6d378a 2022-08-24 op 	while (<$mshow>) {
165 7d6d378a 2022-08-24 op 		last if /^$/;
166 7d6d378a 2022-08-24 op 
167 7d6d378a 2022-08-24 op 		# drop the (1 day ago) string
168 6e04f5f4 2022-08-27 op 		s/ \(.*\)// if /^Date:/;
169 6797be46 2022-08-27 op 		print $text $_;
170 9d8482ab 2022-08-27 op 		push @hdrs, san($_);
171 7d6d378a 2022-08-24 op 	}
172 6797be46 2022-08-27 op 	say $text "";
173 7d6d378a 2022-08-24 op 
174 1edd511a 2023-04-01 op 	thread_header $fh, $mail->{tid}, $mail->{mid}, \@hdrs;
175 9d8482ab 2022-08-27 op 
176 7d6d378a 2022-08-24 op 	print $fh "<pre>";
177 5b01d758 2022-08-25 op 	while (<$mshow>) {
178 5b01d758 2022-08-25 op 		print $text $_;
179 5b01d758 2022-08-25 op 		print $fh san($_);
180 5b01d758 2022-08-25 op 	}
181 7d6d378a 2022-08-24 op 	print $fh "</pre>";
182 7d6d378a 2022-08-24 op 
183 f1ceade9 2022-08-24 op 	# generate the listing for the exported parts
184 bbdbef1a 2023-04-01 op 	open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
185 f3481d06 2022-09-13 op 	    or die "can't exec mshow: $!";
186 f3481d06 2022-09-13 op 
187 53bed501 2023-03-29 op 	my $partno = 0;
188 f3481d06 2022-09-13 op 	while (<$parts>) {
189 f3481d06 2022-09-13 op 		my ($n, $mime, $size, $name) =
190 f3481d06 2022-09-13 op 		    m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
191 f3481d06 2022-09-13 op 
192 f3481d06 2022-09-13 op 		next if $mime =~ m(application/application/pgp-signature);
193 f3481d06 2022-09-13 op 		next if $mime =~ m(audio/*);
194 f3481d06 2022-09-13 op 		next if $mime =~ m(video/*);
195 f3481d06 2022-09-13 op 
196 f3481d06 2022-09-13 op 		my $ext = "bin";
197 f3481d06 2022-09-13 op 		if ($mime =~ m(image/*)) {
198 f3481d06 2022-09-13 op 			if ($mime eq "image/gif") {
199 f3481d06 2022-09-13 op 				$ext = "gif";
200 f3481d06 2022-09-13 op 			} elsif ($mime eq "image/jpeg") {
201 f3481d06 2022-09-13 op 				$ext = "jpg";
202 f3481d06 2022-09-13 op 			} elsif ($mime eq "image/png") {
203 f3481d06 2022-09-13 op 				$ext = "png";
204 f3481d06 2022-09-13 op 			} else {
205 f3481d06 2022-09-13 op 				# skip other image types for now.
206 f3481d06 2022-09-13 op 				next;
207 f3481d06 2022-09-13 op 			}
208 f3481d06 2022-09-13 op 		}
209 f3481d06 2022-09-13 op 
210 f3481d06 2022-09-13 op 		# text/* is bundled in the body by mshow(1).
211 f3481d06 2022-09-13 op 
212 53bed501 2023-03-29 op 		say $fh "<ul class='parts'>" if $partno == 0;
213 53bed501 2023-03-29 op 		$partno++;
214 f3481d06 2022-09-13 op 
215 bbdbef1a 2023-04-01 op 		my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
216 53bed501 2023-03-29 op 		open my $p, '>', $path
217 bbdbef1a 2023-04-01 op 		    or die "can't open $mail->{fname}: $!";
218 bbdbef1a 2023-04-01 op 		export_part($p, $n, $mail->{fname});
219 f3481d06 2022-09-13 op 		close($p);
220 f3481d06 2022-09-13 op 
221 f3481d06 2022-09-13 op 		$path =~ s,^.*/parts/,/parts/,;
222 f3481d06 2022-09-13 op 
223 53bed501 2023-03-29 op 		my $url = san($path);
224 6240f9b8 2022-09-13 op 		my $hs = humanize $size;
225 6240f9b8 2022-09-13 op 		say $fh "<li><a href='$url'>$name ($hs)</a></li>";
226 f1ceade9 2022-08-24 op 	}
227 53bed501 2023-03-29 op 	say $fh "</ul>" if $partno > 0;
228 f1ceade9 2022-08-24 op 
229 1edd511a 2023-04-01 op 	thrnav $fh, $prev, $next, $mail->{mid}, $mail->{tid};
230 85fd8f63 2023-04-01 op 	thrslice $fh, $mail, $prev, $next;
231 f0fb0f08 2022-08-30 op 
232 04eab9af 2022-08-25 op 	endpage $fh;
233 7d6d378a 2022-08-24 op 
234 84989e10 2022-08-24 op 	close($text);
235 7d6d378a 2022-08-24 op 	close($mshow);
236 f3481d06 2022-09-13 op 	close($parts);
237 7d6d378a 2022-08-24 op 	close($fh);
238 f1ceade9 2022-08-24 op 
239 66e1cf97 2022-08-27 op 	unlink $parts;
240 66e1cf97 2022-08-27 op }
241 1edd511a 2023-04-01 op 
242 1edd511a 2023-04-01 op sub export {
243 1edd511a 2023-04-01 op 	my @thread = @_;
244 1edd511a 2023-04-01 op 
245 1edd511a 2023-04-01 op 	for (my $i = 0; $i < @thread; $i++) {
246 1edd511a 2023-04-01 op 		my (@prev, @next);
247 85fd8f63 2023-04-01 op 		@prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
248 85fd8f63 2023-04-01 op 		@next = @thread[$i+1..min($i+2, @thread - 1)]
249 1edd511a 2023-04-01 op 		    if $i + 1 < @thread;
250 1edd511a 2023-04-01 op 		export_one $thread[$i], \@prev, \@next;
251 1edd511a 2023-04-01 op 	}
252 1edd511a 2023-04-01 op }
253 1edd511a 2023-04-01 op 
254 1edd511a 2023-04-01 op my $tid;
255 1edd511a 2023-04-01 op my @thread;
256 1edd511a 2023-04-01 op while (<>) {
257 1edd511a 2023-04-01 op 	my $mail = parse $_;
258 1edd511a 2023-04-01 op 
259 1edd511a 2023-04-01 op 	if ($mail->{level} == 0 && @thread) {
260 1edd511a 2023-04-01 op 		export @thread;
261 1edd511a 2023-04-01 op 		@thread = ();
262 1edd511a 2023-04-01 op 	}
263 1edd511a 2023-04-01 op 
264 1edd511a 2023-04-01 op 	$tid = $mail->{mid} if $mail->{level} == 0;
265 1edd511a 2023-04-01 op 	die "unknown tid" unless defined $tid;
266 1edd511a 2023-04-01 op 	$mail->{tid} = $tid;
267 1edd511a 2023-04-01 op 
268 1edd511a 2023-04-01 op 	# export_one $mail, $tid
269 1edd511a 2023-04-01 op 	push @thread, $mail;
270 1edd511a 2023-04-01 op }
271 1edd511a 2023-04-01 op 
272 1edd511a 2023-04-01 op export @thread if @thread;