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 warnings;
  25 ###PERL_LIB: use lib /botm/lib/bsta
  26 use bsta_lib qw(failpage gethttpheader getcgi entityencode readdatafile writedatafile urlencode);
  27 use  File::Copy;
  28
  29 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  30 ###PERL_CGI_COIN_PATH:      CGI_COIN_PATH      = /bsta/coin
  31 ###PERL_CGI_CSS_PATH:       CGI_CSS_PATH       = /bsta/bsta.css
  32 ###PERL_CGI_LOGO_PATH:      CGI_LOGO_PATH      = /bsta/botmlogo.png
  33
  34 ###PERL_DATA_CHAT_PATH:     DATA_CHAT_PATH     = /botm/data/bsta/chat
  35 ###PERL_DATA_COIN_PATH:     DATA_COIN_PATH     = /botm/data/bsta/coincidence
  36
  37 ###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
  38 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
  39 ###PERL_FAVICON_PATH:       FAVICON_PATH       = /img/favicon.png
  40
  41 my %http;
  42 my %cgi;
  43 my %coin;
  44 my %chat;
  45
  46 my $time = time();
  47 srand ($time-$$);
  48
  49 my $method;
  50 my $IP;
  51 my $page;
  52 my $words;
  53 my $username;
  54 my $action;
  55 my $password;
  56 my $chatfile;
  57 my $state;
  58 my $passwordOK;
  59 my @chatlines;
  60 my $chatstate;
  61 my $message;
  62 my $chatid;
  63 my $lastid;
  64
  65 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  66 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  67
  68 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  69         $method=$1;
  70 }
  71 else{
  72         exit failpage("Status: 405 Method Not Allowed\nAllow: GET, POST, HEAD\n","405 Method Not Allowed","The interface does not support the $ENV{'REQUEST_METHOD'} method.",$method);
  73 }
  74
  75 %http = gethttpheader (\%ENV);
  76 %cgi = getcgi($ENV{'QUERY_STRING'});
  77
  78 if ($method eq 'POST') {
  79         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
  80                 my %cgipost=getcgi( <STDIN> );
  81                 foreach my $ind (keys %cgipost) {
  82                         $cgi{$ind}=$cgipost{$ind};
  83                 }
  84         }
  85         # multipart not supported
  86         else{
  87                 exit failpage("Status: 415 Unsupported Media Type\n","415 Unsupported Media Type","Unsupported Content-type: $http{'content-type'}.");
  88         }
  89 }
  90
  91 if ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
  92         $page=int($1);
  93 }
  94 else {
  95         $page=-1;
  96 }
  97
  98 if ($ENV{'REMOTE_ADDR'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) {
  99         $IP=$1;
 100 }
 101 else {
 102         $IP='0.0.0.0';
 103 }
 104
 105 if ($cgi{'words'} ne '') {
 106         $words=$cgi{'words'};
 107 }
 108 if ($cgi{'username'} ne '') {
 109         $username=$cgi{'username'};
 110 }
 111 if ($cgi{'join'} ne '') {
 112         $action=1;
 113 }
 114 elsif ($cgi{'leave'} ne '') {
 115         $action=2;
 116 }
 117 elsif ($cgi{'nopost'} ne '') {
 118         $action=3;
 119 }
 120 elsif ($cgi{'file'} ne '') {
 121         $action=4;
 122 }
 123 else {
 124         $action=0;
 125 }
 126 if ($cgi{'p'} ne '') {
 127         $password=$cgi{'p'};
 128 }
 129
 130 %coin=readdatafile(DATA_COIN_PATH);
 131
 132 if($password eq $coin{'password'}){
 133         $passwordOK = 1;
 134 }
 135 else{
 136         $passwordOK = 0;
 137         $username = '';
 138 }
 139
 140 if($page < 0) {
 141         if (open ($chatfile,"+<",DATA_CHAT_PATH)){
 142                 if (flock($chatfile,2)) {
 143                         %chat=readdatafile($chatfile);
 144
 145                         $chatstate=int($chat{'state'});
 146                         $chatid=int($chat{'id'});
 147                         $lastid=$chatid;
 148
 149                         if($action==0 && $cgi{'words'} ne '') {
 150                                 if($chatstate < 1 && !$passwordOK) {
 151                                         $message = 'Not connected.';
 152                                 }
 153                                 else {
 154                                         if ($cgi{'words'} !~ /[\r\n]/) {
 155                                                 if($username =~ /^[A-Za-z]*$/) {
 156                                                         $chat{'content'}=$chat{'content'}.$username.': '.$cgi{'words'}."\n";
 157                                                         if($chatstate < 2) {
 158                                                                 $chat{'state'} = 2;
 159                                                                 $chatstate = 2;
 160                                                         }
 161                                                         writedatafile($chatfile,%chat);
 162                                                 }
 163                                                 else {
 164                                                         $message='Invalid username.';
 165                                                 }
 166                                         }
 167                                         else {
 168                                                 $message='Invalid text.';
 169                                         }
 170                                 }
 171                         }
 172                         elsif ($action==1) {
 173                                 if($chatstate > 0 && !$passwordOK) {
 174                                         $message = 'Already connected.';
 175                                 }
 176                                 else {
 177                                         if($username =~ /^[A-Za-z]*$/) {
 178                                                 if ($passwordOK || $cgi{'words'} eq $coin{'server'}) {
 179                                                         $chat{'content'}=$chat{'content'}.'join@'.$username.': '.$cgi{'words'}."\n";
 180                                                         if($chatstate < 1) {
 181                                                                 $chat{'state'} = 1;
 182                                                                 $chatstate = 1;
 183                                                         }
 184                                                         writedatafile($chatfile,%chat);
 185                                                 }
 186                                                 elsif ($cgi{'words'} eq '') {
 187                                                         $message='Server ID missing.';
 188                                                 }
 189                                                 elsif ($cgi{'words'} !~ /^[0-9]+$/) {
 190                                                         $message='Invalid server ID.';
 191                                                 }
 192                                                 else {
 193                                                         $message='No active Coincidence server with this ID.';
 194                                                 }
 195                                         }
 196                                         else {
 197                                                 $message = 'Invalid username.';
 198                                         }
 199                                 }
 200                         }
 201                         elsif ($action==2) {
 202                                 if($chatstate < 1 && !$passwordOK) {
 203                                         $message = 'Already disconnected.';
 204                                 }
 205                                 else {
 206                                         if($username =~ /^[A-Za-z]*$/) {
 207                                                 $chat{'content'}=$chat{'content'}.'leave@'.$username.': '.$cgi{'words'}."\n";
 208                                                 if($username ne '') {
 209                                                         writedatafile($chatfile,%chat);
 210                                                 }
 211                                                 elsif ($chatstate > 1) {
 212                                                         writedatafile(DATA_CHAT_PATH.$chatid,%chat);
 213                                                         my %newchat;
 214                                                         $newchat{'id'}=$chatid+1;
 215                                                         $newchat{'state'}=0;
 216                                                         $newchat{'content'}='';
 217                                                         writedatafile($chatfile,%newchat);
 218                                                 }
 219                                                 else {
 220                                                         my %newchat;
 221                                                         $newchat{'id'}=$chatid;
 222                                                         $newchat{'state'}=0;
 223                                                         $newchat{'content'}='';
 224                                                         writedatafile($chatfile,%newchat);
 225                                                 }
 226                                         }
 227                                         else {
 228                                                 $message = 'Invalid username.';
 229                                         }
 230                                 }
 231                         }
 232                         elsif($action==4 && $cgi{'file'} ne '' && $cgi{'words'} ne '' &&  $passwordOK) {
 233                                 if ($cgi{'words'} !~ /[\r\n]/) {
 234                                         if($username =~ /^[A-Za-z]*$/) {
 235                                                 $chat{'content'}=$chat{'content'}.'file@'.$username.': '.$cgi{'words'}."\n";
 236                                                 if($chatstate < 2) {
 237                                                         $chat{'state'} = 2;
 238                                                         $chatstate = 2;
 239                                                 }
 240                                                 writedatafile($chatfile,%chat);
 241                                         }
 242                                         else {
 243                                                 $message='Invalid username.';
 244                                         }
 245                                 }
 246                                 else {
 247                                         $message='Invalid text.';
 248                                 }
 249                         }
 250
 251                         @chatlines = split(/\r?\n/,$chat{'content'});
 252                 }
 253                 else{
 254                         $chatstate=0;
 255                         $message='Can\'t lock data file!';
 256                 }
 257
 258
 259                 close($chatfile);
 260         }
 261         else {
 262                 $chatstate=0;
 263                 $message='Can\'t open data file!';
 264         }
 265 }
 266 else {
 267         # %chat=readdatafile(DATA_CHAT_PATH);
 268         # $chatid=int($chat{'id'})-$page;
 269         %chat=readdatafile(DATA_CHAT_PATH);
 270         $lastid=int($chat{'id'});
 271         %chat=readdatafile(DATA_CHAT_PATH.$page);
 272         $chatid=int($chat{'id'});
 273         $chatstate=int($chat{'state'});
 274         @chatlines = split(/\r?\n/,$chat{'content'});
 275 }
 276
 277
 278 # print "Content-type: text/plain\n\n";
 279 # print DATA_CHAT_PATH."\n";
 280 # print 'state: '.$chat{'state'}."\n";
 281 # print 'id: '.$chat{'id'}."\n\n";
 282 # print $chat{'content'};
 283
 284 print "Content-type: text/html\n\n";
 285 if($method eq 'HEAD') {
 286         exit;
 287 }
 288
 289 print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 290 print '<html lang="en"><head>'."\n";
 291 print '<title>Coincidence &bull; '.WEBSITE_NAME.'</title>'."\n";
 292 print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 293 print '<link rel="icon" type="image/png" href="'.FAVICON_PATH.'">'."\n";
 294 print '<link rel="stylesheet" href="'.CGI_CSS_PATH.'">'."\n";
 295 print '</head><body>'."\n";
 296 print '<a href="/"><img id="botmlogo" src="'.CGI_LOGO_PATH.'" alt="'.WEBSITE.'"></a>'."\n";
 297 print '<div id="all">'."\n";
 298
 299 print '<div id="inst" class="ins">'."\n";
 300
 301 print '<div id="title">'."\n";
 302 print '<H1 id="titletext">Coincidence</H1>'."\n";
 303 print '</div>'."\n";
 304
 305 print '<div id="storypuzzle">'."\n";
 306 if ($page >= 0) {
 307         print 'Before: '.$chatid."\n";
 308 }
 309 elsif ($chatstate>0){
 310         print 'Connected to server <span class="br">'.entityencode($coin{'server'}).'</span> as user <span class="ni">'.entityencode(($username ne '')?$username:$coin{'name'}).'</span> (<span class="ni">'.entityencode(abbrname(($username ne '')?$username:$coin{'name'})).'</span>), public key <span class="br">'.entityencode($coin{'key'}).'</span>.'."\n";
 311 }
 312 else{
 313         print 'Not connected.';
 314 }
 315 print '</div>'."\n";
 316 print '<div id="command">'."\n";
 317 if ($message ne '') {
 318         print '<span class="br">'.entityencode($message).'</span>'."\n";
 319 }
 320 if ($page < 0) {
 321         print '<form method="post" action="'.CGI_COIN_PATH.'">'."\n";
 322         if ($passwordOK) {
 323                 print '<input class="intxc" type="text" name="words">'."\n";
 324                 print '<input class="inbt" type="submit" value="Send">'."\n";
 325                 print "|\n";
 326                 print '<input class="intx" type="text" name="username" value="'.entityencode($username).'">'."\n";
 327                 print '<input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
 328                 print '<input class="inbt" type="submit" name="join" value="Connect">'."\n";
 329                 print '<input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
 330                 print '<input class="inbt" type="submit" name="file" value="Send file">'."\n";
 331                 print '<input type="hidden" name="p" value="'.entityencode($coin{'password'}).'">'."\n";
 332         }
 333         elsif ($chatstate>0) {
 334                 print '<input class="intxc" type="text" name="words">'."\n";
 335                 print '<input class="inbt" type="submit" value="Send">'."\n";
 336                 print "|\n";
 337                 print '<input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
 338                 print '<input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
 339         }
 340         else {
 341                 print '<input class="intx" type="text" name="words">'."\n";
 342                 print '<input class="inbt" type="submit" name="join" value="Connect">'."\n";
 343         }
 344         print '</form>'."\n";
 345 }
 346 print '</div>'."\n";
 347
 348 print '</div><div id="insb" class="ins">'."\n";
 349
 350 print '<div id="chat">'."\n";
 351 if ($page < 0) {
 352         for (my $i = @chatlines-1; $i>=0; --$i) {
 353                 print chatline($chatlines[$i])."<br>\n";
 354         }
 355 }
 356 else {
 357         for (my $i = 0; $i<@chatlines; ++$i) {
 358                 print chatline($chatlines[$i])."<br>\n";
 359         }
 360 }
 361 print '</div>'."\n";
 362
 363 print '<div id="underlinks">'."\n";
 364 print '<a href="'.CGI_PATH.'">BSTA</a> | <a href="'.CGI_COIN_PATH.($passwordOK?('?p='.urlencode($coin{'password'})):'').'">Once again</a>';
 365 if ($chatid > 0) {
 366         print ' | <a href="'.CGI_COIN_PATH.'/'.($chatid-1).($passwordOK?('?p='.urlencode($coin{'password'})):'').'">Before</a>';
 367 }
 368 if ($chatid < $lastid) {
 369         print ' | <a href="'.CGI_COIN_PATH.'/'.(($chatid < $lastid-1)?($chatid +1):'').($passwordOK?('?p='.urlencode($coin{'password'})):'').'">Unbefore</a>';
 370 }
 371 if ($chatid > 0) {
 372         print ' | <a href="'.CGI_COIN_PATH.'/0'.($passwordOK?('?p='.urlencode($coin{'password'})):'').'">Initially</a>';
 373 }
 374 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";
 375 print "\n";
 376 print '</div>'."\n";
 377
 378 print '</div>'."\n";
 379 print '</div>'."\n";
 380 print '<a href="/" class="cz">'.WEBSITE.'</a>'."\n";
 381 print '</body></html>'."\n";
 382
 383
 384
 385 # print DATA_CHAT_PATH."\n";
 386 # print 'state: '.$chat{'state'}."\n";
 387 # print 'id: '.$chat{'id'}."\n\n";
 388 # print $chat{'content'};
 389
 390 sub abbrname {
 391         (my $name) = @_;
 392         my $abbr;
 393
 394         if($name !~ /^[A-Za-z]+$/) {
 395                 return '?';
 396         }
 397
 398         $abbr = uc(substr($name,0,1));
 399         $name = substr($name,1);
 400         while($name =~ m/([A-Z])/g) {
 401                 $abbr = $abbr.$1;
 402         }
 403         return $abbr;
 404 }
 405
 406 sub chatline {
 407         (my $line) = @_;
 408         my $action;
 409         my $name;
 410         my $text;
 411
 412         if ($line =~ /^([a-z]*@)?([A-Za-z]*): (.*)$/) {
 413                 $action=$1;
 414                 $name=$2;
 415                 $text=$3;
 416
 417                 if($action ne ''){
 418                         if ($action eq 'join@') {
 419                                 return entityencode(($name ne '')?$name:$coin{'name'}).' ('.entityencode(abbrname(($name ne '')?$name:$coin{'name'})).') joined the public chat on server '.entityencode($coin{'server'}).'.';
 420                         }
 421                         elsif ($action eq 'leave@') {
 422                                 return entityencode(($name ne '')?$name:$coin{'name'}).' ('.entityencode(abbrname(($name ne '')?$name:$coin{'name'})).') left the public chat on server '.entityencode($coin{'server'}).'.';
 423                         }
 424                         elsif ($action eq 'file@') {
 425                                 return entityencode(($name ne '')?$name:$coin{'name'}).' ('.entityencode(abbrname(($name ne '')?$name:$coin{'name'})).') sent the file '.entityencode($text).'.';
 426                         }
 427                         else {
 428                                 return 'E:E:E';
 429                         }
 430                 }
 431                 else {
 432                         return '<span class="'.(($name ne '')?'br':'ni').'">'.entityencode(abbrname(($name ne '')?$name:$coin{'name'})).': '.entityencode($text).'</span>';
 433                 }
 434         }
 435         else {
 436                 return 'E:E:E';
 437         }
 438 }