###TIMEOUT_INACT;\r
###UNLOCK_PROXY_HOST;\r
\r
-$VERSION = 0.000003;\r
+$VERSION = 0.000004;\r
@ISA = qw(Exporter);\r
@EXPORT = ();\r
-@EXPORT_OK = qw(access divideurl entitydecode formatheader getcgi joinurl path2url url2path path2urldiv readconfigfile urldecode urldiv2path);\r
+@EXPORT_OK = qw(access divideurl entitydecode formatheader getcgi joinurl path2url url2path path2urldiv readconfigfile readheaderfile urldecode urldiv2path);\r
%EXPORT_TAGS = ();\r
\r
# This function checks if the user has unlocked the proxy. Nonzero means yes.\r
return $t;\r
}\r
\r
+# Function for decoding html entities; by number decimal, haeadecimal or by name\r
sub entitydecode {\r
my $t = $_[0];\r
$t =~ s/&(#?[a-zA-Z0-9]+);/entitydecode1ch($1)/eg;\r
return $t;\r
}\r
\r
+# Function for decoding one html entity, called from entitydecode().\r
sub entitydecode1ch {\r
my $t = $_[0];\r
+ # decode decimal number\r
if ($t =~ /^#([0-9]+)$/) {\r
return chr($1);\r
}\r
+ # decode hexadecimal number\r
elsif ($t =~ /^#x([0-9A-Fa-f]+)$/) {\r
return chr(hex($1));\r
}\r
+ # decode entity name\r
elsif ($t =~ /^([A-Za-z0-9]+)$/) {\r
return entitycode->{$1};\r
}\r
return $t;\r
}\r
\r
-# Function to convert URL to archive path. Also creates required directories\r
-# if $mkdir true.\r
+# Function to convert URL (divided) to archive path. Also creates required\r
+# directories if $mkdir true.\r
# Returns the path on success and undef on fail.\r
# Inspired by the MIRA browser.\r
sub urldiv2path {\r
# character parts ending with '-' until the last one is not longer than 240.\r
# Characters that are not letters or numbers or '_' or '.' are encoded. Like\r
# in URL-encoding but with '@' instead of '%'.\r
- # When segment is longer than 120 characters it's divided into 64 character\r
- # parts ending with '-' until the last one is not longer than 120.\r
# The '?' at the beginning is not part of the query string.\r
# For example:\r
# ?a=1&b=%25%5E%26 becomes ... /a@3D1@26b@3D@2525@255E@2526\r
return $archpath;\r
}\r
\r
+# Function to convert URL (one string) to archive path\r
sub url2path {\r
return urldiv2path(divideurl($_[0]));\r
}\r
\r
+# Function to convert archive path to URL (divided)\r
sub path2urldiv {\r
my $archpath = $_[0];\r
my $prot;\r
return ($prot, $host, $port, $path, $query);\r
}\r
\r
+# Function to join parts of URL to one string\r
sub joinurl {\r
(my $prot, my $host, my $port, my $path, my $query) = @_;\r
my $url;\r
return $url;\r
}\r
\r
+# Function to convert archive path to URL (one string)\r
sub path2url {\r
return joinurl(path2urldiv($_[0]));\r
}\r
\r
+# Function to read http headers. It reads data from a file containing a http\r
+# header (see: https://tools.ietf.org/html/rfc2616#section-4.2). One exception:\r
+# the status line is not special. Instead the status is just another header\r
+# field with the name 'Status' (like in a CGI header)\r
+# \r
+# Returns a hash containing the values.\r
+# Names are case sensitive and are converted to lowercase\r
+#\r
+# Argument can be a path or a file handle. In case of a file handle it will just\r
+# read the file. In case of path it opens the file before reading and closes\r
+# after. On failure (file not open) returns empty hash.\r
+# \r
+sub readheaderfile {\r
+ (my $headerpath) = @_;\r
+ my $headerfile;\r
+ my %header;\r
+ \r
+ # check if $headerpath is actually a path or maybe a filehandle\r
+ # filehandles are references.\r
+ if(ref($headerpath)) {\r
+ $headerfile=$headerpath;\r
+ }\r
+ else {\r
+ unless (open ($headerfile, "<", $headerpath)) {\r
+ return %header;\r
+ }\r
+ }\r
+ \r
+ # The name of header field in previous line. Required for header fields that\r
+ # occupy multiple lines.\r
+ my $lastname='';\r
+ \r
+ while (defined(my $line = <$headerfile>)) {\r
+ $line =~ s/[\r\n]$//g;\r
+ my $headname='';\r
+ my $headval='';\r
+ \r
+ # Line starts with whitespace. It's a continuation of the previous line.\r
+ # Concatenate the field value.\r
+ if($line =~ /^[ \t]+([^ \t](.*[^ \t])?)[ \t]*$/){\r
+ if($lastname ne '') {\r
+ $header{$lastname}.=$1;\r
+ }\r
+ }\r
+ # Line starts with a name followed by colon.\r
+ elsif ($line =~ /^([^:]+):[ \t]*([^ \t](.*[^ \t])?)[ \t]*$/) {\r
+ $headname = lc($1);\r
+ $headval = $2;\r
+ # If there already was a header field with the same name then the value\r
+ # is concantenated, separated by comma.\r
+ if ($header{$headname} ne '') {\r
+ $header{$headname}.=', '.$headval;\r
+ }\r
+ # otherwise just save the value\r
+ else {\r
+ $header{$headname}=$headval;\r
+ }\r
+ $lastname = $headname;\r
+ }\r
+ }\r
+ \r
+ # If argument was a path the file must be closed. \r
+ unless (ref($headerpath)) {\r
+ close ($headerfile);\r
+ }\r
+ \r
+ return %header;\r
+}\r
+\r
+# Function to read configuration files.\r
+# In each line the '#' and everything after it is treated as a comment and\r
+# ignored.\r
+# The format is:\r
+# name = value\r
+# There can be whitespaces (space, tab) before after or between the name, value\r
+# and '='. Leading and trailing whitespaces are not part of the value or name.\r
+# Name can be made of letters, numbers, '_', '-', and '.'. Names are case\r
+# sensitive.\r
+# \r
+# In some cases it may not possible to save the required data in this\r
+# format. There may be a need to change this format in the future.\r
+# \r
+# Returns a hash containing the values.\r
+# \r
+# Argument can be a path or a file handle. In case of a file handle it will just\r
+# read the file. In case of path it opens the file before reading and closes\r
+# after. On failure (file not open) returns empty hash.\r
+# \r
+# This function is duplicated in configure.pl. configure.pl can't use a function\r
+# from a file that it generates. That would create a dependency loop.\r
+# \r
sub readconfigfile {\r
(my $configpath) = @_;\r
my $configfile;\r
my %config;\r
\r
- if (open ($configfile, "<", $configpath)) {\r
- while (defined(my $line = <$configfile>)) {\r
- $line =~ s/[\r\n]//g;\r
- $line =~ s/#.*$//;\r
- if ($line =~ /^ *([a-zA-Z0-9_\-\.]+) *= *(.*)$/){\r
- my $name=$1;\r
- my $value=$2;\r
- $value =~ s/ *$//;\r
- $config{$name}=$value;\r
- }\r
+ # check if $configpath is actually a path or maybe a filehandle\r
+ # filehandles are references.\r
+ if(ref($configpath)) {\r
+ $configfile=$configpath;\r
+ }\r
+ else {\r
+ unless (open ($configfile, "<", $configpath)) {\r
+ return %config;\r
}\r
+ }\r
+ \r
+ while (defined(my $line = <$configfile>)) {\r
+ $line =~ s/[\r\n]//g;\r
+ $line =~ s/#.*$//; #comment\r
+ if ($line =~ /^[ \t]*([a-zA-Z0-9_\-\.]+)[ \t]*=[ \t]*([^ \t](.*[^ \t])?)[ \t]*$/){\r
+ my $name=$1;\r
+ my $value=$2;\r
+ $config{$name}=$value;\r
+ }\r
+ }\r
+ \r
+ # If argument was a path the file must be closed. \r
+ unless (ref($configpath)) {\r
close ($configfile);\r
}\r
return %config;\r
bicyclesonthemoon.info / projects / yplom / proxy / commitdiff