Listing 2

#!/usr/local/bin/perl 
 
# Generate a GUI via your Web Browser 
#  
# Author : Arthur Donkers 
#          Le Reseau netwerksystemen BV 
#          Burg. F. van Ankenweg 5 
#          NL-9991 AM Middelstum 
#          The Netherlands 
#          arthur@reseau.nl 
 
use Socket; 
 
%chartab = ( 
	'20' => ' ', 
	'21' => '!', 
	'22' => '\"', 
	'23' => '#', 
	'24' => '\$', 
	'25' => '%', 
	'26' => '\&', 
	'2B' => '+', 
	'2F' => '/' 
); 
 
sub	create_socket { 
 
	local( $sockaddr, $port, $proto, $me, $junk ); 
 
	$sockaddr = 'S n a4 x8'; 
 
	($junk, $junk, $port)  = getservbyname( "ontime", "tcp" ); 
	($junk, $junk, $proto) = getprotobyname( $protoname ); 
 
	$me = pack($sockaddr, &AF_INET, 1308, "\0\0\0\0"); 
 
	socket( SOCK, &AF_INET, &SOCK_STREAM, $proto ) || die "socket : $!"; 
	bind(SOCK, $me) || die "bind : $!"; 
} 
 
sub	wait_connect { 
 
	listen( SOCK, 1 ) || die "listen : $!"; 
 
	($addr = accept(CLIENT, SOCK)) || die "accept : $!"; 
} 
 
sub	do_req { 
 
	local($request, $command, $url, $script, $arglist, $contents, $junk); 
	local( %extras, @postargs, $decoded, $i ); 
 
	$request = <CLIENT>; 
	chop $request; 
 
print LOGFILE "$request\n"; 
 
	($command, $url) = split( /\s+/, $request ); 
	($junk, $script, $arglist) = split( /\//, $url, 3 ); 
 
	while( <CLIENT> ) { 
	    last if ( /^\s+$/ ); 
 
	    chop; 
 
print LOGFILE "$_\n"; 
 
	    if( /^Authorization:/ ) { 
		($junk, $extras{'authscheme'}, $extras{'authkey'}) = 
			split( /\s+/, $_, 3 ); 
	    } 
 
	    if( /^Content-length:/ ) { 
		($junk, $extras{'contentlength'}) = 
			split( /\s+/, $_, 2 ); 
	    } 
 
	} 
 
	if( $command eq "GET" ) { 
	    if( $script ne "" ) { 
	        &do_script( $script, %extras ); 
	    } 
	    else { 
		&do_script( "isps.pl", %extras ); 
	    } 
	} 
	elsif( $command eq "POST" ) { 
	    $contents = <CLIENT>; 
	    chop $contents; 
print LOGFILE "$contents\n"; 
	    @postargs = split /\&/, $contents; 
	    $i = 0; 
	    foreach $arg (@postargs) { 
		$arg =~ tr/\+/ /; 
		$arg =~ s/\%(..)/$chartab{$1}/eg; 
	    } 
	} 
 
} 
 
sub	do_script { 
 
	local( $script, %extras ) = @_; 
 
	if( need_authorisation( $script ) ) { 
	    if( exists $extras{'authkey'} ) { 
		$good = check_authorisation( $script, $extras{'authkey'} ); 
 
		if( $good ) { 
		    select(CLIENT); 
		    do $script; 
		    select(STDOUT); 
		} 
		else { 
		    &show_error( "Authorisation for $script failed\n" ); 
		} 
	    } 
	    else { 
	        &get_authorisation( "$script" ); 
	    } 
	} 
	else { 
	    select(CLIENT); 
	    do $script; 
	    select(STDOUT); 
	} 
 
} 
 
sub	get_authorisation { 
 
	local( $script ) = @_; 
	local( $curdate ); 
 
	open CURDATE, "date|"; 
	$curdate = <CURDATE>; 
	close CURDATE; 
 
	print CLIENT <<EOHTML 
HTTP/1.0 401 Unauthorized to access the document 
Date: $curdate 
Content-Type: text/html 
Last-Modified: $curdate 
WWW-Authenticate: Basic realm=$script 
 
EOHTML 
; 
 
} 
 
sub	check_authorisation { 
 
	local( $script, $key ) = @_; 
	local( $decoded, $user, $passwd, $crypted, $a, $b, $salt ); 
 
	&decode( $key, \$decoded ); 
	($user, $passwd) = split( /\:/, $decoded, 2 ); 
 
	open AUTHLIST, "<authdb"; 
 
	while( <AUTHLIST> ) { 
 
	    chomp; 
	    ($a, $b) = split( /\:/, $_, 2 ); 
 
	    if( $a eq $script ) { 
		if( $b =~ /\,/ ) { 
	            $found = grep( $_ eq $user, split( /\,/, $b ) ); 
		} 
		else { 
		    $found = $b; 
		} 
 
		return 0 if( $found ne $user ); 
		last; 
	    } 
	} 
	close AUTHLIST; 
 
	open PASSWD, "<passwd"; 
	while( <PASSWD> ) { 
	    chomp; 
	    ($a, $b) = split( /\:/, $_, 2 ); 
	    last if( $a eq $user ); 
	} 
	close PASSWD; 
 
	chomp $passwd; 
	$crypted = crypt $passwd, $b; 
 
	return 1 if( $crypted eq $b ); 
 
	return 0; 
 
} 
 
sub	need_authorisation { 
 
	local( $script ) = @_; 
	local( $authscript ); 
 
	if( open AUTHLIST, "<authdb" ) { 
	    while( <AUTHLIST> ) { 
	        last if( /^\s*$/ ); 
	        chop; 
	        chop; 
		($authscript, $users) = split( /\:/, $_, 2 ); 
	        if( $authscript eq $script ) { 
		    return 1; 
	        } 
	    } 
	    close AUTHLIST; 
	} 
	else { 
	    &show_error( "cannot open need_auth, error $!\n" ); 
	} 
 
	return 0; 
} 
 
sub	show_error { 
 
	local( $errmsg ); 
 
	print STDOUT $errmsg; 
} 
 
sub	decode { 
 
	local( $input, $output ) = @_; 
 
	open DECODE, "decode $input|"; 
	$$output = <DECODE>; 
	close DECODE; 
} 
 
# Start here 
&create_socket( ); 
 
while( 1 ) { 
	&wait_connect( ); 
	select(CLIENT);$|=1; 
	open LOGFILE, ">>reseaud.log"; 
	&do_req( ); 
	close LOGFILE; 
	close CLIENT; 
}
