#!/usr/local/bin/perl -w

eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

## Simple webserver in Perl

## SYNOPSIS
##     ./wserv_med.pl 2345

## (c)1999 by Ronald Blaschke <rblasch@cs.bgsu.edu>

use strict;
use Socket;
use IO::Socket;

my $DOCUMENT_ROOT = $ENV{'HOME'} . "/public_html";

sub trim($) {
    $_[0] =~ s/^\s+//;
    $_[0] =~ s/\s+$//;
}

sub LOG(@) {
    print STDERR @_;
}

sub parse_form_data($) {
    my $data = $_[0];
    my %data;

    LOG "form data is:\n";
    foreach (split /&/, $data) {
	my ($key, $val) = split /=/;

	foreach ($key, $val) {
	    s/\+/ /;  ## restore blanks
	    s/%(..)/chr(hex($1))/eg;  ## restore escaped
	}

	LOG "$key = '$val'\n";
	push @{$data{$key}}, $val;
    }

    return %data;
}

my $port = shift;

if (!defined($port)) {
    die "No httpd port specified\n";
}

LOG "Starting httpd on port $port\n";
my $server = new IO::Socket::INET(Proto => 'tcp',
				  LocalPort => $port,
				  Listen => SOMAXCONN,
				  Reuse => 1);
die "Unable to create server socket: $!" unless $server;

while (my $client = $server->accept()) {
    $client->autoflush(1);

    my %request = ();
    {
	local $/ = Socket::CRLF;
	
	while (<$client>) {
	    chomp;
	    LOG "$.: '$_'\n";
	    ## headers
	    if (/\s*(\w+)\s*([^\s]+)\s*HTTP\/(\d.\d)/) {
		$request{METHOD} = uc $1;
		$request{URL} = $2;
		$request{HTTP_VERSION} = $3;
	    }
	    elsif (/:/) {
		(my $type, my $val) = split /:/, $_, 2;
		foreach ($type, $val) {
		    trim $_;
		}
		$request{lc $type} = $val;
	    }
            ## body
	    elsif (/^$/) {
		read($client, $request{CONTENT}, $request{'content-length'}) 
		    if defined $request{'content-length'};
		last;
	    }
	}
    }

    ## process request
    if ($request{METHOD} eq 'GET') {
	my $localfile = $DOCUMENT_ROOT.$request{URL};

	if (-f $localfile && open(FILE, "< ".$localfile)) {
	    print $client "HTTP/1.0 200 OK", Socket::CRLF;
	    my $buffer;
	    while (read(FILE, $buffer, 4096)) {
		print $client $buffer;
	    }
	}
	else {
	    print $client "HTTP/1.0 404 Not Found", Socket::CRLF;
	    print $client Socket::CRLF;
	    print $client "<html><body><h1>404 Not Found</h1></body></html>";
	}
        close(FILE);
    }
    elsif ($request{METHOD} eq 'POST') {
	print $client "HTTP/1.0 200 OK", Socket::CRLF;
	print $client "Content-Type: text/html", Socket::CRLF;
	print $client Socket::CRLF;

	my %data = parse_form_data($request{CONTENT});
	my $first = ${$data{'first'}}[0];
        my $last = ${$data{'last'}}[0];
        my $checkme = ${$data{'check'}}[0];
        $checkme = $checkme ? 'checked' : 'not checked';
        my $radio = ${$data{'radio'}}[0];
        $radio = $radio eq 'radio1' ? '1' : '2';
        my $single = ${$data{'select-single'}}[0];
        my @multiple = @{$data{'select-multiple'}};
	
        {
	    local $" = q{,};
	    print $client <<EOR;
<html>
  <head><title>Request OK</title></head>
  <body>
    <p>Hi <b>$first $last</b>! Your request is processed.</p>
    <p>Your choice was:</p>
    <ul>
      <li>CheckMe! was $checkme.
      <li>You selected radio $radio.
      <li>You selected item $single and items @multiple.
    </ul>
  </body>
</html>
EOR
        }
    }
    
    close $client;
}

#The
__END__

=head1 NAME

wserv_med.pl -- Webserver example, using Perl's medium level API for network access

=head1 SYNOPSIS

    ./wserv_med.pl 2345

=head1 DESCRIPTION

This is just a simple http server for CS629, Programming Assignment #3.  The
program takes only one argument, and that is the port number to run on.  Note
that only the very basics of HTTP/1.0 are implemented.

You may set the variable C<DOCUMENT_ROOT> to the base directory of the
webserver.  The default is C<public_html> in your home directory.

wserv_med.pl is written in what I consider as "medium level API" for network
access.

=over 4

=item low level API

Basic network calls, just as in C.

=item medium level API

Simplified access through modules, as in Java.

=item high level API

Configurable HTTP Deamon, just as the Perl module 
L<HTTP::Daemon|HTTP::Daemon>.

=back

=head1 EXAMPLES

The following examples assumes that the webserver is run on
allegro.cs.bgsu.edu, port 2345 and that C<DOCUMENT_ROOT> is set in the script
to the path where the following F<index.html> is in.

=for html
A form may look like this one.
<hr>

=for html
    Hello world!
    
    <form method="POST" action="http://allegro.cs.bgsu.edu:2345/index.html">
    <dl>
    <dt>Name
    <dd>First: <input type="text" name="first" value="Ron"><br>
    Last: <input type="text" name="last" value="Blaschke">
    </dl>
    
    <dl>
    <dt>This is a checkbox
    <dd><input type="checkbox" name="check">CheckMe!
    <dt>A radio group
    <dd><input type="radio" name="radio" value="radio1" checked>Radio 1<br>
        <input type="radio" name="radio" value="radio2">Radio 2
    <dt>A single selection
    <dd><select size="2" name="select-single">
	 <option selected>A</option>
	 <option>B</option>
	 <option>C</option>
	 <option>D</option>
	 <option>E</option>
	 </select>
    <dt>A multiple selection
    <dd><select size="4" name="select-multiple" multiple>
	 <option selected>1</option>
	 <option selected>2</option>
	 <option>3</option>
	 <option>4</option>
	 <option>5</option>
	 </select>
    </dl>
    <input type="submit" name="Submit">
    </form>
<hr>

The code for the form in F<index.html> is as follows.

    <html>
      <head>
        <title>Test</title>
      </head>
    
      <body>
        Hello world!
  
        <form method="POST" action=http://allegro.cs.bgsu.edu:2345/index.html >
        <dl>
        <dt>Name
        <dd>First: <input type="text" name="first" value="Ron"><br>
        Last: <input type="text" name="last" value="Blaschke">
        </dl>
        
        <dl>
        <dt>This is a checkbox
        <dd><input type="checkbox" name="check">CheckMe!
        <dt>A radio group
        <dd><input type="radio" name="radio" value="radio1" checked>Radio 1<br>
            <input type="radio" name="radio" value="radio2">Radio 2
        <dt>A single selection
        <dd><select size="2" name="select-single">
	     <option selected>A</option>
             <option>B</option>
             <option>C</option>
             <option>D</option>
             <option>E</option>
            </select>
        <dt>A multiple selection
        <dd><select size="4" name="select-multiple" multiple>
             <option selected>1</option>
             <option selected>2</option>
             <option>3</option>
             <option>4</option>
             <option>5</option>
            </select>
        </dl>
        <input type="submit" name="Submit">
        </form>
      </body>
    </html>

Make sure that the C<action> points to the webserver address!

Now we start the webserver.

    >./wserv_med 2345
    Starting httpd on port 2345

Access the page C<http://allegro.cs.bgsu.edu:2345/index.html> with a 
webbrowser.  The webbrowser will show the form, the server will output
something like this:

    1: 'GET /index.html HTTP/1.0'
    2: 'Connection: Keep-Alive'
    3: 'User-Agent: Mozilla/4.61 [en] (Win95; I)'
    4: 'Host: allegro.cs.bgsu.edu:2345'
    5: 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*'
    6: 'Accept-Encoding: gzip'
    7: 'Accept-Language: en'
    8: 'Accept-Charset: iso-8859-1,*,utf-8'
    9: ''

Enter data in the form and press "Submit Query".  The server will output
something similar to this.

    1: 'POST /index.html HTTP/1.0'
    2: 'Referer: http://allegro.cs.bgsu.edu:2345/index.html'
    3: 'Connection: Keep-Alive'
    4: 'User-Agent: Mozilla/4.61 [en] (Win95; I)'
    5: 'Host: allegro.cs.bgsu.edu:2345'
    6: 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*'
    7: 'Accept-Encoding: gzip'
    8: 'Accept-Language: en'
    9: 'Accept-Charset: iso-8859-1,*,utf-8'
    10: 'Content-type: application/x-www-form-urlencoded'
    11: 'Content-length: 108'
    12: ''
    form data is:
    first = 'Ron'
    last = 'Blaschke'
    radio = 'radio1'
    select-single = 'A'
    select-multiple = '1'
    select-multiple = '2'
    Submit = 'Submit Query'

And the webbrowser will show something like this.

Hi B<Ron Blaschke>! Your request is processed.

Your choice was:

=over 4

=item *

CheckMe! was not checked. 

=item *

You selected radio 1. 

=item *

You selected item A and items 1,2. 

=back

=head1 SEE ALSO

L<Socket>, L<IO::Socket|IO::Socket>, L<HTTP::Daemon|HTTP::Daemon>,
RFC1945 (HTTP/1.0), RFC2616 (HTTP/1.1) 

=head1 BUGS

none known

=head1 AUTHOR

Ronald Blaschke <rblasch@cs.bgsu.edu>

=head1 COPYRIGHT

(c)1999 by Ronald Blaschke <rblasch@cs.bgsu.edu>

=cut
