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