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