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:
A | guess_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();