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      alt='"GOT", but the "O" is a cute, smiling sun' />
31 EOF
32 
33 sub san {
34 	my $str = shift;
35 	$str =~ s/&/\&amp;/g;
36 	$str =~ s/</\&lt;/g;
37 	$str =~ s/>/\&gt;/g;
38 	return $str;
39 }
40 
41 sub genmbox {
42 	my ($fname, $mid) = @_;
43 
44 	open(my $fh, ">", "$outdir/mbox/$mid.mbox")
45 	    or die "can't open $outdir/mbox/$mid.mbox: $!";
46 
47 	my $pid = fork();
48 	die "fork: $!" unless defined $pid;
49 	if ($pid == 0) {
50 		open \*STDOUT, '>&', $fh;
51 		exec('mexport', $fname)
52 		    or die "exec mexport: $!";
53 	}
54 	die "waitpid: $!" if waitpid($pid, 0) == -1;
55 	die "mexport failed with $?" if $? != 0;
56 	# waitpid($pid, 0);
57 }
58 
59 my $tid;
60 while (<>) {
61 	chomp;
62 	say; # continue the pipeline
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 	next if -f "$outdir/$mid.html";
77 
78 	my $level = length($indent) - 1;
79 	$level = 10 if $indent =~ m/\.\.\d{2}\.\./;
80 
81 	$tid = $mid if $level == 0;
82 
83 	genmbox($fname, $mid);
84 
85 	my $dest = "$outdir/$mid.html";
86 	open(my $fh, '>', "$dest") or die "can't open $dest: $!";
87 
88 	say $fh $hdr =~ s/TITLE/$subj/r;
89 
90 	# prepare the parts listing file
91 	$ENV{'MESSAGE_ID'} = $mid;
92 	open(my $parts, '+>', "parts.html")
93 	    or die "can't create parts.html: $!";
94 
95 	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $fname)
96 	    or die "can't exec mshow: $!";
97 
98 	open(my $text, '>', "$outdir/text/$mid.txt")
99 	    or die "can't open $outdir/text/$mid.txt: $!";
100 
101 	print $fh "<header class='mail-header'>";
102 	print $fh "<p>";
103 	print $fh $logo;
104 	print $fh "<a href='/'>← Back to the index</a>";
105 	print $fh " or ";
106 	print $fh "<a href='/thread/$tid.html#$mid'>→ go to the thread</a>.";
107 	print $fh "</p>";
108 	print $fh "<dl>";
109 	while (<$mshow>) {
110 		chomp;
111 		say $text $_;
112 		last if /^$/;
113 		my ($h, $v) = m/^([-A-Za-z]+): (.*)/;
114 		die "bogus line? $fname : $_" unless (defined $h and defined $v);
115 
116 		# drop the (1 day ago) string
117 		$v =~ s/\(.*\)//g if ($h eq "Date");
118 
119 		print $fh "<dt>", san($h), ":</dt>";
120 		print $fh "<dd>", san($v), "</dd>";
121 	}
122 	print $fh "</dl>";
123 	print $fh "<p>Raw <a href='/mbox/$mid.mbox'>message</a>";
124 	print $fh " or <a href='/text/$mid.txt'>body</a>.</p>";
125 	print $fh "</header>";
126 
127 	my $body = do {
128 		local $/ = undef;
129 		<$mshow>;
130 	};
131 
132 	print $fh "<pre>";
133 	print $fh san($body // "");
134 	print $fh "</pre>";
135 
136 	print $text $body;
137 
138 	# generate the listing for the exported parts
139 	my $part_seen = 0;
140 	while (<$parts>) {
141 		if (!$part_seen) {
142 			$part_seen = 1;
143 			say $fh "<ul class='parts'>";
144 		}
145 		print $fh $_;
146 	}
147 	say $fh "</ul>" if $part_seen;
148 
149 	print $fh $foot;
150 
151 	close($text);
152 	close($mshow);
153 	close($parts);
154 	close($fh);
155 
156 	# exit(0);
157 }
158 
159 unlink "parts.html";