#+##############################################################################
#                                                                              #
# File: Authen/Credential.pm                                                   #
#                                                                              #
# Description: abstraction of a credential                                     #
#                                                                              #
#-##############################################################################

#
# module definition
#

package Authen::Credential;
use strict;
use warnings;
our $VERSION  = "0.6";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);

#
# export control
#

use Exporter;
our(@ISA, @EXPORT, @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(_fatal _require _check);

#
# used modules
#

use Params::Validate qw(validate_with validate_pos :types);
use URI::Escape qw(uri_escape uri_unescape);

#
# global variables
#

our(
    $_IdRe,		 # regexp matching an identifier
    $_ValChars,		 # set of all allowed value characters
    $_SepChars,		 # set of all allowed separator characters
    %_LoadedModule,	 # hash of successfully loaded modules
    %_ValidationSpec,	 # per-scheme Params::Validate specification
    %_Preparator,	 # per-scheme and target preparator code
);

$_IdRe = qr{[a-z][a-z0-9]*};
$_ValChars = q{a-zA-Z0-9/\-\+\_\~\.\:};
$_SepChars = q{\,\ };

#+++############################################################################
#                                                                              #
# helper functions                                                             #
#                                                                              #
#---############################################################################

#
# report a fatal error with a sprintf() API
#

sub _fatal ($@) {
    my($message, @arguments) = @_;

    $message = sprintf($message, @arguments) if @arguments;
    $message =~ s/\s+$//;
    die(caller() . ": $message\n");
}

#
# make sure a module is loaded
#

sub _require ($) {
    my($module) = @_;

    return if $_LoadedModule{$module};
    eval("require $module");
    if ($@) {
	$@ =~ s/\s+at\s.+?\sline\s+\d+\.?$//;
	_fatal("failed to load %s: %s", $module, $@);
    } else {
	$_LoadedModule{$module} = 1;
    }
}

#
# check that the data matches the per-scheme specification
#

sub _check ($@) {
    my($scheme);

    $scheme = shift(@_);
    _fatal("invalid credential scheme (missing validation spec): %s", $scheme)
	unless $_ValidationSpec{$scheme};
    return(validate_with(
	params => \@_,
	spec => {
	    %{ $_ValidationSpec{$scheme} },
	    scheme => { type => SCALAR, regex => qr/^\Q$scheme\E$/, default => $scheme },
	},
	stack_skip => 2,
    ));
}

#+++############################################################################
#                                                                              #
# object oriented interface                                                    #
#                                                                              #
#---############################################################################

#
# constructors
#

sub new : method {
    my($class, %option, $cc, $scheme);

    $class = shift(@_);
    if ($class eq __PACKAGE__) {
	# toplevel constructor
	%option = validate_with(
	    params => \@_,
	    spec => {
		scheme => {
		    type    => SCALAR,
		    regex   => $_IdRe,
		    default => "none",
		},
	    },
	    allow_extra => 1,
	);
	$cc = $class . "::" . $option{scheme};
	_require($cc);
	return($cc->new(\%option));
    }
    # inherited constructor
    $scheme = substr($class, length(__PACKAGE__) + 2);
    return(bless({ _check($scheme, @_) }, $class));
}

sub parse : method {
    my($class, $string, @list, %option);

    $class = shift(@_);
    validate_pos(@_, { type => SCALAR })
	unless @_ == 1 and defined($_[0]) and ref($_[0]) eq "";
    $string = shift(@_);
    return($class->new()) if $string eq "";
    _fatal("invalid credential string: %s", $string)
	unless $string =~ /^[${_ValChars}${_SepChars}\%\=]+$/o;
    @list = split(/[${_SepChars}]+/o, $string);
    _fatal("invalid credential string: %s", $string)
	unless @list and $list[0] =~ /^($_IdRe)$/o;
    %option = (scheme => shift(@list));
    foreach $string (@list) {
	_fatal("invalid credential key=value: %s", $string)
	    unless $string =~ /^($_IdRe)\=([$_ValChars\%]*)$/o;
	_fatal("duplicate credential key: %s", $1)
	    if exists($option{$1});
	$option{$1} = uri_unescape($2);
    }
    return($class->new(\%option));
}

#
# transformers
#

sub hash : method {
    my($self);

    $self = shift(@_);
    validate_pos(@_) if @_;
    return($self) unless wantarray();
    return(%$self);
}

sub string : method {
    my($self, @parts, $key);

    $self = shift(@_);
    validate_pos(@_) if @_;
    _fatal("invalid credential: no scheme") unless $self->{scheme};
    @parts = ($self->{scheme});
    foreach $key (sort(keys(%$self))) {
	next if $key eq "scheme";
	push(@parts, $key . "=" . uri_escape($self->{$key}, "^$_ValChars"));
    }
    return(join(" ", @parts));
}

#
# accessors
#

foreach my $name (qw(scheme)) {
    no strict "refs";
    *$name = sub {
	my($self);
	$self = shift(@_);
	validate_pos(@_) if @_;
	return($self->{$name});
    };
}

#
# generic check method using the Params::Validate specification
#

sub check : method {
    my($self);

    $self = shift(@_);
    validate_pos(@_) if @_;
    return(_check($self->scheme(), $self));
}

#
# generic prepare method using the declared preparators
#

sub prepare : method {
    my($self, $target, $preparator);

    $self = shift(@_);
    validate_pos(@_, { type => SCALAR })
	unless @_ == 1 and defined($_[0]) and ref($_[0]) eq "";
    $target = shift(@_);
    $preparator = $_Preparator{$self->scheme()}{$target};
    return($preparator->($self)) if $preparator;
    _fatal("invalid %s credential preparation target: %s", $self->scheme(), $target);
}

1;

__DATA__

=head1 NAME

Authen::Credential - abstraction of a credential

=head1 SYNOPSIS

  use Authen::Credential;
  use Authen::Credential::plain;
  use Getopt::Long qw(GetOptions);
  use Config::General qw(ParseConfig);
  use HTTP::Request;

  # creation
  $cred = Authen::Credential->new(
      scheme => "plain",
      name   => "system",
      pass   => "manager",
  );
  # idem directly using the sub-class
  $cred = Authen::Credential::plain->new(
      name   => "system",
      pass   => "manager",
  );

  # get credential from command line option
  GetOptions(\%Option,
      "auth=s",
      ...
  );
  $cred = Authen::Credential->parse($Option{auth});

  # get credential from configuration file
  %Option = ParseConfig(-ConfigFile => "...");
  $cred = Authen::Credential->new($Option{auth});

  # access the credential attributes
  if ($cred->scheme() eq "plain") {
      printf("user name is %s\n", $cred->name());
  }

  # use the prepare() method to get ready-to-use data
  $req = HTTP::Request->new(GET => $url);
  $req->header(Authorization => $cred->prepare("HTTP.Basic"));

=head1 DESCRIPTION

This module offers abstractions of credentials, i.e. something that
can be used to authenticate. It allows the creation and manipulation of
credentials. In particular, it defines a standard string representation
(so that credentials can be given to external programs as command line
options), a standard structured representation (so that credentials can
be stored in structured configuration files or using JSON) and
"preparators" that can transform credentials into ready-to-use data for
well known targets.

Different authentication schemes (aka credential types) are supported.
This package currently supports C<none>, C<plain> and C<x509> but others
can be added by providing the supporting code in a separate module.

A Python implementation of the same credential abstractions is available
at http://pypi.python.org/pypi/auth.credential so credentials can be
shared between different programming languages.

For a given scheme, a credential is represented by an object with a
fixed set of string attributes. For instance, the C<plain> scheme has
two attributes: C<name> and C<pass>. More information is provided by
the scheme specific module, for instance L<Authen::Credential::plain>.

=head1 STRING REPRESENTATION

The string representation of a credential is made of its scheme
followed by its attributes as key=value pairs, seperated by space.

For instance, for the C<none> scheme with no attributes:

  none

And the the C<plain> scheme with a name and password:

  plain name=system pass=manager

If needed, the characters can be URI-escaped, see L<URI::Escape>. All
non-alphanumerical characters should be escaped to avoid parsing
ambiguities.

The string representation is useful to give a program through its
command line options. For instance:

  myprog --uri http://foo:80 --auth "plain name=system pass=manager"

=head1 STRUCTURED REPRESENTATION

The structured representation of a credential is made of its scheme
and all its attributes as a string table.

Here is for instance how it could end up using JSON:

  {"scheme":"plain","name":"system","pass":"manager"}

The same information could be stored in a configuration file. Here is
an example using the Apache syntax, which is for instance supported by
L<Config::General>:

  <auth>
    scheme = plain
    name   = system
    pass   = manager
  </auth>

=head1 METHODS

This module supports the following methods:

=over

=item new([OPTIONS])

return a new credential object (class method); the OPTIONS are its
attributes

=item parse(STRING)

return a new credential object from its string representation (class
method)

=item hash()

return its structured representation as a reference to a hash

=item string()

return its string representation

=item check()

check that the credential contains the expected attributes

=item prepare(TARGET)

use the credential to prepare data for a given target (this is scheme
specific)

=item scheme()

return the authentication scheme of the credential

=back

In addition, the attributes can be accessed using eponymous methods.
See the example in the L</"SYNOPSIS"> section.

=head1 SEE ALSO

L<Authen::Credential::none>,
L<Authen::Credential::plain>,
L<Authen::Credential::x509>,
L<URI::Escape>,

=head1 AUTHOR

Lionel Cons L<http://cern.ch/lionel.cons>

Copyright CERN 2011-2012
