# ! /usr/bin/perl -Tw
use strict;
use IO::Socket;
use Net::hostent;
my ( $name, $password ) = ( "webmaster", "bert" );
my ( $client, $hostinfo, $page );
my ( $header, $post_vars, $cnt ) = ( undef, undef, 0 );
my $PORT = 9000;
my $server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1 );
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
$page->{a} = <<'EOT_A;';
Page A
Page A
Go to page B!
EOT_A;
$page->{b} = <<'EOT_B;';
Page B
Page B
Go to page C!
EOT_B;
$page->{c} = <<'EOT_C;';
Page C
Page C
Go to page A!
EOT_C;
$page->{d} = <<'EOT_D;';
Page D
Page D
Go to page A!
EOT_D;
sub send_client
{
print $client @_;
print $client "\015\012";
} # send_client
sub parse_page
{
my ( $content ) = @_;
if ( $content =~ /(<\?perl(.*)\?>)/s )
{
local $ENV{ 'PATH' } = "/usr/bin:/bin";
my $retval = `perl -Mstrict -e '$2' 2>&1`;
$content = $` . $retval . $';
}
$content;
} # parse_page
sub serve_page
{
my ( $content ) = parse_page @_;
if ( $header->{ name } eq $name and $header->{ password } eq $password )
{
send_client "HTTP/1.0 200 OK";
}
else
{
send_client "HTTP/1.0 401 Unauthorized";
send_client "WWW-Authenticate: Basic realm=\"Wiskas\"";
}
local $ENV{PATH} = "/bin:/usr/bin";
my $time = `date -R`; chomp $time;
send_client "Date: $time";
send_client "Server: $0";
send_client "Content-length: " . length( $content ) || 0;
send_client "Connection: close";
send_client "Expires: $time";
send_client "Cache-control: no-store";
send_client "Content-type: text/html";
send_client "";
send_client $content;
} # serve_page
sub decode_base64
{
# Routine written by Mark A. Hershberger
my ( $str, $res, $len ) = ( shift, "", 0 );
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
$str =~ s/=_$//; # remove padding
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
while ( $str =~ /(.{1,60})/gs )
{
$len = chr( 32 + length( $1 ) * 3/4 ); # compute length byte
$res .= unpack( "u", $len . $1 ); # uudecode
}
$res;
} # decode_base64
while ( $client = $server->accept() )
{
$client->autoflush( 1 );
$hostinfo = gethostbyaddr( $client->peeraddr );
printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
while ( <$client> )
{
for ( $_ )
{
/^(GET|POST) \/(.*) HTTP\/\d\.\d/ && do
{
$header->{ method } = $1;
$header->{ document } = $2 || "a";
next;
};
/^(.+?): (.+)\r\n$/ && do
{
print "[$1] = [$2]\n";
if ( $1 eq "Authorization" )
{
my ( undef, $base64 ) = ( $2 =~ m/(\w+) (.+)/ );
if ( decode_base64( $base64 ) =~ m/(\w+):(\w+)/ )
{
$header->{ name } = $1;
$header->{ password } = $2;
}
}
else { $header->{ $1 } = $2; }
next;
};
/^(.+)=(.+)$/ && do
{
next unless $header->{ method } eq "POST";
$post_vars->{ $1 } = $2;
next;
};
/^\s*$/ && do
{
if ( $page->{ $header->{ document } } )
{ serve_page $page->{ $header->{ document } }; }
else
{ serve_page "404" .
"404: Not found!
" };
next;
};
}
}
close $client;
}
### END ###