1 #!/usr/bin/env perl
2 
3 use open ":std", ":encoding(UTF-8)";
4 use utf8;
5 use strict;
6 use warnings;
7 use v5.32;
8 
9 my $outdir = $ENV{'OUTDIR'};
10 die 'Set $OUTDIR' unless defined $outdir;
11 mkdir $outdir;
12 
13 my $hdr = do {
14 	local $/ = undef;
15 	open my $fh, "<", "head.html"
16 	    or die "can't open head.html: $!";
17 	<$fh>;
18 };
19 
20 my $foot = do {
21 	local $/ = undef;
22 	open my $fh, "<", "foot.html"
23 	    or die "can't open foot.html: $!";
24 	<$fh>;
25 };
26 
27 my $logo = <<EOF;
28 <img srcset='/got-tiny.png, /got-tiny@2x.png 2x'
29      src='/got-tiny.png'
30      width='64' height='39'
31      alt='"GOT", but the "O" is a cute, smiling sun' />
32 EOF
33 
34 sub san {
35 	my $str = shift;
36 	$str =~ s/&/\&amp;/g;
37 	$str =~ s/</\&lt;/g;
38 	$str =~ s/>/\&gt;/g;
39 	return $str;
40 }
41 
42 sub genmbox {
43 	my ($fname, $mid) = @_;
44 
45 	open(my $fh, ">", "$outdir/mbox/$mid.mbox")
46 	    or die "can't open $outdir/mbox/$mid.mbox: $!";
47 
48 	my $pid = fork();
49 	die "fork: $!" unless defined $pid;
50 	if ($pid == 0) {
51 		open \*STDOUT, '>&', $fh;
52 		exec('mexport', $fname)
53 		    or die "exec mexport: $!";
54 	}
55 	die "waitpid: $!" if waitpid($pid, 0) == -1;
56 	die "mexport failed with $?" if $? != 0;
57 	# waitpid($pid, 0);
58 }
59 
60 my $tid;
61 while (<>) {
62 	chomp;
63 
64 	m/^([^ ]+) <([^>]+)> (.+)(\d{4}-\d{2}-\d{2} \d{2}:\d{2}) <([^>]+)> (.*)/;
65 	die "can't parse: $_" unless defined $1;
66 	my ($fname, $mid, $indent, $date, $from, $subj) = ($1, $2, $3, $4, $5, $6);
67 	$subj = san($subj);
68 	$subj =~ s/\s+/ /g;
69 	$subj =~ s/\s+$//;
70 
71 	$mid =~ s,_,__,g;
72 	$mid =~ s,/,_,g;
73 
74 	chomp($mid);
75 
76 	my $dest = "$outdir/mail/$mid.html";
77 	next if -f $dest;
78 
79 	my $level = length($indent) - 1;
80 	$level = 10 if $indent =~ m/\.\.\d{2}\.\./;
81 
82 	$tid = $mid if $level == 0;
83 	die "unknown tid" unless defined $tid;
84 
85 	genmbox($fname, $mid);
86 
87 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
88 
89 	say $fh $hdr =~ s/TITLE/$subj/r;
90 
91 	# prepare the parts listing file
92 	$ENV{'MESSAGE_ID'} = $mid;
93 	open(my $parts, '+>', "parts.html")
94 	    or die "can't create parts.html: $!";
95 
96 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $fname)
97 	    or die "can't exec mshow: $!";
98 
99 	open(my $text, '>', "$outdir/text/$mid.txt")
100 	    or die "can't open $outdir/text/$mid.txt: $!";
101 
102 	print $fh "<header class='mail-header'>";
103 	print $fh "<p>";
104 	print $fh $logo;
105 	print $fh "<a href='/'>← Back to the index</a>";
106 	print $fh " or ";
107 	print $fh "<a href='/thread/$tid.html#$mid'>→ go to the thread</a>.";
108 	print $fh "</p>";
109 	print $fh "<dl>";
110 	while (<$mshow>) {
111 		chomp;
112 		say $text $_;
113 		last if /^$/;
114 		my ($h, $v) = m/^([-A-Za-z]+): (.*)/;
115 		die "bogus line? $fname : $_" unless (defined $h and defined $v);
116 
117 		# drop the (1 day ago) string
118 		$v =~ s/\(.*\)//g if ($h eq "Date");
119 
120 		print $fh "<dt>", san($h), ":</dt>";
121 		print $fh "<dd>", san($v), "</dd>";
122 	}
123 	print $fh "</dl>";
124 	print $fh "<p>Raw <a href='/mbox/$mid.mbox'>message</a>";
125 	print $fh " or <a href='/text/$mid.txt'>body</a>.</p>";
126 	print $fh "</header>";
127 
128 	my $body = do {
129 		local $/ = undef;
130 		<$mshow>;
131 	};
132 
133 	print $fh "<pre>";
134 	print $fh san($body // "");
135 	print $fh "</pre>";
136 
137 	print $text $body;
138 
139 	# generate the listing for the exported parts
140 	my $part_seen = 0;
141 	while (<$parts>) {
142 		if (!$part_seen) {
143 			$part_seen = 1;
144 			say $fh "<ul class='parts'>";
145 		}
146 		print $fh $_;
147 	}
148 	say $fh "</ul>" if $part_seen;
149 
150 	print $fh $foot;
151 
152 	close($text);
153 	close($mshow);
154 	close($parts);
155 	close($fh);
156 
157 	# exit(0);
158 }
159 
160 unlink "parts.html";