Blame


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