#!/afs/athena/contrib/perl/p

require 'network.pl';		# Deal with net i/o, yech
require 'children.pl';		# Deal with children
$debug = 0;
$fhq = 'SILKAA';
for $n (1..40){
    push(@my_fh_list, $fhq);
    $fhq++;
}

# Read in configuration
&read_configuration();		# Written, sort of

# Setup sockets
&setup_sockets();		# Written

# Have some babies to fetch files and run scripts and stuff
# and put them on the 'ready to work' list (@idle_children)
&init_children();		# Written
print("Ready\n\r") if $debug;
while(1){
    # Listen to:
    #     Children who are getting stuff
    #     Clients that are asking for something
    #     New client requests
    $rin = &make_bitmask(@busy_fetcher_children,
			 @busy_runner_children,
			 @talking_clients,@ports);
    $win = &make_bitmask(@listening_clients);
    $found = select($rin, $win, undef, 1);

    #  If there is something to be done, do it
    if($found){
#	print("Aha, I have something to do ($found)\n\r") if ($debug);
#	print(&print_bits($rin), "\n") if $debug;
#	print(&print_bits($win), "\n") if $debug;
	# Deal with Clients that are already talking first
	$client_num = 0;
	@were_talking_clients = @talking_clients;
	$offset = 0;
	for $talkc (@were_talking_clients){
	    if(vec($rin, fileno($talkc),1)){
		print("Reading request from $talkc\n\r") if $debug;
		# Read the request
		$amount_read = sysread($talkc, $data, 4096);
		$fullrequest{$talkc} .= $data;
		if($fullrequest{$talkc} =~ /\n\r*\n\r*/){
		    # We have a complete request
		    ($requestline, @headers) = 
			split("\n", $fullrequest{$talkc});
		    ($method, $url, $proto) = split(' ', $requestline);
		    if($method eq "GET"){
			# Ask fetcher Child should return a filehandle
			# that corresponds to the child
			print("Asking child for client $talkc\n\r") if $debug;
			$childs_client{&ask_fetcher_child($url)} = $talkc;
			print("Uh: $talkc\n\r") if $debug;
			# Make the client a listening client
			# This evilness is due to perl losing track of the
			# refcounts on talkc when the splice takes place
			# Yuck!
			splice(@talking_clients, $client_num-$offset, 1);
			$offset++;
			print("Talkb $talkc\n\r") if $debug;
			print("Uh2: $talkc\n\r") if $debug;
			push(@listening_clients, $talkc);
			print("Uh3: $talkc\n\r") if $debug;
			print("$talkc is waiting...\n\r") if $debug;

		    }
		}
		else{
		    # We don't have a complete request yet
		    # ignore it...
		}
	    }
	    $client_num++;
	}


	# Deal with new client requests next
	for $p (@ports){
	    if(vec($rin, fileno($p), 1)){
		print("Dealing with a new connections\n\r") if $debug;
		# Put him on the list of clients to listen to
		&new_connection($p);
	    }
	}

	# Deal with children last
	$child_num = 0;
	@were_busy_fetcher_children=@busy_fetcher_children;
	$offset = 0;
	for $fc (@were_busy_fetcher_children){
	    ### If we have data put it in the response...
	    if(vec($rin, fileno($fc), 1)){
		print("Reading from a child\n\r") if $debug;
		$amount_read = sysread($fc, $data, 4096);
		# Store the response
		$response{$childs_client{$fc}} .= $data;
#		($blorgh = $data) =~ s/\001/-\*-/g;
#		print("Read \"$blorgh\"\n\r") if $debug;
		if(substr($response{$childs_client{$fc}},
			  length($response{$childs_client{$fc}})-2,
			  2) eq "\001\000"){
		    # Finished with the response
		    # Add headers and stuff
		    $response{$childs_client{$fc}} =~ s/\001\001/\001/g;
		    $header = &get_header("text/html", 
					  length($response{$childs_client{$fc}}));
		    $response{$childs_client{$fc}} = 
			$header.$response{$childs_client{$fc}};
		    print("Got a full response for $childs_client{$fc}\n\r") if $debug;

		    $status{$childs_client{$fc}} = 1;
		    splice(@busy_fetcher_children, $child_num-$offset, 1);
		    $offset++;
		    push(@idle_fetcher_children, $fc);
		}
	    }
	    $child_num++;
	}
	for $rc (@busy_runner_children){
	    ### Yeah, yeah
	}

	# Actually deal with serving responses last :-)
	for $lc (@listening_clients){
	    if(vec($win, fileno($lc),1) && $status{$lc}){
		print("I have a response\n\r") if $debug;
		$wrote = syswrite($lc, $response{$lc}, length($response{$lc}));
		$response{$lc} = substr($response{$lc}, $wrote);
		if(!length($response{$lc})){
		    close($lc);
		    &checkin_filehandle($lc);
		    $status{$lc} = 0;
		}
	    }
	}

    }
}


sub make_bitmask {
    local(@fhs) = @_;
    local($bitmask);

    for $f (@fhs){
	vec($bitmask, fileno($f), 1) = 1;
    }
    $bitmask;
}

sub read_configuration {
    # We don't need no stinkin' configuration yet

    @port_numbers = ($ARGV[0]);
}

sub print_bits {
    local($bits) = @_;
    for $n (0..8){
	print(vec($bits, $n, 1));
    }
}

sub get_header {
    local($type, $len) = @_;
    $ret =<<HeaderEnd;
HTTP/1.0 200 OK
Content-type: $type
Content-length: $len

HeaderEnd
    $ret;
}