#!@PERL@

use Getopt::Std;
use Data::Dumper;
use FileHandle;
use IPC::Open2;
use Pod::Usage;

=pod

=head1 NAME

helper-mux - Concurrency protocol multiplexer for Squid helpers

=head1 SYNOPSIS

B<helper-mux> helper-path [helper-options ...]

=head1 DESCRIPTION

B<helper-mux> purpose is to relieve some of the burden
B<squid> has when dealing with slow helpers. It does so by acting as a
middleman between B<squid> and the actual helpers, talking to B<squid> via
the multiplexed variant of the helper protocol and to the helpers
via the non-multiplexed variant.

Helpers are started on demand, and in theory the muxer can handle up to
1k helpers per instance. It is up to B<squid> to decide how many helpers
to start.

The helper can be controlled using various signals:
- SIGHUP: dump the state of all helpers to STDERR

=head1 OPTIONS

=over 8

=item   B<helper-path>

Path to the helper being multiplexed.

=item   B<helper-options>

Command line options for the helper being multiplexed.

=back

=head1 KNOWN ISSUES

B<helper-mux> knows nothing about the actual messages being passed around,
and as such cannot yet compensate for broken helpers.

It is not yet able to manage dying helpers.

=head1 COPYRIGHT

 * Copyright (C) 1996-2023 The Squid Software Foundation and contributors
 *
 * Squid software is distributed under GPLv2+ license and includes
 * contributions from numerous individuals and organizations.
 * Please see the COPYING and CONTRIBUTORS files for details.

   Copyright (C) Francesco Chemolli <kinkie@squid-cache.org>

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.

=cut

#mux-ed format: "slot_num non_muxed_request"

# options handling
my %opts=();
$Getopt::Std::STANDARD_HELP_VERSION=1;
getopts('h', \%opts) or die ("unrecognized options");
if (defined $opts{h}) {
    HELP_MESSAGE();
    exit 0;
}
my $actual_helper_cmd=join(" ",@ARGV);

# variables initialization
my %helpers=();
my $helpers_running = 0;
my $rvec='';
vec($rvec,0,1)=1; #stdin
my $nfound;
my ($rd,$wr,$cl);

# signal handlers
$SIG{'HUP'}=\&dump_state;
$SIG{'CHLD'}=\&reaper;
# TODO: signal handling for child dying

# main loop
$|=1;
while(1) {
    print STDERR "selecting\n";
    $nfound=select($rd=$rvec,undef,undef,undef);
    #$nfound=select($rd=$rvec,undef,$cl=$rvec,undef);
    print STDERR "nfound: $nfound\n";
    if ($nfound == -1 ) {
        print STDERR "error in select: $!\n";
        if ($!{ERESTART} || $!{EAGAIN} || $!{EINTR}) {
            next;
        }
        exit 1;
    }
    #print STDERR "cl: ", unpack("b*", $cl) ,"\n";
    print STDERR "rd: ", unpack("b*", $rd) ,"\n";
    # stdin is special
    #if (vec($cl,0,1)==1) { #stdin was closed
    #    print STDERR "stdin closed\n";
    #    exit(0);
    #}
    if (vec($rd,0,1)==1) { #got stuff from stdin
        #TODO: handle leftover buffers? I hope that 40kb are enough..
        $nread=sysread(STDIN,$_,40960); # read 40kb
        # clear the signal-bit, stdin is special
        vec($rd,0,1)=0;
        if ($nread==0) {
            print STDERR "nothing read from stdin\n";
            exit 0;
        }
        foreach $req (split("\n",$_ )) {
            dispatch_request($req);
        }
    }
    # find out if any filedesc was closed
    if ($cl != 0) {
        #TODO: better handle helper restart
        print STDERR "helper crash?";
        exit 1;
    }
    #TODO: is it possible to test the whole bitfield in one go?
    #      != won't work.
    foreach $h (keys %helpers) {
        my %hlp=%{$helpers{$h}};
#print STDERR "examining helper slot $h, fileno $hlp{fno}, filemask ", vec($rd,$hlp{fno},1) , "\n";
        if (vec($rd,$hlp{fno},1)==1) {
            #print STDERR "found\n";
            handle_helper_response($h);
        }
        #no need to clear, it will be reset when iterating
    }
}

sub dispatch_request {
    my $line=$_[0];
    my %h;

    #print STDERR "dispatching request $_";
    $line =~ /^(\d+) (.*)$/;
    my $reqId=$1;
    my $req=$2;

    undef $h;
    # Find a free helper
    foreach $slot ( 1 .. ($helpers_running)) {
        if (!defined($helpers{$slot}->{lastcmd})) {
            $h = $helpers{$slot};
            last;
        }
    }
    # If none create one
    if (!defined($h)) {
        $helpers_running = $helpers_running + 1;
        $helpers{$helpers_running}=init_subprocess();
        $h = $helpers{$helpers_running};
        # print STDERR "Now $helpers_running helpers running\n";
    }

    $wh=$h->{wh};
    $rh=$h->{rh};
    $h->{lastcmd}=$req;
    $h->{reqId}=$reqId;
    print $wh "$req\n";
}

# gets in a slot number having got some response.
# reads the response from the helper and sends it back to squid
# prints the response back
sub handle_helper_response {
    my $h=$_[0];
    my ($nread,$resp);
    $nread=sysread($helpers{$h}->{rh},$resp,40960);
    #print STDERR "got $resp from slot $h\n";
    print $helpers{$h}->{reqId}, " ", $resp;
    delete $helpers{$h}->{lastcmd};
}

# a subprocess is a hash with members:
#  pid => $pid
#  rh => read handle
#  wh => write handle
#  fno => file number of the read handle
#  lastcmd => the command "in flight"
# a ref to such a hash is returned by this call
sub init_subprocess {
    my %rv=();
    my ($rh,$wh,$pid);
    $pid=open2($rh,$wh,$actual_helper_cmd);
    if ($pid == 0) {
        die "Failed to fork helper process";
    }
    select($rh); $|=1;
    select($wh); $|=1;
    select(STDOUT);
    $rv{rh}=$rh;
    $rv{wh}=$wh;
    $rv{pid}=$pid;
    $rv{fno}=fileno($rh);
    print STDERR "fileno is $rv{fno}\n";
    vec($rvec,$rv{fno},1)=1;
    return \%rv;
}

sub HELP_MESSAGE {
    print STDERR <<EOF
$0 options:
    -h this help message
   arguments:
    the actual helper executable and its arguments.
    it's advisable to prefix it with "--" to avoid confusion
EOF
}

sub dump_state {
    $SIG{'HUP'}=\&dump_state;
    print STDERR "Helpers state:\n",Dumper(\%helpers),"\n";
}

# finds and returns the slot number of a helper, -1 if not found
# args: - key in helpers
#       - value to look for
sub find_helper_slot {
    my ($k,$v) = @_;
    foreach (keys %helpers) {
        return $_ if $helpers{$k}==$v;
    }
    return -1;
}

sub reaper {
    my $child=wait;
    print STDERR "child $child died\n";
    $SIG{'CHLD'}=\&reaper;
    $slot = find_helper_slot('pid',$child);
    print STDERR "slot is $slot\n";
    #TODO: find the died child, if it was mid-process through a request
    #      send a "BH" to squid and de-init its data-structs here
    exit 1;
}