Blame


1 7d6d378a 2022-08-24 op #!/usr/bin/env perl
2 1bcb9899 2022-08-29 op #
3 1bcb9899 2022-08-29 op # mexp was written by Omar Polo <op@openbsd.org> and is placed in the
4 1bcb9899 2022-08-29 op # public domain. The author hereby disclaims copyright to this source
5 1bcb9899 2022-08-29 op # code.
6 7d6d378a 2022-08-24 op
7 7d6d378a 2022-08-24 op use open ":std", ":encoding(UTF-8)";
8 7d6d378a 2022-08-24 op use utf8;
9 7d6d378a 2022-08-24 op use strict;
10 7d6d378a 2022-08-24 op use warnings;
11 7d6d378a 2022-08-24 op use v5.32;
12 66e1cf97 2022-08-27 op use File::Temp qw(tempfile);
13 7d6d378a 2022-08-24 op
14 054f3fd4 2022-08-25 op use OpenBSD::Pledge;
15 054f3fd4 2022-08-25 op use OpenBSD::Unveil;
16 054f3fd4 2022-08-25 op
17 04eab9af 2022-08-25 op use lib ".";
18 f0fb0f08 2022-08-30 op use GotMArc qw(parse san urlencode initpage endpage thread_header);
19 04eab9af 2022-08-25 op
20 7d6d378a 2022-08-24 op my $outdir = $ENV{'OUTDIR'};
21 7d6d378a 2022-08-24 op die 'Set $OUTDIR' unless defined $outdir;
22 7d6d378a 2022-08-24 op
23 054f3fd4 2022-08-25 op unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
24 054f3fd4 2022-08-25 op unveil($outdir, "rwc") or die "unveil $outdir: $!";
25 d3d07147 2022-08-30 op
26 d3d07147 2022-08-30 op # can't use tmppath because File::Temp checks whether /tmp exists.
27 66e1cf97 2022-08-27 op unveil("/tmp", "rwc") or die "unveil /tmp: $!";
28 66e1cf97 2022-08-27 op unveil(".", "r") or die "unveil .: $!";
29 054f3fd4 2022-08-25 op
30 d3d07147 2022-08-30 op # fattr for File::Temp
31 66e1cf97 2022-08-27 op pledge("stdio rpath wpath cpath proc exec fattr") or die "pledge: $!";
32 66e1cf97 2022-08-27 op
33 f3481d06 2022-09-13 op sub export_part {
34 f3481d06 2022-09-13 op my ($fh, $n, $fname) = @_;
35 f3481d06 2022-09-13 op
36 f3481d06 2022-09-13 op my $pid = fork;
37 f3481d06 2022-09-13 op die "fork: $!" unless defined $pid;
38 f3481d06 2022-09-13 op if ($pid == 0) {
39 f3481d06 2022-09-13 op open \*STDOUT, '>&', $fh
40 f3481d06 2022-09-13 op or die "can't redirect stdout: $!";
41 f3481d06 2022-09-13 op exec 'mshow', '-F', '-O', $fname, $n
42 f3481d06 2022-09-13 op or die "can't exec mshow: $!";
43 f3481d06 2022-09-13 op }
44 f3481d06 2022-09-13 op
45 f3481d06 2022-09-13 op waitpid $pid, 0;
46 f3481d06 2022-09-13 op die "mshow exited with $? ($n, $fname)" if $?;
47 f3481d06 2022-09-13 op }
48 f3481d06 2022-09-13 op
49 6240f9b8 2022-09-13 op # like libutil' fmt_scaled
50 6240f9b8 2022-09-13 op sub humanize {
51 6240f9b8 2022-09-13 op my $number = shift;
52 6240f9b8 2022-09-13 op my @units = qw( G M K B);
53 6240f9b8 2022-09-13 op my @scale = (1024*1024*1024, 1024*1024, 1024, 1);
54 6240f9b8 2022-09-13 op
55 6240f9b8 2022-09-13 op for (my $i = 0; $i < @scale; $i++) {
56 6240f9b8 2022-09-13 op if ($scale[$i] < $number) {
57 6240f9b8 2022-09-13 op my $r = $number / $scale[$i];
58 6240f9b8 2022-09-13 op return sprintf "%.0f%s", $r, $units[$i];
59 6240f9b8 2022-09-13 op }
60 6240f9b8 2022-09-13 op }
61 6240f9b8 2022-09-13 op }
62 6240f9b8 2022-09-13 op
63 7d6d378a 2022-08-24 op my $tid;
64 7d6d378a 2022-08-24 op while (<>) {
65 de557185 2022-08-26 op my ($level, $fname, $mid, $date, $from, $subj) = parse;
66 7d6d378a 2022-08-24 op
67 7d6d378a 2022-08-24 op $tid = $mid if $level == 0;
68 f3e4455d 2022-08-25 op die "unknown tid" unless defined $tid;
69 7d6d378a 2022-08-24 op
70 c971fcee 2022-08-25 op my $dest = "$outdir/mail/$mid.html";
71 09cbeefa 2022-09-13 op next if -f $dest;
72 c971fcee 2022-08-25 op
73 7d6d378a 2022-08-24 op open(my $fh, '>', "$dest") or die "can't open $dest: $!";
74 7d6d378a 2022-08-24 op
75 04eab9af 2022-08-25 op initpage $fh, $subj;
76 7d6d378a 2022-08-24 op
77 7d6d378a 2022-08-24 op open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $fname)
78 7d6d378a 2022-08-24 op or die "can't exec mshow: $!";
79 7d6d378a 2022-08-24 op
80 84989e10 2022-08-24 op open(my $text, '>', "$outdir/text/$mid.txt")
81 84989e10 2022-08-24 op or die "can't open $outdir/text/$mid.txt: $!";
82 84989e10 2022-08-24 op
83 9d8482ab 2022-08-27 op my @hdrs;
84 7d6d378a 2022-08-24 op while (<$mshow>) {
85 7d6d378a 2022-08-24 op last if /^$/;
86 7d6d378a 2022-08-24 op
87 7d6d378a 2022-08-24 op # drop the (1 day ago) string
88 6e04f5f4 2022-08-27 op s/ \(.*\)// if /^Date:/;
89 6797be46 2022-08-27 op print $text $_;
90 9d8482ab 2022-08-27 op push @hdrs, san($_);
91 7d6d378a 2022-08-24 op }
92 6797be46 2022-08-27 op say $text "";
93 7d6d378a 2022-08-24 op
94 9d8482ab 2022-08-27 op thread_header $fh, $tid, $mid, \@hdrs;
95 9d8482ab 2022-08-27 op
96 7d6d378a 2022-08-24 op print $fh "<pre>";
97 5b01d758 2022-08-25 op while (<$mshow>) {
98 5b01d758 2022-08-25 op print $text $_;
99 5b01d758 2022-08-25 op print $fh san($_);
100 5b01d758 2022-08-25 op }
101 7d6d378a 2022-08-24 op print $fh "</pre>";
102 7d6d378a 2022-08-24 op
103 f1ceade9 2022-08-24 op # generate the listing for the exported parts
104 f3481d06 2022-09-13 op open(my $parts, '-|', 'mshow', '-t', $fname)
105 f3481d06 2022-09-13 op or die "can't exec mshow: $!";
106 f3481d06 2022-09-13 op
107 f1ceade9 2022-08-24 op my $part_seen = 0;
108 f3481d06 2022-09-13 op while (<$parts>) {
109 f3481d06 2022-09-13 op my ($n, $mime, $size, $name) =
110 f3481d06 2022-09-13 op m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;
111 f3481d06 2022-09-13 op
112 f3481d06 2022-09-13 op next if $mime =~ m(application/application/pgp-signature);
113 f3481d06 2022-09-13 op next if $mime =~ m(audio/*);
114 f3481d06 2022-09-13 op next if $mime =~ m(video/*);
115 f3481d06 2022-09-13 op
116 f3481d06 2022-09-13 op my $ext = "bin";
117 f3481d06 2022-09-13 op if ($mime =~ m(image/*)) {
118 f3481d06 2022-09-13 op if ($mime eq "image/gif") {
119 f3481d06 2022-09-13 op $ext = "gif";
120 f3481d06 2022-09-13 op } elsif ($mime eq "image/jpeg") {
121 f3481d06 2022-09-13 op $ext = "jpg";
122 f3481d06 2022-09-13 op } elsif ($mime eq "image/png") {
123 f3481d06 2022-09-13 op $ext = "png";
124 f3481d06 2022-09-13 op } else {
125 f3481d06 2022-09-13 op # skip other image types for now.
126 f3481d06 2022-09-13 op next;
127 f3481d06 2022-09-13 op }
128 f3481d06 2022-09-13 op }
129 f3481d06 2022-09-13 op
130 f3481d06 2022-09-13 op # text/* is bundled in the body by mshow(1).
131 f3481d06 2022-09-13 op
132 f1ceade9 2022-08-24 op if (!$part_seen) {
133 f1ceade9 2022-08-24 op $part_seen = 1;
134 f1ceade9 2022-08-24 op say $fh "<ul class='parts'>";
135 f1ceade9 2022-08-24 op }
136 f3481d06 2022-09-13 op
137 f3481d06 2022-09-13 op my ($p, $path) = tempfile "$outdir/parts/$mid.XXXXXXXXXX";
138 f3481d06 2022-09-13 op export_part($p, $n, $fname);
139 f3481d06 2022-09-13 op close($p);
140 f3481d06 2022-09-13 op rename $path, "$path.$ext"
141 f3481d06 2022-09-13 op or die "can' rename $path as $path.ext";
142 f3481d06 2022-09-13 op chmod 0644, "$path.$ext";
143 f3481d06 2022-09-13 op
144 f3481d06 2022-09-13 op $path =~ s,^.*/parts/,/parts/,;
145 f3481d06 2022-09-13 op
146 f3481d06 2022-09-13 op my $url = san("$path.$ext");
147 6240f9b8 2022-09-13 op my $hs = humanize $size;
148 6240f9b8 2022-09-13 op say $fh "<li><a href='$url'>$name ($hs)</a></li>";
149 f1ceade9 2022-08-24 op }
150 f1ceade9 2022-08-24 op say $fh "</ul>" if $part_seen;
151 f1ceade9 2022-08-24 op
152 f0fb0f08 2022-08-30 op my $encmid = urlencode $mid;
153 f0fb0f08 2022-08-30 op my $enctid = urlencode $tid;
154 f0fb0f08 2022-08-30 op
155 1fd8f454 2022-08-27 op print $fh "<nav>";
156 f0fb0f08 2022-08-30 op print $fh "<a href='/text/$encmid.txt'>Raw body</a>";
157 f0fb0f08 2022-08-30 op print $fh "<a href='/thread/$enctid.html#$encmid'>Thread</a>";
158 1fd8f454 2022-08-27 op print $fh "</nav>\n";
159 1fd8f454 2022-08-27 op
160 04eab9af 2022-08-25 op endpage $fh;
161 7d6d378a 2022-08-24 op
162 84989e10 2022-08-24 op close($text);
163 7d6d378a 2022-08-24 op close($mshow);
164 f3481d06 2022-09-13 op close($parts);
165 7d6d378a 2022-08-24 op close($fh);
166 f1ceade9 2022-08-24 op
167 66e1cf97 2022-08-27 op unlink $parts;
168 66e1cf97 2022-08-27 op }