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