Writing Apache Modules with Perl and C By:   Lincoln Stein and Doug MacEachern Published:   O'Reilly & Associates, Inc.  - March 1999 Copyright © 1999 by O'Reilly & Associates, Inc.

Chapter 6 - Authentication and Authorization
Cookie-Based Access Control

The next example is a long one. To understand its motivation, consider a large site that runs not one but multiple web servers. Perhaps each server mirrors the others in order to spread out and reduce the load, or maybe each server is responsible for a different part of the site.

Such a site might very well want to have each of the servers perform authentication and access control against a shared database, but if it does so in the obvious way, it faces some potential problems. In order for each of the servers to authenticate against a common database, they will have to connect to it via the network. But this is less than ideal because connecting to a network database is not nearly so fast as connecting to a local one. Furthermore, the database network connections generate a lot of network overhead and compete with the web server for a limited pool of operating-system file descriptors. The performance problem is aggravated if authentication requires the evaluation of a complex SQL statement rather than a simple record lookup.

There are also security issues to consider when using a common authentication database. If the database holds confidential information, such as customer account information, it wouldn't do to give all the web servers free access to the database. A break-in on any of the web servers could compromise the confidentiality of the information.

Apache::TicketAccess was designed to handle these and other situations in which user authentication is expensive. Instead of performing a full authentication each time the user requests a page, the module only authenticates against a relational database the very first time the user connects (see Figure 6-3). After successfully validating the user's identity, the module issues the user a "ticket" to use for subsequent accesses. This ticket, which is no more than an HTTP cookie, carries the user's name, IP address, an expiration date, and a cryptographic signature. Until it expires, the ticket can be used to gain entry to any of the servers at the site. Once a ticket is issued, validating it is fast; the servers merely check the signature against the other information on the ticket to make sure that it hasn't been tampered with. No further database accesses are necessary. In fact, only the machine that actually issues the tickets, the so-called ticket master, requires database connectivity.

Figure 6-3. In Apache::TicketAccess, the "ticket master" gives browsers an access ticket in the form of a cookie. The ticket is then used for access to other web servers.

The scheme is reasonably secure because the cryptographic signature and the incorporation of the user's IP address make the cookies difficult to forge and intercept, and even if they are intercepted, they are only valid for a short period of time, preventing replay attacks. The scheme is more secure than plain Basic authentication because it greatly reduces the number of times the clear text password passes over the network. In fact, you can move the database authentication functions off the individual web servers entirely and onto a central server whose only job is to check users' credentials and issue tickets. This reduces the exposure of sensitive database information to one machine only.

Another use for a system like this is to implement nonstandard authentication schemes, such as a one-time password or a challenge-response system. The server that issues tickets doesn't need to use Basic authentication. Instead, it can verify the identity of the user in any way that it sees fit. It can ask the user for his mother's maiden name, or enter the value that appears on a SecureID card. Once the ticket is issued, no further user interaction is required.

The key to the ticket system is the MD5 hash algorithm, which we previously used in Chapter 5 to create message authentication checks (MACs). As in that chapter, we will use MD5 here to create authenticated cookies that cannot be tampered with or forged. If you don't already have it, MD5 can be found in CPAN under the modules directory.

The tickets used in this system have a structure that looks something like this:

IP=$IP time=$time expires=$expires user=$user_name hash=$hash

The hash is an MD5 digest that is calculated according to this formula:

my $hash=MD5->hexhash($secret .
         MD5->hexhash(join ":", $secret, $IP, $time, $expires, $user_name)
         );

The other fields are explained below:

$secret

This is a secret key known only to the servers. The key is any arbitrary string containing ASCII and 8-bit characters. A long set of random characters is best. This key is shared among all the servers in some secure way and updated frequently (once a day or more). It is the only part of the ticket that doesn't appear as plain text.

The user's IP address. This makes it harder for the ticket to be intercepted and used by outside parties because they would also have to commandeer the user's IP address at the same time.⁹

$time

This is the time and date that the ticket was issued, for use in expiring old tickets.

$expires

This is the number of minutes for which a ticket is valid. After this period of time, the user will be forced to reauthenticate. The longer a ticket is valid, the more convenient it is for the user, but the easier it is for an interloper to intercept the ticket. Shorter expiration times are more secure.

$user_name

This is the user's name, saved from the authentication process. It can be used by the web servers for authorization purposes.

By recovering the individual fields of the ticket, recalculating the hash, and comparing the new hash to the transmitted one, the receiving server can verify that the ticket hasn't been tampered with in transit. The scheme can easily be extended to encode the user's access privileges, the range of URIs he has access to, or any other information that the servers need to share without going back to a database.

We use two rounds of MD5 digestion to compute the hash rather than one. This prevents a malicious user from appending extra information to the end of the ticket by exploiting one of the mathematical properties of the MD5 algorithm. Although it is unlikely that this would present a problem here, it is always a good idea to plug this known vulnerability.

The secret key is the linchpin of the whole scheme. Because the secret key is known only to the servers and not to the rest of the world, only a trusted web server can issue and validate the ticket. However, there is the technical problem of sharing the secret key among the servers in a secure manner. If the key were intercepted, the interloper could write his own tickets. In this module, we use either of two methods for sharing the secret key. The secret key may be stored in a file located on the filesystem, in which case it is the responsibility of the system administrator to distribute it among the various servers that use it (NFS is one option, rdist, FTP, or secure shell are others). Alternatively, the module also allows the secret key to be fetched from a central web server via a URI. The system administrator must configure the configuration files so that only internal hosts are allowed to access it.

We'll take a top-down approach to the module starting with the access control handler implemented by the machines that accept tickets. Example 6-12 gives the code for Apache::TicketAccess and a typical entry in the configuration file. The relevant configuration directives look like this:

<Location /protected>
 PerlAccessHandler Apache::TicketAccess
 PerlSetVar        TicketDomain  .capricorn.org
 PerlSetVar        TicketSecret  http://master.capricorn.org/secrets/key.txt
 ErrorDocument     403 http://master.capricorn.org/ticketLogin
</Location>

These directives set the access control handler to use Apache::TicketAccess, and set two per-directory configuration variables using PerlSetVar. TicketDomain is the DNS domain over which issued tickets are valid. If not specified, the module will attempt to guess it from the server hostname, but it's best to specify that information explicitly. TicketSecret is the URI where the shared secret key can be found. It can be on the same server or a different one. Instead of giving a URI, you may specify a physical path to a file on the local system. The contents of the file will be used as the secret.

The last line is an ErrorDocument directive that redirects 403 ("Forbidden") errors to a URI on the ticket master machine. If a client fails to produce a valid ticket--or has no ticket at all--the web server it tried to access will reject the request, causing Apache to redirect the client to the ticket master URI. The ticket master will handle the details of authentication and authorization, give the client a ticket, and then redirect it back to the original server.

Turning to the code for Apache::TicketAccess, you'll find that it's extremely short because all the dirty work is done in a common utility library named Apache::TicketTool. The handler fetches the request object and uses it to create a new TicketTool object. The TicketTool is responsible for fetching the per-directory configuration options, recovering the ticket from the HTTP headers, and fetching the secret key. Next we call the TicketTool's verify_ticket() method to return a result code and an error message. If the result code is true, we return OK.

If verify_ticket() returns false, we do something a bit more interesting. We're going to set in motion a chain of events that leads to the client being redirected to the server responsible for issuing tickets. However, after it issues the ticket, we want the ticket master to redirect the browser back to the original page it tried to access. If the ticket issuer happens to be the same as the current server, we can (and do) recover this information from the Apache subrequest record. However, in the general case the server that issues the ticket is not the same as the current one, so we have to cajole the browser into transmitting the URI of the current request to the issuer.

To do this, we invoke the TicketTool object's make_return_address() method to create a temporary cookie that contains the current request's URI. We then add this cookie to the error headers by calling the request object's err_header_out() method. Lastly, we return a FORBIDDEN status code, triggering the ErrorDocument directive and causing Apache to redirect the request to the ticket master.

Example 6-12. Ticket-Based Access Control

package Apache::TicketAccess;
use strict;
use Apache::Constants qw(:common);
use Apache::TicketTool ();

sub handler {
   my $r = shift;
   my $ticketTool = Apache::TicketTool->new($r);
   my($result, $msg) = $ticketTool->verify_ticket($r);
   unless ($result) {
      $r->log_reason($msg, $r->filename);
      my $cookie = $ticketTool->make_return_address($r);
      $r->err_headers_out->add('Set-Cookie' => $cookie);
      return FORBIDDEN;
   }
   return OK;
}

1;
__END__

Now let's have a look at the code to authenticate users and issue tickets. Example 6-13 shows Apache::TicketMaster, the module that runs on the central authentication server, along with a sample configuration file entry.

For the ticket issuer, the configuration is somewhat longer than the previous one, reflecting its more complex role:

<Location /ticketLogin>
 SetHandler  perl-script
 PerlHandler Apache::TicketMaster
 PerlSetVar  TicketDomain   .capricorn.org
 PerlSetVar  TicketSecret   http://master.capricorn.org/secrets/key.txt
 PerlSetVar  TicketDatabase mysql:test_www
 PerlSetVar  TicketTable    user_info:user_name:passwd
 PerlSetVar  TicketExpires  10
</Location>

We define a URI called /ticketLogin. The name of this URI is arbitrary, but it must match the URI given in protected directories' ErrorDocument directive. This module is a standard content handler rather than an authentication handler. Not only does this design allow us to create a custom login screen (Figure 6-4), but we can design our own authentication system, such as one based on answering a series of questions correctly. Therefore, we set the Apache handler to perl-script and use a PerlHandler directive to set the content handler to Apache::TicketMaster.

Figure 6-4. The custom login screen shown by the ticket master server prompts the user for a username and password.

Five PerlSetVar directives set some per-directory configuration variables. Two of them we've already seen. TicketDomain and TicketSecret are the same as the corresponding variables on the servers that use Apache::TicketAccess, and should be set to the same values throughout the site.

The last three per-directory configuration variables are specific to the ticket issuer. TicketDatabase indicates the relational database to use for authentication. It consists of the DBI driver and the database name separated by colons. TicketTable tells the module where it can find usernames and passwords within the database. It consists of the table name, the username column and the password column, all separated by colons. The last configuration variable, TicketExpires, contains the time (expressed in minutes) for which the issued ticket is valid. After this period of time the ticket expires and the user has to reauthenticate. In this system we measure the ticket expiration time from the time that it was issued. If you wish, you could modify the logic so that the ticket expires only after a certain period of inactivity.

The code is a little longer than Apache::TicketAccess. We'll walk through the relevant parts.

package Apache::TicketMaster;
use strict;
use Apache::Constants qw(:common);
use Apache::TicketTool ();
use CGI qw(:standard);

Apache::TicketMaster loads Apache::Constants, the Apache::TicketTool module, and CGI.pm, which will be used for its HTML shortcuts.

sub handler {
   my $r = shift;
   my($user, $pass) = map { param($_) } qw(user password);

Using the reverse logic typical of CGI scripts, the handler() subroutine first checks to see whether script parameters named user and password are already defined, indicating that the user has submitted the fill-out form.

    my $request_uri = param('request_uri') ||
      ($r->prev ? $r->prev->uri : cookie('request_uri'));

    unless ($request_uri) {
      no_cookie_error();
      return OK;
   }

The subroutine then attempts to recover the URI of the page that the user attempted to fetch before being bumped here. The logic is only a bit twisted. First, we look for a hidden CGI parameter named request_uri. This might be present if the user failed to authenticate the first time and resubmits the form. If this parameter isn't present, we check the request object to see whether this request is the result of an internal redirect, which will happen when the same server both accepts and issues tickets. If there is a previous request, we recover its URI. Otherwise, the client may have been referred to us via an external redirect. Using CGI.pm's cookie() method, we check the request for a cookie named request_uri and recover its value. If we've looked in all these diverse locations and still don't have a location, something's wrong. The most probable explanation is that the user's browser doesn't accept cookies or the user has turned cookies off. Since the whole security scheme depends on cookies being active, we call an error routine named no_cookie_error() that gripes at the user for failing to configure his browser correctly.

    my $ticketTool = Apache::TicketTool->new($r);
   my($result, $msg);
   if ($user and $pass) {
      ($result, $msg) = $ticketTool->authenticate($user, $pass);
      if ($result) {
          my $ticket = $ticketTool->make_ticket($r, $user);
          unless ($ticket) {
              $r->log_error("Couldn't make ticket -- missing secret?");
              return SERVER_ERROR;
          }
          go_to_uri($r, $request_uri, $ticket);
          return OK;
      }
   }
   make_login_screen($msg, $request_uri);
   return OK;
}

We now go on to authenticate the user. We create a new TicketTool from the request object. If both the username and password fields are filled in, we call on TicketTool's authenticate() method to confirm the user's ID against the database. If this is successful, we call make_ticket() to create a cookie containing the ticket information and invoke our go_to_uri() subroutine to redirect the user back to the original URI.

If authentication fails, we display an error message and prompt the user to try the login again. If the authentication succeeds, but TicketTool fails to return a ticket for some reason, we exit with a server error. This scenario only happens if the secret key cannot be read. Finally, if either the username or the password are missing, or if the authentication attempt failed, we call make_login_screen() to display the sign-in page.

The make_login_screen() and no_cookie_error() subroutines are straightforward, so we won't go over them. However, go_to_uri() is more interesting:

sub go_to_uri {
   my($r, $requested_uri, $ticket) = @_;
   print header(-refresh => "1; URL=$requested_uri", -cookie => $ticket),
   start_html(-title => 'Successfully Authenticated', -bgcolor => 'white'),
   h1('Congratulations'),
   h2('You have successfully authenticated'),
   h3("Please stand by..."),
   end_html();
}

This subroutine uses CGI.pm methods to create an HTML page that briefly displays a message that the user has successfully authenticated, and then automatically loads the page that the user tried to access in the first place. This magic is accomplished by adding a Refresh field to the HTTP header, with a refresh time of one second and a refresh URI of the original page. At the same time, we issue an HTTP cookie containing the ticket created during the authentication process.

Example 6-13. The Ticket Master

package Apache::TicketMaster;

use strict;
use Apache::Constants qw(:common);
use Apache::TicketTool ();
use CGI qw(:standard);

# This is the log-in screen that provides authentication cookies.
# There should already be a cookie named "request_uri" that tells
# the login screen where the original request came from.
sub handler {
   my $r = shift;
   my($user, $pass) = map { param($_) } qw(user password);
   my $request_uri = param('request_uri') ||
      ($r->prev ? $r->prev->uri : cookie('request_uri'));

    unless ($request_uri) {
      no_cookie_error();
      return OK;
   }

    my $ticketTool = Apache::TicketTool->new($r);
   my($result, $msg);
   if ($user and $pass) {
      ($result, $msg) = $ticketTool->authenticate($user, $pass);
      if ($result) {
          my $ticket = $ticketTool->make_ticket($r, $user);
          unless ($ticket) {
              $r->log_error("Couldn't make ticket -- missing secret?");
              return SERVER_ERROR;
          }
          go_to_uri($r, $request_uri, $ticket);
          return OK;
      }
   }
   make_login_screen($msg, $request_uri);
   return OK;
}
sub go_to_uri {
   my($r, $requested_uri, $ticket) = @_;
   print header(-refresh => "1; URL=$requested_uri", -cookie => $ticket),
   start_html(-title => 'Successfully Authenticated', -bgcolor => 'white'),
   h1('Congratulations'),
   h2('You have successfully authenticated'),
   h3("Please stand by..."),
   end_html();
}

sub make_login_screen {
   my($msg, $request_uri) = @_;
   print header(),
   start_html(-title => 'Log In', -bgcolor => 'white'),
   h1('Please Log In');
   print  h2(font({color => 'red'}, "Error: $msg")) if $msg;
   print start_form(-action => script_name()),
   table(
        Tr(td(['Name',     textfield(-name => 'user')])),
        Tr(td(['Password', password_field(-name => 'password')]))
        ),
            hidden(-name => 'request_uri', -value => $request_uri),
            submit('Log In'), p(),
            end_form(),
            em('Note: '),
            "Set your browser to accept cookies in order for login to succeed.",
            "You will be asked to log in again after some period of time.";
}

# called when the user tries to log in without a cookie
sub no_cookie_error {
   print header(),
   start_html(-title => 'Unable to Log In', -bgcolor => 'white'),
   h1('Unable to Log In'),
   "This site uses cookies for its own security.  Your browser must be capable ",  
   "of processing cookies ", em('and'), " cookies must be activated. ",
   "Please set your browser to accept cookies, then press the ",
   strong('reload'), " button.", hr();
}

1;
__END__

By now you're probably curious to see how Apache::TicketTool works, so let's have a look at it (Example 6-14).

package Apache::TicketTool;

use strict;
use Tie::DBI ();
use CGI::Cookie ();
use MD5 ();
use LWP::Simple ();
use Apache::File ();
use Apache::URI ();

We start by importing the modules we need, including Tie::DBI, CGI::Cookie, and the MD5 module.

my $ServerName = Apache->server->server_hostname;

my %DEFAULTS = (
  'TicketDatabase' => 'mysql:test_www',
  'TicketTable'    => 'user_info:user_name:passwd',
  'TicketExpires'  => 30,
  'TicketSecret'   => 'http://$ServerName/secret_key.txt',
  'TicketDomain'   => undef,
);

my %CACHE;  # cache objects by their parameters to minimize time-consuming operations

Next we define some default variables that were used during testing and development of the code and an object cache named %CACHE. %CACHE holds a pool of TicketTool objects and was designed to increase the performance of the module. Rather than reading the secret key each time the module is used, the key is cached in memory. This cache is flushed every time there is a ticket mismatch, allowing the key to be changed frequently without causing widespread problems. Similarly, we cache the name of the name of the server, by calling Apache->server->server_hostname (see "The Apache::Server Class" in Chapter 9 for information on retrieving other server configuration values).

sub new {
   my($class, $r) = @_;
   my %self = ();
   foreach (keys %DEFAULTS) {
      $self{$_} = $r->dir_config($_) || $DEFAULTS{$_};
   }
   # post-process TicketDatabase and TicketDomain
   ($self{TicketDomain} = $ServerName) =~ s/^[^.]+//
      unless $self{TicketDomain};

    # try to return from cache
   my $id = join '', sort values %self;
   return $CACHE{$id} if $CACHE{$id};

    # otherwise create new object
   return $CACHE{$id} = bless \%self, $class;
}

The TicketTool new() method is responsible for initializing a new TicketTool object or fetching an appropriate old one from the cache. It reads the per-directory configuration variables from the passed request object and merges them with the defaults. If no TicketDomain variable is present, it attempts to guess one from the server hostname. The code that manages the cache indexes the cache array with the values of the per-directory variables so that several different configurations can coexist peacefully.

sub authenticate {
    my($self, $user, $passwd) = @_;
   my($table, $userfield, $passwdfield) = split ':', $self->{TicketTable};

    tie my %DB, 'Tie::DBI', {
      'db'    => $self->{TicketDatabase},
      'table' => $table, 'key' => $userfield,
   } or return (undef, "couldn't open database");

    return (undef, "invalid account")
      unless $DB{$user};

    my $saved_passwd = $DB{$user}->{$passwdfield};
   return (undef, "password mismatch")
      unless $saved_passwd eq crypt($passwd, $saved_passwd);

    return (1, '');
}

The authenticate() method is called by the ticket issuer to authenticate a username and password against a relational database. This method is just a rehash of the Tie::DBI database authentication code that we have seen in previous sections.

sub fetch_secret {
   my $self = shift;
   unless ($self->{SECRET_KEY}) {
      if ($self->{TicketSecret} =~ /^http:/) {
          $self->{SECRET_KEY} = LWP::Simple::get($self->{TicketSecret});
      } else {
          my $fh = Apache::File->new($self->{TicketSecret}) || return undef;
          $self->{SECRET_KEY} = <$fh>;
      }
   }
   $self->{SECRET_KEY};
}

The fetch_secret() method is responsible for fetching the secret key from disk or via the web. The subroutine first checks to see whether there is already a secret key cached in memory and returns that if present. Otherwise it examines the value of the TicketSecret variable. If it looks like a URI, we load the LWP Simple module and use it to fetch the contents of the URI.¹⁰ If TicketSecret doesn't look like a URI, we attempt to open it as a physical pathname using Apache::File methods and read its contents. We cache the result and return it.

sub invalidate_secret { undef shift->{SECRET_KEY}; }

The invalidate_secret() method is called whenever there seems to be a mismatch between the current secret and the cached one. This method deletes the cached secret, forcing the secret to be reloaded the next time it's needed.

The make_ticket() and verify_ticket() methods are responsible for issuing and checking tickets:

sub make_ticket {
   my($self, $r, $user_name) = @_;
   my $ip_address = $r->connection->remote_ip;
   my $expires = $self->{TicketExpires};
   my $now = time;
   my $secret = $self->fetch_secret() or return undef;
   my $hash = MD5->hexhash($secret .
                MD5->hexhash(join ':', $secret, $ip_address, $now,
                             $expires, $user_name)
              );
   return CGI::Cookie->new(-name => 'Ticket',
                           -path => '/',
                            -domain => $self->{TicketDomain},
                           -value => {
                              'ip' => $ip_address,
                              'time' => $now,
                              'user' => $user_name,
                              'hash' => $hash,
                              'expires' => $expires,
                           });
}

make_ticket() gets the user's name from the caller, the browser's IP address from the request object, the expiration time from the value of the TicketExpires configuration variable, and the secret key from the fetch_secret() method. It then concatenates these values along with the current system time and calls MD5's hexhash() method to turn them into an MD5 digest.

The routine now incorporates this digest into an HTTP cookie named Ticket by calling CGI::Cookie->new(). The cookie contains the hashed information, along with plain text versions of everything except for the secret key. A cute feature of CGI::Cookie is that it serializes simple data structures, allowing you to turn hashes into cookies and later recover them. The cookie's domain is set to the value of TicketDomain, ensuring that the cookie will be sent to all servers in the indicated domain. Note that the cookie itself has no expiration date. This tells the browser to keep the cookie in memory only until the user quits the application. The cookie is never written to disk.

sub verify_ticket {
   my($self, $r) = @_;
   my %cookies = CGI::Cookie->parse($r->header_in('Cookie'));
   return (0, 'user has no cookies') unless %cookies;
   return (0, 'user has no ticket') unless $cookies{'Ticket'};
   my %ticket = $cookies{'Ticket'}->value;
   return (0, 'malformed ticket')
      unless $ticket{'hash'} && $ticket{'user'} &&
          $ticket{'time'} && $ticket{'expires'};
   return (0, 'IP address mismatch in ticket')
      unless $ticket{'ip'} eq $r->connection->remote_ip;
   return (0, 'ticket has expired')
      unless (time - $ticket{'time'})/60 < $ticket{'expires'};
   my $secret;
   return (0, "can't retrieve secret")
      unless $secret = $self->fetch_secret;
   my $newhash = MD5->hexhash($secret .
                    MD5->hexhash(join ':', $secret,
                             @ticket{qw(ip time expires user)})
                 );
   unless ($newhash eq $ticket{'hash'}) {
      $self->invalidate_secret;  #maybe it's changed?
      return (0, 'ticket mismatch');
   }
   $r->connection->user($ticket{'user'});
    return (1, 'ok');
}

verify_ticket() does the same thing but in reverse. It calls CGI::Cookie->parse() to parse all cookies passed in the HTTP header and stow them into a hash. The method then looks for a cookie named Ticket. If one is found, it recovers each of the ticket's fields and does some consistency checks. The method returns an error if any of the ticket fields are missing, if the request's IP address doesn't match the ticket's IP address, or if the ticket has expired.

verify_ticket() then calls secret_key() to get the current value of the secret key and recomputes the hash. If the new hash doesn't match the old one, then either the secret key has changed since the ticket was issued or the ticket is a forgery. In either case, we invalidate the cached secret and return false, forcing the user to repeat the formal authentication process with the central server. Otherwise the function saves the username in the connection object by calling $r->connection->user($ticket{'user'}) and returns true result code. The username is saved into the connection object at this point so that authorization and logging handlers will have access to it. It also makes the username available to CGI scripts via the REMOTE_USER environment variable.

sub make_return_address {
   my($self, $r) = @_;
   my $uri = Apache::URI->parse($r, $r->uri);
   $uri->scheme("http");
   $uri->hostname($r->get_server_name);
   $uri->port($r->get_server_port);
   $uri->query(scalar $r->args);

    return CGI::Cookie->new(-name => 'request_uri',
                           -value => $uri->unparse,
                           -domain => $self->{TicketDomain},
                           -path => '/');
}

The last method, make_return_address(), is responsible for creating a cookie to transmit the URI of the current request to the central authentication server. It recovers the server hostname, port, path, and CGI variables from the request object and turns it into a full URI. It then calls CGI::Cookie->new() to incorporate this URI into a cookie named request_uri, which it returns to the caller. scheme(), hostname(), and the other URI processing calls are explained in detail in Chapter 9, under "The Apache::URI Class."

Example 6-14. The Ticket Issuer

package Apache::TicketTool;

use strict;
use Tie::DBI ();
use CGI::Cookie ();
use MD5 ();
use LWP::Simple ();
use Apache::File ();
use Apache::URI ();

my $ServerName = Apache->server->server_hostname;

my %DEFAULTS = (
  'TicketDatabase' => 'mysql:test_www',
  'TicketTable'    => 'user_info:user_name:passwd',
  'TicketExpires'  => 30,
  'TicketSecret'   => 'http://$ServerName/secret_key.txt',
  'TicketDomain'   => undef,
);

my %CACHE;  # cache objects by their parameters to minimize time-consuming operations

# Set up default parameters by passing in a request object
sub new {
   my($class, $r) = @_;
   my %self = ();
   foreach (keys %DEFAULTS) {
      $self{$_} = $r->dir_config($_) || $DEFAULTS{$_};
   }
   # post-process TicketDatabase and TicketDomain
   ($self{TicketDomain} = $ServerName) =~ s/^[^.]+//
      unless $self{TicketDomain};

    # try to return from cache
   my $id = join '', sort values %self;
   return $CACHE{$id} if $CACHE{$id};

    # otherwise create new object
   return $CACHE{$id} = bless \%self, $class;
}

# TicketTool::authenticate()
# Call as:
# ($result,$explanation) = $ticketTool->authenticate($user,$passwd)
sub authenticate {
   my($self, $user, $passwd) = @_;
   my($table, $userfield, $passwdfield) = split ':', $self->{TicketTable};

    tie my %DB, 'Tie::DBI', {
      'db'    => $self->{TicketDatabase},
      'table' => $table, 'key' => $userfield,
   } or return (undef, "couldn't open database");

    return (undef, "invalid account")
      unless $DB{$user};

    my $saved_passwd = $DB{$user}->{$passwdfield};
   return (undef, "password mismatch")
      unless $saved_passwd eq crypt($passwd, $saved_passwd);

    return (1, '');
}

# TicketTool::fetch_secret()
# Call as:
# $ticketTool->fetch_secret();
sub fetch_secret {
   my $self = shift;
   unless ($self->{SECRET_KEY}) {
      if ($self->{TicketSecret} =~ /^http:/) {
          $self->{SECRET_KEY} = LWP::Simple::get($self->{TicketSecret});
      } else {
          my $fh = Apache::File->new($self->{TicketSecret}) || return undef;
          $self->{SECRET_KEY} = <$fh>;
      }
   }
   $self->{SECRET_KEY};
}

# invalidate the cached secret
sub invalidate_secret { undef shift->{SECRET_KEY}; }

# TicketTool::make_ticket()
# Call as:
# $cookie = $ticketTool->make_ticket($r,$username);
#
sub make_ticket {
   my($self, $r, $user_name) = @_;
   my $ip_address = $r->connection->remote_ip;
   my $expires = $self->{TicketExpires};
   my $now = time;
   my $secret = $self->fetch_secret() or return undef;
   my $hash = MD5->hexhash($secret .
                MD5->hexhash(join ':', $secret, $ip_address, $now,
                             $expires, $user_name)
              );
   return CGI::Cookie->new(-name => 'Ticket',
                           -path => '/',
                           -domain => $self->{TicketDomain},
                           -value => {
                              'ip' => $ip_address,
                              'time' => $now,
                              'user' => $user_name,
                              'hash' => $hash,
                              'expires' => $expires,
                           });
}

# TicketTool::verify_ticket()
# Call as:
# ($result,$msg) = $ticketTool->verify_ticket($r)
sub verify_ticket {
   my($self, $r) = @_;
   my %cookies = CGI::Cookie->parse($r->header_in('Cookie'));
   return (0, 'user has no cookies') unless %cookies;
   return (0, 'user has no ticket') unless $cookies{'Ticket'};
   my %ticket = $cookies{'Ticket'}->value;
   return (0, 'malformed ticket')
      unless $ticket{'hash'} && $ticket{'user'} &&
          $ticket{'time'} && $ticket{'expires'};
   return (0, 'IP address mismatch in ticket')
      unless $ticket{'ip'} eq $r->connection->remote_ip;
   return (0, 'ticket has expired')
      unless (time - $ticket{'time'})/60 < $ticket{'expires'};
   my $secret;
   return (0, "can't retrieve secret")
      unless $secret = $self->fetch_secret;
   my $newhash = MD5->hexhash($secret .
                    MD5->hexhash(join ':', $secret,
                             @ticket{qw(ip time expires user)})
                 );
   unless ($newhash eq $ticket{'hash'}) {
      $self->invalidate_secret;  #maybe it's changed?
      return (0, 'ticket mismatch');
   }
   $r->connection->user($ticket{'user'});
   return (1, 'ok');
}

# Call as:
# $cookie = $ticketTool->make_return_address($r)
sub make_return_address {
   my($self, $r) = @_;
   my $uri = Apache::URI->parse($r, $r->uri);
   $uri->scheme("http");
   $uri->hostname($r->get_server_name);
   $uri->port($r->get_server_port);
   $uri->query(scalar $r->args);

    return CGI::Cookie->new(-name => 'request_uri',
                           -value => $uri->unparse,
                           -domain => $self->{TicketDomain},
                           -path => '/');
}

1;
__END__

Footnotes

⁹ The incorporation of the IP address into the ticket can be problematic if many of your users are connected to the web through a proxy server (America Online for instance!). Proxy servers make multiple browsers all seem to be coming from the same IP address, defeating this check. Worse, some networks are configured to use multiple proxy servers on a round-robin basis, so the same user may not keep the same apparent IP address within a single session! If this presents a problem for you, you can do one of three things: (1) remove the IP address from the ticket entirely; (2) use just the first three numbers in the IP address (the network part of a class C address); or (3) detect and replace the IP address with one of the fields that proxy servers sometimes use to identify the browser, such as X-Forwarded-For (see the description of remote_ip() in "The Apache::Connection Class," in Chapter 9, Perl API Reference Guide.