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 SMArc qw(parse);
17 
18 my $jobs = $ENV{'MAKE_JOBS'} // 1;
19 
20 my $csumdir = $ENV{'CSUMDIR'};
21 die '$CSUMDIR undefined' unless defined $csumdir;
22 
23 my $poll = IO::Poll->new();
24 for (1..$jobs) {
25 	open(my $kid, '|-', 'mexp') or die "can't exec mexp: $!";
26 	$poll->mask($kid => POLLOUT);
27 }
28 
29 # get current thread checksum
30 sub thrsum {
31 	my $sha = Digest::SHA->new(256);
32 	$sha->add(encode('UTF-8', $_)) for @_;
33 	return $sha->hexdigest;
34 }
35 
36 # get stored thread checksum
37 sub oldsum {
38 	my $tid = shift;
39 	open my $fh, '<', "$csumdir/$tid" or return "";
40 	my $sum = <$fh>;
41 	chomp $sum;
42 	return $sum;
43 }
44 
45 # save thread checksum
46 sub savesum {
47 	my ($tid, $sum) = @_;
48 	open my $fh, '>', "$csumdir/$tid"
49 	    or die "can't open checksum file $csumdir/$tid: $!";
50 	say $fh $sum;
51 	close $fh;
52 }
53 
54 sub process {
55 	my @entries = @_;
56 
57 	return unless @entries;
58 
59 	my $mail = parse $entries[0];
60 	die "wtf?" if $mail->{level} != 0;
61 
62 	my $tid = $mail->{mid};
63 	my $thrsum = thrsum @_;
64 	my $oldsum = oldsum $tid;
65 	return if $thrsum eq $oldsum;
66 
67 	die "poll: $!" if $poll->poll() == -1;
68 	my @handles = $poll->handles(POLLOUT) or die "no procs ready?";
69 	my $handle = $handles[int(rand(@handles))];
70 	print $handle $_ foreach @entries;
71 
72 	savesum($tid, $thrsum);
73 }
74 
75 if (`uname` =~ "OpenBSD") {
76 	use OpenBSD::Pledge;
77 	use OpenBSD::Unveil;
78 
79 	unveil($csumdir, "rwc") or die "unveil $csumdir: $!";
80 	pledge("stdio rpath wpath cpath") or die "pledge: $!";
81 }
82 
83 my @thread;
84 while (<>) {
85 	print; # continue the pipeline
86 
87 	my $new_thread = m/^-/;
88 	if ($new_thread && @thread) {
89 		process @thread;
90 		@thread = ();
91 	}
92 
93 	push @thread, $_;
94 }
95 
96 process @thread if @thread;