1 #!/usr/bin/perl -Tw 2 use strict; 3 $|++; 4 5 use CGI qw(:all); 6 7 ## cookie check 8 my $browser = cookie("browser"); 9 if (defined $browser) { # got a good browser 10 Delete("_cookiecheck"); # don't let this leak further 11 } else { # no cookie? set one 12 require MD5; 13 my $cookie = cookie 14 (-name => 'browser', 15 -value => MD5->hexhash(MD5->hexhash(time.{}.rand().$$))); 16 17 if (defined param("_cookiecheck")) { # already tried! 18 print +(header(-cookie => $cookie), 19 start_html("Missing cookies"), 20 h1("Missing cookies"), 21 p("This site requires a cookie to be set. Please permit this."), 22 startform, submit("OK"), endform, 23 end_html); 24 } else { 25 param("_cookiecheck", 1); # prevent infinite loop 26 print redirect (-cookie => $cookie, -uri => self_url()); 27 } 28 exit 0; 29 } 30 31 ## At this point, $browser is now the unique ID of the browser 32 33 require File::Cache; 34 my $cache = File::Cache->new({namespace => 'cookiemaker', 35 username => 'nobody', 36 filemode => 0666, 37 expires_in => 3600, # one hour 38 }); 39 40 ## first, some housekeeping 41 unless ($cache->get(" _purge_ ")) { 42 $cache->purge; # remove expired objects 43 $cache->set(" _purge_ ", 1, 3600 * 4); # purge every four hours 44 } 45 46 my $user = $cache->get($browser); ## either the logged-in user, or undef 47 48 print header,start_html('session demonstration'),h1('session demonstration'); 49 50 ## handle requested transitions (login or logout) 51 if (defined $user and defined param("_logout")) { 52 Delete("_logout"); 53 $cache->remove($browser); 54 print p("You are no longer logged in as $user."); 55 undef $user; 56 } elsif (not defined $user and defined (my $try_user = param("_user"))) { 57 Delete("_user"); 58 my $try_password = param("_password"); 59 Delete("_password"); 60 if ($try_user =~ /\A\w+\z/ and verify($try_user, $try_password)) { 61 $user = $try_user; 62 print p("Welcome back, $user."); 63 } else { 64 print p("I'm sorry, that's not right."); 65 } 66 } 67 68 ## handle current state (possibly after transition) 69 if (defined $user) { 70 $cache->set($browser,$user); # update cache on each hit 71 print p("You are logged in as $user."); 72 print startform, hidden("_logout", 1), submit("Log out"), endform; 73 } else { 74 print p("You are not logged in."); 75 print 76 startform, 77 table({-border => 1, -cellspacing => 0, -cellpadding => 2}, 78 Tr(th("username:"), 79 td(textfield("_user")), 80 td({-rowspan => 2}, submit("login"))), 81 Tr(th("password:"), td(password_field("_password")))), 82 endform; 83 } 84 85 ## rest of page would go here, paying attention to $user 86 87 for ([Cookies => \&cookie], [Params => \¶m]) { 88 my ($title, $f) = @$_; 89 90 print h2($title), table 91 ({-border => 0, -cellspacing => 0, -cellpadding => 2}, 92 map (Tr(th(escapeHTML($_)), td(escapeHTML(join ", ", $f->($_)))), 93 $f->())); 94 } 95 96 ## sample verification 97 98 sub verify { 99 my($user, $password) = @_; 100 return index($password, $user) > -1; # require password to contain user 101 }
Programming with Perl | Cookie Monsters (Web Techniques, May 2001)
Ahh, cookies. One of my pet peeves is the amount of bad cookie code I see out therelike the code responsible for the reaction I get from a Web site when I choose not to permit cookies (usually because I'm feeling rebellious). Cookies are one of many ways to turn stateless HTTP into a series of session-based transactions with states like "logged in" and "logged out." Other ways to achieve a similar transformation of HTTP include using authentication, mangling the URLs, and hiding data.Related Reading
More Insights
INFO-LINK
To upload an avatar photo, first complete your Disqus profile. | View the list of supported HTML tags you can use to style comments. | Please read our commenting policy. | |