#!/usr/bin/perl
# Todo
#
# Link back to the original cache page when it's ready
#
# Clean out leading spaces from answer
# - Maybe clean out extra spaces around too, such as "too many spaces"
#
# Utilize counter routines at the end of the file
# - Done, just need to test for all scenarios.. Plus, what do I want to consider a hit?
# - Retrieving a hint, is that a hit? (currently yes)
# - How to display the hits/statistics (in rules currently)
# GPL v3
# This code is licensed under the GPL Version 3 which you can read about here:
# http://www.gnu.org/licenses/gpl-3.0.txt
use Tie::File;
use strict;
# Pull the coordinates and some config variables in from another file so folks can see
# this file in its entirety.
# You'll just have to trust me on the triviaconfig.pm file I suppose. Only function
# in it is get_coordinates and get_config, and I can provide it if anyone really wants
# to see it, sans the actual coordinates.
use lib "/var/www/cgi-bin/trivia/";
use triviaconfig;
my (@coordinates) = get_coordinates();
my ($triviafile,$logfile,$hashpath,$counterfile,$hashsalt) = get_config();
# Also, I have a cron job running which cleans out my hash dir so old files don't
# sit around forever, plus it expires old wrong answer files.
# Import CGI module
use CGI;
use CGI::Carp qw (fatalsToBrowser);
#use CGI::Debug (on => 'fatals');
use Digest::MD5 qw(md5_hex);
my $query = CGI->new;
my $url = "https://trivia.theblackmoor.net";
my $texturl = "https://theblackmoor.net/stuff/trivia.txt";
my $wp = "GC1NAVF";
my $wpname = "No trivial pursuit of a Cache";
my $wpcachepage = "https://www.geocaching.com/seek/cache_details.aspx?wp=$wp";
my $debug = 0;
my $timeallowed = 30;
my $maxwrong = 5;
my $maxwrongtime;
if ($debug) { $maxwrongtime = 30; }
else { $maxwrongtime = 15 * 60; }
my $welcomewrong = 0;
my $wrongtext = "";
my $answertimediff = 0;
my $totalquestions = 0;
# Vars I need in other places
my (@questions, @answers, $answers_tied, $startime);
my ($log, %post, %in);
my ($correct, $incorrect, $totalhits);
my $post_result = check_post();
my $ip = $ENV{'REMOTE_ADDR'};
open(LOG,">>$logfile") || print "Unable to open log file!\n";
start_html();
if ($post_result == 0)
{
# Direct link, no post
# show_welcome();
$welcomewrong++;
updatecounter(3);
}
elsif ($post_result == 1)
{
#All required variables received
my $hash_rc = check_hash();
check_result($hash_rc);
}
elsif ($post_result == 2)
{
#Answer requested
my $hash_rc = check_hint_hash();
check_hint_result($hash_rc);
}
elsif ($post_result == 99)
{
#Introduction
updatecounter(3);
# show_intro();
show_firsttime();
show_rules();
exit;
}
else
{
destroyhash($post{hashkey});
show_error();
}
load_trivia();
show_intro();
maxwrong(0);
ask_question();
show_rules();
close (LOG);
end_html();
exit;
#sub check_result($result)
sub check_result($)
{
# Check results from an initial submission, ie: answering a question
my ($result) = (@_);
if ($post{hashkey} ne "") { destroyhash($post{hashkey}); }
if ($result == 0)
{
logprint("$ip - Correct answer in $answertimediff seconds: [$post{answer}]");
print "Congratulations, that was the correct answer!
\n";
updatecounter(1);
maxwrong(1);
offer_hint();
}
elsif ($result == 1) { logprint("$ip - Problem with submission in check_result"); }
elsif ($result == 2) { logprint("$ip - Parsing problem in check_result"); updatecounter(3); print "Error code: Problem with parsing
\n"; }
elsif ($result == 3) { logprint("$ip - Wrong Answer: [$post{answer}] in check_result ($answertimediff)"); updatecounter(2); print "Sorry, that was not the correct answer.
\n"; }
elsif ($result == 4) { logprint("$ip - Took too long ($answertimediff). Answer: [$post{answer}] in check_result"); updatecounter(2); print "Sorry, you took too long to answer.
\n"; }
else { print "Unknown error! \n"; }
}
#sub check_hint_result($result)
sub check_hint_result($)
{
# Check results from a submission for retrieving a puzzle piece
my ($result) = (@_);
destroyhash($post{hashkey});
if ($result == 0)
{
updatecounter(3);
give_hint($post{puzzlepiece});
playagain();
end_html();
}
elsif ($result == 1) { logprint("$ip - Problem with submission in check_hint_result"); }
elsif ($result == 2) { logprint("$ip - Parsing problem in check_hint_result"); print "Error code: Problem with parsing
\n"; }
else { print "Unknown error! \n"; }
}
sub load_trivia
{
# Load the trivia file
if ($debug >1) { print "load_trivia()\n "; }
open (FILE, "$triviafile");
@questions = ;
close (FILE);
}
sub ask_question()
{
# Ask a question from the trivia file
if ($debug >1) { print "ask_question\n "; }
my $lines = @questions;
$totalquestions = $lines;
my $randomline = get_random($lines);
my $tmpquestion = $questions[$randomline];
my $result;
my $inputline;
my ($endtime,$answertime);
my @compare;
chomp($tmpquestion);
if ($debug >1) { print "[[$tmpquestion]] \n"; }
my $question = clean_question($tmpquestion);
@answers = clean_answers($tmpquestion);
foreach my $answerstmp (@answers)
{
if ($answers_tied) { $answers_tied = "$answers_tied|$answerstmp"; }
else { $answers_tied = "$answerstmp"; }
}
if ($debug > 0)
{
print "question: [$question] \n";
foreach my $tmp (@answers)
{
print "answer: [$tmp] \n";
}
print " ";
}
$startime = time;
print "You have $timeallowed seconds to answer the following question" . $wrongtext . ": \n \n";
print "$question \n \n";
create_form();
}
sub clean_question()
{
# Parse and clean up the question
my ($tmpquestion) = @_;
my @answers;
my ($foo,$question,@foo) = split('\"', $tmpquestion);
logprint("$ip - Question: $question");
return $question;
}
sub clean_answers()
{
# Parse and clean up the answer or answers
my ($tmpquestion) = @_;
my @answers;
my ($foo,$question,@foo) = split('\"', $tmpquestion);
@answers = ($foo[1]);
if ($foo[3]) { @answers = (@answers, $foo[3]); }
if ($foo[5]) { @answers = (@answers, $foo[5]); }
if ($foo[7]) { @answers = (@answers, $foo[7]); }
if ($foo[9]) { @answers = (@answers, $foo[9]); }
logprint("$ip - Potential answers: @answers");
return @answers;
}
sub playagain
{
print "Please click here to play again!\n";
}
sub offer_hint
{
# Build the form to allow the user to pick their hint
my ($coords) = @_;
my $inputline;
my $finalanswer;
$coords =~ s/[ .-]//g;
my @coords = split('',$coords);
$startime = time;
$answers_tied = "12345|foo";
my $hashid = create_hash_id($answers_tied);
print << "EOT";
Pick a letter from the following. Keep track of the result, I won't keep track of it for you. The format is the same Degrees and Minutes format Geocaching.com uses.
EOT
end_html();
}
#sub give_hint($postion)
sub give_hint($)
{
# Give the user the hint they a due
my ($position) = (@_);
my @puzzle;
$puzzle[0] = "A";
$puzzle[1] = "B";
$puzzle[2] = "C";
$puzzle[3] = "D";
$puzzle[4] = "E";
$puzzle[5] = "F";
$puzzle[6] = "G";
$puzzle[7] = "H";
$puzzle[8] = "I";
$puzzle[9] = "J";
$puzzle[10] = "K";
$puzzle[11] = "L";
$puzzle[12] = "M";
$puzzle[13] = "N";
logprint("$ip - Offered hint of $puzzle[$position]=$coordinates[$position]");
$puzzle[$position] = "" . $coordinates[$position] . "";
print "Here is your hint, please keep track of the results as this program does not!
\n";
print "Your answer is: $coordinates[$position] or see below:
EOT
}
sub logprint
{
# Print the passed data to the log file
my ($log) = @_;
my $time = time;
my $timestring = localtime;
print LOG "$timestring - $log\n";
}
sub start_html
{
print << "EOT";
$wpname
EOT
}
sub end_html
{
print << "EOT";
\n
EOT
exit;
}
sub maxwrong(*)
{
# Limit wrong or page refreshing to minimize screen scraping
# Basic idea is it creates a file from the users IP and logs
# the last time they answered and how many wrong answers. If
# they exceed the limit, lock them out for a period. When the
# period expires, delete the file. Also have a cron job which
# cleans out old files in case they don't clear it themselves,
# also prevents old attempts from affecting current attempts.
my ($arg) = (@_);
my $attempts = 0;
my $filetime = time;
my $line;
if ($debug > 1) { print "maxwrong($arg); \n"; }
# my $ipdigest = md5_hex($ip);
my $ipdigest = $ip;
my $wrongfile = $hashpath . "wrong." . $ipdigest;
open (WRONGFILE_R, "$wrongfile");
$line = ;
if ($line ne "")
{
($filetime,$attempts) = split(" ",$line);
# my $attemptsleft = $maxwrong - $attempts;
# if ($attemptsleft && $post_result && !($arg)) { $wrongtext = " ($attemptsleft attempts remaining)"; }
# if ($welcomewrong && $attemptsleft) { $wrongtext = " ($attemptsleft attempts remaining)"; }
#if ($debug && !$arg) { print "max wrong line: $line
"; }
}
my $attemptsleft = $maxwrong - $attempts;
$wrongtext = " ($attemptsleft of $maxwrong incorrect submissions remaining)";
close (WRONGFILE_R);
unless ($arg == 1)
{
if ("$attempts" eq "") { $attempts = 0; }
elsif ($attempts >= $maxwrong) { maxwrong_info($filetime); return; }
}
open(WRONGFILE_W,">$wrongfile") || print "Unable to open file $wrongfile!\n";
if ($arg == 0)
{
$attempts++;
# First time, or current time?
# print WRONGFILE_W $filetime . " " . $attempts;
print WRONGFILE_W time . " " . $attempts;
}
if ($arg == 1)
{
$attempts--;
if ($attempts > 0) { print WRONGFILE_W $filetime . " " . $attempts; }
else { print WRONGFILE_W "0"; }
}
close (WRONGFILE_W);
}
#sub maxwrong_info($filetime)
sub maxwrong_info($)
{
# Display information around when a user exceeds their maximum number of attempts
my ($filetime) = (@_);
my $wrongfile = $hashpath . "wrong." . $ip;
my $timetest = time - $filetime;
if ($timetest > $maxwrongtime)
{
print "You had previously made too many incorrect submissions, but that time period has elapsed. You may play again.
";
logprint("$ip - Resetting wrong attempts");
unlink $wrongfile;
maxwrong(0);
return;
}
my $remaintime = $maxwrongtime - $timetest;
$remaintime = s2m($remaintime);
print "Too many incorrect submissions or refreshes, please try again in " . $remaintime . "!
\n";
logprint("$ip - Too many wrong attempts - $remaintime remain");
playagain();
show_rules();
end_html();
}
sub show_welcome
{
# Not currently used
logprint("$ip - New Player/Entry");
print "Welcome new or returning player!
";
}
sub show_intro
{
# Show some minimal intro information, don't distract from the game itself
if ($debug >1) { print "show_intro()\n "; }
print << "EOT";
Thank you for playing, and good luck! Do not use the back or refresh
button in your browser or you might be denied answers. See the bottom
of the page for the basic rules.
EOT
}
sub show_firsttime
{
# Show some minimal intro information, don't distract from the game itself
if ($debug >1) { print "show_firsttime()\n "; }
logprint("$ip - Viewing first time intro");
my $maxwrongtimestr = s2m($maxwrongtime);
print << "EOT";
This is a Trivia based Mystery cache program which you must play in order to find
the coordinates to $wpname. The questions range from easy to difficult, and it is
up to you to pick the coordinates you wish to receive for a correct answer. There is
no limit to how many questions you can answer correctly, however, you are only allowed
$maxwrong incorrect attempts in $maxwrongtimestr or you must wait until the time
period expires. This includes incorrect answers, attempts to re-submit answers, refreshes,
etc. Once you answer a question correctly, you have up to 15 minutes to pick a hint to
receive.
I hope you have fun with the trivia questions and finding the cache, I had fun writing
this program to facilitate it. The logging requirements for this cache are documented on the
cache page, and this program does not attempt to enforce any requirements upon players based on
any names or IDs. It is up to each player to follow the rules.
This program creates no cookies, requires no authentication, will not ask for any username or ID,
and only does basic server-side tracking of submissions to minimize the chances of players cheating and getting
free answers. Minimal Javascript is employed to auto-select the input field and to give the user
a count-down timer so they can see how much time remains to answer a question. This Javascript
does not otherwise affect gameplay, so you may play this game even with Javascript blocking turned
on in your browser. I have tested this program on a variety of browsers: Firefox 3, Google Chrome,
Mozilla, Konqueror, Opera Mobile and Skyfire (Windows Mobile platform), as well as several text based
browsers such as links and lynx and all look and function correctly. Pocket Internet Explorer renders
the hint request and hint delivery odd if set to One Column view, but it is still usable.
If you have any particular issue with this program functionality, rules, or a particular
question, please contact me on my Geocaching.com profile page linked below. And in case
you are wondering, no, nobody really likes the phobia questions. :)
After you are done reading this and the basic rules of the game, you may press Play to begin.
EOT
}
sub show_error
{
updatecounter(2);
logprint("$ip - Blank or invalid input");
print "Blank or invalid input, please try again!
\n";
}
sub get_statstring
{
my ($correct,$incorrect,$totalhits) = readcounter();
my ($correct_percent,$incorrect_percent);
if ($correct + $incorrect)
{
# $correct_percent = sprintf("%d", ($correct / ($correct + $incorrect)) * 100);
$correct_percent = int($correct / ($correct + $incorrect) * 100 + .5);
# $incorrect_percent = sprintf("%d", ($incorrect / ($correct + $incorrect)) * 100);
$incorrect_percent = int($incorrect / ($correct + $incorrect) * 100 + .5);
}
else
{
$correct_percent = $incorrect_percent = 0;
}
# my $statstring = "Overall game stats: " . $correct_percent . "% (" . $correct . ") correct answers, " . $incorrect_percent . "% (" . $incorrect . ") incorrect answers. Total of " . $totalhits . " page hits.";
my $statstring = "Overall game stats: " . $correct . " correct answers " . "(" . $correct_percent . "%), " . $incorrect . " incorrect answers (" . $incorrect_percent . "%). Total of " . $totalhits . " page hits.";
if ($totalquestions) { $statstring = $statstring . " " . $totalquestions . " total questions."; }
return($statstring);
}
sub show_rules
{
# Print more verbose information about rules, info, etc
if ($debug >1) { print "show_rules()\n "; }
my $statstring = get_statstring();
my $maxwrongtimestr = s2m($maxwrongtime);
print << "EOT";
Here are the fairly simple rules/info for this game:
$statstring
In case you got here from some other location, this is a trivia puzzle cache program for $wpname
This program maintains no record of your play except for very minimal logging of the following items
Questions asked, time taken to answer, your answer, coordinates given for correct answers, and combined stats from all players
You may make $maxwrong incorrect submissions
If you exceed this number, you must wait $maxwrongtimestr after which you are allowed to play again
You may make unlimited correct attempts
Answers are not case sensitive
Trivia questions may have one or more possible answers
Trivia questions may have multiple word answers
Just type in the words/phrase with spaces, no quotes
Questions were collected from years of playing Pyroto Mountain and may or may not resemble questions from other games
The full source for this program may be viewed here
This is a symlink to the actual source, you are seeing the live code, with the exception of the coordinates which are in a separate module
EOT
}
sub create_form
{
# Create the initial form to submit an answer
my (@hashdata) = @_;
my $hashid = create_hash_id($answers_tied);
print << "EOT";
EOT
}
sub check_post
{
# Check the results being sent from the browser
%post = $query->Vars;#gets 'post' or 'get' data in name/value pairs
print $query->header();
if ($debug > 1)
{
foreach my $param (keys %post)
{
print "$param = $post{$param} \n";
}
}
if ($debug >1) { print " ---------
"; }
if ($post{intro}) { return 99; }
if ($post{hashkey} eq "" && $post{answer} eq "") { return 0; }
if ($post{hashkey} ne "" && $post{answer} ne "") { return 1; }
if ($post{hashkey} ne "" && $post{puzzlepiece} ne "") { return 2; }
else { return 3; }
}
sub check_answer
{
# Check the answer given by the user
my ($hashdata) = @_;
my $time = time;
my ($answer,$startime,@answerstmp) = split('\|',$hashdata);
$answertimediff = $time - $startime;
if ($answertimediff > $timeallowed) { return 4; }
if ($debug >1) { print "answer: $answer startime: $startime answers: @answers\n "; }
my $result = 3;
foreach my $possibility (@answerstmp)
{
if (lc($answer) eq lc($possibility)) { $result = 0; }
}
return $result;
}
sub check_hash
{
# Check the hash key we generate to reduce any potential cheating
my $result;
if ($post{hashkey})
{
my $hashcheck = check_hash_file($post{hashkey});
if ( $hashcheck )
{
my $postanswer = $post{answer};
$postanswer =~ s/[|]//g;
my $hashdata = "$postanswer|$hashcheck";
if ($debug >1) { print "hashdata: $hashdata\n "; }
$result = check_answer($hashdata);
}
else
{
print "Please don't attempt to re-post answers to the same question multiple times. If you feel you are seeing the message and should not be, please let me know.
\n";
logprint("$ip - Hash check failed in check_hash!");
$result = 1;
}
}
else { $result = 2; }
return($result);
}
sub check_hint_hash
{
# Same as check_hash, but specific to the hint, maybe we can combine these sometime
# Basically checking the same thing..
my $result;
if ($post{hashkey})
{
if ($debug > 1) { print "We have [$post{hashkey}]\n "; }
my $hashcheck = check_hash_file($post{hashkey});
if ( $hashcheck )
{
if ($debug >1) { print "inside hint hashcheck: $hashcheck\n "; }
$result = 0
}
else
{
if ($debug > 1) { print "Something naughty is going on in check_hint_hash!! Hash check failed! Posted: $post{hashkey}, saved: \n\n
"; }
print "Please don't attempt to re-submit hint requests multiple times. If you feel you are seeing the message and should not be, please let me know.
\n";
logprint("$ip - Hash check failed in check_hint_hash!");
$result = 1;
}
}
else { $result = 2; }
return($result);
}
sub create_hash_id
{
# Create a hash file id (token) to store on the disk and reference upon answer or hint request
if ($debug > 1) { print "create_hash_id() \n"; }
my ($answers_tiedtmp) = @_;
my $hash;
my $hashtime = time;
$hash = $hashsalt . $hashtime;
my $digest = md5_hex($hash);
$digest = "hash." . $digest;
my @tmphash = ($digest,$answers_tiedtmp);
create_tmp_hash(@tmphash);
return "$digest";
}
sub create_tmp_hash
{
# Create the hash file itself
#hash|startime|answer1|answer2|answer3 etc
my ($hashfile,$answers_tiedtmp) = @_;
if ($debug >1) { print "Creating hash file for validation..\n "; }
my $hashoutput = "$hashpath" . "$hashfile";
my $hashdata = "$startime|$answers_tiedtmp";
open(HASH,">$hashoutput") || print "Unable to open hash file $hashoutput!\n";
print HASH "$hashdata\n";
close(HASH);
}
sub check_hash_file
{
# Check the results of a hash post to verify the page wasn't modified
my ($hashfile) = @_;
my ($result,$hashline,$startime,@answers);
my $hashoutput = "$hashpath" . "$hashfile";
# open(HASH,"$hashoutput") || print "Unable to open hash file\n";
open(HASH,"$hashoutput") || return 0;
if ($debug > 1) { print "Loading $hashoutput file\n "; }
$hashline = ;
chomp($hashline);
if ($debug > 1) { print "hashline: $hashline\n "; }
($startime,@answers) = split('\|',$hashline);
if ($debug > 1) { print "startime: $startime answers: @answers\n "; }
close(HASH);
logprint("$ip - Check hash: $hashfile, resulting startime: $startime and answers: @answers");
if ($startime && @answers)
{
if ($debug >1) { print "Have startime and answers\n "; }
$result = "$hashline";
}
else { $result = 0; }
return $result;
}
sub destroyhash(*)
{
# Remove the hash file once it's used
my ($hash) = (@_);
my $hashfile = $hashpath . $hash;
unlink($hashfile);
}
#sub s2m($seconds)
sub s2m($)
{
# Output pretty minutes or seconds based on passed in seconds
my ($seconds) = (@_);
my $timeremain;
if ($seconds > 60)
{
$timeremain = int($seconds / 60);
if ($timeremain == 1) { return "$timeremain minute"; }
else { return "$timeremain minutes"; }
}
return "$seconds seconds";
}
#sub get_random($number)
sub get_random($)
{
# Return a random number for the question pool
my ($lines) = (@_);
$lines--;
my $random = int(rand($lines));
$random++;
if ($debug) { print "total lines: $lines random line chosen (but not currently actually used): $random
\n"; return 20; }
unless ($debug) { return $random; }
}
sub updatecounter
{
# Update a specific counter
# Input: Counter to update (1 = correct+total, 2 = incorrect+total, 3 = totalhits)
my ($counter) = (@_);
my ($correct_tmp,$incorrect_tmp,$totalhits_tmp) = readcounter();
if ($counter == 1) { $correct_tmp++; $totalhits_tmp++; }
if ($counter == 2) { $incorrect_tmp++; $totalhits_tmp++; }
if ($counter == 3) { $totalhits_tmp++; }
writecounter($correct_tmp,$incorrect_tmp,$totalhits_tmp);
}
sub readcounter
{
# Read the counters
if ($debug > 1) { print "read counter \n"; }
my $flock = tie my @array, "Tie::File", $counterfile;
$flock->flock;
my $lines = @array;
my ($correct_tmp,$incorrect_tmp,$totalhits_tmp) = split('\|',$array[--$lines]);
untie @array;
return ($correct_tmp,$incorrect_tmp,$totalhits_tmp);
}
#sub writecounter($correct_tmp,$incorrect_tmp,$totalhits_tmp)
sub writecounter($$$)
{
# Write to the counters
# For now, we append. At some point, I'm going to change it to over-write
if ($debug > 1) { print "write counter\n"; }
my ($correct_tmp,$incorrect_tmp,$totalhits_tmp) = (@_);
open(COUNTER_W,">>$counterfile") || print "Unable to open file $counterfile for writing!\n";
flock COUNTER_W, 2;
seek COUNTER_W, 0, 0;
print COUNTER_W $correct_tmp . "|" . $incorrect_tmp . "|" . $totalhits_tmp . "\n";
close(COUNTER_W);
}