postfix-sender-login: pre-fork 2 servers.

On Linux perl's allow multiple children to block in a call to accept(2)
so we don't need to place a lock around the call.

1 files changed, 41 insertions, 28 deletions

diff --git a/roles/MSA/files/usr/local/bin/postfix-sender-login.pl b/roles/MSA/files/usr/local/bin/postfix-sender-login.pl
index 58cbf9d..987482e 100755
--- a/roles/MSA/files/usr/local/bin/postfix-sender-login.pl
+++ b/roles/MSA/files/usr/local/bin/postfix-sender-login.pl
@@ -17,79 +17,92 @@
 #
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 #----------------------------------------------------------------------
 
 use warnings;
 use strict;
 
 use Errno 'EINTR';
 use Socket qw/PF_UNIX SOCK_STREAM SHUT_RDWR/;
 
 use Net::LDAPI ();
 use Net::LDAP::Util qw/ldap_explode_dn escape_dn_value escape_filter_value/;
 use Net::LDAP::Constant qw/LDAP_NO_SUCH_OBJECT/;
 use Authen::SASL ();
 
 # clean up PATH
 $ENV{PATH} = join ':', qw{/usr/bin /bin};
 delete @ENV{qw/IFS CDPATH ENV BASH_ENV/};
 
-# returned for forbidden envelope sender addresses
-my $POSTMASTER = 'postmaster@fripost.org';
+my $nProc      = 2;                        # number of pre-forked servers
+my $POSTMASTER = 'postmaster@fripost.org'; # returned for forbidden envelope sender addresses
+
+my $BASEDN  = 'ou=virtual,dc=fripost,dc=org';
+my $BUFSIZE = 65536; # try to read that many bytes at the time
+my $LDAPI   = 'ldapi://%2Fvar%2Fspool%2Fpostfix-msa%2Fprivate%2Fldapi/';
+sub server();
+
 
 # fdopen(3) the file descriptor FD
 die "This service must be socket-activated.\n"
     unless defined $ENV{LISTEN_PID} and $ENV{LISTEN_PID} == $$
        and defined $ENV{LISTEN_FDS} and $ENV{LISTEN_FDS} == 1;
 open my $S, '+<&=', 3 or die "fdopen: $!";
 
-my $BASEDN  = 'ou=virtual,dc=fripost,dc=org';
-my $BUFSIZE = 65536; # try to read that many bytes at the time
-my $LDAPI   = 'ldapi://%2Fvar%2Fspool%2Fpostfix-msa%2Fprivate%2Fldapi/';
-sub process_request($);
-
-while(1) {
-    accept(my $conn, $S) or do {
-        # try again if accept(2) was interrupted by a signal
-        next if $! == EINTR;
-        die "accept: $!";
-    };
-    my $reply = process_request($conn);
-
-    # encode the reply as a netstring and send it back
-    # https://cr.yp.to/proto/netstrings.txt 
-    $reply = length($reply).':'.$reply.',';
-    my $len = length($reply);
-
-    for (my $i = 0; $i < $len;) {
-        my $n = syswrite($conn, $reply, $len-$i, $i) // do {
-            warn "Can't write: $!";
-            last;
-        };
-        $i += $n;
+for (my $i = 0; $i < $nProc-1; $i++) {
+    my $pid = fork() // die "fork: $!";
+    unless ($pid) {
+        server(); # child, never return
+        exit;
     }
-    close $conn or warn "Can't close: $!";
 }
+server();
+
 
 #############################################################################
 
+sub server() {
+    while(1) {
+        accept(my $conn, $S) or do {
+            # try again if accept(2) was interrupted by a signal
+            next if $! == EINTR;
+            die "accept: $!";
+        };
+        my $reply = process_request($conn);
+
+        # encode the reply as a netstring and send it back
+        # https://cr.yp.to/proto/netstrings.txt
+        $reply = length($reply).':'.$reply.',';
+        my $len = length($reply);
+
+        for (my $i = 0; $i < $len;) {
+            my $n = syswrite($conn, $reply, $len-$i, $i) // do {
+                warn "Can't write: $!";
+                last;
+            };
+            $i += $n;
+        }
+        close $conn or warn "Can't close: $!";
+    }
+}
+
 sub process_request($) {
     my $conn = shift;
     my ($buf, $offset) = (undef, 0);
 
     # keep reading until the request length is determined
     do {
         my $n = sysread($conn, $buf, $BUFSIZE, $offset) // return "TEMP can't read: $!";
         return "TEMP EOF" if $n == 0;
         $offset += $n;
     } until ($buf =~ /\A(0|[1-9][0-9]*):/);
 
     # keep reading until the whole request is buffered
     my $strlen = length("$1") + 1; # [len]":"
     my $len = $strlen + $1 + 1;    # [len]":"[string]","
     while ($offset < $len) {
         my $n = sysread($conn, $buf, $BUFSIZE, $offset) // return "TEMP can't read: $!";
         return "TEMP EOF" if $n == 0;
         $offset += $n;
     }
 
@@ -108,41 +121,41 @@ sub process_request($) {
     $ldap->bind( undef, sasl => Authen::SASL::->new(mechanism => 'EXTERNAL') )
         or return "TEMP LDAP: couldn't bind";
 
     my $reply = lookup_sender($ldap, $localpart, $domainpart);
     $ldap->unbind();
     return $reply;
 }
 
 sub lookup_sender($$$) {
     my ($ldap, $l, $d) = @_;
 
     my $filter = '(&(objectClass=FripostVirtualDomain)(fvd='.escape_filter_value($d).'))';
     my $mesg = $ldap->search( base => $BASEDN, scope => 'one', deref => 'never'
                             , filter => $filter
                             , attrs => [qw/objectClass fripostOwner fripostPostmaster/]
                             );
     return "TEMP LDAP error: ".$mesg->error() if $mesg->code;
     my $entry = $mesg->pop_entry() // return "NOTFOUND "; # not a domain we know
     return "TEMP LDAP error: multiple entry founds" if defined $mesg->pop_entry(); # sanity check
 
-    # domain postmasters are allowed to use any sender address 
+    # domain postmasters are allowed to use any sender address
     my @logins = $entry->get_value('fripostPostmaster', asref => 0);
     my @owners = $entry->get_value('fripostOwner', asref => 0);
 
     if (grep { $_ eq 'FripostVirtualAliasDomain' } $entry->get_value('objectClass', asref => 0)) {
         # so are alias domain owners
         push @logins, @owners;
     } else {
         my $dn = 'fvd='.escape_dn_value($d).','.$BASEDN;
         my $filter = '(&(|(objectClass=FripostVirtualAlias)(objectClass=FripostVirtualList)(objectClass=FripostVirtualUser))(fvl='.escape_filter_value($l).'))';
         my $mesg = $ldap->search( base => $dn, scope => 'one', deref => 'never'
                                 , filter => $filter
                                 , attrs => [qw/objectClass fripostOwner/]
                                 );
         unless ($mesg->code == 0 and defined ($entry = $mesg->pop_entry())) {
             # domains owners are allowed to use any unkwown localpart as sender address
             push @logins, @owners;
         } else {
             return "TEMP LDAP error: multiple entry founds" if defined $mesg->pop_entry(); # sanity check
             if (grep { $_ eq 'FripostVirtualUser' } $entry->get_value('objectClass', asref => 0)) {
                 push @logins, $entry->dn();