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  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 warnings;
  25 ###PERL_LIB: use lib /botm/lib/bsta
  26 use bsta_lib qw(failpage gethttpheader getcgi readdatafile bb2bb linehtml);
  27 use File::Copy;
  28
  29 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  30 ###PERL_CGI_ATTACH_PATH:    CGI_ATTACH_PATH    = /bsta/a
  31 ###PERL_CGI_FRAME_PATH:     CGI_FRAME_PATH     = /bsta/f
  32 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  33
  34 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
  35 ###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
  36 ###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
  37 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  38 ###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
  39
  40 ###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
  41
  42 my %http;
  43 my %cgi;
  44 my %framedata;
  45 my %default;
  46 my %settings;
  47 my %state;
  48
  49 my $time = time();
  50 srand ($time-$$);
  51
  52 my $method;
  53 my $frame;
  54 my $password;
  55 my $passwordOK;
  56 my $access;
  57 my $showcommand;
  58 my $ongtime;
  59 my $seconds;
  60
  61 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  62 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  63
  64 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  65         $method=$1;
  66 }
  67 else{
  68         exit failpage("Status: 405 Method Not Allowed\nAllow: GET, POST, HEAD\n","405 Method Not Allowed","The interface does not support the $ENV{'REQUEST_METHOD'} method.",$method);
  69 }
  70
  71 %http = gethttpheader (\%ENV);
  72 %cgi = getcgi($ENV{'QUERY_STRING'});
  73
  74 if ($method eq 'POST') {
  75         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
  76                 my %cgipost=getcgi( <STDIN> );
  77                 foreach my $ind (keys %cgipost) {
  78                         $cgi{$ind}=$cgipost{$ind};
  79                 }
  80         }
  81         # multipart not supported
  82         else{
  83                 exit failpage("Status: 415 Unsupported Media Type\n","415 Unsupported Media Type","Unsupported Content-type: $http{'content-type'}.");
  84         }
  85 }
  86
  87 if ($cgi{'f'} =~ /^(.+)$/) {
  88         $frame=int($1);
  89 }
  90 elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
  91         $frame=int($1);
  92 }
  93 else {
  94         $frame = 0;
  95 }
  96
  97 if ($cgi{'p'} =~ /^(.+)$/) {
  98         $password=$1;
  99 }
 100 else {
 101         $password='';
 102 }
 103
 104 %settings=readdatafile(DATA_SETTINGS_PATH);
 105 %default=readdatafile(DATA_DEFAULT_PATH);
 106 %framedata=readdatafile(DATA_PATH.$frame);
 107 %state=readdatafile(DATA_STATE_PATH);
 108 if($password eq $settings{'password'}){
 109         $passwordOK = 1;
 110 }
 111 else{
 112         $passwordOK = 0;
 113 }
 114
 115 if($frame<0) {
 116         $frame = int($state{'last'}) + $frame +1;
 117         %framedata=readdatafile(DATA_PATH.$frame);
 118 }
 119
 120 foreach my $ind (keys %default) {
 121         unless(defined($framedata{$ind})){
 122                 $framedata{$ind}=$default{$ind};
 123         }
 124 }
 125
 126 if ($passwordOK || (int($state{'state'}) >= 1 && $frame <= int($state{'last'}) && $frame >= 0)) {
 127         $access=1;
 128 }
 129 else {
 130         $access=0;
 131         %framedata = readdatafile(DATA_NOACCESS_PATH);
 132         foreach my $ind (keys %default) {
 133                 unless(defined($framedata{$ind})){
 134                         $framedata{$ind}=$default{$ind};
 135                 }
 136         }
 137 }
 138
 139 print "Content-type: text/plain\n";
 140 if(!$access) {
 141         print "Status: 403 Forbidden\n";
 142 }
 143 print "\n";
 144 if($method eq 'HEAD') {
 145         exit;
 146 }
 147
 148 print '[quote][center][size=200]'.$framedata{'title'}.'[/size]'."\n";
 149 print '[url=http://'.WEBSITE.CGI_VIEWER_PATH.'/'.$frame.'][img]http://'.WEBSITE.CGI_PATH.($access?sprintf($settings{'frame'},$frame,$framedata{'ext'}):$framedata{'frame'}).'[/img][/url][/center]'."\n";
 150 print bb2bbf($framedata{'content'}).'[/quote]'."\n";
 151
 152 sub bb2bbf {
 153         (my $bb) = @_;
 154         my $tag;
 155         my $tagvalue;
 156         my $pretext;
 157         my $posttext;
 158
 159         while($bb =~ m/(###([^#;]*);)/g) {
 160                 $tag = $1;
 161                 $tagvalue = $2;
 162                 $pretext = substr($bb,0,pos ($bb)-length($tag));
 163                 $posttext = substr ($bb,pos ($bb));
 164
 165                 if ($tagvalue =~ /^att&([0-9]+)$/) {
 166                         $tagvalue = 'http://'.WEBSITE.CGI_ATTACH_PATH.'/'.int($1);
 167                 }
 168                 elsif ($tagvalue =~ /^vw&([0-9]+)$/) {
 169                         $tagvalue = 'http://'.WEBSITE.CGI_VIEWER_PATH.'/'.int($1);
 170                 }
 171                 elsif ($tagvalue =~ /^fr&([0-9]+)$/) {
 172                         $tagvalue = 'http://'.WEBSITE.CGI_FRAME_PATH.'/'.int($1);
 173                 }
 174                 else {
 175                         $tagvalue = '';
 176                 }
 177
 178                 $bb = $pretext.$tagvalue.$posttext;
 179         }
 180
 181         return bb2bb ($bb);
 182 }