File Coverage

blib/lib/Net/SSH/Perl/Auth.pm

Criterion	Covered	Total	%
statement	15	54	27.7
branch	0	14	0.0
condition	0	3	0.0
subroutine	5	14	35.7
pod	6	8	75.0
total	26	93	27.9

package Net::SSH::Perl::Auth;

use strict;
use warnings;
use Carp qw( croak );

use vars qw( %AUTH %AUTH_REVERSE @AUTH_ORDER %SUPPORTED );
BEGIN {
    %AUTH = (
        Rhosts       => 1,
        RSA          => 2,
        Password     => 3,
        Rhosts_RSA   => 4,
        ChallengeResponse => 5,
        Kerberos     => 6,
        Kerberos_TGT => 7,
    );
    %AUTH_REVERSE = reverse %AUTH;

    @AUTH_ORDER = qw( 7 6 1 4 2 5 3 );
}

sub _determine_supported {
    for my $auth (keys %AUTH) {
        my $pack = sprintf "%s::%s", __PACKAGE__, $auth;
        eval "use $pack";
        $SUPPORTED{$AUTH{$auth}}++ unless $@;
    }
}

sub new {
    my $class = shift;
    my $type = shift;
    my $auth_class = join '::', __PACKAGE__, $type;
    (my $lib = $auth_class . ".pm") =~ s!::!/!g;
    require $lib;
    $auth_class->new(@_);
}

## For SSH2: mgr is Net::SSH::Perl::AuthMgr object.
sub mgr {
    my $auth = shift;
    $auth->{mgr} = shift if @_;
    $auth->{mgr};
}

sub id {
    my $this = shift;
    my $type;
    if (my $class = ref $this) {
        my $pack = __PACKAGE__;
        ($type = $class) =~ s/^${pack}:://;
    }
    else {
        $type = $this;
    }
    $AUTH{$type};
}

sub name {
    my $this = shift;
    my $name;
    if (my $class = ref $this) {
        my $pack = __PACKAGE__;
        ($name = $class) =~ s/^${pack}:://;
    }
    else {
        $name = $AUTH_REVERSE{$this};
    }
    $name;
}

sub mask {
    my $mask = 0;
    $mask |= (1<<$_) for keys %SUPPORTED;
    $mask;
}

sub supported {
    unless (keys %SUPPORTED) {
        _determine_supported();
    }
    return [ keys %SUPPORTED ] unless @_;
    my $id = shift;
    return $id == 0 || exists $SUPPORTED{$id} unless @_;
    my $ssupp = shift;
    mask() & $ssupp & (1 << $id);
}

sub auth_order { \@AUTH_ORDER }

sub authenticate { 0 }

1;
__END__