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


line stmt bran cond sub pod time code
1             package Net::SSH::Perl::Auth;
2              
3 1     1   7 use strict;
  1         2  
  1         27  
4 1     1   4 use warnings;
  1         2  
  1         28  
5 1     1   4 use Carp qw( croak );
  1         2  
  1         65  
6              
7 1     1   5 use vars qw( %AUTH %AUTH_REVERSE @AUTH_ORDER %SUPPORTED );
  1         2  
  1         120  
8             BEGIN {
9 1     1   7 %AUTH = (
10             Rhosts => 1,
11             RSA => 2,
12             Password => 3,
13             Rhosts_RSA => 4,
14             ChallengeResponse => 5,
15             Kerberos => 6,
16             Kerberos_TGT => 7,
17             );
18 1         6 %AUTH_REVERSE = reverse %AUTH;
19              
20 1         576 @AUTH_ORDER = qw( 7 6 1 4 2 5 3 );
21             }
22              
23             sub _determine_supported {
24 0     0     for my $auth (keys %AUTH) {
25 0           my $pack = sprintf "%s::%s", __PACKAGE__, $auth;
26 0           eval "use $pack";
27 0 0         $SUPPORTED{$AUTH{$auth}}++ unless $@;
28             }
29             }
30              
31             sub new {
32 0     0 1   my $class = shift;
33 0           my $type = shift;
34 0           my $auth_class = join '::', __PACKAGE__, $type;
35 0           (my $lib = $auth_class . ".pm") =~ s!::!/!g;
36 0           require $lib;
37 0           $auth_class->new(@_);
38             }
39              
40             ## For SSH2: mgr is Net::SSH::Perl::AuthMgr object.
41             sub mgr {
42 0     0 0   my $auth = shift;
43 0 0         $auth->{mgr} = shift if @_;
44 0           $auth->{mgr};
45             }
46              
47             sub id {
48 0     0 1   my $this = shift;
49 0           my $type;
50 0 0         if (my $class = ref $this) {
51 0           my $pack = __PACKAGE__;
52 0           ($type = $class) =~ s/^${pack}:://;
53             }
54             else {
55 0           $type = $this;
56             }
57 0           $AUTH{$type};
58             }
59              
60             sub name {
61 0     0 1   my $this = shift;
62 0           my $name;
63 0 0         if (my $class = ref $this) {
64 0           my $pack = __PACKAGE__;
65 0           ($name = $class) =~ s/^${pack}:://;
66             }
67             else {
68 0           $name = $AUTH_REVERSE{$this};
69             }
70 0           $name;
71             }
72              
73             sub mask {
74 0     0 0   my $mask = 0;
75 0           $mask |= (1<<$_) for keys %SUPPORTED;
76 0           $mask;
77             }
78              
79             sub supported {
80 0 0   0 1   unless (keys %SUPPORTED) {
81 0           _determine_supported();
82             }
83 0 0         return [ keys %SUPPORTED ] unless @_;
84 0           my $id = shift;
85 0 0 0       return $id == 0 || exists $SUPPORTED{$id} unless @_;
86 0           my $ssupp = shift;
87 0           mask() & $ssupp & (1 << $id);
88             }
89              
90 0     0 1   sub auth_order { \@AUTH_ORDER }
91              
92 0     0 1   sub authenticate { 0 }
93              
94             1;
95             __END__