#!/usr/bin/perl -wT use strict; use Test::More (tests => 55); use Data::FormValidator; use Data::FormValidator::Constraints qw/ :closures FV_max_length /; # A gift from Andy Lester, this trick shows me where eval's die. use Carp; $SIG{__WARN__} = \&carp; $SIG{__DIE__} = \&confess; $ENV{PATH} = "/bin/"; sub is_tainted { my $val = shift; # What does kill do here? -mls return !eval { $val++, kill 0; 1; }; } my $data1 = { firstname => $ARGV[0], #Jim }; my $data2 = { lastname => $ARGV[1], #Beam email1 => $ARGV[2], #jim@foo.bar email2 => $ARGV[3], #james@bar.foo }; my $data3 = { ip_address => $ARGV[4], #132.10.10.2 cats_name => $ARGV[5], #Monroe dogs_name => $ARGV[6], #Rufus }; my $data4 = { zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345 zip_field2 => [$ARGV[7],$ARGV[8]], #12345 , oops }; my $data5 = { zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345 zip_field2 => [$ARGV[7],$ARGV[7]], #12345 , oops }; my $data6 = { zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345 zip_field2 => [$ARGV[7],$ARGV[7]], #12345 , oops email1 => $ARGV[2], #jim@foo.bar email2 => $ARGV[3], #james@bar.foo }; my $data7 = { zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345 zip_field2 => [$ARGV[7],$ARGV[7]], #12345 , oops email1 => $ARGV[2], #jim@foo.bar email2 => $ARGV[3], #james@bar.foo }; my $profile = { rules1 => { untaint_constraint_fields => "firstname", required => "firstname", # constraints => { # firstname => '/^\w{1,15}$/' # }, constraint_methods => { firstname => FV_max_length(15), }, }, rules2 => { untaint_constraint_fields => [ qw( lastname email1 )], required => [ qw( lastname email1 email2) ], constraints => { lastname => '/^\w{1,10}$/', email1 => "email", email2 => "email", } }, rules2_closure => { untaint_constraint_fields => [ qw( email1 )], required => [ qw( email1 email2) ], constraint_methods => { email1 => email(), email2 => email(), } }, rules3 => { untaint_all_constraints => 1, required => [ qw(ip_address cats_name dogs_name) ], constraints => { ip_address => "ip_address", cats_name => '/^Felix$/', dogs_name => 'm/^rufus$/i', } }, rules4 => { untaint_constraint_fields=> ['zip_field1','zip_field2'], required=>[qw/zip_field1 zip_field2/], constraints=> { zip_field1=>'zip', }, }, rules5 => { untaint_regexp_map => qr/^zip_field\d/, required_regexp => qr/^zip_field\d/, constraint_method_regexp_map => { qr/^zip_field\d/ => zip(), }, }, rules6 => { untaint_regexp_map => [qr/^zip_field\d/, qr/^email\d/], required_regexp => qr/^(zip_field|email)\d/, constraint_method_regexp_map => { qr/^zip_field\d/ => zip(), qr/^email\d/ => email(), }, }, rules7 => { required_regexp => qr/^zip_field\d/, required => [qw(email1 email2)], untaint_regexp_map => [qr/^zip_field\d/, qr/^email\d/], untaint_constraint_fields => [qw(email1 email2)], constraint_method_regexp_map => { qr/^zip_field\d/ => zip(), }, constraints => { email1 => 'email', email2 => 'email', }, }, }; my $validator = new Data::FormValidator($profile); #Rules #1 my ( $valid, $missing, $invalid, $unknown ); eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data1, "rules1"); }; is($@,'','avoided eval error'); ok($valid->{firstname}, 'found firstname'); ok(! is_tainted($valid->{firstname}), 'firstname is untainted'); is($valid->{firstname},$data1->{firstname}, 'firstname has expected value'); #Rules #2 eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data2, "rules2"); }; is($@,'','avoided eval error'); ok($valid->{lastname}); ok(!is_tainted($valid->{lastname})); is($valid->{lastname},$data2->{lastname}); ok($valid->{email1}); ok(!is_tainted($valid->{email1})); is($valid->{email1},$data2->{email1}); ok($valid->{email2}); ok(is_tainted($valid->{email2}), 'email2 is tainted'); is($valid->{email2},$data2->{email2}); # Rules2 with closures { my ($result,$valid); eval { $result = $validator->check( $data2, "rules2_closure"); }; is($@,'', 'survived eval'); $valid = $result->valid(); ok($valid->{email1}, "found email1 in \%valid") || warn Dumper ($data2,$result); ok(!is_tainted($valid->{email1}), "email one is not tainted"); is($valid->{email1},$data2->{email1}, "email1 identity"); } #Rules #3 eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data3, "rules3"); }; ok(!$@); ok($valid->{ip_address}); ok(!is_tainted($valid->{ip_address})); is($valid->{ip_address},$data3->{ip_address}); #in this case we're expecting no match ok(!(exists $valid->{cats_name}), 'cats_name is not valid'); is($invalid->[0], 'cats_name', 'cats_name fails constraint'); ok($valid->{dogs_name}); ok(!is_tainted($valid->{dogs_name})); is($valid->{dogs_name},$data3->{dogs_name}); # Rules # 4 eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data4, "rules4"); }; ok(!$@, 'avoided eval error'); ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted'); ok(is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be tainted'); my $results = Data::FormValidator->check( { qr_re_no_parens => $ARGV[9], # 0 qr_re_parens => $ARGV[9], # 0 }, { required => [qw/qr_re_no_parens qr_re_parens/], constraints=>{ qr_re_no_parens => qr/^.*$/, qr_re_parens => qr/^(.*)$/, }, untaint_all_constraints =>1 }); is($results->valid('qr_re_no_parens'),0,'qr RE without parens in untainted'); is($results->valid('qr_re_parens') ,0,'qr RE with parens in untainted'); # Rules #5 eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data5, "rules5"); }; ok(!$@, 'avoided eval error'); ok($valid->{zip_field1}, "zip_field1 should be valid"); ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted'); ok($valid->{zip_field2}, "zip_field2 should be valid"); ok(!is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be untainted'); # Rules #6 eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data6, "rules6"); }; ok(!$@, 'avoided eval error'); ok($valid->{zip_field1}, "zip_field1 should be valid"); ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted'); ok($valid->{zip_field2}, "zip_field2 should be valid"); ok(!is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be untainted'); ok($valid->{email1}, "email1 should be valid"); ok(!is_tainted($valid->{email1}), 'email1 should be untainted'); ok($valid->{email2}, "email2 should be valid"); ok(!is_tainted($valid->{email2}), 'email2 should be untainted'); # Rules #7 eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data7, "rules7"); }; ok(!$@, 'avoided eval error'); ok($valid->{zip_field1}, "zip_field1 should be valid"); ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted'); ok($valid->{zip_field2}, "zip_field2 should be valid"); ok(!is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be untainted'); ok($valid->{email1}, "email1 should be valid"); ok(!is_tainted($valid->{email1}), 'email1 should be untainted'); ok($valid->{email2}, "email2 should be valid"); ok(!is_tainted($valid->{email2}), 'email2 should be untainted');