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