1 ###RUN_PERL: #!/usr/bin/perl
4 # 2words is generated from 2words.1.pl.
6 # The wordgame interface
8 # Copyright (C) 2016, 2017, 2023, 2024 Balthasar SzczepaĆski
10 # This program is free software: you can redistribute it and/or modify
11 # it under the terms of the GNU Affero General Public License as
12 # published by the Free Software Foundation, either version 3 of the
13 # License, or (at your option) any later version.
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU Affero General Public License for more details.
20 # You should have received a copy of the GNU Affero General Public License
21 # along with this program. If not, see <http://www.gnu.org/licenses/>.
25 # use Encode::Locale ('decode_argv');
26 use Encode ('encode', 'decode');
28 ###PERL_LIB: use lib /botm/lib/bsta
31 'http_header_status', 'http_header_allow',
34 'html_entity_encode_dec',
35 'url_query_decode', 'url_query_encode',
39 'STATE', 'INTF_STATE',
41 'fail_method', 'fail_content_type',
42 'print_html_start', 'print_html_end',
43 'print_html_head_start', 'print_html_head_end',
44 'print_html_body_start', 'print_html_body_end',
46 'get_remote_addr', 'get_password',
49 'read_story', 'write_story',
50 'read_settings', 'read_state'
53 ###PERL_CGI_PATH: CGI_PATH = /bsta/
54 ###PERL_CGI_2WORDS_PATH: CGI_2WORDS_PATH = /bsta/2words
56 ###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story
58 ###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
60 ###PERL_STORY_LENGTH: STORY_LENGTH = 16
61 ###PERL_PAGE_LENGTH: PAGE_LENGTH = 16
62 ###PERL_FIRSTPAGE_LENGTH: FIRSTPAGE_LENGTH = 4
64 binmode STDIN, ':encoding(UTF-8)';
65 binmode STDOUT, ':encoding(UTF-8)';
66 binmode STDERR, ':encoding(UTF-8)';
105 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
106 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
108 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
112 exit fail_method($ENV{'REQUEST_METHOD'}, ['GET','POST', 'HEAD']);
115 %http = read_header_env(\%ENV);
116 %cgi = url_query_decode($ENV{'QUERY_STRING'});
118 if ($method eq 'POST') {
119 if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
120 my %cgi_post = url_query_decode( <STDIN> );
121 %cgi = merge_settings(\%cgi, \%cgi_post);
123 # multipart not supported
125 exit fail_content_type($method, $http{'content-type'});
129 $IP = get_remote_addr();
130 $page = get_id(\%cgi);
131 $password = get_password(\%cgi);
132 if ($cgi{'words'} ne '') {
133 $words = $cgi{'words'};
136 %settings = read_settings();
137 %state = read_state();
138 $ong_state = int($state{'state'});
140 $password_ok = ($password eq $settings{'password'});
146 if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) {
151 %story = read_story($fh);
153 if ($story{'lastip'} =~ /^.+$/) {
160 $last_letter = lc($story{'letter'});
161 $story_id = int($story{'id'});
162 $intf_pass = int($story{'pass'});
163 $intf_state = int($story{'state'});
164 $intf_mode = $intf_state & INTF_STATE->{'mode'};
165 $intf_pause = $intf_state & INTF_STATE->{'||'};
167 if ($IP ne $last_IP) {
175 ($intf_state < 0) || (
176 ($method eq 'POST') && (
177 ($cgi{'clear'} ne '') ||
178 ($cgi{'clear_all'} ne '')
183 ($cgi{'clear_all'} ne '') ||
188 $story{'content'} = '';
189 $story{'lastip' } = '0.0.0.0';
190 $story{'letter' } = '';
192 $story{'state' } = INTF_STATE->{'X'};
194 if ($ong_state == STATE->{'inactive'}) {
203 write_story($fh, \%story);
206 if (($words ne '') && ($method eq 'POST')) {
211 $status = HTTP_STATUS->{'forbidden'};
212 $message = "It's not your turn.";
214 # TODO: consider allowing non-ASCII letters in words.
215 # (not very important in English language)
217 ($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) ||
218 ($password_ok && ($words ne ''))
221 $first_letter = lc(substr($2, 0, 1));
222 $second_letter = lc(substr($4, 0, 1));
224 ($first_letter ne $last_letter) &&
225 ($last_letter ne '') &&
228 $status = HTTP_STATUS->{'bad_request'};
229 $message = 'The first word must start with '.uc($last_letter).'.';
232 ($first_letter eq $second_letter) &&
235 $status = HTTP_STATUS->{'bad_request'};
236 $message = 'The second word can\'t also start with '.uc($first_letter).'.';
241 $story{'content'} = $story{'content'} . $words."\n";
243 $story{'lastip'} = $IP;
244 $story{'letter'} = $second_letter;
246 if ($cgi{'next'} ne '') {
250 (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1))
252 # store finished game
253 write_story($story_id, \%story);
255 $new_story{'id' } = $story_id + 1;
256 $new_story{'letter' } = '';
257 $new_story{'lastip' } = $IP;
258 $new_story{'content'} = '';
259 $new_story{'pass' } = 0;
260 $new_story{'state' } = INTF_STATE->{'X'};
261 # reset hidden interface
262 $intf_state = INTF_STATE->{'X'};
264 $intf_mode = INTF_STATE->{'X'};
266 if($ong_state == STATE->{'inactive'}) {
267 # ONG not activated yet; reset index
277 write_story($fh, \%new_story);
280 $message = 'To early to finish this wordgame.';
281 write_story($fh, \%story);
286 if ($intf_pass == 1) {
287 # hidden interface was already active; deactivate
290 if($ong_state == STATE->{'inactive'}) {
300 elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) {
301 # correct password for the hidden interface!
302 if ($intf_pass != 0) {
303 $message = 'The password has already been used in this story.';
305 elsif ($ong_state != STATE->{'inactive'}) {
306 # ONG already active, nothing to do here
315 'i', # ID: tape interface
316 $time, # ONG time; not relevant
317 0, # timer; not relevant
318 0, # update; not relevant
320 \%settings, # not relevant
321 '', # %default; not relevant
322 '', # %frame_data; not relevant
323 '' # $goto_list; not relevant
329 $time, # ONG time; not relevant
330 0, # timer; not relevant
331 0, # update; not relevant
336 '' # $goto_list; not relevant
343 $time, # ONG time; might get overwritten later
354 # new state of hidden interface
356 $intf_state = INTF_STATE->{'X'};
357 $intf_mode = INTF_STATE->{'X'};
360 $story{'state'} = INTF_STATE->{'X'};
371 write_story($fh, \%story);
376 $status = HTTP_STATUS->{'bad_request'};
377 $message = 'Please, two words, not more, not less (some punctuation is allowed).';
383 ($ong_state == STATE->{'inactive'})
385 $intf_state = int($cgi{'s'}) & INTF_STATE->{'mask'};
386 $intf_mode = $intf_state & INTF_STATE->{'mode'};
387 $intf_pause = $intf_state & INTF_STATE->{'||'};
388 $story{'state'} = $intf_state;
396 write_story($fh, \%story);
398 @story_lines = split(/\r?\n/, $story{'content'});
399 if(@story_lines & 1) {
407 print http_header_status($status);
410 print http_header_allow($allow);
412 print "Content-type: text/html; charset=UTF-8\n\n";
414 if($method eq 'HEAD') {
418 my $max_page = int(($story_id + PAGE_LENGTH - FIRSTPAGE_LENGTH - 1) / PAGE_LENGTH);
419 my $newer_available = ($page > 0);
420 my $older_available = ($page < $max_page);
421 my $show_intf = ($intf_pass == 1) && ($ong_state == STATE->{'inactive'});
425 (($page-1) * PAGE_LENGTH ) + FIRSTPAGE_LENGTH
428 my $id_stop = $story_id-1 - (($page*PAGE_LENGTH) + FIRSTPAGE_LENGTH);
433 my $bsta_url = CGI_PATH;
434 my $twowords_url = CGI_2WORDS_PATH;
438 my $newest_url = merge_url(
439 {'path' => $twowords_url},
442 if ($newer_available) {
443 $newer_url = merge_url(
444 {'path' => $twowords_url},
448 if ($older_available) {
449 $older_url = merge_url(
450 {'path' => $twowords_url},
453 $oldest_url = merge_url(
454 {'path' => $twowords_url},
455 {'path' => $max_page}
458 my $button_4_url = merge_url(
459 {'path' => $twowords_url},
460 {'query' => {'s' => (INTF_STATE->{'>'} | $intf_pause)}}
462 my $button_3_url = merge_url(
463 {'path' => $twowords_url},
464 {'query' => {'s' => (INTF_STATE->{'<<'} | $intf_pause)}}
466 my $button_2_url = merge_url(
467 {'path' => $twowords_url},
468 {'query' => {'s' => (INTF_STATE->{'>>'} | $intf_pause)}}
470 my $button_1_url = merge_url(
471 {'path' => $twowords_url},
472 {'query' => {'s' => INTF_STATE->{'X'}}}
474 my $button_0_url = merge_url(
475 {'path' => $twowords_url},
476 {'query' => {'s' => ($intf_pause ? $intf_mode : ($intf_mode | INTF_STATE->{'||'}))}}
478 my $button_5_img = merge_url(
479 {'path' => CGI_PATH()},
480 {'path' => 'intf-20.gif'}
482 my $button_4_img = merge_url(
483 {'path' => CGI_PATH()},
484 {'path' => 'intf-10'.(($intf_mode == INTF_STATE->{'>'}) ? '_' : '').'.gif'}
486 my $button_3_img = merge_url(
487 {'path' => CGI_PATH()},
488 {'path' => 'intf-08'.(($intf_mode == INTF_STATE->{'<<'}) ? '_' : '').'.gif'}
490 my $button_2_img = merge_url(
491 {'path' => CGI_PATH()},
492 {'path' => 'intf-04'.(($intf_mode == INTF_STATE->{'>>'}) ? '_' : '').'.gif'}
494 my $button_1_img = merge_url(
495 {'path' => CGI_PATH()},
496 {'path' => 'intf-02.gif'}
498 my $button_0_img = merge_url(
499 {'path' => CGI_PATH()},
500 {'path' => 'intf-01'.($intf_pause ? '_' : '').'.gif'}
502 my $intf_img_id = '';
503 if ($intf_state == INTF_STATE->{'>'}) {
506 elsif ($intf_mode == INTF_STATE->{'<<'}) {
509 elsif ($intf_mode == INTF_STATE->{'>>'}) {
512 my $intf_img = merge_url(
513 {'path' => CGI_PATH()},
514 {'path' => 'intf-00'.$intf_img_id.'.gif'}
518 my $password_query = url_query_encode({'p', $settings{'password'}});
519 $twowords_url = merge_url($twowords_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
520 $newest_url = merge_url($newest_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
521 $newer_url = merge_url($newer_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
522 $older_url = merge_url($older_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
523 $button_4_url = merge_url($button_4_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
524 $button_3_url = merge_url($button_3_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
525 $button_2_url = merge_url($button_2_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
526 $button_1_url = merge_url($button_1_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
527 $button_0_url = merge_url($button_0_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
530 my $_password = $password_ok ? html_entity_encode_dec($settings{'password'}, 1): '';
531 my $_bsta_url = html_entity_encode_dec($bsta_url , 1);
532 my $_twowords_url = html_entity_encode_dec($twowords_url , 1);
533 my $_newest_url = html_entity_encode_dec($newest_url , 1);
534 my $_newer_url = html_entity_encode_dec($newer_url , 1);
535 my $_older_url = html_entity_encode_dec($older_url , 1);
536 my $_oldest_url = html_entity_encode_dec($oldest_url , 1);
537 my $_button_4_url = html_entity_encode_dec($button_4_url , 1);
538 my $_button_3_url = html_entity_encode_dec($button_3_url , 1);
539 my $_button_2_url = html_entity_encode_dec($button_2_url , 1);
540 my $_button_1_url = html_entity_encode_dec($button_1_url , 1);
541 my $_button_0_url = html_entity_encode_dec($button_0_url , 1);
542 my $_button_5_img = html_entity_encode_dec($button_5_img , 1);
543 my $_button_4_img = html_entity_encode_dec($button_4_img , 1);
544 my $_button_3_img = html_entity_encode_dec($button_3_img , 1);
545 my $_button_2_img = html_entity_encode_dec($button_2_img , 1);
546 my $_button_1_img = html_entity_encode_dec($button_1_img , 1);
547 my $_button_0_img = html_entity_encode_dec($button_0_img , 1);
548 my $_intf_img = html_entity_encode_dec($intf_img , 1);
549 my $_message = html_entity_encode_dec($message , 1);
550 my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
552 print_html_start(\*STDOUT);
553 print_html_head_start(\*STDOUT);
556 print ' <title>Two words • '.$_website_name.'</title>'."\n";
557 print ' <link rel="start" href="'.$_oldest_url.'">'."\n";
558 if ($older_available) {
559 print ' <link rel="prev" href="'.$_older_url.'">'."\n";
561 if ($newer_available) {
562 print ' <link rel="next" href="'.$_newer_url.'">'."\n";
565 print_html_head_end(\*STDOUT);
566 print_html_body_start(\*STDOUT);
568 print ' <div id="inst" class="ins">'."\n";
570 print ' <div id="title">'."\n";
571 print ' <h1 id="titletext">Two words</h1>'."\n";
572 print ' </div>'."\n";
575 print ' <div id="storypuzzle">'."\n";
576 for (my $i = 0; $i < @story_lines; ++$i) {
577 print ' <span class="'.($turn ? 'ni':'br').'">'.html_entity_encode_dec($story_lines[$i], 1).'</span>'."\n";
580 print ' </div>'."\n";
582 print ' <div id="command">'."\n";
583 if ($message ne '') {
584 print ' <span class="br">'.$_message.'</span>'."\n";
587 if ($turn || $password_ok) {
588 print ' <form method="post" action="'.$_twowords_url.'">'."\n";
589 if ($message eq '') {
590 if ($story{"content"} eq '') {
591 print ' Two words, please:<br>'."\n";
594 print ' Please continue, two words:<br>'."\n";
597 print ' <input class="intx" type="text" name="words">'."\n";
598 print ' <input class="inbt" type="submit" value="enter">'."\n";
599 if ((@story_lines >= (STORY_LENGTH-1)) || $password_ok ) {
600 print ' <input class="inbt" type="submit" name="next" value="enter and then start a new one">'."\n";
603 print ' <input class="inbt" type="submit" name="clear" value="clear">'."\n";
604 print ' <input class="inbt" type="submit" name="clear_all" value="clear all">'."\n";
605 print ' <input type="hidden" name="p" value="'.$_password.'">'."\n";
607 print ' </form>'."\n";
610 if ($message eq '') {
611 print ' Wait for it.'."\n";
614 print ' </div>'."\n";
616 elsif ($message ne '') {
617 print ' <div id="command">'."\n";
618 print ' <span class="br">'.$_message.'</span>'."\n";
619 print ' </div>'."\n";
621 print ' </div>'."\n";
624 print ' <div id="framespace">'."\n";
625 print ' <table id="intftable" cellspacing="0" cellpadding="0">'."\n";
626 print ' <tr class="intf">'."\n";
627 print ' <td colspan="6" class="intf"><img src="'.$_intf_img.'" alt="" class="intf"></td>'."\n";
630 print ' <tr class="intf">'."\n";
631 print ' <td class="intf"><img src="'.$_button_5_img.'" alt="o" class="intf"></td>'."\n";
632 print ' <td class="intf"><a href="'.$_button_4_url.'"><img src="'.$_button_4_img.'" class="intf" alt=">"></a></td>'."\n";
633 print ' <td class="intf"><a href="'.$_button_3_url.'"><img src="'.$_button_3_img.'" class="intf" alt="<<"></a></td>'."\n";
634 print ' <td class="intf"><a href="'.$_button_2_url.'"><img src="'.$_button_2_img.'" class="intf" alt=">>"></a></td>'."\n";
635 print ' <td class="intf"><a href="'.$_button_1_url.'"><img src="'.$_button_1_img.'" class="intf" alt="^"></a></td>'."\n";
636 print ' <td class="intf"><a href="'.$_button_0_url.'"><img src="'.$_button_0_img.'" class="intf" alt="||"></a></td>'."\n";
638 print ' </table>'."\n";
639 print ' </div>'."\n";
642 print ' <div id="insb" class="ins">'."\n";
644 print ' <div id="undertext">'."\n";
645 for (my $i = $id_start; $i > $id_stop; --$i) {
646 %new_story = read_story($i);
647 print ' <p class="'.(($i&1)?'br':'ni').'" id="s'.$i.'">'.html_entity_encode_dec($new_story{'content'}).'</p>'."\n";
649 print ' </div>'."\n";
651 print ' <div id="underlinks">'."\n";
652 print ' <a href="'.$_bsta_url.'">BSTA</a> |'."\n";
653 print ' <a href="'.$_twowords_url.'">Once again</a>';
654 if ($older_available) {
656 print ' <a href="'.$_older_url.'">Before</a>';
658 if ($newer_available) {
660 print ' <a href="'.$newer_url.'">Unbefore</a>';
662 if ($older_available) {
664 print '<a href="'.$_oldest_url.'">Initially</a>';
668 print ' (Entering words here is irreversible. Your actions might be remembered forever. So please be reasonable.)';
671 print ' </div>'."\n";
673 print ' </div>'."\n";
675 print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'});
676 print_html_end(\*STDOUT);