File Coverage

blib/lib/Authen/PAAS/Subject.pm

Criterion	Covered	Total	%
statement	72	72	100.0
branch	14	16	87.5
condition	1	3	33.3
subroutine	13	13	100.0
pod	11	11	100.0
total	111	115	96.5

# -*- perl -*-
#
# Authen::PAAS::Subject by Daniel Berrange
#
# Copyright (C) 2004-2006 Dan Berrange
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# $Id: Subject.pm,v 1.5 2005/08/21 10:57:06 dan Exp $

=pod

=head1 NAME

Authen::PAAS::Subject - represents an authenticated party

=head1 SYNOPSIS

  use Authen::PAAS::Subject;

  ####### Creating a populating a subject..

  # Create a new anonymous subject with no credentials
  my $subject = Authen::PAAS::Subject->new();

  # Add a principal eg a UNIX username, or a Kerberos
  # principal, or some such
  my $prin = SomePrincipal->new();
  $subject->add_principal($prin)

  # Add a credential. eg some form of magic token
  # representing a previously added principal
  my $cred = SomeCredential->new($principal)
  $subject->add_credential($cred);


  ######## Fetching and querying a subject

  # Create a context module for performing auth
  my $context = Context->new($config, "myapp");

  # Attempt to login
  my $subject = $context->login($callbacks);

  if ($subject) {
      # Retrieve set of all principals
      my @princs = $subject->principals;

      # Or only get principal of particular class
      my $princ = $subject->principal("SomePrincipal");

      # Retrieve set of all credentials
      my @cred = $subject->credentials;

      # Or only get credential of particular class
      my $cred = $subject->credential("SomeCredential");
  } else {
      die "login failed";
  }

=head1 DESCRIPTION

The C module provides a representation
of an authenticated party, be they a human user, or a independantly
operating computing service. An authenticated subject will have
one of more principals associated with them, which can be thought
of as their set of C. These are represented by the
L module. Some authentication mechanisms
will also associate some form of security related token with a
subject, thus an authenticated subject may also have zero or more
credentials. These are represented by the L
module.

An authenticated subject is typically obtained via the C
method on the L module. This creates an
anonymous subject, and invokes a set of login modules
(L), which in turn populate the
subject with principals and credentials.

=head1 METHODS

=over 4

=cut

package Authen::PAAS::Subject;


use strict;
use warnings;

our $VERSION = '1.0.0';


=item my $subject = Authen::PAAS::Subject->new();

Create a new subject, with no initial principals
or credentials.

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    my %params = @_;

    $self->{principals} = {};
    $self->{credentials} = {};

    bless $self, $class;

    return $self;
}


=item $subject->add_principal($owner, $principal)

Adds a principal to the subject. The C<$owner> parameter
should be the class name of the login module owning the
principal. The principal parameter must be a subclass of
the L class.

=cut

sub add_principal {
    my $self = shift;
    my $owner = shift;
    my $principal = shift;

    my $type = ref($principal);
    $self->{principals}->{$owner} = {} unless exists $self->{principals}->{$owner};
    $self->{principals}->{$owner}->{$type} = $principal;
}


=item $subject->remove_principal($owner[, $type]);

Removes a previously added principal from the subject. The
C<$id> parameter is the index of the principal previously
added via the C method.

=cut

sub remove_principal {
    my $self = shift;
    my $owner = shift;
    my $type = shift;

    return  unless exists $self->{principals}->{$owner};
    if ($type) {
	delete $self->{principals}->{$owner}->{$type};
    } else {
	delete $self->{principals}->{$owner};
    }
}


=item my @principals = $subject->principals_by_owner($owner);

Retrieves a list of all the principals for the subject associated
with the owner specified in the C<$owner> parameter. The
value of the C<$owner> parameter is the class name of a login
module

=cut

sub principals_by_owner {
    my $self = shift;

    my $owner = shift;
    return () unless exists $self->{principals}->{$owner};
    return values %{$self->{principals}->{$owner}};
}

=item my @principals = $subject->principals_by_type($type);

Retrieves the first matching principal of a given type. The
C<$type> parameter should be the Perl module name of the
principal implementation.

=cut

sub principals_by_type {
    my $self = shift;
    my $type = shift;

    return grep { $_->isa($type) } $self->principals;
}

=item my @principals = $subject->principals;

Retrieves a list of all the principals for the subject.

=cut

sub principals {
    my $self = shift;

    my @principals;
    foreach my $owner (keys %{$self->{principals}}) {
	push @principals, values %{$self->{principals}->{$owner}};
    }
    return @principals;
}


=item $subject->add_credential($owner, $credential)

Adds a credential to the subject. The C<$owner> parameter
should be the class name of the login module owning the
credential. The credential parameter must be a subclass of
the L class.

=cut

sub add_credential {
    my $self = shift;
    my $owner = shift;
    my $credential = shift;

    my $type = ref($credential);
    $self->{credentials}->{$owner} = {} unless exists $self->{credentials}->{$owner};
    $self->{credentials}->{$owner}->{$type} = $credential;
}

=item $subject->remove_credential($owner[, $type]);

Removes a previously added credential from the subject. The
C<$id> parameter is the index of the credential previously
added via the C method.

=cut

sub remove_credential {
    my $self = shift;
    my $owner = shift;
    my $type = shift;

    return  unless exists $self->{credentials}->{$owner};
    if ($type) {
	delete $self->{credentials}->{$owner}->{$type};
    } else {
	delete $self->{credentials}->{$owner};
    }
}

=item my @credentials = $subject->credentials_by_owner($owner);

Retrieves a list of all the credentials for the subject associated
with the owner specified in the C<$owner> parameter. The
value of the C<$owner> parameter is the class name of a login
module

=cut

sub credentials_by_owner {
    my $self = shift;

    my $owner = shift;
    return () unless exists $self->{credentials}->{$owner};
    return values %{$self->{credentials}->{$owner}};
}

=item my @credentials = $subject->credentials_by_type($type);

Retrieves the first matching credential of a given type. The
C<$type> parameter should be the Perl module name of the
credential implementation.

=cut

sub credentials_by_type {
    my $self = shift;
    my $type = shift;

    return grep { $_->isa($type) } $self->credentials;
}

=item my @credentials = $subject->credentials;

Retrieves a list of all the credentials for the subject.

=cut

sub credentials {
    my $self = shift;

    my @credentials;
    foreach my $owner (keys %{$self->{credentials}}) {
	push @credentials, values %{$self->{credentials}->{$owner}};
    }
    return @credentials;
}

1 # So that the require or use succeeds.

__END__