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