#!@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-2021 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;
}