File Coverage

blib/lib/Net/Dropbear/SSHd.pm
Criterion Covered Total %
statement 45 60 75.0
branch 3 10 30.0
condition 1 3 33.3
subroutine 14 16 87.5
pod 4 5 80.0
total 67 94 71.2


line stmt bran cond sub pod time code
1             package Net::Dropbear::SSHd;
2              
3 10     10   453657 use strict;
  10         22  
  10         249  
4 10     10   116 use v5.8;
  10         32  
5             our $VERSION = '0.04';
6              
7 10     10   6947 use Child;
  10         55708  
  10         383  
8              
9 10     10   13375 use autodie;
  10         175829  
  10         52  
10 10     10   63500 use Carp;
  10         30  
  10         696  
11 10     10   9209 use Moo;
  10         151284  
  10         63  
12 10     10   27374 use Types::Standard qw/ArrayRef HashRef GlobRef Str Int Bool InstanceOf/;
  10         708733  
  10         118  
13              
14             has addrs => (
15             is => 'rw',
16             isa => ArrayRef[Str],
17             coerce => sub { ref $_[0] ? $_[0] : [ $_[0] ] },
18             );
19              
20             has keys => (
21             is => 'rw',
22             isa => ArrayRef[Str],
23             coerce => sub {
24             my $value = shift;
25             $value = ref $value ? $value : [ $value ];
26             foreach my $key ( @$value )
27             {
28             carp "Key file does not exist: $key"
29             if !-e $key;
30             }
31             return $value;
32             },
33             );
34              
35             has hooks => (
36             is => 'ro',
37             isa => HashRef,
38             default => sub { {} },
39             );
40              
41             has debug => ( is => "rw", isa => Bool, default => 0, );
42             has forkbg => ( is => "rw", isa => Bool, default => 0, );
43             has usingsyslog => ( is => "rw", isa => Bool, default => 0, );
44             has inetdmode => ( is => "rw", isa => Bool, default => 0, );
45             has norootlogin => ( is => "rw", isa => Bool, default => 1, );
46             has noauthpass => ( is => "rw", isa => Bool, default => 1, );
47             has norootpass => ( is => "rw", isa => Bool, default => 1, );
48             has allowblankpass => ( is => "rw", isa => Bool, default => 0, );
49             has delay_hostkey => ( is => "rw", isa => Bool, default => 0, );
50             has domotd => ( is => "rw", isa => Bool, default => 0, );
51             has noremotetcp => ( is => "rw", isa => Bool, default => 1, );
52             has nolocaltcp => ( is => "rw", isa => Bool, default => 1, );
53              
54             has child => (
55             is => 'rwp',
56             isa => InstanceOf['Child::Link::Proc'],
57             );
58              
59             has comm => (
60             is => 'rwp',
61             isa => GlobRef,
62             );
63              
64             sub is_running
65             {
66 18     18 1 95 my $self = shift;
67 18         288 return defined $self->child;
68             }
69              
70             sub run
71             {
72 9     9 1 1164 my $self = shift;
73 9         24 my $child_hook = shift;
74              
75 9 50 33     81 if (defined $child_hook && ref $child_hook ne 'CODE')
76             {
77 0         0 croak '$child_hook was not a code ref when calling run';
78             }
79              
80 10     10   28391 use Socket;
  10         40455  
  10         6752  
81 10     10   1129 use IO::Handle;
  10         7767  
  10         4517  
82 9         67 socketpair(my $child_comm, my $parent_comm, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
83              
84             my $child = Child->new(sub {
85 0     0   0 my $parent = shift;
86 0         0 $0 .= " [Net::Dropbear Child]";
87              
88 0         0 $parent_comm->close;
89 0         0 $self->_set_comm($child_comm);
90              
91 0         0 require Net::Dropbear::XS;
92              
93 0         0 Net::Dropbear::XS->setup_svr_opts($self);
94              
95 0 0       0 $child_hook->($parent)
96             if defined $child_hook;
97              
98 0         0 Net::Dropbear::XS->svr_main();
99              
100             # Should never return
101 0         0 croak 'Unexpected return from dropbear';
102 9         17087 });
103              
104 9         122 $self->_set_child($child->start);
105 9         33000 $child_comm->close;
106 9         307 $self->_set_comm($parent_comm);
107              
108 9         7661 return;
109             }
110              
111             sub stop
112             {
113 9     9 1 604067 my $self = shift;
114 9 50       176 if ($self->is_running)
115             {
116 9         235 $self->child->kill(15);
117             }
118             }
119              
120             sub wait
121             {
122 9     9 1 883 my $self = shift;
123 9 50       81 if ($self->is_running)
124             {
125 9         158 $self->child->wait;
126             }
127             }
128              
129             sub auto_hook
130             {
131 0     0 0 0 my $self = shift;
132 0         0 my $hook = shift;
133              
134 0 0       0 if (exists $self->hooks->{$hook})
135             {
136 0         0 return $self->hooks->{$hook}->(@_);
137             }
138              
139 0         0 return Net::Dropbear::XS::HOOK_CONTINUE();
140             }
141              
142             sub import
143             {
144 19     19   12687 require Net::Dropbear::XS;
145 19         1826 Net::Dropbear::XS->export_to_level(1, @_);
146             }
147              
148             1;
149             __END__