view release on metacpan or  search on metacpan

AuthTkt.pm  view on Meta::CPAN

}

# 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',
    );