mexp

#!/usr/bin/env perl
#
# mexp was written by Omar Polo <op@openbsd.org> and is placed in the
# public domain.  The author hereby disclaims copyright to this source
# code.

use open ":std", ":encoding(UTF-8)";
use utf8;
use strict;
use warnings;
use v5.32;

use List::Util qw(max min);

use SMArc qw(parse san urlencode initpage endpage thread_header
    threntry thrslice thrnav);

my $outdir = $ENV{'OUTDIR'};
die 'Set $OUTDIR' unless defined $outdir;

if (`uname` =~ "OpenBSD") {
	use OpenBSD::Pledge;
	use OpenBSD::Unveil;

	unveil("/usr/local/bin/mshow", "rx") or die "unveil mshow: $!";
	unveil($outdir, "rwc") or die "unveil $outdir: $!";

	pledge("stdio rpath wpath cpath proc exec") or die "pledge: $!";
}

sub export_part {
	my ($fh, $n, $fname) = @_;

	my $pid = fork;
	die "fork: $!" unless defined $pid;
	if ($pid == 0) {
		open \*STDOUT, '>&', $fh
		    or die "can't redirect stdout: $!";
		exec 'mshow', '-F', '-O', $fname, $n
		    or die "can't exec mshow: $!";
	}

	waitpid $pid, 0;
	die "mshow exited with $? ($n, $fname)" if $?;
}

# like libutil' fmt_scaled
sub humanize {
	my $number = shift;
	my @units = qw(             G          M     K  B);
	my @scale =   (1024*1024*1024, 1024*1024, 1024, 1);

	for (my $i = 0; $i < @scale; $i++) {
		if ($scale[$i] <= $number) {
			my $r = $number / $scale[$i];
			return sprintf "%.0f%s", $r, $units[$i];
		}
	}
	return "0B"
}

sub export_one {
	my ($mail, $prev, $next) = @_;
	my $dest = "$outdir/mail/$mail->{mid}.html";

	open(my $fh, '>', "$dest") or die "can't open $dest: $!";

	initpage $fh, $mail->{subj};

	open(my $mshow, "-|", "mshow", "-nNA", "text/plain", $mail->{fname})
	    or die "can't exec mshow: $!";

	open(my $text, '>', "$outdir/text/$mail->{mid}.txt")
	    or die "can't open $outdir/text/$mail->{mid}.txt: $!";

	my @hdrs;
	while (<$mshow>) {
		last if /^$/;

		# drop the (1 day ago) string
		s/ \(.*\)// if /^Date:/;
		print $text $_;
		push @hdrs, san($_);
	}
	say $text "";

	thread_header $fh, \@hdrs, $mail, $prev, $next;

	print $fh "<pre>";
	while (<$mshow>) {
		print $text $_;
		print $fh san($_);
	}
	print $fh "</pre>";

	# generate the listing for the exported parts
	open(my $parts, '-|', 'mshow', '-t', $mail->{fname})
	    or die "can't exec mshow: $!";

	my $partno = 0;
	while (<$parts>) {
		my ($n, $mime, $size, $name) =
		    m/(\d+): ([^ ]+) size=(\d+) name="(.*)"/ or next;

		next if $mime =~ m(application/pgp-signature);
		next if $mime =~ m(audio/*);
		next if $mime =~ m(video/*);

		my $ext = "bin";
		if ($mime =~ m(image/*)) {
			if ($mime eq "image/gif") {
				$ext = "gif";
			} elsif ($mime eq "image/jpeg") {
				$ext = "jpg";
			} elsif ($mime eq "image/png") {
				$ext = "png";
			} else {
				# skip other image types for now.
				next;
			}
		}

		# text/* is bundled in the body by mshow(1).

		say $fh "<ul class='parts'>" if $partno == 0;
		$partno++;

		my $path = "$outdir/parts/$mail->{mid}.$partno.$ext";
		open my $p, '>', $path
		    or die "can't open $mail->{fname}: $!";
		export_part($p, $n, $mail->{fname});
		close($p);

		$path =~ s,^.*/parts/,/parts/,;

		my $url = san($path);
		my $hs = humanize $size;
		say $fh "<li><a href='$url'>$name ($hs)</a></li>";
	}
	say $fh "</ul>" if $partno > 0;

	thrnav $fh, $prev, $next;
	thrslice $fh, $mail, $prev, $next;

	endpage $fh;

	close($text);
	close($mshow);
	close($parts);
	close($fh);

	unlink $parts;
}

sub export {
	my @thread = @_;

	for (my $i = 0; $i < @thread; $i++) {
		my (@prev, @next);
		@prev = @thread[max($i-2, 0)..$i-1] if $i > 0;
		@next = @thread[$i+1..min($i+2, @thread - 1)]
		    if $i + 1 < @thread;
		export_one $thread[$i], \@prev, \@next;
	}
}

my $tid;
my @thread;
while (<>) {
	my $mail = parse $_;

	if ($mail->{level} == 0 && @thread) {
		export @thread;
		@thread = ();
	}

	$tid = $mail->{mid} if $mail->{level} == 0;
	die "unknown tid" unless defined $tid;
	$mail->{tid} = $tid;

	# export_one $mail, $tid
	push @thread, $mail;
}

export @thread if @thread;