Blob


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.
7 use open ":std", ":encoding(UTF-8)";
8 use utf8;
9 use strict;
10 use warnings;
11 use v5.32;
12 use File::Temp qw(tempfile);
14 use OpenBSD::Pledge;
15 use OpenBSD::Unveil;
17 use lib ".";
18 use GotMArc qw(parse san urlencode initpage endpage thread_header);
20 my $outdir = $ENV{'OUTDIR'};
21 die 'Set $OUTDIR' unless defined $outdir;
23 unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
24 unveil($outdir, "rwc") or die "unveil $outdir: $!";
26 # can't use tmppath because File::Temp checks whether /tmp exists.
27 unveil("/tmp", "rwc") or die "unveil /tmp: $!";
28 unveil(".", "r") or die "unveil .: $!";
30 # fattr for File::Temp
31 pledge("stdio rpath wpath cpath proc exec fattr") or die "pledge: $!";
33 sub export_part {
34 my ($fh, $n, $fname) = @_;
36 my $pid = fork;
37 die "fork: $!" unless defined $pid;
38 if ($pid == 0) {
39 open \*STDOUT, '>&', $fh
40 or die "can't redirect stdout: $!";
41 exec 'mshow', '-F', '-O', $fname, $n
42 or die "can't exec mshow: $!";
43 }
45 waitpid $pid, 0;
46 die "mshow exited with $? ($n, $fname)" if $?;
47 }
49 # like libutil' fmt_scaled
50 sub humanize {
51 my $number = shift;
52 my @units = qw( G M K B);
53 my @scale = (1024*1024*1024, 1024*1024, 1024, 1);
55 for (my $i = 0; $i < @scale; $i++) {
56 if ($scale[$i] < $number) {
57 my $r = $number / $scale[$i];
58 return sprintf "%.0f%s", $r, $units[$i];
59 }
60 }
61 }
63 my $tid;
64 while (<>) {
65 my ($level, $fname, $mid, $date, $from, $subj) = parse;
67 $tid = $mid if $level == 0;
68 die "unknown tid" unless defined $tid;
70 my $dest = "$outdir/mail/$mid.html";
71 next if -f $dest;
73 open(my $fh, '>', "$dest") or die "can't open $dest: $!";
75 initpage $fh, $subj;
77 open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $fname)
78 or die "can't exec mshow: $!";
80 open(my $text, '>', "$outdir/text/$mid.txt")
81 or die "can't open $outdir/text/$mid.txt: $!";
83 my @hdrs;
84 while (<$mshow>) {
85 last if /^$/;
87 # drop the (1 day ago) string
88 s/ \(.*\)// if /^Date:/;
89 print $text $_;
90 push @hdrs, san($_);
91 }
92 say $text "";
94 thread_header $fh, $tid, $mid, \@hdrs;
96 print $fh "<pre>";
97 while (<$mshow>) {
98 print $text $_;
99 print $fh san($_);
101 print $fh "</pre>";
103 # generate the listing for the exported parts
104 open(my $parts, '-|', 'mshow', '-t', $fname)
105 or die "can't exec mshow: $!";
107 my $part_seen = 0;
108 while (<$parts>) {
109 my ($n, $mime, $size, $name) =
110 m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
112 next if $mime =~ m(application/application/pgp-signature);
113 next if $mime =~ m(audio/*);
114 next if $mime =~ m(video/*);
116 my $ext = "bin";
117 if ($mime =~ m(image/*)) {
118 if ($mime eq "image/gif") {
119 $ext = "gif";
120 } elsif ($mime eq "image/jpeg") {
121 $ext = "jpg";
122 } elsif ($mime eq "image/png") {
123 $ext = "png";
124 } else {
125 # skip other image types for now.
126 next;
130 # text/* is bundled in the body by mshow(1).
132 if (!$part_seen) {
133 $part_seen = 1;
134 say $fh "<ul class='parts'>";
137 my ($p, $path) = tempfile "$outdir/parts/$mid.XXXXXXXXXX";
138 export_part($p, $n, $fname);
139 close($p);
140 rename $path, "$path.$ext"
141 or die "can' rename $path as $path.ext";
142 chmod 0644, "$path.$ext";
144 $path =~ s,^.*/parts/,/parts/,;
146 my $url = san("$path.$ext");
147 my $hs = humanize $size;
148 say $fh "<li><a href='$url'>$name ($hs)</a></li>";
150 say $fh "</ul>" if $part_seen;
152 my $encmid = urlencode $mid;
153 my $enctid = urlencode $tid;
155 print $fh "<nav>";
156 print $fh "<a href='/text/$encmid.txt'>Raw body</a>";
157 print $fh "<a href='/thread/$enctid.html#$encmid'>Thread</a>";
158 print $fh "</nav>\n";
160 endpage $fh;
162 close($text);
163 close($mshow);
164 close($parts);
165 close($fh);
167 unlink $parts;