1 ###RUN_PERL: #!/usr/bin/perl
4 # chat.pl is generated from chat.1.pl.
6 # The coincidence interface
8 # Copyright (C) 2016, 2017, 2023, 2024 Balthasar SzczepaĆski
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.
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.
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/>.
25 ###PERL_LIB: use lib /botm/lib/bsta
26 # use Encode::Locale ('decode_argv');
27 use Encode ('encode', 'decode');
29 ###PERL_LIB: use lib /botm/lib/bsta
32 'read_data_file', 'write_data_file',
34 'url_query_decode', 'url_query_encode',
36 'html_entity_encode_dec',
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',
51 ###PERL_CGI_PATH: CGI_PATH = /bsta/
52 ###PERL_CGI_COIN_PATH: CGI_COIN_PATH = /bsta/coin
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
59 ###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
61 binmode STDIN, ':encoding(UTF-8)';
62 binmode STDOUT, ':encoding(UTF-8)';
63 binmode STDERR, ':encoding(UTF-8)';
81 my $action = CHAT_ACTION->{'none'};
93 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
94 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
96 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
100 exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
103 %http = read_header_env(\%ENV);
104 %cgi = url_query_decode($ENV{'QUERY_STRING'});
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);
111 # multipart not supported
113 exit fail_content_type($method, $http{'content-type'});
117 $IP = get_remote_addr();
118 $page = get_id(\%cgi, -1);
119 $password = get_password(\%cgi);
121 %coin = read_data_file(DATA_COIN_PATH());
122 %settings = read_data_file(DATA_SETTINGS_PATH());
123 %state = read_data_file(DATA_STATE_PATH());
125 $password_ok = ($password eq $settings{'password'});
127 if ($cgi{'words'} ne '') {
128 $words = $cgi{'words'};
130 if ($password_ok && ($cgi{'username'} ne '')) {
131 $username = $cgi{'username'};
133 foreach my $action_id ('join', 'leave', 'nopost', 'file') {
134 if ($cgi{$action_id} ne '') {
135 $action = CHAT_ACTION->{$action_id};
142 if (open_encoded($fh, "+<", DATA_CHAT_PATH())) {
144 %chat = read_data_file($fh);
146 $chat_state = int($chat{'state'});
147 $chat_id = int($chat{'id'});
150 if ($method ne 'POST') {
155 ($action == CHAT_ACTION->{'none'}) &&
158 if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
159 $status = HTTP_STATUS->{'forbidden'};
160 $message = 'Not connected.';
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;
170 write_data_file($fh, \%chat);
173 $status = HTTP_STATUS->{'bad_request'};
174 $message = 'Invalid username.';
178 $status = HTTP_STATUS->{'bad_request'};
179 $message = 'Invalid text.';
184 elsif ($action == CHAT_ACTION->{'join'}) {
185 if (($chat_state > CHAT_STATE->{'disconnected'}) && !$password_ok) {
186 $message = 'Already connected.';
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;
196 write_data_file($fh, \%chat);
198 elsif ($words eq '') {
199 $status = HTTP_STATUS->{'bad_request'};
200 $message = 'Server ID missing.';
202 elsif ($words !~ /^[0-9]+$/) {
203 $status = HTTP_STATUS->{'bad_request'};
204 $message = 'Invalid server ID.';
207 $status = HTTP_STATUS->{'not_found'};
208 $message = 'No active Coincidence server with this ID.';
212 $status = HTTP_STATUS->{'bad_request'};
213 $message = 'Invalid username.';
218 elsif ($action == CHAT_ACTION->{'leave'}) {
219 if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
220 $message = 'Already disconnected.';
223 if ($username =~ /^[A-Za-z]*$/) {
224 $chat{'content'} .= 'leave@'.$username.': '.$words."\n";
225 if ($username ne '') {
226 write_data_file($fh, \%chat);
230 if ($chat_state > 1) {
231 write_data_file(DATA_CHAT_PATH.$chat_id, \%chat);
232 $new_chat{'id'} = $chat_id+1;
235 $new_chat{'id'} = $chat_id;
237 $new_chat{'state'} = CHAT_STATE->{'disconnected'};
238 $new_chat{'content'} = '';
239 write_data_file($fh, \%new_chat);
243 $status = HTTP_STATUS->{'bad_request'};
244 $message = 'Invalid username.';
250 ($action == CHAT_ACTION->{'file'}) &&
251 ($cgi{'file'} ne '') &&
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;
262 write_data_file($fh, \%chat);
265 $status = HTTP_STATUS->{'bad_request'};
266 $message = 'Invalid username.';
270 $status = HTTP_STATUS->{'bad_request'};
271 $message = 'Invalid text.';
275 @chat_lines = split(/\r?\n/, $chat{'content'});
278 $chat_state = CHAT_STATE->{'disconnected'};
279 $status = HTTP_STATUS->{'internal_server_error'};
280 $message = 'Can\'t lock data file!';
286 $chat_state = CHAT_STATE->{'disconnected'};
287 $status = HTTP_STATUS->{'internal_server_error'};
288 $message='Can\'t open data file!';
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'});
304 print http_header_status($status);
306 print "Content-type: text/html; charset=UTF-8\n\n";
307 if($method eq 'HEAD') {
311 if ($username eq '') {
312 $username = $coin{'name'};
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},
322 my $older_url = merge_url(
323 {'path' => $coin_url},
324 {'path' => $chat_id -1}
326 my $newer_url = ($chat_id < ($last_id -1)) ?
328 {'path' => $coin_url},
329 {'path' => $chat_id +1}
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});
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);
356 print_html_start(\*STDOUT);
357 print_html_head_start(\*STDOUT);
359 print ' <title>Coincidence • '.$_website_name.'</title>'."\n";
361 print_html_head_end(\*STDOUT);
362 print_html_body_start(\*STDOUT);
364 print ' <div id="inst" class="ins">'."\n";
366 print ' <div id="title">'."\n";
367 print ' <H1 id="titletext">Coincidence</H1>'."\n";
368 print ' </div>'."\n";
370 print ' <div id="storypuzzle">'."\n";
372 print ' Before: '.$chat_id."\n";
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";
378 print ' Not connected.'."\n";
380 print ' </div>'."\n";
382 print ' <div id="command">'."\n";
383 if ($message ne '') {
384 print ' <span class="br">'.$_message.'</span>'."\n";
387 print ' <form method="post" action="'.$_form_url.'">'."\n";
389 print ' <input class="intxc" type="text" name="words">'."\n";
390 print ' <input class="inbt" type="submit" value="Send">'."\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";
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";
403 print ' <input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
404 print ' <input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
407 print ' <input class="intx" type="text" name="words">'."\n";
408 print ' <input class="inbt" type="submit" name="join" value="Connect">'."\n";
410 print ' </form>'."\n";
412 print ' </div>'."\n";
414 print ' </div>'."\n";
415 print ' <div id="insb" class="ins">'."\n";
417 print ' <div id="chat">'."\n";
419 for (my $i = @chat_lines-1; $i>=0; --$i) {
420 print ' '.chat_line($chat_lines[$i])."<br>\n";
424 for (my $i = 0; $i<@chat_lines; ++$i) {
425 print ' '.chat_line($chat_lines[$i])."<br>\n";
428 print ' </div>'."\n";
430 print ' <div id="underlinks">'."\n";
431 print ' <a href="'.$_base_url.'">BSTA</a> | <a href="'.$_coin_url.'">Once again</a>';
433 print ' | <a href="'.$_older_url.'">Before</a>';
435 if ($chat_id < $last_id) {
436 print ' | <a href="'.$_newer_url.'">Unbefore</a>';
439 print ' | <a href="'.$_oldest_url.'">Initially</a>';
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";
444 print ' </div>'."\n";
446 print_html_body_end(\*STDOUT, int($state{'state'}) == STATE->{'inactive'});
447 print_html_end(\*STDOUT);
454 if($name !~ /^[A-Za-z]+$/) {
458 $abbr = uc(substr($name,0,1));
459 $name = substr($name,1);
460 while($name =~ m/([A-Z])/g) {
469 if ($line =~ /^([a-z]*@)?([A-Za-z]*): (.*)$/) {
475 $name = $coin{'name'};
481 $abbr = abbr_name($name);
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);
489 if ($action eq 'join@') {
490 return "$_name ($_abbr) joined the public chat on server $_server.";
492 elsif ($action eq 'leave@') {
493 return "$_name ($_abbr) left the public chat on server $_server.";
495 elsif ($action eq 'file@') {
496 return "$_name ($_abbr) sent the file $_text.";
503 return "<span class=\"$color\">$_abbr: $_text</span>";