Blob


1 #!/usr/bin/env perl
3 use open ":std", ":encoding(UTF-8)";
4 use utf8;
5 use strict;
6 use warnings;
7 use v5.32;
9 my $outdir = $ENV{'OUTDIR'};
10 die 'Set $OUTDIR' unless defined $outdir;
11 mkdir $outdir;
13 my $hdr = do {
14 local $/ = undef;
15 open my $fh, "<", "head.html"
16 or die "can't open head.html: $!";
17 <$fh>;
18 };
20 my $foot = do {
21 local $/ = undef;
22 open my $fh, "<", "foot.html"
23 or die "can't open foot.html: $!";
24 <$fh>;
25 };
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
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 }
41 sub genmbox {
42 my ($fname, $mid) = @_;
44 open(my $fh, ">", "$outdir/mbox/$mid.mbox")
45 or die "can't open $outdir/mbox/$mid.mbox: $!";
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 }
59 my $tid;
60 while (<>) {
61 chomp;
62 say; # continue the pipeline
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+$//;
71 $mid =~ s,_,__,g;
72 $mid =~ s,/,_,g;
74 chomp($mid);
76 next if -f "$outdir/$mid.html";
78 my $level = length($indent) - 1;
79 $level = 10 if $indent =~ m/\.\.\d{2}\.\./;
81 $tid = $mid if $level == 0;
83 genmbox($fname, $mid);
85 my $dest = "$outdir/$mid.html";
86 open(my $fh, '>', "$dest") or die "can't open $dest: $!";
88 say $fh $hdr =~ s/TITLE/$subj/r;
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: $!";
95 open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $fname)
96 or die "can't exec mshow: $!";
98 print $fh "<header class='mail-header'>";
99 print $fh "<p>";
100 print $fh $logo;
101 print $fh "<a href='/'>← Back to the index</a>";
102 print $fh " or ";
103 print $fh "<a href='/thread/$tid.html#$mid'>→ go to the thread</a>.";
104 print $fh "</p>";
105 print $fh "<dl>";
106 while (<$mshow>) {
107 chomp;
108 last if /^$/;
109 my ($h, $v) = m/^([-A-Za-z]+): (.*)/;
110 die "bogus line? $fname : $_" unless (defined $h and defined $v);
112 # drop the (1 day ago) string
113 $v =~ s/\(.*\)//g if ($h eq "Date");
115 print $fh "<dt>", san($h), ":</dt>";
116 print $fh "<dd>", san($v), "</dd>";
118 print $fh "</dl>";
119 print $fh "<p><a href='/mbox/$mid.mbox'>Raw message</a></p>";
120 print $fh "</header>";
122 my $body = do {
123 local $/ = undef;
124 <$mshow>;
125 };
127 print $fh "<pre>";
128 # print $fh san($_) while <>;
129 print $fh san($body // "");
130 print $fh "</pre>";
132 # generate the listing for the exported parts
133 my $part_seen = 0;
134 while (<$parts>) {
135 if (!$part_seen) {
136 $part_seen = 1;
137 say $fh "<ul class='parts'>";
139 print $fh $_;
141 say $fh "</ul>" if $part_seen;
143 print $fh $foot;
145 close($mshow);
146 close($parts);
147 close($fh);
149 # exit(0);
152 unlink "parts.html";