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

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # /bsta/b
   4 # bbcode.pl is generated from bbcode.1.pl.
   5 #
   6 # The bbcode 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         'HTTP_STATUS',
  31         'read_header_env',
  32         'read_data_file',
  33         'url_query_decode',
  34         'join_path',
  35         'merge_url',
  36         'http_header_status'
  37 );
  38 use bsta_lib (
  39         'STATE',
  40         'fail_method', 'fail_content_type',
  41         'get_frame', 'get_password',
  42         'merge_settings',
  43         'eval_bb', 'bb_to_bbcode'
  44 );
  45
  46 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  47
  48 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  49 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  50
  51 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
  52 ###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
  53 ###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
  54 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  55 ###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
  56
  57 ###PERL_SCHEME:             SCHEME             = http
  58 ###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
  59
  60 binmode STDIN,  ':encoding(UTF-8)';
  61 binmode STDOUT, ':encoding(UTF-8)';
  62 binmode STDERR, ':encoding(UTF-8)';
  63 # decode_argv();
  64
  65 my $time = time();
  66 srand ($time-$$);
  67
  68 my %http;
  69 my %cgi;
  70 my %frame_data;
  71 my %default;
  72 my %settings;
  73 my %state;
  74
  75 my $method;
  76 my $frame;
  77 my $password;
  78 my $password_ok;
  79 my $access;
  80 my $ongtime;
  81 my $ong_state;
  82 my $last_frame;
  83 my $frame_data_path;
  84 my $frame_file;
  85
  86 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  87 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  88
  89 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  90         $method = $1;
  91 }
  92 else{
  93         exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
  94 }
  95
  96 %http = read_header_env(\%ENV);
  97 %cgi = url_query_decode($ENV{'QUERY_STRING'});
  98
  99 if ($method eq 'POST') {
 100         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
 101                 my %cgi_post = url_query_decode( <STDIN> );
 102                 %cgi = merge_settings(\%cgi, \%cgi_post);
 103         }
 104         # multipart not supported
 105         else{
 106                 exit fail_content_type($method, $http{'content-type'});
 107         }
 108 }
 109
 110 $frame  = get_frame(\%cgi);
 111 $password = get_password(\%cgi);
 112
 113 %settings   = read_data_file(DATA_SETTINGS_PATH());
 114 %default    = read_data_file(DATA_DEFAULT_PATH());
 115 %state      = read_data_file(DATA_STATE_PATH());
 116
 117 $ong_state  = int($state{'state'});
 118 $last_frame = int($state{'last'});
 119
 120 $password_ok = ($password eq $settings{'password'});
 121
 122 if ($frame < 0) {
 123         $frame = $last_frame + $frame +1;
 124 }
 125 $frame_data_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
 126 %frame_data = read_data_file($frame_data_path);
 127 %frame_data = merge_settings(\%default, \%frame_data);
 128
 129 if (
 130         $password_ok || (
 131                 ($ong_state >= STATE->{'waiting'}) &&
 132                 ($frame <= $last_frame) &&
 133                 ($frame >= 0)
 134         )
 135 ) {
 136         $access = 1;
 137 }
 138 else {
 139         $access=0;
 140         %frame_data = read_data_file(DATA_NOACCESS_PATH());
 141         %frame_data = merge_settings(\%default, \%frame_data);
 142 }
 143 if ($frame_data{'frame'} ne '') {
 144         $frame_file = $frame_data{'frame'};
 145 }
 146 else {
 147         $frame_file = sprintf(
 148                 $settings{'frame'},
 149                 $frame, $frame_data{'ext'}
 150         );
 151 }
 152
 153 print "Content-type: text/plain; charset=UTF-8\n";
 154 if(!$access) {
 155         print http_header_status(HTTP_STATUS->{'forbidden'});
 156 }
 157 print "\n";
 158 if($method eq 'HEAD') {
 159         exit;
 160 }
 161
 162 my $viewer_url = merge_url(
 163         {'scheme' => SCHEME(), 'host' => WEBSITE()},
 164         {'path' => CGI_VIEWER_PATH()},
 165         {'path' => $frame}
 166 );
 167 my $frame_url = merge_url(
 168         {'scheme' => SCHEME(), 'host' => WEBSITE()},
 169         {'path' => CGI_PATH()},
 170         {'path' => $frame_file}
 171 );
 172 my $content = bb_to_bbcode(
 173         eval_bb(
 174                 $frame_data{'content'},
 175                 1
 176         )
 177 );
 178
 179 print '[quote][center][size=200]'.$frame_data{'title'}.'[/size]'."\n";
 180 print '[url='.$viewer_url.'][img]'.$frame_url.'[/img][/url][/center]'."\n";
 181 print $content.'[/quote]'."\n";