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 'fail_method', 'fail_content_type',
34 'url_query_decode', 'url_query_encode',
36 'html_entity_encode_dec',
41 'STATE', 'CHAT_STATE', 'CHAT_ACTION',
42 'get_remote_addr', 'get_id', 'get_password',
43 'print_html_start', 'print_html_end',
44 'print_html_head_start', 'print_html_head_end',
45 'print_html_body_start', 'print_html_body_end',
47 'read_chat', 'write_chat',
48 'read_coincidence', 'read_settings', 'read_state'
52 ###PERL_CGI_PATH: CGI_PATH = /bsta/
53 ###PERL_CGI_COIN_PATH: CGI_COIN_PATH = /bsta/coin
55 ###PERL_DATA_CHAT_PATH: DATA_CHAT_PATH = /botm/data/bsta/chat
57 ###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
59 binmode STDIN, ':encoding(UTF-8)';
60 binmode STDOUT, ':encoding(UTF-8)';
61 binmode STDERR, ':encoding(UTF-8)';
79 my $action = CHAT_ACTION->{'none'};
91 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
92 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
94 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
98 exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
101 %http = read_header_env(\%ENV);
102 %cgi = url_query_decode($ENV{'QUERY_STRING'});
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);
109 # multipart not supported
111 exit fail_content_type($method, $http{'content-type'});
115 $IP = get_remote_addr();
116 $page = get_id(\%cgi, -1);
117 $password = get_password(\%cgi);
119 %coin = read_coincidence();
120 %settings = read_settings();
121 %state = read_state();
123 $password_ok = ($password eq $settings{'password'});
125 if ($cgi{'words'} ne '') {
126 $words = $cgi{'words'};
128 if ($password_ok && ($cgi{'username'} ne '')) {
129 $username = $cgi{'username'};
131 foreach my $action_id ('join', 'leave', 'nopost', 'file') {
132 if ($cgi{$action_id} ne '') {
133 $action = CHAT_ACTION->{$action_id};
140 if (open_encoded($fh, "+<", DATA_CHAT_PATH())) {
142 %chat = read_chat($fh);
144 $chat_state = int($chat{'state'});
145 $chat_id = int($chat{'id'});
148 if ($method ne 'POST') {
153 ($action == CHAT_ACTION->{'none'}) &&
156 if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
157 $status = HTTP_STATUS->{'forbidden'};
158 $message = 'Not connected.';
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;
168 write_chat($fh, \%chat);
171 $status = HTTP_STATUS->{'bad_request'};
172 $message = 'Invalid username.';
176 $status = HTTP_STATUS->{'bad_request'};
177 $message = 'Invalid text.';
182 elsif ($action == CHAT_ACTION->{'join'}) {
183 if (($chat_state > CHAT_STATE->{'disconnected'}) && !$password_ok) {
184 $message = 'Already connected.';
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;
194 write_chat($fh, \%chat);
196 elsif ($words eq '') {
197 $status = HTTP_STATUS->{'bad_request'};
198 $message = 'Server ID missing.';
200 elsif ($words !~ /^[0-9]+$/) {
201 $status = HTTP_STATUS->{'bad_request'};
202 $message = 'Invalid server ID.';
205 $status = HTTP_STATUS->{'not_found'};
206 $message = 'No active Coincidence server with this ID.';
210 $status = HTTP_STATUS->{'bad_request'};
211 $message = 'Invalid username.';
216 elsif ($action == CHAT_ACTION->{'leave'}) {
217 if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) {
218 $message = 'Already disconnected.';
221 if ($username =~ /^[A-Za-z]*$/) {
222 $chat{'content'} .= 'leave@'.$username.': '.$words."\n";
223 if ($username ne '') {
224 write_chat($fh, \%chat);
228 if ($chat_state > 1) {
229 write_chat($chat_id, \%chat);
230 $new_chat{'id'} = $chat_id+1;
233 $new_chat{'id'} = $chat_id;
235 $new_chat{'state'} = CHAT_STATE->{'disconnected'};
236 $new_chat{'content'} = '';
237 write_chat($fh, \%new_chat);
241 $status = HTTP_STATUS->{'bad_request'};
242 $message = 'Invalid username.';
248 ($action == CHAT_ACTION->{'file'}) &&
249 ($cgi{'file'} ne '') &&
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;
260 write_chat($fh, \%chat);
263 $status = HTTP_STATUS->{'bad_request'};
264 $message = 'Invalid username.';
268 $status = HTTP_STATUS->{'bad_request'};
269 $message = 'Invalid text.';
273 @chat_lines = split(/\r?\n/, $chat{'content'});
276 $chat_state = CHAT_STATE->{'disconnected'};
277 $status = HTTP_STATUS->{'internal_server_error'};
278 $message = 'Can\'t lock data file!';
284 $chat_state = CHAT_STATE->{'disconnected'};
285 $status = HTTP_STATUS->{'internal_server_error'};
286 $message='Can\'t open data file!';
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'});
302 print http_header_status($status);
304 print "Content-type: text/html; charset=UTF-8\n\n";
305 if($method eq 'HEAD') {
309 if ($username eq '') {
310 $username = $coin{'name'};
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},
320 my $older_url = merge_url(
321 {'path' => $coin_url},
322 {'path' => $chat_id -1}
324 my $newer_url = ($chat_id < ($last_id -1)) ?
326 {'path' => $coin_url},
327 {'path' => $chat_id +1}
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});
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);
354 print_html_start(\*STDOUT);
355 print_html_head_start(\*STDOUT);
357 print ' <title>Coincidence • '.$_website_name.'</title>'."\n";
359 print_html_head_end(\*STDOUT);
360 print_html_body_start(\*STDOUT);
362 print ' <div id="inst" class="ins">'."\n";
364 print ' <div id="title">'."\n";
365 print ' <H1 id="titletext">Coincidence</H1>'."\n";
366 print ' </div>'."\n";
368 print ' <div id="storypuzzle">'."\n";
370 print ' Before: '.$chat_id."\n";
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";
376 print ' Not connected.'."\n";
378 print ' </div>'."\n";
380 print ' <div id="command">'."\n";
381 if ($message ne '') {
382 print ' <span class="br">'.$_message.'</span>'."\n";
385 print ' <form method="post" action="'.$_form_url.'">'."\n";
387 print ' <input class="intxc" type="text" name="words">'."\n";
388 print ' <input class="inbt" type="submit" value="Send">'."\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";
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";
401 print ' <input class="inbt" type="submit" name="nopost" value="Refresh">'."\n";
402 print ' <input class="inbt" type="submit" name="leave" value="Disconnect">'."\n";
405 print ' <input class="intx" type="text" name="words">'."\n";
406 print ' <input class="inbt" type="submit" name="join" value="Connect">'."\n";
408 print ' </form>'."\n";
410 print ' </div>'."\n";
412 print ' </div>'."\n";
413 print ' <div id="insb" class="ins">'."\n";
415 print ' <div id="chat">'."\n";
417 for (my $i = @chat_lines-1; $i>=0; --$i) {
418 print ' '.chat_line($chat_lines[$i])."<br>\n";
422 for (my $i = 0; $i<@chat_lines; ++$i) {
423 print ' '.chat_line($chat_lines[$i])."<br>\n";
426 print ' </div>'."\n";
428 print ' <div id="underlinks">'."\n";
429 print ' <a href="'.$_base_url.'">BSTA</a> | <a href="'.$_coin_url.'">Once again</a>';
431 print ' | <a href="'.$_older_url.'">Before</a>';
433 if ($chat_id < $last_id) {
434 print ' | <a href="'.$_newer_url.'">Unbefore</a>';
437 print ' | <a href="'.$_oldest_url.'">Initially</a>';
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";
442 print ' </div>'."\n";
444 print_html_body_end(\*STDOUT, int($state{'state'}) == STATE->{'inactive'});
445 print_html_end(\*STDOUT);
452 if($name !~ /^[A-Za-z]+$/) {
456 $abbr = uc(substr($name,0,1));
457 $name = substr($name,1);
458 while($name =~ m/([A-Z])/g) {
467 if ($line =~ /^([a-z]*@)?([A-Za-z]*): (.*)$/) {
473 $name = $coin{'name'};
479 $abbr = abbr_name($name);
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);
487 if ($action eq 'join@') {
488 return "$_name ($_abbr) joined the public chat on server $_server.";
490 elsif ($action eq 'leave@') {
491 return "$_name ($_abbr) left the public chat on server $_server.";
493 elsif ($action eq 'file@') {
494 return "$_name ($_abbr) sent the file $_text.";
501 return "<span class=\"$color\">$_abbr: $_text</span>";