#!/usr/bin/perl5.8.6
#
# SAINT CGI script for interfacing with existing
# web server. Place this script in the web server's
# cgi-bin directory.
#
# by Sam Kline, 9/2001
# Copyright 2001  World Wide Digital Security, Inc.
#
$SAINT_DIR = "/mnt/gmirror/ports/security/saint/work/saint-3.5.8";

&error("SAINT directory not found: $SAINT_DIR") unless -d "$SAINT_DIR";
&error("saint.cf not found") unless -f "$SAINT_DIR/config/saint.cf";

require "$SAINT_DIR/config/saint.cf";
require "$SAINT_DIR/config/paths.pl";

# Check for illegal characters in pipe names
&error("Illegal characters in \$query_pipe")
	if $query_pipe =~ /([^\w\.\-]|\.\.)/;
&error("Illegal characters in \$response_pipe")
	if $response_pipe =~ /([^\w\.\-]|\.\.)/;

$client_addr = $ENV{'REMOTE_ADDR'};
$method = $ENV{'REQUEST_METHOD'};
$url = $ENV{'REQUEST_URI'};
$http_version = $ENV{'SERVER_PROTOCOL'};
$this_script = $ENV{'SCRIPT_NAME'};

# Check that query pipe has been created
&error("Missing pipe: be sure SAINT is running with -w option")
    unless (-p "$SAINT_DIR/$query_pipe");

# Create response pipe
if (-x "$MKFIFO") {
    system($MKFIFO, "/tmp/$response_pipe.$$")
    && &error("Cannot create named pipe /tmp/$response_pipe.$$");
} elsif (-x "$MKNOD") {
    system($MKNOD, "/tmp/$response_pipe.$$", "p")
    && &error("Cannot create named pipe /tmp/$response_pipe.$$");
} else {
    &error("Cannot execute $MKNOD or $MKFIFO");
}

# Adjust the URL
$url =~ s/$this_script//;
$url = "/" if $url eq "";
$post = ($method =~ /^POST/i) ? 1:0;

# Set the restart point in case we get hung later on
restart:

# Open the query pipe to send the query to SAINT
open(QUERY, "> $SAINT_DIR/$query_pipe")
    || &error("Could not open named pipe: $SAINT_DIR/$query_pipe");
# Send the process ID, which is used to identify the pipe
print QUERY "$$\n";
# Send the client's IP address
print QUERY "$client_addr\n";
# Send the HTTP request
print QUERY "$method $url $http_version\n";
print QUERY "Content-length: $ENV{'CONTENT_LENGTH'}\n" if $post;
print QUERY "\n";
# Send the HTTP POST data
if ($post) {
    while(<>) {
	print QUERY;
    }
}
close QUERY;

# Open the response pipe, and make sure we're not hung
eval {
    local $SIG{'ALRM'} = sub { die "response pipe hung" };
    alarm 5;
    open(RESPONSE, "< /tmp/$response_pipe.$$")
	|| &error("Could not open named pipe: /tmp/$response_pipe.$$");
    alarm 0;
};
goto restart if $@ =~ /response pipe hung/;

$http_server = "http_server";
$i = 0;
# Sift through the HTTP headers
while(($_ = <RESPONSE>) =~ /\S/) {
    print if /Content-type:/;
    $http_server = $1 if /^HTTP-server: (http:\/\/[^\/]+)/;
    $i++;
}
print "\n";
# Send response to client
while(<RESPONSE>) {
    # When output is slow (i.e. saint_run_action.pl), pipes
    # on some systems re-send first few lines with each new
    # line. Catch it here.
    if (/^HTTP-server:/) {
	$i--;
	for ($j=0; $j<=$i; $j++) {
	    <RESPONSE>
	}
    } else {
	s/$http_server/$this_script/g;
	print;
	$i++;
    }
}
close RESPONSE;
unlink("/tmp/$response_pipe.$$");

sub error {
    my($msg) = shift;

    print "Content-type: text/html\n\n";
    print "<H2>Error</H2>\n$msg\n";
    exit;
}