I have a script that processes user sign in/out request. One of a few things this script has to do is remove/set appropriate cookies to control user sessions. The problem that I've encountered with the script was that while setting a cookie works 100% of the time, removing a cookie is sometimes problematic.

In order to investigate this problem, I've written a simple cookie manipulation test script. It would display a form with a single submit button, which function is to either 'Remove Cookie' or 'Set Cookie'. The code for this test page is included at the end of this post.

To remove a cookie, I simply create one using CGI's cookie() method and passing it appropriate cookie parameters/values. Finally, I invoke CGI::redirect to create a redirect header containing cookie string (I redirect to the page itself). Having played with the test script a few times (on Mozilla 5.0 rv:0.9.7) I have made a somewhat 'chilly' discovery. Setting -expires option of an existing cookie to 'now' (which will get translated to time() right?) wouldn't remove it immediately. And, I end up having to retry a few times (by hitting the 'Remove Cookie' button) in order to actually make the cookie go. However, setting the -expires option to 1, makes things work the first time.

I also noticed that the 'now' value wouldn't remove my cookie on IE5.0 browsers at all ;/, no matter how many times you try. Frankly, I'm buffled by this problem. I looked at redirect header data produced in two cases, and they don't seem to be all that different (unless I missed something ;-), except for expire times. However, now did produce 'current' expire time.. which had to work, logically.

Any idea why, contrary to perldoc CGI documentation, setting -expires to 'now' wouldn't work? Actually, I've learnt that -value property has to be set to a 'non-false' value (neither 0 nor undef is allowed), otherwise, cookie wouldn't get removed either.

Thanks.

Here goes the source code for cookie_test.cgi 
use strict;

use lib qw(.);
use CGI;
use CGI::Cookie;

my $cgi = new CGI;
my $op = $cgi->param('op');

$main::cookie_name = $cgi->param('cookie_name');
$main::full_url = $ENV{SERVER_URL} . $ENV{SCRIPT_NAME};

$main::domain = $cgi->param('domain');
$main::path = $cgi->param('path');
$main::cookie_value = $cgi->param('cookie_value');
$main::domain ||= '.mybc.com';
$main::path ||= '/';
$main::cookie_value ||= 'na';

#$main::domain = $ENV{HTTP_HOST};
#($main::path) = ($ENV{SCRIPT_NAME} =~ m|(.*)/[^/]+$|);

$main::cookie = $cgi->cookie($main::cookie_name);

#$op='rm';$main::cookie=1;

set_cookie($cgi) if ($op eq 'set');
remove_cookie($cgi) if ($op eq 'rm');

%main::cookies = fetch CGI::Cookie;

my ($html_cookie_table, $html_cookie_select);
parse_all_cookies({
    html_table => \$html_cookie_table,
    html_select => \$html_cookie_select,
});

print $cgi->header();
print qq|
<html>
<title>Cookie Test</title>
<body>
<pre>
 Cookie set/remove test.
 <form method=POST>
 <input type=hidden name=op value="$op">
<table border=0>
 <tr>
 <td></td><td></td>
 </tr>
 <tr>
 <td align=left>Name:</td>
 <td align=left nowrap>
   <input name=cookie_name value="$main::cookie_name">
    &nbsp;
   <script>
    function select_cookie(sel_obj)
    {
        if (sel_obj.selectedIndex) {
            sel_obj.form.cookie_name.value = sel_obj.options[sel_obj.s
+electedIndex].value;
        } else {
            sel_obj.form.cookie_name.value = "";
        }
    }
   </script>
   <select name=cookie_name_select onChange="select_cookie(this);">
    <option value=0>Select existing ...</option>
    $html_cookie_select
   </select>
 </td>
 </tr>
 <tr>
 <td>Value:</td><td><input name=cookie_value value="$main::cookie_valu
+e"></td>
 </tr>
 <tr>
 <td align=left>Domain:</td><td align=left><input name=domain value="$
+main::domain"></td>
 </tr>
 <tr>
 <td align=left>Path:</td><td align=left> <input name=path value="$mai
+n::path"></td>
 </tr>
 <tr><td colspan=2 align=center>
 <input type=button value="Remove Cookie" onclick="this.form.op.value 
+= 'rm';this.form.submit();">
 <input type=button value="Set Cookie" onclick="this.form.op.value = '
+set';this.form.submit();">
 <input type=submit value="Refresh" onclick="this.form.op.value = '';"
+>
 </td></tr>
 </table>
 </form>
</pre>
<hr>
$html_cookie_table
</body>
</html>
|;

exit;

##
## SUBS
##

sub set_cookie {
  my $cgi = shift;

  unless ($main::cookie) {
    $main::cookie = $cgi->cookie(
                                 -name   => $main::cookie_name,
                                 -value  => $main::cookie_value,
                                 -expires=> '+1h',
                                 -path   => $main::path,
                                 -domain => $main::domain,
                                );

    print CGI::redirect(-location => $main::full_url, -cookie => [$mai
+n::cookie]);
    exit;
  }
}

sub remove_cookie {
  my $cgi = shift;

  $DB::single = 1;

  if ($main::cookie) {
    my $cookie = $cgi->cookie(
                              -name   => $main::cookie_name,
                              -value  => 1, # also this one can't be 0
+ or undef!

                              # Setting expires to 'now' doesn't quite
+ work.
                              # I have to hit the 'Remove Cookie' butt
+on
                              # 2/3 times (# of remove attempts) to ac
+tually
                              # remove the cookie.
                              # -expires => 'now',
                              # however, this works well all the time.
                              # what's the trick?
                              -expires=> 1,
                              -path   => $main::path,
                              -domain => $main::domain,
                           );

#      print $cgi->header();
#      print qq|
#          <pre>
#              REMOVING COOKIE:
#                             -name   => $main::cookie_name,
#                             -value  => 'foobar',
#                             -expires=> 'now',
#                             -path   => $main::path,
#                             -domain => $main::domain,
#              </pre>
#          |;
    print CGI::redirect(-location => $main::full_url, -cookie => [$coo
+kie]);
    exit;
  }
}

sub parse_all_cookies {
    my ($r_html_table, $r_html_select) = @{$_[0]}{qw(html_table html_s
+elect)};

    $$r_html_table = qq|
            <table border=0 cellpadding=2 cellspacing=3 bgcolor=lightg
+rey>
            <tr><td><b>Cookie Name</b></td><td><b>Content</b></td></tr
+>
    |;

    foreach (keys %main::cookies) {
        $$r_html_select .= "<option value='$_'>$_</option>";
        $$r_html_table .= "<tr><td>$_</td><td>".$main::cookies{$_}."</
+td></tr>";
    }

    $$r_html_table .= "</table>";
}

[download]


"There is no system but GNU, and Linux is one of its kernels." -- Confession of Faith

In reply to CGI::cookie() bugged? problems with removing cookies.. by vladb

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.