commit 283bec17a09f88125210d93edfd0fe66dc4ebf51
parent 0743d93124fde695b19679d7f2762379eb8bbf06
Author: Samir Parikh <noreply@samirparikh.com>
Date: Wed, 16 Feb 2022 17:49:42 +0000
add rest of current files
Diffstat:
21 files changed, 749 insertions(+), 0 deletions(-)
diff --git a/.guess_number.cgi.swp b/.guess_number.cgi.swp
Binary files differ.
diff --git a/.hangman1.cgi.swp b/.hangman1.cgi.swp
Binary files differ.
diff --git a/Parse_Form_Data.pm b/Parse_Form_Data.pm
@@ -0,0 +1,58 @@
+package Parse_Form_Data;
+use strict;
+use warnings;
+use Exporter qw( import );
+our @EXPORT_OK = qw( parse_form_data );
+
+sub parse_form_data {
+ my %form_data;
+
+ # split query string into name-value pairs and store each pair
+ # in @parameters array, splitting on the ampersand as the delimiter
+ my @parameters = split /&/, $ENV{ QUERY_STRING };
+
+ # if the request happens to be a POST, also read the content of the
+ # request from STDIN. If number of bytes read does not equal number of
+ # bytes we expect in CONTENT_LENGTH, throw error.
+ if ( $ENV{ REQUEST_METHOD } eq 'POST' ) {
+ my $query;
+ read( STDIN, $query, $ENV{ CONTENT_LENGTH } ) == $ENV{ CONTENT_LENGTH }
+ or die "Could not read POST request payload.";
+ push @parameters => split /&/, $query;
+ }
+
+ # loop through parameters to split them into $name and $value
+ foreach my $name_value ( @parameters ) {
+ my ( $name, $value ) = split /=/, $name_value;
+
+ # decode URL-encoded characters
+ # replace each plus sign with a space
+ $name =~ tr/+/ /; # could also be $name =~ s/\+/ / g;
+
+ # scan for a percentage sign followed by two hexadecimal digits and
+ # use Perl's chr function to convert the hexadecimal value into a
+ # character
+ $name =~ s/%([\da-f][\da-f])/chr( hex($1) )/egi;
+
+ # possible that a parameter can be passed without an equal sign or a
+ # value. Set to empty string to avoid warnings
+ $value = "" unless defined $value;
+
+ # see comments above for $name
+ $value =~ tr/+/ /;
+ $value =~ s/%([\da-f][\da-f])/chr( hex($1) )/egi;
+
+ # if the form has elements that share the same name, or if there is
+ # a scrolling box that supports multiple values, then it is possible
+ # for us to receive multiple values for the same name.
+ # to address this, store the multiple values as a single text string
+ # that is delimited by a colon
+ if ( exists $form_data{$name} ) {
+ $form_data{$name} .= ":$value";
+ } else {
+ $form_data{$name} = $value;
+ }
+ }
+
+ return %form_data;
+}
diff --git a/README.md b/README.md
@@ -0,0 +1,10 @@
+This repository contains my common gateway interface (CGI) scripts that I have
+been learning to create. Some of the references I have been using to learn CGI
+include:
+
+- "CGI Programming with Perl", Second Edition, by Scott Guelich,
+ Shishir Gundavaram, Gunther Birznieks
+ https://www.oreilly.com/library/view/cgi-programming-with/1565924193/
+
+- "Writing Apache Modules with Perl and C", by Doug MacEachern, Lincoln Stein
+ https://www.oreilly.com/library/view/writing-apache-modules/156592567X/
diff --git a/count.cgi b/count.cgi
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -wT
+
+use strict;
+
+#print "$ENV{SERVER_PROTOCOL} 200 OK\n";
+#print "Server: $ENV{SERVER_SOFTWARE}\n";
+#print "Content-type: text/plain\n\n";
+print "Content-type: text/plain;charset=iso-8859-1\n\n";
+
+print "OK, starting time consuming process ... \n";
+
+# Tell Perl not to buffer our output
+$| = 1;
+
+for ( my $loop = 1; $loop <= 10; $loop++ ) {
+ print "Iteration: $loop\n";
+ ## Perform some time consuming task here ##
+ sleep 1;
+}
+
+print "All Done!\n";
diff --git a/echo.pl b/echo.pl
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+print qq(Content-type: text/plain\n\n);
+
+print scalar localtime;
diff --git a/env_info.cgi b/env_info.cgi
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -wT
+
+use strict;
+
+my %env_info = (
+ SERVER_SOFTWARE => "the server software",
+ SERVER_NAME => "the server hostname or IP address",
+ GATEWAY_INTERFACE => "the CGI specification revision",
+ SERVER_PROTOCOL => "the server protocol name",
+ SERVER_PORT => "the port number for the server",
+ REQUEST_METHOD => "the HTTP request method",
+ PATH_INFO => "the extra path info",
+ PATH_TRANSLATED => "the extra path info translated",
+ DOCUMENT_ROOT => "the server document root directory",
+ SCRIPT_NAME => "the script name",
+ QUERY_STRING => "the query string",
+ REMOTE_HOST => "the hostname of the client",
+ REMOTE_ADDR => "the IP address of the client",
+ AUTH_TYPE => "the authentication method",
+ REMOTE_USER => "the authenticated username",
+ REMOTE_IDENT => "the remote user is (RFC 931): ",
+ CONTENT_TYPE => "the media type of the data",
+ CONTENT_LENGTH => "the length of the request body",
+ HTTP_ACCEPT => "the media types the client accepts",
+ HTTP_USER_AGENT => "the browser the client is using",
+ HTTP_REFERER => "the URL of the referring page",
+ HTTP_COOKIE => "the cookie(s) the client sent"
+);
+
+print "Content-type: text/html\n\n";
+
+print <<END_OF_HEADING;
+
+<HTML>
+<HEAD>
+ <TITLE>A List of Environment Variables</TITLE>
+</HEAD>
+
+<BODY>
+<H1>CGI Environment Variables</H1>
+
+<TABLE BORDER=1>
+ <TR>
+ <TH>Variable Name</TH>
+ <TH>Description</TH>
+ <TH>Value</TH>
+ </TR>
+END_OF_HEADING
+
+my $name;
+
+# Add additional variables defined by web server or browser
+foreach $name ( keys %ENV ) {
+ $env_info{$name} = "an extra variable provided by this server"
+ unless exists $env_info{$name};
+}
+
+foreach $name ( sort keys %env_info ) {
+ my $info = $env_info{$name};
+ my $value = $ENV{$name} || "<I>Not Defined</I>";
+ print "<TR><TD><B>$name</B></TD><TD>$info</TD><TD>$value</TD></TR>\n";
+}
+
+print "</TABLE>\n";
+print "</BODY></HTML>\n";
diff --git a/guess_number.cgi b/guess_number.cgi
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use CGI;
+
+use constant TRIES => 5;
+my $game = CGI->new;
+
+sub get_state {
+ return undef unless $game->param();
+ my $state = {};
+ foreach ( qw[ NUMBER GAMENO GUESSES_LEFT WON GUESSED ] ) {
+ $state->{ $_ } = $game->param( $_ );
+ }
+ return $state;
+}
+
+sub initialize {
+ my $state = shift;
+ $state = {} unless $state;
+ $state->{NUMBER} = int( rand( 99 ) ) + 1;
+ $state->{GAMENO} += 1;
+ $state->{GUESSES_LEFT} = TRIES;
+ $state->{WON} += 0;
+ $state->{GUESSED} = '';
+ return $state;
+}
+
+sub process_guess {
+ my ( $guess, $state ) = @_;
+
+ # process list of previous guesses
+ my %guessed = map { $_ => 1 } split /,/, $state->{GUESSED};
+
+ # do nothing if user did not enter a guess
+ return ("Did not enter a guess", 'continue') unless $guess;
+
+ # ensure guess is a valid number between 1 and 100
+ return ("Not a valid guess.", 'error')
+ unless $guess =~ m/^[1-9][0-9]?$|^100$/;
+
+ # check if user already entered this guess previously
+ return ("You already guessed that number.", 'error')
+ if $guessed{ $guess };
+
+ # update list of guesses
+ $guessed{ $guess } = 1;
+ $state->{GUESSED} = join ',' sort keys %guessed;
+
+ $state->{GUESSES_LEFT}--;
+
+ # incorrect guess and out of tries
+ return ("Sorry, you ran out of turns. The number was $state->{NUMBER}.",
+ 'lost') unless ($state->{GUESSES_LEFT} && $guess != $state->{NUMBER});
+
+}
+
+
+# retrieve current state
+my $state = get_state();
+
+# initialize state if we are starting from the beginning (!$state)
+# or if we are playing another game ($game->param( 'restart' )).
+if ( !$state || $game->param( 'restart' ) ) {
+ $state = initialize( $state );
+}
+
+# process current guess, if any
+my ( $message, $status ) =
+ process_guess( $game->param( 'guess' ) || '', $state );
diff --git a/hangman1.cgi b/hangman1.cgi
@@ -0,0 +1,187 @@
+#!/usr/bin/perl
+
+# file: hangman1.cgi
+# hangman game using hidden fields to maintain state
+
+use IO::File();
+use CGI qw( :standard );
+use warnings;
+use strict;
+
+use constant WORDS => '/usr/share/dict/hangman_words';
+use constant TRIES => 6;
+
+# retrieve the state
+my $state = get_state(); # $state is a hash reference
+
+# reinitialize if we need to
+$state = initialize($state) if !$state or param('restart');
+
+# process the current guess, if any
+my ($message, $status) = process_guess(param('guess') || '', $state);
+
+# generate the HTML page
+print header(-charset => 'utf-8'),
+ start_html( -Title => 'Hangman 1',
+ -bgcolor => 'white',
+ -onLoad => 'if (document.gf) document.gf.guess.focus()'),
+ h1( 'Hangman 1 Interactive Game' );
+
+# draw the statistics
+status( $message, $state );
+
+# prompt the user to restart or to enter the next guess
+if ( $status =~ /^(won|lost)$/ ) {
+ show_restart_form($state);
+} else {
+ show_guess_form($state);
+}
+print hr,
+ a( {-href => '/'}, "Home"),
+ p( cite( {-style => "fontsize: 10pt"},
+ 'graphics courtesy of Andy Wardley')),
+ end_html();
+
+# This is called to initialize a whole new state object
+# or to create a new game.
+sub initialize {
+ my $state = shift;
+ $state = {} unless $state;
+ $state->{WORD} = pick_random_word();
+ $state->{GUESSES_LEFT} = TRIES;
+ $state->{GUESSED} = ''; # empty hash reference
+ $state->{GAMENO} += 1;
+ $state->{WON} += 0;
+ $state->{TOTAL} += 0;
+ return $state;
+}
+
+sub save_state {
+ my $state = shift;
+ foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) {
+ print hidden(
+ -name => $_, -value=> $state->{$_}, -override => 1
+ );
+ }
+}
+
+sub get_state {
+ return undef unless param();
+ my $state = {};
+ foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) {
+ $state->{$_} = param($_);
+ }
+ return $state;
+}
+
+sub show_guess_form {
+ my $state = shift;
+ print start_form(-name => 'gf'),
+ "Your guess: ",
+ textfield(-name => 'guess', -value => '', -override => 1),
+ submit(-value => 'Guess');
+ save_state($state);
+ print end_form;
+}
+
+sub show_restart_form {
+ my $state = shift;
+ print start_form,
+ "Do you want to play again?",
+ submit(-name => 'restart', -value => 'Another game');
+ #delete $state->{WORD};
+ save_state($state);
+ print end_form;
+}
+
+sub process_guess { # returns message and status
+ my ( $guess, $state ) = @_;
+
+ # lose immediately if user has no more guesses left
+ #return ('', 'lost') unless $state->{GUESSES_LEFT} > 0;
+ #return ('', 'lost') unless $state->{GUESSES_LEFT};
+
+ my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g;
+ my %letters = map { $_ => 1 } $state->{WORD} =~ /(.)/g;
+
+ # return immediately if user has already guessed the word
+ return ('', 'won') unless grep(!$guessed{$_}, keys %letters);
+
+ # do nothing more if no guess
+ return ('', 'continue') unless $guess;
+
+ # this section processes individual letter guesses
+ $guess = lc $guess;
+ return ("Not a valid letter or word", 'error')
+ unless $guess =~ /^[a-z]+$/;
+ return ("You already guessed that letter", 'error')
+ if $guessed{$guess};
+
+ # this section is called when the user guesses the whole word
+ if (length($guess) > 1 and $guess ne $state->{WORD}) {
+ $state->{TOTAL} += $state->{GUESSES_LEFT};
+ return (qq(You lose. The word was "$state->{WORD}".), 'lost');
+ }
+
+ # update the list of guesses
+ $guessed{$_}++ foreach ($guess =~ /(.)/g);
+ $state->{GUESSED} = join '', sort keys %guessed;
+
+ # correct guess -- word completely filled in
+ unless (grep(!$guessed{$_}, keys %letters)) {
+ $state->{WON}++;
+ return (qq(You won! The word was "$state->{WORD}".), 'won');
+ }
+
+ # incorrect guess
+ if (!$letters{$guess}) {
+ $state->{TOTAL}++;
+ $state->{GUESSES_LEFT}--;
+ # user out of turns
+ return (qq(Sorry, you're out of turns. The word was "$state->{WORD}".),
+ 'lost') if $state->{GUESSES_LEFT} <= 0;
+ # user still has some turns
+ return ("Wrong guess", 'continue');
+ }
+
+ # correct guess but word still incomplete
+ return ("Good guess.", 'continue');
+}
+
+sub status {
+ my ( $message, $state ) = @_;
+
+ # print the word with underscores replacing unguessed letters
+ print table( { -width => '100%' },
+ TR(
+ td(b('Word #:'), $state->{GAMENO}),
+ td(b('Guessed:'), $state->{GUESSED})
+ ),
+ TR(
+ td(b('Won:'), $state->{WON}),
+ td(b('Current average:'),
+ sprintf("%2.3f", $state->{TOTAL}/$state->{GAMENO})),
+ td(b('Overall average:'),
+ $state->{GAMENO} > 1 ?
+ sprintf("%2.3f",
+ ($state->{TOTAL}-(TRIES-$state->{GUESSES_LEFT}))/
+ ($state->{GAMENO}-1))
+ : '0.000')
+ )
+ );
+
+ my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g;
+ print h2("Word:",
+ map {$guessed{$_} ? $_ : '_'} $state->{WORD} =~ /(.)/g);
+ print h2(font({-color => 'red'}, $message)) if $message;
+}
+
+# pick a word, any word
+sub pick_random_word {
+ my $list = IO::File->new(WORDS)
+ || die "Couldn't open ${\WORDS}: $!\n";
+ my $word;
+ rand($.) < 1 && ($word = $_) while <$list>;
+ chomp $word;
+ $word;
+}
diff --git a/hello b/hello
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -wT
+
+print <<END_OF_HTML;
+Content-type: text/html
+
+<HTML>
+<HEAD>
+ <TITLE>Welcome to this Site!</TITLE>
+</HEAD>
+<BODY>
+<H1>About this Site</H1>
+<HR>
+<p>This is a site where I am trying to learn about CGI programming using Perl.</p>
+<p>You can find more information about this server by visiting my <a href="server_info.cgi">About this Server</a> page.</p>
+</BODY>
+</HTML>
+END_OF_HTML
diff --git a/hello.cgi b/hello.cgi
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -wT
+
+print <<END_OF_HTML;
+Content-type: text/html
+
+<HTML>
+<HEAD>
+ <TITLE>Welcome to this Site!</TITLE>
+</HEAD>
+<BODY>
+<H1>About this Site</H1>
+<HR>
+<p>This is a site where I am trying to learn about CGI programming using Perl.</p>
+<p>You can find more information about this server by visiting my <a href="server_info.cgi">About this Server</a> page.</p>
+</BODY>
+</HTML>
+END_OF_HTML
diff --git a/image_fetch.cgi b/image_fetch.cgi
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -wT
+
+use strict;
+
+my $image_type = $ENV{HTTP_ACCEPT} =~ m|image/png| ? "png" : "jpeg";
+my( $basename ) = $ENV{PATH_INFO} =~ /\/(\w+)/;
+my $image_path = "$ENV{DOCUMENT_ROOT}/images/$basename.$image_type";
+
+#print <<END_OF_HTML;
+#Content-type: text/html
+#
+#<HTML>
+#<HEAD>
+# <TITLE>Here is what I found</TITLE>
+#</HEAD>
+#<BODY>
+#<H1>Parameter Values</H1>
+#<HR>
+#<PRE>
+# HTTP_ACCEPT: $ENV{HTTP_ACCEPT}
+# image_type: $image_type
+# PATH_INFO: $ENV{PATH_INFO}
+# basename: $basename
+# DOCUMENT_ROOT: $ENV{DOCUMENT_ROOT}
+# image_path: $image_path
+#</PRE>
+#<HR>
+#</BODY>
+#</HTML>
+#END_OF_HTML
+
+my $image;
+unless ( $basename and -B $image_path and open $image, '<', $image_path ) {
+ print "Location: /errors/not_found.html\n\n";
+ exit;
+}
+
+my $buffer;
+print "Content-type: image/$image_type\n\n";
+binmode $image;
+
+while ( read( $image, $buffer, 16_384 ) ) {
+ print $buffer;
+}
diff --git a/notify_signup.cgi b/notify_signup.cgi
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use CGI;
+
+my $form = CGI->new;
+
+print $form->header( "text/html" );
+print $form->start_html( -title => "Register to our Mailing List" );
+print $form->h1( "Mailing List Signup" );
+print $form->p( "Please fill out this form to be notified via email
+ about updates and future product announcements." );
+
+print $form->start_form(
+ method => "register.cgi",
+ action => "POST",
+);
+
+foreach (qw( Name Email )) {
+ print $form->p( "$_:", $form->textfield( -name => lc( $_ ) ) );
+}
+
+print $form->p( "Password:", $form->password_field( -name => "password" ) );
+
+print $form->checkbox(
+ -name => "checkbox",
+ -value => "my_checkbox",
+ -label => "My Checkbox",
+);
+
+print $form->checkbox_group (
+ -name => "toppings",
+ -values => [ qw( lettuce tomato onions ) ],
+ -labels => { "lettuce" => "Lettuce",
+ "tomato" => "Tomato",
+ "onions" => "Onions",
+ },
+ -columns => 1,
+);
+
+print $form->hr;
+
+print $form->submit(
+ -name => "submit",
+ -value => "Submit Now",
+);
+
+print $form->reset;
+
+print $form->end_form;
+print $form->end_html;
diff --git a/nph-count.cgi b/nph-count.cgi
@@ -0,0 +1,20 @@
+#!/usr/bin/perl -wT
+
+use strict;
+
+print "$ENV{SERVER_PROTOCOL} 200 OK\n";
+print "Server: $ENV{SERVER_SOFTWARE}\n";
+print "Content-type: text/plain\n\n";
+
+print "OK, starting time consuming process ... \n";
+
+# Tell Perl not to buffer our output
+$| = 1;
+
+for ( my $loop = 1; $loop <= 30; $loop++ ) {
+ print "Iteration: $loop\n";
+ ## Perform some time consuming task here ##
+ sleep 1;
+}
+
+print "All Done!\n";
diff --git a/oo_hw.cgi b/oo_hw.cgi
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use CGI;
+my $cgi = CGI->new;
+#chomp (my $name = <>);
+#print "hello, $name\n";
+my $path = $cgi->path_info();
+#my $accept_formats = $cgi->Accept;
+print $cgi->header(),
+ $cgi->start_html(),
+ $cgi->p("Hello World"),
+ $cgi->p("my cgi->query_string is ", $cgi->query_string()),
+ $cgi->p("my QUERY_STRING is ", $ENV{ QUERY_STRING }),
+ $cgi->p("my Accept is ", $cgi->Accept);
+
+print $cgi->p("These are the HTTP environment variables I received:");
+
+foreach ( $cgi->http ) {
+ print $cgi->p($_, ": ", $cgi->http($_));
+}
+
+print $cgi->p("self_url is ", $cgi->self_url);
+
+print $cgi->p("These are the parameters I received:");
+
+foreach my $name ($cgi->param) {
+ foreach my $value ( $cgi->param( $name ) ) {
+ print $cgi->p($name, ": ", $value);
+ }
+}
+
+print $cgi->end_html();
diff --git a/redirect_to_samirparikh.cgi b/redirect_to_samirparikh.cgi
@@ -0,0 +1,5 @@
+#!/usr/bin/perl -wT
+
+use strict;
+
+print "Location: https://samirparikh.com\n\n";
diff --git a/register.cgi b/register.cgi
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use CGI;
+
+my $cgi = CGI->new;
+
+print $cgi->header( "text/plain;charset=iso-8859-1" );
+print "These are the results I received:\n\n";
+
+foreach my $name ($cgi->param) {
+ foreach my $value ( $cgi->param( $name ) ) {
+ print $name, ": ", $value, "\n";
+ }
+}
diff --git a/register2.cgi b/register2.cgi
@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+use lib '.';
+use strict;
+use warnings;
+use Parse_Form_Data qw ( parse_form_data );
+
+my %parameters = parse_form_data();
+
+print "Content-type: text/plain;charset=iso-8859-1\n\n";
+print "here are our results...\n";
+
+foreach my $parameter (sort keys %parameters) {
+ #print "$parameter -> $parameters{$parameter}\n";
+ foreach (split /:/, $parameters{$parameter}) {
+ print "$parameter -> $_\n";
+ }
+}
diff --git a/register3.cgi b/register3.cgi
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use lib '.';
+use strict;
+use warnings;
+use Parse_Form_Data qw ( parse_form_data );
+
+my %parameters = parse_form_data();
+
+print "Content-type: text/html\n\n";
+
+print <<END_OF_HEADING;
+<!DOCTYPE html>
+<HTML>
+<HEAD>
+ <meta charset="utf-8">
+ <TITLE>Mailing List Parameters</TITLE>
+</HEAD>
+
+<BODY>
+<H1>Here are our results...</H1>
+
+<TABLE BORDER=1>
+ <TR>
+ <TH>Parameter</TH>
+ <TH>Value</TH>
+ </TR>
+END_OF_HEADING
+
+foreach my $parameter (sort keys %parameters) {
+ foreach my $value(split /:/, $parameters{$parameter}) {
+ print "<TR>
+ <TD><B>$parameter</B></TD>
+ <TD>$value</TD>
+ </TD>\n";
+ }
+}
+
+print <<FOOTER;
+</TABLE>
+</BODY>
+</HTML>
+FOOTER
diff --git a/server_info.cgi b/server_info.cgi
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -wT
+
+print <<END_OF_HTML;
+Content-type: text/html
+
+<HTML>
+<HEAD>
+ <TITLE>About this Server</TITLE>
+</HEAD>
+<BODY>
+<H1>About this Server</H1>
+<HR>
+<PRE>
+ Server Name: $ENV{SERVER_NAME}
+ Listening on Port: $ENV{SERVER_PORT}
+ Server Software: $ENV{SERVER_SOFTWARE}
+ Server Protocol: $ENV{SERVER_PROTOCOL}
+ CGI Version: $ENV{GATEWAY_INTERFACE}
+ -------------------------
+ Content Length: $ENV{CONTENT_LENGTH}
+ Content Type: $ENV{CONTENT_TYPE}
+ Document Root: $ENV{DOCUMENT_ROOT}
+ Query String: $ENV{QUERY_STRING}
+ Remote Address: $ENV{REMOTE_ADDR}
+ Remote Host: $ENV{REMOTE_HOST}
+ -------------------------
+ Referer: $ENV{HTTP_REFERER}
+ User Agent: $ENV{HTTP_USER_AGENT}
+ HTTPS(?): $ENV{HTTPS}
+</PRE>
+<HR>
+</BODY>
+</HTML>
+END_OF_HTML
diff --git a/welcome.cgi b/welcome.cgi
@@ -0,0 +1,30 @@
+#!/usr/bin/perl -wT
+
+use strict;
+
+my $time = localtime;
+my $remote_id = $ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR};
+my $admin_email = $ENV{SERVER_ADMIN};
+
+print "Content-type: text/html\n\n";
+
+print <<END_OF_PAGE;
+<HTML>
+<HEAD>
+ <TITLE>Welcome to Mike's Mechanics Database</TITLE>
+</HEAD>
+
+<BODY BGCOLOR="#ffffff">
+ <IMG SRC="../www/html/mm.png" ALT="Mike's Mechanics">
+ <P>Welcome from $remote_id! What will you find here? You'll
+ find a list of mechanics from around the country and the type of
+ service to expect -- based on user input and suggestions.</P>
+ <P>What are you waiting for? Click <A HREF="/cgi/list.cgi">here</A>
+ to continue.</P>
+ <HR>
+ <P>The current time on this server is: $time.</P>
+ <P>If you find any problems with this site or have any suggestions,
+ please email <A HREF="mailto:$admin_email">$admin_email</A>.</P>
+</BODY>
+</HTML>
+END_OF_PAGE