#$Header: /cvsroot/CM_base_modules/lib/CM/Auth.pm,v 1.3 2003/04/25 01:
+25:55 rbowen Exp $
package CM::Auth;

use strict;
use warnings;
use Apache::Constants qw(:common FORBIDDEN REDIRECT M_GET);
use Digest::MD5 qw();

use base qw(Exporter);
use vars qw(@EXPORT $VERSION);
@EXPORT = qw(subclass recognize_user logout set_cookie unset_cookie);
$VERSION = (qw'$Revision: 1.3 $')[1];

# sub subclass {{{

=head2 subclass

  Package CM::Namespace::Auth;
  use CM::Auth;

  subclass(
    MODULE => 'CM::Namespace::Auth',
    );

  sub authorized {
      my $class = shift;
      my ($username, $r) = @_;
      return 1;
  }

  sub valid_password {
      my $class = shift;
      my ($username, $password, $r) = @_;
      return 1;
  }

  1;

Provides mechanism for subclassing CM::Auth, and getting all the good
stuff. Note that C<authorized> and C<valid_password> are required. If
they are not provided, nothing will work.

=cut

sub subclass {
    my %args = @_;
    die 'MODULE must be defined in subclass()' unless defined $args{MO
+DULE};
    eval "require $args{MODULE}";
    die "$args{MODULE} not found. require failed: $@" if $@;
    my $namespace = (caller())[0];

    {
        no strict "refs";
        *{$namespace . "::handler"} = eval 'sub { CM::Auth::handler( $
+namespace, @_ );}';
        *{$namespace . "::login"} = eval 'sub { CM::Auth::login( $name
+space, @_ );}';
    }
} # }}}

# sub handler {{{

=head2 handler

Here's how it's supposed to work when a URL is requested:

 Cookie present? ---> Yes ---> Is the key valid ---> Yes -----|
       |                               |                      |
       |                               |                      |
       No                             No                      |
       |                               |                      |
       V                               |                      |
     Redirect to <----------------------                      |
 |-> login form.                                              |
 |       |                                                    |
 |       |                                                    |
 |   Username, password                                       V
 |   Entered. Valid?   ---->Yes---> Set cookie,-----------> Authorized
+? 
 |       |                           Put key in              |      |
 |       |                            database               |      | 
 |       V                                                   V      |
 |       No                                       Yes<--------      V
 |       |                                         |                No
 |       V                                         |                |
 --- Return to login form, with useful             V                V
     error message.                            Return OK          Retu
+rn
                                                              Unauthor
+ized
                                                               Message

=cut

sub handler {
    my $class = shift;
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');
    $r->warn(__PACKAGE__ . ": AuthRealm is a REQUIRED variable.")
        unless $realm;

    my $debug = $r->dir_config($realm . 'AuthLogLevel');
    $r->warn(__PACKAGE__ . ": AuthLogLevel is a REQUIRED variable.")
        unless $debug;

    my $acl = $r->dir_config($realm . 'ACL');
    return OK unless ( defined $acl ); 
    # Subclass needs to explicitly deal with ACL 0

    my ($username, $password) = get_username($r);

    unless ( $class->valid_password($username, $password, $r)) {
        unset_cookie($r);
        return login_form($r);
    }

    if ($username) {
        if ( $class->authorized( $username, $r ) ) {
            $r->connection->user($username);
            $r->warn(__PACKAGE__ . " handler: $username requested " . 
+$r->uri) 
                if $debug & 4; # verbsose
            return OK;
        } else {
            $r->log_reason(
                "User $username is not authorized to enter ACL $acl")
                if $debug & 1; # failure
            $r->custom_response(FORBIDDEN, 
                    $r->dir_config($realm . 'Unauthorized'));
            return FORBIDDEN;
        }
    } else {
        unset_cookie($r);
        return login_form($r);
    }
}

# }}}

# sub recognize_user {{{

=head2 recognize_user

 $username = CM::Auth->recognize_user($r);

For areas that don't require authentication, retrieves the cookie
information, if any, and sets $r->connection->user to the username
found, if any. Sets it to '' otherwise.

Note that if you are going to call C<recognize_user> then you MUST hav
+e
the  variable C<AuthRealm> set to something, if you want to
hvae the various log messages output. If C<AuthRealm> is null, then
success logging will be silently turned off.

=cut

sub recognize_user {
    my $class = shift;
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');
    my $debug = $realm ? $r->dir_config($realm . 'AuthLogLevel') : '';

    my ($username,$password) = get_username($r);
    if ($username && $class->valid_password($username, $password, $r))
+ {
        $r->connection->user($username);
        $r->warn(__PACKAGE__ . " recognize_user: recognized user $user
+name") 
            if $debug && $debug & 4;
        return $username;
    } else {
        $r->connection->user('');
        unset_cookie($r);
        $r->warn(__PACKAGE__ . " recognize_user: User is not logged in
+") 
            if $debug && $debug & 4;
        return '';
    }
} # }}}

# sub get_username  {{{

=head2 get_username

 my $username = get_username($r);

Or, from outside the module ...

 my $key = CM::NUSA::A::Auth::get_username($r);

Returns the username of the current user, if they have authenticated, 
+or
undef if they have not.

=cut

sub get_username {
    my $r = shift;

    my $key = get_cookie($r) || return undef;
    my ($username,$password) = user_pass($key);
    return undef unless $username && $password;
   
    return ($username,$password);
} #  }}}

# sub get_cookie {{{

=head2 get_cookie

 my $session_key = get_cookie($r);

Returns the session key, which is saved in the user's cookie.

=cut

sub get_cookie {
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');
    $r->warn(__PACKAGE__ . ': AuthRealm is a required parameter.') unl
+ess $realm;

    my $cookie = $r->header_in('Cookie');
    return unless $cookie;

    my $key = $realm . 'key';
    $cookie =~ m/\b$key=([^;]+)/;
    $cookie=$1;
    return $cookie;
} #}}}

# sub user_pass {{{

=head2 user_pass 

 my ($username, $password) = user_pass($key);

Given a session key, looks up the username and password (MD5'ed) assoc
+iated 
with that key, if any. Returns undef if the key is not valid.

=cut

sub user_pass {
    my $key = shift;
    my ($username, $password) = split /\//,$key;

    return ($username,$password);
}

# }}}

# sub login_form {{{

=head2 login_form

 # PerlSetVar LoginForm /login.html

 login_form($r);

Redirects the user to the login form, which is specified in the
C<LoginForm> variable. See X<APACHE CONFIG> below for syntax.

=cut

#sub login_form {
#    my $r = shift;
#    my $realm = $r->dir_config('AuthRealm');
#    my $url = $r->dir_config($realm . 'LoginForm');
#    $r->custom_response(REDIRECT, $url);
#    return FORBIDDEN;
#}

sub login_form {
    #my $class = shift; leave as is
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');

    my %args = $r->method eq 'POST' ? $r->content : $r->args;
    $args{destination} = $r->dir_config($realm . 'LoginForm');
    $r->headers_out->add( "Location" => $args{destination} );
    $r->err_headers_out->add( "Location" => $args{destination} );
    
    return REDIRECT;
}
#}}}

# sub login {{{

=head2 login

Post the C<login_form> here. It should contain a C<username> and
C<password> field. If the user correctly authenticates, a cookie will 
+be
set which will be usable for authentication afterwards.

An optional additional argument, C<destination>, will specify the URL 
+to
which the user should go once they have authenticated. Presumably, thi
+s
is where they were attempting to go when they failed authentication in
the first place.

=cut

sub login {
    my $class = shift;
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');
    my $userfield = $r->dir_config($realm . 'UserField');
    my $passfield = $r->dir_config($realm . 'PassField');
    my $debug = $r->dir_config($realm . 'AuthLogLevel');
    my $default = $r->dir_config($realm . 'DefaultPage');

    my %args = $r->method eq 'POST' ? $r->content : $r->args;
    $args{destination} ||= $r->dir_config($realm . 'DefaultPage');
    $args{destination} = $r->dir_config($realm . 'DefaultPage')
                            if $args{destination} =~ /LOGIN/;

    
    unless ( $args{$userfield} && $args{$passfield}) {
        $r->log_reason(__PACKAGE__ . " login: Username or password was
+ null")
            if $debug & 1;
        $r->warn(__PACKAGE__ . " login: Username provided was '$args{$
+userfield}'")
            if $debug & 4;
        return invalid_login($r);
    }

    $args{$passfield} = Digest::MD5::md5_hex($args{$passfield});
    if ( $class->valid_password( $args{$userfield}, $args{$passfield},
+ $r ) ) {

        $r->connection->user($args{$userfield});

        $r->warn(__PACKAGE__ . " login: Setting cookie for user $args{
+$userfield}")
            if $debug & 4;
        set_cookie( $r, $args{$userfield}, $args{$passfield} );
        if ( $r->method eq 'POST' ) {
            $r->method('GET');
            $r->method_number(M_GET);
            $r->headers_in->unset('Content-Length');
        }

        $r->warn(__PACKAGE__ . " login: User $args{$userfield} success
+fully logged in")
            if $debug & 2;

        if ($args{destination} =~ /login\.html/) { # login.html or htm
+l/login.html
            $args{destination} = $default;
        }
        $r->headers_out->add( "Location" => $args{destination} );
        $r->err_headers_out->add( "Location" => $args{destination} );

        return REDIRECT;
    } else {
        $r->log_reason("Password mismatch for user $args{$userfield}")
+ 
            if $debug & 1;

        return invalid_login($r);
    }
}    #}}}

# sub set_cookie {{{

=head2 set_cookie

 set_cookie($r, $username);

Sets the cookie on the browser.

=cut

sub set_cookie {
    my ($r, $username, $password) = @_;

    my $realm = $r->dir_config('AuthRealm');
    my $domain = $r->dir_config($realm . 'AuthDomain');
    my $cookie;

    if ($domain) {
        $cookie = $realm . "key=" . $username . '/' . $password . 
             "; expires=Wed, 28-Aug-2019 00:00:00 GMT; path=/; domain=
+$domain;"; #was Tue
    } else {
        $cookie = $realm . "key=" . $username . '/' . $password . 
             "; expires=Wed, 28-Aug-2019 00:00:00 GMT; path=/;";
    }
    $r->headers_out->add("Set-Cookie" => $cookie);
    $r->err_headers_out->add("Set-Cookie" => $cookie);

    return 1;
} #}}}

# sub unset_cookie {{{

=head2 unset_cookie

 unset_cookie($r);

Clears the cookie on the browser.

=cut

sub unset_cookie {
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');

    my $domain = $r->dir_config($realm . 'AuthDomain');
    my $cookie;

    if ($domain) {
        $cookie = $realm 
            . "key=; path=/; expires=Tue, 23-Oct-2018 00:00:00 GMT; do
+main=$domain";
        $r->err_headers_out->add("Set-Cookie" => $cookie);
        $r->headers_out->add("Set-Cookie" => $cookie);
        $cookie = $realm . "key=; path=/; expires=Tue, 23-Oct-2018 00:
+00:00 GMT;";
        $r->err_headers_out->add("Set-Cookie" => $cookie);
        $r->headers_out->add("Set-Cookie" => $cookie);
# This second cookie is unset for browsers that are hanging onto a
# host-specified cookie as well as the domain one
    } else {
        $cookie = $realm . "key=; path=/; expires=Tue, 23-Oct-2018 00:
+00:00 GMT;";
        $r->err_headers_out->add("Set-Cookie" => $cookie);
        $r->headers_out->add("Set-Cookie" => $cookie);
    }

    $r->warn(__PACKAGE__ . ' unset_cookie: Deleting cookie')
        if $r->dir_config($realm . 'AuthLogLevel') & 4;
    return 1;
} #}}}

# sub invalid_login {{{

=head2 invalid_login

 return invalid_login($r);

Return a useful page telling the user that they username and/or passwo
+rd
that they provided was not valid.

=cut

sub invalid_login {
    my $r = shift;
    my $realm = $r->dir_config('AuthRealm');
    #my $url = $r->dir_config($realm . 'InvalidLogin');
    my $url = "/maneggio/login_failed.html";    # XXX
    $r->custom_response(FORBIDDEN, $url);
    return FORBIDDEN;
} # }}}

# sub logout {{{

=head2 logout

 return logout($r);
 return CM::Auth::logout($r);

Sends an empty, expired cookie to the current user, and sends them bac
+k
to the login page. This logs them out. 

=cut

sub logout {
    my $r=shift;
    CM::Auth::unset_cookie($r);
    return CM::Auth::login_form($r);
} # }}}

# Documentation {{{

=head1 NAME

Auth.pm

=head1 NAME

CM::Auth

=head1 AUTHOR

Rich Bowen
<rich@cre8tivegroup.com>

=head1 DATE

$Date: 2003/04/25 01:25:55 $

=head1 VERSION

$Revision: 1.3 $

=head1 DESCRIPTION

Provides cookie based authentication, using the user table as the sour
+ce
of the username and password, and the acl/acg tables for the source of
group information.

This is, technically, as Access Control handler, not an authentication
handler, but it amounts to the same thing, and is a LOT simpler to wri
+te
and configure.

=head2 Cookie

The cookie is a simple combination of their username and other random
stuff.

=head2 Subclassing

CM::Auth is not a standalone module. You are expected to subclass
CM::Auth to create your own authentication module. Your module must
supply the function C<authorized>, which look like the following:

    sub authorized {
        my $class = shift;
        my ($username, $r) = shift;
        my $realm = $r->dir_config('AuthRealm');
        my $acl = $r->dir_config($realm . 'ACL');
        # Determine whether $username should be allowed into $acl
        return $allowed;
    }

The arguments are the username, which is taken from the cookie, and $r
+,
which is the Apache request object, from which one might obtain the
various PerlSetVar values, and any other environment variables that ar
+e
needed. C<authorized()> needs to return true if the user should be let
+ in,
and false if not.

Your C<authorized> function can expect to also receive PerlSetVar
variables C<AuthRealm> and C<RealmACL> (Where the 'Realm' part of
'RealmACL' is substituted by the value of C<AuthRealm>) from which you
can figure out what variables to use.

For example, if C<AuthRealm> has a value of C<Sekr1t>, then you can
expect that the variable C<Sekr1tACL> contains the ACL that this secti
+on
is restricted for.

Your module must also supply <valid_password> which looks like the
following:

    sub valid_password {
        my $class = shift;
        my ($username, $password, $r) = @_;

        # Determine whether $password is a valid password for $usernam
+e
        return $valid;
    }

C<valid_password> should return true or false.

=head2 APACHE CONFIG

    PerlModule YourNameSpace::Auth

    # Then, for a particular Auth realm 'Realm' ...
    PerlSetVar RealmLoginForm "/url/of/login/form"
    # Where 'Realm' gets replaced with your realm name

    PerlSetVar RealmAuthDomain ".numbersusa.com"
    # Set RealmAuthDomain to '' for cookies that only need to be
    # returned to a single host, not a whole domain.
    PerlSetVar RealmUnauthorized "/url/of/unauthorized/warning"
    PerlSetVar RealmInvalidLogin "/url/of/login/form/with/additional/e
+rror/messages"
    PerlSetVar RealmAuthLogLevel 1

    # Place to redirect after login, or other such
    PerlSetVar RealmDefaultPage

    # What is the database field name for usernames?
    PerlSetVar RealmUserField 'username'

    # What is the database field name for passwords?
    PerlSetVar RealmPassField 'password'

    # Then, to protect a particular area: (Directory or Location, eg)
    <Directory /protected>
        PerlAccessHandler CM::Auth
        PerlSetVar AuthRealm 'Realm'
        PerlSetVar RealmACL 2

        # Other directives here
    </Directory>

The various PerlSetVar's have their expected meanings. The one that
requires more explanation is AuthLogLevel

AuthLogLevel is a binary number, allowing you to have a variety of
different log levels. The values are:

 001 - Log all failure messages
 010 - Log all successes
 100 - Log verbose informational debug messages

Additional log levels may be added in the future. In particular, 100
will likely be subdivided into slightly verbose, and exceedingly
verbose.

You can add together several log states. For example, to log only
successes and failures, set the value to 001 + 010 = 011, which is 3
decimal, so you would ...

 PerlSetVar RealmAuthLogLevel 3

Note also that the variable C<AuthRealm> should really be inside the
<Directory> section, so that it does not clobber other C<AuthRealm>
variables on the same server.

Finally, note that hostnames like C<domain.com> will probably not work
for these cookies, and you will need hostnames like C<host.domain.com>
+.
Consequently, you will probably want to redirect requests from, for
example, C<domain.com> to the appropriate place on C<www.domain.com>,
or whatever. This can be accomplished either with a C<RedirectMatch>
directive, or with C<mod_rewrite>. This behavior is a consequence of t
+he
requirement that cookied be returned to a host that contains three
"words" in the hostname, in order that they be valid across multiple
hostnames in the same domain.

If you don't need for cookies to be returned to multiple hosts in the
same domain, just set C<RealmAuthDomain> to ''

=cut

#}}}

1;
[download]