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 <