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     threntry thrslice thrnav);
21 
22 my $outdir = $ENV{'OUTDIR'};
23 die 'Set $OUTDIR' unless defined $outdir;
24 
25 unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
26 unveil($outdir, "rwc") or die "unveil $outdir: $!";
27 
28 pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
29 
30 sub export_part {
31 	my ($fh, $n, $fname) = @_;
32 
33 	my $pid = fork;
34 	die "fork: $!" unless defined $pid;
35 	if ($pid == 0) {
36 		open \*STDOUT, '>&', $fh
37 		    or die "can't redirect stdout: $!";
38 		exec 'mshow', '-F', '-O', $fname, $n
39 		    or die "can't exec mshow: $!";
40 	}
41 
42 	waitpid $pid, 0;
43 	die "mshow exited with $? ($n, $fname)" if $?;
44 }
45 
46 # like libutil' fmt_scaled
47 sub humanize {
48 	my $number = shift;
49 	my @units = qw(             G          M     K  B);
50 	my @scale =   (1024*1024*1024, 1024*1024, 1024, 1);
51 
52 	for (my $i = 0; $i < @scale; $i++) {
53 		if ($scale[$i] < $number) {
54 			my $r = $number / $scale[$i];
55 			return sprintf "%.0f%s", $r, $units[$i];
56 		}
57 	}
58 }
59 
60 sub export_one {
61 	my ($mail, $prev, $next) = @_;
62 	my $dest = "$outdir/mail/$mail->{mid}.html";
63 
64 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
65 
66 	initpage $fh, $mail->{subj};
67 
68 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
69 	    or die "can't exec mshow: $!";
70 
71 	open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
72 	    or die "can't open $outdir/text/$mail->{mid}.txt: $!";
73 
74 	my @hdrs;
75 	while (<$mshow>) {
76 		last if /^$/;
77 
78 		# drop the (1 day ago) string
79 		s/ \(.*\)// if /^Date:/;
80 		print $text $_;
81 		push @hdrs, san($_);
82 	}
83 	say $text "";
84 
85 	thread_header $fh, \@hdrs, $mail, $prev, $next;
86 
87 	print $fh "<pre>";
88 	while (<$mshow>) {
89 		print $text $_;
90 		print $fh san($_);
91 	}
92 	print $fh "</pre>";
93 
94 	# generate the listing for the exported parts
95 	open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
96 	    or die "can't exec mshow: $!";
97 
98 	my $partno = 0;
99 	while (<$parts>) {
100 		my ($n, $mime, $size, $name) =
101 		    m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
102 
103 		next if $mime =~ m(application/pgp-signature);
104 		next if $mime =~ m(audio/*);
105 		next if $mime =~ m(video/*);
106 
107 		my $ext = "bin";
108 		if ($mime =~ m(image/*)) {
109 			if ($mime eq "image/gif") {
110 				$ext = "gif";
111 			} elsif ($mime eq "image/jpeg") {
112 				$ext = "jpg";
113 			} elsif ($mime eq "image/png") {
114 				$ext = "png";
115 			} else {
116 				# skip other image types for now.
117 				next;
118 			}
119 		}
120 
121 		# text/* is bundled in the body by mshow(1).
122 
123 		say $fh "<ul class='parts'>" if $partno == 0;
124 		$partno++;
125 
126 		my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
127 		open my $p, '>', $path
128 		    or die "can't open $mail->{fname}: $!";
129 		export_part($p, $n, $mail->{fname});
130 		close($p);
131 
132 		$path =~ s,^.*/parts/,/parts/,;
133 
134 		my $url = san($path);
135 		my $hs = humanize $size;
136 		say $fh "<li><a href='$url'>$name ($hs)</a></li>";
137 	}
138 	say $fh "</ul>" if $partno > 0;
139 
140 	thrnav $fh, $prev, $next;
141 	thrslice $fh, $mail, $prev, $next;
142 
143 	endpage $fh;
144 
145 	close($text);
146 	close($mshow);
147 	close($parts);
148 	close($fh);
149 
150 	unlink $parts;
151 }
152 
153 sub export {
154 	my @thread = @_;
155 
156 	for (my $i = 0; $i < @thread; $i++) {
157 		my (@prev, @next);
158 		@prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
159 		@next = @thread[$i+1..min($i+2, @thread - 1)]
160 		    if $i + 1 < @thread;
161 		export_one $thread[$i], \@prev, \@next;
162 	}
163 }
164 
165 my $tid;
166 my @thread;
167 while (<>) {
168 	my $mail = parse $_;
169 
170 	if ($mail->{level} == 0 && @thread) {
171 		export @thread;
172 		@thread = ();
173 	}
174 
175 	$tid = $mail->{mid} if $mail->{level} == 0;
176 	die "unknown tid" unless defined $tid;
177 	$mail->{tid} = $tid;
178 
179 	# export_one $mail, $tid
180 	push @thread, $mail;
181 }
182 
183 export @thread if @thread;