File Coverage

=head1 NAME

CGI::Info - Information about the CGI environment

=head1 VERSION

Version 1.13

=cut

=head1 SYNOPSIS

The C<CGI::Info> module is a Perl library designed to provide information about the environment in which a CGI script operates.
It aims to eliminate hard-coded script details,
enhancing code readability and portability.
Additionally, it offers a simple web application firewall to add a layer of security.

All too often,
Perl programs have information such as the script's name
hard-coded into their source.
Generally speaking,
hard-coding is a bad style since it can make programs difficult to read and reduces readability and portability.
CGI::Info attempts to remove that.

Furthermore, to aid script debugging, CGI::Info attempts to do sensible
things when you're not running the program in a CGI environment.

Whilst you shouldn't rely on it alone to provide security to your website,
it is another layer and every little helps.

    use CGI::Info;

    my $info = CGI::Info->new(allow => { id => qr/^\d+$/ });
    my $params = $info->params();

    if($info->is_mobile()) {
        print "Mobile view\n";
    } else {
        print "Desktop view\n";
    }

    my $id = $info->param('id');     # Validated against allow schema

=head1 SUBROUTINES/METHODS

=head2 new

Creates a CGI::Info object.

It takes four optional arguments: allow, logger, expect and upload_dir,
which are documented in the params() method.

It takes other optional parameters:

=over 4

=item * C<auto_load>

Enable/disable the AUTOLOAD feature.
The default is to have it enabled.

=item * C<config_dirs>

Where to look for C<config_file>

=item * C<config_file>

Points to a configuration file which contains the parameters to C<new()>.
The file can be in any common format,
including C<YAML>, C<XML>, and C<INI>.
This allows the parameters to be set at run time.

On non-Windows system,
the class can be configured using environment variables starting with "CGI::Info::".
For example:

  export CGI::Info::max_upload_size=65536

It doesn't work on Windows because of the case-insensitive nature of that system.

If the configuration file has a section called C<CGI::Info>,
only that section,
and the C<global> section,
if any exists,
is used.

=item * C<syslog>

Takes an optional parameter syslog, to log messages to
L<Sys::Syslog>.
It can be a boolean to enable/disable logging to syslog, or a reference
to a hash to be given to Sys::Syslog::setlogsock.

=item * C<cache>

An object that is used to cache IP lookups.
This cache object is an object that understands get() and set() messages,
such as a L<CHI> object.

=item * C<max_upload_size>

The maximum file size in bytes you can upload.
Use C<-1> for no limit.
The default is 512 KB (524288 bytes).

=back

The class can be configured at runtime using environment variables and configuration
files; for example, setting C<$ENV{'CGI__INFO__carp_on_warn'}> causes warnings to
use L<Carp>.  For more information see L<Object::Configure>.

=head3 API SPECIFICATION

=head4 INPUT

  {
    allow          => { type => 'hashref',  optional => 1 },
    auto_load      => { type => 'boolean',  optional => 1 },
    cache          => { type => 'object',   optional => 1 },
    carp_on_warn   => { type => 'boolean',  optional => 1 },
    config_dirs    => { type => 'arrayref', optional => 1 },
    config_file    => { type => 'string',   optional => 1 },
    logger         => { type => 'object',   optional => 1 },
    max_upload_size=> { type => 'integer',  optional => 1, min => -1 },
    upload_dir     => { type => 'string',   optional => 1 },
  }

=head4 OUTPUT

  { type => 'object', isa => 'CGI::Info' }

=head3 MESSAGES

=over 4

=item C<< use ->new() not ::new() to instantiate >>

B<Level>: fatal (croak).
B<Cause>: called as C<CGI::Info::new()> (double-colon) instead of C<< CGI::Info->new() >>.
B<Action>: change the call-site to use the arrow notation.

=item C<< Logger must be an object with info() and error() methods >>

B<Level>: fatal (croak).
B<Cause>: the C<logger> argument is not a blessed object, or does not
implement C<info()>, C<warn()>, and C<error()> methods.
B<Action>: pass a compliant logger such as a L<Log::Abstraction>-based object.

=item C<< expect has been deprecated, use allow instead >>

B<Level>: fatal (croak).
B<Cause>: the removed C<expect> parameter was passed to C<new()>.
B<Action>: replace C<expect =E<gt> [...]> with C<allow =E<gt> { key =E<gt> qr/.../ }>.

=back

=cut

=head2 script_name

Retrieves the name of the executing CGI script.
This is useful for POSTing,
thus avoiding hard-coded paths into forms.

        use CGI::Info;

        my $info = CGI::Info->new();
        my $script_name = $info->script_name();
        # ...
        print "<form method=\"POST\" action=$script_name name=\"my_form\">\n";

=head3 API SPECIFICATION

=head4 INPUT

None.

=head4 OUTPUT

  {
    type => 'string',
    'min' => 1,
    'nomatch' => qr/^[\/\\]/ # Does not return absolute path
  }

=cut

=head2 script_path

Finds the full path name of the script.

        use CGI::Info;

        my $info = CGI::Info->new();
        my $fullname = $info->script_path();
        my @statb = stat($fullname);

        if(@statb) {
                my $mtime = localtime $statb[9];
                print "Last-Modified: $mtime\n";
                # TODO: only for HTTP/1.1 connections
                # $etag = Digest::MD5::md5_hex($html);
                printf "ETag: \"%x\"\n", $statb[9];
        }
=cut

=head2 script_dir

Returns the file system directory containing the script.

        use CGI::Info;
        use File::Spec;

        my $info = CGI::Info->new();

        print 'HTML files are normally stored in ', $info->script_dir(), '/', File::Spec->updir(), "\n";

        # or
        use lib CGI::Info::script_dir() . '../lib';

=cut

=head2 host_name

Return the host-name of the current web server, according to CGI.
If the name can't be determined from the web server, the system's host-name
is used as a fall back.
This may not be the same as the machine that the CGI script is running on,
some ISPs and other sites run scripts on different machines from those
delivering static content.
There is a good chance that this will be domain_name() prepended with either
'www' or 'cgi'.

        use CGI::Info;

        my $info = CGI::Info->new();
        my $host_name = $info->host_name();
        my $protocol = $info->protocol();
        # ...
        print "Thank you for visiting our <A HREF=\"$protocol://$host_name\">Website!</A>";

=cut

=head2 domain_name

Domain_name is the name of the controlling domain for this website.
Usually it will be similar to host_name, but will lack the http:// or www prefixes.

Can be called as a class method.

=cut

=head2 cgi_host_url

Return the URL of the machine running the CGI script.

=cut

=head2 params

Returns a reference to a hash list of the CGI arguments.

CGI::Info helps you to test your script before deployment on a website:
if it is not in a CGI environment (e.g., the script is being tested from the
command line), the program's command line arguments (a list of key=value pairs)
are used, if there are no command line arguments,
then they are read from stdin as a list of key=value lines.
Also,
you can give one of --tablet, --search-engine,
--mobile and --robot to mimic those agents. For example:

        ./script.cgi --mobile name=Nigel

Returns undef if the parameters can't be determined or if none were given.

If an argument is given twice or more, then the values are put in a comma
separated string.

The returned hash value can be passed into L<CGI::Untaint>.

Takes four optional parameters: allow, logger and upload_dir.
The parameters are passed in a hash, or a reference to a hash.
The latter is more efficient since it puts less on the stack.

Allow is a reference to a hash list of CGI parameters that you will allow.
The value for each entry is either a permitted value,
a regular expression of permitted values for
the key,
a code reference,
or a hash of L<Params::Validate::Strict> rules.
Subroutine exceptions propagate normally, allowing custom error handling.
This works alongside existing regex and Params::Validate::Strict patterns.
A undef value means that any value will be allowed.
Arguments not in the list are silently ignored.
This is useful to help to block attacks on your site.

Upload_dir is a string containing a directory where files being uploaded are to
be stored.
It must be a writeable directory in the temporary area.

Takes an optional parameter logger, which is used for warnings and traces.
It can be an object that understands warn() and trace() messages,
such as a L<Log::Log4perl> or L<Log::Any> object,
a reference to code,
a reference to an array,
or a filename.

The allow, logger and upload_dir arguments can also be passed to the
constructor.

        use CGI::Info;
        use CGI::Untaint;
        # ...
        my $info = CGI::Info->new();
        my %params;
        if($info->params()) {
                %params = %{$info->params()};
        }
        # ...
        foreach(keys %params) {
                print "$_ => $params{$_}\n";
        }
        my $u = CGI::Untaint->new(%params);

        use CGI::Info;
        use CGI::IDS;
        # ...
        my $info = CGI::Info->new();
        my $allowed = {
                foo => qr/^\d*$/,    # foo must be a number, or empty
                bar => undef,                # bar can be given and be any value
                xyzzy => qr/^[\w\s-]+$/,     # must be alphanumeric
                                                # to prevent XSS, and non-empty
                                                # as a sanity check
        };
        # or
        $allowed = {
                email => { type => 'string', matches => qr/^[^@]+@[^@]+\.[^@]+$/ }, # String, basic email format check
                age => { type => 'integer', min => 0, max => 150 }, # Integer between 0 and 150
                bio => { type => 'string', optional => 1 }, # String, optional
                ip_address => { type => 'string', matches => qr/^(?:[0-9]{1,3}\.){3}[0-9]{1,3}$/ }, #Basic IPv4 validation
        };
        my $paramsref = $info->params(allow => $allowed);
        if(defined($paramsref)) {
                my $ids = CGI::IDS->new();
                $ids->set_scan_keys(scan_keys => 1);
                if($ids->detect_attacks(request => $paramsref) > 0) {
                        die 'horribly';
                }
        }

If the request is an XML request (i.e. the content type of the POST is text/xml),
CGI::Info will put the request into the params element 'XML', thus:

        use CGI::Info;
        # ...
        my $info = CGI::Info->new();
        my $paramsref = $info->params();     # See BUGS below
        my $xml = $$paramsref{'XML'};
        # ... parse and process the XML request in $xml

Carp if logger is not set and we detect something serious.

Blocks some attacks,
such as SQL and XSS injections,
mustleak and directory traversals,
thus creating a primitive web application firewall (WAF).
Warning - this is an extra layer, not a replacement for your other security layers.

=head3 Validation Subroutine Support

The C<allow> parameter accepts subroutine references for dynamic validation,
enabling complex parameter checks beyond static regex patterns.
These callbacks:

=over 4

=item * Receive three arguments: the parameter key, value and the C<CGI::Info> instance

=item * Must return a true value to allow the parameter, false to reject

=item * Can access other parameters through the instance for contextual validation

=back

Basic usage:

    CGI::Info->new(
        allow => {
            # Simple value check
            even_number => sub { ($_[1] % 2) == 0 },

            # Context-aware validation
            child_age => sub {
                my ($key, $value, $info) = @_;
                $info->param('is_parent') ? $value <= 18 : 0
            }
        }
    );

Advanced features:

    # Combine with regex validation
    mixed_validation => {
        email => qr/@/,  # Regex check
        promo_code => \&validate_promo_code  # Subroutine check
    }

    # Throw custom exceptions
    dangerous_param => sub {
        die 'Hacking attempt!' if $_[1] =~ /DROP TABLE/;
        return 1;
    }
=cut

=head2 param($field)

Get a single CGI parameter value by name.
When called without arguments it delegates to C<params()> and returns all parameters.
When called with a field name it returns that parameter's (sanitised) value,
or C<undef> if the parameter was not supplied or is not in the allow list.

        use CGI::Info;
        my $info = CGI::Info->new();
        my $bar  = $info->param('foo');

        # With an allow list:
        my $info2 = CGI::Info->new();
        my $allowed = { foo => qr/\d+/ };
        $info2->params(allow => $allowed);
        my $bar2 = $info2->param('bar');   # logs a warning; returns undef

=over 4

=item $field

Optional. The name of the CGI parameter to retrieve.
If omitted, all parameters (as a hash-ref) are returned via C<params()>.

=back

=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

=head2 is_mobile

Returns a boolean if the website is being viewed on a mobile
device such as a smartphone.
All tablets are mobile, but not all mobile devices are tablets.

Can be overridden by the IS_MOBILE environment setting

=cut