cgi-dev

Repository that serves as my CGI "scratchpad" to try things out.
git clone git://git.samirparikh.com/cgi-dev
Log | Files | Refs | README

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:
A.guess_number.cgi.swp | 0
A.hangman1.cgi.swp | 0
AParse_Form_Data.pm | 58++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
AREADME.md | 10++++++++++
Acount.cgi | 21+++++++++++++++++++++
Aecho.pl | 7+++++++
Aenv_info.cgi | 65+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aguess_number.cgi | 71+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Ahangman1.cgi | 187+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Ahello | 17+++++++++++++++++
Ahello.cgi | 17+++++++++++++++++
Aimage_fetch.cgi | 44++++++++++++++++++++++++++++++++++++++++++++
Anotify_signup.cgi | 52++++++++++++++++++++++++++++++++++++++++++++++++++++
Anph-count.cgi | 20++++++++++++++++++++
Aoo_hw.cgi | 34++++++++++++++++++++++++++++++++++
Aredirect_to_samirparikh.cgi | 5+++++
Aregister.cgi | 16++++++++++++++++
Aregister2.cgi | 18++++++++++++++++++
Aregister3.cgi | 43+++++++++++++++++++++++++++++++++++++++++++
Aserver_info.cgi | 34++++++++++++++++++++++++++++++++++
Awelcome.cgi | 30++++++++++++++++++++++++++++++
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