view release on metacpan or  search on metacpan

Generic.pm  view on Meta::CPAN

 # Efforts have been made to make this module work under Apache
 # 1.3.* and mod_perl 1.0, but it has only been tested under
 # Apache 2.0.* and mod_perl 2.0.

=head1 DESCRIPTION

=head2 Variables to set in the Apache configuration file

 The following are variables to be set in the Apache
 configuration file with the PerlSetVar directive.

=head3 generic_auth_cipher_key

 This is the encryption key used for encrypting the cookies used
 to verify authentication.  It must be 32 bytes (256-bit).  The
 encryption used is AES-256 and uses an SHA1 digest to verify
 data integrity.

=head3 generic_auth_failed_url

 This is the url users are be redirected to if they have not been
 authenticated (typically a login page).  This url can be
 relative.

=head3 generic_auth_allow_url

 This is a regular expression that will be run against the URI
 the user is trying to access.  If a match occurs, the user will
 be allowed through, as if the user had been authenticated.  This
 is useful for allowing the user to access the login page and to
 allow access to other public pages.

=head3 generic_auth_cookie_name

 This is the name of the cookie that will be used to verify
 authentication.  This must match the name passed to the
 generateAuthCookie() method when using a CGI script for the
 login process.

=head3 generic_auth_ref_url_var

 This is the name of the field the handler will use to pass the
 current URI to the authentication failed page.  This is useful
 for redirecting the user to the page the user was originally
 trying to access when prompted with the login page.

=head3 generic_auth_set_cookie_env

 If this is set to a true value, and the first argument passed to
 the generateAuthCookie() method is a hash, those values will be
 available to your CGI scripts as environment variables whose
 names are the keys of the hash prefixed with the cookie name (as
 set by generic_auth_cookie_name) and an underscore.

=head1 METHODS

=cut

use strict;
use Crypt::CBC;
use Crypt::Rijndael;
use MIME::Base64 ();
use Storable ();
use Digest::SHA1 ();

{   package Apache::Authen::Generic;

    use vars qw($VERSION);
    
    BEGIN {
        $VERSION = '0.01'; # update below in POD as well
    }

    use mod_perl;
    use constant MP2 => $mod_perl::VERSION >= 1.99;

    # for compatibility with both mod_perl 1 and 2
    BEGIN {
        if (defined($ENV{MOD_PERL}) and $ENV{MOD_PERL} ne '') {
            if (MP2) {
                require Apache2;
                require Apache::compat;
                require Apache::Const;
                Apache::Const->import(-compile => qw(:common HTTP_UNAUTHORIZED));
            } else {
                require Apache::Constants;
                Apache::Constants->import(qw(:common :response HTTP_UNAUTHORIZED));
            }
        }
    }

    sub new {
        my ($proto) = @_;
        my $self = bless {}, ref($proto) || $proto;
        return $self;
    }

=pod

=head2 generateAuthCookie($data, $key, $cookie_params, $cookie_name)

 This method is used to generate the authentication cookie from a
 CGI script.  The return value is the value to set for the header
 Set-Cookie without the end of line sequence, e.g.,

     my $cookie = $auth_obj->($data, $key);
     print "Set-Cookie: $cookie\n";
     print "Location: $redirect_url\n";
     print "\n";

 The value for $key must be the same value assigned to
 generic_auth_cipher_key in the webserver configuration.

 if $data is a reference to a hash and the
 generic_auth_set_cookie_env variable is set to a true value in
 the Apache configuration, the values from the hash will be
 available to your CGI scripts as environment variables whose
 names are the keys of the hash prefixed with the cookie name (as
 set by generic_auth_cookie_name) and an underscore.

Generic.pm  view on Meta::CPAN

        my $url = $self->getAuthFailedPage($req);
        if ($url eq '') {
            # FIXME: need to write out a notification page
            $req->header_out('Content-Type' => 'text/html');
            # FIXME: make this work
            my $html;
            $html .= qq{No login page specified for this handler.\n};
            $req->print($html);

            return MP2 ? Apache::HTTP_UNAUTHORIZED() : Apache::Constants::HTTP_UNAUTHORIZED();
        }

        my $ref_url_var = $req->dir_config('generic_auth_ref_url_var');
        $ref_url_var = 'ref_url' if $ref_url_var eq '';
        my $cur_query = $req->args;
        my $uri = $req->uri;
        my $ref_url = $uri;
        $ref_url .= "?$cur_query" unless $cur_query eq '';
        $url = $self->_addParamsToUrl($url, { $ref_url_var => $ref_url });
        if ($url =~ m{^/}) {
            my $host_url = $self->_getSelfHostUrl($req);
            $url = "$host_url$url";
        }
        $req->header_out(Location => $url);

        # REDIRECT does not work properly in Apache 1 with Perl 5.6.0
        return MP2 ? Apache::OK() : Apache::Constants::OK();
    }

    sub getAuthFailedPage {
        my ($self, $req) = @_;

        my $url = $req->dir_config('generic_auth_failed_url');
        return $url;
    }

    sub _getSelfHostUrl {
        my ($self, $req) = @_;
        my $host = $req->hostname;
        my $scheme = $req->subprocess_env('HTTPS') eq 'on' ? 'https' : 'http';
        return "$scheme://$host";
    }

    sub getCipherKey {
        my ($self, $req) = @_;
        my $key;
        $key = $req->dir_config('generic_auth_cipher_key') if $req;
        $key = 'abcdefghijklmnopqrstuvwxyz012345' if $key eq '';

        return $key;
    }

    sub getCipherObj {
        my ($self, $req, $key) = @_;
        my $obj = $$self{_cipher_obj};
        return $obj if $obj;
        
        my $cipher = $self->getCipher($req);
        $key = $self->getCipherKey($req) if $key eq '';
        $obj = Crypt::CBC->new({ cipher => $cipher, key => $key });
        $$self{_cipher_obj} = $obj;
        return $obj;
    }

    sub getDigestObject {
        my ($self, $req, $key) = @_;
        my $obj = $$self{_digest_obj};
        return $obj if $obj;
        # $key = $self->getCipherKey($req) if $key eq '';

        # $obj = Digest::HMAC->new($key, 'Digest::HMAC_SHA1');
        $obj = Digest::SHA1->new;
        $$self{_digest_obj} = $obj;
        return $obj;
    }

    sub getCipher {
        my ($self, $req) = @_;
        return 'Crypt::Rijndael';
    }

    sub getCookies {
        my ($self, $req) = @_;
        my $headers = $req->headers_in;
        return $self->parseCookieData($$headers{Cookie});
    }

    sub parseCookieData {
        my ($self, $cookie_data) = @_;
        
        my $results = {};
        my(@pairs) = split("; ", $cookie_data);
        foreach my $key_value (@pairs) {
            my ($key, $value) = split("=", $key_value);
            $$results{$key} = $value;
        }
        return $results unless wantarray;
        return %$results;
    }

    # FIXME: add timestamp and HMAC
    sub encrypt {
        my ($self, $data, $req, $key) = @_;
        $key = $self->getCipherKey($req) if $key eq '';

        my $cipher_obj = $self->getCipherObj($req, $key);
        my $digest_obj = $self->getDigestObject($req, $key);

        my $serialized = $self->serialize($data);
        $digest_obj->add($serialized);
        my $digest = $digest_obj->b64digest;
        $$self{_digest_obj} = undef;

        my $str = time() . '|' . $digest . '|' . $serialized;
        my $crypted = $self->_encode($cipher_obj->encrypt($str));

        return $crypted;
    }

    sub decrypt {