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 threntry);
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 pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
28 
29 sub export_part {
30 	my ($fh, $n, $fname) = @_;
31 
32 	my $pid = fork;
33 	die "fork: $!" unless defined $pid;
34 	if ($pid == 0) {
35 		open \*STDOUT, '>&', $fh
36 		    or die "can't redirect stdout: $!";
37 		exec 'mshow', '-F', '-O', $fname, $n
38 		    or die "can't exec mshow: $!";
39 	}
40 
41 	waitpid $pid, 0;
42 	die "mshow exited with $? ($n, $fname)" if $?;
43 }
44 
45 # like libutil' fmt_scaled
46 sub humanize {
47 	my $number = shift;
48 	my @units = qw(             G          M     K  B);
49 	my @scale =   (1024*1024*1024, 1024*1024, 1024, 1);
50 
51 	for (my $i = 0; $i < @scale; $i++) {
52 		if ($scale[$i] < $number) {
53 			my $r = $number / $scale[$i];
54 			return sprintf "%.0f%s", $r, $units[$i];
55 		}
56 	}
57 }
58 
59 sub thrnav {
60 	my ($fh, $p, $n, $mid, $tid) = @_;
61 	my @prev = @{$p};
62 	my @next = @{$n};
63 
64 	return if !@prev && !@next;
65 	print $fh "<nav>";
66 
67 	if (@prev) {
68 		my $mail = $prev[-1];
69 		my $encmid = $mail->{mid};
70 		say $fh "<a href='/mail/$encmid.html'>Previous</a>";
71 	} else {
72 		say $fh "<span>Previous</span>";
73 	}
74 
75 	if (defined($mid) && defined($tid)) {
76 		my $encmid = urlencode $mid;
77 		my $enctid = urlencode $tid;
78 		say $fh "<a href='/text/$encmid.txt'>Raw body</a>";
79 		say $fh "<a href='/thread/$enctid.html#$encmid'>Thread</a>";
80 	}
81 
82 	if (@next) {
83 		my $mail = $next[0];
84 		my $encmid = $mail->{mid};
85 		say $fh "<a href='/mail/$encmid.html'>Next</a>";
86 	} else {
87 		say $fh "<span>Next</span>";
88 	}
89 
90 	print $fh "</nav>";
91 }
92 
93 sub min_level {
94 	my $l = 999;
95 	return 0 unless @_;
96 	for (@_) {
97 		$l = $_->{level} if $_->{level} < $l;
98 	}
99 	return $l;
100 }
101 
102 sub thrslice {
103 	my ($fh, $mail, $p, $n) = @_;
104 	my @prev = @{$p};
105 	my @next = @{$n};
106 	my @thread = (@prev, $mail, @next);
107 	return unless @thread;
108 	my $base = min_level @thread;
109 	my $level = 0;
110 	print $fh "<div class='thread'>";
111 	print $fh "<ul class='mails'>";
112 	$level = threntry $fh, "mail", $base, $level, $_, $mail for @thread;
113 	print $fh "</ul></li>" x $level;
114 	print $fh "</ul></div>";
115 }
116 
117 sub export_one {
118 	my ($mail, $prev, $next) = @_;
119 	my $dest = "$outdir/mail/$mail->{mid}.html";
120 
121 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
122 
123 	initpage $fh, $mail->{subj};
124 
125 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
126 	    or die "can't exec mshow: $!";
127 
128 	open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
129 	    or die "can't open $outdir/text/$mail->{mid}.txt: $!";
130 
131 	my @hdrs;
132 	while (<$mshow>) {
133 		last if /^$/;
134 
135 		# drop the (1 day ago) string
136 		s/ \(.*\)// if /^Date:/;
137 		print $text $_;
138 		push @hdrs, san($_);
139 	}
140 	say $text "";
141 
142 	thread_header $fh, $mail->{tid}, $mail->{mid}, \@hdrs;
143 
144 	print $fh "<pre>";
145 	while (<$mshow>) {
146 		print $text $_;
147 		print $fh san($_);
148 	}
149 	print $fh "</pre>";
150 
151 	# generate the listing for the exported parts
152 	open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
153 	    or die "can't exec mshow: $!";
154 
155 	my $partno = 0;
156 	while (<$parts>) {
157 		my ($n, $mime, $size, $name) =
158 		    m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
159 
160 		next if $mime =~ m(application/pgp-signature);
161 		next if $mime =~ m(audio/*);
162 		next if $mime =~ m(video/*);
163 
164 		my $ext = "bin";
165 		if ($mime =~ m(image/*)) {
166 			if ($mime eq "image/gif") {
167 				$ext = "gif";
168 			} elsif ($mime eq "image/jpeg") {
169 				$ext = "jpg";
170 			} elsif ($mime eq "image/png") {
171 				$ext = "png";
172 			} else {
173 				# skip other image types for now.
174 				next;
175 			}
176 		}
177 
178 		# text/* is bundled in the body by mshow(1).
179 
180 		say $fh "<ul class='parts'>" if $partno == 0;
181 		$partno++;
182 
183 		my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
184 		open my $p, '>', $path
185 		    or die "can't open $mail->{fname}: $!";
186 		export_part($p, $n, $mail->{fname});
187 		close($p);
188 
189 		$path =~ s,^.*/parts/,/parts/,;
190 
191 		my $url = san($path);
192 		my $hs = humanize $size;
193 		say $fh "<li><a href='$url'>$name ($hs)</a></li>";
194 	}
195 	say $fh "</ul>" if $partno > 0;
196 
197 	thrnav $fh, $prev, $next, $mail->{mid}, $mail->{tid};
198 	thrslice $fh, $mail, $prev, $next;
199 
200 	endpage $fh;
201 
202 	close($text);
203 	close($mshow);
204 	close($parts);
205 	close($fh);
206 
207 	unlink $parts;
208 }
209 
210 sub export {
211 	my @thread = @_;
212 
213 	for (my $i = 0; $i < @thread; $i++) {
214 		my (@prev, @next);
215 		@prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
216 		@next = @thread[$i+1..min($i+2, @thread - 1)]
217 		    if $i + 1 < @thread;
218 		export_one $thread[$i], \@prev, \@next;
219 	}
220 }
221 
222 my $tid;
223 my @thread;
224 while (<>) {
225 	my $mail = parse $_;
226 
227 	if ($mail->{level} == 0 && @thread) {
228 		export @thread;
229 		@thread = ();
230 	}
231 
232 	$tid = $mail->{mid} if $mail->{level} == 0;
233 	die "unknown tid" unless defined $tid;
234 	$mail->{tid} = $tid;
235 
236 	# export_one $mail, $tid
237 	push @thread, $mail;
238 }
239 
240 export @thread if @thread;