view release on metacpan or  search on metacpan

lib/CGI/Info.pm  view on Meta::CPAN

=head3 API SPECIFICATION

=head4 Input

	{
		field => { type => 'scalar', optional => 1 },
	}

=head4 Output

	# When $field is supplied
	{ type => 'scalar', optional => 1 }
	# When $field is omitted (delegates to params())
	{ type => 'hashref', optional => 1 }

=head3 MESSAGES

	| Level | Message                                  | Meaning                              | Action                                  |
	|-------|------------------------------------------|--------------------------------------|-----------------------------------------|
	| warn  | param: <field> isn't in the allow list   | Caller requested a parameter outside | Review the allow list passed to new()   |
	|       |                                          | the schema set by params(allow=>\%h) | or params(); add the key if legitimate  |

=cut

sub param {
	my ($self, $field) = @_;

	if(!defined($field)) {
		return $self->params();
	}
	# Is this a permitted argument?
	if($self->{allow} && !exists($self->{allow}->{$field})) {
		$self->_warn({
			warning => "param: $field isn't in the allow list"
		});
		return;
	}

	# Prevent deep recursion which can happen when a validation routine calls param()
	my $allow;
	if($self->{in_param} && $self->{allow}) {
		$allow = delete $self->{allow};
	}
	$self->{in_param} = 1;

	my $params = $self->params();

	$self->{in_param} = 0;
	$self->{allow} = $allow if($allow);

	if($params) {
		return Return::Set::set_return($params->{$field}, { type => 'string' });
	}
}

sub _sanitise_input :Protected {
	my $arg = shift;

	# Protected function: inline check because the ($) prototype means no $self,
	unless($ENV{HARNESS_ACTIVE}) {
		my $calling_pkg = (caller)[0];
		unless($calling_pkg && ($calling_pkg eq __PACKAGE__ || $calling_pkg->isa(__PACKAGE__))) {
			Carp::croak('_sanitise_input() is a protected function and cannot be called from outside ' . __PACKAGE__);
		}
	}

	return if(!defined($arg));

	# Remove hacking attempts and spaces
	$arg =~ s/[\r\n]//g;
	$arg =~ s/\s+$//;
	$arg =~ s/^\s+//;

	# Possessive quantifier prevents catastrophic backtracking when input
	# contains '<!--' with no matching closing '-->'.
	$arg =~ s/<!--[^-]*+(?:-(?!->)[^-]*+)*+-->//g;
	# Allow :
	# $arg =~ s/[;<>\*|`&\$!?#\(\)\[\]\{\}'"\\\r]//g;

	# return $arg;
	# return String::EscapeCage->new(convert_XSS($arg))->escapecstring();
	return convert_XSS($arg);
}

sub _multipart_data :Protected {
	my ($self, $args) = @_;

	$self->_trace('Entering _multipart_data');

	my $total_bytes = $$args{length};

	$self->_debug("_multipart_data: total_bytes = $total_bytes");

	if($total_bytes == 0) {
		return;
	}

	unless($stdin_data) {
		while(<STDIN>) {
			chop(my $line = $_);
			$line =~ s/[\r\n]//g;
			$stdin_data .= "$line\n";
		}
		if(!$stdin_data) {
			return;
		}
	}

	my $boundary = $$args{boundary};

	my @pairs;
	my $writing_file = 0;
	my $key;
	my $value;
	my $in_header = 0;
	my $fout;

	foreach my $line(split(/\n/, $stdin_data)) {
		if($line =~ /^--\Q$boundary\E--$/) {
			last;
		}

lib/CGI/Info.pm  view on Meta::CPAN

	if(!defined($self->{'logger'})) {
		Carp::croak($params->{'warning'});
	}
}

# Ensure all environment variables are sanitized and validated before use.
# Use regular expressions to enforce strict input formats.
sub _get_env :Protected {
	my ($self, $var) = @_;

	return unless defined $ENV{$var};

	# Strict sanitization: allow alphanumeric and limited special characters
	if($ENV{$var} =~ /^[\w\.\-\/:\\]+$/) {
		return $ENV{$var};
	}
	$self->_warn("Invalid value in environment variable: $var");

	return;
}

=head2 reset

Class method to reset the class.
You should do this in an FCGI environment before instantiating,
but nowhere else.

=cut

sub reset {
	my $class = shift;

	unless($class eq __PACKAGE__) {
		carp('Reset is a class method');
		return;
	}

	$stdin_data = undef;
}

sub AUTOLOAD
{
	our $AUTOLOAD;

	my $self = shift or return;

	return if(!defined($AUTOLOAD));

	# Extract the method name from the AUTOLOAD variable
	my ($method) = $AUTOLOAD =~ /::(\w+)$/;

	# Skip if called on destruction
	return if($method eq 'DESTROY');

	Carp::croak(__PACKAGE__, ": Unknown method $method") if(!ref($self));

	# Allow the AUTOLOAD feature to be disabled
	Carp::croak(__PACKAGE__, ": Unknown method $method") if(exists($self->{'auto_load'}) && boolean($self->{'auto_load'})->isFalse());

	# Ensure the method is called on the correct package object or a subclass
	return unless((ref($self) eq __PACKAGE__) || (UNIVERSAL::isa((caller)[0], __PACKAGE__)));

	# Validate method name - only allow safe parameter names
	Carp::croak(__PACKAGE__, ": Invalid method name: $method") unless $method =~ /^[a-zA-Z_][a-zA-Z0-9_]*$/;

	# Delegate to the param method
	return $self->param($method);
}

=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

=head1 BUGS

is_tablet() only currently detects the iPad and Windows PCs. Android strings
don't differ between tablets and smartphones.

params() returns a ref which means that calling routines can change the hash
for other routines.
Take a local copy before making amendments to the table if you don't want unexpected
things to happen.

=head1 SEE ALSO

=over 4

=item * L<Configure an Object at Runtime|Object::Configure>

=item * L<Test Dashboard|https://nigelhorne.github.io/CGI-Info/coverage/>

=item * L<HTTP::BrowserDetect>

=item * L<https://github.com/mitchellkrogza/apache-ultimate-bad-bot-blocker>

=back

=head1 REPOSITORY

L<https://github.com/nigelhorne/CGI-Info>

=head1 SUPPORT

This module is provided as-is without any warranty.

Please report any bugs or feature requests to C<bug-cgi-info at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Info>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can find documentation for this module with the perldoc command.

    perldoc CGI::Info

You can also look for information at:

=over 4

=item * MetaCPAN