1 #!/usr/bin/env perl
2 #
3 # pe was written by Omar Polo <op@openbsd.org> and is placed in the
4 # public domain.  The author hereby disclaims copyright to this source
5 # code.
6 
7 use open ":std", ":encoding(UTF-8)";
8 use strict;
9 use warnings;
10 use v5.32;
11 
12 use Digest::SHA;
13 use Encode qw(encode);
14 use IO::Poll qw(POLLOUT);
15 
16 use OpenBSD::Pledge;
17 use OpenBSD::Unveil;
18 
19 use lib ".";
20 use GotMArc qw(parse);
21 
22 my $jobs = $ENV{'MAKE_JOBS'} // 1;
23 
24 my $csumdir = $ENV{'CSUMDIR'};
25 die '$CSUMDIR undefined' unless defined $csumdir;
26 
27 my $poll = IO::Poll->new();
28 for (1..$jobs) {
29 	open(my $kid, '|-', './mexp') or die "can't exec ./mexp: $!";
30 	$poll->mask($kid => POLLOUT);
31 }
32 
33 # get current thread checksum
34 sub thrsum {
35 	my $sha = Digest::SHA->new(256);
36 	$sha->add(encode('UTF-8', $_)) for @_;
37 	return $sha->hexdigest;
38 }
39 
40 # get stored thread checksum
41 sub oldsum {
42 	my $tid = shift;
43 	open my $fh, '<', "$csumdir/$tid" or return "";
44 	my $sum = <$fh>;
45 	chomp $sum;
46 	return $sum;
47 }
48 
49 # save thread checksum
50 sub savesum {
51 	my ($tid, $sum) = @_;
52 	open my $fh, '>', "$csumdir/$tid"
53 	    or die "can't open checksum file $csumdir/$tid: $!";
54 	say $fh $sum;
55 	close $fh;
56 }
57 
58 sub process {
59 	my @entries = @_;
60 
61 	return unless @entries;
62 
63 	my $mail = parse $entries[0];
64 	die "wtf?" if $mail->{level} != 0;
65 
66 	my $tid = $mail->{mid};
67 	my $thrsum = thrsum @_;
68 	my $oldsum = oldsum $tid;
69 	return if $thrsum eq $oldsum;
70 
71 	die "poll: $!" if $poll->poll() == -1;
72 	my @handles = $poll->handles(POLLOUT) or die "no procs ready?";
73 	my $handle = $handles[int(rand(@handles))];
74 	print $handle $_ foreach @entries;
75 
76 	savesum($tid, $thrsum);
77 }
78 
79 unveil($csumdir, "rwc") or die "unveil $csumdir: $!";
80 pledge("stdio rpath wpath cpath") or die "pledge: $!";
81 
82 my @thread;
83 while (<>) {
84 	print; # continue the pipeline
85 
86 	my $new_thread = m/^-/;
87 	if ($new_thread && @thread) {
88 		process @thread;
89 		@thread = ();
90 	}
91 
92 	push @thread, $_;
93 }
94 
95 process @thread if @thread;