"Fossies" - the Fresh Open Source Software Archive

Member "CGI-Lite-3.02/t/cookie.t" (19 May 2018, 9657 Bytes) of package /linux/www/CGI-Lite-3.02.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "cookie.t": 3.01_vs_3.02.

    1 #
    2 #===============================================================================
    3 #
    4 #         FILE:  cookie.t
    5 #
    6 #  DESCRIPTION:  Test of cookie parsing
    7 #
    8 #        FILES:  ---
    9 #         BUGS:  ---
   10 #        NOTES:  ---
   11 #       AUTHOR:  Pete Houston (cpan@openstrike.co.uk)
   12 #      COMPANY:  Openstrike
   13 #      CREATED:  20/05/14 16:12:33
   14 #
   15 #  Updates:
   16 #    25/08/2014 Now tests get_ordered_keys and print_data.
   17 #===============================================================================
   18 
   19 use strict;
   20 use warnings;
   21 
   22 use Test::More tests => 264;                      # last test to print
   23 
   24 use lib './lib';
   25 
   26 BEGIN { use_ok ('CGI::Lite') }
   27 
   28 # Set up a CGI environment
   29 $ENV{REQUEST_METHOD}  = 'GET';
   30 $ENV{PATH_INFO}       = '/somewhere/else';
   31 $ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
   32 $ENV{SCRIPT_NAME}     ='/cgi-bin/foo.cgi';
   33 $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
   34 $ENV{SERVER_PORT}     = 8080;
   35 $ENV{SERVER_NAME}     = 'there.is.no.try.com';
   36 $ENV{QUERY_STRING}    = '';
   37 
   38 my $cgi               = CGI::Lite->new ();
   39 my $cookies           = $cgi->parse_cookies;
   40 is ($cgi->is_error, 0, 'Cookie parse: no cookies, no error');
   41 is ($cookies, undef, 'Cookie parse: no cookies');
   42 
   43 $ENV{HTTP_COOKIE}     = 'foo=bar; baz=quux';
   44 $cgi                  = CGI::Lite->new ();
   45 $cookies              = $cgi->parse_cookies;
   46 my $testname          = 'simple';
   47 
   48 is ($cgi->is_error, 0, "Cookie parse ($testname)");
   49 is (scalar keys %$cookies, 2, "Cookie count ($testname)");
   50 ok (exists $cookies->{foo}, "First cookie name ($testname)");
   51 is ($cookies->{foo}, 'bar', "First cookie value ($testname)");
   52 ok (exists $cookies->{baz}, "Second cookie name ($testname)");
   53 is ($cookies->{baz}, 'quux', "Second cookie value ($testname)");
   54 
   55 # And again but with a hash
   56 $cgi                  = CGI::Lite->new ();
   57 $testname             = 'simple, return hash';
   58 my %cookies           = $cgi->parse_cookies;
   59 is ($cgi->is_error, 0, "Cookie parse ($testname)");
   60 is (scalar keys %cookies, 2, "Cookie count ($testname)");
   61 ok (exists $cookies{foo}, "First cookie name ($testname)");
   62 is ($cookies{foo}, 'bar', "First cookie value ($testname)");
   63 ok (exists $cookies{baz}, "Second cookie name ($testname)");
   64 is ($cookies{baz}, 'quux', "Second cookie value ($testname)");
   65 
   66 
   67 
   68 $ENV{HTTP_COOKIE}     = ' foo=bar ; baz = quux ';
   69 $cgi                  = CGI::Lite->new ();
   70 $cookies              = $cgi->parse_cookies;
   71 $testname             = 'extra space';
   72 
   73 is ($cgi->is_error, 0, "Cookie parse ($testname)");
   74 is (scalar keys %$cookies, 2, "Cookie count ($testname)");
   75 ok (exists $cookies->{foo}, "First cookie name ($testname)");
   76 is ($cookies->{foo}, 'bar', "First cookie value ($testname)");
   77 ok (exists $cookies->{baz}, "Second cookie name ($testname)");
   78 is ($cookies->{baz}, 'quux', "Second cookie value ($testname)");
   79 
   80 $ENV{HTTP_COOKIE}     = 'foo=bar;baz=quux';
   81 $cgi                  = CGI::Lite->new ();
   82 $cookies              = $cgi->parse_cookies;
   83 $testname             = 'zero space';
   84 
   85 is ($cgi->is_error, 0, "Cookie parse ($testname)");
   86 is (scalar keys %$cookies, 2, "Cookie count ($testname)");
   87 ok (exists $cookies->{foo}, "First cookie name ($testname)");
   88 is ($cookies->{foo}, 'bar', "First cookie value ($testname)");
   89 ok (exists $cookies->{baz}, "Second cookie name ($testname)");
   90 is ($cookies->{baz}, 'quux', "Second cookie value ($testname)");
   91 
   92 $ENV{HTTP_COOKIE}     = '%20foo%20=%20bar%20;b%20a%20z=qu%20ux';
   93 $cgi                  = CGI::Lite->new ();
   94 $cookies              = $cgi->parse_cookies;
   95 $testname             = 'interstitial space';
   96 
   97 is ($cgi->is_error, 0, "Cookie parse ($testname)");
   98 is (scalar keys %$cookies, 2, "Cookie count ($testname)");
   99 ok (exists $cookies->{' foo '}, "First cookie name ($testname)");
  100 is ($cookies->{' foo '}, ' bar ', "First cookie value ($testname)");
  101 ok (exists $cookies->{'b a z'}, "Second cookie name ($testname)");
  102 is ($cookies->{'b a z'}, 'qu ux', "Second cookie value ($testname)");
  103 
  104 my $ref = [];
  105 $ref = $cgi->get_ordered_keys;
  106 is_deeply ($ref, [' foo ', 'b a z'], 
  107 	'get_ordered_keys arrayref for cookie data');
  108 my @ref = $cgi->get_ordered_keys;
  109 is_deeply (\@ref, [' foo ', 'b a z'], 
  110 	'get_ordered_keys array for cookie data');
  111 
  112 
  113 SKIP: {
  114 	my $tmpfile = 'tmpout-cookie';
  115 	skip "No file created for stdout", 2 unless open my $tmp, '>', $tmpfile;
  116 	select $tmp;
  117 	$cgi->print_data;
  118 	close $tmp;
  119 	open $tmp, '<', $tmpfile;
  120 	chomp (my $printed = <$tmp>);
  121 	is ($printed, q# foo  =  bar #, 'print_data first cookie');
  122 	chomp ($printed = <$tmp>);
  123 	is ($printed, q#b a z = qu ux#, 'print_data second cookie');
  124 	close $tmp and unlink $tmpfile;
  125 }
  126 
  127 # Other url-escaped chars here
  128 
  129 for my $special (33 .. 47, 58 .. 64, 91 .. 96, 123 .. 126) {
  130 	$ENV{HTTP_COOKIE}     = sprintf 'a=%%%X;%%%X=1', $special, $special;
  131 	$cgi                  = CGI::Lite->new ();
  132 	$cookies              = $cgi->parse_cookies;
  133 	$testname             = "Special value ($ENV{HTTP_COOKIE})";
  134 	is ($cgi->is_error, 0, "Cookie parse ($testname)");
  135 	is (scalar keys %$cookies, 2, "Cookie count ($testname)");
  136 	ok (exists $cookies->{'a'}, "First cookie name ($testname)");
  137 	is ($cookies->{'a'}, chr($special), "First cookie value ($testname)");
  138 	ok (exists $cookies->{chr($special)}, "Second cookie name ($testname)");
  139 	is ($cookies->{chr($special)}, 1, "Second cookie value ($testname)");
  140 }
  141 
  142 $ENV{HTTP_COOKIE}     = '=bar';
  143 $cgi                  = CGI::Lite->new ();
  144 $cookies              = $cgi->parse_cookies;
  145 $testname             = 'Missing key';
  146 
  147 is ($cgi->is_error, 0, "Cookie parse ($testname)");
  148 is (scalar keys %$cookies, 1, "Cookie count ($testname)");
  149 ok (exists $cookies->{''}, "First cookie name ($testname)");
  150 is ($cookies->{''}, 'bar', "First cookie value ($testname)");
  151 
  152 # Bad cookies!
  153 
  154 $ENV{HTTP_COOKIE}     = 'f;o;o=b;a;r';
  155 $cgi                  = CGI::Lite->new ();
  156 $cookies              = $cgi->parse_cookies;
  157 $testname             = 'Extra semicolons';
  158 
  159 is ($cgi->is_error, 0, "Cookie parse ($testname)");
  160 is (scalar keys %$cookies, 4, "Cookie count ($testname)");
  161 ok (exists $cookies->{'o'}, "First cookie name ($testname)");
  162 is (ref $cookies->{'o'}, 'ARRAY', "First cookie ref ($testname)");
  163 is ($cookies->{'o'}->[0], '', "First cookie first elem ($testname)");
  164 is ($cookies->{'o'}->[1], 'b', "First cookie second elem ($testname)");
  165 
  166 $ENV{HTTP_COOKIE}     = 'foo==bar';
  167 $cgi                  = CGI::Lite->new ();
  168 $cookies              = $cgi->parse_cookies;
  169 $testname             = 'Extra equals';
  170 
  171 is ($cgi->is_error, 0, "Cookie parse ($testname)");
  172 is (scalar keys %$cookies, 1, "Cookie count ($testname)");
  173 ok (exists $cookies->{'foo'}, "First cookie name ($testname)");
  174 is ($cookies->{'foo'}, '=bar', "First cookie value ($testname)");
  175 
  176 # Need to decide how strict the cookie validation should be. If strict,
  177 # then these tests could be used. Leaving it lax for now.
  178 # See eg. http://bugs.python.org/issue2193
  179 #
  180 #for my $char (split (//, '()<>@:\"/[]?={} ')) {
  181 #
  182 #	$ENV{HTTP_COOKIE}     = "f${char}o=bar";
  183 #	$cgi                  = CGI::Lite->new ();
  184 #	$cookies              = $cgi->parse_cookies;
  185 #	$testname             = qq#Bad key char: "$char"#;
  186 #
  187 #	is ($cgi->is_error, 1, "Cookie parse ($testname)");
  188 #	is (scalar keys %$cookies, 0, "Cookie count ($testname)");
  189 #
  190 #	$ENV{HTTP_COOKIE}     = "foo=b${char}r";
  191 #	$cgi                  = CGI::Lite->new ();
  192 #	$cookies              = $cgi->parse_cookies;
  193 #	$testname             = qq#Bad value char: "$char"#;
  194 #
  195 #	is ($cgi->is_error, 1, "Cookie parse ($testname)");
  196 #	is (scalar keys %$cookies, 0, "Cookie count ($testname)");
  197 #
  198 #}
  199 #
  200 # What about multiple cookies with the same name?
  201 # cookie o is actually an arrayref, which is neat, but does it match the
  202 # RFC?
  203 #ok (exists $cookies->{'b a z'}, "Second cookie name ($testname)");
  204 #is ($cookies->{'b a z'}, 'qu ux', "Second cookie value ($testname)");
  205 
  206 $ENV{HTTP_COOKIE}     = 'foo=bar;foo=baz;foo=quux';
  207 $cgi                  = CGI::Lite->new ();
  208 $cookies              = $cgi->parse_cookies;
  209 $testname             = 'triple value';
  210 
  211 is ($cgi->is_error, 0, "Cookie parse ($testname)");
  212 is (scalar keys %$cookies, 1, "Cookie count ($testname)");
  213 ok (exists $cookies->{foo}, "First cookie name ($testname)");
  214 is ($cookies->{foo}->[0], 'bar', "First cookie value ($testname)");
  215 is ($cookies->{foo}->[1], 'baz', "First cookie value ($testname)");
  216 is ($cookies->{foo}->[2], 'quux', "First cookie value ($testname)");
  217 
  218 
  219 $cgi                  = CGI::Lite->new ();
  220 is ($cgi->force_unique_cookies(), 0, "force_unique_cookies undef arg");
  221 is ($cgi->force_unique_cookies('foo'), 0, "force_unique_cookies string arg");
  222 is ($cgi->force_unique_cookies(100), 0, "force_unique_cookies arg > 3");
  223 is ($cgi->force_unique_cookies(1), 1, "force_unique_cookies arg == 1");
  224 $cookies              = $cgi->parse_cookies;
  225 $testname             = 'unique, take first';
  226 is ($cgi->is_error, 0, "Cookie parse ($testname)");
  227 is (scalar keys %$cookies, 1, "Cookie count ($testname)");
  228 ok (exists $cookies->{foo}, "Cookie name ($testname)");
  229 is ($cookies->{foo}, 'bar', "Cookie value ($testname)");
  230 
  231 $cgi                  = CGI::Lite->new ();
  232 is ($cgi->force_unique_cookies(2), 2, "force_unique_cookies arg == 2");
  233 $cookies              = $cgi->parse_cookies;
  234 $testname             = 'unique, take last';
  235 is ($cgi->is_error, 0, "Cookie parse ($testname)");
  236 is (scalar keys %$cookies, 1, "Cookie count ($testname)");
  237 ok (exists $cookies->{foo}, "Cookie name ($testname)");
  238 is ($cookies->{foo}, 'quux', "Cookie value ($testname)");
  239 
  240 $cgi                  = CGI::Lite->new ();
  241 is ($cgi->force_unique_cookies(3), 3, "force_unique_cookies arg == 3");
  242 $cookies              = $cgi->parse_cookies;
  243 $testname             = 'unique, raise error';
  244 is ($cgi->is_error, 1, "Cookie parse ($testname)");
  245