guess_number4.cgi (6928B) - raw
1 #!/usr/bin/perl 2 3 use warnings; 4 use strict; 5 use CGI; 6 use CGI::Cookie (); 7 use MD5 (); 8 use Crypt::CBC (); 9 10 use constant TRIES => 6; 11 use constant COOKIE_NAME => 'guess_number_4'; 12 use constant SECRET => 'mySuperSecretSecret'; 13 my $game = CGI->new; 14 my $CIPHER ||= Crypt::CBC->new( SECRET, 'IDEA' ); 15 16 # state maintenance subroutines 17 sub get_state { 18 my %cookie = $game->cookie( COOKIE_NAME ); 19 return undef unless %cookie; 20 # decrypt the cookie 21 my %state = split ':', $CIPHER->decrypt_hex( %cookie ); 22 authentication_error() unless cookie_check( \%state, 'check'); 23 return \%state; 24 } 25 26 sub initialize { 27 my $state = shift; 28 $state = {} unless $state; 29 $state->{NUMBER} = int( rand( 99 ) ) + 1; 30 $state->{GAMENO} += 1; 31 $state->{GUESSES_LEFT} = TRIES; 32 $state->{WON} += 0; 33 $state->{GUESSED} = ''; 34 return $state; 35 } 36 37 sub save_state { 38 my $state = shift; 39 cookie_check( $state, 'generate' ); 40 # encrypt cookie 41 my $encrypted = $CIPHER->encrypt_hex(join ':', %{$state}); 42 return CGI::Cookie->new ( 43 -name => COOKIE_NAME, 44 -value => $encrypted, 45 -expires => '+1M', 46 ); 47 } 48 49 # game play logic 50 sub process_guess { 51 my ( $guess, $state ) = @_; 52 53 # process list of previous guesses 54 my %guessed = map { $_ => 1 } split /,/, $state->{GUESSED}; 55 56 # do nothing if user did not enter a guess 57 return ('', 'continue') unless $guess; 58 59 # ensure guess is a valid number between 1 and 100 60 return ("Not a valid guess.", 'error') 61 unless $guess =~ m/^[1-9][0-9]?$|^100$/; 62 63 # check if user already entered this guess previously 64 return ("You already guessed that number.", 'error') 65 if $guessed{ $guess }; 66 67 # we have a valid guess. update list of guesses 68 $guessed{ $guess } = 1; 69 $state->{GUESSED} = join ',', sort keys %guessed; 70 71 $state->{GUESSES_LEFT}--; 72 73 # the order of the checks is important here. At this point, it's 74 # possible that the player has used their last guess. Therefore, 75 # we first check whether the guess is correct 76 77 # guess is correct! 78 if ( $guess == $state->{NUMBER} ) { 79 $state->{WON}++; 80 return ("Congratulations! You guessed that the correct number 81 was $state->{NUMBER}!", 'won'); 82 } 83 84 # if the guess is not correct AND we are out of guesses... 85 return ("Sorry, you ran out of turns. The number was $state->{NUMBER}.", 86 'lost') unless ($state->{GUESSES_LEFT} && $guess != $state->{NUMBER}); 87 88 # otherwise... 89 # guess too low 90 return ("Your guess is too low.", 'continue') 91 if ( $guess < $state->{NUMBER} ); 92 93 # ...or 94 # guess is too high 95 return ("Your guess is too high.", 'continue') 96 if ( $guess > $state->{NUMBER} ); 97 98 } 99 100 # html generation subroutines 101 sub print_header { 102 my $state = shift; 103 print $game->header( 104 -type => "text/html", 105 -charset => 'utf-8', 106 -cookie => save_state( $state ), 107 ); 108 print $game->start_html( 109 -title => "Guess a Secret Number!", 110 -onLoad => 'if (document.gf) document.gf.guess.focus()' 111 ); 112 print $game->h1( 'Guess a Secret Number Interactive Game' ); 113 } 114 115 sub print_status { 116 my ( $message, $state ) = @_; 117 118 # draw table 119 print 120 $game->table( { -border=>"0", -width=>"50%" }, 121 $game->Tr( 122 $game->td( $game->b("Game #: "), $state->{GAMENO} ), 123 $game->td( $game->b("Wins: "), $state->{WON} ) 124 ), 125 $game->Tr( 126 $game->td( $game->b("Guesses Left: "), $state->{GUESSES_LEFT} ), 127 $game->td( $game->b("Numbers Guessed: "), $state->{GUESSED} ) 128 ) 129 ); 130 print $game->h2( $game->font( {-color => 'red'}, $message )) 131 if $message; 132 } 133 134 sub show_restart_form { 135 my $state = shift; 136 print $game->start_form(); 137 print $game->p( 138 #-style => 'padding-right: 25px', 139 'Do you want to play again?', 140 ); 141 print $game->submit ( 142 -name => 'restart', 143 -value => 'Play again', 144 #-style => 'padding-left: 25px; padding-right: 25px', 145 ); 146 print $game->checkbox ( 147 -name => 'clear', 148 -label => 'Clear history', 149 ); 150 print $game->end_form(); 151 } 152 153 sub show_guess_form { 154 my $state = shift; 155 print $game->start_form( -name => 'gf' ); 156 print "Your guess: "; 157 print $game->textfield ( 158 -inputmode => 'numeric', # force number pad on mobile 159 -pattern => '[0-9]*', # force number pad on mobile 160 -name => 'guess', 161 -value => '', 162 -override => 1 163 ); 164 print $game->submit ( 165 -name => '_guess', 166 -value => 'Guess' 167 ); 168 print $game->end_form(); 169 } 170 171 sub print_footer { 172 print $game->hr; 173 print $game->p( 174 'inspired by Hangman game from ', 175 $game->a( 176 { -href => "https://www.oreilly.com/library/view/writing-apache-modules/156592567X/"}, 177 $game->i( 'Writing Apache Modules with Perl and C') 178 ), 179 ' by Lincoln Stein and Doug MacEachern.' 180 ); 181 print $game->end_html(); 182 } 183 184 # message authentication checks 185 sub cookie_check { 186 my ($state, $action) = @_; 187 return unless ref( $state ); 188 my @fields = @{$state}{qw(NUMBER GUESSES_LEFT GUESSED GAMENO WON)}; 189 my $newmac = MD5->hexhash( 190 SECRET . MD5->hexhash( join '', SECRET, @fields ) 191 ); 192 return $state->{MAC} = $newmac if $action eq 'generate'; 193 return $newmac eq $state->{MAC} if $action eq 'check'; 194 return undef; 195 } 196 197 sub authentication_error { 198 my $cookie = CGI::Cookie->new(-name => COOKIE_NAME, -value=>'',-expires => '-1d'); 199 print $game->header(-cookie => $cookie), 200 $game->start_html(-title => 'Authentication Error'), 201 $game->h1($game->font({-color => 'red'}, 'Authentication Error')), 202 $game->p('This application was unable to confirm the integrity of the', 203 'cookie that holds your current score.', 204 'Please reload the page to start a fresh session.'), 205 $game->p('If the problem persists, contact the webmaster.'); 206 exit 0; 207 } 208 209 # begin main program 210 # retrieve current state 211 my $state = get_state() unless $game->param( 'clear' ); 212 213 # initialize state if we are starting from the beginning (!$state) 214 # or if we are playing another game ($game->param( 'restart' )). 215 if ( !$state || $game->param( 'restart' ) ) { 216 $state = initialize( $state ); 217 } 218 219 # process current guess, if any 220 my ( $message, $status ) = 221 process_guess( $game->param( 'guess' ) || '', $state ); 222 223 # generate the HTML page 224 print_header( $state ); 225 print_status( $message, $state ); 226 227 # prompt user 228 if ( $status =~ /^(won|lost)$/ ) { 229 show_restart_form( $state ); 230 } else { 231 show_guess_form( $state ); 232 } 233 234 print_footer();