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

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # /bsta/w
   4 # opomba is generated from opomba.1.pl.
   5 #
   6 # The comment posting interface
   7 #
   8 # Copyright (C) 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', 'url_query_decode',
  31         'read_data_file', 'write_data_file',
  32         'html_entity_encode_dec',
  33         'open_encoded',
  34         'join_path',
  35         'merge_url',
  36         'make_id'
  37 );
  38 use bsta_lib (
  39         'TEXT_MODE',
  40         'get_password',
  41         'fail_method', 'fail_content_type',
  42         'redirect',
  43         'print_html_start', 'print_html_end',
  44         'print_html_head_start', 'print_html_head_end',
  45         'print_html_body_start', 'print_html_body_end',
  46         'bb_to_html', 'eval_bb',
  47         'merge_settings'
  48 );
  49
  50 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  51
  52 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  53 ###PERL_CGI_WORDS_PATH:     CGI_WORDS_PATH     = /bsta/w
  54
  55 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  56 ###PERL_DATA_WORDS_PATH:    DATA_WORDS_PATH    = /botm/data/bsta/words/
  57
  58 ###PERL_LOG_WORDS_PATH:     LOG_WORDS_PATH     = /botm/log/bsta/words.log
  59
  60 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
  61
  62 ###PERL_COMMENT_PAGE_LENGTH:COMMENT_PAGE_LENGTH= 16
  63
  64 binmode STDIN,  ':encoding(UTF-8)';
  65 binmode STDOUT, ':encoding(UTF-8)';
  66 binmode STDERR, ':encoding(UTF-8)';
  67 # decode_argv();
  68
  69 my $time = time();
  70 srand ($time-$$);
  71
  72 my %http;
  73 my %cgi;
  74 my %settings;
  75 my %words_data;
  76 my %post_data;
  77
  78 my @post_list;
  79
  80 my $method;
  81 my $frame;
  82 my $ID;
  83 my $password;
  84 my $password_ok;
  85 my $edit = 0;
  86 my $remove = 0;
  87 my $post = 0;
  88 my $quote;
  89 my $words_data_path;
  90 my $post_data_path;
  91 my $index;
  92 my $page;
  93 my $fh;
  94 my $r;
  95
  96
  97 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  98 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  99
 100 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
 101         $method = $1;
 102 }
 103 else {
 104         exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD');
 105 }
 106
 107 %http = read_header_env(\%ENV);
 108 %cgi = url_query_decode($ENV{'QUERY_STRING'});
 109
 110 if ($method eq 'POST') {
 111         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
 112                 my %cgi_post = url_query_decode( <STDIN> );
 113                 %cgi = merge_settings(\%cgi, \%cgi_post);
 114         }
 115         # multipart not supported
 116         else {
 117                 exit fail_content_type($method, $http{'content-type'});
 118         }
 119 }
 120
 121 if ($ENV{'PATH_INFO'} =~ /^\/([0-9]+)$/) {
 122         $frame = int($1);
 123 }
 124 elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
 125         $ID = $1;
 126 }
 127 if ($cgi{'f'} =~ /^.+$/) {
 128         $frame = int($&);
 129 }
 130 if ($cgi{'i'} =~ /^.+$/) {
 131         $ID = $&;
 132 }
 133 $password = get_password(\%cgi);
 134
 135 %settings   = read_data_file(DATA_SETTINGS_PATH());
 136
 137 $password_ok = ($password eq $settings{'password'});
 138
 139 if ($cgi{'post'} ne '') {
 140         $post = 1;
 141 }
 142 elsif ($cgi{'edit'} ne '') {
 143         $edit = 1;
 144         if ($ID eq '') {
 145                 $ID = $cgi{'edit'};
 146         }
 147 }
 148 elsif ($cgi{'remove'} ne '') {
 149         $remove = 1;
 150         if ($ID eq '') {
 151                 $ID = $cgi{'remove'};
 152         }
 153 }
 154 else {
 155         $edit = 1;
 156         if ($cgi{'quote'} ne '') {
 157                 $quote = $cgi{'quote'};
 158         }
 159 }
 160
 161 if ($ID ne '') {
 162         $post_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $ID);
 163         %post_data = read_data_file($post_data_path);
 164         if ($post_data{'frame'} ne '') {
 165                 $frame = int($post_data{'frame'});
 166         }
 167 }
 168
 169 if ($frame eq '') {
 170         exit output(0, '400 Bad Request', 'Frame ID not specified.');
 171 }
 172
 173 $words_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $frame);
 174
 175 unless (open_encoded($fh, "+<:encoding(UTF-8)", $words_data_path)) {
 176         unless (open_encoded($fh, "+>:encoding(UTF-8)", $words_data_path)) {
 177                 exit output(0, '500 Internal Server Error', 'Failed opening data file.', 1);
 178         }
 179 }
 180 unless (flock($fh, 2)) {
 181         exit output(0, '500 Internal Server Error', 'Failed locking data file.', 1);
 182 }
 183
 184 %words_data = read_data_file(
 185         $fh, # file
 186         '',  # encoding
 187         0,   # no header
 188         0,   # header only
 189         1    # as list
 190 );
 191
 192 @post_list = @{$words_data{'content'}};
 193
 194 for (my $i=0; $i< scalar(@post_list); $i +=1) {
 195         if ($post_list[$i] eq $ID) {
 196                 $index = $i;
 197                 $page = int($index / COMMENT_PAGE_LENGTH());
 198                 last;
 199         }
 200 }
 201
 202 if ($remove || ($ID ne '')) {
 203         unless ($index ne '') {
 204                 close($fh);
 205                 exit output(0, '404 Not Found', $remove ? 'Nothing to remove.' : 'No such message.');
 206         }
 207         unless ($cgi{'key'} eq $post_data{'key'}) {
 208                 close($fh);
 209                 exit output(0, '400 Bad Request', 'Invalid request.');
 210         }
 211 }
 212 if ($remove) {
 213         if ($cgi{'i'} eq '') { # followed a link, not confirmed yet
 214                 close($fh);
 215                 exit output(0, '', '', 1);
 216         }
 217 }
 218 else {
 219         unless ($post) { # followed a link, not confirmed yet
 220                 close($fh);
 221                 exit output(0, '', '', 1);
 222         }
 223 }
 224 if (!$remove) {
 225         unless ($cgi{'words'} ne '') {
 226                 exit output(0, '400 Bad Request', 'Where are your words?', 1);
 227         }
 228 }
 229 unless ($cgi{'username'} ne '') {
 230         close($fh);
 231         exit output(0, '400 Bad Request', 'Missing user name.', 1);
 232 }
 233 if ($remove || ($ID ne '')) {
 234         unless ($cgi{'username'} eq $post_data{'name'}) {
 235                 close($fh);
 236                 exit output(0, '403 Forbidden', 'Wrong user name.', 1);
 237         }
 238 }
 239 if ($remove || ($ID ne '')) {
 240                 unless ($cgi{'password'} ne '') {
 241                 close($fh);
 242                 exit output(0, '400 Bad Request', 'Missing password.', 1);
 243         }
 244         unless (
 245                 ($cgi{'password'} eq $post_data{'password'}) || (
 246                         ($cgi{'password'} eq $settings{'password'}) &&
 247                         $password_ok
 248                 )
 249         ) {
 250                 close($fh);
 251                 exit output(0, '403 Forbidden', 'Wrong password.', 1);
 252         }
 253         if ($password_ok) {
 254                 $cgi{'password'} = $post_data{'password'};
 255         }
 256 }
 257 unless ($cgi{'password2'} eq '') {
 258         close($fh);
 259         exit output(0, '', 'Please don\'t write anything in the place which should remain empty.', 1);
 260         # no error code to confuse spambot :)
 261 }
 262
 263 # all conditions fulfilled
 264
 265 if ($remove) {
 266         splice @post_list, $index, 1;
 267         $words_data{'posts'} = scalar(@post_list);
 268         $words_data{'content'} = \@post_list;
 269
 270         $r = write_data_file(
 271                 $fh, # file
 272                 \%words_data,
 273                 '',  # encoding
 274                 0,   # no header
 275                 0,   # header only
 276                 1    # as list
 277         );
 278         unless ($r) {
 279                 close($fh);
 280                 exit output(0, '500 Internal Server Error', 'Failed writing data file.');
 281         }
 282
 283         close ($fh);
 284
 285         if (open_encoded($fh, ">>:encoding(UTF-8)", LOG_WORDS_PATH())) {
 286                 print $fh "$time REMOVE $ID\n";
 287                 write_data_file(
 288                         $fh, \%post_data, '',
 289                         0, 0, 0,
 290                         '>>', 1
 291                 );
 292                 print $fh "\n\n";
 293                 close ($fh);
 294         }
 295
 296         $ID = 'insw';
 297         exit output(1);
 298 }
 299
 300 if ($ID eq '') {
 301         $ID = make_id($frame, 1);
 302 }
 303 if ($index eq '') {
 304         $index = scalar(@post_list);
 305         $page = int($index / COMMENT_PAGE_LENGTH());
 306         push @post_list, $ID;
 307 }
 308 $words_data{'posts'} = scalar(@post_list);
 309 $words_data{'content'} = \@post_list;
 310
 311 $post_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $ID);
 312
 313 $post_data{'frame'} = $frame;
 314 $post_data{'name'} = $cgi{'username'};
 315 $post_data{'password'} = $cgi{'password'};
 316 if ($post_data{'posttime'} eq '') {
 317         $post_data{'posttime'} = $time;
 318 }
 319 else {
 320         $post_data{'edittime'} = $time;
 321 }
 322 if ($post_data{'key'} eq '') {
 323         my $new_key = '';
 324         for (my $i=1; $i<16; $i+=1) {
 325                 $new_key .= sprintf('%02X', int(rand(0x100)));
 326         }
 327         $post_data{'key'} = $new_key;
 328 }
 329 $post_data{'content'} = $cgi{'words'};
 330
 331 $r = write_data_file($post_data_path, \%post_data);
 332 unless ($r) {
 333         close($fh);
 334         exit output(0, '500 Internal Server Error', 'Failed writing post file.', 1, 0);
 335 }
 336
 337 $r = write_data_file(
 338         $fh, # file
 339         \%words_data,
 340         '',  # encoding
 341         0,   # no header
 342         0,   # header only
 343         1    # as list
 344 );
 345 unless ($r) {
 346         close($fh);
 347         exit output(0, '500 Internal Server Error', 'Failed writing data file.', 1, 0);
 348 }
 349
 350 close($fh);
 351
 352 if (open_encoded($fh, ">>:encoding(UTF-8)", LOG_WORDS_PATH())) {
 353         print $fh "$time POST $ID\n";
 354         write_data_file(
 355                 $fh, \%post_data, '',
 356                 0, 0, 0,
 357                 '>>', 1
 358         );
 359         print $fh "\n\n";
 360         close ($fh);
 361 }
 362
 363 exit output(1);
 364
 365
 366 sub output {
 367         (my $done, my $status, my $message, my $show_content) = @_;
 368
 369
 370         my $return_url = merge_url(
 371                 {'path' => CGI_VIEWER_PATH()},
 372                 {
 373                         'path' => $frame,
 374                         'query' => {
 375                                 'b' => TEXT_MODE->{'words'},
 376                                 'i' => $page,
 377                                 'p' => ($password_ok ? $settings{'password'} : '')
 378                         },
 379                         'fragment' => $ID
 380                 }
 381         );
 382         if ($done) {
 383                 return redirect ($method, $return_url, 303);
 384         }
 385
 386         print "Content-type: text/html\n";
 387         if ($status ne '') {
 388                 print 'Status: '.$status."\n";
 389         }
 390         print "\n";
 391         if ($method eq 'HEAD') {
 392                 return;
 393         }
 394
 395         my $title;
 396         my $name;
 397         my $content;
 398
 399         if ($remove) {
 400                 $title = 'Remove message "'.$ID.'"';
 401         }
 402         elsif ($ID ne '') {
 403                 $title = 'Edit message "'.$ID.'"';
 404         }
 405         else {
 406                 $title = 'Words';
 407         }
 408
 409         if ($cgi{'username'} ne '') {
 410                 $name = $cgi{'username'}
 411         }
 412         elsif ($post_data{'name'} ne '') {
 413                 $name = $post_data{'name'}
 414         }
 415         else {
 416                 $name = '';
 417         }
 418
 419         if ($cgi{'words'} ne '') {
 420                 $content = $cgi{'words'};
 421         }
 422         elsif ($quote ne '') {
 423                 my $quote_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $quote);
 424                 my %quote_data = read_data_file($quote_data_path);
 425                 $content = '[quote="'.$quote_data{'name'}.'"]'.$quote_data{'content'}.'[/quote]';
 426         }
 427         elsif (($cgi{'edit'} ne '') || $remove) {
 428                 $content = $post_data{'content'};
 429         }
 430         else {
 431                 $content = '';
 432         }
 433
 434         my $_key = html_entity_encode_dec($post_data{'key'}, 1);
 435         my $_ID = html_entity_encode_dec($ID, 1);
 436         my $_title = html_entity_encode_dec($title, 1);
 437         my $_message = html_entity_encode_dec($message, 1);
 438         my $_password = html_entity_encode_dec($settings{'password'}, 1);
 439         my $_story = html_entity_encode_dec($settings{'story'}, 1);
 440         my $_name = html_entity_encode_dec($name, 1);
 441         my $_content = html_entity_encode_dec($content, 1);
 442         my $_empty = html_entity_encode_dec($cgi{'password2'}, 1);
 443         my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
 444         my $_post_url = html_entity_encode_dec(CGI_WORDS_PATH(), 1);
 445         my $_return_url = html_entity_encode_dec($return_url, 1);
 446
 447         print_html_start(\*STDOUT);
 448         print_html_head_start(\*STDOUT);
 449
 450         print '  <title>'.$_title.' &bull; '.$_story.' &bull; '.$_website_name.'</title>';
 451
 452         print_html_head_end(\*STDOUT);
 453         print_html_body_start(\*STDOUT);
 454
 455         print '   <div id="inst" class="ins">'."\n";
 456
 457         print '    <div id="title">'."\n";
 458         print '     <h1 id="titletext">'.$_title.'</h1>'."\n";
 459         print '    </div>'."\n";
 460
 461         print '   </div>'."\n";
 462
 463         if ($message ne '') {
 464                 print '   <div id="insb" class="ins">'."\n";
 465
 466                 print '    <div id="command">'."\n";
 467                 print '     <span class="br">'.$_message.'</span>'."\n";
 468                 print '    </div>'."\n";
 469
 470                 print '   </div>'."\n";
 471         }
 472
 473         if ($show_content) {
 474                 print '   <div id="insw" class="ins">'."\n";
 475
 476                 print '    <div class="undertext" id="words">'."\n";
 477                 print '     <form method="post" action="'.$_post_url.'">'."\n";
 478                 unless ($remove) {
 479                         print '      <b>Your words:</b>'."\n";
 480                         print '      <textarea class="inta" name="words" rows="4">'.$_content.'</textarea>'."\n";
 481                 }
 482                 print '      <table cellpadding="0" cellspacing="0" border="0"><tr>'."\n";
 483                 print '       <td><b>Your name: </b></td>'."\n";
 484                 print '       <td><input class="intx" type="text" name="username" value="'.$_name.'"></td>'."\n";
 485                 print '       <td></td>'."\n";
 486                 print '      </tr><tr>'."\n";
 487                 print '       <td><b>'.(($ID ne '') ? 'Password' : 'Optional password').': </b></td>'."\n";
 488                 print '       <td><input class="intx" type="password" name="password" value=""></td>'."\n";
 489                 print '       <td>'.(($ID ne '') ? '' : '(if you want to edit later)').'</td>'."\n";
 490                 print '      </tr><tr>'."\n";
 491                 print '       <td><b>Leave this empty: </b></td>'."\n";
 492                 print '       <td><input class="intx" type="text" name="password2" value="'.$_empty.'"></td>'."\n";
 493                 if ($remove) {
 494                         print '       <td><input class="inbt" type="submit" name="remove" value="Remove"></td>'."\n";
 495                 }
 496                 else {
 497                         print '       <td>'."\n";
 498                         print '        <input class="inbt" type="submit" name="post" value="'.(($ID ne '') ? 'Update' : 'Send').'">'."\n";
 499                         print '        <input class="inbt" type="submit" name="preview" value="Preview">'."\n";
 500                         print '       </td>'."\n";
 501                 }
 502                 print '      </tr></table>'."\n";
 503                 print '      <input type="hidden" name="f" value="'.$frame.'">'."\n";
 504                 if ($ID ne '') {
 505                         print '      <input type="hidden" name="i" value="'.$_ID.'">'."\n";
 506                 }
 507                 print '      <input type="hidden" name="key" value="'.$_key.'">'."\n";
 508                 if ($password_ok) {
 509                         print '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
 510                 }
 511                 print '     </form>'."\n";
 512                 if ($content ne ''){
 513                         print '     <br>'."\n";
 514                         print '     <div id="preview"class="opomba">'."\n";
 515                         print '      <div class="opomba_info">'."\n";
 516                         print '       Preview:'."\n";
 517                         print '      </div>'."\n";
 518                         print '      <div class="opomba_text">'."\n";
 519                   print bb_to_html(eval_bb($content, 0))."\n";
 520                         print '      </div>'."\n";
 521                         print '     </div>'."\n";
 522                 }
 523                 print '    </div>'."\n";
 524                 print '    <div id="underlinks">'."\n";
 525                 print '     <a href="'.$_return_url.'">Return</a>'."\n";
 526                 print '    </div>'."\n";
 527
 528                 print '   </div>'."\n";
 529         }
 530
 531         print_html_body_end(\*STDOUT); # , $ong_state == STATE->{'inactive'}
 532         print_html_end(\*STDOUT);
 533 }