Seumas has asked for the wisdom of the Perl Monks concerning the following question:

CGI::Session states that you can use $session->header() as a shortcut to accomplish the following: 
$cookie = new CGI::Cookie(-name=>'CGISESSID', -value=>$session->id);
print $cgi->header(-cookie=>$cookie);

[download]
In the more verbose example, I could add expires => '+1M', if I wanted. But I can not find a way to accomplish setting a cookie expiration time with the short CGI::Session method above. I tried the following, which did not work: 
$session->header(expires => '+1M')

[download]
I've looked through the CGI::Session code and could not find anything that addresses this but it seems common enough that there has to be something simple that will allow me to use the shorter header() method while still applying an expiration period.

All of the comments in CGI::Session, CGI::Session::Tutorial and CGI::Session::Cookbook relating to expirations are dealing with an expiration flag in the DATA portion of the sessions table.

Replies are listed 'Best First'.
Re: CGI::Session and cookie expiration
by amt (Monk) on Oct 18, 2004 at 17:33 UTC
    Seumas, I wrote a script a while ago using LDAP for logins, and ran into a similar problem. What I ended up doing was to put a "expired" or "~logged-in" variable if you want to follow CGI::Session::Cookbook. The code is below, but what you need to do with this implementation is fetch the session, and check for the existance of that session variable, because when the expiration is triggered it disappears. This helps with inactivity expirations, because every time you go to the session on the server, you can just touch that session variable.

    if( $authority = verify_password(\@autharray)){
        # ldap authentication succeeded at this point

        # set session variables and other expiry information
        my $session = new CGI::Session( "driver:MySQL", undef, {Handle
+ => $dbh})
;
        my $sid = $session->id;
        syslog( 'notice', "sid: %s", $sid);
        $session->param("~logged-in",1);
        $session->param("username",$autharray[0]);
        $session->param("org-name",$autharray[2]);

        $session->expires("~logged-in", "+15m");
        syslog( 'notice',"after session writing") if $debug;

        # write cookie information to user browser
        my $cookie = $cgi->cookie(CGISESSID =>$session->id);
        print $cgi->header(-cookie=>$cookie);

        # ...
        # other proprietary stuff
}

    [download]


    I hope this helps.

    amt.

    perlcheat
[reply]
[d/l]
Re: CGI::Session and cookie expiration
by !1 (Hermit) on Oct 18, 2004 at 17:25 UTC

    You're going to love this...

    I don't see anything about it but you can pass a CGI object as the second parameter to CGI::Session->new. If and only if the second parameter is a CGI object will it use the additional parameters on the first call to header. The funny thing is that if you call header a second time with the parameters, it does what you want. Funny stuff, eh?

    > cat sillycgisess.pl
#!/usr/bin/perl -l

use CGI::Session;

my $sess = CGI::Session->new(undef,undef,{Directory=>'.'});
print "First:";
print $sess->header(expires => '+1M');
print "Second:";
print $sess->header(expires => '+1M');

> perl sillycgisess.pl
First:
Set-Cookie: CGISESSID=681008f3133c46a8f53a121eeb76b692; path=/
Date: Mon, 18 Oct 2004 17:25:36 GMT
Content-Type: text/html; charset=ISO-8859-1


Second:
Set-Cookie: CGISESSID=681008f3133c46a8f53a121eeb76b692; path=/
Expires: Wed, 17 Nov 2004 17:25:36 GMT
Date: Mon, 18 Oct 2004 17:25:36 GMT
Content-Type: text/html; charset=ISO-8859-1

    [download]

    This should be considered a bug, IMHO.

[reply]
[d/l]
[select]
      Update: Didn't read close enough and didn't realize the exercise.

      !1, that's when you are running on the console. CGI barks when you try to print two headers, it just outputs the second header into the page.

      amt.

      perlcheat
[reply]
        And you can actually disable that by setting $CGI::HEADERS_ONCE = 1.
[reply]
[d/l]
      I think it's a bug too, but the first call to header just drops all arguments - passing a CGI object is irrelevant (to header, !1 was talking about new). Here's sub header() from CGI::Session v3.95

      sub header {
    my $self = shift;

    my $cgi = $self->{_SESSION_OBJ};
    unless ( defined $cgi ) {
        require CGI;
        $self->{_SESSION_OBJ} = CGI->new();
        return $self->header();
    }

    my $cookie = $cgi->cookie($self->name(), $self->id() );

    return $cgi->header(
        -type   => 'text/html',
        -cookie => $cookie,
        @_
    );
}

      [download]

      The first call to CGI::Session::header instantiates a CGI object ($self->{_SESSION_OBJ}), then calls $self->header() without any of the parameters originally passed. The second call, the CGI object already exists and sub header handles all the arguments.

      Here's a minimal patch for CGI::Session (untested) 

      1222c1222
<         return $self->header();
---
>         $cgi = $self->{_SESSION_OBJ};

      [download]

      A workaround for the OP would be to call it twice - ie

       # call header to instantiate CGI object, but throw away the result
$sess->header();
# _now_ print the header
print $sess->header(expires => '+1M');
__END__
output:
Set-Cookie: CGISESSID=e438a0cb3647f362bd9934d048dca443; path=/
Expires: Mon, 18 Oct 2004 21:52:43 GMT
Date: Mon, 18 Oct 2004 21:42:43 GMT
Content-Type: text/html; charset=ISO-8859-1

      [download]

      Update: modified the patch

      Update 2: went to rt.cpan.org, and !1's patch is almost the same...

[reply]
[d/l]
[select]

        To further clarify, I was referring to this:

        > cat cgipass.pl
#!/usr/bin/perl -l

use CGI::Session;
use CGI;

my $cgi = CGI->new();

my $sess = CGI::Session->new(undef, $cgi, {Directory=>'.'});
print $sess->header(expires=>'+1M');

> perl cgipass.pl
Set-Cookie: CGISESSID=e433f7dae02dd6e0baf79d0d993250cd; path=/
Expires: Thu, 18 Nov 2004 14:17:27 GMT
Date: Tue, 19 Oct 2004 14:17:27 GMT
Content-Type: text/html; charset=ISO-8859-1

        [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom