bicyclesonthemoon.info Git - ott/bsta/blob - info.1.pl

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # /bsta/i
   4 # info.pl is generated from info.1.pl.
   5 #
   6 # The frame/story info interface
   7 #
   8 # Copyright (C) 2017, 2023, 2024  Balthasar Szczepański
   9 #
  10 # This program is free software: you can redistribute it and/or modify
  11 # it under the terms of the GNU Affero General Public License as
  12 # published by the Free Software Foundation, either version 3 of the
  13 # License, or (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU Affero General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU Affero General Public License
  21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 use strict;
  24 use utf8;
  25 # use Encode::Locale ('decode_argv');
  26 use Encode ('encode', 'decode');
  27
  28 ###PERL_LIB: use lib /botm/lib/bsta
  29 use botm_common (
  30         'read_header_env',
  31         'read_data_file', 'write_data_file',
  32         'url_query_decode',
  33         'join_path'
  34 );
  35 use bsta_lib (
  36         'STATE',
  37         'fail_method', 'fail_content_type',
  38         'get_password',
  39         'merge_settings'
  40 );
  41
  42 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  43
  44 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta
  45 ###PERL_DATA_ATTACH_PATH:   DATA_ATTACH_PATH   = /botm/data/bsta/a
  46 ###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
  47 ###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
  48 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  49 ###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
  50 ###PERL_DATA_WORDS_PATH:    DATA_WORDS_PATH    = /botm/data/bsta/words/
  51
  52 binmode STDIN,  ':encoding(UTF-8)';
  53 binmode STDOUT, ':encoding(UTF-8)';
  54 binmode STDERR, ':encoding(UTF-8)';
  55 # decode_argv();
  56
  57 my $time = time();
  58 srand ($time-$$);
  59
  60 my %http;
  61 my %cgi;
  62 my %info_data;
  63 my %next_frame_data;
  64 my %default;
  65 my %settings;
  66 my %state;
  67
  68 my $method;
  69 my $frame = '';
  70 my $attachment = '';
  71 my $words = '';
  72 my $password;
  73 my $password_ok;
  74 my $access;
  75 my $show_command;
  76 my $ongtime;
  77 my $timer;
  78 my $info_data_path;
  79 my $next_frame_data_path;
  80 my $ong_state;
  81 my $last_frame;
  82
  83 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  84 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  85
  86 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  87         $method = $1;
  88 }
  89 else{
  90         exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD');
  91 }
  92
  93 %http = read_header_env(\%ENV);
  94 %cgi = url_query_decode($ENV{'QUERY_STRING'});
  95
  96 if ($method eq 'POST') {
  97         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
  98                 my %cgi_post = url_query_decode( <STDIN> );
  99                 %cgi = merge_settings(\%cgi, \%cgi_post);
 100         }
 101         # multipart not supported
 102         else{
 103                 exit fail_content_type($method, $http{'content-type'});
 104         }
 105 }
 106
 107 if ($cgi{'f'} =~ /^.+$/) {
 108         $frame = int($&);
 109 }
 110 elsif ($cgi{'a'} =~ /^.+$/) {
 111         $attachment = int($&);
 112 }
 113 elsif ($cgi{'i'} =~ /^.+$/) {
 114         $attachment = int($&);
 115 }
 116 elsif ($cgi{'w'} =~ /^.+$/) {
 117         $words = $&;
 118 }
 119 elsif ($ENV{'PATH_INFO'} =~ /^\/a(.+)$/) {
 120         $attachment = int($1);
 121 }
 122 elsif ($ENV{'PATH_INFO'} =~ /^\/w(.+)$/) {
 123         $words = $1;
 124 }
 125 elsif ($ENV{'PATH_INFO'} =~ /^\/f?(.+)$/) {
 126         $frame = int($1);
 127 }
 128
 129 $password = get_password(\%cgi);
 130
 131 %settings   = read_data_file(DATA_SETTINGS_PATH());
 132 %default    = read_data_file(DATA_DEFAULT_PATH());
 133 %state      = read_data_file(DATA_STATE_PATH());
 134
 135 $ong_state  = int($state{'state'});
 136 $last_frame = int($state{'last'});
 137
 138 $password_ok = ($password eq $settings{'password'});
 139
 140 # comment info, not frame
 141 if ($words ne '') {
 142         $info_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $words);
 143         %info_data      = read_data_file($info_data_path);
 144         if ($words =~ /^[0-9]+$/) {
 145                 $frame = int($&);
 146                 if ($info_data{'posts'} eq '') {
 147                         $info_data{'posts'} = 0;
 148                 }
 149         }
 150         else {
 151                 $frame = ($info_data{'frame'} ne '') ? int($info_data{'frame'}) : -1;
 152                 unless ($password_ok) {
 153                         delete($info_data{'password'});
 154                         delete($info_data{'key'});
 155                 }
 156         }
 157 }
 158 # attachment info, not frame
 159 elsif ($attachment ne '') {
 160         %info_data = read_data_file(DATA_ATTACH_PATH().$attachment);
 161         $frame = ($info_data{'frame'} ne '') ? int($info_data{'frame'}) : -1;
 162 }
 163 # frame info
 164 elsif ($frame ne '') {
 165         if ($frame < 0) {
 166                 $frame = $last_frame + $frame +1;
 167         }
 168         $info_data_path       = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
 169         $next_frame_data_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame+1);
 170         %info_data       = read_data_file($info_data_path);
 171         %next_frame_data = read_data_file($next_frame_data_path);
 172         %info_data       = merge_settings(\%default,      \%info_data);
 173         %next_frame_data = merge_settings(\%default, \%next_frame_data);
 174
 175         $timer   = int($state{'nextong'}) - $time;
 176         $ongtime = int($state{'ongtime'});
 177         if($ongtime == 0) {
 178                 $ongtime = int($settings{'ongtime'})
 179         }
 180         $show_command = ($timer < ($ongtime * 3600 / 3));
 181 }
 182 # state info, not frame
 183 else {
 184         unless ($password_ok) {
 185                 # just show if IP was saved, not its value
 186                 if ($state{'ip1'} ne '') {
 187                         $state{'ip1'} = 1;
 188                 }
 189                 if ($state{'ip2'} ne '') {
 190                         $state{'ip2'} = 1;
 191                 }
 192                 if ($state{'ip3'} ne '') {
 193                         $state{'ip3'} = 1;
 194                 }
 195         }
 196         print "Content-type: text/plain; charset=UTF-8\n\n";
 197         if ($method eq 'HEAD') {
 198                 exit;
 199         }
 200         write_data_file(
 201                 \*STDOUT, \%state, '',
 202                 0, 0, 0,
 203                 '>>', 1
 204         );
 205
 206         exit;
 207 }
 208
 209 if (
 210         $password_ok || (
 211                 ($ong_state >= STATE->{'waiting'}) &&
 212                 ($frame <= $last_frame) &&
 213                 ($frame >= 0)
 214         )
 215 ) {
 216         $access = 1;
 217
 218         if (
 219                 ($words eq '') &&
 220                 ($attachment eq '') &&
 221                 ($info_data{'command'} eq '') && (
 222                         $password_ok ||
 223                         ($frame < $last_frame) || (
 224                                 ($ong_state >= STATE->{'ready'}) &&
 225                                 $show_command
 226                         )
 227                 )
 228         ) {
 229                 $info_data{'command'} = $next_frame_data{'title'};
 230         }
 231 }
 232 else {
 233         $access = 0;
 234         if (($attachment ne '') || ($words ne '')) {
 235                 %info_data = ();
 236         }
 237         else {
 238                 %info_data = read_data_file(DATA_NOACCESS_PATH());
 239                 %info_data = merge_settings(\%default, \%info_data);
 240         }
 241 }
 242 if (
 243         ($info_data{'frame'} eq '') &&
 244         ($attachment eq '') &&
 245         ($words eq '')
 246 ) {
 247         $info_data{'frame'} = sprintf($settings{'frame'}, $frame, $info_data{'ext'});
 248 }
 249
 250 print "Content-type: text/plain; charset=UTF-8\n";
 251 if (!$access) {
 252         print "Status: 403 Forbidden\n";
 253 }
 254 print "\n";
 255 if($method eq 'HEAD') {
 256         exit;
 257 }
 258 write_data_file(
 259         \*STDOUT, \%info_data, '',
 260         0, 0, 0,
 261         '>>', 1
 262 );