File Coverage

blib/lib/CGI/Application/Plugin/WSSE.pm

Criterion	Covered	Total	%
statement	21	55	38.1
branch	0	14	0.0
condition			n/a
subroutine	7	10	70.0
pod	2	2	100.0
total	30	81	37.0

=head1 NAME

CGI::Application::Plugin::WSSE - Simple WSSE Authentication for CGI applications

=head1 SYNOPSIS

    use base 'CGI::Application';
    use CGI::Application::Plugin::WSSE;

    sub setup {
        ...

        $self->wsse_config(
            callback => sub {
                my ($self, $username) = @_;

                # get password associated with this username somehow

                return $password;
            },
            log      => $self->log,
        );
    }

    sub runmode {

        if ( ! $self->wsse_authenticate( ) ) {
            # authentication failed.
            return $self->error( title => 'Error', msg => 'Access denied!');
        }

        # authentication worked so do stuff.
   }

=head1 ABSTRACT

This plugin enables WSSE Username Token authentication in web applications
using the CGI::Application framework.

=cut

package CGI::Application::Plugin::WSSE;

use warnings;
use strict;
use base qw( Exporter );
use Carp qw( croak );
use Digest::SHA1 qw( sha1 );
use MIME::Base64 qw( encode_base64 decode_base64 );
use Params::Validate qw( validate SCALAR CODEREF OBJECT );

=head1 VERSION

This document describes CGI::Application::Plugin::WSSE Version 1.0

=cut

our $VERSION = '1.0';

=head1 DESCRIPTION

Use this module to implement WSSE Username Token authentication in your
CGI::Application based module.  This protocol is transported over HTTP headers
and is safe to send as clear text while still providing security against
password sniffing and replay attacks.

=head1 FUNCTIONS

The following functions are imported into your L subclass.

=cut

our @EXPORT = qw(  wsse_config wsse_authenticate );

=head2 wsse_config(%options)

This method is used to configure the way authentication is done.  It takes a
hash of parameters. The following parameters are valid:

=over 4

=item C

A code reference to a subroutine you provide in your app which sets the takes
two parameters, a reference to the calling object (your L
object, and a reference to a scalar containing a username.  The subroutine
should use the username to look up its associated password in some
application-defined way and return that password as a scalar or undef if the
password is not found. This parameter is mandatory.

=item C

A reference to an  object that supports C, and C methods.  If
you are using L, set this to C<$self-Elog>. If this
parameter is not specified, no logging will be done.

=back

=cut

sub wsse_config {
    my $self = shift;

    my %args = validate(
        @_,
        {
            callback => { type => CODEREF, },
            log      => {
                type     => OBJECT,
                can      => [qw/ debug error /],
                optional => 1,
            },
        }
    );

    $self->{WSSE_OPTS} = \%args;

    return;
}

=head2 wsse_authenticate()

Call this method to authenticate using the WSSE Username Token protocol.  It
will return true if authentication was successful or false if it fails.  In
the case of failure, a WWW-Authenticate HTTP header is added to the response
with the value C.  The HTTP status is also
set to an appropriate value.  See L.

=cut

sub wsse_authenticate {
    my ($self) = @_;

    if ( !exists $self->{WSSE_OPTS} ) {
        croak "Must call wsse_config first.\n";
    }

    my $req = $self->query->http('X-WSSE');
    if ( !$req ) {
        return _wsse_auth_failure( $self, '401',
            'X-WSSE authentication required' );
    }

    $req =~ s/^(?:WSSE|UsernameToken)[ ]//msx;
    my $auth;
    for my $i ( split /,\s*/msx, $req ) {
        my ( $k, $v ) = split /=/msx, $i, 2;
        $v =~ s/^"//msx;
        $v =~ s/"$//msx;
        $auth->{$k} = $v;
    }

    for my $f (qw( Username PasswordDigest Nonce Created )) {
        if ( !defined $auth->{$f} ) {
            return _wsse_auth_failure( $self, '400', "X-WSSE requires $f" );
        }
    }

    my $password = $self->{WSSE_OPTS}->{callback}->( $self, $auth->{Username} );
    if ( !defined $password ) {
        return _wsse_auth_failure( $self, '403', 'Invalid login' );
    }

    my $expected = encode_base64(
        sha1( decode_base64( $auth->{Nonce} ) . $auth->{Created} . $password ),
        q{}
    );
    if ( $expected ne $auth->{PasswordDigest} ) {
        return _wsse_auth_failure( $self, '403', 'Invalid login' );
    }

    if ( exists $self->{WSSE_OPTS}->{log} ) {
        $self->{WSSE_OPTS}->{log}->debug(
            'Successfully authenticated user ' . $auth->{Username} . q{.} );
    }

    return 1;
}

sub _wsse_auth_failure {
    my ( $self, $code, $msg ) = @_;

    if ( exists $self->{WSSE_OPTS}->{log} ) {
        $self->{WSSE_OPTS}->{log}->error("$msg");
    }
    $self->header_add(
        -WWW_Authenticate => 'WSSE profile="UsernameToken"',
        -Status           => "$code $msg",
    );

    return;
}

=head1 DIAGNOSTICS

During the authentication process, errors can occur in certain circumstances.
If an error occurs the HTTP status is set to one of the following values.

=over 4

=item 400 X-WSSE requires $part

The X-WSSE HTTP header consists of four values, Username, PasswordDigest,
Nonce, and Created.  If one or more of these are missing, the header is
malformed and this error is returned.  (C<$part> is the first missing part
encountered.)

=item 401 X-WSSE authentication required

This error is returned if the client request does not contain an X-WSSE HTTP
header.  Often the client will not send X-WSSE initially but but will retry
with the correct header in response to a 401 status like this.

=item 403 Invalid login

This error is returned if either the username or password sent by the client
are invalid or missing.

=back

=head1 BUGS AND LIMITATIONS

There are no known problems with this module.

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SEE ALSO

L

=head1 THANKS

Some code lifted from L and L

=head1 AUTHOR

Jaldhar H. Vyas, C<<  >>

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2011, Consoliated Braincells Inc. All rights reserved.

This distribution is free software; you can redistribute it and/or modify it
under the terms of either:

a) the GNU General Public License as published by the Free Software
Foundation; either version 2, or (at your option) any later version, or

b) the Artistic License version 2.0.

The full text of the license can be found in the LICENSE file included
with this distribution.

=cut

1;    # CGI::Application::Plugin::WSSE

__END__