1 #!/usr/bin/env perl
2 #
3 # mexp was written by Omar Polo <op@openbsd.org> and is placed in the
4 # public domain.  The author hereby disclaims copyright to this source
5 # code.
6 
7 use open ":std", ":encoding(UTF-8)";
8 use utf8;
9 use strict;
10 use warnings;
11 use v5.32;
12 
13 use List::Util qw(max min);
14 
15 use OpenBSD::Pledge;
16 use OpenBSD::Unveil;
17 
18 use lib ".";
19 use GotMArc qw(parse san urlencode initpage endpage thread_header);
20 
21 my $outdir = $ENV{'OUTDIR'};
22 die 'Set $OUTDIR' unless defined $outdir;
23 
24 unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
25 unveil($outdir, "rwc") or die "unveil $outdir: $!";
26 
27 unveil(".", "r") or die "unveil .: $!";
28 
29 pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
30 
31 sub export_part {
32 	my ($fh, $n, $fname) = @_;
33 
34 	my $pid = fork;
35 	die "fork: $!" unless defined $pid;
36 	if ($pid == 0) {
37 		open \*STDOUT, '>&', $fh
38 		    or die "can't redirect stdout: $!";
39 		exec 'mshow', '-F', '-O', $fname, $n
40 		    or die "can't exec mshow: $!";
41 	}
42 
43 	waitpid $pid, 0;
44 	die "mshow exited with $? ($n, $fname)" if $?;
45 }
46 
47 # like libutil' fmt_scaled
48 sub humanize {
49 	my $number = shift;
50 	my @units = qw(             G          M     K  B);
51 	my @scale =   (1024*1024*1024, 1024*1024, 1024, 1);
52 
53 	for (my $i = 0; $i < @scale; $i++) {
54 		if ($scale[$i] < $number) {
55 			my $r = $number / $scale[$i];
56 			return sprintf "%.0f%s", $r, $units[$i];
57 		}
58 	}
59 }
60 
61 sub thrnav {
62 	my ($fh, $p, $n, $mid, $tid) = @_;
63 	my @prev = @{$p};
64 	my @next = @{$n};
65 
66 	return if !@prev && !@next;
67 	print $fh "<nav>";
68 
69 	if (@prev) {
70 		my $mail = $prev[-1];
71 		my $encmid = $mail->{mid};
72 		say $fh "<a href='/mail/$encmid.html'>Previous</a>";
73 	} else {
74 		say $fh "<span>Previous</span>";
75 	}
76 
77 	if (defined($mid) && defined($tid)) {
78 		my $encmid = urlencode $mid;
79 		my $enctid = urlencode $tid;
80 		say $fh "<a href='/text/$encmid.txt'>Raw body</a>";
81 		say $fh "<a href='/thread/$enctid.html#$encmid'>Thread</a>";
82 	}
83 
84 	if (@next) {
85 		my $mail = $next[0];
86 		my $encmid = $mail->{mid};
87 		say $fh "<a href='/mail/$encmid.html'>Next</a>";
88 	} else {
89 		say $fh "<span>Next</span>";
90 	}
91 
92 	print $fh "</nav>";
93 }
94 
95 sub min_level {
96 	my $l = 999;
97 	return 0 unless @_;
98 	for (@_) {
99 		$l = $_->{level} if $_->{level} < $l;
100 	}
101 	return $l;
102 }
103 
104 sub threntry {
105 	my ($fh, $base, $last_level, $cur, $mail) = @_;
106 	my $level = $mail->{level} - $base;
107 
108 	say $fh "</ul></li>" x ($last_level - $level) if $last_level > $level;
109 	say $fh "<li><ul>" if $last_level < $level;
110 
111 	my $encmid = urlencode $mail->{mid};
112 
113 	print $fh "<li id='$encmid' class='mail'>";
114 	print $fh "<p class='mail-meta'>";
115 	print $fh "<time>$mail->{date}</time> ";
116 	print $fh "<span class='from'>$mail->{from}</span>";
117 	print $fh "<span class='colon'>:</span>";
118 	print $fh "</p>";
119 	print $fh "<p class='subject'>";
120 
121 	my $subj = $mail->{subj};
122 	if ($mail->{mid} ne $cur->{mid}) {
123 		print $fh "<a href='/mail/$encmid.html'>$subj</a>";
124 	} else {
125 		print $fh "<span>$subj</span>";
126 	}
127 
128 	print $fh "</p>";
129 	print $fh "</li>\n";
130 
131 	return $level;
132 }
133 
134 sub thrslice {
135 	my ($fh, $mail, $p, $n) = @_;
136 	my @prev = @{$p};
137 	my @next = @{$n};
138 	my @thread = (@prev, $mail, @next);
139 	return unless @thread;
140 	my $base = min_level @thread;
141 	my $level = 0;
142 	print $fh "<div class='thread'>";
143 	print $fh "<ul class='mails'>";
144 	$level = threntry $fh, $base, $level, $mail, $_ for @thread;
145 	print $fh "</ul></li>" x $level;
146 	print $fh "</ul></div>";
147 }
148 
149 sub export_one {
150 	my ($mail, $prev, $next) = @_;
151 	my $dest = "$outdir/mail/$mail->{mid}.html";
152 
153 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
154 
155 	initpage $fh, $mail->{subj};
156 
157 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
158 	    or die "can't exec mshow: $!";
159 
160 	open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
161 	    or die "can't open $outdir/text/$mail->{mid}.txt: $!";
162 
163 	my @hdrs;
164 	while (<$mshow>) {
165 		last if /^$/;
166 
167 		# drop the (1 day ago) string
168 		s/ \(.*\)// if /^Date:/;
169 		print $text $_;
170 		push @hdrs, san($_);
171 	}
172 	say $text "";
173 
174 	thread_header $fh, $mail->{tid}, $mail->{mid}, \@hdrs;
175 
176 	print $fh "<pre>";
177 	while (<$mshow>) {
178 		print $text $_;
179 		print $fh san($_);
180 	}
181 	print $fh "</pre>";
182 
183 	# generate the listing for the exported parts
184 	open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
185 	    or die "can't exec mshow: $!";
186 
187 	my $partno = 0;
188 	while (<$parts>) {
189 		my ($n, $mime, $size, $name) =
190 		    m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
191 
192 		next if $mime =~ m(application/application/pgp-signature);
193 		next if $mime =~ m(audio/*);
194 		next if $mime =~ m(video/*);
195 
196 		my $ext = "bin";
197 		if ($mime =~ m(image/*)) {
198 			if ($mime eq "image/gif") {
199 				$ext = "gif";
200 			} elsif ($mime eq "image/jpeg") {
201 				$ext = "jpg";
202 			} elsif ($mime eq "image/png") {
203 				$ext = "png";
204 			} else {
205 				# skip other image types for now.
206 				next;
207 			}
208 		}
209 
210 		# text/* is bundled in the body by mshow(1).
211 
212 		say $fh "<ul class='parts'>" if $partno == 0;
213 		$partno++;
214 
215 		my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
216 		open my $p, '>', $path
217 		    or die "can't open $mail->{fname}: $!";
218 		export_part($p, $n, $mail->{fname});
219 		close($p);
220 
221 		$path =~ s,^.*/parts/,/parts/,;
222 
223 		my $url = san($path);
224 		my $hs = humanize $size;
225 		say $fh "<li><a href='$url'>$name ($hs)</a></li>";
226 	}
227 	say $fh "</ul>" if $partno > 0;
228 
229 	thrnav $fh, $prev, $next, $mail->{mid}, $mail->{tid};
230 	thrslice $fh, $mail, $prev, $next;
231 
232 	endpage $fh;
233 
234 	close($text);
235 	close($mshow);
236 	close($parts);
237 	close($fh);
238 
239 	unlink $parts;
240 }
241 
242 sub export {
243 	my @thread = @_;
244 
245 	for (my $i = 0; $i < @thread; $i++) {
246 		my (@prev, @next);
247 		@prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
248 		@next = @thread[$i+1..min($i+2, @thread - 1)]
249 		    if $i + 1 < @thread;
250 		export_one $thread[$i], \@prev, \@next;
251 	}
252 }
253 
254 my $tid;
255 my @thread;
256 while (<>) {
257 	my $mail = parse $_;
258 
259 	if ($mail->{level} == 0 && @thread) {
260 		export @thread;
261 		@thread = ();
262 	}
263 
264 	$tid = $mail->{mid} if $mail->{level} == 0;
265 	die "unknown tid" unless defined $tid;
266 	$mail->{tid} = $tid;
267 
268 	# export_one $mail, $tid
269 	push @thread, $mail;
270 }
271 
272 export @thread if @thread;