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