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 OpenBSD::Pledge;
14 use OpenBSD::Unveil;
15 
16 use lib ".";
17 use GotMArc qw(parse san urlencode initpage endpage thread_header);
18 
19 my $outdir = $ENV{'OUTDIR'};
20 die 'Set $OUTDIR' unless defined $outdir;
21 
22 unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
23 unveil($outdir, "rwc") or die "unveil $outdir: $!";
24 
25 unveil(".", "r") or die "unveil .: $!";
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 my $tid;
60 while (<>) {
61 	my $mail = parse $_;
62 
63 	$tid = $mail->{mid} if $mail->{level} == 0;
64 	die "unknown tid" unless defined $tid;
65 
66 	my $dest = "$outdir/mail/$mail->{mid}.html";
67 
68 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
69 
70 	initpage $fh, $mail->{subj};
71 
72 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
73 	    or die "can't exec mshow: $!";
74 
75 	open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
76 	    or die "can't open $outdir/text/$mail->{mid}.txt: $!";
77 
78 	my @hdrs;
79 	while (<$mshow>) {
80 		last if /^$/;
81 
82 		# drop the (1 day ago) string
83 		s/ \(.*\)// if /^Date:/;
84 		print $text $_;
85 		push @hdrs, san($_);
86 	}
87 	say $text "";
88 
89 	thread_header $fh, $tid, $mail->{mid}, \@hdrs;
90 
91 	print $fh "<pre>";
92 	while (<$mshow>) {
93 		print $text $_;
94 		print $fh san($_);
95 	}
96 	print $fh "</pre>";
97 
98 	# generate the listing for the exported parts
99 	open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
100 	    or die "can't exec mshow: $!";
101 
102 	my $partno = 0;
103 	while (<$parts>) {
104 		my ($n, $mime, $size, $name) =
105 		    m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
106 
107 		next if $mime =~ m(application/application/pgp-signature);
108 		next if $mime =~ m(audio/*);
109 		next if $mime =~ m(video/*);
110 
111 		my $ext = "bin";
112 		if ($mime =~ m(image/*)) {
113 			if ($mime eq "image/gif") {
114 				$ext = "gif";
115 			} elsif ($mime eq "image/jpeg") {
116 				$ext = "jpg";
117 			} elsif ($mime eq "image/png") {
118 				$ext = "png";
119 			} else {
120 				# skip other image types for now.
121 				next;
122 			}
123 		}
124 
125 		# text/* is bundled in the body by mshow(1).
126 
127 		say $fh "<ul class='parts'>" if $partno == 0;
128 		$partno++;
129 
130 		my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
131 		open my $p, '>', $path
132 		    or die "can't open $mail->{fname}: $!";
133 		export_part($p, $n, $mail->{fname});
134 		close($p);
135 
136 		$path =~ s,^.*/parts/,/parts/,;
137 
138 		my $url = san($path);
139 		my $hs = humanize $size;
140 		say $fh "<li><a href='$url'>$name ($hs)</a></li>";
141 	}
142 	say $fh "</ul>" if $partno > 0;
143 
144 	my $encmid = urlencode $mail->{mid};
145 	my $enctid = urlencode $tid;
146 
147 	print $fh "<nav>";
148 	print $fh "<a href='/text/$encmid.txt'>Raw body</a>";
149 	print $fh "<a href='/thread/$enctid.html#$encmid'>Thread</a>";
150 	print $fh "</nav>\n";
151 
152 	endpage $fh;
153 
154 	close($text);
155 	close($mshow);
156 	close($parts);
157 	close($fh);
158 
159 	unlink $parts;
160 }