#
# htbin.pl	--- execute htbin scripts
#
# Package to execute scripts in /htbin (with URL path /htbin/script...).
#
# This package was developed to allow htbin scripts written for NCSA's
# httpd server to also run under Plexus.
#
# Passes $rest and $query to script and attempts to execute it.
# If either is missing, it will not be passed.
# In case only one of the two is present, scripts can distinguish $rest
# from $query since $rest must start with "/".
#
# Note that scripts should normally print "Content-type: text/html\n\n"
# at the beginning (or whatever the type should be, e.g., "image/gif").
# In any case, this package will pick up the type and print it in
# the MIME header, if needed.
#
# Scripts should not normally exit with non-zero status.
# If they do, a server error will be logged.
# (This will happen if the script contains errors.)
#
# Oscar Nierstrasz
# oscar@cui.unige.ch
# 28/10/93 -- first version
# 08/11/93 -- fixed treatment of MIME headers
#
# The following lines should be added to local.conf:
# load    htbin.pl
# map     htbin         htbin.pl &do_htbin($rest,$query)

package htbin;

sub main'do_htbin {
    local($rest,$query) = @_;
    ($rest =~ s|^([^/]*)||) && ($script = "htbin/$1");
    $query = join(" ", &main'splitquery($query));
    unless (-f $script) {
        &main'error('not_found', "do_exec: can't find $script");
        exit;
    }
    unless (-x $script) {
        &main'error('forbidden', "do_exec: can't execute $script");
        exit;
    }
    #
    # The fork/exec must be done by hand in order to detect errors,
    # and to pick up the Content-type (this will ONLY be printed in
    # the MIME header if the client is using HTTP 1.0).
    #
    pipe(CMDOUT,OUT); # pipes for scripts STDOUT and STDERR
    # parent: wait for script's output:
    if ($pid = fork) {
        close(OUT);
        local($/); # no record boundaries needed here
	#
	# NB: both STDOUT and STDERR are redirected to CMDOUT
	# to avoid the server deadlocking.
	#
	$out = <CMDOUT>;
	wait;
	if ($? != 0) {
            &main'error('internal_error',
                "do_exec: exec $script failed<BR>\n$out");
	    exit;
	}
	# extract the content-type, if the script returns it
	# NB: if other MIME header fields should be recognized,
	# this is the place to do it.
	if ($out =~ s/^Content-type: (.*)\n[\n]//) {
	    $content = $1;
	}
	else { $content = 'text/html'; }
	&main'MIME_header('ok',$content);
	print $out;
    } elsif (defined $pid) {
        # child: exec script
	# redirect stdout and stderr:
        close(CMDOUT);
        open(STDERR,">&OUT");
        open(STDOUT,">&OUT");
	close(OUT);
        select(STDOUT); $| = 1;
	# only pass $rest and $query if non-empty
	if ($rest eq "") {
	    if ($query eq "") { exec($script); }
	    else { exec($script, $query); }
	} else {
	    if ($query eq "") { exec($script, $rest); }
	    else { exec($script, $rest, $query); }
	}
	print STDERR "do_exec: can't exec $script\n$!";
	exit 1;
    } else {
        &main'error('internal_error',
            "do_exec: fork $script failed\n$!");
    }
}

1;