From: b Date: Thu, 18 Jan 2024 21:58:11 +0000 (+0000) Subject: http header functions X-Git-Tag: v1.1.1 X-Git-Url: http://bicyclesonthemoon.info/git-projects/?a=commitdiff_plain;h=refs%2Ftags%2Fv1.1.1;p=botm%2Fcommon-perl http header functions --- diff --git a/botm_common.pm b/botm_common.pm index 161222f..5734342 100644 --- a/botm_common.pm +++ b/botm_common.pm @@ -26,13 +26,15 @@ use File::Copy; use Exporter; -our $VERSION = '1.1.0'; +our $VERSION = '1.1.1'; our @ISA = qw(Exporter); our @EXPORT = (); our @EXPORT_OK = ( 'read_data_file', 'write_data_file', 'write_postdata_file', 'read_list_file', 'write_list_file', 'read_header_file', 'read_header_env', + 'HTTP_STATUS', 'http_status', 'http_header_line', + 'http_header_status', 'http_header_allow', 'http_header_location', 'http_header_content_length', 'http_header_content_disposition', 'url_encode', 'url_decode', 'url_query_encode', 'url_query_decode', 'split_url', 'join_url', 'merge_url', @@ -736,6 +738,269 @@ sub write_list_file { # https://tools.ietf.org/html/rfc2616#section-4.2 +# http://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml +use constant HTTP_STATUS => { + 100 => 'Continue', + 101 => 'Switching Protocols', + 102 => 'Processing', + 103 => 'Early Hints', + + 200 => 'OK', + 201 => 'Created', + 202 => 'Accepted', + 203 => 'Non-Authoritative Information', + 204 => 'No Content', + 205 => 'Reset Content', + 206 => 'Partial Content', + 207 => 'Multi-Status', + 208 => 'Already Reported', + 226 => 'IM Used', + + 300 => 'Multiple Choices', + 301 => 'Moved Permanently', + 302 => 'Found', + 303 => 'See Other', + 304 => 'Not Modified', + 305 => 'Use Proxy', + 306 => '(Unused)', + 307 => 'Temporary Redirect', + 308 => 'Permanent Redirect', + + 400 => 'Bad Request', + 401 => 'Unauthorized', + 402 => 'Payment Required', + 403 => 'Forbidden', + 404 => 'Not Found', + 405 => 'Method Not Allowed', + 406 => 'Not Acceptable', + 407 => 'Proxy Authentication Required', + 408 => 'Request Timeout', + 409 => 'Conflict', + 410 => 'Gone', + 411 => 'Length Required', + 412 => 'Precondition Failed', + 413 => 'Content Too Large', + 414 => 'URI Too Long', + 415 => 'Unsupported Media Type', + 416 => 'Range Not Satisfiable', + 417 => 'Expectation Failed', + 418 => '(Unused)', + 421 => 'Misdirected Request', + 422 => 'Unprocessable Content', + 423 => 'Locked', + 424 => 'Failed Dependency', + 425 => 'Too Early', + 426 => 'Upgrade Required', + 428 => 'Precondition Required', + 429 => 'Too Many Requests', + 431 => 'Request Header Fields Too Large', + 451 => 'Unavailable For Legal Reasons', + + 500 => 'Internal Server Error', + 501 => 'Not Implemented', + 502 => 'Bad Gateway', + 503 => 'Service Unavailable', + 504 => 'Gateway Timeout', + 505 => 'HTTP Version Not Supported', + 506 => 'Variant Also Negotiates', + 507 => 'Insufficient Storage', + 508 => 'Loop Detected', + 509 => 'Unassigned', + 510 => 'Not Extended', + 511 => 'Network Authentication Required', + + 100 => 'Continue', + 101 => 'Switching Protocols', + 102 => 'Processing', + 103 => 'Early Hints', + + 'ok' => 200, + 'created' => 201, + 'accepted' => 202, + 'non_authoritative_information' => 203, + 'no_content' => 204, + 'reset_content' => 205, + 'partial_content' => 206, + 'multi_status' => 207, + 'already_reported' => 208, + 'im_used' => 209, + + 'multiple_choices' => 300, + 'moved_permanently' => 301, + 'found' => 302, + 'see_other' => 303, + 'not_modified' => 304, + 'use_proxy' => 305, + 'temporary_redirect' => 307, + 'permanent_redirect' => 308, + + 'bad_request' => 400, + 'unauthorized' => 401, + 'payment_required' => 402, + 'forbidden' => 403, + 'not_found' => 404, + 'method_not_allowed' => 405, + 'not_acceptable' => 406, + 'proxy_authentication_required' => 407, + 'request_timeout' => 408, + 'conflict' => 409, + 'gone' => 410, + 'length_required' => 411, + 'precondition_failed' => 412, + 'content_too_large' => 413, + 'uri_too_long' => 414, + 'unsupported_media_type' => 415, + 'range_not_satisfiable' => 416, + 'expectation_failed' => 417, + 'misdirected_request' => 421, + 'unprocessable_content' => 422, + 'locked' => 423, + 'failed_dependency' => 424, + 'too_early' => 425, + 'upgrade_required' => 426, + 'precondition_required' => 428, + 'too_many_requests' => 429, + 'request_header_fields_too_large' => 431, + 'unavailable_for_legal_reasons' => 451, + + 'internal_server_error' => 500, + 'not_implemented' => 501, + 'bad_gateway' => 502, + 'service_unavailable' => 503, + 'gateway_timeout' => 504, + 'http_version_not_supported' => 505, + 'variant_also-negotiates' => 506, + 'insufficient _torage' => 507, + 'loop_detected' => 508, + 'unassigned' => 509, + 'not_extended' => 510, + 'network_authentication required' => 511, + +}; + +sub http_header_line { + (my $name, my $value, my $single_line) = @_; + if ( + ($name !~ /^[\x21\x23-\x27\x2a\x2b\x2d\x2e\x30-\x39\x3d\x41-\x5a\x5e-\x7a\x7c\x7e]+$/s) || + ($value !~ /^([^\x00-\x1f\x7f]|((\r?\n)?[ \t]))*$/s) + ) { + # name: 'token' + # value: 'field-value' (a bit complicated but when taken together, + # all *TEXT is allowed (we're not checking correct value, just if it doesn't break.)) + return ''; + } + + $name = lc($name); + $name =~ s/^([a-z])/uc($1)/es; + $name =~ s/_([a-z])/'-'.uc($1)/egs; + + if ($single_line) { + $value =~ s/(\r?\n)?[ \t]/ /gs; + } + $value =~ s/^((\r?\n)?[ \t])+//gs; + $value =~ s/((\r?\n)?[ \t])+$//gs; + + return $name.': '.$value."\n"; +} + +# return full HTTP status line text based on status code +# fall back to 500 +sub http_status { + (my $code) = @_; + $code = int($code); + if (HTTP_STATUS->{$code} eq '') { + $code = 500; + } + return $code . ' ' . HTTP_STATUS->{$code}; +} + +sub http_header_status { + (my $code) = @_; + return http_header_line( + 'status', + http_status($code) + ); +} + +sub http_header_allow { + my ($methods) = @_; + + my @list; + my $value; + + if (ref($methods)) { + @list = @$methods; + } + else { + @list = ($methods,); + } + + foreach my $method (@list) { + $method = uc($method); + if ($method !~ /^(OPTIONS|GET|HEAD|POST|PUT|DELETE|TRACE|CONNECT)$/s) { + next; + } + $value .= (($value ne '') ? ', ' : '').$method; + } + if ($value eq '') { + return ''; + } + return http_header_line('allow', $value); +} + +sub http_header_location { + (my $uri) = @_; + + # expect that URL-encoding if needed is already applied + if ($uri !~ /^[\x20-\x7f]+$/) { + return ''; + } + return http_header_line('location', $uri); +} + +sub http_header_content_length { + (my $length) = @_; + + return http_header_line('content-length', int($length)); +} + +sub http_header_content_disposition { + (my $type, my $filename) = @_; + + if ($type !~ /^[\x21\x23-\x27\x2a\x2b\x2d\x2e\x30-\x39\x3d\x41-\x5a\x5e-\x7a\x7c\x7e]+$/s) { + return ''; + } + my $value = lc($type); + + if ($filename ne '') { + $value .= '; filename'; + if ($filename =~ /^[\x21\x23-\x27\x2a\x2b\x2d\x2e\x30-\x39\x3d\x41-\x5a\x5e-\x7a\x7c\x7e]+$/s) { + # token + $value .= '='.$filename; + } + elsif ($filename =~ /^[\x20-\x21\x23-\x5b\x5d-\x7e]*$/s) { + # quoted-string + $value .= '="'.$filename.'"'; + } + elsif ($filename =~ /^[\x00-\xff]*$/) { + $value .= "*=ISO-8859-1''".url_encode($filename, 'iso-8859-1'); + } + else { + $value .= "*=UTF-8''".url_encode($filename, 'UTF-8'); + } + } + return http_header_line('content-disposition', $value); +} + +# sub http_header_content_type { + # (my $media_type, my $parameters) = @_; + # if ($media_type !~ /^[\x21\x23-\x27\x2a\x2b\x2d\x2e\x30-\x39\x3d\x41-\x5a\x5e-\x7a\x7c\x7e]+\/[\x21\x23-\x27\x2a\x2b\x2d\x2e\x30-\x39\x3d\x41-\x5a\x5e-\x7a\x7c\x7e]+$/s) { + # return '' + # } + # my $value = media_type; + +# } + # read_header_file() reads a HTTP header file and returns a hash with # the header values. # The status line is returned under :http-version, :status-code and