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

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # /bsta/coin
   4 # chat.pl is generated from chat.1.pl.
   5 #
   6 # The coincidence interface
   7 #
   8 # Copyright (C) 2016, 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 ###PERL_LIB: use lib /botm/lib/bsta
  26 # use Encode::Locale ('decode_argv');
  27 use Encode ('encode', 'decode');
  28
  29 ###PERL_LIB: use lib /botm/lib/bsta
  30 use botm_common (
  31         'HTTP_STATUS',
  32         'read_data_file', 'write_data_file',
  33         'read_header_env',
  34         'url_query_decode', 'url_query_encode',
  35         'merge_url',
  36         'html_entity_encode_dec',
  37         'open_encoded',
  38         'http_header_status'
  39 );
  40 use bsta_lib (
  41         'STATE', 'CHAT_STATE', 'CHAT_ACTION',
  42         'fail_method', 'fail_content_type',
  43         'get_remote_addr', 'get_id', 'get_password',
  44         'print_html_start', 'print_html_end',
  45         'print_html_head_start', 'print_html_head_end',
  46         'print_html_body_start', 'print_html_body_end',
  47         'merge_settings'
  48 );
  49 use  File::Copy;
  50
  51 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  52 ###PERL_CGI_COIN_PATH:      CGI_COIN_PATH      = /bsta/coin
  53
  54 ###PERL_DATA_CHAT_PATH:     DATA_CHAT_PATH     = /botm/data/bsta/chat
  55 ###PERL_DATA_COIN_PATH:     DATA_COIN_PATH     = /botm/data/bsta/coincidence
  56 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  57 ###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
  58
  59 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
  60
  61 binmode STDIN,  ':encoding(UTF-8)';
  62 binmode STDOUT, ':encoding(UTF-8)';
  63 binmode STDERR, ':encoding(UTF-8)';
  64 # decode_argv();
  65
  66 my %http;
  67 my %cgi;
  68 my %coin;
  69 my %chat;
  70 my %settings;
  71 my %state;
  72
  73 my $time = time();
  74 srand ($time-$$);
  75
  76 my $method;
  77 my $IP;
  78 my $page;
  79 my $words = '';
  80 my $username = '';
  81 my $action = CHAT_ACTION->{'none'};
  82 my $password;
  83 my $fh;
  84 my $state;
  85 my $password_ok;
  86 my @chat_lines;
  87 my $chat_state;
  88 my $status;
  89 my $message;
  90 my $chat_id;
  91 my $last_id;
  92
  93 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  94 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  95
  96 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  97         $method = $1;
  98 }
  99 else {
 100         exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
 101 }
 102
 103 %http = read_header_env(\%ENV);
 104 %cgi = url_query_decode($ENV{'QUERY_STRING'});
 105
 106 if ($method eq 'POST') {
 107         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
 108                 my %cgi_post = url_query_decode( <STDIN> );
 109                 %cgi = merge_settings(\%cgi, \%cgi_post);
 110         }
 111         # multipart not supported
 112         else{
 113                 exit fail_content_type($method, $http{'content-type'});
 114         }
 115 }
 116
 117 $IP       = get_remote_addr();
 118 $page     = get_id(\%cgi, -1);
 119 $password = get_password(\%cgi);
 120
 121 %coin      = read_data_file(DATA_COIN_PATH());
 122 %settings  = read_data_file(DATA_SETTINGS_PATH());
 123 %state     = read_data_file(DATA_STATE_PATH());
 124
 125 $password_ok = ($password eq $settings{'password'});
 126
 127 if ($cgi{'words'} ne '') {
 128         $words = $cgi{'words'};
 129 }
 130 if ($password_ok && ($cgi{'username'} ne '')) {
 131         $username = $cgi{'username'};
 132 }
 133 foreach my $action_id ('join', 'leave', 'nopost', 'file') {
 134         if ($cgi{$action_id} ne '') {
 135                 $action = CHAT_ACTION->{$action_id};
 136                 last;
 137         }
 138 }
 139
 140 # ongoing chat
 141 if ($page < 0) {
 142         if (open_encoded($fh, "+<", DATA_CHAT_PATH())) {
 143                 if (flock($fh, 2)) {
 144                         %chat = read_data_file($fh);
 145
 146                         $chat_state = int($chat{'state'});
 147                         $chat_id    = int($chat{'id'});
 148                         $last_id    = $chat_id;
 149
 150                         if ($method ne 'POST') {
 151                                 #
 152                         }
 153
 154                         elsif (
 155                                 ($action == CHAT_ACTION->{'none'}) &&
 156                                 ($words ne '')
 157                         ) {
 158                                 if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
 159                                         $status = HTTP_STATUS->{'forbidden'};
 160                                         $message = 'Not connected.';
 161                                 }
 162                                 else {
 163                                         if ($words !~ /[\r\n]/) {
 164                                                 if ($username =~ /^[A-Za-z]*$/) {
 165                                                         $chat{'content'} .= $username.': '.$words."\n";
 166                                                         if ($chat_state < CHAT_STATE->{'active'}) {
 167                                                                 $chat_state = CHAT_STATE->{'active'};
 168                                                                 $chat{'state'} = $chat_state;
 169                                                         }
 170                                                         write_data_file($fh, \%chat);
 171                                                 }
 172                                                 else {
 173                                                         $status = HTTP_STATUS->{'bad_request'};
 174                                                         $message = 'Invalid username.';
 175                                                 }
 176                                         }
 177                                         else {
 178                                                 $status = HTTP_STATUS->{'bad_request'};
 179                                                 $message = 'Invalid text.';
 180                                         }
 181                                 }
 182                         }
 183
 184                         elsif ($action == CHAT_ACTION->{'join'}) {
 185                                 if (($chat_state > CHAT_STATE->{'disconnected'}) && !$password_ok) {
 186                                         $message = 'Already connected.';
 187                                 }
 188                                 else {
 189                                         if ($username =~ /^[A-Za-z]*$/) {
 190                                                 if ($password_ok || $words eq $coin{'server'}) {
 191                                                         $chat{'content'} .= 'join@'.$username.': '.$words."\n";
 192                                                         if ($chat_state < CHAT_STATE->{'ready'}) {
 193                                                                 $chat_state = CHAT_STATE->{'ready'};
 194                                                                 $chat{'state'} = $chat_state;
 195                                                         }
 196                                                         write_data_file($fh, \%chat);
 197                                                 }
 198                                                 elsif ($words eq '') {
 199                                                         $status = HTTP_STATUS->{'bad_request'};
 200                                                         $message = 'Server ID missing.';
 201                                                 }
 202                                                 elsif ($words !~ /^[0-9]+$/) {
 203                                                         $status = HTTP_STATUS->{'bad_request'};
 204                                                         $message = 'Invalid server ID.';
 205                                                 }
 206                                                 else {
 207                                                         $status = HTTP_STATUS->{'not_found'};
 208                                                         $message = 'No active Coincidence server with this ID.';
 209                                                 }
 210                                         }
 211                                         else {
 212                                                 $status = HTTP_STATUS->{'bad_request'};
 213                                                 $message = 'Invalid username.';
 214                                         }
 215                                 }
 216                         }
 217
 218                         elsif ($action == CHAT_ACTION->{'leave'}) {
 219                                 if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
 220                                         $message = 'Already disconnected.';
 221                                 }
 222                                 else {
 223                                         if ($username =~ /^[A-Za-z]*$/) {
 224                                                 $chat{'content'} .= 'leave@'.$username.': '.$words."\n";
 225                                                 if ($username ne '') {
 226                                                         write_data_file($fh, \%chat);
 227                                                 }
 228                                                 else {
 229                                                         my %new_chat;
 230                                                         if ($chat_state > 1) {
 231                                                                 write_data_file(DATA_CHAT_PATH.$chat_id, \%chat);
 232                                                                 $new_chat{'id'} = $chat_id+1;
 233                                                         }
 234                                                         else {
 235                                                                 $new_chat{'id'} = $chat_id;
 236                                                         }
 237                                                         $new_chat{'state'} = CHAT_STATE->{'disconnected'};
 238                                                         $new_chat{'content'} = '';
 239                                                         write_data_file($fh, \%new_chat);
 240                                                 }
 241                                         }
 242                                         else {
 243                                                 $status = HTTP_STATUS->{'bad_request'};
 244                                                 $message = 'Invalid username.';
 245                                         }
 246                                 }
 247                         }
 248
 249                         elsif (
 250                                 ($action == CHAT_ACTION->{'file'}) &&
 251                                 ($cgi{'file'} ne '') &&
 252                                 ($words ne '') &&
 253                                 $password_ok
 254                         ) {
 255                                 if ($words !~ /[\r\n]/) {
 256                                         if ($username =~ /^[A-Za-z]*$/) {
 257                                                 $chat{'content'} .= 'file@'.$username.': '.$words."\n";
 258                                                 if ($chat_state < CHAT_STATE->{'active'}) {
 259                                                         $chat_state = CHAT_STATE->{'active'};
 260                                                         $chat{'state'} = $chat_state;
 261                                                 }
 262                                                 write_data_file($fh, \%chat);
 263                                         }
 264                                         else {
 265                                                 $status = HTTP_STATUS->{'bad_request'};
 266                                                 $message = 'Invalid username.';
 267                                         }
 268                                 }
 269                                 else {
 270                                         $status = HTTP_STATUS->{'bad_request'};
 271                                         $message = 'Invalid text.';
 272                                 }
 273                         }
 274
 275                         @chat_lines = split(/\r?\n/, $chat{'content'});
 276                 }
 277                 else {
 278                         $chat_state = CHAT_STATE->{'disconnected'};
 279                         $status = HTTP_STATUS->{'internal_server_error'};
 280                         $message = 'Can\'t lock data file!';
 281                 }
 282
 283                 close($fh);
 284         }
 285         else {
 286                 $chat_state = CHAT_STATE->{'disconnected'};
 287                 $status = HTTP_STATUS->{'internal_server_error'};
 288                 $message='Can\'t open data file!';
 289         }
 290 }
 291 # old chat archive
 292 else {
 293         $chat_id = $page;
 294         %chat = read_data_file(DATA_CHAT_PATH());
 295         $last_id = int($chat{'id'});
 296         if ($chat_id < $last_id) {
 297                 %chat = read_data_file(DATA_CHAT_PATH.$page);
 298                 $chat_state = int($chat{'state'});
 299                 @chat_lines = split(/\r?\n/, $chat{'content'});
 300         }
 301 }
 302
 303 if ($status ne '') {
 304         print http_header_status($status);
 305 }
 306 print "Content-type: text/html; charset=UTF-8\n\n";
 307 if($method eq 'HEAD') {
 308         exit;
 309 }
 310
 311 if ($username eq '') {
 312         $username = $coin{'name'};
 313 }
 314
 315 my $base_url = CGI_PATH();
 316 my $coin_url = CGI_COIN_PATH();
 317 my $form_url = $coin_url;
 318 my $oldest_url = merge_url(
 319         {'path' => $coin_url},
 320         {'path' => 0}
 321 );
 322 my $older_url = merge_url(
 323         {'path' => $coin_url},
 324         {'path' => $chat_id -1}
 325 );
 326 my $newer_url = ($chat_id < ($last_id -1)) ?
 327         merge_url(
 328                 {'path' => $coin_url},
 329                 {'path' => $chat_id +1}
 330         ) : $coin_url;
 331
 332 if ($password_ok) {
 333         my $password_query = url_query_encode({'p', $settings{'password'}});
 334         $coin_url   = merge_url($coin_url  , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
 335         $oldest_url = merge_url($oldest_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
 336         $older_url  = merge_url($older_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
 337         $newer_url  = merge_url($newer_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
 338 }
 339
 340 my $abbr = abbr_name($username);
 341 my $_website_name = html_entity_encode_dec(WEBSITE_NAME() , 1);
 342 my $_server       = html_entity_encode_dec($coin    {'server'}  , 1);
 343 my $_key          = html_entity_encode_dec($coin    {'key'}     , 1);
 344 my $_password     = html_entity_encode_dec($settings{'password'}, 1);
 345 my $_cgi_username = html_entity_encode_dec($cgi     {'username'}, 1);
 346 my $_username     = html_entity_encode_dec($username  , 1);
 347 my $_abbr         = html_entity_encode_dec($abbr      , 1);
 348 my $_message      = html_entity_encode_dec($message   , 1);
 349 my $_base_url     = html_entity_encode_dec($base_url  , 1);
 350 my $_coin_url     = html_entity_encode_dec($coin_url  , 1);
 351 my $_form_url     = html_entity_encode_dec($form_url  , 1);
 352 my $_oldest_url   = html_entity_encode_dec($oldest_url, 1);
 353 my $_older_url    = html_entity_encode_dec($older_url , 1);
 354 my $_newer_url    = html_entity_encode_dec($newer_url , 1);
 355
 356 print_html_start(\*STDOUT);
 357 print_html_head_start(\*STDOUT);
 358
 359 print '  <title>Coincidence &bull; '.$_website_name.'</title>'."\n";
 360
 361 print_html_head_end(\*STDOUT);
 362 print_html_body_start(\*STDOUT);
 363
 364 print '   <div id="inst" class="ins">'."\n";
 365
 366 print '    <div id="title">'."\n";
 367 print '     <H1 id="titletext">Coincidence</H1>'."\n";
 368 print '    </div>'."\n";
 369
 370 print '    <div id="storypuzzle">'."\n";
 371 if ($page >= 0) {
 372         print '     Before: '.$chat_id."\n";
 373 }
 374 elsif ($chat_state > CHAT_STATE->{'disconnected'}) {
 375         print '     Connected to server <span class="br">'.$_server.'</span> as user <span class="ni">'.$_username.'</span> (<span class="ni">'.$_abbr.'</span>), public key <span class="br">'.$_key.'</span>.'."\n";
 376 }
 377 else{
 378         print '     Not connected.'."\n";
 379 }
 380 print '    </div>'."\n";
 381
 382 print '    <div id="command">'."\n";
 383 if ($message ne '') {
 384         print '     <span class="br">'.$_message.'</span>'."\n";
 385 }
 386 if ($page < 0) {
 387         print '     <form method="post" action="'.$_form_url.'">'."\n";
 388         if ($password_ok) {
 389                 print '      <input class="intxc" type="text" name="words">'."\n";
 390                 print '      <input class="inbt" type="submit" value="Send">'."\n";
 391                 print "      |\n";
 392                 print '      <input class="intx" type="text" name="username" value="'.$_cgi_username.'">'."\n";
 393                 print '      <input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
 394                 print '      <input class="inbt" type="submit" name="join" value="Connect">'."\n";
 395                 print '      <input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
 396                 print '      <input class="inbt" type="submit" name="file" value="Send file">'."\n";
 397                 print '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
 398         }
 399         elsif ($chat_state > CHAT_STATE->{'disconnected'}) {
 400                 print '      <input class="intxc" type="text" name="words">'."\n";
 401                 print '      <input class="inbt" type="submit" value="Send">'."\n";
 402                 print "      |\n";
 403                 print '      <input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
 404                 print '      <input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
 405         }
 406         else {
 407                 print '      <input class="intx" type="text" name="words">'."\n";
 408                 print '      <input class="inbt" type="submit" name="join" value="Connect">'."\n";
 409         }
 410         print '     </form>'."\n";
 411 }
 412 print '    </div>'."\n";
 413
 414 print '   </div>'."\n";
 415 print '   <div id="insb" class="ins">'."\n";
 416
 417 print '    <div id="chat">'."\n";
 418 if ($page < 0) {
 419         for (my $i = @chat_lines-1; $i>=0; --$i) {
 420                 print '     '.chat_line($chat_lines[$i])."<br>\n";
 421         }
 422 }
 423 else {
 424         for (my $i = 0; $i<@chat_lines; ++$i) {
 425                 print '     '.chat_line($chat_lines[$i])."<br>\n";
 426         }
 427 }
 428 print '    </div>'."\n";
 429
 430 print '    <div id="underlinks">'."\n";
 431 print '     <a href="'.$_base_url.'">BSTA</a> | <a href="'.$_coin_url.'">Once again</a>';
 432 if ($chat_id > 0) {
 433         print ' | <a href="'.$_older_url.'">Before</a>';
 434 }
 435 if ($chat_id < $last_id) {
 436         print ' | <a href="'.$_newer_url.'">Unbefore</a>';
 437 }
 438 if ($chat_id > 0) {
 439         print ' | <a href="'.$_oldest_url.'">Initially</a>';
 440 }
 441 print ' | (This interface is only a demo, a proof of concept. It is very limited. No autorefresh, no private chat, etc. For full functionality use the actual Coincidence client.)'."\n";
 442 print '    </div>'."\n";
 443
 444 print '   </div>'."\n";
 445
 446 print_html_body_end(\*STDOUT, int($state{'state'}) == STATE->{'inactive'});
 447 print_html_end(\*STDOUT);
 448
 449
 450 sub abbr_name {
 451         (my $name) = @_;
 452         my $abbr;
 453
 454         if($name !~ /^[A-Za-z]+$/) {
 455                 return '?';
 456         }
 457
 458         $abbr = uc(substr($name,0,1));
 459         $name = substr($name,1);
 460         while($name =~ m/([A-Z])/g) {
 461                 $abbr = $abbr.$1;
 462         }
 463         return $abbr;
 464 }
 465
 466 sub chat_line {
 467         (my $line) = @_;
 468
 469         if ($line =~ /^([a-z]*@)?([A-Za-z]*): (.*)$/) {
 470                 my $action = $1;
 471                 my $name = $2;
 472                 my $text = $3;
 473                 my $color;
 474                 if ($name eq '') {
 475                         $name = $coin{'name'};
 476                         $color = 'ni';
 477                 }
 478                 else {
 479                         $color = 'br';
 480                 }
 481                 $abbr = abbr_name($name);
 482
 483                 my $_name   = html_entity_encode_dec($name          , 1);
 484                 my $_abbr   = html_entity_encode_dec($abbr          , 1);
 485                 my $_text   = html_entity_encode_dec($text          , 1);
 486                 my $_server = html_entity_encode_dec($coin{'server'}, 1);
 487
 488                 if($action ne '') {
 489                         if ($action eq 'join@') {
 490                                 return "$_name ($_abbr) joined the public chat on server $_server.";
 491                         }
 492                         elsif ($action eq 'leave@') {
 493                                 return "$_name ($_abbr) left the public chat on server $_server.";
 494                         }
 495                         elsif ($action eq 'file@') {
 496                                 return "$_name ($_abbr)  sent the file $_text.";
 497                         }
 498                         else {
 499                                 return 'E:E:E';
 500                         }
 501                 }
 502                 else {
 503                         return "<span class=\"$color\">$_abbr: $_text</span>";
 504                 }
 505         }
 506         else {
 507                 return 'E:E:E';
 508         }
 509 }