Skip to content

Commit

Permalink
Added come comments and small optimisations
Browse files Browse the repository at this point in the history
  • Loading branch information
@nigelhorne
nigelhorne committed Oct 25, 2024
1 parent bb7dd23 commit 8d9cccc
Show file tree
Hide file tree
Showing 3 changed files with 50 additions and 59 deletions.
1 change: 1 addition & 0 deletions Changes
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ Revision history for CGI-Info

0.85
Send back HTTP code 422 when argument fails "allow"
Added come comments and small optimisations

0.84 Fri Oct 18 08:21:05 EDT 2024
Intercept SQL Injection
Expand Down
103 changes: 46 additions & 57 deletions lib/CGI/Info.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,8 @@ our $stdin_data; # Class variable storing STDIN in case the class
sub new
{
my $class = shift;

# Handle hash or hashref arguments
my %args = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;

if($args{expect}) {
Expand All @@ -100,18 +102,18 @@ sub new
# FIXME: this only works when no arguments are given
$class = __PACKAGE__;
} elsif(ref($class)) {
# clone the given object
# If $class is an object, clone it with new arguments
return bless { %{$class}, %args }, ref($class);
}

my %defaults = (
# Return the blessed object
return bless {
max_upload_size => 512 * 1024,
allow => undef,
expect => undef,
upload_dir => undef
);

return bless { %defaults, %args }, $class;
upload_dir => undef,
%args # Overwrite defaults with given arguments
}, $class;
}

=head2 script_name
Expand All @@ -128,7 +130,8 @@ This is useful for POSTing, thus avoiding putting hardcoded paths into forms
=cut

sub script_name {
sub script_name
{
my $self = shift;

unless($self->{script_name}) {
Expand All @@ -143,33 +146,31 @@ sub _find_paths {
require File::Basename;
File::Basename->import();

if($ENV{'SCRIPT_NAME'}) {
$self->{script_name} = File::Basename::basename($ENV{'SCRIPT_NAME'});
} else {
$self->{script_name} = File::Basename::basename($0);
}
# Determine script name
my $script_name = $ENV{'SCRIPT_NAME'} // $0;
$self->{script_name} = $self->_untaint_filename({
filename => $self->{script_name}
filename => File::Basename::basename($script_name)
});

# Determine script path
if($ENV{'SCRIPT_FILENAME'}) {
$self->{script_path} = $ENV{'SCRIPT_FILENAME'};
} elsif($ENV{'SCRIPT_NAME'} && $ENV{'DOCUMENT_ROOT'}) {
my $script_name = $ENV{'SCRIPT_NAME'};
if($script_name =~ /^\/(.+)/) {
# It's usually the case, e.g. /cgi-bin/foo.pl
$script_name = $1;
}
$self->{script_path} = File::Spec->catfile($ENV{'DOCUMENT_ROOT' }, $script_name);
$script_name = $ENV{'SCRIPT_NAME'};

# It's usually the case, e.g. /cgi-bin/foo.pl
$script_name =~ s{^/}{};

$self->{script_path} = File::Spec->catfile($ENV{'DOCUMENT_ROOT'}, $script_name);
} elsif($ENV{'SCRIPT_NAME'} && !$ENV{'DOCUMENT_ROOT'}) {
if(File::Spec->file_name_is_absolute($ENV{'SCRIPT_NAME'}) && (-r $ENV{'SCRIPT_NAME'})) {
# Called from a command line with a full path
$self->{script_path} = $ENV{'SCRIPT_NAME'};
} else {
require Cwd;
Cwd->import;
Cwd->import();

my $script_name = $ENV{'SCRIPT_NAME'};
$script_name = $ENV{'SCRIPT_NAME'};
if($script_name =~ /^\/(.+)/) {
# It's usually the case, e.g. /cgi-bin/foo.pl
$script_name = $1;
Expand All @@ -184,6 +185,7 @@ sub _find_paths {
$self->{script_path} = File::Spec->rel2abs($0);
}

# Untaint and finalize script path
$self->{script_path} = $self->_untaint_filename({
filename => $self->{script_path}
});
Expand Down Expand Up @@ -233,28 +235,21 @@ Returns the file system directory containing the script.
=cut

sub script_dir {
sub script_dir
{
my $self = shift;

if(!ref($self)) {
$self = __PACKAGE__->new();
}
# Ensure $self is an object
$self = __PACKAGE__->new() unless ref $self;

unless($self->{script_path}) {
$self->_find_paths();
}
# Set script path if it is not already defined
$self->_find_paths() unless $self->{script_path};

# Extract directory from script path based on OS
# Don't use File::Spec->splitpath() since that can leave the trailing slash
if($^O eq 'MSWin32') {
if($self->{script_path} =~ /(.+)\\.+?$/) {
return $1;
}
} else {
if($self->{script_path} =~ /(.+)\/.+?$/) {
return $1;
}
}
return $self->{script_path};
my $dir_regex = $^O eq 'MSWin32' ? qr{(.+)\\.+?$} : qr{(.+)/.+?$};

return $self->{script_path} =~ $dir_regex ? $1 : $self->{script_path};
}

=head2 host_name
Expand Down Expand Up @@ -913,30 +908,24 @@ sub _warn {
# when called _get_params('arg', @_);
sub _get_params
{
shift;
shift; # Discard the first argument (typically $self)
my $default = shift;

if(ref($_[0]) eq 'HASH') {
# %rc = %{$_[0]};
return $_[0];
}
# Directly return hash reference if the first parameter is a hash reference
return $_[0] if ref $_[0] eq 'HASH';

my %rc;
my $num_args = scalar @_;

if((scalar(@_) % 2) == 0) {
# Populate %rc based on the number and type of arguments
if($num_args == 1 && defined $default) {
%rc = ($default => shift);
} elsif(($num_args % 2) == 0) {
%rc = @_;
} elsif(scalar(@_) == 1) {
if(defined($default)) {
$rc{$default} = shift;
} else {
my @c = caller(1);
my $func = $c[3]; # calling function name
Carp::croak('Usage: ', __PACKAGE__, "->$func()");
}
} elsif((scalar(@_) == 0) && defined($default)) {
my @c = caller(1);
my $func = $c[3]; # calling function name
Carp::croak('Usage: ', __PACKAGE__, "->$func($default => " . '$val)');
} elsif($num_args == 1) {
Carp::croak("Usage: ", __PACKAGE__, "->", (caller(1))[3], "()");
} elsif($num_args == 0 && defined $default) {
Carp::croak("Usage: ", __PACKAGE__, "->", (caller(1))[3], "($default => \$val)");
}

return \%rc;
Expand Down Expand Up @@ -1107,7 +1096,7 @@ sub is_mobile {
}

# From http://detectmobilebrowsers.com/
if ($agent =~ m/(android|bb\d+|meego).+mobile|avantgo|bada\/|blackberry|blazer|compal|elaine|fennec|hiptop|iemobile|ip(hone|od)|iris|kindle|lge |maemo|midp|mmp|mobile.+firefox|netfront|opera m(ob|in)i|palm( os)?|phone|p(ixi|re)\/|plucker|pocket|psp|series(4|6)0|symbian|treo|up\.(browser|link)|vodafone|wap|windows ce|xda|xiino/i || substr($ENV{'HTTP_USER_AGENT'}, 0, 4) =~ m/1207|6310|6590|3gso|4thp|50[1-6]i|770s|802s|a wa|abac|ac(er|oo|s\-)|ai(ko|rn)|al(av|ca|co)|amoi|an(ex|ny|yw)|aptu|ar(ch|go)|as(te|us)|attw|au(di|\-m|r |s )|avan|be(ck|ll|nq)|bi(lb|rd)|bl(ac|az)|br(e|v)w|bumb|bw\-(n|u)|c55\/|capi|ccwa|cdm\-|cell|chtm|cldc|cmd\-|co(mp|nd)|craw|da(it|ll|ng)|dbte|dc\-s|devi|dica|dmob|do(c|p)o|ds(12|\-d)|el(49|ai)|em(l2|ul)|er(ic|k0)|esl8|ez([4-7]0|os|wa|ze)|fetc|fly(\-|_)|g1 u|g560|gene|gf\-5|g\-mo|go(\.w|od)|gr(ad|un)|haie|hcit|hd\-(m|p|t)|hei\-|hi(pt|ta)|hp( i|ip)|hs\-c|ht(c(\-| |_|a|g|p|s|t)|tp)|hu(aw|tc)|i\-(20|go|ma)|i230|iac( |\-|\/)|ibro|idea|ig01|ikom|im1k|inno|ipaq|iris|ja(t|v)a|jbro|jemu|jigs|kddi|keji|kgt( |\/)|klon|kpt |kwc\-|kyo(c|k)|le(no|xi)|lg( g|\/(k|l|u)|50|54|\-[a-w])|libw|lynx|m1\-w|m3ga|m50\/|ma(te|ui|xo)|mc(01|21|ca)|m\-cr|me(rc|ri)|mi(o8|oa|ts)|mmef|mo(01|02|bi|de|do|t(\-| |o|v)|zz)|mt(50|p1|v )|mwbp|mywa|n10[0-2]|n20[2-3]|n30(0|2)|n50(0|2|5)|n7(0(0|1)|10)|ne((c|m)\-|on|tf|wf|wg|wt)|nok(6|i)|nzph|o2im|op(ti|wv)|oran|owg1|p800|pan(a|d|t)|pdxg|pg(13|\-([1-8]|c))|phil|pire|pl(ay|uc)|pn\-2|po(ck|rt|se)|prox|psio|pt\-g|qa\-a|qc(07|12|21|32|60|\-[2-7]|i\-)|qtek|r380|r600|raks|rim9|ro(ve|zo)|s55\/|sa(ge|ma|mm|ms|ny|va)|sc(01|h\-|oo|p\-)|sdk\/|se(c(\-|0|1)|47|mc|nd|ri)|sgh\-|shar|sie(\-|m)|sk\-0|sl(45|id)|sm(al|ar|b3|it|t5)|so(ft|ny)|sp(01|h\-|v\-|v )|sy(01|mb)|t2(18|50)|t6(00|10|18)|ta(gt|lk)|tcl\-|tdg\-|tel(i|m)|tim\-|t\-mo|to(pl|sh)|ts(70|m\-|m3|m5)|tx\-9|up(\.b|g1|si)|utst|v400|v750|veri|vi(rg|te)|vk(40|5[0-3]|\-v)|vm40|voda|vulc|vx(52|53|60|61|70|80|81|83|85|98)|w3c(\-| )|webc|whit|wi(g |nc|nw)|wmlb|wonu|x700|yas\-|your|zeto|zte\-/i) {
if($agent =~ m/(android|bb\d+|meego).+mobile|avantgo|bada\/|blackberry|blazer|compal|elaine|fennec|hiptop|iemobile|ip(hone|od)|iris|kindle|lge |maemo|midp|mmp|mobile.+firefox|netfront|opera m(ob|in)i|palm( os)?|phone|p(ixi|re)\/|plucker|pocket|psp|series(4|6)0|symbian|treo|up\.(browser|link)|vodafone|wap|windows ce|xda|xiino/i || substr($ENV{'HTTP_USER_AGENT'}, 0, 4) =~ m/1207|6310|6590|3gso|4thp|50[1-6]i|770s|802s|a wa|abac|ac(er|oo|s\-)|ai(ko|rn)|al(av|ca|co)|amoi|an(ex|ny|yw)|aptu|ar(ch|go)|as(te|us)|attw|au(di|\-m|r |s )|avan|be(ck|ll|nq)|bi(lb|rd)|bl(ac|az)|br(e|v)w|bumb|bw\-(n|u)|c55\/|capi|ccwa|cdm\-|cell|chtm|cldc|cmd\-|co(mp|nd)|craw|da(it|ll|ng)|dbte|dc\-s|devi|dica|dmob|do(c|p)o|ds(12|\-d)|el(49|ai)|em(l2|ul)|er(ic|k0)|esl8|ez([4-7]0|os|wa|ze)|fetc|fly(\-|_)|g1 u|g560|gene|gf\-5|g\-mo|go(\.w|od)|gr(ad|un)|haie|hcit|hd\-(m|p|t)|hei\-|hi(pt|ta)|hp( i|ip)|hs\-c|ht(c(\-| |_|a|g|p|s|t)|tp)|hu(aw|tc)|i\-(20|go|ma)|i230|iac( |\-|\/)|ibro|idea|ig01|ikom|im1k|inno|ipaq|iris|ja(t|v)a|jbro|jemu|jigs|kddi|keji|kgt( |\/)|klon|kpt |kwc\-|kyo(c|k)|le(no|xi)|lg( g|\/(k|l|u)|50|54|\-[a-w])|libw|lynx|m1\-w|m3ga|m50\/|ma(te|ui|xo)|mc(01|21|ca)|m\-cr|me(rc|ri)|mi(o8|oa|ts)|mmef|mo(01|02|bi|de|do|t(\-| |o|v)|zz)|mt(50|p1|v )|mwbp|mywa|n10[0-2]|n20[2-3]|n30(0|2)|n50(0|2|5)|n7(0(0|1)|10)|ne((c|m)\-|on|tf|wf|wg|wt)|nok(6|i)|nzph|o2im|op(ti|wv)|oran|owg1|p800|pan(a|d|t)|pdxg|pg(13|\-([1-8]|c))|phil|pire|pl(ay|uc)|pn\-2|po(ck|rt|se)|prox|psio|pt\-g|qa\-a|qc(07|12|21|32|60|\-[2-7]|i\-)|qtek|r380|r600|raks|rim9|ro(ve|zo)|s55\/|sa(ge|ma|mm|ms|ny|va)|sc(01|h\-|oo|p\-)|sdk\/|se(c(\-|0|1)|47|mc|nd|ri)|sgh\-|shar|sie(\-|m)|sk\-0|sl(45|id)|sm(al|ar|b3|it|t5)|so(ft|ny)|sp(01|h\-|v\-|v )|sy(01|mb)|t2(18|50)|t6(00|10|18)|ta(gt|lk)|tcl\-|tdg\-|tel(i|m)|tim\-|t\-mo|to(pl|sh)|ts(70|m\-|m3|m5)|tx\-9|up(\.b|g1|si)|utst|v400|v750|veri|vi(rg|te)|vk(40|5[0-3]|\-v)|vm40|voda|vulc|vx(52|53|60|61|70|80|81|83|85|98)|w3c(\-| )|webc|whit|wi(g |nc|nw)|wmlb|wonu|x700|yas\-|your|zeto|zte\-/i) {
$self->{is_mobile} = 1;
return 1;
}
Expand Down
5 changes: 3 additions & 2 deletions t/script.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,12 @@

use strict;
use warnings;
use Test::Most tests => 64;

use File::Spec;
use Cwd;
use Test::NoWarnings;
use Tie::Filehandle::Preempt::Stdin;
use Test::Most tests => 64;

BEGIN {
use_ok('CGI::Info');
Expand Down Expand Up @@ -77,7 +78,7 @@ PATHS: {
delete $ENV{'SCRIPT_FILENAME'};

$i = new_ok('CGI::Info');
ok($i->script_name() eq 'bar.pl');
cmp_ok($i->script_name() ,'eq', 'bar.pl', 'script_name returns script name');
if($^O eq 'MSWin32') {
TODO: {
local $TODO = 'Absolute path test needs to be done on Windows';
Expand Down

0 comments on commit 8d9cccc

Please sign in to comment.