Listing 2: The complete GUI program

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

# End of file