File Coverage

blib/lib/Net/STOMP/Client/Auth.pm

Criterion	Covered	Total	%
statement	18	48	37.5
branch	1	32	3.1
condition	1	6	16.6
subroutine	6	8	75.0
pod			n/a
total	26	94	27.6

#+##############################################################################
#                                                                              #
# File: Net/STOMP/Client/Auth.pm                                               #
#                                                                              #
# Description: Authentication support for Net::STOMP::Client                   #
#                                                                              #
#-##############################################################################

#
# module definition
#

package Net::STOMP::Client::Auth;
use strict;
use warnings;
our $VERSION  = "2.4";
our $REVISION = sprintf("%d.%02d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/);

#
# used modules
#

use No::Worries::Die qw(dief);
use Params::Validate qw(validate_pos :types);

#
# Authen::Credential is optional
#

eval { require Authen::Credential };

#
# check a single authentication
#

sub _chkauth ($) {
    my($auth) = @_;

    return(Authen::Credential->parse($auth))
        if ref($auth) eq "";
    return($auth)
        if ref($auth) and $auth->isa("Authen::Credential");
    dief("unexpected authentication: %s", $auth);
}

#
# setup
#

sub _setup ($) {
    my($self) = @_;
    my(@list, $scheme, $sslopts);

    # no additional options if Authen::Credential is not available!
    return() unless $self or $Authen::Credential::VERSION;
    # additional options for new()
    return(
        "auth" => { optional => 1, type => SCALAR|ARRAYREF|OBJECT },
    ) unless $self;
    # check the given authentication
    return() unless $self->{"auth"};
    if (ref($self->{"auth"}) eq "ARRAY") {
        @list = map(_chkauth($_), @{ $self->{"auth"} });
    } else {
        @list = (_chkauth($self->{"auth"}));
    }
    # make sure we have at most one X.509 and one plain|none
    foreach my $auth (@list) {
        $auth->check();
        $scheme = $auth->scheme();
        if ($scheme eq "x509") {
            dief("duplicate authentication: %s", $auth->string())
                if exists($self->{"x509_auth"});
            $self->{"x509_auth"} = $auth;
        } elsif ($scheme eq "none") {
            dief("duplicate authentication: %s", $auth->string())
                if exists($self->{"plain_auth"});
            $self->{"plain_auth"} = ""; # special case...
        } elsif ($scheme eq "plain") {
            dief("duplicate authentication: %s", $auth->string())
                if exists($self->{"plain_auth"});
            $self->{"plain_auth"} = $auth;
        } else {
            dief("unsupported authentication scheme: %s", $scheme);
        }
    }
    # use the X.509 authentication via the socket options
    if ($self->{"x509_auth"}) {
        $sslopts = $self->{"x509_auth"}->prepare("IO::Socket::SSL");
        while (my($name, $value) = each(%{ $sslopts })) {
            $self->{"sockopts"}{$name} = $value;
        }
    }
}

#
# hook for the CONNECT frame
#

sub _connect_hook ($$) {
    my($self, $frame) = @_;

    return unless $self->{"plain_auth"};
    # do not override what the user did put in the frame
    $frame->header("login", $self->{"plain_auth"}->name())
        unless defined($frame->header("login"));
    $frame->header("passcode", $self->{"plain_auth"}->pass())
        unless defined($frame->header("passcode"));
}

#
# register the setup and hook
#

{
    no warnings qw(once);
    $Net::STOMP::Client::Setup{"auth"} = \&_setup;
    $Net::STOMP::Client::Hook{"CONNECT"}{"auth"} = \&_connect_hook;
}

1;

__END__