]> mj.ucw.cz Git - libucw.git/blobdiff - ucw/perl/CGI.pm
CGI.pm: More improvements to the cookie mechanism.
[libucw.git] / ucw / perl / CGI.pm
index 7389511a1d53f1868ab8f39b000bb71f879fad63..99ab83a9ffc2eb7705b892e7fb5791feeeb5cb48 100644 (file)
@@ -427,13 +427,19 @@ sub set_cookie($$@) {
        #       max-age         maximal age in seconds
        #       domain          domain name scope
        #       path            path name scope
-       #       secure          if non-zero, cookie applies only to SSL connections
+       #       secure          if present, cookie applies only to SSL connections
+       #                       (in this case, the value should be undefined)
+       #       discard         if present with any value, the cookie is discarded
        #
 
        my $key = shift @_;
        my $value = shift @_;
        my %other = @_;
-       if (my $age = $other{'max-age'}) {
+       if (exists $other{'discard'}) {
+               delete $other{'discard'};
+               $other{'max-age'} = 0;
+       }
+       if (defined(my $age = $other{'max-age'})) {
                delete $other{'max-age'};
                my $exp = ($age ? (time + $age) : 0);
                # Avoid problems with locales
@@ -443,14 +449,12 @@ sub set_cookie($$@) {
                $other{'expires'} = sprintf("%s, %02d-%s-%d %02d:%02d:%02d GMT",
                        $wdays[$wd], $d, $mons[$m], $y+1900, $H, $M, $S);
        }
-       my $secure = $other{'secure'};
-       delete $other{'secure'};
 
        print "Set-Cookie: $key=", url_escape($value);
        foreach my $k (keys %other) {
-               print "; $k=", $other{$k};
+               print "; $k";
+               print "=", $other{$k} if defined $other{$k};
        }
-       print "; secure" if $secure;
        print "\n";
 }
 
@@ -459,7 +463,8 @@ sub parse_cookies() {
        my @cook = ();
        foreach my $x (split /;\s*/, $h) {
                my ($k,$v) = split /=/, $x;
-               push @cook, $k => url_deescape($v);
+               $v = url_deescape($v) if defined $v;
+               push @cook, $k => $v;
        }
        return @cook;
 }