our @EXPORT = ();
our @EXPORT_OK = (
'STATE', 'TEXT_MODE', 'INTF_STATE', 'CHAT_STATE', 'CHAT_ACTION',
- 'failpage',
- 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_attachment', 'fail_500',
- 'redirect',
'get_remote_addr', 'get_id', 'get_frame', 'get_password',
- 'merge_settings',
'print_html_start', 'print_html_end',
'print_html_head_start', 'print_html_head_end',
'print_html_body_start', 'print_html_body_end',
'join_path',
'copy_encoded', 'open_encoded', '_x_encoded',
'http_header_line', 'http_status',
- 'http_header_status', 'http_header_allow', 'http_header_location'
+ 'http_header_status', 'http_header_allow', 'http_header_location',
+ 'merge_settings'
);
###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
};
-# Function to return an error page
-# arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
-sub failpage {
- (my $header, my $title, my $message, my $method, my $hyperlink) = @_;
-
- if (ref($header)) {
- foreach my $header_name (keys %$header) {
- print http_header_line($header_name, $header->{$header_name});
- }
- }
- elsif($header ne '') {
- print $header;
- }
- if($method eq 'HEAD') {
- print "\n";
- return;
- }
- my $_title = html_entity_encode_dec($title , 1);
- my $_message = html_entity_encode_dec($message , 1);
- my $_hyperlink = html_entity_encode_dec($hyperlink, 1);
-
- print "Content-type: text/html; charset=UTF-8\n\n";
-
- print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
- print ' <html lang="en">'."\n";
- print ' <head>'."\n";
- print ' <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
- if ($title ne '') {
- print ' <title>'.$_title.'</title>'."\n";
- }
- print ' </head>'."\n";
- print ' <body>'."\n";
- if ($title ne '') {
- print ' <h1>'.$_title.'</h1>'."\n";
- }
- if (($message ne '') || ($hyperlink ne '')) {
- print " <p>\n";
- if ($message ne '') {
- print ' '.$_message.($hyperlink ne '' ? '<br>' : '')."\n";
- }
- if ($hyperlink ne '') {
- print ' <a href="'.$_hyperlink.'">'.$_hyperlink."</a>\n";
- }
- print " </p>\n";
- }
- print ' </body>'."\n";
- print '</html>'."\n";
-}
-
-sub fail_method {
- (my $method, my $allowed) = @_;
-
- my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
- my $header =
- http_header_line('status', $status) .
- http_header_allow($allowed);
-
- return failpage(
- $header,
- $status,
- "The interface does not support the $method method.",
- $method
- );
-}
-
-sub fail_content_type
-{
- (my $method, my $content_type) = @_;
-
- my $status = http_status(HTTP_STATUS->{'unsupported_media_type'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Unsupported Content-type: $content_type.",
- $method
- );
-}
-
-sub fail_open_file
-{
- (my $method, my $type, my $path) = @_;
-
- my $status = http_status(HTTP_STATUS->{'not_found'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Can't open ".
- ($type ne '' ? $type : 'file').
- ($path ne '' ? ': "'.$path.'"' : '').
- '.',
- $method
- );
-}
-
-sub fail_attachment
-{
- (my $method, my $ID) = @_;
-
- my $status = http_status(HTTP_STATUS->{'not_found'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Attachment $ID not found.",
- $method
- );
-}
-
-sub fail_500
-{
- (my $method, my $text) = @_;
-
- my $status = http_status(HTTP_STATUS->{'internal_server_error'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- $text,
- $method
- );
-}
-
-sub redirect
-{
- (my $method, my $uri, my $code) = @_;
- my $header;
- my $status;
- if ($code eq '') {
- $code = HTTP_STATUS->{'found'};
- }
- # https://insanecoding.blogspot.com/2014/02/http-308-incompetence-expected.html
- # 301 Moved Permanently
- # 302 Found
- # 303 See Other
- # 307 Temporary Redirect
- # 308 Permanent Redirect
- $status = http_status($code);
- $header = http_header_line('status', $status);
- $header .= http_header_location($uri);
-
- return failpage(
- $header,
- $status,
- '',
- $method,
- $uri
- );
-}
-
# function to obtain address of remote agent
sub get_remote_addr {
}
-sub merge_settings {
- my %final_settings;
-
- foreach my $settings (@_) {
- foreach my $ind (keys %$settings) {
- $final_settings{$ind} = $settings->{$ind};
- }
- }
- return %final_settings;
-}
-
-
# BB code stuff
# different & simpler implementation than in post library
# to consider:
merge_url(
{'path' => $viewer_url},
{
- 'query' => {'g' => 1},
+ 'query' => {
+ 'g' => 1,
+ 'b' => $text_mode
+ },
'fragment' => 'goto'
}
);
print $fh '<a href="'.$_goto_url.'">GOTO</a>'."\n";
print $fh ' <span style="float: right;">'."\n ";
if (
- ($text_mode == TEXT_MODE->{'normal'}) &&
- (!$goto)
+ ($text_mode == TEXT_MODE->{'normal'})
+ # && (!$goto)
){
if ($show_words) {
print $fh '<a href="'.$_words_url.'">'.$words_link_text.'</a> | ';
'query' => {
'f' => $frame,
'quote' => $ID,
- 'p' => ($password_ok ? $settings->{'password'} : '')
}
}
);
'edit' => $ID,
'key' => $post_data{'key'},
'username' => $post_data{'name'},
- 'p' => ($password_ok ? $settings->{'password'} : '')
}
}
);
'remove' => $ID,
'key' => $post_data{'key'},
'username' => $post_data{'name'},
- 'p' => ($password_ok ? $settings->{'password'} : '')
}
}
);
+ if ($password_ok) {
+ $quote_url = merge_url($quote_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
+ $edit_url = merge_url($edit_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
+ $remove_url = merge_url($remove_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
+ }
my $_ID = html_entity_encode_dec($ID, 1);
my $_name = html_entity_encode_dec($post_data{'name'}, 1);
bicyclesonthemoon.info / projects / ott / bsta / blobdiff