From 530579dc6a238ef41823a47218059e6d78fac5ff Mon Sep 17 00:00:00 2001 From: b Date: Wed, 5 Jul 2023 21:57:54 +0000 Subject: [PATCH] read HTTP header --- botm_common.pm | 111 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 110 insertions(+), 1 deletion(-) diff --git a/botm_common.pm b/botm_common.pm index 0277cab..9ddb13d 100644 --- a/botm_common.pm +++ b/botm_common.pm @@ -25,11 +25,12 @@ use Encode ('encode', 'decode'); use Exporter; -our $VERSION = '1.0.12'; +our $VERSION = '1.0.13'; our @ISA = qw(Exporter); our @EXPORT = (); our @EXPORT_OK = ( 'read_data_file', 'write_data_file', + 'read_header_file', 'url_encode', 'url_decode', 'url_query_encode', 'url_query_decode', 'split_url', 'join_url', 'merge_url', @@ -317,6 +318,114 @@ sub write_data_file { +################### +## HTTP HEADER ## +################### + +# https://tools.ietf.org/html/rfc2616#section-4.2 + +# 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 +# :reason-phrase. +# all header field names are converted to lowercase. +# +# $file is the path to the file to read. +# file will be opened, read, and closed. +# +# alternatively, $file can be an filehandle for already opened file +# (or STDIN). +# in this case a fseek to the beginning will be attempted and file +# will be read and not closed afterwards. +# +# File reading stops at end of header, to be able to resume reading +# afterwards. +# +# $encoding is the text encoding of the file to read. +# if left empty, this will default to "utf8". +# encoding of an already opened file will not be changed by this. +# +sub read_header_file { + (my $file, my $encoding) = @_; + my $fh; + my %data; + my $status_line=1; + + if ($encoding eq '') { + $encoding = 'utf8'; + } + + # check if $file is actually a path or maybe a filehandle + # filehandles are references. + if(ref($file)) { + $fh=$file; + unless (seek($fh, 0, 0)) { + # return %data; + } + } + else { + unless (open ($fh, "<:encoding($encoding)", encode('locale_fs', $file))) { + return %data; + } + } + + # The name of header field in previous line. Required for header fields that + # occupy multiple lines. + my $lastname=''; + + while (defined(my $line = <$fh>)) { + $line =~ s/[\n]$//g; + $line =~ s/[\r]$//g; + + if ($status_line) { + $line =~ /^([^ ]+) +([^ ]+)( +([^ ].*))?$/; + $data{':http-version'} = $1; + $data{':status-code'} = $2; + $data{':reason-phrase'} = $4; + $status_line = 0; + next; + } + + # $line = decode($encoding, $line); + my $name=''; + my $value=''; + + # Empty line - end of header. + if ($line eq ''){ + last; + } + + # Line starts with LWS. It's a continuation of the previous line. + # Concatenate the field value. + elsif($line =~ /^[ \t]+([^ \t](.*[^ \t])?)[ \t]*$/) { + if($lastname ne '') { + $data{$lastname} .= $1; + } + } + # Line starts with a name followed by colon + elsif ($line =~ /^([^:]+):[ \t]*([^ \t](.*[^ \t])?)[ \t]*$/) { + $name = lc($1); + $value = $2; + # If there already was a header field with the same name then the value + # is concantenated, separated by comma. + if ($data{$name} ne '') { + $data{$name}.=', '.$value; + } + # otherwise just save the value + else { + $data{$name} = $value; + } + $lastname = $name; + } + } + # If argument was a path the file must be closed. + unless (ref($file)) { + close ($fh); + } + + return %data; +} + ########### ## URL ## ########### -- 2.30.2