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 ab612410cde498d205b6c9098eed75c80933f649
parent 2e4000699fe055c465cc3a90d9617d001e97ba0e
Author: Samir Parikh <noreply@samirparikh.com>
Date:   Wed,  2 Mar 2022 16:09:31 +0000

add capability to encrypt client-side cookies to maintain state information

Diffstat:
Aguess_number4.cgi | 234+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 234 insertions(+), 0 deletions(-)

diff --git a/guess_number4.cgi b/guess_number4.cgi @@ -0,0 +1,234 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use CGI; +use CGI::Cookie (); +use MD5 (); +use Crypt::CBC (); + +use constant TRIES => 6; +use constant COOKIE_NAME => 'guess_number_4'; +use constant SECRET => 'mySuperSecretSecret'; +my $game = CGI->new; +my $CIPHER ||= Crypt::CBC->new( SECRET, 'IDEA' ); + +# state maintenance subroutines +sub get_state { + my %cookie = $game->cookie( COOKIE_NAME ); + return undef unless %cookie; + # decrypt the cookie + my %state = split ':', $CIPHER->decrypt_hex( %cookie ); + authentication_error() unless cookie_check( \%state, 'check'); + 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 save_state { + my $state = shift; + cookie_check( $state, 'generate' ); + # encrypt cookie + my $encrypted = $CIPHER->encrypt_hex(join ':', %{$state}); + return CGI::Cookie->new ( + -name => COOKIE_NAME, + -value => $encrypted, + -expires => '+1M', + ); +} + +# game play logic +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 ('', '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 }; + + # we have a valid guess. update list of guesses + $guessed{ $guess } = 1; + $state->{GUESSED} = join ',', sort keys %guessed; + + $state->{GUESSES_LEFT}--; + + # the order of the checks is important here. At this point, it's + # possible that the player has used their last guess. Therefore, + # we first check whether the guess is correct + + # guess is correct! + if ( $guess == $state->{NUMBER} ) { + $state->{WON}++; + return ("Congratulations! You guessed that the correct number + was $state->{NUMBER}!", 'won'); + } + + # if the guess is not correct AND we are out of guesses... + return ("Sorry, you ran out of turns. The number was $state->{NUMBER}.", + 'lost') unless ($state->{GUESSES_LEFT} && $guess != $state->{NUMBER}); + + # otherwise... + # guess too low + return ("Your guess is too low.", 'continue') + if ( $guess < $state->{NUMBER} ); + + # ...or + # guess is too high + return ("Your guess is too high.", 'continue') + if ( $guess > $state->{NUMBER} ); + +} + +# html generation subroutines +sub print_header { + my $state = shift; + print $game->header( + -type => "text/html", + -charset => 'utf-8', + -cookie => save_state( $state ), + ); + print $game->start_html( + -title => "Guess a Secret Number!", + -onLoad => 'if (document.gf) document.gf.guess.focus()' + ); + print $game->h1( 'Guess a Secret Number Interactive Game' ); +} + +sub print_status { + my ( $message, $state ) = @_; + + # draw table + print + $game->table( { -border=>"0", -width=>"50%" }, + $game->Tr( + $game->td( $game->b("Game #: "), $state->{GAMENO} ), + $game->td( $game->b("Wins: "), $state->{WON} ) + ), + $game->Tr( + $game->td( $game->b("Guesses Left: "), $state->{GUESSES_LEFT} ), + $game->td( $game->b("Numbers Guessed: "), $state->{GUESSED} ) + ) + ); + print $game->h2( $game->font( {-color => 'red'}, $message )) + if $message; +} + +sub show_restart_form { + my $state = shift; + print $game->start_form(); + print $game->p( + #-style => 'padding-right: 25px', + 'Do you want to play again?', + ); + print $game->submit ( + -name => 'restart', + -value => 'Play again', + #-style => 'padding-left: 25px; padding-right: 25px', + ); + print $game->checkbox ( + -name => 'clear', + -label => 'Clear history', + ); + print $game->end_form(); +} + +sub show_guess_form { + my $state = shift; + print $game->start_form( -name => 'gf' ); + print "Your guess: "; + print $game->textfield ( + -inputmode => 'numeric', # force number pad on mobile + -pattern => '[0-9]*', # force number pad on mobile + -name => 'guess', + -value => '', + -override => 1 + ); + print $game->submit ( + -name => '_guess', + -value => 'Guess' + ); + print $game->end_form(); +} + +sub print_footer { + print $game->hr; + print $game->p( + 'inspired by Hangman game from ', + $game->a( + { -href => "https://www.oreilly.com/library/view/writing-apache-modules/156592567X/"}, + $game->i( 'Writing Apache Modules with Perl and C') + ), + ' by Lincoln Stein and Doug MacEachern.' + ); + print $game->end_html(); +} + +# message authentication checks +sub cookie_check { + my ($state, $action) = @_; + return unless ref( $state ); + my @fields = @{$state}{qw(NUMBER GUESSES_LEFT GUESSED GAMENO WON)}; + my $newmac = MD5->hexhash( + SECRET . MD5->hexhash( join '', SECRET, @fields ) + ); + return $state->{MAC} = $newmac if $action eq 'generate'; + return $newmac eq $state->{MAC} if $action eq 'check'; + return undef; +} + +sub authentication_error { + my $cookie = CGI::Cookie->new(-name => COOKIE_NAME, -value=>'',-expires => '-1d'); + print $game->header(-cookie => $cookie), + $game->start_html(-title => 'Authentication Error'), + $game->h1($game->font({-color => 'red'}, 'Authentication Error')), + $game->p('This application was unable to confirm the integrity of the', + 'cookie that holds your current score.', + 'Please reload the page to start a fresh session.'), + $game->p('If the problem persists, contact the webmaster.'); + exit 0; +} + +# begin main program +# retrieve current state +my $state = get_state() unless $game->param( 'clear' ); + +# 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 ); + +# generate the HTML page +print_header( $state ); +print_status( $message, $state ); + +# prompt user +if ( $status =~ /^(won|lost)$/ ) { + show_restart_form( $state ); +} else { + show_guess_form( $state ); +} + +print_footer();