Channels ▼
RSS

Programming with Perl | Cookie Monsters (Web Techniques, May 2001)


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 => \&param]) {
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    }



Related Reading


More Insights






Currently we allow the following HTML tags in comments:

Single tags

These tags can be used alone and don't need an ending tag.

<br> Defines a single line break

<hr> Defines a horizontal line

Matching tags

These require an ending tag - e.g. <i>italic text</i>

<a> Defines an anchor

<b> Defines bold text

<big> Defines big text

<blockquote> Defines a long quotation

<caption> Defines a table caption

<cite> Defines a citation

<code> Defines computer code text

<em> Defines emphasized text

<fieldset> Defines a border around elements in a form

<h1> This is heading 1

<h2> This is heading 2

<h3> This is heading 3

<h4> This is heading 4

<h5> This is heading 5

<h6> This is heading 6

<i> Defines italic text

<p> Defines a paragraph

<pre> Defines preformatted text

<q> Defines a short quotation

<samp> Defines sample computer code text

<small> Defines small text

<span> Defines a section in a document

<s> Defines strikethrough text

<strike> Defines strikethrough text

<strong> Defines strong text

<sub> Defines subscripted text

<sup> Defines superscripted text

<u> Defines underlined text

Dr. Dobb's encourages readers to engage in spirited, healthy debate, including taking us to task. However, Dr. Dobb's moderates all comments posted to our site, and reserves the right to modify or remove any content that it determines to be derogatory, offensive, inflammatory, vulgar, irrelevant/off-topic, racist or obvious marketing or spam. Dr. Dobb's further reserves the right to disable the profile of any commenter participating in said activities.

 
Disqus Tips 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.