commit 2e4000699fe055c465cc3a90d9617d001e97ba0e
parent b4b5a092aef0ebad8be68d8f2eed96180b9fcfd6
Author: Samir Parikh <noreply@samirparikh.com>
Date: Wed, 2 Mar 2022 15:54:03 +0000
get encrypted cookies to work
Diffstat:
A | hangman4.cgi | | | 234 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 234 insertions(+), 0 deletions(-)
diff --git a/hangman4.cgi b/hangman4.cgi
@@ -0,0 +1,234 @@
+#!/usr/bin/perl
+
+# file: hangman4.cgi
+# hangman game using simple cookie and message authentication
+# state and encyprtion to maintain state
+
+use IO::File();
+use CGI qw( :standard );
+use CGI::Cookie ();
+use MD5 ();
+use Crypt::CBC ();
+use warnings;
+use strict;
+
+use constant WORDS => '/usr/share/dict/hangman_words';
+use constant TRIES => 6;
+use constant COOKIE_NAME => 'Hangman4';
+use constant SECRET => 'kiddo';
+
+# retrieve the state
+my $CIPHER ||= Crypt::CBC->new( SECRET, 'IDEA' );
+my $state = get_state() unless param('clear');
+
+# 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',
+ -cookie => save_state($state)
+ ),
+ 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;
+ MAC($state, 'generate');
+ # encrypt the cookie
+ my $encrypted = $CIPHER->encrypt_hex(join ':', %{$state});
+ return CGI::Cookie->new (
+ -name => COOKIE_NAME,
+ -value => $encrypted,
+ -expires => '+1M'
+ );
+}
+
+#sub get_state {
+# return undef unless param();
+# my $state = {};
+# foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) {
+# $state->{$_} = param($_);
+# }
+# return $state;
+#}
+
+sub get_state {
+ my %cookie = cookie( COOKIE_NAME );
+ return undef unless %cookie;
+ # decrypt the cookie
+ my %state = split ':', $CIPHER->decrypt_hex( %cookie );
+ authentication_error() unless MAC(\%state, 'check');
+ 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'),
+ checkbox(-name => 'clear', -label => 'Clear history');
+ 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 => '50%' },
+ 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;
+}
+
+sub MAC {
+ my ($state, $action) = @_;
+ return unless ref( $state );
+ my @fields = @{$state}{qw(WORD GUESSES_LEFT GUESSED GAMENO WON TOTAL)};
+ 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 header(-cookie => $cookie),
+ start_html(-title => 'Authentication Error'),
+ h1(font({-color => 'red'}, 'Authentication Error')),
+ 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.'),
+ p('If the problem persists, contact the webmaster.');
+ exit 0;
+}