[submodule "config"]
path = config
url = ../../botm/config
-[submodule "exec"]
- path = exec
- url = ../../botm/exec
[submodule "botm-common"]
path = botm-common
url = ../../botm/common-perl
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/2words
-# 2words is generated from 2words.1.pl.
-#
-# The wordgame interface
-#
-# Copyright (C) 2016, 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'http_header_status', 'http_header_allow',
- 'merge_url',
- 'read_header_env',
- 'html_entity_encode_dec',
- 'url_query_decode', 'url_query_encode',
- 'open_encoded'
-);
-use bsta_lib (
- 'STATE', 'INTF_STATE',
- 'get_id',
- 'fail_method', 'fail_content_type',
- 'print_html_start', 'print_html_end',
- 'print_html_head_start', 'print_html_head_end',
- 'print_html_body_start', 'print_html_body_end',
- 'write_index',
- 'get_remote_addr', 'get_password',
- 'merge_settings',
- 'ong',
- 'read_story', 'write_story',
- 'read_settings', 'read_state'
-);
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_CGI_2WORDS_PATH: CGI_2WORDS_PATH = /bsta/2words
-
-###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story
-
-###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
-
-###PERL_STORY_LENGTH: STORY_LENGTH = 16
-###PERL_PAGE_LENGTH: PAGE_LENGTH = 16
-###PERL_FIRSTPAGE_LENGTH: FIRSTPAGE_LENGTH = 4
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my %http;
-my %cgi;
-my %story;
-my %new_story;
-my %settings;
-my %state;
-
-my $time = time();
-srand ($time-$$);
-
-my $method;
-my $IP;
-my $words;
-my $color2;
-my $last_IP;
-my $story_id;
-my $turn;
-my $status;
-my $allow;
-my $message;
-my $first_letter;
-my $second_letter;
-my $last_letter;
-my $intf_state;
-my $intf_pass;
-my $intf_pause;
-my $intf_mode;
-my $fh;
-my $story_lock;
-my @story_lines;
-my $ong_state;
-my $page;
-my $password;
-my $password_ok;
-
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else {
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET','POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-$IP = get_remote_addr();
-$page = get_id(\%cgi);
-$password = get_password(\%cgi);
-if ($cgi{'words'} ne '') {
- $words = $cgi{'words'};
-}
-
-%settings = read_settings();
-%state = read_state();
-$ong_state = int($state{'state'});
-
-$password_ok = ($password eq $settings{'password'});
-if ($password_ok) {
- $IP .= ' OK';
-}
-
-$story_lock=0;
-if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) {
- $story_lock=1;
- if (flock($fh,2)) {
- $story_lock=2;
- }
- %story = read_story($fh);
-
- if ($story{'lastip'} =~ /^.+$/) {
- $last_IP=$&;
- }
- else {
- $last_IP='0.0.0.0';
- }
-
- $last_letter = lc($story{'letter'});
- $story_id = int($story{'id'});
- $intf_pass = int($story{'pass'});
- $intf_state = int($story{'state'});
- $intf_mode = $intf_state & INTF_STATE->{'mode'};
- $intf_pause = $intf_state & INTF_STATE->{'||'};
-
- if ($IP ne $last_IP) {
- $turn = 1;
- }
- else {
- $turn = 0;
- }
-
- if (
- ($intf_state < 0) || (
- ($method eq 'POST') && (
- ($cgi{'clear'} ne '') ||
- ($cgi{'clear_all'} ne '')
- )
- )
- ) {
- if (
- ($cgi{'clear_all'} ne '') ||
- ($intf_state < -1)
- ) {
- $story{'id'} = 0;
- }
- $story{'content'} = '';
- $story{'lastip' } = '0.0.0.0';
- $story{'letter' } = '';
- $story{'pass' } = 0;
- $story{'state' } = INTF_STATE->{'X'};
- $turn = 0;
- if ($ong_state == STATE->{'inactive'}) {
- write_index(
- \%state,
- \%settings,
- $story{'pass'},
- $story{'state'},
- 0 # pause
- );
- }
- write_story($fh, \%story);
- }
-
- if (($words ne '') && ($method eq 'POST')) {
- if (
- (!$turn) &&
- (!$password_ok)
- ) {
- $status = HTTP_STATUS->{'forbidden'};
- $message = "It's not your turn.";
- }
- # TODO: consider allowing non-ASCII letters in words.
- # (not very important in English language)
- elsif (
- ($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) ||
- ($password_ok && ($words ne ''))
- ) {
- # we have 2 words
- $first_letter = lc(substr($2, 0, 1));
- $second_letter = lc(substr($4, 0, 1));
- if (
- ($first_letter ne $last_letter) &&
- ($last_letter ne '') &&
- (!$password_ok)
- ) {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'The first word must start with '.uc($last_letter).'.';
- }
- elsif (
- ($first_letter eq $second_letter) &&
- (!$password_ok)
- ) {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'The second word can\'t also start with '.uc($first_letter).'.';
- }
- else {
- # words are valid
- # update state
- $story{'content'} = $story{'content'} . $words."\n";
- $turn = 0;
- $story{'lastip'} = $IP;
- $story{'letter'} = $second_letter;
-
- if ($cgi{'next'} ne '') {
- # start next game
- if (
- $password_ok ||
- (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1))
- ) {
- # store finished game
- write_story($story_id, \%story);
- # init new game
- $new_story{'id' } = $story_id + 1;
- $new_story{'letter' } = '';
- $new_story{'lastip' } = $IP;
- $new_story{'content'} = '';
- $new_story{'pass' } = 0;
- $new_story{'state' } = INTF_STATE->{'X'};
- # reset hidden interface
- $intf_state = INTF_STATE->{'X'};
- $intf_pass = 0;
- $intf_mode = INTF_STATE->{'X'};
- $intf_pause= 0;
- if($ong_state == STATE->{'inactive'}) {
- # ONG not activated yet; reset index
- write_index(
- \%state,
- \%settings,
- $intf_pass,
- $intf_mode,
- $intf_pause
- );
- }
- # save new game
- write_story($fh, \%new_story);
- }
- else {
- $message = 'To early to finish this wordgame.';
- write_story($fh, \%story);
- }
- }
- else {
- # continue the game
- if ($intf_pass == 1) {
- # hidden interface was already active; deactivate
- $intf_pass = 2;
- $story{'pass'} = 2;
- if($ong_state == STATE->{'inactive'}) {
- write_index(
- \%state,
- \%settings,
- $intf_pass,
- $intf_mode,
- $intf_pause
- );
- }
- }
- elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) {
- # correct password for the hidden interface!
- if ($intf_pass != 0) {
- $message = 'The password has already been used in this story.';
- }
- elsif ($ong_state != STATE->{'inactive'}) {
- # ONG already active, nothing to do here
- $message = "???";
- }
- else {
- # ready to activate?
- my $r;
-
- # ONG tape interface
- $r = ong(
- 'i', # ID: tape interface
- $time, # ONG time; not relevant
- 0, # timer; not relevant
- 0, # update; not relevant
- 0, # print
- \%settings, # not relevant
- '', # %default; not relevant
- '', # %frame_data; not relevant
- '' # $goto_list; not relevant
- );
- if ($r) {
- # ONG CFRT
- $r = ong(
- 'c', # ID: CFRT
- $time, # ONG time; not relevant
- 0, # timer; not relevant
- 0, # update; not relevant
- 0, # print
- \%settings,
- '', # %default
- '', # %frame_data
- '' # $goto_list; not relevant
- );
- }
- if ($r) {
- # ONG frame 0!
- $r = ong(
- 0, # frame ID
- $time, # ONG time; might get overwritten later
- 0, # timer
- 0, # update
- 0, # print
- \%settings,
- '', # %default
- '', # %frame_data
- '' # $goto_list
- );
- }
- if($r) {
- # new state of hidden interface
- $intf_pass = 1;
- $intf_state = INTF_STATE->{'X'};
- $intf_mode = INTF_STATE->{'X'};
- $intf_pause = 0;
- $story{'pass'} = 1;
- $story{'state'} = INTF_STATE->{'X'};
- write_index(
- \%state,
- \%settings,
- $intf_pass,
- $intf_mode,
- $intf_pause
- );
- }
- }
- }
- write_story($fh, \%story);
- }
- }
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Please, two words, not more, not less (some punctuation is allowed).';
- }
- }
- elsif (
- ($cgi{'s'} ne '') &&
- ($intf_pass == 1) &&
- ($ong_state == STATE->{'inactive'})
- ) {
- $intf_state = int($cgi{'s'}) & INTF_STATE->{'mask'};
- $intf_mode = $intf_state & INTF_STATE->{'mode'};
- $intf_pause = $intf_state & INTF_STATE->{'||'};
- $story{'state'} = $intf_state;
- write_index(
- \%state,
- \%settings,
- $intf_pass,
- $intf_mode,
- $intf_pause
- );
- write_story($fh, \%story);
- }
- @story_lines = split(/\r?\n/, $story{'content'});
- if(@story_lines & 1) {
- $turn = !$turn;
- }
-
- close($fh);
-}
-
-if ($status ne '') {
- print http_header_status($status);
-}
-if ($allow ne '') {
- print http_header_allow($allow);
-}
-print "Content-type: text/html; charset=UTF-8\n\n";
-
-if($method eq 'HEAD') {
- exit;
-}
-
-my $max_page = int(($story_id + PAGE_LENGTH - FIRSTPAGE_LENGTH - 1) / PAGE_LENGTH);
-my $newer_available = ($page > 0);
-my $older_available = ($page < $max_page);
-my $show_intf = ($intf_pass == 1) && ($ong_state == STATE->{'inactive'});
-my $id_start =
- $story_id-1 -(
- ($page == 0) ? 0 : (
- (($page-1) * PAGE_LENGTH ) + FIRSTPAGE_LENGTH
- )
- );
-my $id_stop = $story_id-1 - (($page*PAGE_LENGTH) + FIRSTPAGE_LENGTH);
-if ($id_stop < 0) {
- $id_stop = -1;
-}
-
-my $bsta_url = CGI_PATH;
-my $twowords_url = CGI_2WORDS_PATH;
-my $newer_url;
-my $older_url;
-my $oldest_url;
-my $newest_url = merge_url(
- {'path' => $twowords_url},
- {'path' => 0}
-);
-if ($newer_available) {
- $newer_url = merge_url(
- {'path' => $twowords_url},
- {'path' => $page-1}
- );
-}
-if ($older_available) {
- $older_url = merge_url(
- {'path' => $twowords_url},
- {'path' => $page+1}
- );
- $oldest_url = merge_url(
- {'path' => $twowords_url},
- {'path' => $max_page}
- );
-}
-my $button_4_url = merge_url(
- {'path' => $twowords_url},
- {'query' => {'s' => (INTF_STATE->{'>'} | $intf_pause)}}
-);
-my $button_3_url = merge_url(
- {'path' => $twowords_url},
- {'query' => {'s' => (INTF_STATE->{'<<'} | $intf_pause)}}
-);
-my $button_2_url = merge_url(
- {'path' => $twowords_url},
- {'query' => {'s' => (INTF_STATE->{'>>'} | $intf_pause)}}
-);
-my $button_1_url = merge_url(
- {'path' => $twowords_url},
- {'query' => {'s' => INTF_STATE->{'X'}}}
-);
-my $button_0_url = merge_url(
- {'path' => $twowords_url},
- {'query' => {'s' => ($intf_pause ? $intf_mode : ($intf_mode | INTF_STATE->{'||'}))}}
-);
-my $button_5_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-20.gif'}
-);
-my $button_4_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-10'.(($intf_mode == INTF_STATE->{'>'}) ? '_' : '').'.gif'}
-);
-my $button_3_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-08'.(($intf_mode == INTF_STATE->{'<<'}) ? '_' : '').'.gif'}
-);
-my $button_2_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-04'.(($intf_mode == INTF_STATE->{'>>'}) ? '_' : '').'.gif'}
-);
-my $button_1_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-02.gif'}
-);
-my $button_0_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-01'.($intf_pause ? '_' : '').'.gif'}
-);
-my $intf_img_id = '';
-if ($intf_state == INTF_STATE->{'>'}) {
- $intf_img_id = '_10'
-}
-elsif ($intf_mode == INTF_STATE->{'<<'}) {
- $intf_img_id = '_08'
-}
-elsif ($intf_mode == INTF_STATE->{'>>'}) {
- $intf_img_id = '_04'
-}
-my $intf_img = merge_url(
- {'path' => CGI_PATH()},
- {'path' => 'intf-00'.$intf_img_id.'.gif'}
-);
-
-if ($password_ok) {
- my $password_query = url_query_encode({'p', $settings{'password'}});
- $twowords_url = merge_url($twowords_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $newest_url = merge_url($newest_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $newer_url = merge_url($newer_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $older_url = merge_url($older_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $button_4_url = merge_url($button_4_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $button_3_url = merge_url($button_3_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $button_2_url = merge_url($button_2_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $button_1_url = merge_url($button_1_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $button_0_url = merge_url($button_0_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
-}
-
-my $_password = $password_ok ? html_entity_encode_dec($settings{'password'}, 1): '';
-my $_bsta_url = html_entity_encode_dec($bsta_url , 1);
-my $_twowords_url = html_entity_encode_dec($twowords_url , 1);
-my $_newest_url = html_entity_encode_dec($newest_url , 1);
-my $_newer_url = html_entity_encode_dec($newer_url , 1);
-my $_older_url = html_entity_encode_dec($older_url , 1);
-my $_oldest_url = html_entity_encode_dec($oldest_url , 1);
-my $_button_4_url = html_entity_encode_dec($button_4_url , 1);
-my $_button_3_url = html_entity_encode_dec($button_3_url , 1);
-my $_button_2_url = html_entity_encode_dec($button_2_url , 1);
-my $_button_1_url = html_entity_encode_dec($button_1_url , 1);
-my $_button_0_url = html_entity_encode_dec($button_0_url , 1);
-my $_button_5_img = html_entity_encode_dec($button_5_img , 1);
-my $_button_4_img = html_entity_encode_dec($button_4_img , 1);
-my $_button_3_img = html_entity_encode_dec($button_3_img , 1);
-my $_button_2_img = html_entity_encode_dec($button_2_img , 1);
-my $_button_1_img = html_entity_encode_dec($button_1_img , 1);
-my $_button_0_img = html_entity_encode_dec($button_0_img , 1);
-my $_intf_img = html_entity_encode_dec($intf_img , 1);
-my $_message = html_entity_encode_dec($message , 1);
-my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
-
-print_html_start(\*STDOUT);
-print_html_head_start(\*STDOUT);
-
-
-print ' <title>Two words • '.$_website_name.'</title>'."\n";
-print ' <link rel="start" href="'.$_oldest_url.'">'."\n";
-if ($older_available) {
- print ' <link rel="prev" href="'.$_older_url.'">'."\n";
-}
-if ($newer_available) {
- print ' <link rel="next" href="'.$_newer_url.'">'."\n";
-}
-
-print_html_head_end(\*STDOUT);
-print_html_body_start(\*STDOUT);
-
-print ' <div id="inst" class="ins">'."\n";
-
-print ' <div id="title">'."\n";
-print ' <h1 id="titletext">Two words</h1>'."\n";
-print ' </div>'."\n";
-
-if ($page == 0) {
- print ' <div id="storypuzzle">'."\n";
- for (my $i = 0; $i < @story_lines; ++$i) {
- print ' <span class="'.($turn ? 'ni':'br').'">'.html_entity_encode_dec($story_lines[$i], 1).'</span>'."\n";
- $turn = !$turn;
- }
- print ' </div>'."\n";
-
- print ' <div id="command">'."\n";
- if ($message ne '') {
- print ' <span class="br">'.$_message.'</span>'."\n";
- }
-
- if ($turn || $password_ok) {
- print ' <form method="post" action="'.$_twowords_url.'">'."\n";
- if ($message eq '') {
- if ($story{"content"} eq '') {
- print ' Two words, please:<br>'."\n";
- }
- else {
- print ' Please continue, two words:<br>'."\n";
- }
- }
- print ' <input class="intx" type="text" name="words">'."\n";
- print ' <input class="inbt" type="submit" value="enter">'."\n";
- if ((@story_lines >= (STORY_LENGTH-1)) || $password_ok ) {
- print ' <input class="inbt" type="submit" name="next" value="enter and then start a new one">'."\n";
- }
- if ($password_ok) {
- print ' <input class="inbt" type="submit" name="clear" value="clear">'."\n";
- print ' <input class="inbt" type="submit" name="clear_all" value="clear all">'."\n";
- print ' <input type="hidden" name="p" value="'.$_password.'">'."\n";
- }
- print ' </form>'."\n";
- }
- else {
- if ($message eq '') {
- print ' Wait for it.'."\n";
- }
- }
- print ' </div>'."\n";
-}
-elsif ($message ne '') {
- print ' <div id="command">'."\n";
- print ' <span class="br">'.$_message.'</span>'."\n";
- print ' </div>'."\n";
-}
-print ' </div>'."\n";
-
-if ($show_intf) {
- print ' <div id="framespace">'."\n";
- print ' <table id="intftable" cellspacing="0" cellpadding="0">'."\n";
- print ' <tr class="intf">'."\n";
- print ' <td colspan="6" class="intf"><img src="'.$_intf_img.'" alt="" class="intf"></td>'."\n";
- print ' </tr>'."\n";
-
- print ' <tr class="intf">'."\n";
- print ' <td class="intf"><img src="'.$_button_5_img.'" alt="o" class="intf"></td>'."\n";
- print ' <td class="intf"><a href="'.$_button_4_url.'"><img src="'.$_button_4_img.'" class="intf" alt=">"></a></td>'."\n";
- print ' <td class="intf"><a href="'.$_button_3_url.'"><img src="'.$_button_3_img.'" class="intf" alt="<<"></a></td>'."\n";
- print ' <td class="intf"><a href="'.$_button_2_url.'"><img src="'.$_button_2_img.'" class="intf" alt=">>"></a></td>'."\n";
- print ' <td class="intf"><a href="'.$_button_1_url.'"><img src="'.$_button_1_img.'" class="intf" alt="^"></a></td>'."\n";
- print ' <td class="intf"><a href="'.$_button_0_url.'"><img src="'.$_button_0_img.'" class="intf" alt="||"></a></td>'."\n";
- print ' </tr>'."\n";
- print ' </table>'."\n";
- print ' </div>'."\n";
-}
-
-print ' <div id="insb" class="ins">'."\n";
-
-print ' <div id="undertext">'."\n";
-for (my $i = $id_start; $i > $id_stop; --$i) {
- %new_story = read_story($i);
- print ' <p class="'.(($i&1)?'br':'ni').'" id="s'.$i.'">'.html_entity_encode_dec($new_story{'content'}).'</p>'."\n";
-}
-print ' </div>'."\n";
-
-print ' <div id="underlinks">'."\n";
-print ' <a href="'.$_bsta_url.'">BSTA</a> |'."\n";
-print ' <a href="'.$_twowords_url.'">Once again</a>';
-if ($older_available) {
- print ' |'."\n";
- print ' <a href="'.$_older_url.'">Before</a>';
-}
-if ($newer_available) {
- print ' |'."\n";
- print ' <a href="'.$newer_url.'">Unbefore</a>';
-}
-if ($older_available) {
- print ' |'."\n";
- print '<a href="'.$_oldest_url.'">Initially</a>';
-}
-if($turn) {
- print ' |'."\n";
- print ' (Entering words here is irreversible. Your actions might be remembered forever. So please be reasonable.)';
-}
-print "\n";
-print ' </div>'."\n";
-
-print ' </div>'."\n";
-
-print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'});
-print_html_end(\*STDOUT);
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/a
-# attach.pl is generated from attach.1.pl.
-#
-# The attachment interface
-#
-# Copyright (C) 2016, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'read_header_env',
- 'url_query_decode',
- 'join_path',
- 'merge_url',
- 'open_encoded', 'stat_encoded',
- 'http_header_line', 'http_header_content_length', 'http_header_content_disposition'
-);
-use bsta_lib (
- 'STATE',
- 'merge_settings',
- 'get_id', 'get_password',
- 'fail_method', 'fail_content_type', 'fail_attachment', 'fail_500',
- 'redirect',
- 'read_settings', 'read_state', 'read_attachment'
-);
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta
-###PERL_WWW_PATH: WWW_PATH = /botm/www/1190/bsta/
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %settings;
-my %state;
-my %file_data;
-
-my $method;
-my $ID;
-my $frame;
-my $last_frame;
-my $ong_state;
-my $password;
-my $password_ok;
-my $IP;
-my $try_onged;
-my $buffer;
-my $fh;
-my $file_path;
-my $file_name;
-my $direct;
-my $r = 0;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-$ID = get_id( \%cgi);
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%state = read_state();
-%file_data = read_attachment($ID);
-$frame = ($file_data{'frame'} ne '') ? int($file_data{'frame'}) : -1;
-$last_frame = int($state{'last'});
-$ong_state = int($state{'state'});
-$file_name = $file_data{'filename'};
-
-$password_ok = ($password eq $settings{'password'});
-
-unless (
- ($file_name ne '') && (
- $password_ok || (
- ($ong_state >= STATE->{'waiting'}) &&
- ($frame <= $last_frame) &&
- ($frame >=0)
- )
- )
-) {
- exit fail_attachment($method, $ID);
-}
-
-if ($file_data{'content'} ne '') {
- $direct = 1;
-}
-else {
- $direct = 0;
- $try_onged = (
- ($ong_state >= STATE->{'waiting'}) &&
- ($frame <= $last_frame) &&
- ($frame >=0)
- );
- if ($try_onged) {
- $file_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $file_name);
- $r = open_encoded($fh, '<' , $file_path);
- if ($r) {
- close($r);
- $file_path = merge_url(
- {'path' => CGI_PATH()},
- {'path' => $file_name}
- );
- exit redirect ($method, $file_path, HTTP_STATUS->{'see_other'});
- }
- }
- unless ($r) {
- $file_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $file_name);
- $r = open_encoded($fh,'<', $file_path);
- unless ($r) {
- exit fail_attachment($method, $ID);
- }
- }
- unless (binmode($fh)) {
- close($fh);
- exit fail_500("Can't switch file to binary mode.");
- }
- if (my @file_info = stat_encoded($file_path)) {
- print http_header_content_length($file_info[7]);
- }
-}
-if ($file_data{'content-type'} ne '') {
- print http_header_line('content-type', $file_data{'content-type'});
-}
-if ($file_name ne '') {
- print http_header_content_disposition('inline', $file_name);
-}
-unless ($direct) {
- unless (binmode STDOUT) {
- close($fh);
- exit fail_500("Can't switch output to binary mode.");
- }
-}
-print "\n";
-
-if($method ne 'HEAD'){
- if($direct) {
- print $file_data{'content'};
- }
- else {
- while (read ($fh, $buffer, 1024)) {
- print (STDOUT $buffer);
- }
- }
-}
-unless ($direct) {
- close($fh);
-}
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/b
-# bbcode.pl is generated from bbcode.1.pl.
-#
-# The bbcode interface
-#
-# Copyright (C) 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'read_header_env',
- 'url_query_decode',
- 'merge_url',
- 'http_header_status'
-);
-use bsta_lib (
- 'STATE',
- 'fail_method', 'fail_content_type',
- 'get_frame', 'get_password',
- 'merge_settings',
- 'eval_bb', 'bb_to_bbcode',
- 'get_frame_file',
- 'read_frame_data', 'read_default', 'read_noaccess',
- 'read_settings', 'read_state'
-);
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_CGI_VIEWER_PATH: CGI_VIEWER_PATH = /bsta/v
-
-###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta/
-
-###PERL_SCHEME: SCHEME = http
-###PERL_WEBSITE: WEBSITE = 1190.bicyclesonthemoon.info
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %frame_data;
-my %default;
-my %settings;
-my %state;
-
-my $method;
-my $frame;
-my $password;
-my $password_ok;
-my $access;
-my $ongtime;
-my $ong_state;
-my $last_frame;
-my $frame_data_path;
-my $frame_file;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-$frame = get_frame(\%cgi);
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%default = read_default();
-%state = read_state();
-
-$ong_state = int($state{'state'});
-$last_frame = int($state{'last'});
-
-$password_ok = ($password eq $settings{'password'});
-
-if ($frame < 0) {
- $frame = $last_frame + $frame +1;
-}
-%frame_data = read_frame_data($frame, \%default);
-
-if (
- $password_ok || (
- ($ong_state >= STATE->{'waiting'}) &&
- ($frame <= $last_frame) &&
- ($frame >= 0)
- )
-) {
- $access = 1;
-}
-else {
- $access=0;
- %frame_data = read_noaccess(\%default);
-}
-$frame_file = get_frame_file($frame, \%frame_data, \%settings);
-
-print "Content-type: text/plain; charset=UTF-8\n";
-if(!$access) {
- print http_header_status(HTTP_STATUS->{'forbidden'});
-}
-print "\n";
-if($method eq 'HEAD') {
- exit;
-}
-
-my $viewer_url = merge_url(
- {'scheme' => SCHEME(), 'host' => WEBSITE()},
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $frame}
-);
-my $frame_url = merge_url(
- {'scheme' => SCHEME(), 'host' => WEBSITE()},
- {'path' => CGI_PATH()},
- {'path' => $frame_file}
-);
-my $content = bb_to_bbcode(
- eval_bb(
- $frame_data{'content'},
- 1
- )
-);
-
-print '[quote][center][size=200]'.$frame_data{'title'}.'[/size]'."\n";
-print '[url='.$viewer_url.'][img]'.$frame_url.'[/img][/url][/center]'."\n";
-print $content.'[/quote]'."\n";
-Subproject commit 54a9ab5889510496f8820da830f46068703aa8d6
+Subproject commit 44fbe59bfd7652a0975e601591df4a4b218da40d
+++ /dev/null
-# bsta.conf is automatically generated from bsta.1.conf
-
-ScriptAlias ###CONF_CGI_2WORDS; ###CONF_BIN_2WORDS;
-ScriptAlias ###CONF_CGI_ATTACH; ###CONF_BIN_ATTACH;
-ScriptAlias ###CONF_CGI_BBCODE; ###CONF_BIN_BBCODE;
-ScriptAlias ###CONF_CGI_COIN; ###CONF_BIN_COIN;
-ScriptAlias ###CONF_CGI_FRAME; ###CONF_BIN_FRAME;
-ScriptAlias ###CONF_CGI_GOTO; ###CONF_BIN_GOTO;
-ScriptAlias ###CONF_CGI_INFO; ###CONF_BIN_INFO;
-ScriptAlias ###CONF_CGI_VIEWER; ###CONF_BIN_VIEWER;
-ScriptAlias ###CONF_CGI_WORDS; ###CONF_BIN_WORDS;
-
-<Directory ###CONF_BIN;>
- Require all granted
-</Directory>
+++ /dev/null
-# bsta.cron is automatically generated from bsta.1.cron
-
-###CRON_OLDLOGS_SCHEDULE; ###CRON_USER; ###CRON_OLDLOGS; ###CRON_LOG; ###CRON_LOG_SIZE_LIMIT; ###CRON_LOGS_TOTAL; ###CRON_LOGS_UNCOMPRESSED;
-###CRON_ONG_SCHEDULE; ###CRON_USER; ###CRON_ONG; >> ###CRON_ONG_LOG;
-###CRON_RESET_SCHEDULE; ###CRON_USER; ###CRON_RESET; ###CRON_RESET_PASSWORD;
+++ /dev/null
-html
-{
- background-color: #46a3ff;
- /* background-color: #d9ecff; */
- border-color: #000000;
- color: #000000;
- text-align: center;
-}
-
-a
-{
- border-color: #0057af;
- color: #0057af;
- text-decoration:underline;
-}
-a:visited
-{
- border-color: #bb6622;
- color: #bb6622;
-}
-a:hover
-{
- border-color: #bb6622;
- color: #bb6622;
-}
-a:hover:visited
-{
- border-color: #0057af;
- color: #0057af;
-}
-::selection
-{
- color: #ffffff;
- background-color: #bb6622;
-}
-
-div#all
-{
- background-color: #d9ecff;
- /* background-color: #ffffff; */
- margin-left: auto;
- margin-right: auto;
- margin-top: 0px;
- margin-bottom: 0px;
- width: 656px;
- padding-top: 27px;
- padding-bottom: 27px;
- text-align: center;
-}
-div.all
-{
- background-color: #d9ecff;
- /* background-color: #ffffff; */
- margin-left: auto;
- margin-right: auto;
- margin-top: 0px;
- margin-bottom: 0px;
- width: 656px;
- padding-top: 27px;
- padding-bottom: 27px;
- text-align: center;
-}
-
-div.ins
-{
- background-color: #ffffff;
- margin-left: auto;
- margin-right: auto;
- margin-top: 0px;
- margin-bottom: 0px;
- padding: 0px;
- border: 0px;
- width: 580px;
-}
-div#inst
-{
- /* margin-top: 27px; */
- /* margin-bottom: 0px; */
-}
-div#insb
-{
- /* margin-top: 0px; */
- /* margin-bottom: 27px; */
-}
-
-div#title
-{
- text-align: center;
- padding-top: 21px;
- padding-bottom: 21px;
- padding-left: 0px;
- padding-right: 0px;
- border: 0px;
- margin: 0px;
-}
-div.title
-{
- text-align: center;
- padding-top: 21px;
- padding-bottom: 21px;
- padding-left: 0px;
- padding-right: 0px;
- border: 0px;
- margin: 0px;
-}
-
-h1#titletext
-{
- margin: 0px;
- border: 0px;
- padding: 0px;
-}
-h1.titletext
-{
- margin: 0px;
- border: 0px;
- padding: 0px;
-}
-
-div#storypuzzle
-{
- text-align: left;
- padding: 8px;
- margin: 0px;
- border: 0px;
- font-weight: bold;
-}
-
-div#framespace
-{
- background-color: #ffffff;
- margin-left: auto;
- margin-right: auto;
- margin-top: 0px;
- margin-bottom: 0px;
- padding: 0px;
- border: 0px;
- width: 656px;
-}
-
-img#frame
-{
- border: solid #0057af;
- border-width: 27px 38px;
- padding: 0px;
- margin: 0px;
-}
-img#frame:hover
-{
- border-color: #bb6622;
-}
-img#frame.double
-{
- border-width: 54px 38px;
-}
-img#frame.full
-{
- border-width: 0px;
- background-color: #0057af;
-}
-img#frame.full#hover
-{
- background-color: #bb6622;
-}
-img#frame.bftf
-{
- padding-top: 60px;
- padding-bottom: 60px;
- padding-left: 85px;
- padding-right: 85px;
- background-color: #d9ecff;
-}
-
-img.intf
-{
- border-width: 0px;
- padding: 0px;
- margin: 0px;
-}
-tr.intf
-{
- border-width: 0px;
- padding: 0px;
- margin: 0px;
-}
-td.intf
-{
- border-width: 0px;
- padding: 0px;
- margin: 0px;
-}
-table#intftable
-{
- border: solid #0057af;
- border-width:27px 38px;
- padding: 0px;
- margin: 0px;
- background-color: #ffffff;
- border-collapse: collapse;
- border-spacing: 0px;
-}
-
-div#undertext
-{
- text-align: left;
- padding: 8px;
- margin: 0px;
- border: 0px;
-}
-div.undertext
-{
- text-align: left;
- padding: 8px;
- margin: 0px;
- border: 0px;
-}
-
-div#chat
-{
- text-align: left;
- padding: 8px;
- margin: 0px;
- border: 0px;
- font-family: monospace;
-}
-
-div.fq
-{
- text-align: left;
- border: solid #0057af 4px;
- font-family: monospace;
- padding: 2px;
-}
-div.fq:hover
-{
- border-color: #bb6622;
-}
-div.tq
-{
- text-align: left;
- border: solid #0057af 4px;
- padding: 2px;
-}
-div.tq:hover
-{
- border-color: #bb6622;
-}
-
-div.opomba
-{
- text-align: left;
- border: solid #0057af 4px;
- background-color: #0057af;
-}
-div.opomba:hover
-{
- border-color: #bb6622;
- background-color: #bb6622;
-}
-div.opomba:target
-{
- border-color: #bb6622;
- background-color: #bb6622;
-}
-div.opomba:target:hover
-{
- border-color: #bb6622;
- background-color: #bb6622;
-}
-div.opomba_info
-{
- color: #ffffff!important;
- /* font-weight: bold; */
-}
-div.opomba_text
-{
- background-color: #ffffff;
- color: #000000;
- clear: both;
- padding: 4px;
-}
-
-div.space
-{
- background-color: #46a3ff;
- height: 27px;
- margin-top: 27px;
- margin-bottom: 27px;
-}
-
-div#command
-{
- text-align: left;
- margin: 0px;
- border: 0px;
- padding: 8px;
- font-family: monospace;
- font-size: 150%;
- /* font-weight: bold; */
-}
-
-div#underlinks
-{
- text-align: left;
- padding: 8px;
- margin: 0px;
- border: 0px;
- font-family: monospace;
-}
-div.underlinks
-{
- text-align: left;
- padding: 8px;
- margin: 0px;
- border: 0px;
- font-family: monospace;
-}
-
-span.inp
-{
- animation: inp 2380ms step-start infinite;
-}
-@keyframes inp
-{
- 50% { opacity: 0.0;}
-}
-
-input.intx
-{
- border-color: #0057af;
- color: #000000;
- background-color: #ffffff;
- border-width: 2px;
- border-style: solid;
- margin: 2px;
- font-family: monospace;
- /* font-size: 150%; */
-}
-input.intx:focus
-{
- border-color: #bb6622;
-}
-input.intx:hover
-{
- border-color: #bb6622;
-}
-
-input.intxc
-{
- border-color: #0057af;
- color: #000000;
- background-color: #ffffff;
- border-width: 2px;
- border-style: solid;
- margin: 2px;
- font-family: monospace;
- width: 100%;
- /* font-size: 150%; */
-}
-input.intxc:focus
-{
- border-color: #bb6622;
-}
-input.intxc:hover
-{
- border-color: #bb6622;
-}
-
-/* table.intxc
-{
- width=100%;
-} */
-
-textarea.inta
-{
- border-color: #0057af;
- color: #000000;
- background-color: #ffffff;
- border-width: 2px;
- border-style: solid;
- width: 100%;
- margin: 2px;
- resize: none;
-}
-textarea.inta:focus
-{
- border-color: #bb6622;
-}
-textarea.inta:hover
-{
- border-color: #bb6622;
-}
-
-input.inbt
-{
- border-color: #0057af;
- color: #000000;
- background-color: #ffffff;
- border-width: 2px;
- border-style: solid;
- margin: 2px;
- font-family: monospace;
- /* font-size: 150%; */
-}
-input.inbt:focus
-{
- border-color: #bb6622;
-}
-input.inbt:hover
-{
- border-color: #bb6622;
-}
-
-input.hl {
- background:none!important;
- border:none!important;
- padding:0!important;
-/* font-family:inherit;
- font-size:inherit; */
- font: inherit;
- text-decoration:underline;
- border-color: #0057af;
- color: #0057af;
-}
-input.hl:hover {
- border-color: #bb6622;
- color: #bb6622;
-}
-form.hl {
- display: inline
-}
-
-form.goto {
- clear: both;
- display: inline
-}
-
-.br
-{
- border-color: #bb6622!important;
- color: #bb6622!important;
-}
-.po
-{
- border-color: #ff8800!important;
- color: #ff8800!important;
-}
-.ni
-{
- border-color: #0057af!important;
- color: #0057af!important;
-}
-.bi
-{
- border-color: #ffffff!important;
- color: #ffffff!important;
-}
-.cz
-{
- border-color: #000000!important;
- color: #000000!important;
-}
-
-.hv.ni:hover
-{
- border-color: #bb6622!important;
- color: #bb6622!important;
-}
-
-.hv.br:hover
-{
- border-color: #0057af!important;
- color: #0057af!important;
-}
-
-.hu
-{
- text-decoration:none!important;
-}
-.hu:hover
-{
- text-decoration:underline!important;
-}
-
-div.le
-{
- float: left;
-}
-div.pr
-{
- float: right;
-}
+++ /dev/null
-# bsta_lib.pm is generated from bsta_lib.1.pm
-#
-# Library of functions
-#
-# Copyright (C) 2016, 2017, 2019, 2020, 2022, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-# TODO: FQ NBSP ?
-# TODO: DEBUG
-# TODO: BB & INFO indent
-
-package bsta_lib;
-
-use strict;
-#use warnings
-
-use utf8;
-use Encode ('encode', 'decode');
-use Exporter;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-###PERL_EXPORT_VERSION: our $VERSION = 'x.x.x';
-our @ISA = qw(Exporter);
-our @EXPORT = ();
-our @EXPORT_OK = (
- 'STATE', 'TEXT_MODE', 'INTF_STATE', 'CHAT_STATE', 'CHAT_ACTION',
- 'failpage',
- 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_attachment', 'fail_500',
- 'redirect',
- 'get_remote_addr', 'get_id', 'get_frame', 'get_password',
- 'merge_settings',
- 'print_html_start', 'print_html_end',
- 'print_html_head_start', 'print_html_head_end',
- 'print_html_body_start', 'print_html_body_end',
- 'print_viewer_page', 'print_goto',
- 'write_index', 'write_static_viewer_page', 'write_static_goto',
- 'get_frame_file', 'get_page_file',
- 'read_frame_data', 'write_frame_data', 'read_default', 'read_noaccess',
- 'read_state', 'write_state',
- 'read_words_list', 'write_words_list', 'read_words', 'write_words',
- 'read_story', 'write_story',
- 'read_goto', 'write_goto',
- 'read_chat', 'write_chat',
- 'read_settings', 'read_attachment', 'read_coincidence',
- 'ong',
- 'eval_bb', 'bb_to_bbcode', 'bb_to_html'
-);
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'url_query_decode', 'url_query_encode',
- 'url_decode', 'url_encode',
- 'html_entity_encode_dec',
- 'merge_url',
- 'read_header_env',
- 'read_data_file', 'write_data_file',
- 'join_path',
- 'copy_encoded', 'open_encoded', '_x_encoded',
- 'http_header_line', 'http_status',
- 'http_header_status', 'http_header_allow', 'http_header_location'
-);
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_CGI_ATTACH_PATH: CGI_ATTACH_PATH = /bsta/a
-###PERL_CGI_2WORDS_PATH: CGI_2WORDS_PATH = /bsta/2words
-###PERL_CGI_BBCODE_PATH: CGI_BBCODE_PATH = /bsta/b
-###PERL_DATA_CHAT_PATH: DATA_CHAT_PATH = /botm/data/bsta/chat
-###PERL_CGI_COIN_PATH: CGI_COIN_PATH = /bsta/coin
-###PERL_CGI_CSS_PATH: CGI_CSS_PATH = /bsta/bsta.css
-###PERL_CGI_FRAME_PATH: CGI_FRAME_PATH = /bsta/f
-###PERL_CGI_GOTO_PATH: CGI_GOTO_PATH = /bsta/g
-###PERL_CGI_INFO_PATH: CGI_INFO_PATH = /bsta/i
-###PERL_CGI_LIST_PATH: CGI_LIST_PATH = /bsta/goto.htm
-###PERL_CGI_LOGO_PATH: CGI_LOGO_PATH = /bsta/botmlogo.png
-###PERL_CGI_TIMER_PATH: CGI_TIMER_PATH = /bsta/timer.js
-###PERL_CGI_VIEWER_PATH: CGI_VIEWER_PATH = /bsta/v
-###PERL_CGI_WORDS_PATH: CGI_WORDS_PATH = /bsta/w
-
-###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta/
-###PERL_DATA_ATTACH_PATH: DATA_ATTACH_PATH = /botm/data/bsta/a
-###PERL_DATA_COIN_PATH: DATA_COIN_PATH = /botm/data/bsta/coincidence
-###PERL_DATA_DEFAULT_PATH: DATA_DEFAULT_PATH = /botm/data/bsta/default
-###PERL_DATA_LIST_PATH: DATA_LIST_PATH = /botm/data/bsta/list
-###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
-###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
-###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state
-###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story
-###PERL_DATA_WORDS_PATH: DATA_WORDS_PATH = /botm/data/bsta/words/
-
-###PERL_WWW_PATH: WWW_PATH = /botm/www/
-###PERL_WWW_GOTO_PATH: WWW_GOTO_PATH = /botm/www/1190/bsta/goto.htm
-###PERL_WWW_INDEX_PATH: WWW_INDEX_PATH = /botm/www/1190/bsta/index.htm
-
-###PERL_SCHEME: SCHEME = http
-###PERL_WEBSITE: WEBSITE = 1190.bicyclesonthemoon.info
-###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
-###PERL_FAVICON_PATH: FAVICON_PATH = /img/favicon.png
-
-###PERL_COIN_DATE: COIN_DATE = 13-Nov-2016 22:15
-###PERL_INTF_DATE: INTF_DATE = 28-Sep-2016 20:34
-
-###PERL_STORY_CREDITS: STORY_CREDITS = "BSTA" by Balthasar Szczepański
-###PERL_INTF_CREDITS: INTF_CREDITS = Online interface © Balthasar Szczepański; AGPL 3 license
-###PERL_SOURCE_URL: SOURCE_URL = http://bicyclesonthemoon.info/git-projects/?p=ott/bsta
-
-###PERL_COMMENT_PAGE_LENGTH:COMMENT_PAGE_LENGTH= 16
-
-use constant STATE => {
- 'inactive' => 0,
- 'waiting' => 1,
- 'ready' => 2,
- 'end' => 3,
-};
-use constant INTF_STATE => {
- 'X' => 0b000000,
- 'x' => 0b000000,
- '||' => 0b000001,
- '>>' => 0b000100,
- '>>|'=> 0b000101,
- '<<' => 0b001000,
- '|<<'=> 0b001001,
- '>' => 0b010000,
- '>|' => 0b010001,
- 'mask'=>0b111111,
- 'mode'=>0b111110,
-};
-use constant TEXT_MODE => {
- 'normal' => 0,
- 'bb' => 1,
- 'info' => 2,
- 'words' => 3
-};
-use constant CHAT_STATE => {
- 'disconnected' => 0,
- 'ready' => 1,
- 'active' => 2,
-};
-use constant CHAT_ACTION => {
- 'none' => 0,
- 'join' => 1,
- 'leave' => 2,
- 'nopost' => 3,
- 'file' => 4,
-};
-
-use constant tags_bbcode => {
- 'ht' => '',
- '/ht' => '',
- 'fq' => '[quote]',
- '/fq' => '[/quote]',
- 'tq' => '[quote]',
- '/tq' => '[/quote]',
- 'quote' => '[quote]',
- 'quote=' => '[quote="',
- 'quote/='=> '"]',
- '/quote' => '[/quote]',
- 'ni' => '[color=#0057AF]',
- '/ni' => '[/color]',
- 'br' => '[color=#BB6622]',
- '/br' => '[/color]',
- 'po' => '[color=#FF8800]',
- '/po' => '[/color]',
- 'url' => '[url]',
- 'url=' => '[url=',
- 'url/=' => ']',
- '/url' => '[/url]',
- 'i' => '[i]',
- '/i' => '[/i]',
- 'list' => '[list]',
- 'list=' => '[list=',
- 'list/=' => ']',
- '/list' => '[/list]',
- '*' => '[*]',
- '/*' => '[/*]',
- '?' => '[unknown!]',
- '/?' => '[/unknown!]',
-};
-use constant tags_html => {
- 'ht' => '',
- '/ht' => '',
- 'fq' => '<div class="fq">',
- '/fq' => '</div>',
- 'tq' => '<div class="tq">',
- '/tq' => '</div>',
- 'quote' => '<div class="opomba"><div class="opomba_text">',
- 'quote=' => '<div class="opomba"><div class="opomba_info"><b>',
- 'quote/='=> '</b> wrote:</div><div class="opomba_text">',
- '/quote' => '</div></div>',
- 'ni' => '<span class="ni">',
- '/ni' => '</span>',
- 'br' => '<span class="br">',
- '/br' => '</span>',
- 'po' => '<span class="po">',
- '/po' => '</span>',
- 'url' => '<a href="#">',#think: how to add selfincluding?
- 'url=' => '<a href="',
- 'url/=' => '">',
- '/url' => '</a>',
- 'i' => '<i>',
- '/i' => '</i>',
- 'list' => '<ul>',
- 'list=' => '<ol style="list-style-type: ',
- 'list=1' => 'decimal',
- 'list=A' => 'upper-alpha',
- 'list=a' => 'lower-alpha',
- 'list=I' => 'upper-roman',
- 'list=i' => 'lower-roman',
- 'list/=' => '">',
- '/list' => '</ul>',
- '/list=' => '</ol>',
- '*' => '<li>',
- '/*' => '</li>',
- '?' => '[unknown!]',
- '/?' => '[/unknown!]',
-};
-
-
-# Function to return an error page
-# arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
-sub failpage {
- (my $header, my $title, my $message, my $method, my $hyperlink) = @_;
-
- if (ref($header)) {
- foreach my $header_name (keys %$header) {
- print http_header_line($header_name, $header->{$header_name});
- }
- }
- elsif($header ne '') {
- print $header;
- }
- if($method eq 'HEAD') {
- print "\n";
- return;
- }
- my $_title = html_entity_encode_dec($title , 1);
- my $_message = html_entity_encode_dec($message , 1);
- my $_hyperlink = html_entity_encode_dec($hyperlink, 1);
-
- print "Content-type: text/html; charset=UTF-8\n\n";
-
- print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
- print ' <html lang="en">'."\n";
- print ' <head>'."\n";
- print ' <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
- if ($title ne '') {
- print ' <title>'.$_title.'</title>'."\n";
- }
- print ' </head>'."\n";
- print ' <body>'."\n";
- if ($title ne '') {
- print ' <h1>'.$_title.'</h1>'."\n";
- }
- if (($message ne '') || ($hyperlink ne '')) {
- print " <p>\n";
- if ($message ne '') {
- print ' '.$_message.($hyperlink ne '' ? '<br>' : '')."\n";
- }
- if ($hyperlink ne '') {
- print ' <a href="'.$_hyperlink.'">'.$_hyperlink."</a>\n";
- }
- print " </p>\n";
- }
- print ' </body>'."\n";
- print '</html>'."\n";
-}
-
-sub fail_method {
- (my $method, my $allowed) = @_;
-
- my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
- my $header =
- http_header_line('status', $status) .
- http_header_allow($allowed);
-
- return failpage(
- $header,
- $status,
- "The interface does not support the $method method.",
- $method
- );
-}
-
-sub fail_content_type
-{
- (my $method, my $content_type) = @_;
-
- my $status = http_status(HTTP_STATUS->{'unsupported_media_type'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Unsupported Content-type: $content_type.",
- $method
- );
-}
-
-sub fail_open_file
-{
- (my $method, my $type, my $path) = @_;
-
- my $status = http_status(HTTP_STATUS->{'not_found'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Can't open ".
- ($type ne '' ? $type : 'file').
- ($path ne '' ? ': "'.$path.'"' : '').
- '.',
- $method
- );
-}
-
-sub fail_attachment
-{
- (my $method, my $ID) = @_;
-
- my $status = http_status(HTTP_STATUS->{'not_found'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Attachment $ID not found.",
- $method
- );
-}
-
-sub fail_500
-{
- (my $method, my $text) = @_;
-
- my $status = http_status(HTTP_STATUS->{'internal_server_error'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- $text,
- $method
- );
-}
-
-sub redirect
-{
- (my $method, my $uri, my $code) = @_;
- my $header;
- my $status;
- if ($code eq '') {
- $code = HTTP_STATUS->{'found'};
- }
- # https://insanecoding.blogspot.com/2014/02/http-308-incompetence-expected.html
- # 301 Moved Permanently
- # 302 Found
- # 303 See Other
- # 307 Temporary Redirect
- # 308 Permanent Redirect
- $status = http_status($code);
- $header = http_header_line('status', $status);
- $header .= http_header_location($uri);
-
- return failpage(
- $header,
- $status,
- '',
- $method,
- $uri
- );
-}
-
-
-# function to obtain address of remote agent
-sub get_remote_addr {
- if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) {
- return $&;
- }
- elsif ($ENV{'REMOTE_ADDR'} =~ /^.+$/) {
- return $&;
- }
- else {
- return '0.0.0.0';
- }
-}
-
-# functions to get ID/number etc.
-sub get_id {
- (my $cgi, my $default, my $cgi_name) = @_;
- if ($default eq '') {
- $default = 0;
- }
- if ($cgi_name eq '') {
- $cgi_name = 'i';
- }
-
- if ($cgi->{$cgi_name} =~ /^.+$/) {
- return int($&);
- }
- elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
- return int($1);
- }
- else {
- return int($default);
- }
-}
-
-# function to obtain frame number
-sub get_frame {
- (my $cgi, my $default) = @_;
- return get_id($cgi, $default, 'f');
-}
-
-# function to obtain password
-sub get_password {
- (my $cgi) = @_;
-
- if ($cgi->{'p'} =~ /^.+$/) {
- return $&;
- }
- else {
- return '';
- }
-}
-
-
-sub merge_settings {
- my %final_settings;
-
- foreach my $settings (@_) {
- foreach my $ind (keys %$settings) {
- $final_settings{$ind} = $settings->{$ind};
- }
- }
- return %final_settings;
-}
-
-
-# BB code stuff
-# different & simpler implementation than in post library
-# to consider:
-# a BBcode library?
-
-#analyse bbcode text to build tag tree
-#TODO make [/*] optional!
-sub bbtree {
- (my $bb, my $printdebug) = @_;
- my %bbtree;
- my $ind;
- my $tag;
- my $tag_name;
- my $tag_value;
- my $tag_end;
- my $level=0;
- my $pre_text;
- my $debug;
-
- $ind="_";
- $level=0;
- $bbtree{"_.name" } = "ht";
- $bbtree{"_.value" } = '';
- $bbtree{"_.type" } = "tag";
- $bbtree{"_.count" } = 0;
- $bbtree{"_.closed"} = 0;
- $debug .= debug($printdebug,
- "\n".
- "<!--GENERATING BBCODE TREE:\n".
- '[_]automatic tag: [ht]'."\n"
- );
-
- while ($bb ne '') {
- my $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
-
- if($bb =~ m/\[(\/?)([A-Za-z]+|\*)(=([^\[\]]*))?\]/g) {
- $pre_text = $`;
- $tag = $&;
- $tag_end = $1;
- $tag_name = lc($2);
- $tag_value = $4;
- $bb = $';
- if ($tag_value =~ /^"(.*)"$/) {
- $tag_value = $1;
- }
-
- if ($pre_text ne '') {
- $debug .= debug($printdebug, "[$new_ind]text: $pre_text\n");
- $bbtree{$new_ind.'.type' } = 'text';
- $bbtree{$new_ind.'.value'} = $pre_text;
- $bbtree{ $ind.'.count'}+= 1;
- $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
- }
-
- if($tag_name =~ /^(fq|tq|quote|br|ni|po|url|i|list|\*)$/) {
- if ($tag_end ne '') {
- if (
- ($tag_name ne $bbtree{$ind.'.name'}) ||
- ($level <= 0)
- ) {
- $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
- $bbtree{$new_ind.'.type' } = 'text';
- $bbtree{$new_ind.'.value'} = $tag;
- $bbtree{ $ind.'.count'}+= 1;
- # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
- }
- else {
- $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
- $bbtree{$new_ind.'.type' } = 'tag';
- $bbtree{$new_ind.'.name' } = '/'.$tag_name;
- $bbtree{$new_ind.'.value' } = $tag_value;
- $bbtree{ $ind.'.count' }+= 1;
- $bbtree{ $ind.'.closed'} = 1;
- $level -= 1;
- $ind =~ s/\.[0-9]+$//;
- # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
- }
- }
- else
- {
- $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
- $bbtree{$new_ind.'.type' } = 'tag';
- $bbtree{$new_ind.'.name' } = $tag_name;
- $bbtree{$new_ind.'.value' } = $tag_value;
- $bbtree{$new_ind.'.count' } = 0;
- $bbtree{$new_ind.'.closed'} = 0;
- $bbtree{ $ind.'.count' }+= 1;
- $level += 1;
- $ind = $new_ind;
- # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
- }
- }
- else {
- $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
- $bbtree{$new_ind.'.type' } = 'text';
- $bbtree{$new_ind.'.value'} = $tag;
- $bbtree{ $ind.'.count'}+= 1;
- # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
- }
- }
- else {
- $debug .= debug($printdebug, "[$new_ind]text: $bb\n");
- $bbtree{$new_ind.'.type' } = 'text';
- $bbtree{$new_ind.'.value'} = $bb;
- $bbtree{ $ind.'.count'}+= 1;
- # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
- $bb = '';
- }
- }
- my $final_ind = '_.'.$bbtree{"_.count"};
- $debug .= debug($printdebug, "[$final_ind]automatic tag: [/ht]\n -->\n");
- $bbtree{$final_ind.'.type' } = "tag";
- $bbtree{$final_ind.'.name' } = '/ht';
- $bbtree{ '_.count' }+= 1;
- $bbtree{ '_.closed'} = 1;
-
- return ($debug, %bbtree);
-}
-
-#convert tag tree to final text
-sub convtree {
- (my $printdebug, my $debug, my $lang, my $bbtree) = @_;
- my $out;
- my $ind;
- my $indd;
- my $level = 0;
- my $tags = ($lang eq 'html') ? tags_html : tags_bbcode;
- my $escape = ($lang eq 'html');
-
- # $debug .= debug($printdebug, "\n****\n");
- # foreach my $iiii (keys %tags) {
- # $debug .= debug($printdebug, $iiii.'='.$tags->{$iiii}."\n");
- # }
- # $debug .= debug($printdebug, "****\n");
-
- $level = 0;
- $ind = '_';
- $out = '';
- $debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
-
- while ($level >= 0) {
- my $goto_next = '';
- $debug .= debug($printdebug, "[$level:$ind:".int($bbtree->{$ind.'.count'})."]");
- #normal text
- if ($bbtree->{$ind.'.type'} eq 'text') {
- my $text = $bbtree->{$ind.'.value'};
- $debug .= debug($printdebug, "text: ".$text);
- $out .= $escape ? html_encode_line($text) : $text;
-
- $goto_next = 'tx';
- }
- #tag
- elsif ($bbtree->{$ind.'.type'} eq 'tag') {
- my $name = $bbtree->{$ind.'.name'};
- #endtag
- if ($name =~ /^\//) {
- $debug .= debug($printdebug, "tag: [$name]");
- $indd = $ind;
- $indd =~ s/\.([0-9]+)$//;
- if (exists($tags->{$name.'='}) && ($bbtree->{$indd.'.value'} ne '')) {
- $out .= $tags->{$name.'='};
- }
- elsif (exists($tags->{$name})) {
- $out .= $tags->{$name};
- }
- else {
- $out .= $tags->{'/?'};
- $debug .= debug($printdebug, "[unknown!]");
- }
-
- $ind =~ s/\.([0-9]+)$//;
- $level -= 1;
- $debug .= debug($printdebug, "[<]");
- if ($level > 0) {
- $goto_next = 'nd';
- }
- else {
- # time to end this
- $level = -1;
- }
- }
- #starttag
- else {
- my $value = $bbtree->{$ind.'.value'};
- if($bbtree->{$ind.'.closed'} ne '') {
- $debug .= debug($printdebug, "tag: [$name]");
-
- if (exists($tags->{$name.'='}) && ($value ne '')) {
- if (exists($tags->{$name.'='.$value})) {
- $out .=
- $tags->{$name.'='} .
- $tags->{$name.'='.$value} .
- $tags->{$name.'/='};
- }
- else {
- $out .=
- $tags->{$name.'='} .
- ($escape ? html_entity_encode_dec($value, 1) : $value) .
- $tags->{$name.'/='};
- }
- }
- elsif (exists($tags->{$name})) {
- $out .= $tags->{$name};
- }
- else {
- $out .= $out.$tags->{'?'};
- $debug .= debug($printdebug, "[unknown!]");
- }
- }
- else {
- $debug .= debug($printdebug, "unclosed tag: [$name]");
- my $text = $name . (($value ne '') ? ('='.$value) : '');
- $out .= '['.($escape ? html_encode_line($text) : $text).']';
- }
- if ($bbtree->{$ind.'.count'} > 0) {
- $ind = $ind.'.0';
- $level += 1;
- $debug .= debug($printdebug, "[>]");
- }
- else {
- $goto_next = 'st';
- }
- }
- }
- # what is this
- else {
- $debug .= debug($printdebug, "unknown thing: ".$bbtree->{$ind.'.type'});
- #should not occur with a correct bbtree
- #unless unimplemented
- $ind =~ s/\.([0-9]+)$//;
- $level -= 1;
- $debug .= debug($printdebug, "[<ui]");
- if ($level > 0) {
- $goto_next = 'un';
- }
- else {
- # time to end this
- $level = -1;
- }
- }
- if ($goto_next ne '') {
- {do{
- $ind =~ s/\.([0-9]+)$//;
- my $i = int($1) + 1;
- if (($i < $bbtree->{$ind.'.count'}) and ($1 ne '')){
- # goto next
- $ind = $ind.'.'.$i;
- last;
- }
- else {
- # step out
- # should not occur with a correct bbtree
- $debug .= debug($printdebug, "[<$goto_next]");
- $level -= 1;
- }
- } while ($level >= 0);}
- }
-
- $debug .= debug($printdebug, "[>$level:$ind]\n");
- }
-
- $debug .= debug($printdebug, "-->\n");
- return ($debug, $out);
-}
-
-#bbcode to html, TBD
-sub bb_to_html {
- (my $bb, my $printdebug) = @_;
- my $ht;
- my %bbtree;
- my $debug;
-
- ($debug, %bbtree) = bbtree($bb, $printdebug);
- ($debug, $ht) = convtree ($printdebug, $debug, 'html', \%bbtree);
-
- return $ht;
-}
-
-#bbcode to bb, TBD
-sub bb_to_bbcode {
- (my $bb, my $printdebug) = @_;
- my $ht;
- my %bbtree;
- my $debug;
-
- ($debug, %bbtree) = bbtree($bb, $printdebug);
- ($debug, $ht) = convtree ($printdebug, $debug, 'bb', \%bbtree);
-
- return $ht;
-}
-
-sub eval_bb {
- (my $bb, my $full_url, my $password) = @_;
- my $value;
- my $before;
- my $after;
-
- my $base_url = $full_url ?
- {'scheme' => SCHEME(), 'host' => WEBSITE()} :
- {'path' => ''};
-
- while ($bb =~ m/###([^#;]*);/g) {
- $value = $1;
- $before = $`;
- $after = $';
-
- if ($value =~ /^att&([0-9]+)$/) {
- $value = merge_url(
- $base_url,
- {'path' => CGI_ATTACH_PATH()},
- {'path' => int($1)}
- )
- }
- elsif ($value =~ /^vw&([0-9]+)$/) {
- $value = merge_url(
- $base_url,
- {'path' => CGI_VIEWER_PATH()},
- {'path' => int($1)}
- )
- }
- elsif ($value =~ /^fr&([0-9]+)$/) {
- $value = merge_url(
- $base_url,
- {'path' => CGI_FRAME_PATH()},
- {'path' => int($1)}
- )
- }
- else {
- $value = '';
- }
- if (($value ne '') && ($password ne '')) {
- $value = merge_url(
- $value,
- {'query' => {'p' => $password}}
- );
- }
- $bb = $before . $value . $after;
- }
- return $bb;
-}
-
-
-sub html_encode_line {
- (my $text, my $non_ascii, my $all) = @_;
- my $html;
- my $ind;
-
- $text =~ s/\r\n/\n/gs;
- $text =~ s/\r/\n/gs;
-
- while ($text ne '') {
- $ind = index($text, "\n");
- if ($ind >= 0) {
- $html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
- $text = substr($text, $ind+1);
- }
- else
- {
- $html .= html_entity_encode_dec($text, 1);
- $text = '';
- }
- }
- return $html;
-}
-
-sub debug {
- (my $print, my $text) = @_;
-
- if ($print) {
- print $text;
- }
-
- return $text;
-}
-
-
-sub print_html_start {
- (my $fh) = @_;
- print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
- print $fh '<html lang="en">'."\n";
-}
-
-sub print_html_end {
- (my $fh) = @_;
- print $fh '</html>'."\n";
-}
-
-sub print_html_head_start {
- (my $fh) = @_;
- print $fh ' <head>'."\n";
- print $fh ' <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
- print $fh ' <link rel="icon" type="image/png" href="'.html_entity_encode_dec(FAVICON_PATH(),1).'">'."\n";
- print $fh ' <link rel="stylesheet" href="'.html_entity_encode_dec(CGI_CSS_PATH(),1).'">'."\n";
-}
-
-sub print_html_head_end {
- (my $fh) = @_;
- print $fh ' </head>'."\n";
-}
-
-sub print_html_body_start {
- (my $fh) = @_;
- print $fh ' <body>'."\n";
- print $fh ' <a href="/"><img id="botmlogo" src="'.html_entity_encode_dec(CGI_LOGO_PATH(),1).'" alt="'.html_entity_encode_dec(WEBSITE(),1).'"></a>'."\n";
- print $fh ' <div id="all">'."\n";
-}
-
-sub print_html_body_end {
- (my $fh, my $hide_credits) = @_;
- print $fh ' </div>'."\n";
- unless ($hide_credits) {
- print $fh ' <p>'."\n";
- print $fh ' '.html_entity_encode_dec(STORY_CREDITS(),1).'<br>'."\n";
- print $fh ' '.html_entity_encode_dec(INTF_CREDITS(),1).'<br>'."\n";
- print $fh ' <a href="'.html_entity_encode_dec(SOURCE_URL(),1).'" class="cz">source code</a>'."\n";
- print $fh ' </p>'."\n";
- }
- print $fh ' <a href="/" class="cz">'.html_entity_encode_dec(WEBSITE(),1).'</a>'."\n";
- print $fh ' </body>'."\n";
-}
-
-sub print_html_data {
- (my $fh, my $data) = @_;
-
- foreach my $key (keys %$data) {
- unless ($key eq 'content') {
- my $val = $data->{$key};
- $val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
- print $fh html_encode_line("$key: $val\n", 1);
- }
- }
- print $fh html_encode_line("\n".$data->{'content'});
-}
-
-sub print_goto {
- (
- my $file,
- my $state,
- my $settings,
- my $goto_list,
- my $password_ok,
- ) = @_;
-
- my $fh;
- my $last_frame;
- my $ong_state;
- my $password_query;
-
- $last_frame = int($state->{'last'});
- $ong_state = int($state->{'state'});
- $password_query = url_query_encode({'p', $settings->{'password'}});
-
- my $_title = html_entity_encode_dec($settings->{'story'}, 1);
- my $_website_name = html_entity_encode_dec(WEBSITE_NAME() , 1);
- my $_base_url = html_entity_encode_dec(CGI_PATH() , 1);
-
- if (ref($file)) {
- $fh=$file;
- unless (seek($fh, 0, 0)) {
- #don't actually fail here
- }
- }
- else {
- unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) {
- return 0;
- }
- }
-
- print_html_start($fh);
- print_html_head_start($fh);
-
- print $fh ' <title>GOTO • '.$_title.' • '.$_website_name.'</title>'."\n";
-
- print_html_head_end($fh);
- print_html_body_start($fh);
-
- print $fh ' <div id="inst" class="ins">'."\n";
-
- print $fh ' <div id="title">'."\n";
- print $fh ' <h1 id="titletext">'.$_title.'</h1>'."\n";
- print $fh ' </div>'."\n";
-
- print $fh ' </div>'."\n";
- print $fh ' <div id="insb" class="ins">'."\n";
-
- print $fh ' <div id="chat">'."\n";
-
- for (my $frame = 0; ; $frame += 1) {
- unless (
- $password_ok || (
- ($frame <= $last_frame) &&
- ($ong_state >= STATE->{'waiting'})
- )
- ) {
- last;
- }
- my $title;
- my $ongtime;
- my @time_tab;
- my $time_text;
- my $timer_color;
- my $frame_text;
- my $viewer_url;
-
- $ongtime = $goto_list->{'ongtime-'.$frame};
- $title = $goto_list->{'title-' .$frame};
- if (($ongtime eq '') && ($title eq '')) {
- my %frame_data = read_frame_data($frame);
- $ongtime = $frame_data{'ongtime'};
- $title = $frame_data{'title'};
- unless (keys %frame_data) {
- last;
- }
- }
-
- if ($ongtime ne '') {
- @time_tab = gmtime($ongtime);
- $time_text = sprintf(
- '%02d.%02d.%02d %02d:%02d',
- $time_tab[3],
- $time_tab[4]+1,
- $time_tab[5]%100,
- $time_tab[2],
- $time_tab[1]
- );
- }
- else {
- $time_text = (($frame <= $last_frame) && ($ong_state >= STATE->{'waiting'})) ?
- 'EE.EE.EE EE:EE' : '--.--.-- --:--';
- }
- if ($title eq '') {
- $title = '_';
- }
- $timer_color = (($frame > $last_frame) || ($ong_state < STATE->{'waiting'})) ?
- 'cz' : (
- (($frame == $last_frame) && ($ong_state < STATE->{'ready'})) ?
- 'ni' : 'br'
- );
- $frame_text = sprintf('%03d',$frame);
- $viewer_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $frame}
- ); # TODO: consider static here?
- if ($password_ok) {
- $viewer_url = merge_url($viewer_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- }
-
- my $_viewer_url = html_entity_encode_dec($viewer_url, 1);
- my $_title = html_entity_encode_dec($title , 1);
-
- print $fh ' <span class="'.$timer_color.'">'.$frame_text.'</span> '.$time_text.' <a href="'.$_viewer_url.'">'.$_title.'</a><br>'."\n";
- }
- print $fh ' </div>'."\n";
-
- print $fh ' <div id="underlinks">'."\n";
- print $fh ' <a href="'.$_base_url.'">BSTA</a>'."\n";
- print $fh ' </div>'."\n";
-
- print $fh ' </div>'."\n";
-
- print_html_body_end($fh, $ong_state == STATE->{'inactive'});
- print_html_end($fh);
-
- unless (ref($file)) {
- close ($fh);
- }
- else {
- truncate ($fh , tell($fh));
- }
-
- return 1;
-}
-
-sub print_viewer_page {
- (
- my $file,
- my $context,
- my $state,
- my $settings,
- my $frame_data,
- my $prev_frame_data,
- my $next_frame_data,
- my $words_data,
- ) = @_;
- my $fh;
-
- my $launch = $context->{'launch'};
- my $access = $context->{'access'};
- my $password_ok = $context->{'password_ok'};
- my $static = $context->{'static'};
-
- my $goto = int($context->{'goto'});
- my $frame = int($context->{'frame'});
- my $text_mode = int($context->{'text_mode'});
- my $timer_unlocked = int($context->{'timer_unlocked'});
- my $timer = int($context->{'timer'});
- # my $words_page = int($context->{'words_page'});
-
- my $prev_frame = $frame - 1;
- my $next_frame = $frame + 1;
-
- my $story = $settings->{'story'};
- my $title = $frame_data->{'title'};
- my $command = ($frame_data->{'command'} ne '') ?
- $frame_data->{'command'} :
- $next_frame_data->{'title'};
-
- my $last_frame = int($state->{'last'});
- my $ong_state = int($state->{'state'});
-
- my $width = int($frame_data->{'width'});
- my $height = int($frame_data->{'height'});
- my $frame_type = $frame_data->{'frametype'};
-
- my $timer_color_h = (($timer_unlocked >= 1) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
- my $timer_color_m = (($timer_unlocked >= 2) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
- my $timer_color_s = (($timer_unlocked >= 3) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
-
- my $timer_h;
- my $timer_m;
- my $timer_s;
- if (
- ($timer > 0) ||
- (($timer >= 0) && ($frame == 0))
- ) {
- $timer_s = sprintf('%02d', $timer % 60);
- $timer_h = int($timer / 60);
- $timer_m = sprintf('%02d', $timer_h % 60);
- $timer_h = sprintf('%02d', $timer_h / 60);
- }
- elsif (($timer >= -15) && ($ong_state >= STATE->{'ready'})) {
- $timer_h = '00';
- $timer_m = '00';
- $timer_s = 'NG';
- }
- else {
- $timer_h = 'EE';
- $timer_m = 'EE';
- $timer_s = 'EE';
- }
-
- my $words_posts = int($words_data->{'posts'});
- my $words_link_text = 'Words'.(($words_posts > 0) ? "[$words_posts]" : '');
-
- my $prev_available = (($frame > 0) && $access);
- my $next_available = ($launch || $password_ok || ($next_frame <= $last_frame));
- my $prefetch_prev = (
- $password_ok ||
- ($prev_frame < $last_frame) || ( # avoid unseen trigger!
- ($prev_frame <= $last_frame) &&
- ($ong_state >= STATE->{'ready'})
- )
- );
- my $prefetch_next = (
- $password_ok ||
- ($next_frame < $last_frame) || ( # avoid unseen trigger!
- ($next_frame <= $last_frame) &&
- ($ong_state >= STATE->{'ready'})
- )
- );
- my $show_timer = (
- (
- $access && $launch
- ) || (
- ($frame == $last_frame) && (
- ($ong_state == STATE->{'waiting'}) ||
- ($ong_state == STATE->{'ready'})
- )
- )
- );
- my $show_command = (
- $launch ||
- $password_ok ||
- (!$access) ||
- ($frame < $last_frame) || (
- ($ong_state >= STATE->{'ready'}) &&
- $context->{'show_command'}
- )
- );
- my $show_command_link = ($next_available || (!$access));
- my $show_command_cursor = ((!$next_available) || ($command eq ''));
- my $show_words = ($password_ok || ($access && !$launch));
-
- my $frame_indirect = !(
- (!$access) || (
- ($frame <= $last_frame) &&
- ($ong_state > STATE->{'inactive'})
- )
- );
- my $prevframe_indirect = !($prev_frame <= $last_frame);
- my $nextframe_indirect = !($next_frame <= $last_frame);
-
- my $password_query;
-
- my $base_url = CGI_PATH();
- my $timer_url = CGI_TIMER_PATH();
- my $viewer_full_url = merge_url(
- {'scheme' => SCHEME(), 'host' => WEBSITE()},
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $frame}
- );
- my $viewer_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $frame}
- );
- my $viewer_0_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => 0}
- );
- my $viewer_prev_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $prev_frame}
- );
- my $viewer_next_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $next_frame}
- );
- my $viewer_last_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => ($static ? -1 : $last_frame)}
- );
- my $goto_url = ($goto) ?
- CGI_GOTO_PATH() :
- merge_url(
- {'path' => $viewer_url},
- {
- 'query' => {'g' => 1},
- 'fragment' => 'goto'
- }
- );
-
- unless ($password_ok) {
- my $page_file;
- $viewer_0_url = $base_url;
- if ($prev_frame == 0) {
- $viewer_prev_url = $viewer_0_url;
- }
- else {
- $page_file = get_page_file($prev_frame, $prev_frame_data, $settings);
- if (_x_encoded('-f',
- join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
- )) {
- $viewer_prev_url = merge_url(
- {'path' => $base_url},
- {'path' => $page_file}
- );
- }
- }
- if ($next_frame < $last_frame) {
- $page_file = get_page_file($next_frame, $next_frame_data, $settings);
- if (_x_encoded('-f',
- join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
- )) {
- $viewer_next_url = merge_url(
- {'path' => $base_url},
- {'path' => $page_file}
- );
- }
- }
- if (
- $goto &&
- (_x_encoded('-f',WWW_GOTO_PATH()))
- ) {
- $goto_url = CGI_LIST_PATH();
- }
- }
- my $bbcode_url = ($text_mode == TEXT_MODE->{'bb'}) ?
- merge_url(
- {'path' => CGI_BBCODE_PATH()},
- {'path' => $frame}
- ) :
- merge_url (
- $viewer_url,
- {
- 'query'=>{
- 'b' => TEXT_MODE->{'bb'}
- },
- 'fragment'=>'insb'
- }
- );
- my $info_url = ($text_mode == TEXT_MODE->{'info'}) ?
- merge_url(
- {'path' => CGI_INFO_PATH()},
- {'path' => $frame}
- ) :
- merge_url (
- $viewer_url,
- {
- 'query'=>{
- 'b' => TEXT_MODE->{'info'}
- },
- 'fragment'=>'insb'
- }
- );
- my $words_url = merge_url (
- $viewer_url,
- {
- 'query'=>{
- 'b' => TEXT_MODE->{'words'}
- },
- 'fragment'=>'insw'
- }
- );
- my $frame_file;
- my $frame_url;
- my $frame_prev_url;
- my $frame_next_url;
- my $frame_normal_url;
- my $frame_full_url;
- $frame_file = get_frame_file($frame, $frame_data, $settings);
- $frame_normal_url = merge_url(
- {'path' => CGI_PATH()},
- {'path' => $frame_file}
- );
- $frame_url = $frame_indirect ?
- merge_url(
- {'path' => CGI_FRAME_PATH()},
- {'path' => $frame}
- ) :
- $frame_normal_url;
- $frame_full_url = merge_url(
- {'scheme' => SCHEME(), 'host' => WEBSITE()},
- {'path' => $frame_normal_url}
- );
- if ($prevframe_indirect) {
- $frame_prev_url = merge_url(
- {'path' => CGI_FRAME_PATH()},
- {'path' => $prev_frame}
- );
- }
- else {
- $frame_prev_url = merge_url(
- {'path' => CGI_PATH()},
- {'path' => get_frame_file($prev_frame, $prev_frame_data, $settings)}
- );
- }
- if ($nextframe_indirect) {
- $frame_next_url = merge_url(
- {'path' => CGI_FRAME_PATH()},
- {'path' => $next_frame}
- );
- }
- else {
- $frame_next_url = merge_url(
- {'path' => CGI_PATH()},
- {'path' => get_frame_file($next_frame, $next_frame_data, $settings)}
- );
- }
-
- if ($password_ok) {
- $password_query = url_query_encode({'p', $settings->{'password'}});
- $goto_url = merge_url($goto_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $info_url = merge_url($info_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $words_url = merge_url($words_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $bbcode_url = merge_url($bbcode_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $viewer_url = merge_url($viewer_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $viewer_0_url = merge_url($viewer_0_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $viewer_prev_url = merge_url($viewer_prev_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $viewer_next_url = merge_url($viewer_next_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $viewer_last_url = merge_url($viewer_last_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- if ($frame_indirect) {
- $frame_url = merge_url($frame_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- }
- if ($prevframe_indirect) {
- $frame_prev_url= merge_url($frame_prev_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- }
- if ($nextframe_indirect) {
- $frame_next_url= merge_url($frame_next_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- }
- }
- my $_password = $password_ok ? html_entity_encode_dec($settings->{'password'}, 1) : '';
- my $_action_url = html_entity_encode_dec(CGI_VIEWER_PATH(), 1);
- my $_base_url = html_entity_encode_dec($base_url , 1);
- my $_goto_url = html_entity_encode_dec($goto_url , 1);
- my $_info_url = html_entity_encode_dec($info_url , 1);
- my $_words_url = html_entity_encode_dec($words_url , 1);
- my $_bbcode_url = html_entity_encode_dec($bbcode_url , 1);
- my $_timer_url = html_entity_encode_dec($timer_url , 1);
- my $_viewer_full_url = html_entity_encode_dec($viewer_full_url , 1);
- my $_viewer_url = html_entity_encode_dec($viewer_url , 1);
- my $_viewer_0_url = html_entity_encode_dec($viewer_0_url , 1);
- my $_viewer_prev_url = html_entity_encode_dec($viewer_prev_url , 1);
- my $_viewer_next_url = html_entity_encode_dec($viewer_next_url , 1);
- my $_viewer_last_url = html_entity_encode_dec($viewer_last_url , 1);
- my $_frame_url = html_entity_encode_dec($frame_url , 1);
- my $_frame_prev_url = html_entity_encode_dec($frame_prev_url , 1);
- my $_frame_next_url = html_entity_encode_dec($frame_next_url , 1);
- my $_frame_full_url = html_entity_encode_dec($frame_full_url , 1);
-
- my $_story = html_entity_encode_dec($story , 1);
- my $_title = html_entity_encode_dec($title , 1);
- my $_command = html_entity_encode_dec($command , 1);
- my $_frame_type = html_entity_encode_dec($frame_type, 1);
-
- my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
-
- if ($text_mode == TEXT_MODE->{'info'}) {
- if ($show_command) {
- $frame_data->{'command'} = $command;
- }
- if ($access) {
- $frame_data->{'frame'} = $frame_file;
- }
- if ($frame_data->{'page'} eq '') {
- unless (($access) && ($frame < $last_frame)) {
- $frame_data->{'page'} = '';
- }
- else {
- $frame_data->{'page'} = get_page_file($frame, $frame_data, $settings);
- }
- }
- }
-
- # everything determined, now start generating
-
- if (ref($file)) {
- $fh=$file;
- unless (seek($fh, 0, 0)) {
- #don't actually fail here
- }
- }
- else {
- unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) {
- return 0;
- }
- }
-
- print_html_start($fh);
- print_html_head_start($fh);
-
- print $fh ' <title>'.$_title;
- if ($story ne $title) {
- print $fh ' • '.$_story;
- }
- print $fh ' • '.$_website_name.'</title>'."\n";
- print $fh ' <link rel="index" href="'.$_goto_url.'">'."\n";
- print $fh ' <link rel="start" href="'.$_viewer_0_url.'">'."\n";
- if ($prev_available) {
- print $fh ' <link rel="prev" href="'.$_viewer_prev_url.'">'."\n";
- if ($prefetch_prev) {
- print $fh ' <link rel="prefetch" href="'.$_viewer_prev_url.'">'."\n";
- print $fh ' <link rel="prefetch" href="'.$_frame_prev_url.'">'."\n";
- }
- }
- if ($next_available) {
- print $fh ' <link rel="next" href="'.$_viewer_next_url.'">'."\n";
- if ($prefetch_next) {
- print $fh ' <link rel="prefetch" href="'.$_viewer_next_url.'">'."\n";
- print $fh ' <link rel="prefetch" href="'.$_frame_next_url.'">'."\n";
- }
- }
- if ($show_timer) {
- print $fh ' <script src="'.$_timer_url.'"></script>'."\n";
- }
-
- print_html_head_end($fh);
- print_html_body_start($fh);
-
- print $fh ' <div id="inst" class="ins">'."\n";
-
- print $fh ' <div id="title">'."\n";
- print $fh ' <h1 id="titletext">'.$_title.'</h1>'."\n";
- print $fh ' </div>'."\n";
-
- print $fh ' </div>'."\n";
- print $fh ' <div id="framespace">'."\n";
-
- print $fh ' <img src="'.$_frame_url.'" id="frame" class="'.$_frame_type.'" alt="'.$frame.'" title="'.$_title.'" width="'.$width.'" height="'.$height.'">'."\n";
-
- print $fh ' </div>'."\n";
- print $fh ' <div id="insb" class="ins">'."\n";
-
- if ($text_mode == TEXT_MODE->{'info'}) {
- print $fh ' <div id="chat">'."\n";
-
- print_html_data($fh, $frame_data);
-
- print $fh ' </div>'."\n";
- }
- elsif ($text_mode == TEXT_MODE->{'bb'}) {
- print $fh ' <div id="chat">'."\n";
-
- print $fh '[quote][center][size=200]'.$_title.'[/size]<br>'."\n";
- print $fh '[url='.$_viewer_full_url.'][img]'.$_frame_full_url.'[/img][/url][/center]<br>'."\n";
- print $fh html_encode_line(
- bb_to_bbcode(
- eval_bb(
- $frame_data->{'content'},
- 1
- )
- )
- );
- print $fh '[/quote]'."\n";
-
- print $fh ' </div>'."\n";
- }
- elsif ($frame_data->{'content'} ne '') {
- print $fh ' <div id="undertext">'."\n";
- print $fh bb_to_html(
- eval_bb(
- $frame_data->{'content'},
- 0,
- $password_ok ? $settings->{'password'} : ''
- )
- )."\n";
- print $fh ' </div>'."\n";
- }
-
- print $fh ' <div id="command">'."\n";
-
- if ($show_timer) {
- print $fh ' <span id="timer">';
- print $fh '[<span id="ongh" class="hv '.$timer_color_h.'">'.$timer_h.'</span>';
- print $fh ':<span id="ongm" class="hv '.$timer_color_m.'">'.$timer_m.'</span>';
- print $fh ':<span id="ongs" class="hv '.$timer_color_s.'">'.$timer_s.'</span>]';
- print $fh '</span><br>'."\n";
- }
- print $fh ' >';
- if ($show_command_link) {
- print $fh '<a href="'.($access ? $_viewer_next_url : $_viewer_last_url).'">';
- }
- if ($show_command) {
- print $fh $_command;
- }
- if ($show_command_cursor) {
- print $fh '<span class="inp">_</span>';
- }
- if ($show_command_link) {
- print $fh '</a>';
- }
- print $fh "<br>\n";
- print $fh " </div>\n";
-
- print $fh ' <div id="underlinks">'."\n ";
-
- unless (($frame == 0) && $static) {
- print $fh '<a href="'.$_base_url.'">Once again</a> | ';
- }
- if ($prev_available) {
- print $fh '<a href="'.$_viewer_prev_url.'">Before</a> | ';
- }
- unless ($frame == $last_frame) {
- print $fh '<a href="'.$_viewer_last_url.'">Now</a> | ';
- }
- print $fh '<a href="'.$_goto_url.'">GOTO</a>'."\n";
- print $fh ' <span style="float: right;">'."\n ";
- if (
- ($text_mode == TEXT_MODE->{'normal'}) &&
- (!$goto)
- ){
- if ($show_words) {
- print $fh '<a href="'.$_words_url.'">'.$words_link_text.'</a> | ';
- }
- }
- else {
- print $fh '<a href="'.$_viewer_url.'">Without</a> | ';
- }
- print $fh '<a href="'.$_info_url.'">Info</a> | ';
- print $fh '<a href="'.$_bbcode_url.'">BB</a>';
- print $fh "\n </span>\n";
-
- print $fh " </div>\n";
-
- if ($goto) {
- print $fh ' <div class="underlinks" id="goto">'."\n";
- print $fh ' <form class="goto" method="get" action="'.$_action_url.'">'."\n";
- print $fh ' GO TO:'."\n";
- print $fh ' <input class="intx" type="number" size="4" name="f"'.(
- ($goto > 1) ?
- ('value="'.$frame.'"') :
- ''
- ).'>'."\n";
- print $fh ' <input class="inbt" type="submit" value="GO">'."\n";
- if ($password_ok) {
- print $fh ' <input type="hidden" name="p" value="'.$_password.'">'."\n";
- }
- print $fh ' <input type="hidden" name="g" value="2">'."\n";
- print $fh ' </form>'."\n";
- print $fh " </div>\n";
- }
-
- print $fh " </div>\n";
-
- if (($text_mode == TEXT_MODE->{'words'}) && $show_words) {
- print_comments($fh, $context, $settings, $words_data);
- }
-
- print_html_body_end($fh, $ong_state == STATE->{'inactive'});
- print_html_end($fh);
-
-
- unless (ref($file)) {
- close ($fh);
- }
- else {
- truncate ($fh , tell($fh));
- }
-
- return 1;
-}
-
-sub print_comments {
- (my $fh, my $context, my $settings, my $words_data) = @_;
-
- my $password_ok = $context->{'password_ok'};
- my $frame = int($context->{'frame'});
- my $page = int($context->{'words_page'});
- my $post_count = int($words_data->{'posts'});
- my $id_start = $page * COMMENT_PAGE_LENGTH();
- my $id_stop = $id_start + COMMENT_PAGE_LENGTH();
- my $older = ($page > 0) ? ($page-1) : '';
- my $newer;
- my $password_query;
- if ($id_stop >= $post_count) {
- $id_stop = $post_count;
- }
- else {
- $newer = $page+1;
- }
- my $links;
-
- my $words_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {
- 'path' => $frame,
- 'query' => {'b' => TEXT_MODE->{'words'}},
- }
- );
- my $older_url = merge_url(
- $words_url,
- {
- 'query' => {'i' => $page-1},
- 'fragment' => 'insw',
- 'append_query' => 1
- }
- );
- my $newer_url = merge_url(
- $words_url,
- {
- 'query' => {'i' => $page+1},
- 'fragment' => 'insw',
- 'append_query' => 1
- }
- );
-
- if ($password_ok) {
- $password_query = url_query_encode({'p', $settings->{'password'}});
- $older_url = merge_url($older_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $newer_url = merge_url($older_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- }
-
- my $_password = $password_ok ? html_entity_encode_dec($settings->{'password'}, 1) : '';
- my $_post_url = html_entity_encode_dec(CGI_WORDS_PATH(), 1);
- my $_older_url = html_entity_encode_dec($older_url, 1);
- my $_newer_url = html_entity_encode_dec($newer_url, 1);
-
- if (($older ne '') || ($newer ne '')) {
- $links .= ' <div class="underlinks">'."\n";
- $links .= ' ';
- if ($older ne '') {
- $links .= '<a href="'.$_older_url.'">Older</a>'
- }
- if (($older ne '') && ($newer ne '')) {
- $links .= ' | ';
- }
- if ($newer ne '') {
- $links .= '<a href="'.$_newer_url.'">Newer</a>';
- }
- $links .= "\n";
- $links .= ' </div>'."\n";
- }
-
- print $fh ' <div class="space"></div>'."\n";
- print $fh ' <div id="insw" class="ins">'."\n";
-
- print $fh ' <div class="title" id="wordstitle">'."\n";
- print $fh ' <h1 class="titletext" id="wordstitletext">Words</h1>'."\n";
- print $fh ' </div>'."\n";
-
- if ($links ne '') {
- print $fh $links;
- }
-
- print $fh ' <div class="undertext" id="words">'."\n";
-
- if ($post_count > 0) {
- for (my $i=$id_start; $i<$id_stop; ++$i) {
- my $ID = $words_data->{'content'}->[$i];
- my %post_data = read_words($ID);
-
- my $post_time = int($post_data{'posttime'});
- my $edit_time = int($post_data{'edittime'});
-
- my $post_time_text;
- my $edit_time_text;
-
- if ($post_time != 0) {
- my @time_tab = gmtime($post_time);
- $post_time_text = sprintf(
- '%04d.%02d.%02d %02d:%02d:%02d UTC',
- $time_tab[5]+1900,
- $time_tab[4]+1,
- $time_tab[3],
- $time_tab[2],
- $time_tab[1],
- $time_tab[0]
- );
- }
- if (($edit_time !=0) && ($edit_time != $post_time)) {
- my @time_tab = gmtime($edit_time);
- $edit_time_text = sprintf(
- '%04d.%02d.%02d %02d:%02d UTC',
- $time_tab[5]+1900,
- $time_tab[4]+1,
- $time_tab[3],
- $time_tab[2],
- $time_tab[1]
- );
- }
- my $quote_url = merge_url(
- {'path' => CGI_WORDS_PATH()},
- {
- 'query' => {
- 'f' => $frame,
- 'quote' => $ID,
- 'p' => ($password_ok ? $settings->{'password'} : '')
- }
- }
- );
- my $edit_url = merge_url(
- {'path' => CGI_WORDS_PATH()},
- {
- 'query' => {
- 'f' => $frame,
- 'edit' => $ID,
- 'key' => $post_data{'key'},
- 'username' => $post_data{'name'},
- 'p' => ($password_ok ? $settings->{'password'} : '')
- }
- }
- );
- my $remove_url = merge_url(
- {'path' => CGI_WORDS_PATH()},
- {
- 'query' => {
- 'f' => $frame,
- 'remove' => $ID,
- 'key' => $post_data{'key'},
- 'username' => $post_data{'name'},
- 'p' => ($password_ok ? $settings->{'password'} : '')
- }
- }
- );
-
- my $_ID = html_entity_encode_dec($ID, 1);
- my $_name = html_entity_encode_dec($post_data{'name'}, 1);
- my $_quote_url = html_entity_encode_dec($quote_url, 1);
- my $_edit_url = html_entity_encode_dec($edit_url, 1);
- my $_remove_url = html_entity_encode_dec($remove_url, 1);
-
- print $fh ' <div id="'.$_ID.'"class="opomba">'."\n";
- print $fh ' <div class="opomba_info">'."\n";
- print $fh ' <a href="#'.$_ID.'" class="bi hu">'.$i.': '.$_name;
- if ($post_time_text ne '') {
- print $fh ' • '.$post_time_text;
- }
- if ($edit_time_text ne '') {
- print $fh ' • '.$edit_time_text;
- }
- print $fh '</a>'."\n";
- print $fh ' <div class="pr">'."\n";
- print $fh ' <a href="'.$_quote_url.'" class="bi hu">quote</a> | <a href="'.$_edit_url.'" class="bi hu">edit</a> | <a href="'.$_remove_url.'" class="bi hu">remove</a>'."\n";
- print $fh ' </div>'."\n";
- print $fh ' </div>'."\n";
- print $fh ' <div class="opomba_text">'."\n";
- print $fh bb_to_html(
- eval_bb(
- $post_data{'content'},
- 0,
- $password_ok ? $settings->{'password'} : ''
- )
- )."\n";
- print $fh ' </div>'."\n";
- print $fh ' </div>'."\n";
- print $fh ' <br>'."\n";
- }
- }
-
- print $fh ' <form method="post" action="'.$_post_url.'">'."\n";
- print $fh ' <b>Your words:</b>'."\n";
- print $fh ' <textarea class="inta" name="words" rows="4"></textarea>'."\n";
- print $fh ' <table cellpadding="0" cellspacing="0" border="0"><tr>'."\n";
- print $fh ' <td><b>Your name: </b></td>'."\n";
- print $fh ' <td><input class="intx" type="text" name="username" value=""></td>'."\n";
- print $fh ' <td></td>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <td><b>Optional password: </b></td>'."\n";
- print $fh ' <td><input class="intx" type="password" name="password" value=""></td>'."\n";
- print $fh ' <td>(if you want to edit later)</td>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <td><b>Leave this empty: </b></td>'."\n";
- print $fh ' <td><input class="intx" type="text" name="password2" value=""></td>'."\n";
- print $fh ' <td>'."\n";
- print $fh ' <input class="inbt" type="submit" name="post" value="Send">'."\n";
- print $fh ' <input class="inbt" type="submit" name="preview" value="Preview">'."\n";
- print $fh ' </td>'."\n";
- print $fh ' </tr></table>'."\n";
- print $fh ' <input type="hidden" name="f" value="'.$frame.'">'."\n";
- if ($password_ok) {
- print $fh ' <input type="hidden" name="p" value="'.$_password.'">'."\n";
- }
- print $fh ' </form>'."\n";
- print $fh ' </div>'."\n";
-
- if ($links ne '') {
- print $fh $links;
- }
-
- print $fh ' </div>'."\n";
-}
-
-sub write_index {
- (
- my $state,
- my $settings,
- my $pass,
- my $mode,
- my $pause
- ) = @_;
- my $fh;
- my $r = 1;
- my $ong_state = int($state->{'state'});
-
- unless (open_encoded($fh, ">:encoding(UTF-8)", WWW_INDEX_PATH())) {
- return 0;
- }
-
- # normal running story
- if ($ong_state > STATE->{'inactive'}) {
- my %default = read_default();
- my %frame_data = read_frame_data(0, \%default);
- my %next_frame_data= read_frame_data(1, \%default);
- my %words_data = read_words_list(
- 0, # frame ID
- 1, # header only
- );
-
- $r = print_viewer_page(
- $fh,
- {
- 'launch' => 0,
- 'frame' => 0,
- 'access' => 1,
- 'password_ok' => 0,
- 'timer_unlocked' => 3, # not relevant
- 'timer' => 0, # not relevant
- 'static' => 1,
- 'show_command' => 1,
- 'text_mode' => TEXT_MODE->{'normal'},
- 'words_page' => 0, # not relevant
- 'goto' => 0
- },
- $state,
- $settings,
- \%frame_data,
- \%default, # prev
- \%next_frame_data,
- \%words_data
- );
- }
- # no conditions met, pretend a normal Apache2 index
- elsif ($pass != 1) {
- my $index_of = CGI_PATH;
- $index_of =~ s/\/$//g;
-
- my $_index_of = html_entity_encode_dec($index_of , 1);
- my $_2words_date = html_entity_encode_dec(INTF_DATE(), 1);
- my $_coin_date = html_entity_encode_dec(COIN_DATE(), 1);
- my $_website = html_entity_encode_dec(WEBSITE() , 1);
-
- print_html_start ($fh);
- print $fh ' <head>'."\n";
- print $fh ' <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
- print $fh ' <title>Index of '.$_index_of.'</title>'."\n";
- print $fh ' </head>'."\n";
- print $fh ' <body>'."\n";
- print $fh ' <h1>Index of '.$_index_of.'</h1>'."\n";
- print $fh ' <table>'."\n";
- print $fh ' <tr>'."\n";
- print $fh ' <th><img src="/icons/blank.gif" alt="[ICO]"></th>'."\n";
- print $fh ' <th><a href="?C=N;O=D">Name</a></th>'."\n";
- print $fh ' <th><a href="?C=M;O=A">Last modified</a></th>'."\n";
- print $fh ' <th><a href="?C=S;O=A">Size</a></th>'."\n";
- print $fh ' <th><a href="?C=D;O=A">Description</a></th>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <th colspan="5"><hr></th>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <td valign="top"><img src="/icons/back.gif" alt="[DIR]"></td>'."\n";
- print $fh ' <td><a href="/">Parent Directory</a></td>'."\n";
- print $fh ' <td> </td>'."\n";
- print $fh ' <td align="right"> - </td>'."\n";
- print $fh ' <td> </td>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
- print $fh ' <td><a href="2words/">2words/</a></td>'."\n";
- print $fh ' <td align="right">'.$_2words_date.' </td>'."\n";
- print $fh ' <td align="right"> - </td><td> </td>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
- print $fh ' <td><a href="coin/">coin/</a></td>'."\n";
- print $fh ' <td align="right">'.$_coin_date.' </td>'."\n";
- print $fh ' <td align="right"> - </td><td> Coincidence </td>'."\n";
- print $fh ' </tr><tr>'."\n";
- print $fh ' <th colspan="5"><hr></th>'."\n";
- print $fh ' </tr>'."\n";
- print $fh ' </table>'."\n";
- print $fh ' <address>Apache/2.2.22 (Debian) Server at '.$_website.' Port 80</address>'."\n";
- print $fh ' </body>'."\n";
- print_html_end ($fh);
- }
- # the launch index
- else {
- my %default = read_default();
- my %frame_data = read_frame_data(0, \%default);
- my %next_frame_data= read_frame_data(1, \%default);
- my %coin_data = read_coincidence();
-
- if (($mode == INTF_STATE->{'>'}) && $pause) {
- $r = print_viewer_page(
- $fh,
- {
- 'launch' => 1,
- 'frame' => 0,
- 'access' => 1,
- 'password_ok' => 0,
- 'timer_unlocked' => 3,
- 'timer' => 0,
- 'static' => 1,
- 'show_command' => 1,
- 'text_mode' => TEXT_MODE->{'normal'},
- 'words_page' => 0, # not relevant
- 'goto' => 0
- },
- $state,
- $settings,
- \%frame_data,
- \%default, # prev
- \%next_frame_data,
- {'posts' => 0} # words_data
- );
- return $r;
- }
-
- my $index_of = CGI_PATH;
- $index_of =~ s/\/$//g;
- my $title;
- my $frame_file;
- my $undertext = '';
- my $show_parent_dir = 0;
- my $show_yb = 0;
- my $show_folders = 0;
- my $timer = '';
- my $timer_color = 'ni';
- if ($mode == INTF_STATE->{'>'}) {
- $title = $settings->{'story'}; # $frame_data{'title'} ?
- $frame_file = 'intf-tr.gif';
- $undertext = '...';
- $timer = '--';
- }
- elsif ($mode == INTF_STATE->{'<<'}) {
- $title = 'Index of';
- $frame_file = 'intf-ll.gif';
- $show_parent_dir = 1;
- $show_yb = 1;
- $timer = 'EE';
- $timer_color = 'br';
- }
- elsif ($mode == INTF_STATE->{'>>'}) {
- $title = 'Index of';
- $frame_file = 'intf-pp.gif';
- $show_parent_dir = 1;
- $show_yb = 1;
- $timer = 'EE';
- }
- else
- {
- $title = 'Index of '.$index_of;
- $frame_file = 'intf-kw.gif';
- $show_parent_dir = 1;
- $show_folders = 1;
- }
- my $frame_url = merge_url(
- {'path' => CGI_PATH()},
- {'path' => $frame_file}
- );
- my $coin_server = $coin_data{'server'};
-
- my $_title = html_entity_encode_dec($title , 1);
- my $_website_name = html_entity_encode_dec(WEBSITE_NAME() , 1);
- my $_frame_url = html_entity_encode_dec($frame_url , 1);
- my $_undertext = html_entity_encode_dec($undertext , 1);
- my $_2words_date = html_entity_encode_dec(INTF_DATE() , 1);
- my $_coin_date = html_entity_encode_dec(COIN_DATE() , 1);
- my $_coin_server = html_entity_encode_dec($coin_server , 1);
- my $_2words_url = html_entity_encode_dec(CGI_2WORDS_PATH(), 1);
- my $_coin_url = html_entity_encode_dec(CGI_COIN_PATH() , 1);
-
- print_html_start($fh);
- print_html_head_start($fh);
-
- print $fh ' <title>'.$_title.' • '.$_website_name.'</title>'."\n";
-
- print_html_head_end($fh);
- print_html_body_start($fh);
-
- print $fh ' <div id="inst" class="ins">'."\n";
-
- print $fh ' <div id="title">'."\n";
- print $fh ' <h1 id="titletext">'.$_title.'</h1>'."\n";
- print $fh ' </div>'."\n";
-
- print $fh ' </div>'."\n";
- print $fh ' <div id="framespace">'."\n";
-
- print $fh ' <img src="'.$_frame_url.'" id="frame" alt="0">'."\n"; # title="'.$_title.'"
-
- print $fh ' </div>'."\n";
- print $fh ' <div id="insb" class="ins">'."\n";
-
- print $fh ' <div id="undertext">'."\n";
-
- if ($show_parent_dir) {
- print $fh ' <img src="/icons/back.gif" alt="[DIR]"> <a href="..">Parent Directory</a><br>'."\n";
- }
- if ($show_folders) {
- print $fh ' <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">2words/</a> '.$_2words_date.' - <br>'."\n";
- print $fh ' <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_coin_url.'">coin/</a> '.$_coin_date.' - '.$_coin_server."\n";
- }
- elsif ($show_yb) {
- print $fh ' <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">yyyyb/</a>'."\n";
- }
- if ($undertext ne '') {
- print $fh ' '.$_undertext."\n";
- }
-
- print $fh ' </div>'."\n";
-
- if ($timer ne '') {
- print $fh ' <div id="command">'."\n";
-
- print $fh ' [<span id="ongh" class="'.$timer_color.'">'.$timer.'</span>';
- print $fh ':<span id="ongm" class="'.$timer_color.'">'.$timer.'</span>';
- print $fh ':<span id="ongs" class="'.$timer_color.'">'.$timer.'</span>]<br>'."\n";
-
- if ($undertext ne '') {
- print $fh '><a href="'.$_2words_url.'">'.$_undertext.'</a><span class="inp">_</span>'."\n";
- }
- print $fh " </div>\n";
- }
-
- print $fh " </div>\n";
-
- print_html_body_end($fh, $ong_state == STATE->{'inactive'});
- print_html_end($fh);
- }
- close ($fh);
- return $r
-}
-
-sub write_static_viewer_page {
- (
- my $frame,
- my $state_ref,
- my $settings_ref,
- my $default_ref,
- my $frame_data_ref,
- my $prev_frame_data_ref,
- my $next_frame_data_ref,
- my $words_data_ref
- ) = @_;
-
- my %state;
- my %settings;
- my %default;
- my %frame_data;
- my %prev_frame_data;
- my %next_frame_data;
- my %words_data;
-
- my $file;
-
- $frame = int($frame);
- my $prev_frame = $frame -1;
- my $next_frame = $frame +1;
-
- %state = (ref ($state_ref)) ?
- %$state_ref :
- read_state();
- my $ong_state = int($state{'state'});
- my $last_frame = int($state{'last'});
-
- unless ($ong_state > STATE->{'inactive'}) {
- return 0;
- }
- unless (
- ($frame >= 0) && (
- ($frame < $last_frame) || (
- ($frame <= $last_frame) &&
- ($ong_state >= STATE->{'end'})
- )
- )
- ) {
- return 0;
- }
-
- %settings = (ref ($settings_ref)) ?
- %$settings_ref :
- read_settings();
- %default = (ref ($default_ref)) ?
- %$default_ref :
- read_default();
-
- %frame_data = (ref ($frame_data_ref)) ?
- %$frame_data_ref :
- read_frame_data($frame);
-
- %prev_frame_data = (ref ($prev_frame_data_ref)) ?
- %$prev_frame_data_ref : (
- ($prev_frame >= 0) ?
- read_frame_data($prev_frame) :
- %default
- );
-
- %next_frame_data = (ref ($next_frame_data_ref)) ?
- %$next_frame_data_ref :
- read_frame_data($next_frame);
-
- %words_data = (ref ($words_data_ref)) ?
- %$words_data_ref :
- read_words_list(
- $frame, # frame ID
- 1, # header only
- );
-
- %frame_data = merge_settings(\%default, \%frame_data);
- %prev_frame_data = merge_settings(\%default, \%prev_frame_data);
- %next_frame_data = merge_settings(\%default, \%next_frame_data);
-
- $file = get_page_file($frame, \%frame_data, \%settings);
- $file = join_path(PATH_SEPARATOR(), WWW_PATH(), $file);
-
- return print_viewer_page(
- $file,
- {
- 'launch' => 0,
- 'frame' => $frame,
- 'access' => 1,
- 'password_ok' => 0,
- 'timer_unlocked'=> 3, # not relevant
- 'timer' => 0, # not relevant
- 'static' => 1,
- 'show_command' => 1,
- 'text_mode' => TEXT_MODE->{'normal'},
- 'words_page' => 0, # not relevant
- 'goto' => 0
- },
- \%state,
- \%settings,
- \%frame_data,
- \%prev_frame_data,
- \%next_frame_data,
- \%words_data
- );
-}
-
-sub write_static_goto {
- (my $state_ref, my $settings_ref, my $goto_ref) = @_;
- my %state;
- my %settings;
- my %goto_list;
-
- %state = (ref ($state_ref)) ?
- %$state_ref :
- read_state();
- %settings = (ref ($settings_ref)) ?
- %$settings_ref :
- read_settings();
- %goto_list = (ref ($goto_ref)) ?
- %$goto_ref :
- read_goto();
-
- return print_goto(
- WWW_GOTO_PATH(),
- \%state,
- \%settings,
- \%goto_list,
- 0, # password OK
- );
-}
-
-# ONG the frame + attachment & stuff. NOT update state file.
-sub ong {
- (
- my $ID, my $ongtime, my $timer, my $update, my $print,
- my $settings_ref, my $default_ref, my $data_ref, my $goto_ref
- ) = @_;
- my @files;
- my $cfrt;
- my $intf;
- my $frame;
- my $frame_data_path;
- my $write_data;
- my $in_path;
- my $out_path;
- my $r;
- my %settings;
- my %default;
- my %frame_data;
- my %frame_full_data;
- my %goto_list;
-
- if ($ongtime eq '') {
- $ongtime = time();
- }
-
- if ($ID eq 'i') {
- $intf = 1;
- }
- elsif ($ID eq 'c') {
- $cfrt = 1;
- }
- else {
- $frame = int($ID);
- }
-
- if ($intf) {
- @files = (
- 'intf-00.gif',
- 'intf-00_04.gif',
- 'intf-00_08.gif',
- 'intf-00_10.gif',
- 'intf-01.gif',
- 'intf-01_.gif',
- 'intf-02.gif',
- 'intf-02_.gif',
- 'intf-04.gif',
- 'intf-04_.gif',
- 'intf-08.gif',
- 'intf-08_.gif',
- 'intf-10.gif',
- 'intf-10_.gif',
- 'intf-20.gif',
- 'intf-20_.gif',
- 'intf-kw.gif',
- 'intf-ll.gif',
- 'intf-pp.gif',
- 'intf-tr.gif',
- );
- }
- else {
- %settings = (ref ($settings_ref)) ?
- %$settings_ref :
- read_settings();
- %default = (ref ($default_ref)) ? %$default_ref : read_default();
- $frame_data_path = $cfrt ?
- DATA_NOACCESS_PATH() :
- join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
- %frame_data = (ref ($data_ref)) ?
- %$data_ref :
- read_frame_data($frame_data_path);
- %frame_full_data = merge_settings(\%default, \%frame_data);
- @files = (get_frame_file($frame, \%frame_full_data, \%settings), );
- unless ($cfrt) {
- %goto_list = (ref ($goto_ref)) ?
- %$goto_ref :
- read_goto();
- for (my $i=0; ;$i+=1) {
- my %file_data = read_attachment($i);
- if ($file_data{'frame'} eq '') {
- last;
- }
- if (int($file_data{'frame'}) != $frame) {
- next;
- }
- if ($file_data{'content'} ne '') {
- next;
- }
- unshift @files, $file_data{'filename'};
- }
- if (
- (!$update) ||
- ($frame_full_data{'ongtime'} eq '')
- ) {
- $frame_data {'ongtime'} = $ongtime;
- $frame_full_data{'ongtime'} = $ongtime;
- $write_data = 1;
- }
- if (
- ($timer ne '') && (
- (!$update) ||
- ($frame_full_data{'timer'} eq '')
- )
- ) {
- $frame_data{'timer'} = int($timer);
- $write_data = 1;
- }
- if ($write_data) {
- $r = write_frame_data($frame_data_path, \%frame_data);
- unless ($r) {
- print STDERR "fail writing $frame_data_path\n";
- if ($print) {
- print "write frame data fail\n";
- }
- return $r;
- }
- }
- $goto_list{'title-' .$frame} = $frame_full_data{'title'};
- $goto_list{'ongtime-'.$frame} = $frame_full_data{'ongtime'};
- $r = write_goto('', \%goto_list);
- unless ($r) {
- print STDERR "fail writing ".DATA_LIST_PATH()."\n";
- if ($print) {
- print "write GOTO list fail\n";
- }
- return $r;
- }
- }
- }
- foreach my $file (@files) {
- $in_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $file);
- $out_path = join_path(PATH_SEPARATOR(), WWW_PATH() , $file);
- if ($print) {
- print $in_path.' -> '.$out_path;
- }
- $r = copy_encoded($in_path, $out_path);
- if ($print) {
- print (($r) ? " OK\n" : " FAIL\n");
- }
- unless ($r) {
- print STDERR "fail copy $in_path $out_path\n";
- return $r
- }
- }
-
- return 1;
-}
-
-
-sub get_frame_file {
- (my $frame, my $frame_data, my $settings) = @_;
- my $file;
- my $pattern;
-
- if ($frame_data->{'frame'} ne '') {
- $file = $frame_data->{'frame'};
- }
- else {
- $pattern = validate_filename($settings->{'frame'}, '%d.%ext');
- $file = sprintf(
- $pattern,
- int($frame), $frame_data->{'ext'}
- );
- }
- return validate_filename($file);
-}
-
-sub get_page_file {
- (my $frame, my $frame_data, my $settings) = @_;
- my $file;
- my $pattern;
-
- if ($frame == 0) {
- return 'index.htm';
- }
- if ($frame_data->{'page'} ne '') {
- $file = $frame_data->{'page'};
- }
- else {
- $pattern = validate_filename($settings->{'frame'}, '%d.%ext');
- $file = sprintf(
- $pattern,
- int($frame), 'htm'
- );
- }
- return validate_filename($file);
-}
-
-sub validate_filename {
- (my $filename, my $fallback) = @_;
- if ($fallback eq '') {
- $fallback = '';
- }
-
- # TODO: more checks
-
- if ($filename =~ /^\./) {
- return $fallback;
- }
- if (index($filename, PATH_SEPARATOR()) >= 0) {
- return $fallback;
- }
- return $filename;
-}
-
-sub validate_frame_data {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'ongtime'} ne '') {
- $data{'ongtime'} = int($data{'ongtime'});
- }
- if ($data{'timer'} ne '') {
- $data{'timer'} = int($data{'timer'});
- }
- if ($data{'width'} ne '') {
- $data{'width'} = int($data{'width'});
- }
- if ($data{'height'} ne '') {
- $data{'height'} = int($data{'height'});
- }
- if ($data{'page'} ne '') {
- $data{'page'} = validate_filename($data{'page'});
- }
- if ($data{'frame'} ne '') {
- $data{'frame'} = validate_filename($data{'frame'});
- }
-
- return %data;
-}
-
-sub validate_settings {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'ongtime'} ne '') {
- $data{'ongtime'} = int($data{'ongtime'});
- }
- if ($data{'dynamicongtime'} ne '') {
- $data{'dynamicongtime'} = int($data{'dynamicongtime'});
- }
- if ($data{'firstongtime'} ne '') {
- $data{'firstongtime'} = int($data{'firstongtime'});
- }
- if ($data{'last'} ne '') {
- $data{'last'} = int($data{'last'});
- }
- $data{'frame'} = validate_filename($data{'frame'}, '%d.%s');
-
- return %data;
-}
-
-sub validate_state {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'state'} ne '') {
- $data{'state'} = int($data{'state'});
- }
- if ($data{'last'} ne '') {
- $data{'last'} = int($data{'last'});
- }
- if ($data{'nextong'} ne '') {
- $data{'nextong'} = int($data{'nextong'});
- }
-
- return %data;
-}
-
-sub validate_words_list {
- (my $data_in, my $not_list) = @_;
- my %data = %$data_in;
-
- if ($data{'ongtime'} ne '') {
- $data{'ongtime'} = int($data{'ongtime'});
- }
-
- if ($not_list) {
- my $id_list = '';
- foreach my $ID (split(/\r?\n/, $data{'content'})) {
- $ID = validate_filename($ID);
- if ($ID ne '') {
- $id_list .= $ID."\n";
- }
- }
- $data{'content'} = $id_list;
- }
- else {
- my @id_list;
- foreach my $ID (@{$data{'content'}}) {
-
- $ID = validate_filename($ID);
- if ($ID ne '') {
- push @id_list, $ID;
- }
- }
- $data{'content'} = [@id_list];
- }
-
- return %data;
-}
-
-sub validate_words {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'posttime'} ne '') {
- $data{'posttime'} = int($data{'posttime'});
- }
- if ($data{'edittime'} ne '') {
- $data{'edittime'} = int($data{'edittime'});
- }
-
- return %data;
-}
-
-sub validate_story {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'id'} ne '') {
- $data{'id'} = int($data{'id'});
- }
- if ($data{'pass'} ne '') {
- $data{'pass'} = int($data{'pass'});
- }
- if ($data{'state'} ne '') {
- $data{'state'} = int($data{'state'});
- }
-
- return %data;
-}
-
-sub validate_goto {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- foreach my $key (keys %data) {
- if ($key =~ /^ongtime-([0-9]+)$/) {
- my $new_key = 'ongtime-'.int($1);
- $data{$new_key} = int($data{$key});
- if ($new_key != $key) {
- delete $data{$key};
- }
- }
- }
-
- return %data;
-}
-
-sub validate_attachment {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'frame'} ne '') {
- $data{'frame'} = int($data{'frame'});
- }
- $data{'filename'} = validate_filename($data{'filename'});
-
- return %data;
-}
-
-sub validate_coincidence {
- (my $data_in) = @_;
- my %data = %$data_in;
-
- if ($data{'server'} ne '') {
- $data{'server'} = int($data{'server'});
- }
-
- return %data;
-}
-
-sub read_frame_data {
- (my $f, my $default) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # frame ID
- $file = join_path(PATH_SEPARATOR(), DATA_PATH(), int($&));
- }
- elsif ($f =~ /^(c(frt)?)|(noaccess)$/) { # CFRT (no access)
- $file = DATA_NOACCESS_PATH();
- }
- elsif ($f =~ /^d(efault)?$/) { # default
- $file = DATA_DEFAULT_PATH();
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_DEFAULT_PATH();
- }
-
- %data = read_data_file($file);
- if (ref ($default)) {
- %data = merge_settings($default, \%data);
- }
- elsif ($default ne '') {
- my %default_data = read_data_file(DATA_DEFAULT_PATH());
- %data = merge_settings(\%default_data, \%data);
- }
-
- return validate_frame_data(\%data);
-}
-
-sub write_frame_data {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # frame ID
- $file = join_path(PATH_SEPARATOR(), DATA_PATH(), int($&));
- }
- elsif ($f =~ /^(c(frt)?)|(noaccess)$/) { # CFRT (no access)
- return 0; # forbidden
- }
- elsif ($f =~ /^d(efault)?$/) { # default
- return 0; # forbidden
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- return 0; # forbidden
- }
-
- my %_data = validate_frame_data($data);
-
- return write_data_file($file, \%_data);
-}
-
-sub read_default {
- return read_frame_data('default');
-}
-
-sub read_noaccess {
- (my $default) = @_;
- return read_frame_data('noaccess', $default);
-}
-
-sub read_settings {
- (my $f) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_SETTINGS_PATH();
- }
-
- %data = read_data_file($file);
-
- return validate_settings(\%data);
-}
-
-sub read_state {
- (my $f) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_STATE_PATH();
- }
-
- %data = read_data_file($file);
-
- return validate_state(\%data);
-}
-
-sub write_state {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = PERL_DATA_STATE_PATH();
- }
-
- my %_data = validate_state($data);
-
- return write_data_file($file, \%_data);
-}
-
-sub read_words_list {
- (my $f, my $header_only, my $not_list) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # frame ID
- $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), int($&));
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else { # which frame ???
- return ('posts' => 0);
- }
-
- %data = read_data_file(
- $file,
- '', # encoding
- 0, # no header
- $header_only,
- not $not_list # as list
- );
-
- return validate_words_list(\%data, $not_list);
-}
-
-sub write_words_list {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # frame ID
- $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), int($&));
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else { # which frame ???
- return 0;
- }
-
- my %_data = validate_words_list($data);
-
- return write_data_file(
- $file, # file
- \%_data,
- '', # encoding
- 0, # no header
- 0, # header only
- 1 # as list
- );
-}
-
-sub read_words {
- (my $f, my $default) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+\.[0-9\.]+$/) { # post ID
- $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else { # which post ???
- return ();
- }
-
- %data = read_data_file($file);
-
- return validate_words(\%data);
-}
-
-sub write_words {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9\.]+$/) { # post ID
- $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else { # which post ???
- return 0;
- }
-
- my %_data = validate_words($data);
-
- return write_data_file($file, \%_data);
-}
-
-sub read_story {
- (my $f) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # story ID
- $file = DATA_STORY_PATH().int($&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_STORY_PATH();
- }
-
- %data = read_data_file($file);
-
- return validate_story(\%data);
-}
-
-sub write_story {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # story ID
- $file = DATA_STORY_PATH().int($&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_STORY_PATH();
- }
-
- my %_data = validate_story($data);
-
- return write_data_file($file, \%_data);
-}
-
-sub read_goto {
- (my $f) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_LIST_PATH();
- }
-
- %data = read_data_file($file);
-
- return validate_goto(\%data);
-}
-
-sub write_goto {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_LIST_PATH();
- }
-
- my %_data = validate_goto($data);
-
- return write_data_file($file, \%_data);
-}
-
-sub read_attachment {
- (my $f, my $default) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # attachment ID
- $file = DATA_ATTACH_PATH().int($&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- return ();
- }
-
- %data = read_data_file($file);
-
- return validate_attachment(\%data);
-}
-
-sub read_coincidence {
- (my $f) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_COIN_PATH();
- }
-
- %data = read_data_file($file);
-
- return validate_coincidence(\%data);
-}
-
-sub read_chat {
- (my $f) = @_;
- my $file;
- my %data;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # chat ID
- $file = DATA_CHAT_PATH().int($&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_CHAT_PATH();
- }
-
- return read_data_file($file);
-
- # no validation
-}
-
-sub write_chat {
- (my $f, my $data) = @_;
- my $file;
-
- if (ref ($f)) { # already open file
- $file = $f;
- }
- elsif ($f =~ /^[0-9]+$/) { # chat ID
- $file = DATA_CHAT_PATH().int($&);
- }
- elsif ($f ne '') { # path
- $file = $f;
- }
- else {
- $file = DATA_CHAT_PATH();
- }
-
- # no validation
-
- return write_data_file($file, $data);
-}
-
-
-1
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/coin
-# chat.pl is generated from chat.1.pl.
-#
-# The coincidence interface
-#
-# Copyright (C) 2016, 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-###PERL_LIB: use lib /botm/lib/bsta
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'read_header_env',
- 'url_query_decode', 'url_query_encode',
- 'merge_url',
- 'html_entity_encode_dec',
- 'open_encoded',
- 'http_header_status'
-);
-use bsta_lib (
- 'STATE', 'CHAT_STATE', 'CHAT_ACTION',
- 'fail_method', 'fail_content_type',
- 'get_remote_addr', 'get_id', 'get_password',
- 'print_html_start', 'print_html_end',
- 'print_html_head_start', 'print_html_head_end',
- 'print_html_body_start', 'print_html_body_end',
- 'merge_settings',
- 'read_chat', 'write_chat',
- 'read_coincidence', 'read_settings', 'read_state'
-);
-use File::Copy;
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_CGI_COIN_PATH: CGI_COIN_PATH = /bsta/coin
-
-###PERL_DATA_CHAT_PATH: DATA_CHAT_PATH = /botm/data/bsta/chat
-
-###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my %http;
-my %cgi;
-my %coin;
-my %chat;
-my %settings;
-my %state;
-
-my $time = time();
-srand ($time-$$);
-
-my $method;
-my $IP;
-my $page;
-my $words = '';
-my $username = '';
-my $action = CHAT_ACTION->{'none'};
-my $password;
-my $fh;
-my $state;
-my $password_ok;
-my @chat_lines;
-my $chat_state;
-my $status;
-my $message;
-my $chat_id;
-my $last_id;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else {
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-$IP = get_remote_addr();
-$page = get_id(\%cgi, -1);
-$password = get_password(\%cgi);
-
-%coin = read_coincidence();
-%settings = read_settings();
-%state = read_state();
-
-$password_ok = ($password eq $settings{'password'});
-
-if ($cgi{'words'} ne '') {
- $words = $cgi{'words'};
-}
-if ($password_ok && ($cgi{'username'} ne '')) {
- $username = $cgi{'username'};
-}
-foreach my $action_id ('join', 'leave', 'nopost', 'file') {
- if ($cgi{$action_id} ne '') {
- $action = CHAT_ACTION->{$action_id};
- last;
- }
-}
-
-# ongoing chat
-if ($page < 0) {
- if (open_encoded($fh, "+<", DATA_CHAT_PATH())) {
- if (flock($fh, 2)) {
- %chat = read_chat($fh);
-
- $chat_state = int($chat{'state'});
- $chat_id = int($chat{'id'});
- $last_id = $chat_id;
-
- if ($method ne 'POST') {
- #
- }
-
- elsif (
- ($action == CHAT_ACTION->{'none'}) &&
- ($words ne '')
- ) {
- if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
- $status = HTTP_STATUS->{'forbidden'};
- $message = 'Not connected.';
- }
- else {
- if ($words !~ /[\r\n]/) {
- if ($username =~ /^[A-Za-z]*$/) {
- $chat{'content'} .= $username.': '.$words."\n";
- if ($chat_state < CHAT_STATE->{'active'}) {
- $chat_state = CHAT_STATE->{'active'};
- $chat{'state'} = $chat_state;
- }
- write_chat($fh, \%chat);
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid username.';
- }
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid text.';
- }
- }
- }
-
- elsif ($action == CHAT_ACTION->{'join'}) {
- if (($chat_state > CHAT_STATE->{'disconnected'}) && !$password_ok) {
- $message = 'Already connected.';
- }
- else {
- if ($username =~ /^[A-Za-z]*$/) {
- if ($password_ok || $words eq $coin{'server'}) {
- $chat{'content'} .= 'join@'.$username.': '.$words."\n";
- if ($chat_state < CHAT_STATE->{'ready'}) {
- $chat_state = CHAT_STATE->{'ready'};
- $chat{'state'} = $chat_state;
- }
- write_chat($fh, \%chat);
- }
- elsif ($words eq '') {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Server ID missing.';
- }
- elsif ($words !~ /^[0-9]+$/) {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid server ID.';
- }
- else {
- $status = HTTP_STATUS->{'not_found'};
- $message = 'No active Coincidence server with this ID.';
- }
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid username.';
- }
- }
- }
-
- elsif ($action == CHAT_ACTION->{'leave'}) {
- if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
- $message = 'Already disconnected.';
- }
- else {
- if ($username =~ /^[A-Za-z]*$/) {
- $chat{'content'} .= 'leave@'.$username.': '.$words."\n";
- if ($username ne '') {
- write_chat($fh, \%chat);
- }
- else {
- my %new_chat;
- if ($chat_state > 1) {
- write_chat($chat_id, \%chat);
- $new_chat{'id'} = $chat_id+1;
- }
- else {
- $new_chat{'id'} = $chat_id;
- }
- $new_chat{'state'} = CHAT_STATE->{'disconnected'};
- $new_chat{'content'} = '';
- write_chat($fh, \%new_chat);
- }
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid username.';
- }
- }
- }
-
- elsif (
- ($action == CHAT_ACTION->{'file'}) &&
- ($cgi{'file'} ne '') &&
- ($words ne '') &&
- $password_ok
- ) {
- if ($words !~ /[\r\n]/) {
- if ($username =~ /^[A-Za-z]*$/) {
- $chat{'content'} .= 'file@'.$username.': '.$words."\n";
- if ($chat_state < CHAT_STATE->{'active'}) {
- $chat_state = CHAT_STATE->{'active'};
- $chat{'state'} = $chat_state;
- }
- write_chat($fh, \%chat);
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid username.';
- }
- }
- else {
- $status = HTTP_STATUS->{'bad_request'};
- $message = 'Invalid text.';
- }
- }
-
- @chat_lines = split(/\r?\n/, $chat{'content'});
- }
- else {
- $chat_state = CHAT_STATE->{'disconnected'};
- $status = HTTP_STATUS->{'internal_server_error'};
- $message = 'Can\'t lock data file!';
- }
-
- close($fh);
- }
- else {
- $chat_state = CHAT_STATE->{'disconnected'};
- $status = HTTP_STATUS->{'internal_server_error'};
- $message='Can\'t open data file!';
- }
-}
-# old chat archive
-else {
- $chat_id = $page;
- %chat = read_chat();
- $last_id = int($chat{'id'});
- if ($chat_id < $last_id) {
- %chat = read_chat($page);
- $chat_state = int($chat{'state'});
- @chat_lines = split(/\r?\n/, $chat{'content'});
- }
-}
-
-if ($status ne '') {
- print http_header_status($status);
-}
-print "Content-type: text/html; charset=UTF-8\n\n";
-if($method eq 'HEAD') {
- exit;
-}
-
-if ($username eq '') {
- $username = $coin{'name'};
-}
-
-my $base_url = CGI_PATH();
-my $coin_url = CGI_COIN_PATH();
-my $form_url = $coin_url;
-my $oldest_url = merge_url(
- {'path' => $coin_url},
- {'path' => 0}
-);
-my $older_url = merge_url(
- {'path' => $coin_url},
- {'path' => $chat_id -1}
-);
-my $newer_url = ($chat_id < ($last_id -1)) ?
- merge_url(
- {'path' => $coin_url},
- {'path' => $chat_id +1}
- ) : $coin_url;
-
-if ($password_ok) {
- my $password_query = url_query_encode({'p', $settings{'password'}});
- $coin_url = merge_url($coin_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $oldest_url = merge_url($oldest_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $older_url = merge_url($older_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
- $newer_url = merge_url($newer_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
-}
-
-my $_password = $password_ok ? html_entity_encode_dec($settings{'password'}, 1): '';
-my $abbr = abbr_name($username);
-my $_website_name = html_entity_encode_dec(WEBSITE_NAME() , 1);
-my $_server = html_entity_encode_dec($coin {'server'} , 1);
-my $_key = html_entity_encode_dec($coin {'key'} , 1);
-my $_cgi_username = html_entity_encode_dec($cgi {'username'}, 1);
-my $_username = html_entity_encode_dec($username , 1);
-my $_abbr = html_entity_encode_dec($abbr , 1);
-my $_message = html_entity_encode_dec($message , 1);
-my $_base_url = html_entity_encode_dec($base_url , 1);
-my $_coin_url = html_entity_encode_dec($coin_url , 1);
-my $_form_url = html_entity_encode_dec($form_url , 1);
-my $_oldest_url = html_entity_encode_dec($oldest_url, 1);
-my $_older_url = html_entity_encode_dec($older_url , 1);
-my $_newer_url = html_entity_encode_dec($newer_url , 1);
-
-print_html_start(\*STDOUT);
-print_html_head_start(\*STDOUT);
-
-print ' <title>Coincidence • '.$_website_name.'</title>'."\n";
-
-print_html_head_end(\*STDOUT);
-print_html_body_start(\*STDOUT);
-
-print ' <div id="inst" class="ins">'."\n";
-
-print ' <div id="title">'."\n";
-print ' <H1 id="titletext">Coincidence</H1>'."\n";
-print ' </div>'."\n";
-
-print ' <div id="storypuzzle">'."\n";
-if ($page >= 0) {
- print ' Before: '.$chat_id."\n";
-}
-elsif ($chat_state > CHAT_STATE->{'disconnected'}) {
- print ' Connected to server <span class="br">'.$_server.'</span> as user <span class="ni">'.$_username.'</span> (<span class="ni">'.$_abbr.'</span>), public key <span class="br">'.$_key.'</span>.'."\n";
-}
-else{
- print ' Not connected.'."\n";
-}
-print ' </div>'."\n";
-
-print ' <div id="command">'."\n";
-if ($message ne '') {
- print ' <span class="br">'.$_message.'</span>'."\n";
-}
-if ($page < 0) {
- print ' <form method="post" action="'.$_form_url.'">'."\n";
- if ($password_ok) {
- print ' <input class="intxc" type="text" name="words">'."\n";
- print ' <input class="inbt" type="submit" value="Send">'."\n";
- print " |\n";
- print ' <input class="intx" type="text" name="username" value="'.$_cgi_username.'">'."\n";
- print ' <input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
- print ' <input class="inbt" type="submit" name="join" value="Connect">'."\n";
- print ' <input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
- print ' <input class="inbt" type="submit" name="file" value="Send file">'."\n";
- print ' <input type="hidden" name="p" value="'.$_password.'">'."\n";
- }
- elsif ($chat_state > CHAT_STATE->{'disconnected'}) {
- print ' <input class="intxc" type="text" name="words">'."\n";
- print ' <input class="inbt" type="submit" value="Send">'."\n";
- print " |\n";
- print ' <input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
- print ' <input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
- }
- else {
- print ' <input class="intx" type="text" name="words">'."\n";
- print ' <input class="inbt" type="submit" name="join" value="Connect">'."\n";
- }
- print ' </form>'."\n";
-}
-print ' </div>'."\n";
-
-print ' </div>'."\n";
-print ' <div id="insb" class="ins">'."\n";
-
-print ' <div id="chat">'."\n";
-if ($page < 0) {
- for (my $i = @chat_lines-1; $i>=0; --$i) {
- print ' '.chat_line($chat_lines[$i])."<br>\n";
- }
-}
-else {
- for (my $i = 0; $i<@chat_lines; ++$i) {
- print ' '.chat_line($chat_lines[$i])."<br>\n";
- }
-}
-print ' </div>'."\n";
-
-print ' <div id="underlinks">'."\n";
-print ' <a href="'.$_base_url.'">BSTA</a> | <a href="'.$_coin_url.'">Once again</a>';
-if ($chat_id > 0) {
- print ' | <a href="'.$_older_url.'">Before</a>';
-}
-if ($chat_id < $last_id) {
- print ' | <a href="'.$_newer_url.'">Unbefore</a>';
-}
-if ($chat_id > 0) {
- print ' | <a href="'.$_oldest_url.'">Initially</a>';
-}
-print ' | (This interface is only a demo, a proof of concept. It is very limited. No autorefresh, no private chat, etc. For full functionality use the actual Coincidence client.)'."\n";
-print ' </div>'."\n";
-
-print ' </div>'."\n";
-
-print_html_body_end(\*STDOUT, int($state{'state'}) == STATE->{'inactive'});
-print_html_end(\*STDOUT);
-
-
-sub abbr_name {
- (my $name) = @_;
- my $abbr;
-
- if($name !~ /^[A-Za-z]+$/) {
- return '?';
- }
-
- $abbr = uc(substr($name,0,1));
- $name = substr($name,1);
- while($name =~ m/([A-Z])/g) {
- $abbr = $abbr.$1;
- }
- return $abbr;
-}
-
-sub chat_line {
- (my $line) = @_;
-
- if ($line =~ /^([a-z]*@)?([A-Za-z]*): (.*)$/) {
- my $action = $1;
- my $name = $2;
- my $text = $3;
- my $color;
- if ($name eq '') {
- $name = $coin{'name'};
- $color = 'ni';
- }
- else {
- $color = 'br';
- }
- $abbr = abbr_name($name);
-
- my $_name = html_entity_encode_dec($name , 1);
- my $_abbr = html_entity_encode_dec($abbr , 1);
- my $_text = html_entity_encode_dec($text , 1);
- my $_server = html_entity_encode_dec($coin{'server'}, 1);
-
- if($action ne '') {
- if ($action eq 'join@') {
- return "$_name ($_abbr) joined the public chat on server $_server.";
- }
- elsif ($action eq 'leave@') {
- return "$_name ($_abbr) left the public chat on server $_server.";
- }
- elsif ($action eq 'file@') {
- return "$_name ($_abbr) sent the file $_text.";
- }
- else {
- return 'E:E:E';
- }
- }
- else {
- return "<span class=\"$color\">$_abbr: $_text</span>";
- }
- }
- else {
- return 'E:E:E';
- }
-}
+++ /dev/null
-Subproject commit 92cf35c0340afcadb39f06248de26e114ad5603c
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/f
-# viewer.pl is generated from viewer.1.pl.
-#
-# The frame interface
-#
-# Copyright (C) 2016, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'read_header_env',
- 'url_query_decode',
- 'join_path',
- 'merge_url',
- 'open_encoded', 'stat_encoded',
- 'http_header_line', 'http_header_content_length', 'http_header_content_disposition'
-);
-use bsta_lib (
- 'STATE', 'INTF_STATE',
- 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_500', 'redirect',
- 'get_frame', 'get_password',
- 'merge_settings',
- 'get_frame_file',
- 'read_frame_data', 'read_default', 'read_noaccess',
- 'read_settings', 'read_state', 'read_story'
-);
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta
-###PERL_WWW_PATH: WWW_PATH = /botm/www/1190/bsta/
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %frame_data;
-my %default;
-my %settings;
-my %state;
-
-my $method;
-my $frame;
-my $password;
-my $password_ok;
-my $IP;
-my $access;
-my $try_onged;
-my $frame_path;
-my $frame_file;
-my $fh;
-my $buffer;
-my $ong_state;
-my $last_frame;
-my $r = 0;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-$frame = get_frame(\%cgi);
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%default = read_default();
-%state = read_state();
-
-$ong_state = int($state{'state'});
-$last_frame = int($state{'last'});
-
-if ($frame < 0) {
- $frame = $state{'last'} + $frame +1;
-}
-
-$password_ok = ($password eq $settings{'password'});
-
-$access = 0;
-if (
- $password_ok || (
- ($ong_state >= STATE->{'waiting'}) &&
- ($frame <= $last_frame) &&
- ($frame >= 0)
- )
- ) {
- $access = 1;
-}
-elsif (
- ($ong_state == STATE->{'inactive'}) &&
- ($frame == 0)
-) {
- my %story = read_story();
- if (
- (int($story{'pass'}) == 1) &&
- (int($story{'state'}) == INTF_STATE->{'>|'})
- ) {
- $access = 1;
- }
-}
-
-$try_onged = (
- (!$access) || (
- ($frame <= $last_frame) &&
- ($ong_state > STATE->{'inactive'})
- )
-);
-
-if ($access) {
- %frame_data = read_frame_data($frame, \%default);
-}
-else {
- %frame_data = read_noaccess(\%default);
-}
-$frame_file = get_frame_file($frame, \%frame_data, \%settings);
-
-if ($try_onged) {
- $frame_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $frame_file);
- $r = open_encoded($fh, '<' , $frame_path);
- if ($r) {
- close($r);
- $frame_path = merge_url(
- {'path' => CGI_PATH()},
- {'path' => $frame_file}
- );
- exit redirect ($method, $frame_path, HTTP_STATUS->{'see_other'});
- }
-}
-unless ($r) {
- $frame_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame_file);
- $r = open_encoded($fh, '<' , $frame_path);
- unless ($r) {
- exit fail_open_file($method, 'image file', $frame_file);
- }
-}
-unless (binmode($fh)) {
- close($fh);
- exit fail_500("Can't switch file to binary mode.");
-}
-
-if (my @file_info = stat_encoded($frame_path)){
- print http_header_content_length($file_info[7]);
-}
-if ($frame_data{'content-type'} ne '') {
- print http_header_line('content-type', $frame_data{'content-type'});
-}
-if ($frame_file ne '') {
- print http_header_content_disposition('inline', $frame_file);
-}
-unless (binmode STDOUT) {
- close($fh);
- exit fail_500("Can't switch output to binary mode.");
-}
-print "\n";
-
-if($method ne 'HEAD'){
- while (read ($fh, $buffer, 1024)) {
- print (STDOUT $buffer);
- }
-}
-close($fh);
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/g
-# goto is generated from goto.1.pl.
-#
-# The frame list
-#
-# Copyright (C) 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'read_header_env',
- 'url_query_decode',
- '_x_encoded'
-);
-use bsta_lib (
- 'STATE',
- 'fail_method', 'fail_content_type',
- 'redirect',
- 'get_password',
- 'print_goto',
- 'merge_settings',
- 'read_settings', 'read_state', 'read_goto'
-);
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_CGI_LIST_PATH: CGI_LIST_PATH = /bsta/goto.htm
-###PERL_CGI_VIEWER_PATH: CGI_VIEWER_PATH = /bsta/v
-
-###PERL_WWW_GOTO_PATH: WWW_GOTO_PATH = /botm/www/1190/bsta/goto.htm
-
-###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %settings;
-my %state;
-my %goto_list;
-
-my $method;
-my $password;
-my $password_ok;
-my $no_cgi;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-$no_cgi = (scalar (keys %cgi) == 0);
-
-if ($no_cgi) {
- if (_x_encoded('-f', WWW_GOTO_PATH())) {
- exit redirect($method, CGI_LIST_PATH());
- }
-}
-
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%state = read_state();
-%goto_list = read_goto();
-
-$password_ok = ($password eq $settings{'password'});
-
-print "Content-type: text/html; charset=UTF-8\n";
-print "\n";
-if($method eq 'HEAD') {
- exit;
-}
-
-print_goto(
- \*STDOUT,
- \%state,
- \%settings,
- \%goto_list,
- $password_ok
-);
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/i
-# info.pl is generated from info.1.pl.
-#
-# The frame/story info interface
-#
-# Copyright (C) 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'http_header_status',
- 'read_header_env',
- 'write_data_file',
- 'url_query_decode'
-);
-use bsta_lib (
- 'STATE',
- 'fail_method', 'fail_content_type',
- 'get_password',
- 'merge_settings',
- 'get_page_file', 'get_frame_file',
- 'read_frame_data', 'read_default', 'read_noaccess',
- 'read_settings', 'read_default', 'read_state',
- 'read_words_list', 'read_words', 'read_attachment'
-);
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %info_data;
-my %next_frame_data;
-my %default;
-my %settings;
-my %state;
-
-my $method;
-my $frame = '';
-my $attachment = '';
-my $words = '';
-my $password;
-my $password_ok;
-my $access;
-my $show_command;
-my $ongtime;
-my $timer;
-my $ong_state;
-my $last_frame;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-if ($cgi{'f'} =~ /^.+$/) {
- $frame = int($&);
-}
-elsif ($cgi{'a'} =~ /^.+$/) {
- $attachment = int($&);
-}
-elsif ($cgi{'i'} =~ /^.+$/) {
- $attachment = int($&);
-}
-elsif ($cgi{'w'} =~ /^.+$/) {
- $words = $&;
-}
-elsif ($ENV{'PATH_INFO'} =~ /^\/a\/?(.+)$/) {
- $attachment = int($1);
-}
-elsif ($ENV{'PATH_INFO'} =~ /^\/w\/?(.+)$/) {
- $words = $1;
-}
-elsif ($ENV{'PATH_INFO'} =~ /^\/(f\/?)?(.+)$/) {
- $frame = int($2);
-}
-
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%default = read_default();
-%state = read_state(());
-
-$ong_state = int($state{'state'});
-$last_frame = int($state{'last'});
-
-$password_ok = ($password eq $settings{'password'});
-
-# comment info, not frame
-if ($words ne '') {
- if ($words =~ /^[0-9]+$/) {
- %info_data = read_words_list(
- int($&), # id
- 0, # header only
- 1 # not as list
- );
- $frame = int($&);
- if ($info_data{'posts'} eq '') {
- $info_data{'posts'} = 0;
- }
- }
- elsif ($words =~ /^[0-9]+\.[0-9\.]+$/) {
- %info_data = read_words($&);
- $frame = ($info_data{'frame'} ne '') ? int($info_data{'frame'}) : -1;
- unless ($password_ok) {
- delete($info_data{'password'});
- delete($info_data{'key'});
- }
- }
-}
-# attachment info, not frame
-elsif ($attachment ne '') {
- %info_data = read_attachment($attachment);
- $frame = ($info_data{'frame'} ne '') ? int($info_data{'frame'}) : -1;
-}
-# frame info
-elsif ($frame ne '') {
- if ($frame < 0) {
- $frame = $last_frame + $frame +1;
- }
- %info_data = read_frame_data($frame, \%default);
- %next_frame_data = read_frame_data($frame+1, \%default);
-
- $timer = int($state{'nextong'}) - $time;
- $ongtime = int($state{'ongtime'});
- if($ongtime == 0) {
- $ongtime = int($settings{'ongtime'})
- }
- $show_command = ($timer < ($ongtime * 3600 / 3));
-}
-# state info, not frame
-else {
- unless ($password_ok) {
- # just show if IP was saved, not its value
- if ($state{'ip1'} ne '') {
- $state{'ip1'} = 1;
- }
- if ($state{'ip2'} ne '') {
- $state{'ip2'} = 1;
- }
- if ($state{'ip3'} ne '') {
- $state{'ip3'} = 1;
- }
- }
- print "Content-type: text/plain; charset=UTF-8\n\n";
- if ($method eq 'HEAD') {
- exit;
- }
- write_data_file(
- \*STDOUT, \%state, '',
- 0, 0, 0,
- '>>', 1
- );
-
- exit;
-}
-
-if (
- $password_ok || (
- ($ong_state >= STATE->{'waiting'}) &&
- ($frame <= $last_frame) &&
- ($frame >= 0)
- )
-) {
- $access = 1;
-
- if (
- ($words eq '') &&
- ($attachment eq '') &&
- ($info_data{'command'} eq '') && (
- $password_ok ||
- ($frame < $last_frame) || (
- ($ong_state >= STATE->{'ready'}) &&
- $show_command
- )
- )
- ) {
- $info_data{'command'} = $next_frame_data{'title'};
- }
-}
-else {
- $access = 0;
- if (($attachment ne '') || ($words ne '')) {
- %info_data = ();
- }
- else {
- %info_data = read_noaccess(\%default);
- }
-}
-if (
- ($attachment eq '') &&
- ($words eq '')
-) {
- if ($info_data{'frame'} eq '') {
- $info_data{'frame'} = get_frame_file($frame, \%info_data, \%settings)
- }
- if ($info_data{'page'} eq '') {
- unless (($access) && ($frame < $last_frame)) {
- $info_data{'page'} = '';
- }
- else {
- $info_data{'page'} = get_page_file($frame, \%info_data, \%settings);
- }
- }
-}
-
-print "Content-type: text/plain; charset=UTF-8\n";
-if (!$access) {
- print http_header_status(HTTP_STATUS->{'forbidden'});
-}
-print "\n";
-if($method eq 'HEAD') {
- exit;
-}
-write_data_file(
- \*STDOUT, \%info_data, '',
- 0, 0, 0,
- '>>', 1
-);
#!/bin/sh
make clean
-make -B TARGET=bsta makefile
-make install
-make clean
-make -B TARGET=again makefile
+make -B TARGET=release makefile
make install
make clean
endif
PERL = perl
-CC =/usr/bin/gcc
-CF =-g -Wall
-
CHMOD=/usr/bin/chmod
CP =/usr/bin/cp
MKDIR=/usr/bin/mkdir
PERL =/usr/bin/perl
RM =/usr/bin/rm
-SUDO =/usr/bin/sudo
-BIN_PATH = /botm/bin/test-bsta
-DATA_PATH = /botm/data/test-bsta
-DATA_WORDS_PATH = /botm/data/test-bsta/words
-LIB_PATH = /botm/lib/test-bsta
-LOG_PATH = /botm/log/test-bsta
-TMP_PATH = /botm/tmp/test-bsta
-WWW_PATH = /botm/www/1190/bstatest
+BIN_PATH = /botm/bin/test-oldlogs
+LIB_PATH = /botm/lib/test-oldlogs
-CONF = /botm/etc/www/conf/1190/test-bsta.conf
-CRON = /etc/cron.d/test-bsta
CONFIGFILE = settings-$(TARGET).txt settings.txt
DEFAULT_CONFIGFILE = settings-$(DEFAULT_TARGET).txt settings.txt
# keep these 2 lists in the same order!:
GENERATE_FROM=\
-2words.1.pl\
-attach.1.pl\
-bbcode.1.pl\
-bsta.1.conf\
-bsta.1.cron\
-bsta_lib.1.pm\
-chat.1.pl\
-frame.1.pl\
-goto.1.pl\
-info.1.pl\
-oldlogs.1.pl\
-opomba.1.pl\
-ong.1.pl\
-reset.1.pl\
-update.1.pl\
-viewer.1.pl
+oldlogs.1.pl
TO_GENERATE=\
-2words.pl\
-attach.pl\
-bbcode.pl\
-bsta.conf\
-bsta.cron\
-bsta_lib.pm\
-chat.pl\
-frame.pl\
-goto.pl\
-info.pl\
-oldlogs.pl\
-opomba.pl\
-ong.pl\
-reset.pl\
-update.pl\
-viewer.pl
+oldlogs.pl
DIR=\
$(BIN_PATH)\
-$(DATA_PATH)\
-$(DATA_WORDS_PATH)\
-$(LIB_PATH)\
-$(LOG_PATH)\
-$(TMP_PATH)\
-$(WWW_PATH)
-
-HIDDEN_DIR=\
-$(DATA_PATH)\
-$(DATA_WORDS_PATH)\
-$(TMP_PATH)
-
-SETUID=\
-2words\
-bbcode\
-attach\
-chat\
-frame\
-goto\
-info\
-opomba\
-viewer
+$(LIB_PATH)
+
+# HIDDEN_DIR=
+
+# SETUID=
EXEC=\
-2words.pl\
-attach.pl\
-bbcode.pl\
-chat.pl\
-frame.pl\
-goto.pl\
-info.pl\
-oldlogs.pl\
-opomba.pl\
-ong.pl\
-reset.pl\
-update.pl\
-viewer.pl
-
-PERL_WRAP_EXEC=\
-2words\
-attach\
-bbcode\
-chat\
-frame\
-goto\
-info\
-opomba\
-viewer
+oldlogs.pl
+
+# PERL_WRAP_EXEC=
BIN=\
-$(EXEC)\
-$(PERL_WRAP_EXEC)
+$(EXEC)
LIB=\
botm-common/botm_common.pm\
-bsta_lib.pm
-
-WWW=\
-botmlogo.png\
-bsta.css\
-timer.js
-
-all: $(BIN) setuid exec
+all: $(BIN) exec
makefile: makefile.1.mak $(CONFIGFILE) configure.pl
$(TO_GENERATE): $(GENERATE_FROM) $(CONFIGFILE) configure.pl
$(CONFIGURE_CMD) --in $(GENERATE_FROM) --out $(TO_GENERATE)
-$(PERL_WRAP_EXEC): %: exec/exec.c exec/settings.txt configure.pl
- $(PERL) configure.pl path=$(BIN_PATH) target=$*.pl io_path=$(LOG_PATH) stderr=$*-stderr.log exec/settings.txt --in exec/exec.c --out $*.c
- $(CC) $(CF) -o $@ $*.c
-
exec: $(EXEC)
$(CHMOD) +x $(EXEC)
-wrap_exec:
-
-setuid: $(SETUID)
- $(CHMOD) u+s,g+s $(SETUID)
-
-
mktree:
$(MKDIR) -p $(DIR)
- $(CHMOD) g-r,g-w,g-x,o-r,o-w,o-x $(HIDDEN_DIR)
+# $(CHMOD) g-r,g-w,g-x,o-r,o-w,o-x $(HIDDEN_DIR)
ifdef BIN_PATH
-cp_bin: $(BIN) setuid exec | mktree
+cp_bin: $(BIN) exec | mktree
$(RM) -f $(BIN_PATH)/*
$(CP) -p $(BIN) $(BIN_PATH)
endif
$(CP) -p $(LIB) $(LIB_PATH)
endif
-cp_www:
- $(CP) -p $(WWW) $(WWW_PATH)
-
-cp_conf: bsta.conf
- $(CP) bsta.conf $(CONF)
-
-cp_cron: bsta.cron
- $(SUDO) $(CP) bsta.cron $(CRON)
-install: all cp_bin cp_lib cp_www cp_conf cp_cron
+install: all cp_bin cp_lib
clean:
- $(RM) -f configure.pl $(TO_GENERATE) $(PERL_WRAP_EXEC) $(PERL_WRAP_EXEC:=.c)
+ $(RM) -f configure.pl $(TO_GENERATE)
$(PERL) config/configure.1.pl $(DEFAULT_CONFIGFILE) < makefile.1.mak > makefile
-PHONY: all clean install setuid exec mktree cp_bin cp_lib cp_www cp_conf cp_cron
+PHONY: all clean install exec mktree cp_bin cp_lib
endif
PERL = perl
-###MAKE_CC: CC=gcc
-###MAKE_CF: CF=-g -Wall
-
###MAKE_CHMOD: CHMOD = chmod
###MAKE_CP: CP = cp
###MAKE_MKDIR: MKDIR = mkdir
###MAKE_PERL: PERL = perl
###MAKE_RM: RM = rm
-###MAKE_SUDO: SUDO = sudo
###MAKE_BIN_PATH: BIN_PATH = /botm/bin/bsta
-###MAKE_DATA_PATH: DATA_PATH = /botm/data/bsta
-###MAKE_DATA_WORDS_PATH: DATA_WORDS_PATH = /botm/data/bsta/words
###MAKE_LIB_PATH: LIB_PATH = /botm/lib/bsta
-###MAKE_LOG_PATH: LOG_PATH = /botm/log/bsta
-###MAKE_TMP_PATH: TMP_PATH = /botm/tmp/bsta
-###MAKE_WWW_PATH: WWW_PATH = /botm/www/1190/bsta
-###MAKE_CONF: CONF = /botm/etc/www/conf/1190/bsta.conf
-###MAKE_CRON: CRON = /etc/cron.d/bsta
CONFIGFILE = settings-$(TARGET).txt settings.txt
DEFAULT_CONFIGFILE = settings-$(DEFAULT_TARGET).txt settings.txt
# keep these 2 lists in the same order!:
GENERATE_FROM=\
-2words.1.pl\
-attach.1.pl\
-bbcode.1.pl\
-bsta.1.conf\
-bsta.1.cron\
-bsta_lib.1.pm\
-chat.1.pl\
-frame.1.pl\
-goto.1.pl\
-info.1.pl\
-oldlogs.1.pl\
-opomba.1.pl\
-ong.1.pl\
-reset.1.pl\
-update.1.pl\
-viewer.1.pl
+oldlogs.1.pl
TO_GENERATE=\
-2words.pl\
-attach.pl\
-bbcode.pl\
-bsta.conf\
-bsta.cron\
-bsta_lib.pm\
-chat.pl\
-frame.pl\
-goto.pl\
-info.pl\
-oldlogs.pl\
-opomba.pl\
-ong.pl\
-reset.pl\
-update.pl\
-viewer.pl
+oldlogs.pl
DIR=\
$(BIN_PATH)\
-$(DATA_PATH)\
-$(DATA_WORDS_PATH)\
-$(LIB_PATH)\
-$(LOG_PATH)\
-$(TMP_PATH)\
-$(WWW_PATH)
-
-HIDDEN_DIR=\
-$(DATA_PATH)\
-$(DATA_WORDS_PATH)\
-$(TMP_PATH)
-
-SETUID=\
-2words\
-bbcode\
-attach\
-chat\
-frame\
-goto\
-info\
-opomba\
-viewer
+$(LIB_PATH)
+
+# HIDDEN_DIR=
+
+# SETUID=
EXEC=\
-2words.pl\
-attach.pl\
-bbcode.pl\
-chat.pl\
-frame.pl\
-goto.pl\
-info.pl\
-oldlogs.pl\
-opomba.pl\
-ong.pl\
-reset.pl\
-update.pl\
-viewer.pl
-
-PERL_WRAP_EXEC=\
-2words\
-attach\
-bbcode\
-chat\
-frame\
-goto\
-info\
-opomba\
-viewer
+oldlogs.pl
+
+# PERL_WRAP_EXEC=
BIN=\
-$(EXEC)\
-$(PERL_WRAP_EXEC)
+$(EXEC)
LIB=\
botm-common/botm_common.pm\
-bsta_lib.pm
-
-WWW=\
-botmlogo.png\
-bsta.css\
-timer.js
-
-all: $(BIN) setuid exec
+all: $(BIN) exec
makefile: makefile.1.mak $(CONFIGFILE) configure.pl
$(TO_GENERATE): $(GENERATE_FROM) $(CONFIGFILE) configure.pl
$(CONFIGURE_CMD) --in $(GENERATE_FROM) --out $(TO_GENERATE)
-$(PERL_WRAP_EXEC): %: exec/exec.c exec/settings.txt configure.pl
- $(PERL) configure.pl path=$(BIN_PATH) target=$*.pl io_path=$(LOG_PATH) stderr=$*-stderr.log exec/settings.txt --in exec/exec.c --out $*.c
- $(CC) $(CF) -o $@ $*.c
-
exec: $(EXEC)
$(CHMOD) +x $(EXEC)
-wrap_exec:
-
-setuid: $(SETUID)
- $(CHMOD) u+s,g+s $(SETUID)
-
-
mktree:
$(MKDIR) -p $(DIR)
- $(CHMOD) g-r,g-w,g-x,o-r,o-w,o-x $(HIDDEN_DIR)
+# $(CHMOD) g-r,g-w,g-x,o-r,o-w,o-x $(HIDDEN_DIR)
ifdef BIN_PATH
-cp_bin: $(BIN) setuid exec | mktree
+cp_bin: $(BIN) exec | mktree
$(RM) -f $(BIN_PATH)/*
$(CP) -p $(BIN) $(BIN_PATH)
endif
$(CP) -p $(LIB) $(LIB_PATH)
endif
-cp_www:
- $(CP) -p $(WWW) $(WWW_PATH)
-
-cp_conf: bsta.conf
- $(CP) bsta.conf $(CONF)
-
-cp_cron: bsta.cron
- $(SUDO) $(CP) bsta.cron $(CRON)
-install: all cp_bin cp_lib cp_www cp_conf cp_cron
+install: all cp_bin cp_lib
clean:
- $(RM) -f configure.pl $(TO_GENERATE) $(PERL_WRAP_EXEC) $(PERL_WRAP_EXEC:=.c)
+ $(RM) -f configure.pl $(TO_GENERATE)
$(PERL) config/configure.1.pl $(DEFAULT_CONFIGFILE) < makefile.1.mak > makefile
-PHONY: all clean install setuid exec mktree cp_bin cp_lib cp_www cp_conf cp_cron
+PHONY: all clean install exec mktree cp_bin cp_lib
'system_encoded',
'opendir_encoded', 'readdir_decoded',
'_x_encoded', 'stat_encoded',
- 'unlink_encoded', 'rename_encoded'
+ 'unlink_encoded', 'rename_encoded', 'env_pwd_decoded'
);
###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
###PERL_GZIP: GZIP = gzip
-###PERL_LOG_PATH: LOG_PATH = /botm/log/bsta/
###PERL_LOG_SIZE_LIMIT: LOG_SIZE_LIMIT = 65536
###PERL_LOGS_UNCOMPRESSED: LOGS_UNCOMPRESSED = 2
###PERL_LOGS_TOTAL: LOGS_TOTAL = 10
binmode STDERR, ':encoding(UTF-8)';
decode_argv();
-my $log_path = ($ARGV[0] ne '' ) ? $ARGV[0]: LOG_PATH();
+my $log_path = ($ARGV[0] ne '' ) ? $ARGV[0]: env_pwd_decoded;
my $log_size_limit = ($ARGV[1] =~ /^[0-9]+$/) ? int($&) : LOG_SIZE_LIMIT();
my $logs_total = ($ARGV[2] =~ /^[0-9]+$/) ? int($&) : LOGS_TOTAL();
my $logs_uncompressed = ($ARGV[3] =~ /^[0-9]+$/) ? int($&) : LOGS_UNCOMPRESSED();
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# ong.pl is generated from ong.1.pl.
-#
-# The ONG bot
-#
-# Copyright (C) 2016, 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'open_encoded',
-);
-use bsta_lib (
- 'STATE',
- 'ong',
- 'write_static_viewer_page', 'write_index', 'write_static_goto',
- 'read_default', 'read_frame_data', 'read_settings', 'read_goto',
- 'read_state', 'write_state'
-);
-
-###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %settings;
-my %state;
-my %new_state;
-# my %goto_list;
-my %default;
-my %frame_data;
-my %frame_1_data;
-my %frame_2_data;
-my %frame_3_data;
-
-my $fh;
-my $ongstate;
-my $frame;
-my $next_ong;
-my $ongtime;
-my $static_timer;
-my $timer;
-my $last;
-my $r = 0;
-
-$ongtime = int($time / 3600) * 3600; # check time as if it was last full hour!
-
-print $time.' - '.$ongtime."\n";
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-unless (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STATE_PATH())) {
- print "NO STATEFILE\n\n";
- exit;
-}
-unless (flock($fh, 2)) {
- print "NO STATELOCK\n\n";
- close ($fh);
- exit;
-}
-%state = read_state($fh);
-$ongstate = int($state{'state'});
-print 'state: '.$ongstate."\n";
-unless ($ongstate > STATE->{'inactive'}) {
- print "INACTIVE\n\n";
- close ($fh);
- exit;
-}
-$next_ong = int($state{'nextong'});
-print 'ongtime: '.$next_ong."\n";
-
-unless ($ongtime >= $next_ong) {
- print "WAIT\n\n";
- close ($fh);
- exit;
-}
-
-%settings = read_settings();
-$static_timer = int($settings{'ongtime'});
-$timer = int($settings{'dynamicongtime'});
-$last = int($settings{'last'});
-$frame = int($state {'last'})+1;
-
-if (($timer > 0) && ($frame < $last)) {
- $timer = int($timer / ($last - $frame));
-}
-else {
- $timer=0;
-}
-
-if ($static_timer > $timer) {
- $timer = $static_timer;
-}
-$next_ong = $ongtime + ($timer*3600);
-$state{'nextong'} = $next_ong;
-print 'next ongtime: '.$next_ong.' (+'.$timer.")\n";
-$state{'ongtime'}=$timer;
-
-if ($ongstate == STATE->{'ready'}) {
- print 'next frame: '.$frame."\n";
-
- %default = read_default();
- %frame_data = read_frame_data($frame);
- # %goto_list = read_goto());
-
- %new_state = %state;
- $new_state{'last'} = $frame;
- $new_state{'state'} = 1;
- $new_state{'ip1'} = '';
- $new_state{'ip2'} = '';
- $new_state{'ip3'} = '';
- $new_state{'ongtime'}= $timer;
-
- if ($frame >= 1) {
- %frame_1_data = read_frame_data($frame-1);
- }
- if ($frame >= 2) {
- %frame_2_data = read_frame_data($frame-2);
- }
- if ($frame >= 3) {
- %frame_3_data = read_frame_data($frame-3);
- }
-
- $r = ong (
- $frame, # frame ID
- $time, # ONG time
- $timer, # timer to next ONG
- 0, # update
- 1, # print
- \%settings,
- \%default,
- \%frame_data,
- '' # \%goto_list
- );
- if ($r && ($frame >= 2)) {
- print 'static page '.($frame-1);
- $r = write_static_viewer_page(
- $frame-1, # frame ID
- \%new_state,
- \%settings,
- \%default,
- \%frame_1_data, # frame data
- \%frame_2_data, # prev frame data
- \%frame_data, # next frame data
- '' # words data
- );
- print (($r) ? " OK\n" : " FAIL\n");
- }
- if ($r && ($frame >= 3)) {
- print 'static page '.($frame-2);
- $r = write_static_viewer_page(
- $frame-2, # frame ID
- \%new_state,
- \%settings,
- \%default,
- \%frame_2_data, # frame data
- \%frame_3_data, # prev frame data
- \%frame_1_data, # next frame data
- '' # words data
- );
- print (($r) ? " OK\n" : " FAIL\n");
- }
- if ($r && ($frame <= 2)) {
- print 'index';
- $r = write_index(
- \%new_state,
- \%settings
- );
- print (($r) ? " OK\n" : " FAIL\n");
- }
- if ($r) {
- print 'static GOTO';
- $r = write_static_goto(
- \%new_state,
- \%settings,
- '' # \%goto_list
- );
- print (($r) ? " OK\n" : " FAIL\n");
- }
- if ($r) {
- %state = %new_state;
- print "ONG\n\n";
- }
- else {
- print "NO ONG\n\n";
- }
-}
-write_state($fh, \%state);
-close ($fh);
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/w
-# opomba is generated from opomba.1.pl.
-#
-# The comment posting interface
-#
-# Copyright (C) 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'read_header_env', 'url_query_decode',
- 'write_data_file',
- 'html_entity_encode_dec',
- 'open_encoded',
- 'join_path',
- 'merge_url',
- 'make_id',
- 'http_header_status'
-);
-use bsta_lib (
- 'TEXT_MODE', 'STATE',
- 'get_password',
- 'fail_method', 'fail_content_type',
- 'redirect',
- 'print_html_start', 'print_html_end',
- 'print_html_head_start', 'print_html_head_end',
- 'print_html_body_start', 'print_html_body_end',
- 'bb_to_html', 'eval_bb',
- 'merge_settings',
- 'write_index', 'write_static_viewer_page',
- 'read_settings', 'read_state',
- 'read_words', 'write_words',
- 'read_words_list', 'write_words_list'
-
-);
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_CGI_VIEWER_PATH: CGI_VIEWER_PATH = /bsta/v
-###PERL_CGI_WORDS_PATH: CGI_WORDS_PATH = /bsta/w
-
-###PERL_DATA_WORDS_PATH: DATA_WORDS_PATH = /botm/data/bsta/words/
-
-###PERL_LOG_SPAM_PATH: LOG_SPAM_PATH = /botm/log/bsta/words_spam.log
-###PERL_LOG_WORDS_PATH: LOG_WORDS_PATH = /botm/log/bsta/words.log
-
-###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
-
-###PERL_COMMENT_PAGE_LENGTH:COMMENT_PAGE_LENGTH= 16
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %state;
-my %settings;
-my %words_data;
-my %post_data;
-my %last_post_data;
-
-my @post_list;
-
-my $method;
-my $frame;
-my $ID;
-my $last_ID;
-my $password;
-my $password_ok;
-my $access;
-my $edit = 0;
-my $remove = 0;
-my $post = 0;
-my $quote;
-my $words_data_path;
-my $index;
-my $page;
-my $ong_state;
-my $last_frame;
-my $fh;
-my $r;
-
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else {
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else {
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-
-if ($ENV{'PATH_INFO'} =~ /^\/([0-9]+)$/) {
- $frame = int($1);
-}
-elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
- $ID = $1;
-}
-if ($cgi{'f'} =~ /^.+$/) {
- $frame = int($&);
-}
-if ($cgi{'i'} =~ /^.+$/) {
- $ID = $&;
-}
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%state = read_state();
-$ong_state = int($state{'state'});
-$last_frame = int($state{'last'});
-
-$password_ok = ($password eq $settings{'password'});
-
-if ($cgi{'post'} ne '') {
- $post = 1;
-}
-elsif ($cgi{'edit'} ne '') {
- $edit = 1;
- if ($ID eq '') {
- $ID = $cgi{'edit'};
- }
-}
-elsif ($cgi{'remove'} ne '') {
- $remove = 1;
- if ($ID eq '') {
- $ID = $cgi{'remove'};
- }
-}
-else {
- $edit = 1;
- if ($cgi{'quote'} ne '') {
- $quote = $cgi{'quote'};
- }
-}
-
-if ($ID ne '') {
- %post_data = read_words($ID);
- if ($post_data{'frame'} ne '') {
- $frame = int($post_data{'frame'});
- }
-}
-
-unless ($frame ne '') {
- exit output(0, HTTP_STATUS->{'bad_request'}, 'Frame ID not specified.');
-}
-$access = (
- $password_ok || (
- ($ong_state >= STATE->{'waiting'}) &&
- ($frame <= $last_frame)
- )
-);
-unless ($access) {
- exit output(0, HTTP_STATUS->{'forbidden'}, 'Not allowed to post this here now');
-}
-
-$words_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $frame);
-
-unless (open_encoded($fh, "+<:encoding(UTF-8)", $words_data_path)) {
- unless (open_encoded($fh, "+>:encoding(UTF-8)", $words_data_path)) {
- exit output(0, '500 Internal Server Error', 'Failed opening data file.', 1);
- }
-}
-unless (flock($fh, 2)) {
- exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed locking data file.', 1);
-}
-
-%words_data = read_words_list(
- $fh, # file
- 0, # header only
-);
-
-@post_list = @{$words_data{'content'}};
-
-for (my $i=0; $i< scalar(@post_list); $i +=1) {
- if ($post_list[$i] eq $ID) {
- $index = $i;
- $page = int($index / COMMENT_PAGE_LENGTH());
- last;
- }
-}
-
-if ($remove || ($ID ne '')) {
- unless ($index ne '') {
- close($fh);
- exit output(0, HTTP_STATUS->{'not_found'}, $remove ? 'Nothing to remove.' : 'No such message.');
- }
- unless ($cgi{'key'} eq $post_data{'key'}) {
- close($fh);
- exit output(0, HTTP_STATUS->{'bad_request'}, 'Invalid request.');
- }
-}
-if ($remove) {
- unless (($method eq 'POST') && ($cgi{'i'} ne '')) { # followed a link, not confirmed yet
- close($fh);
- exit output(0, '', '', 1);
- }
-}
-else {
- unless (($method eq 'POST') && $post) { # followed a link, not confirmed yet
- close($fh);
- exit output(0, '', '', 1);
- }
-}
-if (!$remove) {
- unless ($cgi{'words'} ne '') {
- exit output(0, HTTP_STATUS->{'bad_request'}, 'Where are your words?', 1);
- }
-}
-unless ($cgi{'username'} ne '') {
- close($fh);
- exit output(0, HTTP_STATUS->{'bad_request'}, 'Missing user name.', 1);
-}
-if ($remove || ($ID ne '')) {
- unless ($cgi{'username'} eq $post_data{'name'}) {
- close($fh);
- exit output(0, HTTP_STATUS->{'forbidden'}, 'Wrong user name.', 1);
- }
-}
-if ($remove || ($ID ne '')) {
- unless ($cgi{'password'} ne '') {
- close($fh);
- exit output(0, HTTP_STATUS->{'bad_request'}, 'Missing password.', 1);
- }
- unless (
- ($cgi{'password'} eq $post_data{'password'}) || (
- ($cgi{'password'} eq $settings{'password'}) &&
- $password_ok
- )
- ) {
- close($fh);
- exit output(0, HTTP_STATUS->{'forbidden'}, 'Wrong password.', 1);
- }
- if ($password_ok) {
- $cgi{'password'} = $post_data{'password'};
- }
-}
-unless ($cgi{'password2'} eq '') {
- close($fh);
- # no error code to confuse spambot :)
- output(0, '', 'Please don\'t write anything in the place which should remain empty.', 1);
- if (open_encoded($fh, ">>:encoding(UTF-8)", LOG_SPAM_PATH())) {
- $cgi{'content'} = $cgi{'words'};
- $cgi{'empty'} = $cgi{'password2'};
- delete($cgi{'words'});
- delete ($cgi{'password'});
- delete ($cgi{'password2'});
- print $fh "$time SPAM $ID\n";
- write_data_file(
- $fh, \%cgi, '',
- 0, 0, 0,
- '>>', 1
- );
- print $fh "\n\n";
- close ($fh);
- }
- exit;
-}
-
-# all conditions fulfilled
-
-if ($remove) {
- splice @post_list, $index, 1;
- $words_data{'posts'} = scalar(@post_list);
- $words_data{'content'} = \@post_list;
-
- $r = write_words_list($fh, \%words_data);
- unless ($r) {
- close($fh);
- exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed writing data file.');
- }
-
- close ($fh);
-
- if (open_encoded($fh, ">>:encoding(UTF-8)", LOG_WORDS_PATH())) {
- delete ($post_data{'password'});
- print $fh "$time REMOVE $ID\n";
- write_data_file(
- $fh, \%post_data, '',
- 0, 0, 0,
- '>>', 1
- );
- print $fh "\n\n";
- close ($fh);
- }
-
- $ID = 'insw';
- exit output(1);
-}
-
-if ($ID eq '') {
- $ID = make_id($frame, 1);
-}
-if ($index eq '') {
- $index = scalar(@post_list);
- $page = int($index / COMMENT_PAGE_LENGTH());
- if ($index > 0) {
- $last_ID = $post_list[-1];
- %last_post_data = read_words($last_ID);
- if (
- ($cgi{'username'} eq $last_post_data{'name' }) &&
- ($cgi{'words' } eq $last_post_data{'content'})
- ) { # duplicate post
- $index -= 1;
- $page = int($index / COMMENT_PAGE_LENGTH());
- $ID = $last_ID;
- close ($fh);
- exit output(1);
- }
- }
- push @post_list, $ID;
-}
-$words_data{'posts'} = scalar(@post_list);
-$words_data{'content'} = \@post_list;
-
-$post_data{'frame'} = $frame;
-$post_data{'name'} = $cgi{'username'};
-$post_data{'password'} = $cgi{'password'};
-if ($post_data{'posttime'} eq '') {
- $post_data{'posttime'} = $time;
-}
-else {
- $post_data{'edittime'} = $time;
-}
-if ($post_data{'key'} eq '') {
- my $new_key = '';
- for (my $i=1; $i<16; $i+=1) {
- $new_key .= sprintf('%02X', int(rand(0x100)));
- }
- $post_data{'key'} = $new_key;
-}
-$post_data{'content'} = $cgi{'words'};
-
-$r = write_words($ID, \%post_data);
-unless ($r) {
- close($fh);
- exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed writing post file.', 1, 0);
-}
-
-$r = write_words_list($fh, \%words_data);
-unless ($r) {
- close($fh);
- exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed writing data file.', 1, 0);
-}
-
-close($fh);
-
-if (($frame == 0) && ($ong_state > STATE->{'inactive'})) {
- write_index(\%state, \%settings);
-}
-elsif ($frame >= 1) {
- write_static_viewer_page(
- $frame,
- \%state,
- \%settings,
- '', # default
- '', # frame data
- '', # prev frame data
- '', # next frame data
- \%words_data
- );
-}
-
-if (open_encoded($fh, ">>:encoding(UTF-8)", LOG_WORDS_PATH())) {
- delete ($post_data{'password'});
- print $fh "$time POST $ID\n";
- write_data_file(
- $fh, \%post_data, '',
- 0, 0, 0,
- '>>', 1
- );
- print $fh "\n\n";
- close ($fh);
-}
-
-exit output(1);
-
-
-sub output {
- (my $done, my $status, my $message, my $show_content) = @_;
-
- my $return_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {
- 'path' => $frame,
- 'query' => {
- 'b' => TEXT_MODE->{'words'},
- 'i' => $page,
- 'p' => ($password_ok ? $settings{'password'} : '')
- },
- 'fragment' => $ID
- }
- );
- if ($done) {
- return redirect($method, $return_url, HTTP_STATUS->{'see_other'});
- }
-
- if ($status ne '') {
- print http_header_status($status);
- }
- print "Content-type: text/html; charset=UTF-8\n\n";
- if ($method eq 'HEAD') {
- return;
- }
-
- my $title;
- my $name;
- my $content;
-
- if ($remove) {
- $title = 'Remove message "'.$ID.'"';
- }
- elsif ($ID ne '') {
- $title = 'Edit message "'.$ID.'"';
- }
- else {
- $title = 'Words';
- }
- if ($frame ne '') {
- $title = $frame.'. '.$title;
- }
-
- if ($cgi{'username'} ne '') {
- $name = $cgi{'username'}
- }
- elsif ($post_data{'name'} ne '') {
- $name = $post_data{'name'}
- }
- else {
- $name = '';
- }
-
- if ($cgi{'words'} ne '') {
- $content = $cgi{'words'};
- }
- elsif ($quote ne '') {
- my %quote_data = read_words($quote);
- $content = '[quote="'.$quote_data{'name'}.'"]'.$quote_data{'content'}.'[/quote]';
- }
- elsif (($cgi{'edit'} ne '') || $remove) {
- $content = $post_data{'content'};
- }
- else {
- $content = '';
- }
-
- my $_password = $password_ok ? html_entity_encode_dec($settings{'password'}, 1) : '';
- my $_key = html_entity_encode_dec($post_data{'key'}, 1);
- my $_ID = html_entity_encode_dec($ID, 1);
- my $_title = html_entity_encode_dec($title, 1);
- my $_message = html_entity_encode_dec($message, 1);
- my $_story = html_entity_encode_dec($settings{'story'}, 1);
- my $_name = html_entity_encode_dec($name, 1);
- my $_content = html_entity_encode_dec($content, 1);
- my $_empty = html_entity_encode_dec($cgi{'password2'}, 1);
- my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
- my $_post_url = html_entity_encode_dec(CGI_WORDS_PATH(), 1);
- my $_return_url = html_entity_encode_dec($return_url, 1);
-
- print_html_start(\*STDOUT);
- print_html_head_start(\*STDOUT);
-
- print ' <title>'.$_title.' • '.$_story.' • '.$_website_name.'</title>';
-
- print_html_head_end(\*STDOUT);
- print_html_body_start(\*STDOUT);
-
- print ' <div id="inst" class="ins">'."\n";
-
- print ' <div id="title">'."\n";
- print ' <h1 id="titletext">'.$_title.'</h1>'."\n";
- print ' </div>'."\n";
-
- print ' </div>'."\n";
-
- if ($message ne '') {
- print ' <div id="insb" class="ins">'."\n";
-
- print ' <div id="command">'."\n";
- print ' <span class="br">'.$_message.'</span>'."\n";
- print ' </div>'."\n";
-
- print ' </div>'."\n";
- }
-
- print ' <div id="insw" class="ins">'."\n";
-
- if ($show_content) {
- print ' <div class="undertext" id="words">'."\n";
- print ' <form method="post" action="'.$_post_url.'">'."\n";
- unless ($remove) {
- print ' <b>Your words:</b>'."\n";
- print ' <textarea class="inta" name="words" rows="4">'.$_content.'</textarea>'."\n";
- }
- print ' <table cellpadding="0" cellspacing="0" border="0"><tr>'."\n";
- print ' <td><b>Your name: </b></td>'."\n";
- print ' <td><input class="intx" type="text" name="username" value="'.$_name.'"></td>'."\n";
- print ' <td></td>'."\n";
- print ' </tr><tr>'."\n";
- print ' <td><b>'.(($ID ne '') ? 'Password' : 'Optional password').': </b></td>'."\n";
- print ' <td><input class="intx" type="password" name="password" value=""></td>'."\n";
- print ' <td>'.(($ID ne '') ? '' : '(if you want to edit later)').'</td>'."\n";
- print ' </tr><tr>'."\n";
- print ' <td><b>Leave this empty: </b></td>'."\n";
- print ' <td><input class="intx" type="text" name="password2" value="'.$_empty.'"></td>'."\n";
- if ($remove) {
- print ' <td><input class="inbt" type="submit" name="remove" value="Remove"></td>'."\n";
- }
- else {
- print ' <td>'."\n";
- print ' <input class="inbt" type="submit" name="post" value="'.(($ID ne '') ? 'Update' : 'Send').'">'."\n";
- print ' <input class="inbt" type="submit" name="preview" value="Preview">'."\n";
- print ' </td>'."\n";
- }
- print ' </tr></table>'."\n";
- print ' <input type="hidden" name="f" value="'.$frame.'">'."\n";
- if ($ID ne '') {
- print ' <input type="hidden" name="i" value="'.$_ID.'">'."\n";
- }
- print ' <input type="hidden" name="key" value="'.$_key.'">'."\n";
- if ($password_ok) {
- print ' <input type="hidden" name="p" value="'.$_password.'">'."\n";
- }
- print ' </form>'."\n";
- if ($content ne ''){
- print ' <br>'."\n";
- print ' <div id="preview"class="opomba">'."\n";
- print ' <div class="opomba_info">'."\n";
- print ' Preview:'."\n";
- print ' </div>'."\n";
- print ' <div class="opomba_text">'."\n";
- print bb_to_html(
- eval_bb(
- $content,
- 0,
- $password_ok ? $settings{'password'} : ''
- )
- )."\n";
- print ' </div>'."\n";
- print ' </div>'."\n";
- }
- print ' </div>'."\n";
- }
- print ' <div id="underlinks">'."\n";
- print ' <a href="'.$_return_url.'">Return</a>'."\n";
- print ' </div>'."\n";
-
- print ' </div>'."\n";
-
- print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'});
- print_html_end(\*STDOUT);
-}
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# reset is generated from reset.1.pl.
-#
-# Reset BSTA state
-#
-# Copyright (C) 2016, 2017, 2018, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'write_data_file',
- 'opendir_encoded', 'readdir_decoded', 'unlink_encoded',
- 'join_path'
-);
-use bsta_lib (
- 'STATE', 'INTF_STATE', 'CHAT_STATE',
- 'write_index',
- 'merge_settings',
- 'get_page_file', 'get_frame_file',
- 'read_settings', 'read_default', 'read_frame_data', 'read_attachment', 'read_state'
-);
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-decode_argv();
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_DATA_CHAT_PATH: DATA_CHAT_PATH = /botm/data/bsta/chat
-###PERL_DATA_DEFAULT_PATH: DATA_DEFAULT_PATH = /botm/data/bsta/default
-###PERL_DATA_LIST_PATH: DATA_LIST_PATH = /botm/data/bsta/list
-###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state
-###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story
-###PERL_DATA_WORDS_PATH: DATA_WORDS_PATH = /botm/data/bsta/words/
-
-###PERL_WWW_PATH: WWW_PATH = /botm/www/
-
-###PERL_RESET_PASSWORD: RESET_PASSWORD = ''
-
-my %story;
-my %state;
-my %chat;
-my %settings;
-my %goto_list;
-my %default;
-my $last_frame;
-my @remove_list;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-%settings = read_settings();
-%state = read_state();
-unless (
- ($ARGV[0] ne '') && (
- ($ARGV[0] eq $settings{'password'}) ||
- ($ARGV[0] eq RESET_PASSWORD())
- )
-) {
- print STDERR "Wrong password; no reset.\n";
- exit 1;
-}
-
-$last_frame = (int($settings{'last'}) > int($state{'last'})) ?
- int($settings{'last'}) : int($state{'last'});
-%default = read_default();
-
-for (my $frame=0; $frame<=$last_frame; $frame+=1) {
- my %frame_data = read_frame_data($frame, \%default);
- unless ($frame == 0) {
- push @remove_list, get_page_file($frame, \%frame_data, \%settings);
- }
- push @remove_list, get_frame_file($frame, \%frame_data, \%settings);
-}
-push @remove_list, 'goto.htm';
-for (my $i=0; ;$i+=1) {
- my %file_data;
-
- %file_data = read_attachment($i);
- if ($file_data{'frame'} eq '') {
- last;
- }
- if ($file_data{'content'} ne '') {
- next;
- }
- push @remove_list, $file_data{'filename'};
-}
-
-%state = (
- 'state' => STATE->{'inactive'},
- 'last' => 0,
- 'ongtime' => '',
- 'nextong' => '',
- 'ip1' => '',
- 'ip2' => '',
- 'ip3' => ''
-);
-%story = (
- 'id' => 0,
- 'letter' => '',
- 'lastip' => '0.0.0.0',
- 'content' => '',
- 'pass' => 0,
- 'state' => INTF_STATE->{'X'}
-);
-%chat = (
- 'id' => 0,
- 'state' => CHAT_STATE->{'disconnected'},
- 'content' => ''
-);
-%goto_list = (
-);
-
-write_data_file(DATA_STATE_PATH(), \%state);
-write_data_file(DATA_STORY_PATH(), \%story);
-write_data_file(DATA_CHAT_PATH() , \%chat);
-write_data_file(DATA_LIST_PATH() , \%goto_list);
-
-write_index(
- \%state,
- \%settings,
- $story{'pass'},
- $story{'state'},
- 0 # pause
-);
-
-if (opendir_encoded(my $dir, DATA_WORDS_PATH())) {
- while (defined (my $file_name = readdir_decoded($dir))) {
- if ($file_name !~ /^[0-9]+$/) {
- next;
- }
- my $full_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $file_name);
- # print "RM $full_path\n";
- unlink_encoded ($full_path);
- }
-}
-foreach my $file_name (@remove_list) {
- my $full_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $file_name);
- # print "RM $full_path\n";
- unlink_encoded ($full_path);
-}
+++ /dev/null
-# In this file are defined values specific for the user's system
-
-
-# target name. settings file (THIS FILE) is "settings-TARGET_NAME.txt"
-# where TARGET_NAME is the value
-target: again
-
-name: bstagain
-
-
-# Where the software will be located
-bin_path: /botm/bin/bstagain
-
-# where the libraries will be located
-lib_path: /botm/lib/bstagain
-
-# where the software will remember data
-data_path: /botm/data/bstagain
-
-#where the software will record logs
-log_path: /botm/log/bstagain
-
-#for temporary fies
-tmp_path: /botm/tmp/bstagain
-
-#for the www server
-www_path : /botm/www/1190/bstagain
-cgi_path : /bstagain
-conf_path: /botm/etc/www/conf/1190
-
-#cron files directory
-cron_path: /etc/cron.d
-
-path: /usr/local/bin:/usr/bin:/bin
-# The path environment variable. Must be overwritten if SETUID.
-# Otherwise launching programs may fail.
-# (Perl security...)
-
-
-#paths to software
-
-chmod: /usr/bin/chmod
-cp : /usr/bin/cp
-gzip : /usr/bin/gzip
-mkdir: /usr/bin/mkdir
-mv : /usr/bin/mv
-perl : /usr/bin/perl
-rm : /usr/bin/rm
-sudo : /usr/bin/sudo
-
-CC: /usr/bin/gcc
-CF: -g -Wall
-
-
-# How big can a log file be
-log_size_limit: 65536
-
-# How many uncompressed old logs to keep
-logs_uncompressed: 2
-
-# How many old logs to keep
-logs_total: 10
-
-# When to deal with old logs
-oldlogs_schedule: 1 4 * * *
-
-# When to run the ONG bot
-ong_schedule: 0 * * * *
-
-# When to RESET EVERYTHING
-reset_schedule: 33 4 * * *
-reset_password: again
-
-cron_user: b
-
-
-scheme : http
-website : 1190.bicyclesonthemoon.info
-website_name: Bicycles on the Moon
-favicon_path: /img/favicon.png
-intf_date : 28-Sep-2016 20:34
-coin_date : 13-Nov-2016 22:15
-
-story_length : 16
-firstpage_length: 4
-page_length : 16
-
-comment_page_length: 40
-
-story_credits: "BSTA" by Balthasar Szczepański
-intf_credits: Online interface v$_version © Balthasar Szczepański; AGPL 3 license
-source_url: http://bicyclesonthemoon.info/git-projects/?p=ott/bsta
+++ /dev/null
-# In this file are defined values specific for the user's system
-
-
-# target name. settings file (THIS FILE) is "settings-TARGET_NAME.txt"
-# where TARGET_NAME is the value
-target: bsta
-
-name: bsta
-
-
-# Where the software will be located
-bin_path: /botm/bin/bsta
-
-# where the libraries will be located
-lib_path: /botm/lib/bsta
-
-# where the software will remember data
-data_path: /botm/data/bsta
-
-#where the software will record logs
-log_path: /botm/log/bsta
-
-#for temporary fies
-tmp_path: /botm/tmp/bsta
-
-#for the www server
-www_path : /botm/www/1190/bsta
-cgi_path : /bsta
-conf_path: /botm/etc/www/conf/1190
-
-#cron files directory
-cron_path: /etc/cron.d
-
-path: /usr/local/bin:/usr/bin:/bin
-# The path environment variable. Must be overwritten if SETUID.
-# Otherwise launching programs may fail.
-# (Perl security...)
-
-
-#paths to software
-
-chmod: /usr/bin/chmod
-cp : /usr/bin/cp
-gzip : /usr/bin/gzip
-mkdir: /usr/bin/mkdir
-mv : /usr/bin/mv
-perl : /usr/bin/perl
-rm : /usr/bin/rm
-sudo : /usr/bin/sudo
-
-CC: /usr/bin/gcc
-CF: -g -Wall
-
-
-# How big can a log file be
-log_size_limit: 65536
-
-# How many uncompressed old logs to keep
-logs_uncompressed: 2
-
-# How many old logs to keep
-logs_total: 10
-
-# When to deal with old logs
-oldlogs_schedule: 0 4 * * *
-
-# When to run the ONG bot
-ong_schedule: 0 * * * *
-
-# When to RESET EVERYTHING
-reset_schedule: #33 4 * * *
-reset_password:
-
-cron_user: b
-
-
-scheme : http
-website : 1190.bicyclesonthemoon.info
-website_name: Bicycles on the Moon
-favicon_path: /img/favicon.png
-intf_date : 28-Sep-2016 20:34
-coin_date : 13-Nov-2016 22:15
-
-story_length : 16
-firstpage_length: 4
-page_length : 16
-
-comment_page_length: 40
-
-story_credits: "BSTA" by Balthasar Szczepański
-intf_credits: Online interface v$_version © Balthasar Szczepański; AGPL 3 license
-source_url: http://bicyclesonthemoon.info/git-projects/?p=ott/bsta
# where TARGET_NAME is the value
target: debug
-name: test-bsta
+name: test-oldlogs
# Where the software will be located
-bin_path: /botm/bin/test-bsta
+bin_path: /botm/bin/test-oldlogs
# where the libraries will be located
-lib_path: /botm/lib/test-bsta
-
-# where the software will remember data
-data_path: /botm/data/test-bsta
-
-#where the software will record logs
-log_path: /botm/log/test-bsta
-
-#for temporary fies
-tmp_path: /botm/tmp/test-bsta
-
-#for the www server
-www_path : /botm/www/1190/bstatest
-cgi_path : /bstatest
-conf_path: /botm/etc/www/conf/1190
-
-#cron files directory
-cron_path: /etc/cron.d
-
-path: /usr/local/bin:/usr/bin:/bin
-# The path environment variable. Must be overwritten if SETUID.
-# Otherwise launching programs may fail.
-# (Perl security...)
-
+lib_path: /botm/lib/test-oldlogs
#paths to software
mv : /usr/bin/mv
perl : /usr/bin/perl
rm : /usr/bin/rm
-sudo : /usr/bin/sudo
-
-CC: /usr/bin/gcc
-CF: -g -Wall
# How big can a log file be
# How many old logs to keep
logs_total: 10
-# When to deal with old logs
-oldlogs_schedule: #0 4 * * *
-
-# When to run the ONG bot
-ong_schedule: #0 * * * *
-
-# When to RESET EVERYTHING
-reset_schedule: #33 4 * * *
-reset_password: bstreset
-
-cron_user: b
-
-
-scheme : http
-website : 1190.bicyclesonthemoon.info
-website_name: Bicycles on the Moon
-favicon_path: /img/favicon.png
-intf_date : 28-Sep-2016 20:34
-coin_date : 13-Nov-2016 22:15
-
-story_length : 16
-firstpage_length: 4
-page_length : 16
-
-comment_page_length: 4
-
-story_credits: "BSTA" by Balthasar Szczepański
-intf_credits: Online interface v$_version © Balthasar Szczepański; AGPL 3 license
-source_url: http://bicyclesonthemoon.info/git-projects/?p=ott/bsta
--- /dev/null
+# In this file are defined values specific for the user's system
+
+
+# target name. settings file (THIS FILE) is "settings-TARGET_NAME.txt"
+# where TARGET_NAME is the value
+target: release
+
+name: oldlogs
+
+
+# Where the software will be located
+bin_path: /botm/bin/oldlogs
+
+# where the libraries will be located
+lib_path: /botm/lib/oldlogs
+
+#paths to software
+
+chmod: /usr/bin/chmod
+cp : /usr/bin/cp
+gzip : /usr/bin/gzip
+mkdir: /usr/bin/mkdir
+mv : /usr/bin/mv
+perl : /usr/bin/perl
+rm : /usr/bin/rm
+
+
+# How big can a log file be
+log_size_limit: 65536
+
+# How many uncompressed old logs to keep
+logs_uncompressed: 2
+
+# How many old logs to keep
+logs_total: 10
+
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
-_version: 1.2.6
+_version: 1.0.0y
_SHEBANG: #!$0
_PERL_OUR_STR: @_PERL_OUR(\$$0,@_PERL_STR($1))
-_bin_path = @_PATH( $bin_path, )
-_bin_2words_path = @_PATH( $bin_path, 2words )
-_bin_attach_path = @_PATH( $bin_path, attach )
-_bin_bbcode_path = @_PATH( $bin_path, bbcode )
-_bin_coin_path = @_PATH( $bin_path, chat )
-_bin_frame_path = @_PATH( $bin_path, frame )
-_bin_goto_path = @_PATH( $bin_path, goto )
-_bin_info_path = @_PATH( $bin_path, info )
-_bin_oldlogs_path = @_PATH( $bin_path, oldlogs.pl)
-_bin_ong_path = @_PATH( $bin_path, ong.pl )
-_bin_reset_path = @_PATH( $bin_path, reset.pl )
-_bin_viewer_path = @_PATH( $bin_path, viewer )
-_bin_words_path = @_PATH( $bin_path, opomba )
-
-_cgi_path = @_PATH( $cgi_path, )
-_cgi_2words_path = @_PATH( $cgi_path, 2words )
-_cgi_attach_path = @_PATH( $cgi_path, a )
-_cgi_bbcode_path = @_PATH( $cgi_path, b )
-_cgi_coin_path = @_PATH( $cgi_path, coin )
-_cgi_css_path = @_PATH( $cgi_path, bsta.css )
-_cgi_frame_path = @_PATH( $cgi_path, f )
-_cgi_goto_path = @_PATH( $cgi_path, g )
-_cgi_info_path = @_PATH( $cgi_path, i )
-_cgi_list_path = @_PATH( $cgi_path, goto.htm )
-_cgi_logo_path = @_PATH( $cgi_path, botmlogo.png)
-_cgi_timer_path = @_PATH( $cgi_path, timer.js )
-_cgi_viewer_path = @_PATH( $cgi_path, v )
-_cgi_words_path = @_PATH( $cgi_path, w )
-
-_data_path = @_PATH( $data_path, )
-_data_attach_path = @_PATH( $data_path, a )
-_data_chat_path = @_PATH( $data_path, chat )
-_data_coin_path = @_PATH( $data_path, coincidence)
-_data_default_path = @_PATH( $data_path, default )
-_data_list_path = @_PATH( $data_path, list )
-_data_noaccess_path = @_PATH( $data_path, noaccess )
-_data_settings_path = @_PATH( $data_path, settings )
-_data_state_path = @_PATH( $data_path, state )
-_data_story_path = @_PATH( $data_path, story )
-_data_words_path = @_PATH( $data_path, words )
-
-_log_path = @_PATH( $log_path, )
-_log_ong_path = @_PATH( $log_path, ong.log )
-_log_spam_path = @_PATH( $log_path, words_spam.log)
-_log_words_path = @_PATH( $log_path, words.log )
-
-_www_path = @_PATH( $www_path, )
-_www_goto_path = @_PATH( $www_path, goto.htm )
-_www_index_path = @_PATH( $www_path, index.htm)
-
-_conf_path = @_PATH($conf_path, $name\.conf)
-_cron_path = @_PATH($cron_path, $name)
-
-
-CONF_BIN = $_bin_path
-CONF_BIN_2WORDS = $_bin_2words_path
-CONF_BIN_ATTACH = $_bin_attach_path
-CONF_BIN_BBCODE = $_bin_bbcode_path
-CONF_BIN_COIN = $_bin_coin_path
-CONF_BIN_FRAME = $_bin_frame_path
-CONF_BIN_GOTO = $_bin_goto_path
-CONF_BIN_INFO = $_bin_info_path
-CONF_BIN_VIEWER = $_bin_viewer_path
-CONF_BIN_WORDS = $_bin_words_path
-
-CONF_CGI_2WORDS = $_cgi_2words_path
-CONF_CGI_ATTACH = $_cgi_attach_path
-CONF_CGI_BBCODE = $_cgi_bbcode_path
-CONF_CGI_COIN = $_cgi_coin_path
-CONF_CGI_FRAME = $_cgi_frame_path
-CONF_CGI_GOTO = $_cgi_goto_path
-CONF_CGI_INFO = $_cgi_info_path
-CONF_CGI_VIEWER = $_cgi_viewer_path
-CONF_CGI_WORDS = $_cgi_words_path
-
-
-CRON_ONG = $_bin_ong_path
-CRON_OLDLOGS = $_bin_oldlogs_path
-CRON_RESET = $_bin_reset_path
-
-CRON_USER = $cron_user
-
-CRON_OLDLOGS_SCHEDULE = $oldlogs_schedule
-CRON_ONG_SCHEDULE = $ong_schedule
-CRON_RESET_SCHEDULE = $reset_schedule
-CRON_RESET_PASSWORD = $reset_password
-
-CRON_LOG_SIZE_LIMIT = $log_size_limit
-CRON_LOGS_UNCOMPRESSED = $logs_uncompressed
-CRON_LOGS_TOTAL = $logs_total
-
-CRON_LOG = $_log_path
-CRON_ONG_LOG = $_log_ong_path
-
-
MAKE_TARGET = TARGET = $target
MAKE_CHMOD = CHMOD=$chmod
MAKE_MKDIR = MKDIR=$mkdir
MAKE_PERL = PERL =$perl
MAKE_RM = RM =$rm
-MAKE_SUDO = SUDO =$sudo
-
-MAKE_CC = CC =$CC
-MAKE_CF = CF =$CF
-
-MAKE_CONF = CONF = $_conf_path
-MAKE_CRON = CRON = $_cron_path
MAKE_BIN_PATH = BIN_PATH = $bin_path
-MAKE_DATA_PATH = DATA_PATH = $data_path
-MAKE_DATA_WORDS_PATH = DATA_WORDS_PATH = $_data_words_path
MAKE_LIB_PATH = LIB_PATH = $lib_path
-MAKE_LOG_PATH = LOG_PATH = $log_path
-MAKE_TMP_PATH = TMP_PATH = $tmp_path
-MAKE_WWW_PATH = WWW_PATH = $www_path
PERL_LIB = @_PERL_USE_2(lib, @_PERL_STR($lib_path))
-PERL_SET_PATH = \$ENV{'PATH'} = @_PERL_STR($path);
-
PERL_EXPORT_VERSION = @_PERL_OUR_STR( VERSION, $_version)
PERL_PATH_SEPARATOR = @_PERL_CONSTANT_STR( PATH_SEPARATOR, $_PATH_SEPARATOR)
-PERL_CGI_PATH = @_PERL_CONSTANT_STR( CGI_PATH , $_cgi_path )
-PERL_CGI_2WORDS_PATH = @_PERL_CONSTANT_STR( CGI_2WORDS_PATH, $_cgi_2words_path)
-PERL_CGI_ATTACH_PATH = @_PERL_CONSTANT_STR( CGI_ATTACH_PATH, $_cgi_attach_path)
-PERL_CGI_BBCODE_PATH = @_PERL_CONSTANT_STR( CGI_BBCODE_PATH, $_cgi_bbcode_path)
-PERL_CGI_COIN_PATH = @_PERL_CONSTANT_STR( CGI_COIN_PATH , $_cgi_coin_path )
-PERL_CGI_CSS_PATH = @_PERL_CONSTANT_STR( CGI_CSS_PATH , $_cgi_css_path )
-PERL_CGI_FRAME_PATH = @_PERL_CONSTANT_STR( CGI_FRAME_PATH , $_cgi_frame_path )
-PERL_CGI_GOTO_PATH = @_PERL_CONSTANT_STR( CGI_GOTO_PATH , $_cgi_goto_path )
-PERL_CGI_INFO_PATH = @_PERL_CONSTANT_STR( CGI_INFO_PATH , $_cgi_info_path )
-PERL_CGI_LIST_PATH = @_PERL_CONSTANT_STR( CGI_LIST_PATH , $_cgi_list_path )
-PERL_CGI_LOGO_PATH = @_PERL_CONSTANT_STR( CGI_LOGO_PATH , $_cgi_logo_path )
-PERL_CGI_TIMER_PATH = @_PERL_CONSTANT_STR( CGI_TIMER_PATH , $_cgi_timer_path )
-PERL_CGI_VIEWER_PATH = @_PERL_CONSTANT_STR( CGI_VIEWER_PATH, $_cgi_viewer_path)
-PERL_CGI_WORDS_PATH = @_PERL_CONSTANT_STR( CGI_WORDS_PATH , $_cgi_words_path )
-
-PERL_DATA_PATH = @_PERL_CONSTANT_STR( DATA_PATH , $_data_path )
-PERL_DATA_ATTACH_PATH = @_PERL_CONSTANT_STR( DATA_ATTACH_PATH , $_data_attach_path )
-PERL_DATA_CHAT_PATH = @_PERL_CONSTANT_STR( DATA_CHAT_PATH , $_data_chat_path )
-PERL_DATA_COIN_PATH = @_PERL_CONSTANT_STR( DATA_COIN_PATH , $_data_coin_path )
-PERL_DATA_DEFAULT_PATH = @_PERL_CONSTANT_STR( DATA_DEFAULT_PATH , $_data_default_path )
-PERL_DATA_LIST_PATH = @_PERL_CONSTANT_STR( DATA_LIST_PATH , $_data_list_path )
-PERL_DATA_NOACCESS_PATH = @_PERL_CONSTANT_STR( DATA_NOACCESS_PATH, $_data_noaccess_path)
-PERL_DATA_SETTINGS_PATH = @_PERL_CONSTANT_STR( DATA_SETTINGS_PATH, $_data_settings_path)
-PERL_DATA_STATE_PATH = @_PERL_CONSTANT_STR( DATA_STATE_PATH , $_data_state_path )
-PERL_DATA_STORY_PATH = @_PERL_CONSTANT_STR( DATA_STORY_PATH , $_data_story_path )
-PERL_DATA_WORDS_PATH = @_PERL_CONSTANT_STR( DATA_WORDS_PATH , $_data_words_path )
-
-PERL_LOG_PATH = @_PERL_CONSTANT_STR( LOG_PATH , $_log_path )
-PERL_LOG_SPAM_PATH = @_PERL_CONSTANT_STR( LOG_SPAM_PATH , $_log_spam_path )
-PERL_LOG_WORDS_PATH = @_PERL_CONSTANT_STR( LOG_WORDS_PATH, $_log_words_path)
-
-PERL_WWW_PATH = @_PERL_CONSTANT_STR( WWW_PATH , $_www_path )
-PERL_WWW_GOTO_PATH = @_PERL_CONSTANT_STR( WWW_GOTO_PATH , $_www_goto_path )
-PERL_WWW_INDEX_PATH = @_PERL_CONSTANT_STR( WWW_INDEX_PATH, $_www_index_path)
-
-PERL_SCHEME = @_PERL_CONSTANT_STR( SCHEME , $scheme )
-PERL_WEBSITE = @_PERL_CONSTANT_STR( WEBSITE , $website )
-PERL_WEBSITE_NAME = @_PERL_CONSTANT_STR( WEBSITE_NAME, $website_name)
-PERL_FAVICON_PATH = @_PERL_CONSTANT_STR( FAVICON_PATH, $favicon_path)
-
-PERL_COIN_DATE = @_PERL_CONSTANT_STR( COIN_DATE, $coin_date)
-PERL_INTF_DATE = @_PERL_CONSTANT_STR( INTF_DATE, $intf_date)
-
-PERL_STORY_CREDITS = @_PERL_CONSTANT_STR( STORY_CREDITS, $story_credits)
-PERL_INTF_CREDITS = @_PERL_CONSTANT_STR( INTF_CREDITS , @intf_credits)
-PERL_SOURCE_URL = @_PERL_CONSTANT_STR( SOURCE_URL , $source_url)
-
PERL_GZIP = @_PERL_CONSTANT_STR( GZIP, $gzip)
-PERL_RESET_PASSWORD = @_PERL_CONSTANT_STR( RESET_PASSWORD, $reset_password)
-
PERL_LOG_SIZE_LIMIT = @_PERL_CONSTANT( LOG_SIZE_LIMIT , $log_size_limit)
PERL_LOGS_UNCOMPRESSED = @_PERL_CONSTANT( LOGS_UNCOMPRESSED, $logs_uncompressed)
PERL_LOGS_TOTAL = @_PERL_CONSTANT( LOGS_TOTAL , $logs_total)
-PERL_STORY_LENGTH = @_PERL_CONSTANT( STORY_LENGTH , $story_length)
-PERL_PAGE_LENGTH = @_PERL_CONSTANT( PAGE_LENGTH , $page_length)
-PERL_FIRSTPAGE_LENGTH = @_PERL_CONSTANT( FIRSTPAGE_LENGTH, $firstpage_length)
-
-PERL_COMMENT_PAGE_LENGTH= @_PERL_CONSTANT( COMMENT_PAGE_LENGTH, $comment_page_length)
-
RUN_PERL = @_SHEBANG($perl)
+++ /dev/null
-// timer.js
-//
-// The countdown script.
-//
-// @license magnet:?xt=urn:btih:0b31508aeb0634b347b8270c7bee4d411b5d4109&dn=agpl-3.0.txt AGPL-3.0
-// Copyright (C) 2017, 2024 Balthasar Szczepański
-//
-// This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU Affero General Public License as
-// published by the Free Software Foundation, either version 3 of the
-// License, or (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU Affero General Public License for more details.
-//
-// You should have received a copy of the GNU Affero General Public License
-// along with this program. If not, see <http://www.gnu.org/licenses/>.
-// @license-end
-
-var enabled = false;
-
-window.onload = function () {
- var e_h;
- var e_m;
- var e_s;
- var h;
- var m;
- var s;
- var countdown;
- var timer;
-
- e_h = document.getElementById("ongh");
- e_m = document.getElementById("ongm");
- e_s = document.getElementById("ongs");
-
- h = +(e_h.innerHTML);
- m = +(e_m.innerHTML);
- s = +(e_s.innerHTML);
-
- timer = document.getElementById("timer");
- timer.onclick = function () {
- enabled = !enabled;
- }
-
- if (e_h == null || e_m == null || e_s == null) {
- // window.alert("NUL");
- }
- else {
- countdown = setInterval (function() {
- if(isNaN(h) || isNaN(m) || isNaN(s)) {
- // window.alert("NAN");
- clearInterval(countdown);
- return;
- }
-
- if (s > 0) {
- s -= 1;
- }
- else {
- s = 59;
- if (m > 0) {
- m -= 1;
- }
- else {
- m == 59;
- if (h > 0) {
- h -= 1;
- }
- else {
- m = 0;
- s = 0;
- }
- }
- }
-
- if (enabled) {
- if (h == 0 && m == 0 && s == 0) {
- e_h.innerHTML = "00";
- e_m.innerHTML = "00";
- e_s.innerHTML = "NG";
- // window.alert("ONG");
- clearInterval(countdown);
- return;
- }
- else {
- e_h.innerHTML = ((h < 10) ? "0" : "") + h;
- e_m.innerHTML = ((m < 10) ? "0" : "") + m;
- e_s.innerHTML = ((s < 10) ? "0" : "") + s;
- }
- }
- }, 1000);
- }
-};
+++ /dev/null
-#!/usr/bin/perl
-
-# update.pl is generated from update.1.pl.
-#
-# update already ONGed frames & stuff
-#
-# Copyright (C) 2016, 2017, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
-);
-use bsta_lib (
- 'STATE',
- 'ong',
- 'write_index', 'write_static_viewer_page', 'write_static_goto',
- 'read_frame_data', 'read_default', 'read_words_list',
- 'read_settings', 'read_state'
-);
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %settings = read_settings();
-my %default = read_default();
-my %state = read_state();
-my %all_frame_data = ();
-my %all_words_data = ();
-
-my $update_goto = 0;
-
-my $ong_state = int($state{'state'});
-my $last_frame = ($ong_state > STATE->{'inactive'}) ?
- int($state{'last'}) :
- 0;
-
-my @list;
-
-my $fail = 0;
-
-print $time."\n";
-
-foreach my $id (@ARGV) {
- if ($id eq 'all') {
- $update_goto = 1;
- push @list, 'i';
- push @list, 'c';
- for (my $f=0; $f<=$last_frame; $f+=1) {
- push @list, $f;
- }
- }
- elsif ($id =~ /^[0-9]+$/) {
- $update_goto = 1;
- my $f = int($&);
- if ($f <= $last_frame) {
- push @list, $f
- }
- else {
- print "$f > $last_frame\n";
- $fail += 1;
- }
- }
- elsif ($id =~ /^[ic]$/) {
- push @list, $&;
- }
- else {
- print "$id ???\n";
- $fail += 1;
- }
-}
-
-# duplicated - before AND after normal pages!
-if ($update_goto) {
- print 'static GOTO';
- my $r = write_static_goto(
- \%state,
- \%settings,
- '' # \%goto_list
- );
- if ($r) {
- print " OK\n";
- }
- else {
- print " FAIL\n";
- $fail += 1;
- }
-}
-
-foreach my $id (@list) {
- print "ONG $id\n";
- my $r = ong(
- $id, # frame ID
- $time, # ONG time
- '', # timer value; not relevant
- 1, # update
- 1, # print
- \%settings,
- \%default,
- get_frame_data($id),
- '' # %goto_list
- );
- unless ($r) {
- $fail += 1;
- print "ONG FAIL!\n";
- }
- make_static_pages($id);
-}
-
-# duplicated - before AND after normal pages!
-if ($update_goto) {
- print 'static GOTO';
- my $r = write_static_goto(
- \%state,
- \%settings,
- '' # \%goto_list
- );
- if ($r) {
- print " OK\n";
- }
- else {
- print " FAIL\n";
- $fail += 1;
- }
-}
-
-print "\n";
-
-
-sub get_frame_data {
- (my $id) = @_;
-
- unless ($id =~ /^[0-9]+$/) {
- return '';
- }
- my $f = int($id);
-
- unless (($f >= 0) && ($f <= $last_frame)) {
- return '';
- }
-
- my $r = $all_frame_data{$f};
- if (ref ($r)) {
- return $r;
- }
-
- my %frame_data = read_frame_data($f);
- $all_frame_data{$f} = \%frame_data;
- return \%frame_data;
-}
-
-sub get_words_data {
- (my $id) = @_;
-
- unless ($id =~ /^[0-9]+$/) {
- return '';
- }
- my $f = int($id);
-
- unless (($f >= 0) && ($f <= $last_frame)) {
- return '';
- }
-
- my $r = $all_words_data{$f};
- if (ref ($r)) {
- return $r;
- }
-
- my %words_data = read_words_list($f, 1);
- $all_words_data{$f} = \%words_data;
- return \%words_data;
-}
-
-sub make_static_page {
- (my $id) = @_;
- unless ($id =~ /^[0-9]+$/) {
- return;
- }
- my $f = int($id);
- unless (
- ($f >= 0) && (
- ($f < $last_frame) || (
- ($ong_state >= STATE->{'end'}) &&
- ($f <= $last_frame)
- )
- )
- ) {
- return;
- }
- my $r;
-
- if (($f == 0) && ($ong_state > STATE->{'inactive'})) {
- print 'index';
- $r = write_index(
- \%state,
- \%settings,
- );
- print (($r) ? " OK\n" : " FAIL\n");
- }
- elsif ($f > 0) {
- print 'static page '.$f;
- $r = write_static_viewer_page (
- $f,
- \%state,
- \%settings,
- \%default,
- get_frame_data($f),
- get_frame_data($f-1),
- get_frame_data($f+1),
- get_words_data($f)
- );
- print (($r) ? " OK\n" : " FAIL\n");
- }
-}
-
-sub make_static_pages {
- (my $id) = @_;
- unless ($id =~ /^[0-9]+$/) {
- return;
- }
- my $f = int($id);
- unless (($f >= 0) && ($f <= $last_frame)) {
- return '';
- }
-
- make_static_page($f);
- make_static_page($f-1);
- make_static_page($f+1);
- make_static_page($f);
-}
-
-exit $fail;
+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# /bsta/v
-# viewer is generated from viewer.1.pl.
-#
-# The viewer interface
-#
-# Copyright (C) 2016, 2017, 2019, 2020, 2023, 2024 Balthasar Szczepański
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
-use utf8;
-# use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'HTTP_STATUS',
- 'read_header_env',
- 'url_query_decode',
- 'join_path',
- 'open_encoded', '_x_encoded',
- 'http_header_status',
- 'merge_url'
-);
-use bsta_lib (
- 'STATE', 'TEXT_MODE', 'INTF_STATE',
- 'fail_method', 'fail_content_type', 'redirect',
- 'get_remote_addr', 'get_frame', 'get_password',
- 'merge_settings',
- 'print_viewer_page',
- 'write_index', 'write_static_goto', 'write_static_viewer_page',
- 'ong',
- 'read_frame_data', 'read_default', 'read_noaccess',
- 'read_words_list', 'read_settings', 'read_story', 'read_goto',
- 'read_state', 'write_state',
- 'get_page_file'
-);
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_CGI_PATH: CGI_PATH = /bsta/
-###PERL_CGI_VIEWER_PATH: CGI_VIEWER_PATH = /bsta/v
-
-###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state
-
-###PERL_WWW_PATH: WWW_PATH = /botm/www/
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-# decode_argv();
-
-my $time = time();
-srand ($time-$$);
-
-my %http;
-my %cgi;
-my %frame_data;
-my %prev_frame_data;
-my %next_frame_data;
-my %default;
-my %settings;
-my %state;
-my %new_state;
-my %goto_list;
-my %words_data;
-
-my $method;
-my $frame;
-my $prev_frame_data_path;
-my $next_frame_data_path;
-my $password;
-my $password_ok;
-my $IP;
-my $access;
-my $timer;
-my $timer_unlocked;
-my $fh;
-my $show_command;
-my $ongtime;
-my $goto;
-my $text_mode;
-my $words_page;
-my $words_data_path;
-my $no_cgi;
-my $force_redirect;
-
-delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
-###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
-
-if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
- $method = $1;
-}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
-}
-
-%http = read_header_env(\%ENV);
-%cgi = url_query_decode($ENV{'QUERY_STRING'});
-
-if ($method eq 'POST') {
- if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
- my %cgi_post = url_query_decode( <STDIN> );
- %cgi = merge_settings(\%cgi, \%cgi_post);
- }
- # multipart not supported
- else{
- exit fail_content_type($method, $http{'content-type'});
- }
-}
-$no_cgi = (scalar (keys %cgi) == 0);
-
-$IP = get_remote_addr();
-$frame = get_frame(\%cgi);
-$password = get_password(\%cgi);
-
-%settings = read_settings();
-%default = read_default();
-
-if ($frame >= 0) {
- %frame_data= read_frame_data($frame);
-}
-
-$password_ok = ($password eq $settings{'password'});
-
-# state & activation logic
-if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STATE_PATH())) {
- if (flock($fh, 2)) {
-
- %state = read_state($fh);
-
- if ($frame < 0) {
- $frame = int($state{'last'}) + $frame +1;
- if ($frame >= 0) {
- $force_redirect = 1;
- %frame_data = read_frame_data($frame);
- }
- }
-
- if (
- (int($state{'state'}) == STATE->{'waiting'}) &&
- ($frame == int($state{'last'})) &&
- ($method ne 'HEAD') &&
- (!$password_ok)
- ) {
- # register IP for progress
- my %new_state = %state;
- unless (
- ($state{'ip1'} eq $IP) ||
- ($state{'ip2'} eq $IP) ||
- ($state{'ip3'} eq $IP)
- )
- {
- if ($state{'ip1'} eq '') {
- $new_state{'ip1'} = $IP;
- }
- elsif ($state{'ip2'} eq '') {
- $new_state{'ip2'} = $IP;
- }
- elsif ($state{'ip3'} eq '') {
- $new_state{'ip3'} = $IP;
- $new_state{'state'} = STATE->{'ready'};
- }
- else {
- $new_state{'state'} = STATE->{'ready'};
- }
- if ($new_state{'state'} == STATE->{'ready'}) {
- write_static_goto(\%new_state, \%settings, '');
- write_static_viewer_page(
- $frame-1,
- \%new_state,
- \%settings,
- \%default,
- '', # frame data
- '', # prev frame data
- \%frame_data, # next frame data,
- '' # words data
- );
- }
- write_state($fh, \%new_state);
- }
- }
- elsif (
- (int($state{'state'}) == STATE->{'inactive'}) &&
- ($frame == 1) &&
- (!$password_ok)
- ) {
- # ready to activate?
- # NOTE: at this point frame 0 is already ONGed.
- my %story;
- my $ong_time = int($settings{'firstongtime'});
- my $r;
-
- %story = read_story();
- %goto_list = read_goto();
-
- if (
- (int($story{'state'}) == INTF_STATE->{'>|'} ) &&
- (int($story{'pass'}) == 1)
- ) {
- # conditions met; ACTIVATE!
-
- # set initial state
- $state{'state'} = STATE->{'waiting'};
- $state{'last'} = 1;
- $state{'ip1'} = '0.0.0.0';
- $state{'ip2'} = '0.0.0.0';
- $state{'ip3'} = '';
- $state{'nextong'} = (int($time / 3600) + int($settings{'firstongtime'})) * 3600 ;
- $state{'ongtime'} = $ong_time;
-
- # prepare to ONG frame 1
-
- $r = ong(
- 1, # frame ID
- $time, # ONG time,
- $ong_time, # timer
- 0, # update
- 0, # print
- \%settings,
- \%default,
- \%frame_data,
- \%goto_list
- );
- if ($r) {
- $r = write_index(\%state, \%settings);
- }
- if ($r) {
- $r = write_static_goto(\%state, \%settings, \%goto_list);
- }
- if ($r) {
- $r = write_state($fh, \%state);
- }
- unless ($r) {
- # FAILED ONG! Story as if it was inactive!
- $state{'state'} = STATE->{'inactive'};
- }
- }
- }
- }
- else {
- # FAILED GET STATE! Story as if it was inactive!
- $state{'state'} = STATE->{'inactive'};
- }
- close ($fh);
-}
-else {
- $state{'state'} = STATE->{'inactive'};
-}
-
-$access = (
- $password_ok || (
- (int($state{'state'}) >= STATE->{'waiting'}) &&
- ($frame <= int($state{'last'})) &&
- ($frame >= 0)
- )
-);
-
-if ($access) {
- if ($no_cgi) {
- # no CGI - static page is OK
- if ($frame == 0) {
- exit redirect($method, CGI_PATH(), HTTP_STATUS->{'see_other'});
- }
- elsif ($frame < int($state{'last'})) {
- my $page_file = get_page_file($frame, \%frame_data, \%settings);
- if (_x_encoded('-f',
- join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
- )) {
- my $static_url = merge_url(
- {'path' => CGI_PATH()},
- {'path' => $page_file}
- );
- exit redirect($method, $static_url, HTTP_STATUS->{'see_other'});
- }
- }
- }
- if ($force_redirect) {
- my $redirect_url = merge_url(
- {'path' => CGI_VIEWER_PATH()},
- {'path' => $frame}
- );
- unless ($no_cgi) {
- delete $cgi{'f'}; # to avoid infinite loop
- $redirect_url = merge_url(
- {'path' => $redirect_url},
- {'query' => \%cgi}
- );
- }
- exit redirect($method, $redirect_url, HTTP_STATUS->{'see_other'});
- }
-
- if ($frame > 0) {
- %prev_frame_data = read_frame_data($frame-1, \%default);
- }
- else {
- %prev_frame_data = %default;
- }
- %next_frame_data = read_frame_data($frame+1, \%default);
- %frame_data = merge_settings(\%default, \%frame_data);
-}
-else {
- # replace frame data with fail state replacement
- %frame_data = read_noaccess(\%default);
-}
-
-$timer = int($state{'nextong'}) - $time;
-$ongtime = int($state{'ongtime'});
-if($ongtime == 0) {
- $ongtime = int($settings{'ongtime'})
-}
-
-$show_command = ($timer < ($ongtime*3600/3));
-if ($state{'state'} >= STATE->{'ready'}) {
- $timer_unlocked = 3;
-}
-elsif ($state{'ip3'} ne '') {
- $timer_unlocked = 3;
-}
-elsif ($state{'ip2'} ne '') {
- $timer_unlocked = 2;
-}
-elsif ($state{'ip1'} ne '') {
- $timer_unlocked = 1;
-}
-else {
- $timer_unlocked = 0;
-}
-
-$text_mode = int($cgi{'b'});
-if($text_mode > TEXT_MODE->{'words'}) {
- $text_mode = TEXT_MODE->{'normal'};
-}
-$words_page = int($cgi{'i'});
-$goto = int($cgi{'g'});
-
-%words_data = read_words_list(
- $frame,
- ($text_mode != TEXT_MODE->{'words'})
-);
-
-if (!$access) {
- print http_header_status(HTTP_STATUS->{'forbidden'});
-}
-print "Content-type: text/html; charset=UTF-8\n\n";
-if($method eq 'HEAD') {
- exit;
-}
-
-print_viewer_page (
- \*STDOUT,
- {
- 'launch' => 0,
- 'frame' => $frame,
- 'access' => $access,
- 'password_ok' => $password_ok,
- 'timer_unlocked'=> $timer_unlocked,
- 'timer' => $timer,
- 'static' => 0,
- 'show_command' => $show_command,
- 'text_mode' => $text_mode,
- 'words_page' => $words_page,
- 'goto' => $goto
- },
- \%state,
- \%settings,
- \%frame_data,
- $access ? \%prev_frame_data : \%frame_data,
- $access ? \%next_frame_data : \%frame_data,
- \%words_data,
-);
bicyclesonthemoon.info / projects / botm / oldlogs / commitdiff
