improve HTTP headers; can't post with GET request

[ott/bsta] / bsta_lib.1.pm

diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm
index fe1f349eebb43f99a971cfb0f1e43b87ee9ceb7e..9774a2dc6c0ac59cc615e6d3917487589598ea2e 100644 (file)
--- a/bsta_lib.1.pm
+++ b/bsta_lib.1.pm
@@ -53,6 +53,7 @@ our @EXPORT_OK   = (
 
 ###PERL_LIB: use lib /botm/lib/bsta
 use botm_common (
+       'HTTP_STATUS',
        'url_query_decode', 'url_query_encode',
        'url_decode', 'url_encode',
        'html_entity_encode_dec',
@@ -60,7 +61,9 @@ use botm_common (
        'read_header_env',
        'read_data_file', 'write_data_file',
        'join_path',
-       'copy_encoded', 'open_encoded'
+       'copy_encoded', 'open_encoded',
+       'http_header_line', 'http_status',
+       'http_header_status', 'http_header_allow', 'http_header_location'
 );
 
 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
@@ -218,7 +221,13 @@ use constant tags_html => {
 # 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($header ne ''){
+       
+       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') {
@@ -260,13 +269,14 @@ sub failpage {
 sub fail_method {
        (my $method, my $allowed) = @_;
        
-       my $header = "Status: 405 Method Not Allowed\n";
-       if ($allowed ne '') {
-               $header .= "Allow: $allowed\n";
-       }
+       my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
+       my $header =
+               http_header_line('status', $status) .
+               http_header_allow($allowed);
+       
        return failpage(
                $header,
-               "405 Method Not Allowed",
+               $status,
                "The interface does not support the $method method.",
                $method
        );
@@ -276,9 +286,12 @@ 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(
-               "Status: 415 Unsupported Media Type\n",
-               "415 Unsupported Media Type",
+               $header,
+               $status,
                "Unsupported Content-type: $content_type.",
                $method
        );
@@ -288,9 +301,12 @@ 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(
-               "Status: 404 Not Found\n",
-               "404 Not Found",
+               $header,
+               $status,
                        "Can't open ".
                        ($type ne '' ? $type : 'file').
                        ($path ne '' ? ': "'.$path.'"' : '').
@@ -303,9 +319,12 @@ sub fail_attachment
 {
        (my $method, my $ID) = @_;
        
+       my $status = http_status(HTTP_STATUS->{'not_found'});
+       my $header = http_header_line('status', $status);
+
        return failpage(
-               "Status: 404 Not Found\n",
-               "404 Not Found",
+               $header,
+               $status,
                "Attachment $ID not found.",
                $method
        );
@@ -314,9 +333,13 @@ sub fail_attachment
 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(
-               "Status: 500 Internal Server Error\n",
-               "500 Internal Server Error",
+               $header,
+               $status,
                $text,
                $method
        );
@@ -325,31 +348,22 @@ sub fail_500
 sub redirect
 {
        (my $method, my $uri, my $code) = @_;
+       my $header;
        my $status;
        if ($code eq '') {
-               $code = 302
-       }
-       $code = int($code);
-       if ($code == 301) {
-               $status = '301 Moved Permanently';
-       }
-       elsif ($code == 302) {
-               $status = '302 Found';
-       }
-       elsif ($code == 303) {
-               $status = '303 See Other';
-       }
-       elsif ($code == 307) {
-               $status = '307 Temporary Redirect';
-       }
-       elsif ($code == 308) {
-               $status = '308 Permanent Redirect';
-       }
-       else{
-               $status = "$code Redirect";
+               $code = HTTP_STATUS->{'found'};
        }
+       # 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(
-               "Status: $status\nLocation: $uri\n",
+               $header,
                $status,
                '',
                $method,
@@ -857,7 +871,6 @@ sub print_html_data {
        print $fh html_encode_line("\n".$data->{'content'});
 }
 
-# TODO: previous page preload?
 sub print_viewer_page {
        (
                my $file,
@@ -1804,7 +1817,7 @@ sub write_index {
 }
 
 
-# ONG the frame + attachment & stiff. NOT update state file.
+# ONG the frame + attachment & stuff. NOT update state file.
 sub ong {
        (
                my $ID, my $ongtime, my $timer, my $update, my $print,