#!/usr/bin/perl # # Test::Simple is nice, especially since we can print out additional # notes (namely, the name of the function we're testing). However, # older perls don't have Test::Simple, so we're stuck with the less # flexible Test module. So we check to see which modules are # available, and use our own mok() (my_ok) to figure out the proper # way to invoke ok() (i.e. with our without notes). # BEGIN { $NUMTESTS = 140; eval { require "../LW2.pm" }; die("Libwhisker2 not installed!?!?") if($@); @VERSION = split(/\./, $LW2::VERSION); if($VERSION[0] != 2 || $VERSION[1] < 4){ die("This harness expects LW2 2.4 or later"); } $TESTSIMPLE=0; eval "use Test::Simple tests=>$NUMTESTS"; if($@){ # no Test::Simple, try to use Test instead eval "use Test"; if($@){ die("Test or Test::Simple need to be installed"); } plan(tests => $NUMTESTS); } else { $TESTSIMPLE=1; } } sub mok { # my ok(), for figuring out which ok() to use my ($result, $note) = @_; if($TESTSIMPLE){ ok($result, $note); } else { ok($result); } } ########################################################################## # Encode functions # disable MIME::Base64 and use built in version instead LW2::encode_base64('test'); undef $MIME::Base64::VERSION; $INITIAL_DATA = "Libwhisker2 default test value"; $EXPECTED = "TGlid2hpc2tlcjIgZGVmYXVsdCB0ZXN0IHZhbHVl"; $temp = LW2::encode_base64($INITIAL_DATA, ''); mok( $temp eq $EXPECTED, 'encode_base64' ); $temp = LW2::decode_base64($temp); mok($temp eq $INITIAL_DATA, 'decode_base64'); $INITIAL_DATA = "/012/abc/ \\&/=;/"; $EXPECTED = "/%30%31%32/%61%62%63/%20%5c%26/%3d%3b/"; $temp = LW2::encode_uri_hex($INITIAL_DATA); mok($temp eq $EXPECTED, 'encode_uri_hex'); # encode_uri_randomhex is random, so can't be reliably tested # encode_uri_randomcase is random, so can't be reliably tested $INITIAL_DATA = "test"; $EXPECTED = "t\x00e\x00s\x00t\x00"; $temp = LW2::encode_unicode($INITIAL_DATA); mok($temp eq $EXPECTED, 'encode_unicode'); $INITIAL_DATA = "abc\xc0\xafdef"; $EXPECTED = "abc/def"; $temp = LW2::decode_unicode($INITIAL_DATA); mok($temp eq $EXPECTED, 'decode_unicode'); # TODO: encode_anti_ids? ########################################################################## # mdx functions # disable MD5 and use built in version instead LW2::md5('test'); undef $MD5::VERSION; $INITIAL_DATA = "Libwhisker2 default test value"; $EXPECTED = "44c9975b203df2c1de2b0bda1b5f515b"; $temp = LW2::md5($INITIAL_DATA); mok($temp eq $EXPECTED, 'md5'); $INITIAL_DATA = "Libwhisker2 default test value"; $EXPECTED = "0b1e75f19334a77d2b18dce72311d030"; $temp = LW2::md4($INITIAL_DATA); mok($temp eq $EXPECTED, 'md4'); ########################################################################## # uri functions $INITIAL_DATA = 'https://user1:pass1@server:81/dir1/dir2/page?param1#frag'; @EXPECTED = ('/dir1/dir2/page', 'https', 'server', 81, 'param1', 'frag', 'user1', 'pass1'); @temp = LW2::uri_split($INITIAL_DATA); $BAD = 0; for($x=0; $x<8; $x++){ $BAD++ if($EXPECTED[$x] ne $temp[$x]); } mok(!$BAD, 'uri_split'); $temp = LW2::uri_join(@temp); mok($temp eq $INITIAL_DATA, 'uri_join'); %EXPECTED = ( uri => '/dir1/dir2/page', port => 81, host=>'server', ssl=>1, uri_user=>'user1', uri_password=>'pass1', parameters=>'param1' ); $BAD = 0; $REQUEST = LW2::http_new_request(); if(ref($REQUEST) ne 'HASH' || !defined $REQUEST->{whisker} || ref($REQUEST->{whisker}) ne 'HASH'){ mok(0, 'http_new_request pre-check'); } else { mok(1, 'http_new_request pre-check'); LW2::uri_split($INITIAL_DATA,$REQUEST); foreach (keys %EXPECTED){ if(!defined $REQUEST->{whisker}->{$_} || $REQUEST->{whisker}->{$_} ne $EXPECTED{$_}){ $BAD++; } } } mok(!$BAD, 'uri_split (hash)'); $INITIAL_DATA = "http://server2/page2"; %EXPECTED = ( uri => '/page2', port => 80, host=>'server2', ssl=>0, uri_user=>undef, uri_password=>undef, parameters=>undef ); @temp = LW2::uri_split($INITIAL_DATA,$REQUEST); $BAD=0; foreach (keys %EXPECTED){ if(defined $EXPECTED{$_}){ if(!defined $REQUEST->{whisker}->{$_} || $REQUEST->{whisker}->{$_} ne $EXPECTED{$_}){ $BAD++; } } else { if(defined $REQUEST->{whisker}->{$_}){ $BAD++; } } } mok(!$BAD, 'uri_split no.2'); $temp = LW2::uri_join(@temp); mok($temp eq $INITIAL_DATA, 'uri_join'); $BAD=0; $BADSTR=''; @INITIAL_DATA = ( ['http://server/dir/page', 'http://baseserver/basedir/basepage', 'http://server/dir/page'], ['/otherdir/page2', 'http://baseserver/basedir/basepage', 'http://baseserver/otherdir/page2'], ['page3','http://baseserver/basedir/basepage','http://baseserver/basedir/page3'], ['/dir/page','/otherdir/otherpage','/dir/page'], ['/dir/page','http://server','http://server/dir/page'], ['page','http://server','http://server/page'], ['page','http://server/stuff','http://server/page'], ['/dir1/page1','http://server/dir1/page2','http://server/dir1/page1'], ['dir/dir2/page','http://server/page','http://server/dir/dir2/page'], ['dir/dir2/page','http://server/dir/','http://server/dir/dir/dir2/page'], ['dir/page','http://server:81','http://server:81/dir/page'], ['dir/page','http://server:81/x/y','http://server:81/x/dir/page'], ['/dir/page','https://server/x/y','https://server/dir/page'], ['/dir/page','http://server:81/x/y','http://server:81/dir/page'], ['/dir/page','http://server:81','http://server:81/dir/page'], ['/dir1/page1?param1','http://server/','http://server/dir1/page1?param1'], ['/dir1/page1?param1','http://server/dir2/page2?param2','http://server/dir1/page1?param1'], ['dir1/page1?param1','http://server/dir2/page2?param2','http://server/dir2/dir1/page1?param1'], ['page1?param1','http://server/dir/?param2','http://server/dir/page1?param1'], ['page1?param1','http://server/dir/#param2','http://server/dir/page1?param1'] ); for($x=0; $x<~~@INITIAL_DATA; $x++){ $temp = LW2::uri_absolute($INITIAL_DATA[$x]->[0], $INITIAL_DATA[$x]->[1]); if($temp ne $INITIAL_DATA[$x]->[2]){ $BAD++; $BADSTR.=",$x"; } } mok(!$BAD, 'uri_join no.2 '.$BADSTR); $BAD=0; $BADSTR=''; @INITIAL_DATA = ( ['http://server/page','http://server/page'], ['http://server\\page','http://server/page'], ['http://server/dir1/../dir2/page','http://server/dir2/page'], ['http://server/dir1/../','http://server/'], ['http://server/dir1/dir2/..','http://server/dir1/'], ['http://server/././././././dir1/page','http://server/dir1/page'], ['http://server/..\\../../x/..\\..\\../a/b','http://server/a/b'], ['/..\\..///../x//..\\/..\\../a/b','/a/b'], ['http://server','http://server/'], ['/dir/.test/page','/dir/.test/page'], ['/dir/././././','/dir/'], ['/dir/././././p','/dir/p'], ['/dir/./././../p','/p'], ['/d/./p?x','/d/p?x'], ['/d/./?x','/d/?x'], ['/d/../?x','/?x'], ['/d?x/../','/d?x/../'], ['/d/..#x','/#x'] ); for($x=0; $x<~~@INITIAL_DATA; $x++){ $temp = LW2::uri_normalize($INITIAL_DATA[$x]->[0],1); if($temp ne $INITIAL_DATA[$x]->[1]){ $BAD++; $BADSTR.=", $x"; } } mok(!$BAD, 'uri_normalize '.$BADSTR); $BAD=0; $BADSTR=''; @INITIAL_DATA = ( ['page',''], ['d/','d/'], ['/d/','/d/'], ['/d/?p','/d/'], ['/d/#f','/d/'], ['/a/b/c','/a/b/'], ['/a','/'] ); for($x=0; $x<~~@INITIAL_DATA; $x++){ $temp = LW2::uri_get_dir($INITIAL_DATA[$x]->[0]); if($temp ne $INITIAL_DATA[$x]->[1]){ $BAD++; $BADSTR.=", $x"; } } mok(!$BAD, 'uri_get_dir '.$BADSTR); $BAD=0; $BADSTR=''; @INITIAL_DATA = ( ['/a/b','/a/b'], ['/a/b/','/a/b/'], ['/;foo','/'], [';foo/','/'], [';foo',''], ['/a/b;foo','/a/b'], ['/a;foo/b','/a/b'], [';foo/a/','/a/'], ['/;foo/;bar/b;baz/','///b/'], ['/b///','/b///'] ); for($x=0; $x<~~@INITIAL_DATA; $x++){ $temp = LW2::uri_strip_path_parameters($INITIAL_DATA[$x]->[0]); if($temp ne $INITIAL_DATA[$x]->[1]){ $BAD++; $BADSTR.=", $x"; } } mok(!$BAD, 'uri_strip_path_parameters '.$BADSTR); $BAD=0; $INITIAL_DATA = '/a;A=1/b;B=2/c;C=3/;D=4'; %EXPECTED = (a=>'A=1',b=>'B=2',c=>'C=3',''=>'D=4'); $temp = {}; LW2::uri_strip_path_parameters($INITIAL_DATA, $temp); foreach( keys %EXPECTED ){ if(!defined $temp->{$_} || $temp->{$_} ne $EXPECTED{$_}){ $BAD++; } delete $temp->{$_}; } if(keys %$temp){ $BAD++; } mok(!$BAD,'uri_strip_path_parameters'); $BAD=0; $BADSTR=''; @INITIAL_DATA = ( ['a=1',{a=>'1'}], ['a',{a=>undef}], ['&',{}], ['=',{''=>''}], ['=1',{''=>'1'}], ['a=1&b=2&c=3',{a=>'1',b=>'2',c=>'3'}], ['a=1&b&c=3',{a=>'1',b=>undef,c=>'3'}], ['a=1&a=2&a=3',{a=>'3'}] ); for($x=0; $x<~~@INITIAL_DATA; $x++){ $temp = LW2::uri_parse_parameters( $INITIAL_DATA[$x]->[0] ); foreach (keys %{ $INITIAL_DATA[$x]->[1] }){ if(!exists $temp->{$_} || $temp->{$_} ne $INITIAL_DATA[$x]->[1]->{$_}){ $BAD++; $BADSTR.=", $x"; } delete $temp->{$_}; } if(keys %$temp){ $BAD++; } } mok(!$BAD,'uri_parse_parameters '.$BADSTR); $BAD=0; $INITIAL_DATA = 'a=a1&b=b1&a=a2'; $temp = LW2::uri_parse_parameters( $INITIAL_DATA, 0, 1 ); if(!defined $temp->{a} || ref($temp->{a}) ne 'ARRAY' || $temp->{a}->[0] ne 'a1' || $temp->{a}->[1] ne 'a2' || !defined $temp->{b} || $temp->{b} ne 'b1'){ $BAD++; } mok(!$BAD, 'uri_parse_parameters no.2'); $BADe=0; $BADSTRe=''; $BADu=0; $BADSTRu=''; @INITIAL_DATA = ( ['abc','abc'], ['a%b','a%25b'], ['a b','a+b'], ['a b','a++++b'], ['a%%%b','a%25%25%25b'], ['a%25b','a%2525b'], ['a+b','a%2bb'], ['+=?&#@;\\/','%2b%3d%3f%26%23%40%3b%5c%2f'], ["ab\x00cd",'ab%00cd'], ["ab%\xff\xfe\x01cd",'ab%25%ff%fe%01cd'] ); for($x=0; $x<~~@INITIAL_DATA; $x++){ $temp = LW2::uri_escape($INITIAL_DATA[$x]->[0]); if($temp ne $INITIAL_DATA[$x]->[1]){ $BADe++; $BADSTRe .= ", $x"; } $temp = LW2::uri_unescape($INITIAL_DATA[$x]->[1]); if($temp ne $INITIAL_DATA[$x]->[0]){ $BADu++; $BADSTRu .= ", $x"; } } mok(!$BADe, 'uri_escape '.$BADSTRe); mok(!$BADu, 'uri_unescape '.$BADSTRu); ########################################################################## # utils functions # TODO: utils_recperm # utils_array_shuffle, assumed good, nothing to test %temp = (); # this test can fail, since it could randomly come up with # the same string, but the odds of that should be low $BAD=0; for(0..5){ $temp = LW2::utils_randstr(); if(length($temp)<10 || length($temp)>20 || $temp=~tr/A-Za-z0-9//c || defined $temp{$temp}){ $BAD++; } $temp{$temp}++; } mok(!$BAD,'utils_randstr'); $temp = LW2::utils_randstr(11,'ABC'); if(length($temp) != 11 || $temp=~tr/ABC//c){ print "FAIL: utils_randstr (w/ params)\n"; } # utils_port_open... $BAD=0; %INITIAL_DATA = ( AAA=>'Aaa', bBb=>'Bbb', ccc=>'Ccc', '123'=>'Ddd', ''=>'Eee', "\x80\xc0\xd0\xff"=>'Fff' ); %EXPECTED = ( aaa=>'Aaa', bbb=>'Bbb', ccc=>'Ccc', '123'=>'Ddd', ''=>'Eee', "\x80\xc0\xd0\xff"=>'Fff' ); $temp = LW2::utils_lowercase_keys(\%INITIAL_DATA); if($temp != 2){ $BAD++; } foreach (keys %EXPECTED){ if(!defined $INITIAL_DATA{$_} || $INITIAL_DATA{$_} ne $EXPECTED{$_}){ $BAD++; } delete $INITIAL_DATA{$_}; } if(keys %INITIAL_DATA){ $BAD++; } mok(!$BAD,'utils_lowercase_keys'); %INITIAL_DATA = ( AAA=>'1', Aaa=>'2', ''=>'3', BBB=>'4', M=>['X','Y'], m=>'Z' ); $temp = LW2::utils_find_key( \%INITIAL_DATA, 'foo' ); mok(!defined $temp, 'utils_find_key no.1'); $temp = LW2::utils_find_key( \%INITIAL_DATA, '' ); mok(defined $temp && !ref($temp) && $temp eq '3', 'utils_find_key no.2'); @temp = LW2::utils_find_key( \%INITIAL_DATA, '' ); mok(defined $temp[0] && $temp[0] eq '3' && ~~@temp == 1, 'utils_find_key no.3'); $temp = LW2::utils_find_key( \%INITIAL_DATA, 'M' ); mok(!(!defined $temp || ref($temp) ne 'ARRAY' || $temp->[0] ne 'X' || $temp->[1] ne 'Y' || ~~@$temp != 2),'utils_find_key no.4'); @temp = LW2::utils_find_key( \%INITIAL_DATA, 'M' ); mok(!(!defined $temp[0] || !defined $temp[1] || $temp[0] ne 'X' || $temp[1] ne 'Y' || ~~@temp != 2),'utils_find_key no.5'); $temp = LW2::utils_find_lowercase_key( \%INITIAL_DATA, 'bbb' ); mok(!(!defined $temp || $temp ne '4'),'utils_find_lowercase_key no.1'); $temp = LW2::utils_find_lowercase_key( \%INITIAL_DATA, 'BBB' ); mok(!(!defined $temp || $temp ne '4'), 'utils_find_lowercase_key no.2'); @temp = LW2::utils_find_lowercase_key( \%INITIAL_DATA, 'BbB' ); mok(!(!defined $temp[0] || $temp[0] ne '4' || ~~@temp != 1), 'utils_find_lowercase_key no.3'); $BAD=0; $temp = LW2::utils_find_lowercase_key( \%INITIAL_DATA, 'aAa' ); if(!defined $temp || ref($temp) ne 'ARRAY'){ $BAD++; } else { @temp = sort @$temp; if($temp[0] ne '1' || $temp[1] ne '2' || ~~@$temp != 2){ $BAD++; } } mok(!$BAD,'utils_find_lowercase_key no.4'); $BAD=0; $temp = LW2::utils_find_lowercase_key( \%INITIAL_DATA, 'm' ); if(!defined $temp || ref($temp) ne 'ARRAY'){ $BAD++; } else { @temp = sort @$temp; if($temp[0] ne 'X' || $temp[1] ne 'Y' || $temp[2] ne 'Z' || ~~@$temp != 3){ $BAD++; } } mok(!$BAD,'utils_find_lowercase_key no.5'); %INITIAL_DATA = ( AAA=>'1', Aaa=>'2', ''=>'3', BBB=>'4', M=>['X','Y'], m=>'Z' ); $temp = LW2::utils_delete_lowercase_key( \%INITIAL_DATA, 'm' ); mok(!($temp != 2 || defined $INITIAL_DATA{'M'} || defined $INITIAL_DATA{'m'} ), 'utils_delete_lowercase_key no.1'); $temp = LW2::utils_delete_lowercase_key( \%INITIAL_DATA, 'AaA' ); mok(!($temp != 2 || defined $INITIAL_DATA{'AAA'} || defined $INITIAL_DATA{'Aaa'} || $INITIAL_DATA{''} ne '3' || $INITIAL_DATA{'BBB'} ne '4'), 'utils_delete_lowercase_key no.2'); $BAD=0; $INITIAL_DATA = "A\nB\nC"; $temp = LW2::utils_getline(\$INITIAL_DATA); $BAD++ if($temp ne 'A'); $temp = LW2::utils_getline(\$INITIAL_DATA); $BAD++ if($temp ne 'B'); $temp = LW2::utils_getline(\$INITIAL_DATA); $BAD++ if(defined $temp); $temp = LW2::utils_getline(\$INITIAL_DATA); $BAD++ if(defined $temp); $temp = LW2::utils_getline(\$INITIAL_DATA, 0); $BAD++ if($temp ne 'A'); mok(!$BAD,'utils_getline'); $BAD=0; $INITIAL_DATA = "A\r\nB\r\nC\rD\r\nE\nF\r\nG"; $temp = LW2::utils_getline_crlf(\$INITIAL_DATA); $BAD++ if($temp ne 'A'); $temp = LW2::utils_getline_crlf(\$INITIAL_DATA); $BAD++ if($temp ne 'B'); $temp = LW2::utils_getline_crlf(\$INITIAL_DATA); $BAD++ if($temp ne "C\rD"); $temp = LW2::utils_getline_crlf(\$INITIAL_DATA); $BAD++ if($temp ne "E\nF"); $temp = LW2::utils_getline_crlf(\$INITIAL_DATA); $BAD++ if(defined $temp); $temp = LW2::utils_getline_crlf(\$INITIAL_DATA); $BAD++ if(defined $temp); $temp = LW2::utils_getline_crlf(\$INITIAL_DATA, 0); $BAD++ if($temp ne 'A'); mok(!$BAD,'utils_getline_crlf'); # TODO: utils_save_page @ARGV = ('-a','-b','bval','c','-d','','e'); %temp = (); LW2::utils_getopts('ab:d:', \%temp ); mok(!(!defined $temp{a} || $temp{a} ne '1' || !defined $temp{b} || $temp{b} ne 'bval' || !defined $temp{d} || $temp{d} ne '' || keys %temp != 3 || $ARGV[0] ne 'c' || $ARGV[1] ne 'e'), 'utils_getopts'); @ARGV = (); $INITIAL_DATA = "abc def ghijkl"; $temp = LW2::utils_text_wrapper($INITIAL_DATA, "\n", 4); mok($temp eq "abc\ndef\nghij\nkl\n", 'utils_text_wrapper'); # TODO: brute URL $BAD=0; $temp = LW2::utils_join_tag('TAG', { 'a'=>'b' }); $BAD++ if($temp ne ''); $temp = LW2::utils_join_tag('TAG', { 'a'=>undef }); $BAD++ if($temp ne ''); $temp = LW2::utils_join_tag('TAG', { 'a'=>'1', 'b'=>'2' }); $BAD++ if($temp ne '' && $temp ne ''); $temp = LW2::utils_join_tag('TAG', {} ); $BAD++ if($temp ne ''); mok(!$BAD, 'utils_join_tag'); %INITIAL_DATA = ( 'A'=>'aa', 'B'=>'bb', 'whisker'=>{ 'MAGIC'=>31339, 'C'=>'cc' } ); %temp = (); LW2::utils_request_clone( \%INITIAL_DATA, \%temp ); mok(!(!defined $temp{A} || $temp{A} ne 'aa' || !defined $temp{B} || $temp{B} ne 'bb' || !defined $temp{whisker} || ref($temp{whisker}) ne 'HASH' || !defined $temp{whisker}->{MAGIC} || $temp{whisker}->{MAGIC} != 31339 || !defined $temp{whisker}->{C} || $temp{whisker}->{C} ne 'cc' || keys %temp != 3 || keys %{$temp{whisker}} != 2), 'utils_request_clone no.1'); %INITIAL_DATA = ( 'A'=>['a1','a2'], 'whisker'=>{ 'MAGIC'=>31339, 'C'=>['c1','c2'] } ); %temp = (); LW2::utils_request_clone( \%INITIAL_DATA, \%temp ); mok(!(!defined $temp{A} || ref($temp{A}) ne 'ARRAY' || $temp{A}->[0] ne 'a1' || $temp{A}->[1] ne 'a2' || !defined $temp{whisker} || ref($temp{whisker}) ne 'HASH' || !defined $temp{whisker}->{MAGIC} || $temp{whisker}->{MAGIC} != 31339 || !defined $temp{whisker}->{C} || ref($temp{whisker}->{C}) ne 'ARRAY' || $temp{whisker}->{C}->[0] ne 'c1' || $temp{whisker}->{C}->[1] ne 'c2' || keys %temp != 2 || keys %{$temp{whisker}} != 2), 'utils_request_clone no.2'); # TODO: utils_request_fingerprint # utils_flatten_lwhash # - test http_req2line/http_resp2line and http_construct_headers first ########################################################################## # cookie functions # # NOTE! we cheat and use internal knowledge that the cookie jar is just # a hash reference, in order to verify it's contents for these tests. # Ideally, we wouldn't be making that assumption, as the structure and # contents of the cookie jar are subject to change. # $JAR = LW2::cookie_new_jar(); mok( defined $JAR && ref($JAR) eq 'HASH', 'cookie_new_jar'); die("Need working cookie jar") if(!defined $JAR || ref($JAR) ne 'HASH'); @INITIAL_DATA = ( ['cook1','v1','d1.com','/u','2',0,'v1','d1.com','/u',undef,0], ['cook2','v2','d2.com',undef,undef,0,'v2','d2.com','/',undef,0], ['cook3','v3',undef,undef,undef,1,'v3',undef,'/',undef,1], ['$cook4','v4',undef,undef,undef,undef,'v4',undef,'/',undef,0], ); $BAD=0; foreach (@INITIAL_DATA){ LW2::cookie_set( $JAR, $_->[0], $_->[1], $_->[2], $_->[3], $_->[4], $_->[5]); if(defined $JAR->{$_->[0]} && ref($JAR->{$_->[0]}) eq 'ARRAY'){ for($x=0;$x<5;$x++){ if( defined $JAR->{$_->[0]}->[$x] && defined $_->[6+$x]){ $BAD++ if($JAR->{$_->[0]}->[$x] ne $_->[6+$x]); } else { $BAD++ if(defined $JAR->{$_->[0]}->[$x] && !defined $_->[6+$x]); $BAD++ if(!defined $JAR->{$_->[0]}->[$x] && defined $_->[6+$x]); } } } else { $BAD++; } delete $JAR->{$_->[0]}; $BAD++ if(keys %$JAR); } mok(!$BAD,'cookie_set no.1'); LW2::cookie_set( $JAR, '', 'val', undef, undef, undef, undef ); mok( !keys %$JAR, 'cookie_set no.2'); $JAR = LW2::cookie_new_jar(); LW2::cookie_set($JAR,'cook','val'); $BAD=0; if(defined $JAR->{cook}){ LW2::cookie_set($JAR,'cook',''); $BAD++ if(defined $JAR->{cook}); } else { $BAD++; } mok(!$BAD,'cookie_set no.3'); $JAR = LW2::cookie_new_jar(); LW2::cookie_set($JAR,'cook','val'); $BAD=0; if(defined $JAR->{cook}){ LW2::cookie_set($JAR,'cook',undef); $BAD++ if(defined $JAR->{cook}); } else { $BAD++; } mok(!$BAD,'cookie_set no.4'); $JAR = LW2::cookie_new_jar(); LW2::cookie_set($JAR,'A','a'); LW2::cookie_set($JAR,'B','b'); LW2::cookie_set($JAR,'C','c'); @temp = LW2::cookie_get_names($JAR); @temp = sort @temp; mok( ($temp[0] eq 'A' && $temp[1] eq 'B' && $temp[2] eq 'C'), 'cookie_get_names'); $JAR = LW2::cookie_new_jar(); @INITIAL_DATA = ( ['cook1','v1','d1.com','/u','2',0,'v1','d1.com','/u',undef,0], ['cook2','v2','d2.com',undef,undef,0,'v2','d2.com','/',undef,0], ['cook3','v3',undef,undef,undef,1,'v3',undef,'/',undef,1], ['$cook4','v4',undef,undef,undef,undef,'v4',undef,'/',undef,0], ); $BAD=0; foreach (@INITIAL_DATA){ LW2::cookie_set( $JAR, $_->[0], $_->[1], $_->[2], $_->[3], $_->[4], $_->[5]); @temp = LW2::cookie_get($JAR, $_->[0]); if( !defined $temp[0] ){ $BAD++; next; } for($x=0;$x<5;$x++){ if( defined $temp[$x] && defined $_->[6+$x]){ $BAD++ if($temp[$x] ne $_->[6+$x]); } else { $BAD++ if(defined $temp[$x] && !defined $_->[6+$x]); $BAD++ if(!defined $temp[$x] && defined $_->[6+$x]); } } } mok(!$BAD,'cookie_get'); @INITIAL_DATA = ( ['c=v',undef,undef, 'c','v',undef,'/',undef,0], ['c=v;',undef,undef, 'c','v',undef,'/',undef,0], ['$c=v',undef,undef, '$c','v',undef,'/',undef,0], ['c = v',undef,undef, 'c','v',undef,'/',undef,0], [' c = v ',undef,undef, 'c','v',undef,'/',undef,0], [' c = v ; ',undef,undef, 'c','v',undef,'/',undef,0], ['c="v"',undef,undef, 'c','v',undef,'/',undef,0], [' c = "v" ',undef,undef, 'c','v',undef,'/',undef,0], ['c=v; path=/',undef,undef, 'c','v',undef,'/',undef,0], ['c=v; path=',undef,undef, 'c','v',undef,'/',undef,0], ['c=v; path=""',undef,undef, 'c','v',undef,'/',undef,0], ['c=v; path=/a/',undef,undef, 'c','v',undef,'/a',undef,0], ['c=v; path=/a; path=/b',undef,undef, 'c','v',undef,'/a',undef,0], ['c=v; path=a',undef,undef, 'c','v',undef,'/',undef,0], ['c=v',undef,'/foo', 'c','v',undef,'/foo',undef,0], ['c=v',undef,'', 'c','v',undef,'/',undef,0], ['c=v',undef,'/foo/', 'c','v',undef,'/foo',undef,0], ['c=v',undef,'foo/', 'c','v',undef,'/',undef,0], ['c=v; path=a',undef,'b', 'c','v',undef,'/',undef,0], ['c=v; path=/a',undef,'/b', 'c','v',undef,'/a',undef,0], ['c=v; path=a',undef,'/b', 'c','v',undef,'/',undef,0], ['c=v; domain=.foo.com',undef,undef, 'c','v','.foo.com','/',undef,0], ['c=v; domain=.foo.com.',undef,undef, 'c','v','.foo.com','/',undef,0], ['c=v; domain=foo.com',undef,undef, 'c','v','.foo.com','/',undef,0], ['c=v; domain=a.com; domain=b.com',undef,undef, 'c','v','.a.com','/',undef,0], ['c=v; domain=1.2.3.4',undef,undef, 'c','v','1.2.3.4','/',undef,0], ['c=v','foo.com',undef, 'c','v','foo.com','/',undef,0], ['c=v','.foo.com',undef, 'c','v','.foo.com','/',undef,0], ['c=v','1.2.3.4',undef, 'c','v','1.2.3.4','/',undef,0], ['c=v; domain=','foo.com',undef, 'c','v','foo.com','/',undef,0], ['c=v; domain=""','foo.com',undef, 'c','v','foo.com','/',undef,0], ['c=v; domain=a.com','b.com',undef, 'c','v','.a.com','/',undef,0], ['c=v; max-age=5',undef,undef, 'c','v',undef,'/',undef,0], ['c=v; misc=foobar',undef,undef, 'c','v',undef,'/',undef,0], ['c=v; secure',undef,undef, 'c','v',undef,'/',undef,1], ['c=v; secure; secure',undef,undef, 'c','v',undef,'/',undef,1], [' c = v ; domain = a.com ; path = /a/ ; ', undef, undef, 'c','v','.a.com','/a',undef,0], [' c = "v" ; domain = "a.com" ; path = "/a/" ; ', undef, undef, 'c','v','.a.com','/a',undef,0], ['c=v; domain="a.com" b.com', undef, undef, 'c','v','.a.com','/',undef,0], ['c=v; path="/a" secure;', undef, undef, 'c','v',undef,'/a',undef,0], ['c=v; path=/a secure; ', undef, undef, 'c','v',undef,'/a',undef,0] ); $BAD=0; foreach (@INITIAL_DATA){ $JAR = LW2::cookie_new_jar(); LW2::cookie_parse( $JAR, $_->[0], $_->[1], $_->[2]); @temp = LW2::cookie_get($JAR, $_->[3]); #print "D: ", LW2::dump($_->[0],\@temp), "\n\n"; if( !defined $temp[0] ){ $BAD++; next; } for($x=0;$x<5;$x++){ if( defined $temp[$x] && defined $_->[4+$x]){ $BAD++ if($temp[$x] ne $_->[4+$x]); } else { $BAD++ if(defined $temp[$x] && !defined $_->[4+$x]); $BAD++ if(!defined $temp[$x] && defined $_->[4+$x]); } } } mok(!$BAD,'cookie_parse no.1'); # cookie_read # cookie_parse # cookie_write # cookie_get_valid_names ########################################################################## # stream functions # test buffer stream, to be able to test http stream handling functions # later; don't use the stream helper function until after this $REQUEST = LW2::http_new_request(); $REQUEST->{whisker}->{buffer_stream}++; $STREAM = LW2::stream_new($REQUEST); $BAD=0; if(defined $STREAM){ $STREAM->{open}->(); $STREAM->{queue}->('abcd'); $BAD++ if !$STREAM->{write}->('efg'); $BAD++ if !$STREAM->{read}->(); $BAD++ if($STREAM->{bufin} ne 'abcdefg'); $STREAM->{clearall}->(); $STREAM->{queue}->('X'); $STREAM->{queue}->('Y'); $STREAM->{queue}->('Z'); $BAD++ if !$STREAM->{write}->(); $BAD++ if !$STREAM->{read}->(); $BAD++ if($STREAM->{bufin} ne 'XYZ'); # $BAD++ if(!(!$STREAM->{read}->() && $STREAM->{eof}==1)); $STREAM->{close}->(); } else { $BAD++; } mok(!$BAD,'basic buffer stream testing'); die("Correctly functioning buffer streams are necessary for the rest of the tests") if($BAD); ########################################################################## # html functions # try to find evil.htm file $SKIPHTML = 0; $EVIL = 'evil.htm'; if(!-e $EVIL){ $EVIL = '../docs/evil.htm' if(-e '../docs' && -d '../docs'); $EVIL = 'docs/evil.htm' if(-e 'docs' && -d 'docs'); } if(!-e $EVIL){ print STDERR "# Unable to find 'evil.htm' file; HTML testing skipped\n"; $SKIPHTML++; } $LITTLEHTML = ''; $EVILHTML = ''; if(!$SKIPHTML){ if(!open(IN,"<$EVIL")){ print STDERR "# Unable to open '$EVIL'\n"; $SKIPHTML++; } else { binmode(IN); while(){ $EVILHTML .= $_; } close(IN); } } sub test_html_minimum { my $tag = shift; my $hr = shift; $HTML_BAD++; $HTML_BAD++ if($tag ne 'tag'); $HTML_BAD++ if(!defined $hr->{param}); $HTML_BAD++ if(defined $hr->{param} && $hr->{param} ne 'one'); return; } sub test_html_minimum2 { my ($tag, $hr, $data, $start, $len, $fr) = @_; test_html_minimum($tag, $hr); $HTML_BAD++ if($$data ne $LITTLEHTML); $HTML_BAD++ if($start != 0); $HTML_BAD++ if($len != length($LITTLEHTML)); $HTML_BAD++ if(!ref($fr) || ref($fr) ne 'ARRAY' || $fr->[0] != 12345); } sub test_html_taglist { my ($tag, $hr, $data, $start, $len, $fr) = @_; return if($HTML_BAD); my $T = shift @$fr; if(!defined $T){ $HTML_BAD++; return; } if($tag ne $T->[0]){ #print STDERR "HD: current tag '$tag' != expected '", $T->[0], "'\n"; #print STDERR "HD2: next expected '", $fr->[0]->[0], "'\n"; #print STDERR "HD3: next expected '", $fr->[1]->[0], "'\n"; $HTML_BAD++; return; } if($tag eq '!--'){ # comments are special return if($T->[1]->{'='} eq '*'); } foreach(keys %$hr){ if(!exists $T->[1]->{$_} || $hr->{$_} ne $T->[1]->{$_}){ #print STDERR "HD: bad value for $_\n"; #print STDERR LW2::dump('d', \$T->[1]->{$_}), "\n"; #print STDERR LW2::dump('a', \$hr->{$_}), "\n"; $HTML_BAD++; return; } delete $T->[1]->{$_}; } if(~~ keys %{ $T->[1] } > 0){ #print STDERR "HD: left over values\n"; $HTML_BAD++; return; } } # really basic test to make sure parser parses a tag $HTML_BAD = 0; LW2::html_find_tags(\$LITTLEHTML, \&test_html_minimum); mok($HTML_BAD==1,'html_find_tags no.1'); # test to make sure all callback parts work $HTML_BAD = 0; $FUNCREF = [ 12345 ]; LW2::html_find_tags(\$LITTLEHTML, \&test_html_minimum2, 0, $FUNCREF); mok($HTML_BAD==1,'html_find_tags no.2'); # verify taglist test function works as expected $TAGLIST = [ ['tag', { param=>'one' } ] ]; $HTML_BAD = 0; LW2::html_find_tags(\$LITTLEHTML, \&test_html_taglist, 0, $TAGLIST); mok($HTML_BAD==0,'html_find_tags no.3'); # basic taglist #1 $TAGLIST = [ ['a',{}],['b',{}],['c',{}],['/c',{}],['/b',{}],['/a',{}] ]; $HTML_BAD = 0; $TAGHTML = ''; LW2::html_find_tags(\$TAGHTML, \&test_html_taglist, 0, $TAGLIST); mok($HTML_BAD==0,'html_find_tags no.4'); # basic taglist #2 $TAGLIST = [ ['!--',{'='=>'-x '}],['script',{'='=> 'foobarbaz'}],['foo',{}] ]; $HTML_BAD = 0; $TAGHTML = ''; LW2::html_find_tags(\$TAGHTML, \&test_html_taglist, 0, $TAGLIST); mok($HTML_BAD==0,'html_find_tags no.5'); # now do evil.htm test if(!$SKIPHTML){ $TAGLIST = [ ['html',{}], ['body',{}], ['p',{}], ['script',{language=>'javascript','='=> "\r\ndocument.writeln(\"Do not parse or tag!\");\r\ndocument.writeln(\"',type=>'submit'}], ['!--',{'='=>"\r\nDon't stop - -> and -- and -> and