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 );
  36 use bsta_lib (
  37         'TEXT_MODE',
  38         'get_password',
  39         'fail_method', 'fail_content_type',
  40         'redirect',
  41         'print_html_start', 'print_html_end',
  42         'print_html_head_start', 'print_html_head_end',
  43         'print_html_body_start', 'print_html_body_end'
  44 );
  45
  46 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  47
  48 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  49
  50 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  51 ###PERL_DATA_WORDS_PATH:    DATA_WORDS_PATH    = /botm/data/bsta/words/
  52
  53 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
  54
  55 ###PERL_COMMENT_PAGE_LENGTH:COMMENT_PAGE_LENGTH= 16
  56
  57 binmode STDIN,  ':encoding(UTF-8)';
  58 binmode STDOUT, ':encoding(UTF-8)';
  59 binmode STDERR, ':encoding(UTF-8)';
  60 # decode_argv();
  61
  62 my $time = time();
  63 srand ($time-$$);
  64
  65 my %http;
  66 my %cgi;
  67 my %settings;
  68 my %words_data;
  69 my %post_data;
  70
  71 my @post_list;
  72
  73 my $method;
  74 my $frame;
  75 my $ID;
  76 my $password;
  77 my $password_ok;
  78 my $edit = 0;
  79 my $remove = 0;
  80 my $post = 0;
  81 my $quote;
  82 my $words_data_path;
  83 my $post_data_path;
  84 my $index;
  85 my $page;
  86 my $fh;
  87 my $r;
  88
  89
  90 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  91 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  92
  93 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  94         $method = $1;
  95 }
  96 else{
  97         exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD');
  98 }
  99
 100 %http = read_header_env(\%ENV);
 101 %cgi = url_query_decode($ENV{'QUERY_STRING'});
 102
 103 if ($method eq 'POST') {
 104         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
 105                 my %cgi_post = url_query_decode( <STDIN> );
 106                 %cgi = merge_settings(\%cgi, \%cgi_post);
 107         }
 108         # multipart not supported
 109         else{
 110                 exit fail_content_type($method, $http{'content-type'});
 111         }
 112 }
 113
 114 if ($ENV{'PATH_INFO'} =~ /^\/([0-9]+)$/) {
 115         $frame = int($1);
 116 }
 117 elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
 118         $ID = $1;
 119 }
 120 if ($cgi{'f'} =~ /^.+$/) {
 121         $frame = int($&);
 122 }
 123 if ($cgi{'i'} =~ /^.+$/) {
 124         $ID = $&;
 125 }
 126 $password = get_password(\%cgi);
 127
 128 %settings   = read_data_file(DATA_SETTINGS_PATH());
 129
 130 $password_ok = ($password eq $settings{'password'});
 131
 132 if ($cgi{'post'} ne '') {
 133         $post = 1;
 134 }
 135 elsif ($cgi{'edit'} ne '') {
 136         $edit = 1;
 137         if ($ID eq '') {
 138                 $ID = $cgi{'edit'};
 139         }
 140 }
 141 elsif ($cgi{'remove'} ne '') {
 142         $remove = 1;
 143         if ($ID eq '') {
 144                 $ID = $cgi{'remove'};
 145         }
 146 }
 147 else {
 148         $edit = 1;
 149         if ($cgi{'quote'} ne '') {
 150                 $quote = $cgi{'quote'};
 151         }
 152 }
 153
 154 if ($ID ne '') {
 155         $post_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $ID);
 156         %post_data = read_data_file($post_data_path);
 157         if ($post_data{'frame'} ne '') {
 158                 $frame = int($post_data{'frame'});
 159         }
 160 }
 161
 162 if ($frame eq '') {
 163         exit output(0, '', 'Frame ID not specified.');
 164 }
 165
 166 $words_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $frame);
 167
 168 unless (open_encoded($fh, "+<:encoding(UTF-8)", $words_data_path)) {
 169         exit output(0, '500 Internal Server Error', 'Failed opening data file.');
 170 }
 171 unless (flock($fh, 2)) {
 172         exit output(0, '500 Internal Server Error', 'Failed locking data file.');
 173 }
 174
 175 %words_data = read_data_file(
 176         $fh, # file
 177         '',  # encoding
 178         0,   # no header
 179         0,   # header only
 180         1    # as list
 181 );
 182
 183 @post_list = @{$words_data{'content'}};
 184
 185 for (my $i=0; $i< scalar(@post_list); $i +=1) {
 186         if ($post_list[$i] eq $ID) {
 187                 $index = $i;
 188                 $page = int($index / COMMENT_PAGE_LENGTH());
 189                 last;
 190         }
 191 }
 192
 193 if ($remove) {
 194         unless ($index ne '') {
 195                 close($fh);
 196                 exit output(0, '404 Not Found', 'Nothing to remove.');
 197         }
 198         unless ($cgi{'key'} eq $post_data{'key'}) {
 199                 close($fh);
 200                 exit output(0, '403 Forbidden', 'Invalid request.');
 201         }
 202
 203         if (($cgi{'username'} eq '') && ($cgi{'password'} eq ''))
 204         {
 205                 close($fh);
 206                 exit output(0, '', '', 0, 1);
 207         }
 208
 209         unless ($cgi{'username'} ne '') {
 210                 close($fh);
 211                 exit output(0, '403 Forbidden', 'Missing user name.', 0, 1);
 212         }
 213         unless ($cgi{'username'} eq $post_data{'name'}) {
 214                 close($fh);
 215                 exit output(0, '403 Forbidden', 'Wrong user name.', 0, 1);
 216         }
 217         unless ($cgi{'password'} ne '') {
 218                 close($fh);
 219                 exit output(0, '403 Forbidden', 'Missing password.', 0, 1);
 220         }
 221         unless (
 222                 ($cgi{'password'} eq $post_data{'password'}) || (
 223                         ($cgi{'password'} eq $settings{'password'}) &&
 224                         $password_ok
 225                 )
 226         ) {
 227                 close($fh);
 228                 exit output(0, '403 Forbidden', 'Wrong password.', 0, 1);
 229         }
 230
 231         # all conditions fulfilled
 232
 233         splice @post_list, $index, 1;
 234         $words_data{'posts'} = scalar(@post_list);
 235         $words_data{'content'} = \@post_list;
 236
 237         $r = write_data_file($fh, '', '', \%words_data);
 238         unless($r) {
 239                 close($fh);
 240                 exit output(0, '500 Internal Server Error', 'Failed writing data file.');
 241         }
 242         $ID = 'insw';
 243         exit output(1);
 244 }
 245
 246 close($fh);
 247
 248 exit output(0, '', '???');
 249
 250 sub output {
 251         (
 252                 my $posted, my $status, my $message,
 253                 my $edit, my $remove,
 254         ) = @_;
 255
 256         if ($posted) {
 257                 my $redirect_url = merge_url(
 258                         {'path' => CGI_VIEWER_PATH()},
 259                         {
 260                                 'path' => $frame,
 261                                 'query' => {
 262                                         'b' => TEXT_MODE->{'words'},
 263                                         'i' => $page,
 264                                         'p' => ($password_ok ? $settings{'password'} : '')
 265                                 },
 266                                 'fragment' => $ID
 267                         }
 268                 );
 269                 return redirect ($method, $redirect_url, 303);
 270         }
 271
 272         print "Content-type: text/html\n";
 273         if ($status ne '') {
 274                 print 'Status: '.$status."\n";
 275         }
 276         print "\n";
 277         if ($method eq 'HEAD') {
 278                 return;
 279         }
 280
 281         my $_message = html_entity_encode_dec($message, 1);
 282         my $_story = html_entity_encode_dec($settings{'story'}, 1);
 283         my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
 284
 285         print_html_start(\*STDOUT);
 286         print_html_head_start(\*STDOUT);
 287
 288         print '  <title>Words &bull; '.$_story.' &bull; '.$_website_name.'</title>';
 289
 290         print_html_head_end(\*STDOUT);
 291         print_html_body_start(\*STDOUT);
 292
 293         print '   <div id="inst" class="ins">'."\n";
 294
 295         print '    <div id="title">'."\n";
 296         print '     <h1 id="titletext">Words</h1>'."\n";
 297         print '    </div>'."\n";
 298
 299         print '   </div>'."\n";
 300
 301         if ($message ne '') {
 302                 print '   <div id="insb" class="ins">'."\n";
 303
 304                 print '    <div id="command">'."\n";
 305                 print '     <span class="br">'.$_message.'</span>'."\n";
 306                 print '    </div>'."\n";
 307
 308                 print '   </div>'."\n";
 309         }
 310
 311         if ($edit) {
 312                 print "EDIT\n";
 313         }
 314         elsif ($remove) {
 315                 print "REMOVE\n";
 316         }
 317
 318         print_html_body_end(\*STDOUT); # , $ong_state == STATE->{'inactive'}
 319         print_html_end(\*STDOUT);
 320 }
 321
 322
 323
 324
 325
 326
 327