CGI-Application-Plugin-LinkIntegrity-0.06/ 0042755 0001752 0000144 00000000000 10432775231 017665 5 ustar michael users CGI-Application-Plugin-LinkIntegrity-0.06/t/ 0042755 0001752 0000144 00000000000 10432775231 020130 5 ustar michael users CGI-Application-Plugin-LinkIntegrity-0.06/t/pod.t 0100644 0001752 0000144 00000000214 10432775231 021067 0 ustar michael users #!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); CGI-Application-Plugin-LinkIntegrity-0.06/t/06-built_in_link_tampered_rm.t 0100644 0001752 0000144 00000005733 10432775231 025744 0 ustar michael users use Test::More 'no_plan'; use strict; $ENV{CGI_APP_RETURN_ONLY} = 1; use URI; use URI::QueryParam; my $Created_Link; { package WebApp; use CGI; use CGI::Application; use vars qw(@ISA); use URI; use URI::Escape; @ISA = ('CGI::Application'); use Test::More; use CGI::Application::Plugin::LinkIntegrity; sub setup { my $self = shift; $self->header_type('none'); $self->run_modes([qw( link_okay create_link bad_user_no_biscuit )]); my %li_config = ( secret => 'extree seekrit', ); if ($self->param('custom_rm')) { $li_config{'link_tampered_run_mode'} = 'bad_user_no_biscuit'; } if ($self->param('check')) { $li_config{'checksum_param'} = $self->param('check'); } if ($self->param('create_link')) { $self->start_mode('create_link'); $li_config{'disable'} = 1; } else { $self->start_mode('link_okay'); } $self->link_integrity_config( %li_config, ); } sub link_okay { my $self = shift; return 'rm=link_okay'; } sub create_link { my $self = shift; return $self->link($self->param('create_link')); } sub bad_user_no_biscuit { my $self = shift; return 'rm=bad_user_no_biscuit'; } } ########################################################################### # Build the link $ENV{'REQUEST_METHOD'} = 'POST'; $ENV{'SERVER_PORT'} = '80'; $ENV{'SCRIPT_NAME'} = '/cgi-bin/app.cgi'; $ENV{'SERVER_NAME'} = 'www.example.com'; $ENV{'PATH_INFO'} = '/my/happy/pathy/info'; $ENV{'QUERY_STRING'} = 'zap=zoom&zap=zub&guff=gubbins&zap=zuzzu'; my $link = URI->new(WebApp->new(PARAMS => { create_link => 'http://www.example.com/script.cgi/path/info?p1=v1&p2=v2&p2=v3', })->run); # Validate it $ENV{'REQUEST_METHOD'} = 'POST'; $ENV{'SERVER_PORT'} = $link->port; $ENV{'SCRIPT_NAME'} = $link->path; $ENV{'SERVER_NAME'} = $link->authority; $ENV{'PATH_INFO'} = ''; $ENV{'QUERY_STRING'} = $link->query; is(WebApp->new->run, 'rm=link_okay', 'link_okay'); # remove the _checksum from the query - this should invalidate it my $checksum = $link->query_param_delete('_checksum'); $ENV{'QUERY_STRING'} = $link->query; is(WebApp->new->run, '
sequences (only necessary in old pod2html)
# $text =~ s/<\/pre>(\s*)/$1/imsg;
# remove redundant tags (only necessary in old pod2html)
# $text =~ s/<\/pre>(\s*)<\/dd>\s*/$1/imsg;
open my $fh, '>', $target or die "can't clobber $target: $!\n";
print $fh $text;
close $fh;
foreach my $tempfile (@Tempfiles) {
unlink $tempfile;
}
}
foreach my $target (keys %COPY) {
my $source = $COPY{$target};
copy($source, $target);
}
CGI-Application-Plugin-LinkIntegrity-0.06/misc/prove_prereqs.pl 0100644 0001752 0000144 00000004772 10432775231 024056 0 ustar michael users #!/usr/bin/perl
=pod
This script allows you to run the test suite, simulating the absense of
a particular set of Perl modules, even if they are installed on your
system.
To run the test suite multiple times in a row, each tie multiple times
(each with a different selection of absent modules), run:
$ perl misc/prove_prereqs.pl t/*.t
To add a new set of absent modules, make a subdir under t/prereq_scenarios, and
add a dummy perl module for every module you want to skip. This file
should be empty. For instance if you wanted to simulate the absense of
XML::Complicated and Config::Obscure, you would do the following:
$ mkdir t/prereq_scenarios/skip_xc+co
$ mkdir t/prereq_scenarios/skip_xc+co/XML
$ touch t/prereq_scenarios/skip_xc+co/XML/Complicated.pm
$ mkdir t/prereq_scenarios/skip_xc+co/Config
$ touch t/prereq_scenarios/skip_xc+co/Config/Obscure.pm
Finally, add this directory to the @Scenarios array below.
=cut
my @Scenarios = qw(
t/prereq_scenarios/cgi-3.10
t/prereq_scenarios/cgi-3.11
t/prereq_scenarios/cgi-3.20
);
###################################################################
use strict;
use File::Find;
unless (@ARGV) {
die "Usage: $0 [args to prove]\n";
}
my %Skip_Modules;
my $errors;
foreach my $prereq_scenarios_dir (@Scenarios) {
if (!-d $prereq_scenarios_dir) {
$errors = 1;
warn "Skip lib dir does not exist: $prereq_scenarios_dir\n";
next;
}
my @modules;
find(sub {
return unless -f;
my $dir = "$File::Find::dir/$_";
$dir =~ s/^\Q$prereq_scenarios_dir\E//;
$dir =~ s/\.pm$//;
$dir =~ s{^/}{};
$dir =~ s{/}{::}g;
push @modules, $dir;
}, $prereq_scenarios_dir);
$Skip_Modules{$prereq_scenarios_dir} = \@modules;
}
die "Terminating." if $errors;
foreach my $prereq_scenarios_dir (@Scenarios) {
my $modules = join ', ', sort @{ $Skip_Modules{$prereq_scenarios_dir} };
$modules ||= 'none';
print "\n##############################################################\n";
print "Running tests. Old (or absent) modules in this scenario:\n";
print "$modules\n";
my @prove_command = ('prove', '-Ilib', "-I$prereq_scenarios_dir", @ARGV);
system(@prove_command) && do {
die <