view release on metacpan or  search on metacpan

AuthTkt.pm  view on Meta::CPAN

    my $self = shift;

    die "Invalid digest_type '" . $self->digest_type . "'\n"
        unless $DIGEST_TYPE{ $self->digest_type };

    my ($module, $func) = @{ $DIGEST_TYPE{ $self->digest_type } };
    eval "require $module";
    return eval "\\&${module}::$func";
}

sub _get_digest
{
    my ($self, $ts, $ip_addr, $uid, $tokens, $data, $debug) = @_;
    my @ip = split /\./, $ip_addr;
    my @ts = ( (($ts & 0xff000000) >> 24),
               (($ts & 0xff0000) >> 16),
               (($ts & 0xff00) >> 8),
               (($ts & 0xff)) );
    my $ipts = pack("C8", @ip, @ts);
    my $raw = $ipts . $self->secret . $uid . "\0" . $tokens . "\0" . $data;
    my $digest_function = $self->_get_digest_function;
    my $digest0 = $digest_function->($raw);
    my $digest  = $digest_function->($digest0 . $self->secret);

    if ($debug) {
        print STDERR "ts: $ts\nip_addr: $ip_addr\nuid: $uid\ntokens: $tokens\ndata: $data\n";
        print STDERR "secret: " . $self->secret . "\n";
        print STDERR "raw: '$raw'\n";
        my $len = length($raw);
        print STDERR "digest0: $digest0 (input length $len)\n";
        print STDERR "digest: $digest\n";
    }

    return $digest;
}

# Return a cookie containing a mod_auth_tkt ticket 
sub cookie
{
    my $self = shift;
    my %DEFAULTS = (
        cookie_name => 'auth_tkt',
        cookie_path => '/',
    );
    my %arg = ( %DEFAULTS, %$self, @_ );
    $arg{cookie_domain} ||= $self->domain;

    # Get ticket, forcing base64 for cookies
    my $ticket = $self->ticket(@_, base64 => 1) or return;

    my $cookie_fmt = "%s=%s%s%s%s";
    my $path_elt = "; path=$arg{cookie_path}";
    my $domain_elt = $arg{cookie_domain} ? "; domain=$arg{cookie_domain}" : '';
    my $secure_elt = $arg{cookie_secure} ? "; secure" : '';
    return sprintf $cookie_fmt, 
           $arg{cookie_name}, $ticket, $domain_elt, $path_elt, $secure_elt;
}

# Returns a hashref representing the original ticket components
# Returns undef if there were any errors
sub validate_ticket
{
    my $self = shift;
    my $ticket = shift || croak "No ticket passed to validate_ticket";
    my %arg = ( %$self, @_ );

    $arg{ip_addr} = $arg{ignore_ip} ? '0.0.0.0' : $ENV{REMOTE_ADDR}
        unless exists $arg{ip_addr};
    # 0 or undef ip_addr treated as 0.0.0.0
    $arg{ip_addr} ||= '0.0.0.0';

    # Parse ticket
    my $info = $self->parse_ticket($ticket);

    # Validate digest
    my $expected_digest = $self->_get_digest(
        $info->{ts}, $arg{ip_addr}, $info->{uid},
        $info->{tokens}, $info->{data});

    return $info if $expected_digest eq $info->{digest};
    return undef;
}

sub parse_ticket
{
    my $self    = shift;
    my $ticket  = shift or croak "No ticket passed to parse_ticket";
    my $parts   = {};

    # Strip possible quotes
    $ticket =~ s,^"|"$,,g;

    return if length($ticket) < 40;

    # Assume $ticket is not URL-escaped but may be base64-escaped
    my $raw = $ticket =~ m/!/ ? $ticket : decode_base64($ticket);

    # If $raw still doesn't have ! then it is bogus
    return if $raw !~ m/!/;
    
    # Deconstruct
    my ($digest,$ts,$uid,$extra) = ($raw =~ m/^(.{32})(.{8})(.+?)!(.*)$/);
    $parts->{digest} = $digest;
    $parts->{ts}  = hex($ts);
    $parts->{uid} = $uid;
    $parts->{tokens} = '';
    $parts->{data} = '';

    # Tokens and data if present
    if (defined $extra) {
        if ($extra =~ m/!/) {
            ($parts->{tokens},$parts->{data}) = split m/!/, $extra, 2;
        }
        else {
            $parts->{data} = $extra;
        }
    }
    return $parts;
}

# Alias for compatibility with Jose/Ton's original patch
*valid_ticket = \&validate_ticket;

1;

__END__

=head1 NAME

Apache::AuthTkt - module to generate authentication tickets for 
mod_auth_tkt apache module.


=head1 SYNOPSIS

    # Constructor - either (preferred):
    $at = Apache::AuthTkt->new(
        conf => '/etc/httpd/conf.d/auth_tkt.conf',
    );
    # OR:
    $at = Apache::AuthTkt->new(
        secret => '818f9c9d-91ed-4b74-9f48-ff99cfe00a0e',
        digest_type => 'MD5',
    );

    # Generate ticket
    $ticket = $at->ticket(uid => $username, ip_addr => $ip_addr);

    # Or generate cookie containing ticket
    $cookie = $at->cookie(
        uid => $username, 
        cookie_name => 'auth_tkt',
        cookie_domain => 'www.openfusion.com.au',
    );

    # Access the shared secret
    $secret = $at->secret();
    # If using the 'conf' constructor above, all other TKTAuth attributes 
    #   are also available e.g.:
    print $at->cookie_name(), $at->ignore_ip(), $at->request_ssl();

    # Report error string
    print $at->errstr;


=head1 INTRODUCTION

Apache::AuthTkt is a module for generating and validating 
authentication tickets used with the 'mod_auth_tkt' apache module. 
Tickets are typically generated by a login web page of some kind 
when a user has been authenticated. The ticket contains a username/uid 
for the authenticated user, and often also the IP address they 
authenticated from, a set of authorisation tokens, and any other user 
data required. The ticket also includes an MD5 hash of all the included 
user data plus a shared secret, so that tickets can be validated by 
mod_auth_tkt without requiring access to the user repository.

See http://www.openfusion.com.au/labs/mod_auth_tkt for mod_auth_tkt
itself.


=head1 DESCRIPTION

=head2 CONSTRUCTOR

An Apache::AuthTkt object is created via a standard constructor
with named arguments. The preferred form is to point the constructor
to the apache config file containing the mod_auth_tkt TKTAuthSecret
directive, from which Apache::AuthTkt will parse the shared secret
it needs, as well as any additional TKTAuth* directives it finds:

    $at = Apache::Tkt->new(
        conf => '/etc/httpd/conf/auth_tkt.conf',
    );

Alternatively, you can pass the mod_auth_tkt shared secret (the 
TKTAuthSecret value) and the digest_type to use (default is 'MD5')
explicitly to the constructor:

    $at = Apache::AuthTkt->new(
        secret => '818f9c9d-91ed-4b74-9f48-ff99cfe00a0e',
        digest_type => 'SHA256',
    );

=head2 ACCESSORS

If the 'conf' form of the constructor is used, Apache::AuthTkt parses
all additional TKTAuth* directives it finds there and stores them in
additional internal attributes. Those values are available via 
accessors named after the relevant TKTAuth directive (with the 'TKTAuth'
prefix dropped and converted to lowercase underscore format) i.e.

    $at->secret()
    $at->secret_old()
    $at->digest_type()
    $at->cookie_name()
    $at->back_cookie_name()
    $at->back_arg_name()
    $at->domain()
    $at->cookie_expires()
    $at->login_url()
    $at->timeout_url()
    $at->unauth_url()
    $at->timeout()
    $at->timeout_refresh()
    $at->token ()
    $at->guest_login()
    $at->ignore_ip()
    $at->require_ssl()


=head2 TICKET GENERATION

Tickets are generated using the ticket() method with named parameters:

AuthTkt.pm  view on Meta::CPAN

IP address associated with this ticket. Default: if $at->ignore_ip
is true, then '0.0.0.0', otherwise $ENV{REMOTE_ADDR};

=item tokens

A comma-separated list of tokens associated with this user. Typically
only used if you are using the mod_auth_tkt TKTAuthToken directive.
Default: none.

=item data

Arbitrary user data to be stored for this ticket. This data is included
in the MD5 hash check. Default: none.

=item base64

Flag used to indicate whether to base64-encode the ticket. Default: 1.

=item ts

Explicitly set the timestamp to use for this ticket. Only for testing!

=back


As an alternative to ticket(), the cookie() method can be used to 
return the generated ticket in cookie format. cookie() returns undef 
on error, with error information available via the errstr() method:

    $cookie = $at->cookie or die $at->errstr;

cookie() supports all the same arguments as ticket(), plus the 
following:

=over 4

=item cookie_name

Cookie name. Should match the TKTAuthCookieName directive, if you're
using it. Default: $at->cookie_name, or 'auth_tkt'.

=item cookie_domain

Cookie domain. Should match the TKTAuthDomain directive, if you're
using it. Default: $at->domain.

=item cookie_path

Cookie path. Default: '/'.

=item cookie_secure

Flag whether to set the 'secure' cookie flag, so that the cookie is 
returned only in HTTPS contexts. Default: $at->require_ssl, or 0.

=back

=head2 TICKET PARSING AND VALIDATION

You may parse and validate existing tickets with the validate_ticket() 
method. It takes as its first parameter the ticket to be validated, and
then an optional list of named parameter overrides 
(e.g. ip_addr => 'x.x.x.x'). If the ticket is valid, validate_ticket 
returns a hashref with the following key/value pairs:

=over 4

=item digest

=item ts

=item uid

=item tokens

=item data

=back

validate_ticket() will return undef if any errors with the ticket value 
are encountered.

The validate_ticket() method algorithm is analogous to the function with
the same name in the mod_auth_tkt C module.

There is also a parse_ticket() method available that parses the ticket
without running it through the validation phase, and returns the same
data as validate_ticket(). This is only safe to use where you are certain
that the ticket has been validated elsewhere. In general it's considerably
safer to just use validate_ticket.


=head2 DIGEST TYPES

As of version 2.1.0, mod_auth_tkt supports multiple digest types. The
following digest_types are currently supported:

=over 4

=item MD5

The current default, for backwards compatibility. Requires the Digest::MD5
perl module.

=item SHA256

Requires the Digest::SHA perl module.

=back

These can be set either via your config (the TKTAuthDigestType directive)
or by passing a 'digest_type' parameter to the AuthTkt constructor.


=head1 AUTHOR

Gavin Carr <gavin@openfusion.com.au>

Contributors:

Peter Karman <peter@peknet.com>

Ton Voon <ton.voon@altinity.com>

Jose Luis Martinez <jlmartinez@capside.com>

=head1 COPYRIGHT

Copyright 2001-2009 Gavin Carr and contributors.

This program is free software. You may copy or redistribute it under the
same terms as perl itself.

=cut


# vim:sw=4