1 ###RUN_PERL: #!/usr/bin/perl
4 # info.pl is generated from info.1.pl.
6 # The frame/story info interface
8 # Copyright (C) 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 # use Encode::Locale ('decode_argv');
26 use Encode ('encode', 'decode');
28 ###PERL_LIB: use lib /botm/lib/bsta
38 'fail_method', 'fail_content_type',
41 'get_page_file', 'get_frame_file',
42 'read_frame_data', 'read_default', 'read_noaccess',
43 'read_settings', 'read_default', 'read_state',
44 'read_words_list', 'read_words', 'read_attachment'
47 binmode STDIN, ':encoding(UTF-8)';
48 binmode STDOUT, ':encoding(UTF-8)';
49 binmode STDERR, ':encoding(UTF-8)';
76 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
77 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
79 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
83 exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
86 %http = read_header_env(\%ENV);
87 %cgi = url_query_decode($ENV{'QUERY_STRING'});
89 if ($method eq 'POST') {
90 if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
91 my %cgi_post = url_query_decode( <STDIN> );
92 %cgi = merge_settings(\%cgi, \%cgi_post);
94 # multipart not supported
96 exit fail_content_type($method, $http{'content-type'});
100 if ($cgi{'f'} =~ /^.+$/) {
103 elsif ($cgi{'a'} =~ /^.+$/) {
104 $attachment = int($&);
106 elsif ($cgi{'i'} =~ /^.+$/) {
107 $attachment = int($&);
109 elsif ($cgi{'w'} =~ /^.+$/) {
112 elsif ($ENV{'PATH_INFO'} =~ /^\/a\/?(.+)$/) {
113 $attachment = int($1);
115 elsif ($ENV{'PATH_INFO'} =~ /^\/w\/?(.+)$/) {
118 elsif ($ENV{'PATH_INFO'} =~ /^\/(f\/?)?(.+)$/) {
122 $password = get_password(\%cgi);
124 %settings = read_settings();
125 %default = read_default();
126 %state = read_state(());
128 $ong_state = int($state{'state'});
129 $last_frame = int($state{'last'});
131 $password_ok = ($password eq $settings{'password'});
133 # comment info, not frame
135 if ($words =~ /^[0-9]+$/) {
136 %info_data = read_words_list(
142 if ($info_data{'posts'} eq '') {
143 $info_data{'posts'} = 0;
146 elsif ($words =~ /^[0-9]+\.[0-9\.]+$/) {
147 %info_data = read_words($&);
148 $frame = ($info_data{'frame'} ne '') ? int($info_data{'frame'}) : -1;
149 unless ($password_ok) {
150 delete($info_data{'password'});
151 delete($info_data{'key'});
155 # attachment info, not frame
156 elsif ($attachment ne '') {
157 %info_data = read_attachment($attachment);
158 $frame = ($info_data{'frame'} ne '') ? int($info_data{'frame'}) : -1;
161 elsif ($frame ne '') {
163 $frame = $last_frame + $frame +1;
165 %info_data = read_frame_data($frame, \%default);
166 %next_frame_data = read_frame_data($frame+1, \%default);
168 $timer = int($state{'nextong'}) - $time;
169 $ongtime = int($state{'ongtime'});
171 $ongtime = int($settings{'ongtime'})
173 $show_command = ($timer < ($ongtime * 3600 / 3));
175 # state info, not frame
177 unless ($password_ok) {
178 # just show if IP was saved, not its value
179 if ($state{'ip1'} ne '') {
182 if ($state{'ip2'} ne '') {
185 if ($state{'ip3'} ne '') {
189 print "Content-type: text/plain; charset=UTF-8\n\n";
190 if ($method eq 'HEAD') {
194 \*STDOUT, \%state, '',
204 ($ong_state >= STATE->{'waiting'}) &&
205 ($frame <= $last_frame) &&
213 ($attachment eq '') &&
214 ($info_data{'command'} eq '') && (
216 ($frame < $last_frame) || (
217 ($ong_state >= STATE->{'ready'}) &&
222 $info_data{'command'} = $next_frame_data{'title'};
227 if (($attachment ne '') || ($words ne '')) {
231 %info_data = read_noaccess(\%default);
235 ($attachment eq '') &&
238 if ($info_data{'frame'} eq '') {
239 $info_data{'frame'} = get_frame_file($frame, \%info_data, \%settings)
241 if ($info_data{'page'} eq '') {
242 unless (($access) && ($frame < $last_frame)) {
243 $info_data{'page'} = '';
246 $info_data{'page'} = get_page_file($frame, \%info_data, \%settings);
251 print "Content-type: text/plain; charset=UTF-8\n";
253 print http_header_status(HTTP_STATUS->{'forbidden'});
256 if($method eq 'HEAD') {
260 \*STDOUT, \%info_data, '',