| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Net::SSH2::Cisco; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
################################################## |
|
4
|
|
|
|
|
|
|
# Michael Vincent |
|
5
|
|
|
|
|
|
|
# www.VinsWorld.com |
|
6
|
|
|
|
|
|
|
################################################## |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# NOTE: This module is basically a cut/paste of: |
|
9
|
|
|
|
|
|
|
# 70% Net::Telnet |
|
10
|
|
|
|
|
|
|
# 20% Net::Telnet::Cisco |
|
11
|
|
|
|
|
|
|
# 5% Net::SSH2(::Channel) |
|
12
|
|
|
|
|
|
|
# 5% original hack to make it all work together |
|
13
|
|
|
|
|
|
|
# |
|
14
|
|
|
|
|
|
|
# - I tried to create a child class of Net::SSH2 to no avail due to |
|
15
|
|
|
|
|
|
|
# the C-type inside-out object it returns and my lack of experience. |
|
16
|
|
|
|
|
|
|
# |
|
17
|
|
|
|
|
|
|
# - I tried to pass a Net::SSH2 connetion to Net::Telnet(::Cisco) fhopen() |
|
18
|
|
|
|
|
|
|
# method, but it returned: |
|
19
|
|
|
|
|
|
|
# |
|
20
|
|
|
|
|
|
|
# Not a GLOB reference at [...]/perl/vendor/lib/Net/Telnet.pm line 679. |
|
21
|
|
|
|
|
|
|
# |
|
22
|
|
|
|
|
|
|
# - I tried to use Net::Telnet in my @ISA with AUTOLOAD to leverage the |
|
23
|
|
|
|
|
|
|
# accessors and code already written, but I'm not creating a Net::Telnet |
|
24
|
|
|
|
|
|
|
# object and I couldn't get it to work. |
|
25
|
|
|
|
|
|
|
# |
|
26
|
|
|
|
|
|
|
# That left me the (?only?) option - to write this Franken-module "liberally |
|
27
|
|
|
|
|
|
|
# borrowing" from much smarter, more talented programmers than I. |
|
28
|
|
|
|
|
|
|
|
|
29
|
1
|
|
|
1
|
|
16421
|
use strict; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
26
|
|
|
30
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
53
|
|
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
|
33
|
|
|
|
|
|
|
our @ISA; |
|
34
|
|
|
|
|
|
|
|
|
35
|
1
|
|
|
1
|
|
1324
|
use Net::SSH2 0.51; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use Socket qw(inet_ntoa AF_INET IPPROTO_TCP); |
|
37
|
|
|
|
|
|
|
my $HAVE_IO_Socket_IP = 0; |
|
38
|
|
|
|
|
|
|
eval "use IO::Socket::IP -register"; |
|
39
|
|
|
|
|
|
|
if(!$@) { |
|
40
|
|
|
|
|
|
|
$HAVE_IO_Socket_IP = 1; |
|
41
|
|
|
|
|
|
|
push @ISA, "IO::Socket::IP" |
|
42
|
|
|
|
|
|
|
} else { |
|
43
|
|
|
|
|
|
|
require IO::Socket::INET; |
|
44
|
|
|
|
|
|
|
push @ISA, "IO::Socket::INET" |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my $AF_INET6 = eval { Socket::AF_INET6() }; |
|
48
|
|
|
|
|
|
|
my $AF_UNSPEC = eval { Socket::AF_UNSPEC() }; |
|
49
|
|
|
|
|
|
|
my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() }; |
|
50
|
|
|
|
|
|
|
my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() }; |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
$|++; |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
################################################## |
|
55
|
|
|
|
|
|
|
# Start Public Module |
|
56
|
|
|
|
|
|
|
################################################## |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub new { |
|
59
|
|
|
|
|
|
|
my $self = shift; |
|
60
|
|
|
|
|
|
|
my $class = ref($self) || $self; |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my ($fh_open, $host); |
|
63
|
|
|
|
|
|
|
my %params = ( |
|
64
|
|
|
|
|
|
|
always_waitfor_prompt => 1, |
|
65
|
|
|
|
|
|
|
autopage => 1, |
|
66
|
|
|
|
|
|
|
bin_mode => 0, |
|
67
|
|
|
|
|
|
|
blocking => 0, |
|
68
|
|
|
|
|
|
|
cmd_prompt => '/(?m:^(?:[\w.\/]+\:)?[\w.-]+\s?(?:\(config[^\)]*\))?\s?[\$#>]\s?(?:\(enable\))?\s*$)/', |
|
69
|
|
|
|
|
|
|
cmd_rm_mode => "auto", |
|
70
|
|
|
|
|
|
|
dumplog => '', |
|
71
|
|
|
|
|
|
|
eofile => 1, |
|
72
|
|
|
|
|
|
|
errormode => "die", |
|
73
|
|
|
|
|
|
|
errormsg => "", |
|
74
|
|
|
|
|
|
|
fh_open => undef, |
|
75
|
|
|
|
|
|
|
host => "localhost", |
|
76
|
|
|
|
|
|
|
ignore_warnings => 0, |
|
77
|
|
|
|
|
|
|
inputlog => '', |
|
78
|
|
|
|
|
|
|
last_cmd => '', |
|
79
|
|
|
|
|
|
|
last_prompt => '', |
|
80
|
|
|
|
|
|
|
maxbufsize => 1_048_576, |
|
81
|
|
|
|
|
|
|
more_prompt => '/(?m:^\s*--More--)/', |
|
82
|
|
|
|
|
|
|
normalize_cmd => 1, |
|
83
|
|
|
|
|
|
|
ofs => "", |
|
84
|
|
|
|
|
|
|
opened => '', |
|
85
|
|
|
|
|
|
|
outputlog => '', |
|
86
|
|
|
|
|
|
|
ors => "\n", |
|
87
|
|
|
|
|
|
|
peer_family => 'ipv4', |
|
88
|
|
|
|
|
|
|
port => 22, |
|
89
|
|
|
|
|
|
|
rs => "\n", |
|
90
|
|
|
|
|
|
|
send_wakeup => 0, |
|
91
|
|
|
|
|
|
|
time_out => 10, |
|
92
|
|
|
|
|
|
|
timedout => '', |
|
93
|
|
|
|
|
|
|
waitfor_clear => 1, |
|
94
|
|
|
|
|
|
|
waitfor_pause => 0.2, |
|
95
|
|
|
|
|
|
|
warnings => '/(?mx:^% Unknown VPN |
|
96
|
|
|
|
|
|
|
|^%IP routing table VRF.* does not exist. Create first$ |
|
97
|
|
|
|
|
|
|
|^%No CEF interface information |
|
98
|
|
|
|
|
|
|
|^%No matching route to delete$ |
|
99
|
|
|
|
|
|
|
|^%Not all config may be removed and may reappear after reactivating/ |
|
100
|
|
|
|
|
|
|
)/', |
|
101
|
|
|
|
|
|
|
); |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
$params{_SSH_} = Net::SSH2->new() or return; |
|
104
|
|
|
|
|
|
|
$self = bless \%params, $class; |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my %args; |
|
107
|
|
|
|
|
|
|
if (@_ == 1) { |
|
108
|
|
|
|
|
|
|
($host) = @_ |
|
109
|
|
|
|
|
|
|
} else { |
|
110
|
|
|
|
|
|
|
%args = @_; |
|
111
|
|
|
|
|
|
|
for (keys(%args)) { |
|
112
|
|
|
|
|
|
|
if (/^-?always_waitfor_prompt$/i) { |
|
113
|
|
|
|
|
|
|
$self->always_waitfor_prompt($args{$_}); |
|
114
|
|
|
|
|
|
|
} elsif (/^-?autopage$/i) { |
|
115
|
|
|
|
|
|
|
$self->autopage($args{$_}) |
|
116
|
|
|
|
|
|
|
} elsif (/^-?binmode$/i) { |
|
117
|
|
|
|
|
|
|
$self->binmode($args{$_}) |
|
118
|
|
|
|
|
|
|
} elsif (/^-?blocking$/i) { |
|
119
|
|
|
|
|
|
|
$self->blocking($args{$_}) |
|
120
|
|
|
|
|
|
|
} elsif (/^-?cmd_remove_mode$/i) { |
|
121
|
|
|
|
|
|
|
$self->cmd_remove_mode($args{$_}) |
|
122
|
|
|
|
|
|
|
} elsif (/^-?dump_log$/i) { |
|
123
|
|
|
|
|
|
|
$self->dump_log($args{$_}) |
|
124
|
|
|
|
|
|
|
or return; |
|
125
|
|
|
|
|
|
|
} elsif (/^-?errmode$/i) { |
|
126
|
|
|
|
|
|
|
$self->errmode($args{$_}) |
|
127
|
|
|
|
|
|
|
} elsif (/^-?family$/i) { |
|
128
|
|
|
|
|
|
|
$self->family($args{$_}) |
|
129
|
|
|
|
|
|
|
} elsif (/^-?fhopen$/i) { |
|
130
|
|
|
|
|
|
|
$fh_open = $args{$_} |
|
131
|
|
|
|
|
|
|
} elsif (/^-?host$/i) { |
|
132
|
|
|
|
|
|
|
$host = $args{$_} |
|
133
|
|
|
|
|
|
|
} elsif (/^-?input_log$/i) { |
|
134
|
|
|
|
|
|
|
$self->input_log($args{$_}) |
|
135
|
|
|
|
|
|
|
or return; |
|
136
|
|
|
|
|
|
|
} elsif (/^-?input_record_separator$/i or /^-?rs$/i) { |
|
137
|
|
|
|
|
|
|
$self->input_record_separator($args{$_}) |
|
138
|
|
|
|
|
|
|
} elsif (/^-?max_buffer_length$/i) { |
|
139
|
|
|
|
|
|
|
$self->max_buffer_length($args{$_}) |
|
140
|
|
|
|
|
|
|
} elsif (/^-?normalize_cmd$/i) { |
|
141
|
|
|
|
|
|
|
$self->normalize_cmd($args{$_}) |
|
142
|
|
|
|
|
|
|
} elsif (/^-?output_field_separator$/i or /^-?ofs$/i) { |
|
143
|
|
|
|
|
|
|
$self->output_field_separator($args{$_}) |
|
144
|
|
|
|
|
|
|
} elsif (/^-?output_log$/i) { |
|
145
|
|
|
|
|
|
|
$self->output_log($args{$_}) |
|
146
|
|
|
|
|
|
|
or return; |
|
147
|
|
|
|
|
|
|
} elsif (/^-?output_record_separator$/i or /^-?ors$/i) { |
|
148
|
|
|
|
|
|
|
$self->output_record_separator($args{$_}) |
|
149
|
|
|
|
|
|
|
} elsif (/^-?port$/i) { |
|
150
|
|
|
|
|
|
|
$self->port($args{$_}) |
|
151
|
|
|
|
|
|
|
} elsif (/^-?prompt$/i) { |
|
152
|
|
|
|
|
|
|
$self->prompt($args{$_}) |
|
153
|
|
|
|
|
|
|
} elsif (/^-?send_wakeup$/i) { |
|
154
|
|
|
|
|
|
|
$self->send_wakeup($args{$_}) |
|
155
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
156
|
|
|
|
|
|
|
$self->timeout($args{$_}) |
|
157
|
|
|
|
|
|
|
} elsif (/^-?waitfor_clear$/i) { |
|
158
|
|
|
|
|
|
|
$self->waitfor_clear($args{$_}); |
|
159
|
|
|
|
|
|
|
} elsif (/^-?waitfor_pause$/i) { |
|
160
|
|
|
|
|
|
|
$self->waitfor_pause($args{$_}); |
|
161
|
|
|
|
|
|
|
} else { |
|
162
|
|
|
|
|
|
|
# pass through |
|
163
|
|
|
|
|
|
|
#$params{$_} = $args{$_} |
|
164
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given " . |
|
165
|
|
|
|
|
|
|
"to " . ref($self) . "::new()"); |
|
166
|
|
|
|
|
|
|
} |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
} |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# $self->open in the if statement so open() not called |
|
171
|
|
|
|
|
|
|
# if neither 'fh' nor 'host' are provided. |
|
172
|
|
|
|
|
|
|
if (defined $fh_open) { |
|
173
|
|
|
|
|
|
|
$self->fhopen($fh_open); |
|
174
|
|
|
|
|
|
|
$self->open or return |
|
175
|
|
|
|
|
|
|
} elsif (defined $host) { |
|
176
|
|
|
|
|
|
|
$self->host($host); |
|
177
|
|
|
|
|
|
|
$self->open or return |
|
178
|
|
|
|
|
|
|
} |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
return $self |
|
181
|
|
|
|
|
|
|
} |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub always_waitfor_prompt { |
|
184
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
185
|
|
|
|
|
|
|
$self->{always_waitfor_prompt} = $arg if defined $arg; |
|
186
|
|
|
|
|
|
|
return $self->{always_waitfor_prompt} |
|
187
|
|
|
|
|
|
|
} |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub autopage { |
|
190
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
191
|
|
|
|
|
|
|
$self->{autopage} = $arg if defined $arg; |
|
192
|
|
|
|
|
|
|
return $self->{autopage} |
|
193
|
|
|
|
|
|
|
} |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub binmode { |
|
196
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
197
|
|
|
|
|
|
|
$self->{bin_mode} = $arg if defined $arg; |
|
198
|
|
|
|
|
|
|
return $self->{bin_mode} |
|
199
|
|
|
|
|
|
|
} |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub blocking { |
|
202
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
203
|
|
|
|
|
|
|
$self->{blocking} = $arg if defined $arg; |
|
204
|
|
|
|
|
|
|
return $self->{blocking} |
|
205
|
|
|
|
|
|
|
} |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub close { |
|
208
|
|
|
|
|
|
|
my ($self) = @_; |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$self->{eofile} = 1; |
|
211
|
|
|
|
|
|
|
$self->{opened} = ''; |
|
212
|
|
|
|
|
|
|
if (defined $self->{_SSH_CHAN_}) { |
|
213
|
|
|
|
|
|
|
$self->{_SSH_CHAN_}->close |
|
214
|
|
|
|
|
|
|
} |
|
215
|
|
|
|
|
|
|
if (defined $self->{_SSH_}) { |
|
216
|
|
|
|
|
|
|
$self->{_SSH_}->disconnect |
|
217
|
|
|
|
|
|
|
} |
|
218
|
|
|
|
|
|
|
delete $self->{_SSH_CHAN_}; |
|
219
|
|
|
|
|
|
|
delete $self->{_SSH_}; |
|
220
|
|
|
|
|
|
|
1 |
|
221
|
|
|
|
|
|
|
} |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub cmd { |
|
224
|
|
|
|
|
|
|
my ($self, @args) = @_; |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
my $string = ''; |
|
227
|
|
|
|
|
|
|
my $chan = $self->{_SSH_CHAN_}; |
|
228
|
|
|
|
|
|
|
my $clear = $self->{waitfor_clear}; |
|
229
|
|
|
|
|
|
|
my $normal = $self->{normalize_cmd}; |
|
230
|
|
|
|
|
|
|
my $ors = $self->{ors}; |
|
231
|
|
|
|
|
|
|
my $pause = $self->{waitfor_pause}; |
|
232
|
|
|
|
|
|
|
my $prompt = $self->{cmd_prompt}; |
|
233
|
|
|
|
|
|
|
my $rm = $self->{cmd_rm_mode}; |
|
234
|
|
|
|
|
|
|
my $rs = $self->{rs}; |
|
235
|
|
|
|
|
|
|
my $timeout = $self->{time_out}; |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
if (!defined $chan) { |
|
238
|
|
|
|
|
|
|
&_croak($self, "no login " . |
|
239
|
|
|
|
|
|
|
"for " . ref($self) . "::cmd()"); |
|
240
|
|
|
|
|
|
|
} |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
my $ok = 1; |
|
243
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
my $arg_errmode = &_extract_arg_errmode($self, \@args); |
|
246
|
|
|
|
|
|
|
local $self->{errormode} = $arg_errmode if $arg_errmode; |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $output = []; |
|
249
|
|
|
|
|
|
|
my $output_ref; |
|
250
|
|
|
|
|
|
|
if (@_ == 2) { |
|
251
|
|
|
|
|
|
|
($string) = ($_[1]) |
|
252
|
|
|
|
|
|
|
} else { |
|
253
|
|
|
|
|
|
|
my %args = @args; |
|
254
|
|
|
|
|
|
|
for (keys(%args)) { |
|
255
|
|
|
|
|
|
|
if (/^-?string$/i) { |
|
256
|
|
|
|
|
|
|
$string = $args{$_} |
|
257
|
|
|
|
|
|
|
} elsif (/^-?cmd_remove_mode$/i) { |
|
258
|
|
|
|
|
|
|
$rm = _parse_cmd_remove_mode($self, $args{$_}) |
|
259
|
|
|
|
|
|
|
} elsif (/^-?input_record_separator$/i or /^-?rs$/i) { |
|
260
|
|
|
|
|
|
|
$rs = $args{$_} |
|
261
|
|
|
|
|
|
|
} elsif (/^-?normalize_cmd$/i) { |
|
262
|
|
|
|
|
|
|
$normal = $args{$_} |
|
263
|
|
|
|
|
|
|
} elsif (/^-?output$/i) { |
|
264
|
|
|
|
|
|
|
$output_ref = $args{$_}; |
|
265
|
|
|
|
|
|
|
if (defined($output_ref) and ref($output_ref) eq "ARRAY") { |
|
266
|
|
|
|
|
|
|
$output = $output_ref; |
|
267
|
|
|
|
|
|
|
} |
|
268
|
|
|
|
|
|
|
} elsif (/^-?output_record_separator$/i or /^-?ors$/i) { |
|
269
|
|
|
|
|
|
|
$ors = $args{$_} |
|
270
|
|
|
|
|
|
|
} elsif (/^-?prompt$/i) { |
|
271
|
|
|
|
|
|
|
$prompt = &_parse_prompt($self, $args{$_}) |
|
272
|
|
|
|
|
|
|
or return; |
|
273
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
274
|
|
|
|
|
|
|
$timeout = _parse_timeout($self, $args{$_}) |
|
275
|
|
|
|
|
|
|
} elsif (/^-?waitfor_clear$/i) { |
|
276
|
|
|
|
|
|
|
$clear = $args{$_} |
|
277
|
|
|
|
|
|
|
} elsif (/^-?waitfor_pause$/i) { |
|
278
|
|
|
|
|
|
|
$pause = _parse_waitfor_pause($self, $args{$_}) |
|
279
|
|
|
|
|
|
|
or return |
|
280
|
|
|
|
|
|
|
} else { |
|
281
|
|
|
|
|
|
|
# pass through |
|
282
|
|
|
|
|
|
|
#$params{$_} = $args{$_} |
|
283
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given " . |
|
284
|
|
|
|
|
|
|
"to " . ref($self) . "::cmd()"); |
|
285
|
|
|
|
|
|
|
} |
|
286
|
|
|
|
|
|
|
} |
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
#prep |
|
290
|
|
|
|
|
|
|
local $self->{time_out} = $timeout; |
|
291
|
|
|
|
|
|
|
local $self->{waitfor_clear} = $clear; |
|
292
|
|
|
|
|
|
|
$self->errmsg(""); |
|
293
|
|
|
|
|
|
|
chomp $string; |
|
294
|
|
|
|
|
|
|
$self->{last_cmd} = $string; |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
my ($lines, $last_prompt); |
|
297
|
|
|
|
|
|
|
{ |
|
298
|
|
|
|
|
|
|
local $self->{errormode} = "return"; |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
#send |
|
301
|
|
|
|
|
|
|
$self->put($string . $ors); |
|
302
|
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
#wait |
|
304
|
|
|
|
|
|
|
select(undef,undef,undef,$pause); # sleep |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
#read |
|
307
|
|
|
|
|
|
|
($lines, $last_prompt) = $self->waitfor($prompt); |
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
return $self->error("command timed-out") if $self->timed_out; |
|
311
|
|
|
|
|
|
|
return $self->error($self->errmsg) if $self->errmsg ne ""; |
|
312
|
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
## Split lines into an array, keeping record separator at end of line. |
|
314
|
|
|
|
|
|
|
my $firstpos = 0; |
|
315
|
|
|
|
|
|
|
my $rs_len = length $rs; |
|
316
|
|
|
|
|
|
|
while ((my $lastpos = index($lines, $rs, $firstpos)) > -1) { |
|
317
|
|
|
|
|
|
|
push(@$output, substr($lines, $firstpos, $lastpos - $firstpos + $rs_len)); |
|
318
|
|
|
|
|
|
|
$firstpos = $lastpos + $rs_len |
|
319
|
|
|
|
|
|
|
} |
|
320
|
|
|
|
|
|
|
if ($firstpos < length $lines) { |
|
321
|
|
|
|
|
|
|
push @$output, substr($lines, $firstpos) |
|
322
|
|
|
|
|
|
|
} |
|
323
|
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
# clean up |
|
325
|
|
|
|
|
|
|
if ($rm eq "auto") { |
|
326
|
|
|
|
|
|
|
if ((defined @$output[0]) and (@$output[0] =~ /^$string(?:\r)?(?:\n)?/)) { |
|
327
|
|
|
|
|
|
|
shift @$output |
|
328
|
|
|
|
|
|
|
} |
|
329
|
|
|
|
|
|
|
} else { |
|
330
|
|
|
|
|
|
|
while ($rm--) { |
|
331
|
|
|
|
|
|
|
shift @$output |
|
332
|
|
|
|
|
|
|
} |
|
333
|
|
|
|
|
|
|
} |
|
334
|
|
|
|
|
|
|
## Ensure at least a null string when there's no command output - so |
|
335
|
|
|
|
|
|
|
## "true" is returned in a list context. |
|
336
|
|
|
|
|
|
|
unless (@$output) { |
|
337
|
|
|
|
|
|
|
@$output = ("") |
|
338
|
|
|
|
|
|
|
} |
|
339
|
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
# Look for errors in output |
|
341
|
|
|
|
|
|
|
for ( my ($i, $lastline) = (0, ''); |
|
342
|
|
|
|
|
|
|
$i <= $#{$output}; |
|
343
|
|
|
|
|
|
|
$lastline = $output->[$i++] ) { |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# This may have to be a pattern match instead. |
|
346
|
|
|
|
|
|
|
if ( ( substr $output->[$i], 0, 1 ) eq '%' ) { |
|
347
|
|
|
|
|
|
|
if ( $output->[$i] =~ /'\^' marker/ ) { # Typo & bad arg errors |
|
348
|
|
|
|
|
|
|
chomp $lastline; |
|
349
|
|
|
|
|
|
|
$self->error( join "\n", |
|
350
|
|
|
|
|
|
|
"Last command and router error: ", |
|
351
|
|
|
|
|
|
|
( $self->last_prompt . $string ), |
|
352
|
|
|
|
|
|
|
$lastline, |
|
353
|
|
|
|
|
|
|
$output->[$i], |
|
354
|
|
|
|
|
|
|
); |
|
355
|
|
|
|
|
|
|
splice @$output, $i - 1, 3; |
|
356
|
|
|
|
|
|
|
} else { # All other errors. |
|
357
|
|
|
|
|
|
|
chomp $output->[$i]; |
|
358
|
|
|
|
|
|
|
$self->error( join "\n", |
|
359
|
|
|
|
|
|
|
"Last command and router error: ", |
|
360
|
|
|
|
|
|
|
( $self->last_prompt . $string ), |
|
361
|
|
|
|
|
|
|
$output->[$i], |
|
362
|
|
|
|
|
|
|
); |
|
363
|
|
|
|
|
|
|
splice @$output, $i, 2; |
|
364
|
|
|
|
|
|
|
} |
|
365
|
|
|
|
|
|
|
$ok = 0; |
|
366
|
|
|
|
|
|
|
last; |
|
367
|
|
|
|
|
|
|
} |
|
368
|
|
|
|
|
|
|
} |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
if ($normal) { |
|
371
|
|
|
|
|
|
|
@$output = _normalize (@$output); |
|
372
|
|
|
|
|
|
|
} |
|
373
|
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
## Return command output via named arg, if requested. |
|
375
|
|
|
|
|
|
|
if (defined $output_ref) { |
|
376
|
|
|
|
|
|
|
if (ref($output_ref) eq "SCALAR") { |
|
377
|
|
|
|
|
|
|
$$output_ref = join "", @$output; |
|
378
|
|
|
|
|
|
|
} elsif (ref($output_ref) eq "HASH") { |
|
379
|
|
|
|
|
|
|
%$output_ref = @$output; |
|
380
|
|
|
|
|
|
|
} |
|
381
|
|
|
|
|
|
|
} |
|
382
|
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
wantarray ? @$output : $ok |
|
384
|
|
|
|
|
|
|
} |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub cmd_remove_mode { |
|
387
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
if (defined $arg) { |
|
390
|
|
|
|
|
|
|
if (defined (my $r = _parse_cmd_remove_mode($self, $arg))) { |
|
391
|
|
|
|
|
|
|
$self->{cmd_rm_mode} = $r |
|
392
|
|
|
|
|
|
|
} |
|
393
|
|
|
|
|
|
|
} |
|
394
|
|
|
|
|
|
|
return $self->{cmd_rm_mode} |
|
395
|
|
|
|
|
|
|
} |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
sub connect { &open } |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub disable { |
|
400
|
|
|
|
|
|
|
my $self = shift; |
|
401
|
|
|
|
|
|
|
$self->cmd('disable'); |
|
402
|
|
|
|
|
|
|
if ($self->is_enabled) { |
|
403
|
|
|
|
|
|
|
return $self->error("Failed to exit enabled mode") |
|
404
|
|
|
|
|
|
|
} |
|
405
|
|
|
|
|
|
|
1 |
|
406
|
|
|
|
|
|
|
} |
|
407
|
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub dump_log { |
|
409
|
|
|
|
|
|
|
my ($self, $name) = @_; |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
my $fh = $self->{dumplog}; |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
if (@_ >= 2) { |
|
414
|
|
|
|
|
|
|
if (!defined($name) or $name eq "") { # input arg is "" |
|
415
|
|
|
|
|
|
|
## Turn off logging. |
|
416
|
|
|
|
|
|
|
$fh = ""; |
|
417
|
|
|
|
|
|
|
} elsif (&_is_open_fh($name)) { # input arg is an open fh |
|
418
|
|
|
|
|
|
|
## Use the open fh for logging. |
|
419
|
|
|
|
|
|
|
$fh = $name; |
|
420
|
|
|
|
|
|
|
select((select($fh), $|=1)[$[]); # don't buffer writes |
|
421
|
|
|
|
|
|
|
} elsif (!ref $name) { # input arg is filename |
|
422
|
|
|
|
|
|
|
## Open the file for logging. |
|
423
|
|
|
|
|
|
|
$fh = &_fname_to_handle($self, $name) |
|
424
|
|
|
|
|
|
|
or return; |
|
425
|
|
|
|
|
|
|
select((select($fh), $|=1)[$[]); # don't buffer writes |
|
426
|
|
|
|
|
|
|
} else { |
|
427
|
|
|
|
|
|
|
return $self->error("bad Dump_log argument ", |
|
428
|
|
|
|
|
|
|
"\"$name\": not filename or open fh"); |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
$self->{dumplog} = $fh; |
|
431
|
|
|
|
|
|
|
} |
|
432
|
|
|
|
|
|
|
$fh; |
|
433
|
|
|
|
|
|
|
} |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub enable { |
|
436
|
|
|
|
|
|
|
my $self = shift; |
|
437
|
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
my ($en_username, $en_password, $en_passcode, $en_level) = ('','','',''); |
|
439
|
|
|
|
|
|
|
my ($error, $lastline, $orig_errmode, $reset, %seen); |
|
440
|
|
|
|
|
|
|
my $chan = $self->{_SSH_CHAN_}; |
|
441
|
|
|
|
|
|
|
my $ors = $self->{ors}; |
|
442
|
|
|
|
|
|
|
my $timeout = $self->{time_out}; |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
if (!defined $chan) { |
|
445
|
|
|
|
|
|
|
&_croak($self, "no login " . |
|
446
|
|
|
|
|
|
|
"for " . ref($self) . "::enable()"); |
|
447
|
|
|
|
|
|
|
} |
|
448
|
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
450
|
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
if (@_ == 1) { # just passwd given |
|
452
|
|
|
|
|
|
|
($en_password) = @_ |
|
453
|
|
|
|
|
|
|
} else { |
|
454
|
|
|
|
|
|
|
my %args = @_; |
|
455
|
|
|
|
|
|
|
foreach (keys %args) { |
|
456
|
|
|
|
|
|
|
if (/^-?name$|^-?login$|^-?user/i) { |
|
457
|
|
|
|
|
|
|
$en_username = $args{$_} |
|
458
|
|
|
|
|
|
|
} elsif (/^-?passw/i) { |
|
459
|
|
|
|
|
|
|
$en_password = $args{$_} |
|
460
|
|
|
|
|
|
|
} elsif (/^-?passc/i) { |
|
461
|
|
|
|
|
|
|
$en_passcode = $args{$_} |
|
462
|
|
|
|
|
|
|
} elsif (/^-?level$/i) { |
|
463
|
|
|
|
|
|
|
$en_level = $args{$_} |
|
464
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
465
|
|
|
|
|
|
|
$timeout = $args{$_} |
|
466
|
|
|
|
|
|
|
} else { |
|
467
|
|
|
|
|
|
|
# pass through |
|
468
|
|
|
|
|
|
|
#$params{$_} = $args{$_} |
|
469
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given " . |
|
470
|
|
|
|
|
|
|
"to " . ref($self) . "::enable()"); |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
} |
|
473
|
|
|
|
|
|
|
} |
|
474
|
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
local $self->{time_out} = $timeout; |
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
## Create a subroutine to generate an error for user. |
|
478
|
|
|
|
|
|
|
# $error = sub { |
|
479
|
|
|
|
|
|
|
# my($errmsg) = @_; |
|
480
|
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# if ($self->timed_out) { |
|
482
|
|
|
|
|
|
|
# return $self->error($errmsg); |
|
483
|
|
|
|
|
|
|
# } elsif ($self->eof) { |
|
484
|
|
|
|
|
|
|
# ($lastline = $self->lastline) =~ s/\n+//; |
|
485
|
|
|
|
|
|
|
# return $self->error($errmsg, ": ", $lastline); |
|
486
|
|
|
|
|
|
|
# } else { |
|
487
|
|
|
|
|
|
|
# return $self->error($errmsg); |
|
488
|
|
|
|
|
|
|
# } |
|
489
|
|
|
|
|
|
|
# }; |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# Store the old prompt without the //s around it. |
|
492
|
|
|
|
|
|
|
my ($old_prompt) = _prep_regex($self->{cmd_prompt}); |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
# We need to expect either a Password prompt or a |
|
495
|
|
|
|
|
|
|
# typical prompt. If the user doesn't have enough |
|
496
|
|
|
|
|
|
|
# access to run the 'enable' command, the device |
|
497
|
|
|
|
|
|
|
# won't even query for a password, it will just |
|
498
|
|
|
|
|
|
|
# ignore the command and display another [boring] prompt. |
|
499
|
|
|
|
|
|
|
$self->put("enable " . $en_level . $ors); |
|
500
|
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
select(undef,undef,undef,$self->{waitfor_pause}); # sleep |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
{ |
|
504
|
|
|
|
|
|
|
my ($prematch, $match) = $self->waitfor( |
|
505
|
|
|
|
|
|
|
-match => '/[Ll]ogin[:\s]*$/', |
|
506
|
|
|
|
|
|
|
-match => '/[Uu]sername[:\s]*$/', |
|
507
|
|
|
|
|
|
|
-match => '/[Pp]assw(?:or)?d[:\s]*$/', |
|
508
|
|
|
|
|
|
|
-match => '/(?i:Passcode)[:\s]*$/', |
|
509
|
|
|
|
|
|
|
-match => "/$old_prompt/", |
|
510
|
|
|
|
|
|
|
) or do { |
|
511
|
|
|
|
|
|
|
return &$error("read eof waiting for enable login or password prompt") |
|
512
|
|
|
|
|
|
|
if $self->eof; |
|
513
|
|
|
|
|
|
|
return &$error("timed-out waiting for enable login or password prompt"); |
|
514
|
|
|
|
|
|
|
}; |
|
515
|
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
if (not defined $match) { |
|
517
|
|
|
|
|
|
|
return $self->error("enable failed: access denied or bad name, passwd, etc") |
|
518
|
|
|
|
|
|
|
} elsif ($match =~ /sername|ogin/) { |
|
519
|
|
|
|
|
|
|
if (!defined $self->put($en_username . $ors)) { |
|
520
|
|
|
|
|
|
|
return $self->error("enable failed") |
|
521
|
|
|
|
|
|
|
} |
|
522
|
|
|
|
|
|
|
$self->{last_prompt} = $match; |
|
523
|
|
|
|
|
|
|
if ($seen{login}++) { |
|
524
|
|
|
|
|
|
|
return $self->error("enable failed: access denied or bad username") |
|
525
|
|
|
|
|
|
|
} |
|
526
|
|
|
|
|
|
|
redo |
|
527
|
|
|
|
|
|
|
} elsif ($match =~ /[Pp]assw/ ) { |
|
528
|
|
|
|
|
|
|
if (!defined $self->put($en_password . $ors)) { |
|
529
|
|
|
|
|
|
|
return $self->error("enable failed") |
|
530
|
|
|
|
|
|
|
} |
|
531
|
|
|
|
|
|
|
$self->{last_prompt} = $match; |
|
532
|
|
|
|
|
|
|
if ($seen{passwd}++) { |
|
533
|
|
|
|
|
|
|
return $self->error("enable failed: access denied or bad password") |
|
534
|
|
|
|
|
|
|
} |
|
535
|
|
|
|
|
|
|
redo |
|
536
|
|
|
|
|
|
|
} elsif ($match =~ /(?i:Passcode)/ ) { |
|
537
|
|
|
|
|
|
|
if (!defined $self->put($en_passcode . $ors)) { |
|
538
|
|
|
|
|
|
|
return $self->error("enable failed") |
|
539
|
|
|
|
|
|
|
} |
|
540
|
|
|
|
|
|
|
$self->{last_prompt} = $match; |
|
541
|
|
|
|
|
|
|
if ($seen{passcode}++) { |
|
542
|
|
|
|
|
|
|
return $self->error("enable failed: access denied or bad passcode") |
|
543
|
|
|
|
|
|
|
} |
|
544
|
|
|
|
|
|
|
redo |
|
545
|
|
|
|
|
|
|
} elsif ($match =~ /$old_prompt/) { |
|
546
|
|
|
|
|
|
|
## Success! Exit the block. |
|
547
|
|
|
|
|
|
|
$self->{last_prompt} = $match; |
|
548
|
|
|
|
|
|
|
last |
|
549
|
|
|
|
|
|
|
} else { |
|
550
|
|
|
|
|
|
|
return $self->error("enable received unexpected prompt. Aborting.") |
|
551
|
|
|
|
|
|
|
} |
|
552
|
|
|
|
|
|
|
} |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
if (not defined $en_level or $en_level =~ /^[1-9]/) { |
|
555
|
|
|
|
|
|
|
# Prompts and levels over 1 give a #/(enable) prompt. |
|
556
|
|
|
|
|
|
|
if ($self->is_enabled) { |
|
557
|
|
|
|
|
|
|
return 1 |
|
558
|
|
|
|
|
|
|
} else { |
|
559
|
|
|
|
|
|
|
return $self->error("Failed to enter enable mode") |
|
560
|
|
|
|
|
|
|
} |
|
561
|
|
|
|
|
|
|
} else { |
|
562
|
|
|
|
|
|
|
# Assume success |
|
563
|
|
|
|
|
|
|
return 1 |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
} |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub eof { |
|
568
|
|
|
|
|
|
|
my ($self) = @_; |
|
569
|
|
|
|
|
|
|
exists $self->{_SSH_CHAN_} ? ($self->{_SSH_CHAN_}->eof or $self->{eofile}) : $self->{eofile}; |
|
570
|
|
|
|
|
|
|
} |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub errmode { |
|
573
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
if (defined $arg) { |
|
576
|
|
|
|
|
|
|
if (defined (my $r = _parse_errmode($self, $arg))) { |
|
577
|
|
|
|
|
|
|
$self->{errormode} = $r |
|
578
|
|
|
|
|
|
|
} |
|
579
|
|
|
|
|
|
|
} |
|
580
|
|
|
|
|
|
|
return $self->{errormode} |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
sub errmsg { |
|
584
|
|
|
|
|
|
|
my ($self, @errmsgs) = @_; |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
if (@_ >= 2) { |
|
587
|
|
|
|
|
|
|
$self->{errormsg} = join "", @errmsgs; |
|
588
|
|
|
|
|
|
|
} |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
return $self->{errormsg} |
|
591
|
|
|
|
|
|
|
} |
|
592
|
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub error { |
|
594
|
|
|
|
|
|
|
my ($self, @errmsg) = @_; |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
if ($self->ignore_warnings) { |
|
597
|
|
|
|
|
|
|
my $errmsg = join '', @errmsg; |
|
598
|
|
|
|
|
|
|
my $warnings_re = _prep_regex($self->warnings); |
|
599
|
|
|
|
|
|
|
return if $errmsg =~ /$warnings_re/; |
|
600
|
|
|
|
|
|
|
} |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
my ($errmsg, $func, $mode, @args); |
|
603
|
|
|
|
|
|
|
local $_; |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
if (@_ >= 2) { |
|
606
|
|
|
|
|
|
|
## Put error message in the object. |
|
607
|
|
|
|
|
|
|
$errmsg = join "", @errmsg; |
|
608
|
|
|
|
|
|
|
$self->{errormsg} = $errmsg; |
|
609
|
|
|
|
|
|
|
## Do the error action as described by error mode. |
|
610
|
|
|
|
|
|
|
$mode = $self->{errormode}; |
|
611
|
|
|
|
|
|
|
if (ref($mode) eq "CODE") { |
|
612
|
|
|
|
|
|
|
&$mode($errmsg); |
|
613
|
|
|
|
|
|
|
return; |
|
614
|
|
|
|
|
|
|
} elsif (ref($mode) eq "ARRAY") { |
|
615
|
|
|
|
|
|
|
($func, @args) = @$mode; |
|
616
|
|
|
|
|
|
|
&$func(@args); |
|
617
|
|
|
|
|
|
|
return; |
|
618
|
|
|
|
|
|
|
} elsif ($mode =~ /^return$/i) { |
|
619
|
|
|
|
|
|
|
return; |
|
620
|
|
|
|
|
|
|
} else { # die |
|
621
|
|
|
|
|
|
|
if ($errmsg =~ /\n$/) { |
|
622
|
|
|
|
|
|
|
die $errmsg; |
|
623
|
|
|
|
|
|
|
} else { |
|
624
|
|
|
|
|
|
|
## Die and append caller's line number to message. |
|
625
|
|
|
|
|
|
|
&_croak($self, $errmsg); |
|
626
|
|
|
|
|
|
|
} |
|
627
|
|
|
|
|
|
|
} |
|
628
|
|
|
|
|
|
|
} else { |
|
629
|
|
|
|
|
|
|
return $self->{errormsg} ne ""; |
|
630
|
|
|
|
|
|
|
} |
|
631
|
|
|
|
|
|
|
} |
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub family { |
|
634
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
if (defined $arg) { |
|
637
|
|
|
|
|
|
|
if (defined (my $r = _parse_family($self, $arg))) { |
|
638
|
|
|
|
|
|
|
$self->{peer_family} = $r |
|
639
|
|
|
|
|
|
|
} |
|
640
|
|
|
|
|
|
|
} |
|
641
|
|
|
|
|
|
|
return $self->{peer_family} |
|
642
|
|
|
|
|
|
|
} |
|
643
|
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
sub fhopen{ |
|
645
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
646
|
|
|
|
|
|
|
$self->{fh_open} = $arg if defined $arg; |
|
647
|
|
|
|
|
|
|
return $self->{fh_open} |
|
648
|
|
|
|
|
|
|
} |
|
649
|
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub host { |
|
651
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
652
|
|
|
|
|
|
|
$self->{host} = $arg if defined $arg; |
|
653
|
|
|
|
|
|
|
return $self->{host} |
|
654
|
|
|
|
|
|
|
} |
|
655
|
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
sub ignore_warnings { |
|
657
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
658
|
|
|
|
|
|
|
$self->{ignore_warnings} = $arg if defined $arg; |
|
659
|
|
|
|
|
|
|
return $self->{ignore_warnings} |
|
660
|
|
|
|
|
|
|
} |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub input_log { |
|
663
|
|
|
|
|
|
|
my ($self, $name) = @_; |
|
664
|
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
my $fh = $self->{inputlog}; |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
if (@_ >= 2) { |
|
668
|
|
|
|
|
|
|
if (!defined($name) or $name eq "") { # input arg is "" |
|
669
|
|
|
|
|
|
|
## Turn off logging. |
|
670
|
|
|
|
|
|
|
$fh = ""; |
|
671
|
|
|
|
|
|
|
} elsif (&_is_open_fh($name)) { # input arg is an open fh |
|
672
|
|
|
|
|
|
|
## Use the open fh for logging. |
|
673
|
|
|
|
|
|
|
$fh = $name; |
|
674
|
|
|
|
|
|
|
select((select($fh), $|=1)[$[]); # don't buffer writes |
|
675
|
|
|
|
|
|
|
} elsif (!ref $name) { # input arg is filename |
|
676
|
|
|
|
|
|
|
## Open the file for logging. |
|
677
|
|
|
|
|
|
|
$fh = &_fname_to_handle($self, $name) |
|
678
|
|
|
|
|
|
|
or return; |
|
679
|
|
|
|
|
|
|
select((select($fh), $|=1)[$[]); # don't buffer writes |
|
680
|
|
|
|
|
|
|
} else { |
|
681
|
|
|
|
|
|
|
return $self->error("bad Input_log argument ", |
|
682
|
|
|
|
|
|
|
"\"$name\": not filename or open fh"); |
|
683
|
|
|
|
|
|
|
} |
|
684
|
|
|
|
|
|
|
$self->{inputlog} = $fh; |
|
685
|
|
|
|
|
|
|
} |
|
686
|
|
|
|
|
|
|
$fh; |
|
687
|
|
|
|
|
|
|
} |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub input_record_separator { |
|
690
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
691
|
|
|
|
|
|
|
$self->{rs} = $arg if (defined $arg and length $arg); |
|
692
|
|
|
|
|
|
|
return $self->{rs} |
|
693
|
|
|
|
|
|
|
} |
|
694
|
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
sub ios_break { |
|
696
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
my $chan = $self->{_SSH_CHAN_}; |
|
699
|
|
|
|
|
|
|
my $ret; |
|
700
|
|
|
|
|
|
|
if (defined $arg) { |
|
701
|
|
|
|
|
|
|
$ret = $self->put("\c^$arg") |
|
702
|
|
|
|
|
|
|
} else { |
|
703
|
|
|
|
|
|
|
$ret = $self->put("\c^") |
|
704
|
|
|
|
|
|
|
} |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
return $ret; |
|
707
|
|
|
|
|
|
|
} |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
sub is_enabled { $_[0]->last_prompt =~ /\#|enable|config/ ? 1 : undef } |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
sub last_cmd { |
|
712
|
|
|
|
|
|
|
my $self = shift; |
|
713
|
|
|
|
|
|
|
exists $self->{last_cmd} ? $self->{last_cmd} : undef |
|
714
|
|
|
|
|
|
|
} |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
sub last_prompt { |
|
717
|
|
|
|
|
|
|
my $self = shift; |
|
718
|
|
|
|
|
|
|
exists $self->{last_prompt} ? $self->{last_prompt} : undef |
|
719
|
|
|
|
|
|
|
} |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
sub login { |
|
722
|
|
|
|
|
|
|
my ($self, @args) = @_; |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
if (!$self->{opened}) { |
|
725
|
|
|
|
|
|
|
&_croak($self, "no connect " . |
|
726
|
|
|
|
|
|
|
"for " . ref($self) . "::login()"); |
|
727
|
|
|
|
|
|
|
} |
|
728
|
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
my $bin = $self->{bin_mode}; |
|
730
|
|
|
|
|
|
|
my $block = $self->{blocking}; |
|
731
|
|
|
|
|
|
|
my $prompt = $self->{cmd_prompt}; |
|
732
|
|
|
|
|
|
|
my $timeout = $self->{time_out}; |
|
733
|
|
|
|
|
|
|
my $ssh = $self->{_SSH_}; |
|
734
|
|
|
|
|
|
|
my $sent_wakeup = 0; |
|
735
|
|
|
|
|
|
|
my ($user, $pass); |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
my $arg_errmode = &_extract_arg_errmode($self, \@args); |
|
740
|
|
|
|
|
|
|
local $self->{errormode} = $arg_errmode if $arg_errmode; |
|
741
|
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
if (@_ == 3) { # just username and passwd given |
|
743
|
|
|
|
|
|
|
($user, $pass) = (@_[1,2]) |
|
744
|
|
|
|
|
|
|
} else { |
|
745
|
|
|
|
|
|
|
my %args = @args; |
|
746
|
|
|
|
|
|
|
for (keys(%args)) { |
|
747
|
|
|
|
|
|
|
if (/^-?(?:user)?name$/i) { |
|
748
|
|
|
|
|
|
|
$user = $args{$_} |
|
749
|
|
|
|
|
|
|
} elsif (/^-?passw(?:ord)?$/i) { |
|
750
|
|
|
|
|
|
|
$pass = $args{$_} |
|
751
|
|
|
|
|
|
|
} elsif (/^-?prompt$/i) { |
|
752
|
|
|
|
|
|
|
$prompt = _parse_prompt($self, $args{$_}) |
|
753
|
|
|
|
|
|
|
or return |
|
754
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
755
|
|
|
|
|
|
|
$timeout = _parse_timeout($self, $args{$_}) |
|
756
|
|
|
|
|
|
|
} else { |
|
757
|
|
|
|
|
|
|
# pass through |
|
758
|
|
|
|
|
|
|
#$params{$_} = $args{$_} |
|
759
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given ", |
|
760
|
|
|
|
|
|
|
"to " . ref($self) . "::login()"); |
|
761
|
|
|
|
|
|
|
} |
|
762
|
|
|
|
|
|
|
} |
|
763
|
|
|
|
|
|
|
} |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
if (!defined $user) { |
|
766
|
|
|
|
|
|
|
&_croak($self,"username argument not given to " . ref($self) . "::login()") |
|
767
|
|
|
|
|
|
|
} |
|
768
|
|
|
|
|
|
|
if (!defined $pass) { |
|
769
|
|
|
|
|
|
|
&_croak($self,"password argument not given to " . ref($self) . "::login()") |
|
770
|
|
|
|
|
|
|
} |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
local $self->{time_out} = $timeout; |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
# This is where we'd do 'connect' send_wakeup if Net::SSH2 supported |
|
775
|
|
|
|
|
|
|
if ($self->{send_wakeup} eq 'connect') { |
|
776
|
|
|
|
|
|
|
$sent_wakeup = 1; |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
# my $old_sep = $self->output_record_separator; |
|
779
|
|
|
|
|
|
|
# $self->output_record_separator("\n"); |
|
780
|
|
|
|
|
|
|
# $self->print(''); |
|
781
|
|
|
|
|
|
|
# $self->output_record_separator($old_sep); |
|
782
|
|
|
|
|
|
|
} |
|
783
|
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
AUTH: |
|
785
|
|
|
|
|
|
|
if ($ssh->auth_password($user, $pass)) { |
|
786
|
|
|
|
|
|
|
my $chan = $ssh->channel(); |
|
787
|
|
|
|
|
|
|
$chan->blocking($block); # 0 Needed on Windows |
|
788
|
|
|
|
|
|
|
$chan->shell(); |
|
789
|
|
|
|
|
|
|
if ($bin) { |
|
790
|
|
|
|
|
|
|
CORE::binmode ($chan) |
|
791
|
|
|
|
|
|
|
} |
|
792
|
|
|
|
|
|
|
$self->{_SSH_CHAN_} = $chan; |
|
793
|
|
|
|
|
|
|
# flush buffer, read off first prompt |
|
794
|
|
|
|
|
|
|
$self->waitfor($self->{cmd_prompt}); |
|
795
|
|
|
|
|
|
|
} else { |
|
796
|
|
|
|
|
|
|
# This is where we'd do 'timeout' send_wakeup if Net::SSH2 supported |
|
797
|
|
|
|
|
|
|
if ($sent_wakeup == 0 && $self->{send_wakeup} eq 'timeout') { |
|
798
|
|
|
|
|
|
|
$sent_wakeup = 1; |
|
799
|
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
# my $old_sep = $self->output_record_separator; |
|
801
|
|
|
|
|
|
|
# $self->output_record_separator("\n"); |
|
802
|
|
|
|
|
|
|
# $self->print(''); |
|
803
|
|
|
|
|
|
|
# $self->output_record_separator($old_sep); |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
# goto AUTH; |
|
806
|
|
|
|
|
|
|
} |
|
807
|
|
|
|
|
|
|
my ($errcode, $errname, $errstr) = $ssh->error; |
|
808
|
|
|
|
|
|
|
return $self->error("Net::SSH2 error $errcode:$errname [$errstr]\nauthentication failed for user - `$user'") |
|
809
|
|
|
|
|
|
|
} |
|
810
|
|
|
|
|
|
|
1 |
|
811
|
|
|
|
|
|
|
} |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
sub max_buffer_length { |
|
814
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
my $minbufsize = 512; |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
if (defined $arg) { |
|
819
|
|
|
|
|
|
|
if ($arg =~ /^\d+$/) { |
|
820
|
|
|
|
|
|
|
$self->{maxbufsize} = $arg |
|
821
|
|
|
|
|
|
|
} else { |
|
822
|
|
|
|
|
|
|
&_carp($self, "ignoring bad Max_buffer_length " . |
|
823
|
|
|
|
|
|
|
"argument \"$arg\": it's not a positive integer"); |
|
824
|
|
|
|
|
|
|
} |
|
825
|
|
|
|
|
|
|
} |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
## Adjust up values that are too small. |
|
828
|
|
|
|
|
|
|
if ($self->{maxbufsize} < $minbufsize) { |
|
829
|
|
|
|
|
|
|
$self->{maxbufsize} = $minbufsize; |
|
830
|
|
|
|
|
|
|
} |
|
831
|
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
return $self->{maxbufsize} |
|
833
|
|
|
|
|
|
|
} |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub more_prompt { |
|
836
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
if (defined $arg) { |
|
839
|
|
|
|
|
|
|
$self->_match_check($arg); |
|
840
|
|
|
|
|
|
|
$self->{more_prompt} = $arg; |
|
841
|
|
|
|
|
|
|
} |
|
842
|
|
|
|
|
|
|
return $self->{more_prompt}; |
|
843
|
|
|
|
|
|
|
} |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
sub normalize_cmd { |
|
846
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
847
|
|
|
|
|
|
|
$self->{normalize_cmd} = $arg if defined $arg; |
|
848
|
|
|
|
|
|
|
return $self->{normalize_cmd} |
|
849
|
|
|
|
|
|
|
} |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
sub ofs { &output_field_separator; } |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
sub open { |
|
854
|
|
|
|
|
|
|
my ($self, @args) = @_; |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
return 1 if $self->{opened}; |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
my $ssh = $self->{_SSH_}; |
|
859
|
|
|
|
|
|
|
my $family = $self->{peer_family}; |
|
860
|
|
|
|
|
|
|
my $fh = $self->{fh_open}; |
|
861
|
|
|
|
|
|
|
my $host = $self->{host}; |
|
862
|
|
|
|
|
|
|
my $port = $self->{port}; |
|
863
|
|
|
|
|
|
|
my $timeout = $self->{time_out}; |
|
864
|
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
my $arg_errmode = &_extract_arg_errmode($self, \@args); |
|
868
|
|
|
|
|
|
|
local $self->{errormode} = $arg_errmode if $arg_errmode; |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
if (@_ == 2) { |
|
871
|
|
|
|
|
|
|
($host) = $_[1] |
|
872
|
|
|
|
|
|
|
} else { |
|
873
|
|
|
|
|
|
|
my %args = @args; |
|
874
|
|
|
|
|
|
|
for (keys(%args)) { |
|
875
|
|
|
|
|
|
|
if (/^-?fhopen$/i) { |
|
876
|
|
|
|
|
|
|
$fh = $args{$_} |
|
877
|
|
|
|
|
|
|
} elsif (/^-?host$/i) { |
|
878
|
|
|
|
|
|
|
$host = $args{$_} |
|
879
|
|
|
|
|
|
|
} elsif (/^-?family$/i) { |
|
880
|
|
|
|
|
|
|
$family = _parse_family($self, $args{$_}) |
|
881
|
|
|
|
|
|
|
} elsif (/^-?port$/i) { |
|
882
|
|
|
|
|
|
|
$port = _parse_port($self, $args{$_}) |
|
883
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
884
|
|
|
|
|
|
|
$timeout = _parse_timeout($self, $args{$_}) |
|
885
|
|
|
|
|
|
|
} else { |
|
886
|
|
|
|
|
|
|
# pass through |
|
887
|
|
|
|
|
|
|
#$params{$_} = $args{$_} |
|
888
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given ", |
|
889
|
|
|
|
|
|
|
"to " . ref($self) . "::connect()"); |
|
890
|
|
|
|
|
|
|
} |
|
891
|
|
|
|
|
|
|
} |
|
892
|
|
|
|
|
|
|
} |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
local $self->{time_out} = $timeout; |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
my $r; |
|
897
|
|
|
|
|
|
|
# IO::Socket object provided |
|
898
|
|
|
|
|
|
|
if (defined $fh) { |
|
899
|
|
|
|
|
|
|
$r = $ssh->connect($fh) |
|
900
|
|
|
|
|
|
|
# host provided |
|
901
|
|
|
|
|
|
|
} else { |
|
902
|
|
|
|
|
|
|
# resolve |
|
903
|
|
|
|
|
|
|
if (defined(my $res = _resolv($self, $host, _parse_family_to_num($self, $family)))) { |
|
904
|
|
|
|
|
|
|
$host = $res->{addr}; |
|
905
|
|
|
|
|
|
|
$port = $res->{port} || $port |
|
906
|
|
|
|
|
|
|
} else { |
|
907
|
|
|
|
|
|
|
return $self->error($self->errmsg) |
|
908
|
|
|
|
|
|
|
} |
|
909
|
|
|
|
|
|
|
# connect if IPv4 |
|
910
|
|
|
|
|
|
|
if ($family eq 'ipv4') { |
|
911
|
|
|
|
|
|
|
$r = $ssh->connect($host, $port, Timeout => $timeout) |
|
912
|
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
# if IPv6, Net::SSH2 doesn't yet support, |
|
914
|
|
|
|
|
|
|
# so need to create our own IO::Socket::IP |
|
915
|
|
|
|
|
|
|
} else { |
|
916
|
|
|
|
|
|
|
my $socket = IO::Socket::IP->new( |
|
917
|
|
|
|
|
|
|
PeerHost => $host, |
|
918
|
|
|
|
|
|
|
PeerPort => $port, |
|
919
|
|
|
|
|
|
|
Timeout => $timeout, |
|
920
|
|
|
|
|
|
|
Family => _parse_family_to_num($self, $family) |
|
921
|
|
|
|
|
|
|
); |
|
922
|
|
|
|
|
|
|
if (!$socket) { |
|
923
|
|
|
|
|
|
|
return $self->error("unable to connect to [$family] host - `$host:$port'") |
|
924
|
|
|
|
|
|
|
} |
|
925
|
|
|
|
|
|
|
$r = $ssh->connect($socket); |
|
926
|
|
|
|
|
|
|
} |
|
927
|
|
|
|
|
|
|
} |
|
928
|
|
|
|
|
|
|
if (! $r) { |
|
929
|
|
|
|
|
|
|
my ($errcode, $errname, $errstr) = $ssh->error; |
|
930
|
|
|
|
|
|
|
return $self->error("Net::SSH2 error - $errcode:$errname = $errstr\nunable to connect to host - `$host:$port'") |
|
931
|
|
|
|
|
|
|
} |
|
932
|
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
$self->{eofile} = ''; |
|
934
|
|
|
|
|
|
|
$self->{errormsg} = ""; |
|
935
|
|
|
|
|
|
|
$self->{opened} = 1; |
|
936
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
937
|
|
|
|
|
|
|
1 |
|
938
|
|
|
|
|
|
|
} |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
sub ors { &output_record_separator } |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
sub output_field_separator { |
|
943
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
944
|
|
|
|
|
|
|
$self->{ofs} = $arg if (defined $arg and length $arg); |
|
945
|
|
|
|
|
|
|
return $self->{ofs} |
|
946
|
|
|
|
|
|
|
} |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
sub output_log { |
|
949
|
|
|
|
|
|
|
my ($self, $name) = @_; |
|
950
|
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
my $fh = $self->{outputlog}; |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
if (@_ >= 2) { |
|
954
|
|
|
|
|
|
|
if (!defined($name) or $name eq "") { # input arg is "" |
|
955
|
|
|
|
|
|
|
## Turn off logging. |
|
956
|
|
|
|
|
|
|
$fh = ""; |
|
957
|
|
|
|
|
|
|
} elsif (&_is_open_fh($name)) { # input arg is an open fh |
|
958
|
|
|
|
|
|
|
## Use the open fh for logging. |
|
959
|
|
|
|
|
|
|
$fh = $name; |
|
960
|
|
|
|
|
|
|
select((select($fh), $|=1)[$[]); # don't buffer writes |
|
961
|
|
|
|
|
|
|
} elsif (!ref $name) { # input arg is filename |
|
962
|
|
|
|
|
|
|
## Open the file for logging. |
|
963
|
|
|
|
|
|
|
$fh = &_fname_to_handle($self, $name) |
|
964
|
|
|
|
|
|
|
or return; |
|
965
|
|
|
|
|
|
|
select((select($fh), $|=1)[$[]); # don't buffer writes |
|
966
|
|
|
|
|
|
|
} else { |
|
967
|
|
|
|
|
|
|
return $self->error("bad Output_log argument ", |
|
968
|
|
|
|
|
|
|
"\"$name\": not filename or open fh"); |
|
969
|
|
|
|
|
|
|
} |
|
970
|
|
|
|
|
|
|
$self->{outputlog} = $fh; |
|
971
|
|
|
|
|
|
|
} |
|
972
|
|
|
|
|
|
|
$fh; |
|
973
|
|
|
|
|
|
|
} |
|
974
|
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
sub output_record_separator { |
|
976
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
977
|
|
|
|
|
|
|
$self->{ors} = $arg if (defined $arg and length $arg); |
|
978
|
|
|
|
|
|
|
return $self->{ors} |
|
979
|
|
|
|
|
|
|
} |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
sub port { |
|
982
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
if (defined $arg) { |
|
985
|
|
|
|
|
|
|
if (defined (my $r = _parse_port($self, $arg))) { |
|
986
|
|
|
|
|
|
|
$self->{port} = $r |
|
987
|
|
|
|
|
|
|
} |
|
988
|
|
|
|
|
|
|
} |
|
989
|
|
|
|
|
|
|
return $self->{port} |
|
990
|
|
|
|
|
|
|
} |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
sub print { |
|
993
|
|
|
|
|
|
|
my ($self) = shift; |
|
994
|
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
return $self->error("write error: filehandle isn't open") |
|
998
|
|
|
|
|
|
|
unless $self->{opened}; |
|
999
|
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
## Add field and record separators. |
|
1001
|
|
|
|
|
|
|
my $buf = join($self->{"ofs"}, @_) . $self->{"ors"}; |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
if ($self->{outputlog}) { |
|
1004
|
|
|
|
|
|
|
&_log_print($self->{outputlog}, $buf); |
|
1005
|
|
|
|
|
|
|
} |
|
1006
|
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
&_put($self, \$buf, "print"); |
|
1008
|
|
|
|
|
|
|
} |
|
1009
|
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
sub prompt { |
|
1011
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
if (defined $arg) { |
|
1014
|
|
|
|
|
|
|
if (defined (my $r = _parse_prompt($self, $arg))) { |
|
1015
|
|
|
|
|
|
|
$self->{cmd_prompt} = $r |
|
1016
|
|
|
|
|
|
|
} |
|
1017
|
|
|
|
|
|
|
} |
|
1018
|
|
|
|
|
|
|
return $self->{cmd_prompt} |
|
1019
|
|
|
|
|
|
|
} |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
sub put { |
|
1022
|
|
|
|
|
|
|
my ($self, @args) = @_; |
|
1023
|
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
local $_; |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
my $binmode = $self->{bin_mode}; |
|
1027
|
|
|
|
|
|
|
my $timeout = $self->{time_out}; |
|
1028
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
my $arg_errmode = &_extract_arg_errmode($self, \@args); |
|
1031
|
|
|
|
|
|
|
local $self->{errormode} = $arg_errmode if $arg_errmode; |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
my $buf; |
|
1034
|
|
|
|
|
|
|
if (@_ == 2) { |
|
1035
|
|
|
|
|
|
|
$buf = $_[1]; |
|
1036
|
|
|
|
|
|
|
} elsif (@_ > 2) { |
|
1037
|
|
|
|
|
|
|
my (undef, %args) = @_; |
|
1038
|
|
|
|
|
|
|
foreach (keys %args) { |
|
1039
|
|
|
|
|
|
|
if (/^-?binmode$/i) { |
|
1040
|
|
|
|
|
|
|
$binmode = $args{$_}; |
|
1041
|
|
|
|
|
|
|
} elsif (/^-?string$/i) { |
|
1042
|
|
|
|
|
|
|
$buf = $args{$_}; |
|
1043
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
1044
|
|
|
|
|
|
|
$timeout = &_parse_timeout($self, $args{$_}); |
|
1045
|
|
|
|
|
|
|
} else { |
|
1046
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given ", |
|
1047
|
|
|
|
|
|
|
"to " . ref($self) . "::put()"); |
|
1048
|
|
|
|
|
|
|
} |
|
1049
|
|
|
|
|
|
|
} |
|
1050
|
|
|
|
|
|
|
} |
|
1051
|
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
## If any args given, override corresponding instance data. |
|
1053
|
|
|
|
|
|
|
local $self->{bin_mode} = $binmode; |
|
1054
|
|
|
|
|
|
|
local $self->{time_out} = $timeout; |
|
1055
|
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
## Check for errors. |
|
1057
|
|
|
|
|
|
|
return $self->error("write error: filehandle isn't open") |
|
1058
|
|
|
|
|
|
|
unless $self->{opened}; |
|
1059
|
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
if ($self->{outputlog}) { |
|
1061
|
|
|
|
|
|
|
&_log_print($self->{outputlog}, $buf); |
|
1062
|
|
|
|
|
|
|
} |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
&_put($self, \$buf, "put"); |
|
1065
|
|
|
|
|
|
|
} |
|
1066
|
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
sub rs { &input_record_separator } |
|
1068
|
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
sub send_wakeup { |
|
1070
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1071
|
|
|
|
|
|
|
$self->{send_wakeup} = $arg if defined $arg; |
|
1072
|
|
|
|
|
|
|
return $self->{send_wakeup} |
|
1073
|
|
|
|
|
|
|
} |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
sub sock { |
|
1076
|
|
|
|
|
|
|
my $self = shift; |
|
1077
|
|
|
|
|
|
|
exists $self->{_SSH_} ? $self->{_SSH_}->sock : undef |
|
1078
|
|
|
|
|
|
|
} |
|
1079
|
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
sub ssh2 { |
|
1081
|
|
|
|
|
|
|
my $self = shift; |
|
1082
|
|
|
|
|
|
|
exists $self->{_SSH_} ? $self->{_SSH_} : undef |
|
1083
|
|
|
|
|
|
|
} |
|
1084
|
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
sub ssh2_chan { |
|
1086
|
|
|
|
|
|
|
my $self = shift; |
|
1087
|
|
|
|
|
|
|
exists $self->{_SSH_CHAN_} ? $self->{_SSH_CHAN_} : undef |
|
1088
|
|
|
|
|
|
|
} |
|
1089
|
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
sub timed_out { |
|
1091
|
|
|
|
|
|
|
my $self = shift; |
|
1092
|
|
|
|
|
|
|
exists $self->{timedout} ? $self->{timedout} : undef |
|
1093
|
|
|
|
|
|
|
} |
|
1094
|
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
sub timeout { |
|
1096
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1097
|
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
if (defined $arg) { |
|
1099
|
|
|
|
|
|
|
if (defined (my $r = _parse_timeout($self, $arg))) { |
|
1100
|
|
|
|
|
|
|
$self->{time_out} = $r |
|
1101
|
|
|
|
|
|
|
} |
|
1102
|
|
|
|
|
|
|
} |
|
1103
|
|
|
|
|
|
|
return $self->{time_out} |
|
1104
|
|
|
|
|
|
|
} |
|
1105
|
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
sub waitfor { |
|
1107
|
|
|
|
|
|
|
my ($self, @args) = @_; |
|
1108
|
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
my $ap = $self->{autopage}; |
|
1110
|
|
|
|
|
|
|
my $awfp = $self->{always_waitfor_prompt}; |
|
1111
|
|
|
|
|
|
|
my $binmode = $self->{bin_mode}; |
|
1112
|
|
|
|
|
|
|
my $chan = $self->{_SSH_CHAN_}; |
|
1113
|
|
|
|
|
|
|
my $clear = $self->{waitfor_clear}; |
|
1114
|
|
|
|
|
|
|
my $cmd = $self->{last_cmd}; |
|
1115
|
|
|
|
|
|
|
my $rm = $self->{cmd_rm_mode}; |
|
1116
|
|
|
|
|
|
|
my $timeout = $self->{time_out}; |
|
1117
|
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
if (!defined $chan) { |
|
1119
|
|
|
|
|
|
|
&_croak($self, "no login " . |
|
1120
|
|
|
|
|
|
|
"for " . ref($self) . "::waitfor()"); |
|
1121
|
|
|
|
|
|
|
} |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
local $@; |
|
1124
|
|
|
|
|
|
|
local $_; |
|
1125
|
|
|
|
|
|
|
my $DONE = 0; |
|
1126
|
|
|
|
|
|
|
my $MORE = _prep_regex($self->{more_prompt}); |
|
1127
|
|
|
|
|
|
|
my $PROMPT = _prep_regex($self->{cmd_prompt}); |
|
1128
|
|
|
|
|
|
|
my ($match, $buffer, $errmode); |
|
1129
|
|
|
|
|
|
|
my @matches; |
|
1130
|
|
|
|
|
|
|
if ($awfp) { |
|
1131
|
|
|
|
|
|
|
push @matches, $PROMPT |
|
1132
|
|
|
|
|
|
|
} |
|
1133
|
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
$self->{timedout} = ''; |
|
1135
|
|
|
|
|
|
|
return if $self->{eofile}; |
|
1136
|
|
|
|
|
|
|
return unless @args; |
|
1137
|
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
if (@_ == 2) { |
|
1139
|
|
|
|
|
|
|
push @matches, _prep_regex($_[1]) |
|
1140
|
|
|
|
|
|
|
} else { |
|
1141
|
|
|
|
|
|
|
my $arg; |
|
1142
|
|
|
|
|
|
|
while (($_, $arg) = splice @args, 0, 2 ) { |
|
1143
|
|
|
|
|
|
|
if (/^-?binmode$/i) { |
|
1144
|
|
|
|
|
|
|
$binmode = $arg |
|
1145
|
|
|
|
|
|
|
} elsif (/^-?errmode$/i) { |
|
1146
|
|
|
|
|
|
|
$errmode = &_parse_errmode($self, $arg); |
|
1147
|
|
|
|
|
|
|
} elsif (/^-?match$/i) { |
|
1148
|
|
|
|
|
|
|
push @matches, _prep_regex($arg) |
|
1149
|
|
|
|
|
|
|
} elsif (/^-?string$/i) { |
|
1150
|
|
|
|
|
|
|
$arg =~ s/'/\\'/g; # quote ticks |
|
1151
|
|
|
|
|
|
|
push @matches, $arg |
|
1152
|
|
|
|
|
|
|
} elsif (/^-?timeout$/i) { |
|
1153
|
|
|
|
|
|
|
$timeout = _parse_timeout($self, $arg) |
|
1154
|
|
|
|
|
|
|
} elsif (/^-?waitfor_clear$/i) { |
|
1155
|
|
|
|
|
|
|
$clear = $arg |
|
1156
|
|
|
|
|
|
|
} else { |
|
1157
|
|
|
|
|
|
|
# pass through |
|
1158
|
|
|
|
|
|
|
#$params{$_} = $args{$_} |
|
1159
|
|
|
|
|
|
|
&_croak($self, "bad named parameter \"$_\" given " . |
|
1160
|
|
|
|
|
|
|
"to " . ref($self) . "::waitfor()"); |
|
1161
|
|
|
|
|
|
|
} |
|
1162
|
|
|
|
|
|
|
} |
|
1163
|
|
|
|
|
|
|
} |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
local $self->{errormode} = $errmode if defined $errmode; |
|
1166
|
|
|
|
|
|
|
local $self->{waitfor_clear} = $clear; |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
eval { |
|
1169
|
|
|
|
|
|
|
local $SIG{ALRM} = sub { die "timed-out\n" }; |
|
1170
|
|
|
|
|
|
|
alarm $timeout; |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
if ($self->{waitfor_clear}) { |
|
1173
|
|
|
|
|
|
|
$chan->flush; |
|
1174
|
|
|
|
|
|
|
} |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
# Read until $DONE |
|
1177
|
|
|
|
|
|
|
while (1) { |
|
1178
|
|
|
|
|
|
|
last if $DONE; |
|
1179
|
|
|
|
|
|
|
last if $self->eof; |
|
1180
|
|
|
|
|
|
|
my $buf; |
|
1181
|
|
|
|
|
|
|
# Read chunk |
|
1182
|
|
|
|
|
|
|
while (defined (my $len = $chan->read($buf,$self->{maxbufsize}))) { |
|
1183
|
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
## Display network traffic if requested. |
|
1185
|
|
|
|
|
|
|
if ($self->{dumplog} and ($buf ne '')) { |
|
1186
|
|
|
|
|
|
|
&_log_dump('<', $self->{dumplog}, \$buf, 0, $len); |
|
1187
|
|
|
|
|
|
|
} |
|
1188
|
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
# input logging |
|
1190
|
|
|
|
|
|
|
if ($self->{inputlog}) { |
|
1191
|
|
|
|
|
|
|
&_log_print($self->{inputlog}, $buf); |
|
1192
|
|
|
|
|
|
|
} |
|
1193
|
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
# Found match then $DONE |
|
1195
|
|
|
|
|
|
|
for my $m (@matches) { |
|
1196
|
|
|
|
|
|
|
if ($buf =~ /($m)/) { |
|
1197
|
|
|
|
|
|
|
$match = $1; |
|
1198
|
|
|
|
|
|
|
$buf =~ s/$m//; |
|
1199
|
|
|
|
|
|
|
$DONE++ |
|
1200
|
|
|
|
|
|
|
} |
|
1201
|
|
|
|
|
|
|
} |
|
1202
|
|
|
|
|
|
|
# autopage |
|
1203
|
|
|
|
|
|
|
if ($ap and ($buf =~ /($MORE)/)) { |
|
1204
|
|
|
|
|
|
|
#$buf =~ s/$MORE//g; |
|
1205
|
|
|
|
|
|
|
$self->put(" "); |
|
1206
|
|
|
|
|
|
|
} |
|
1207
|
|
|
|
|
|
|
$buffer .= $buf |
|
1208
|
|
|
|
|
|
|
} |
|
1209
|
|
|
|
|
|
|
} |
|
1210
|
|
|
|
|
|
|
}; |
|
1211
|
|
|
|
|
|
|
alarm 0; |
|
1212
|
|
|
|
|
|
|
if ($@ =~ /^timed-out$/) { |
|
1213
|
|
|
|
|
|
|
$self->errmsg("timed-out during read"); |
|
1214
|
|
|
|
|
|
|
$self->{timedout} = 1; |
|
1215
|
|
|
|
|
|
|
# If previous call to waitfor timed out, there may still be |
|
1216
|
|
|
|
|
|
|
# stuff in the channel - e.g., "show run" takes time to "build |
|
1217
|
|
|
|
|
|
|
# configuration" and that may time out, but the output will fill |
|
1218
|
|
|
|
|
|
|
# the channel after the return and if term length is a finite |
|
1219
|
|
|
|
|
|
|
# value - like the default 24 - a MORE prompt is waiting. So |
|
1220
|
|
|
|
|
|
|
# we need to send a character to cancel that; otherwise, the first |
|
1221
|
|
|
|
|
|
|
# character of the subsequent $chan->write() (usually from cmd()) |
|
1222
|
|
|
|
|
|
|
# will "disappear" from the output - satisfying the MORE prompt |
|
1223
|
|
|
|
|
|
|
# and being lost forever. |
|
1224
|
|
|
|
|
|
|
# The following is 'Control-Shift-Z', which breaks a MORE and |
|
1225
|
|
|
|
|
|
|
# returns the prompt. |
|
1226
|
|
|
|
|
|
|
#$chan->write("\cZ") |
|
1227
|
|
|
|
|
|
|
if ($self->{waitfor_clear}) { |
|
1228
|
|
|
|
|
|
|
$self->ios_break("Z") |
|
1229
|
|
|
|
|
|
|
} |
|
1230
|
|
|
|
|
|
|
} |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
if (defined $match and ($match =~ /$PROMPT/)) { |
|
1233
|
|
|
|
|
|
|
$self->{last_prompt} = $match |
|
1234
|
|
|
|
|
|
|
} |
|
1235
|
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
wantarray ? ($buffer, $match) : 1; |
|
1237
|
|
|
|
|
|
|
} |
|
1238
|
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
sub waitfor_clear { |
|
1240
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1241
|
|
|
|
|
|
|
$self->{waitfor_clear} = $arg if defined $arg; |
|
1242
|
|
|
|
|
|
|
return $self->{waitfor_clear} |
|
1243
|
|
|
|
|
|
|
} |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
sub waitfor_pause { |
|
1246
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1247
|
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
if (defined $arg) { |
|
1249
|
|
|
|
|
|
|
if (defined (my $r = _parse_waitfor_pause($self, $arg))) { |
|
1250
|
|
|
|
|
|
|
$self->{waitfor_pause} = $r |
|
1251
|
|
|
|
|
|
|
} |
|
1252
|
|
|
|
|
|
|
} |
|
1253
|
|
|
|
|
|
|
return $self->{waitfor_pause} |
|
1254
|
|
|
|
|
|
|
} |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
#### PRIVATE #### |
|
1257
|
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
sub _append_lineno { |
|
1259
|
|
|
|
|
|
|
my ($obj, @msgs) = @_; |
|
1260
|
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
my ( $file, $line, $pkg); |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
## Find the caller that's not in object's class or one of its base classes. |
|
1264
|
|
|
|
|
|
|
($pkg, $file , $line) = &_user_caller($obj); |
|
1265
|
|
|
|
|
|
|
join("", @msgs, " at ", $file, " line ", $line, "\n"); |
|
1266
|
|
|
|
|
|
|
} |
|
1267
|
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
sub _carp { |
|
1269
|
|
|
|
|
|
|
my ($self) = @_; |
|
1270
|
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
$self->{errormsg} = &_append_lineno(@_); |
|
1272
|
|
|
|
|
|
|
warn $self->{errormsg}, "\n"; |
|
1273
|
|
|
|
|
|
|
} |
|
1274
|
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
sub _croak { |
|
1276
|
|
|
|
|
|
|
my ($self) = @_; |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
$self->{errormsg} = &_append_lineno(@_); |
|
1279
|
|
|
|
|
|
|
die $self->{errormsg}, "\n"; |
|
1280
|
|
|
|
|
|
|
} |
|
1281
|
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
sub _extract_arg_errmode { |
|
1283
|
|
|
|
|
|
|
my ($self, $args) = @_; |
|
1284
|
|
|
|
|
|
|
my (%args); |
|
1285
|
|
|
|
|
|
|
local $_; |
|
1286
|
|
|
|
|
|
|
my $errmode = ''; |
|
1287
|
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
## Check for named parameters. |
|
1289
|
|
|
|
|
|
|
return '' unless @$args >= 2; |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
## Rebuild args without errmode parameter. |
|
1292
|
|
|
|
|
|
|
%args = @$args; |
|
1293
|
|
|
|
|
|
|
@$args = (); |
|
1294
|
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
## Extract errmode arg. |
|
1296
|
|
|
|
|
|
|
foreach (keys %args) { |
|
1297
|
|
|
|
|
|
|
if (/^-?errmode$/i) { |
|
1298
|
|
|
|
|
|
|
$errmode = &_parse_errmode($self, $args{$_}); |
|
1299
|
|
|
|
|
|
|
} else { |
|
1300
|
|
|
|
|
|
|
push @$args, $_, $args{$_}; |
|
1301
|
|
|
|
|
|
|
} |
|
1302
|
|
|
|
|
|
|
} |
|
1303
|
|
|
|
|
|
|
$errmode; |
|
1304
|
|
|
|
|
|
|
} |
|
1305
|
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
sub _fname_to_handle { |
|
1307
|
|
|
|
|
|
|
my ($self, $filename) = @_; |
|
1308
|
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
no strict "refs"; |
|
1310
|
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
my $fh = &_new_handle(); |
|
1312
|
|
|
|
|
|
|
CORE::open $fh, ">", $filename |
|
1313
|
|
|
|
|
|
|
or return $self->error("problem creating $filename: $!"); |
|
1314
|
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
$fh; |
|
1316
|
|
|
|
|
|
|
} |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
sub _is_open_fh { |
|
1319
|
|
|
|
|
|
|
my ($fh) = @_; |
|
1320
|
|
|
|
|
|
|
my $is_open = ''; |
|
1321
|
|
|
|
|
|
|
local $@; |
|
1322
|
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
eval { |
|
1324
|
|
|
|
|
|
|
local $SIG{"__DIE__"} = "DEFAULT"; |
|
1325
|
|
|
|
|
|
|
$is_open = defined(fileno $fh); |
|
1326
|
|
|
|
|
|
|
}; |
|
1327
|
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
$is_open; |
|
1329
|
|
|
|
|
|
|
} |
|
1330
|
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
sub _log_dump { |
|
1332
|
|
|
|
|
|
|
my ($direction, $fh, $data, $offset, $len) = @_; |
|
1333
|
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
my $addr = 0; |
|
1335
|
|
|
|
|
|
|
$len = length($$data) - $offset |
|
1336
|
|
|
|
|
|
|
if !defined $len; |
|
1337
|
|
|
|
|
|
|
return 1 if $len <= 0; |
|
1338
|
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
my ($hexvals, $line); |
|
1340
|
|
|
|
|
|
|
## Print data in dump format. |
|
1341
|
|
|
|
|
|
|
while ($len > 0) { |
|
1342
|
|
|
|
|
|
|
## Convert up to the next 16 chars to hex, padding w/ spaces. |
|
1343
|
|
|
|
|
|
|
if ($len >= 16) { |
|
1344
|
|
|
|
|
|
|
$line = substr $$data, $offset, 16; |
|
1345
|
|
|
|
|
|
|
} else { |
|
1346
|
|
|
|
|
|
|
$line = substr $$data, $offset, 16; |
|
1347
|
|
|
|
|
|
|
} |
|
1348
|
|
|
|
|
|
|
$hexvals = unpack("H*", $line); |
|
1349
|
|
|
|
|
|
|
$hexvals .= ' ' x (32 - length $hexvals); |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
## Place in 16 columns, each containing two hex digits. |
|
1352
|
|
|
|
|
|
|
$hexvals = sprintf("%s %s %s %s " x 4, unpack("a2" x 16, $hexvals)); |
|
1353
|
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
## For the ASCII column, change unprintable chars to a period. |
|
1355
|
|
|
|
|
|
|
$line =~ s/[\000-\037,\177-\237]/./g; |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
## Print the line in dump format. |
|
1358
|
|
|
|
|
|
|
&_log_print($fh, sprintf("%s 0x%5.5lx: %s%s\n", |
|
1359
|
|
|
|
|
|
|
$direction, $addr, $hexvals, $line)); |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
$addr += 16; |
|
1362
|
|
|
|
|
|
|
$offset += 16; |
|
1363
|
|
|
|
|
|
|
$len -= 16; |
|
1364
|
|
|
|
|
|
|
} |
|
1365
|
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
&_log_print($fh, "\n"); |
|
1367
|
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
1; |
|
1369
|
|
|
|
|
|
|
} |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
sub _log_print { |
|
1372
|
|
|
|
|
|
|
my ($fh, $buf) = @_; |
|
1373
|
|
|
|
|
|
|
local $\ = ''; |
|
1374
|
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
if (ref($fh) eq "GLOB") { # fh is GLOB ref |
|
1376
|
|
|
|
|
|
|
print $fh $buf; |
|
1377
|
|
|
|
|
|
|
} else { # fh isn't GLOB ref |
|
1378
|
|
|
|
|
|
|
$fh->print($buf); |
|
1379
|
|
|
|
|
|
|
} |
|
1380
|
|
|
|
|
|
|
} |
|
1381
|
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
sub _match_check { |
|
1383
|
|
|
|
|
|
|
my ($self, $code) = @_; |
|
1384
|
|
|
|
|
|
|
my $error; |
|
1385
|
|
|
|
|
|
|
my @warns = (); |
|
1386
|
|
|
|
|
|
|
local $@; |
|
1387
|
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
## Use eval to check for syntax errors or warnings. |
|
1389
|
|
|
|
|
|
|
{ |
|
1390
|
|
|
|
|
|
|
local $SIG{"__DIE__"} = "DEFAULT"; |
|
1391
|
|
|
|
|
|
|
local $SIG{"__WARN__"} = sub { push @warns, @_ }; |
|
1392
|
|
|
|
|
|
|
local $^W = 1; |
|
1393
|
|
|
|
|
|
|
local $_ = ''; |
|
1394
|
|
|
|
|
|
|
eval "\$_ =~ $code;"; |
|
1395
|
|
|
|
|
|
|
} |
|
1396
|
|
|
|
|
|
|
if ($@) { |
|
1397
|
|
|
|
|
|
|
## Remove useless lines numbers from message. |
|
1398
|
|
|
|
|
|
|
($error = $@) =~ s/ at \(eval \d+\) line \d+.?//; |
|
1399
|
|
|
|
|
|
|
chomp $error; |
|
1400
|
|
|
|
|
|
|
return $self->error("bad match operator: $error"); |
|
1401
|
|
|
|
|
|
|
} elsif (@warns) { |
|
1402
|
|
|
|
|
|
|
## Remove useless lines numbers from message. |
|
1403
|
|
|
|
|
|
|
($error = shift @warns) =~ s/ at \(eval \d+\) line \d+.?//; |
|
1404
|
|
|
|
|
|
|
$error =~ s/ while "strict subs" in use//; |
|
1405
|
|
|
|
|
|
|
chomp $error; |
|
1406
|
|
|
|
|
|
|
return $self->error("bad match operator: $error"); |
|
1407
|
|
|
|
|
|
|
} |
|
1408
|
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
1; |
|
1410
|
|
|
|
|
|
|
} |
|
1411
|
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
sub _new_handle { |
|
1413
|
|
|
|
|
|
|
if ($INC{"IO/Handle.pm"}) { |
|
1414
|
|
|
|
|
|
|
return IO::Handle->new; |
|
1415
|
|
|
|
|
|
|
} else { |
|
1416
|
|
|
|
|
|
|
require FileHandle; |
|
1417
|
|
|
|
|
|
|
return FileHandle->new; |
|
1418
|
|
|
|
|
|
|
} |
|
1419
|
|
|
|
|
|
|
} |
|
1420
|
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
sub _normalize { |
|
1422
|
|
|
|
|
|
|
$_ = join "", @_; |
|
1423
|
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
1 while s/[^\cH\c?][\cH\c?]//mg; # ^H ^? |
|
1425
|
|
|
|
|
|
|
s/^.*\cU//mg; # ^U |
|
1426
|
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
return wantarray ? split /$/m, $_ : $_; # ORS instead? |
|
1428
|
|
|
|
|
|
|
} |
|
1429
|
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
sub _parse_cmd_remove_mode { |
|
1431
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1432
|
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
my $crm; |
|
1434
|
|
|
|
|
|
|
if ($arg =~ /^\d+$/) { |
|
1435
|
|
|
|
|
|
|
$crm = $arg |
|
1436
|
|
|
|
|
|
|
} elsif ($arg =~ /^\s*auto\s*$/i) { |
|
1437
|
|
|
|
|
|
|
$crm = "auto" |
|
1438
|
|
|
|
|
|
|
} else { |
|
1439
|
|
|
|
|
|
|
&_carp($self, "ignoring bad Cmd_remove_mode " . |
|
1440
|
|
|
|
|
|
|
"argument \"$arg\": it's not \"auto\" or a " . |
|
1441
|
|
|
|
|
|
|
"non-negative integer"); |
|
1442
|
|
|
|
|
|
|
$crm = $self->{cmd_rm_mode} |
|
1443
|
|
|
|
|
|
|
} |
|
1444
|
|
|
|
|
|
|
$crm |
|
1445
|
|
|
|
|
|
|
} |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
sub _parse_errmode { |
|
1448
|
|
|
|
|
|
|
my ($self, $errmode) = @_; |
|
1449
|
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
## Set the error mode. |
|
1451
|
|
|
|
|
|
|
if (!defined $errmode) { |
|
1452
|
|
|
|
|
|
|
&_carp($self, "ignoring undefined Errmode argument"); |
|
1453
|
|
|
|
|
|
|
$errmode = $self->{errormode}; |
|
1454
|
|
|
|
|
|
|
} elsif ($errmode =~ /^\s*return\s*$/i) { |
|
1455
|
|
|
|
|
|
|
$errmode = "return"; |
|
1456
|
|
|
|
|
|
|
} elsif ($errmode =~ /^\s*die\s*$/i) { |
|
1457
|
|
|
|
|
|
|
$errmode = "die"; |
|
1458
|
|
|
|
|
|
|
} elsif (ref($errmode) eq "CODE") { |
|
1459
|
|
|
|
|
|
|
} elsif (ref($errmode) eq "ARRAY") { |
|
1460
|
|
|
|
|
|
|
unless (ref($errmode->[0]) eq "CODE") { |
|
1461
|
|
|
|
|
|
|
&_carp($self, "ignoring bad Errmode argument: " . |
|
1462
|
|
|
|
|
|
|
"first list item isn't a code ref"); |
|
1463
|
|
|
|
|
|
|
$errmode = $self->{errormode}; |
|
1464
|
|
|
|
|
|
|
} |
|
1465
|
|
|
|
|
|
|
} else { |
|
1466
|
|
|
|
|
|
|
&_carp($self, "ignoring bad Errmode argument \"$errmode\""); |
|
1467
|
|
|
|
|
|
|
$errmode = $self->{errormode}; |
|
1468
|
|
|
|
|
|
|
} |
|
1469
|
|
|
|
|
|
|
$errmode; |
|
1470
|
|
|
|
|
|
|
} |
|
1471
|
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
sub _parse_family { |
|
1473
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1474
|
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
my $family; |
|
1476
|
|
|
|
|
|
|
if ($arg =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) { |
|
1477
|
|
|
|
|
|
|
if ($arg =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) { |
|
1478
|
|
|
|
|
|
|
$family = 'ipv4' # AF_INET |
|
1479
|
|
|
|
|
|
|
} else { |
|
1480
|
|
|
|
|
|
|
if (!$HAVE_IO_Socket_IP) { |
|
1481
|
|
|
|
|
|
|
return $self->error("IO::Socket::IP required for IPv6") |
|
1482
|
|
|
|
|
|
|
} |
|
1483
|
|
|
|
|
|
|
$family = 'ipv6' # $AF_INET6 |
|
1484
|
|
|
|
|
|
|
} |
|
1485
|
|
|
|
|
|
|
} else { |
|
1486
|
|
|
|
|
|
|
return $self->error("bad Family argument \"$arg\": " . |
|
1487
|
|
|
|
|
|
|
"must be \"ipv4\" or \"ipv6\""); |
|
1488
|
|
|
|
|
|
|
} |
|
1489
|
|
|
|
|
|
|
$family |
|
1490
|
|
|
|
|
|
|
} |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
sub _parse_family_to_num { |
|
1493
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1494
|
|
|
|
|
|
|
if ($arg eq 'ipv4') { |
|
1495
|
|
|
|
|
|
|
return AF_INET |
|
1496
|
|
|
|
|
|
|
} elsif ($arg eq 'ipv6') { |
|
1497
|
|
|
|
|
|
|
return $AF_INET6 |
|
1498
|
|
|
|
|
|
|
} else { |
|
1499
|
|
|
|
|
|
|
return $self->error("invalid address family - `$arg'"); |
|
1500
|
|
|
|
|
|
|
} |
|
1501
|
|
|
|
|
|
|
} |
|
1502
|
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
sub _parse_port { |
|
1504
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1505
|
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
my $port; |
|
1507
|
|
|
|
|
|
|
if ($arg =~ /^\d{1,5}$/) { |
|
1508
|
|
|
|
|
|
|
if (($arg > 0) and ($arg < 65536)) { |
|
1509
|
|
|
|
|
|
|
$port = $arg |
|
1510
|
|
|
|
|
|
|
} else { |
|
1511
|
|
|
|
|
|
|
return $self->error("not a valid port - `$arg'") |
|
1512
|
|
|
|
|
|
|
} |
|
1513
|
|
|
|
|
|
|
} else { |
|
1514
|
|
|
|
|
|
|
return $self->error("port not a valid number - `$arg'") |
|
1515
|
|
|
|
|
|
|
} |
|
1516
|
|
|
|
|
|
|
$port |
|
1517
|
|
|
|
|
|
|
} |
|
1518
|
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
sub _parse_prompt { |
|
1520
|
|
|
|
|
|
|
my ($self, $prompt) = @_; |
|
1521
|
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
unless (defined $prompt) { |
|
1523
|
|
|
|
|
|
|
$prompt = ""; |
|
1524
|
|
|
|
|
|
|
} |
|
1525
|
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
return $self->error("bad Prompt argument \"$prompt\": " . |
|
1527
|
|
|
|
|
|
|
"missing opening delimiter of match operator") |
|
1528
|
|
|
|
|
|
|
unless $prompt =~ m(^\s*/) or $prompt =~ m(^\s*m\s*\W); |
|
1529
|
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
$prompt; |
|
1531
|
|
|
|
|
|
|
} |
|
1532
|
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
sub _parse_timeout { |
|
1534
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1535
|
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
my $timeout; |
|
1537
|
|
|
|
|
|
|
if ($arg =~ /^\d+$/) { |
|
1538
|
|
|
|
|
|
|
$timeout = $arg |
|
1539
|
|
|
|
|
|
|
} else { |
|
1540
|
|
|
|
|
|
|
return $self->error("not a valid timeout - `$arg'") |
|
1541
|
|
|
|
|
|
|
} |
|
1542
|
|
|
|
|
|
|
$timeout |
|
1543
|
|
|
|
|
|
|
} |
|
1544
|
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
sub _parse_waitfor_pause { |
|
1546
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
|
1547
|
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
my $wfp; |
|
1549
|
|
|
|
|
|
|
if ($arg =~ /^[0-9]*\.?[0-9]+$/) { |
|
1550
|
|
|
|
|
|
|
$wfp = $arg |
|
1551
|
|
|
|
|
|
|
} else { |
|
1552
|
|
|
|
|
|
|
return $self->error("not a valid waitfor_pause - `$arg'") |
|
1553
|
|
|
|
|
|
|
} |
|
1554
|
|
|
|
|
|
|
$wfp |
|
1555
|
|
|
|
|
|
|
} |
|
1556
|
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
sub _put { |
|
1558
|
|
|
|
|
|
|
my ($self, $buf, $subname) = @_; |
|
1559
|
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
return $self->error("write error: filehandle isn't open") |
|
1561
|
|
|
|
|
|
|
unless $self->{opened}; |
|
1562
|
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
if (exists $self->{_SSH_CHAN_}) { |
|
1564
|
|
|
|
|
|
|
my $nwrote = $self->{_SSH_CHAN_}->write($$buf); |
|
1565
|
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
## Display network traffic if requested. |
|
1567
|
|
|
|
|
|
|
if ($self->{dumplog}) { |
|
1568
|
|
|
|
|
|
|
&_log_dump('>', $self->{dumplog}, $buf, 0, $nwrote); |
|
1569
|
|
|
|
|
|
|
} |
|
1570
|
|
|
|
|
|
|
} else { |
|
1571
|
|
|
|
|
|
|
return $self->error("Net::SSH2::Channel not created") |
|
1572
|
|
|
|
|
|
|
} |
|
1573
|
|
|
|
|
|
|
1 |
|
1574
|
|
|
|
|
|
|
} |
|
1575
|
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
sub _prep_regex { |
|
1577
|
|
|
|
|
|
|
my ($regex) = @_; |
|
1578
|
|
|
|
|
|
|
# strip leading / if found |
|
1579
|
|
|
|
|
|
|
$regex =~ s/^\///; |
|
1580
|
|
|
|
|
|
|
# strip trailing / if found |
|
1581
|
|
|
|
|
|
|
$regex =~ s/\/$//; |
|
1582
|
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
return $regex |
|
1584
|
|
|
|
|
|
|
} |
|
1585
|
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
################################################## |
|
1587
|
|
|
|
|
|
|
# DNS hostname resolution |
|
1588
|
|
|
|
|
|
|
# return: |
|
1589
|
|
|
|
|
|
|
# $host->{name} = host - as passed in |
|
1590
|
|
|
|
|
|
|
# $host->{host} = host - as passed in without :port |
|
1591
|
|
|
|
|
|
|
# $host->{port} = OPTIONAL - if :port, then value of port |
|
1592
|
|
|
|
|
|
|
# $host->{addr} = resolved numeric address |
|
1593
|
|
|
|
|
|
|
# $host->{family} = AF_INET/6 |
|
1594
|
|
|
|
|
|
|
############################ |
|
1595
|
|
|
|
|
|
|
sub _resolv { |
|
1596
|
|
|
|
|
|
|
my ($self, $name, $family) = @_; |
|
1597
|
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
my %h; |
|
1599
|
|
|
|
|
|
|
$h{name} = $name; |
|
1600
|
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
# Default to IPv4 for backward compatiblity |
|
1602
|
|
|
|
|
|
|
# THIS MAY CHANGE IN THE FUTURE!!! |
|
1603
|
|
|
|
|
|
|
if (!defined $family) { |
|
1604
|
|
|
|
|
|
|
$family = AF_INET |
|
1605
|
|
|
|
|
|
|
} |
|
1606
|
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
# START - host:port |
|
1608
|
|
|
|
|
|
|
my $cnt = 0; |
|
1609
|
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
# Count ":" |
|
1611
|
|
|
|
|
|
|
$cnt++ while ($name =~ m/:/g); |
|
1612
|
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
# 0 = hostname or IPv4 address |
|
1614
|
|
|
|
|
|
|
if ($cnt == 0) { |
|
1615
|
|
|
|
|
|
|
$h{host} = $name |
|
1616
|
|
|
|
|
|
|
# 1 = IPv4 address with port |
|
1617
|
|
|
|
|
|
|
} elsif ($cnt == 1) { |
|
1618
|
|
|
|
|
|
|
($h{host}, $h{port}) = split /:/, $name |
|
1619
|
|
|
|
|
|
|
# >=2 = IPv6 address |
|
1620
|
|
|
|
|
|
|
} elsif ($cnt >= 2) { |
|
1621
|
|
|
|
|
|
|
#IPv6 with port - [2001::1]:port |
|
1622
|
|
|
|
|
|
|
if ($name =~ /^\[.*\]:\d{1,5}$/) { |
|
1623
|
|
|
|
|
|
|
($h{host}, $h{port}) = split /:([^:]+)$/, $name # split after last : |
|
1624
|
|
|
|
|
|
|
# IPv6 without port |
|
1625
|
|
|
|
|
|
|
} else { |
|
1626
|
|
|
|
|
|
|
$h{host} = $name |
|
1627
|
|
|
|
|
|
|
} |
|
1628
|
|
|
|
|
|
|
} |
|
1629
|
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
# Clean up host |
|
1631
|
|
|
|
|
|
|
$h{host} =~ s/\[//g; |
|
1632
|
|
|
|
|
|
|
$h{host} =~ s/\]//g; |
|
1633
|
|
|
|
|
|
|
# Clean up port |
|
1634
|
|
|
|
|
|
|
if (defined $h{port} && (($h{port} !~ /^\d{1,5}$/) || ($h{port} < 1) || ($h{port} > 65535))) { |
|
1635
|
|
|
|
|
|
|
$self->errmsg("Invalid port `$h{port}' in `$name'"); |
|
1636
|
|
|
|
|
|
|
return undef |
|
1637
|
|
|
|
|
|
|
} |
|
1638
|
|
|
|
|
|
|
# END - host:port |
|
1639
|
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
# address check |
|
1641
|
|
|
|
|
|
|
# new way |
|
1642
|
|
|
|
|
|
|
if ($Socket::VERSION >= 1.94) { |
|
1643
|
|
|
|
|
|
|
my %hints = ( |
|
1644
|
|
|
|
|
|
|
family => $AF_UNSPEC, |
|
1645
|
|
|
|
|
|
|
protocol => IPPROTO_TCP, |
|
1646
|
|
|
|
|
|
|
flags => $AI_NUMERICHOST |
|
1647
|
|
|
|
|
|
|
); |
|
1648
|
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
# numeric address, return |
|
1650
|
|
|
|
|
|
|
my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints); |
|
1651
|
|
|
|
|
|
|
if (defined $getaddr[0]) { |
|
1652
|
|
|
|
|
|
|
$h{addr} = $h{host}; |
|
1653
|
|
|
|
|
|
|
$h{family} = $getaddr[0]->{family}; |
|
1654
|
|
|
|
|
|
|
return \%h |
|
1655
|
|
|
|
|
|
|
} |
|
1656
|
|
|
|
|
|
|
# old way |
|
1657
|
|
|
|
|
|
|
} else { |
|
1658
|
|
|
|
|
|
|
# numeric address, return |
|
1659
|
|
|
|
|
|
|
my $ret = gethostbyname($h{host}); |
|
1660
|
|
|
|
|
|
|
if (defined $ret && (inet_ntoa($ret) eq $h{host})) { |
|
1661
|
|
|
|
|
|
|
$h{addr} = $h{host}; |
|
1662
|
|
|
|
|
|
|
$h{family} = AF_INET; |
|
1663
|
|
|
|
|
|
|
return \%h |
|
1664
|
|
|
|
|
|
|
} |
|
1665
|
|
|
|
|
|
|
} |
|
1666
|
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
# resolve |
|
1668
|
|
|
|
|
|
|
# new way |
|
1669
|
|
|
|
|
|
|
if ($Socket::VERSION >= 1.94) { |
|
1670
|
|
|
|
|
|
|
my %hints = ( |
|
1671
|
|
|
|
|
|
|
family => $family, |
|
1672
|
|
|
|
|
|
|
protocol => IPPROTO_TCP |
|
1673
|
|
|
|
|
|
|
); |
|
1674
|
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints); |
|
1676
|
|
|
|
|
|
|
if (defined $getaddr[0]) { |
|
1677
|
|
|
|
|
|
|
my ($err, $address) = Socket::getnameinfo($getaddr[0]->{addr}, $NI_NUMERICHOST); |
|
1678
|
|
|
|
|
|
|
if (defined $address) { |
|
1679
|
|
|
|
|
|
|
$h{addr} = $address; |
|
1680
|
|
|
|
|
|
|
$h{addr} =~ s/\%(.)*$//; # remove %ifID if IPv6 |
|
1681
|
|
|
|
|
|
|
$h{family} = $getaddr[0]->{family}; |
|
1682
|
|
|
|
|
|
|
return \%h |
|
1683
|
|
|
|
|
|
|
} else { |
|
1684
|
|
|
|
|
|
|
$self->errmsg("getnameinfo($getaddr[0]->{addr}) failed - $err"); |
|
1685
|
|
|
|
|
|
|
return undef |
|
1686
|
|
|
|
|
|
|
} |
|
1687
|
|
|
|
|
|
|
} else { |
|
1688
|
|
|
|
|
|
|
my $LASTERROR = sprintf "getaddrinfo($h{host},,%s) failed - $err", ($family == AF_INET) ? "AF_INET" : "AF_INET6"; |
|
1689
|
|
|
|
|
|
|
$self->errmsg($LASTERROR); |
|
1690
|
|
|
|
|
|
|
return undef |
|
1691
|
|
|
|
|
|
|
} |
|
1692
|
|
|
|
|
|
|
# old way |
|
1693
|
|
|
|
|
|
|
} else { |
|
1694
|
|
|
|
|
|
|
if ($family == $AF_INET6) { |
|
1695
|
|
|
|
|
|
|
$self->errmsg("Socket >= 1.94 required for IPv6 - found Socket $Socket::VERSION"); |
|
1696
|
|
|
|
|
|
|
return undef |
|
1697
|
|
|
|
|
|
|
} |
|
1698
|
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
my @gethost = gethostbyname($h{host}); |
|
1700
|
|
|
|
|
|
|
if (defined $gethost[4]) { |
|
1701
|
|
|
|
|
|
|
$h{addr} = inet_ntoa($gethost[4]); |
|
1702
|
|
|
|
|
|
|
$h{family} = AF_INET; |
|
1703
|
|
|
|
|
|
|
return \%h |
|
1704
|
|
|
|
|
|
|
} else { |
|
1705
|
|
|
|
|
|
|
$self->errmsg("gethostbyname($h{host}) failed - $^E"); |
|
1706
|
|
|
|
|
|
|
return undef |
|
1707
|
|
|
|
|
|
|
} |
|
1708
|
|
|
|
|
|
|
} |
|
1709
|
|
|
|
|
|
|
} |
|
1710
|
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
sub _user_caller { |
|
1712
|
|
|
|
|
|
|
my ($obj) = @_; |
|
1713
|
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
my ($class, $curr_pkg, $file, $i, $line, $pkg, %isa, @isa); |
|
1715
|
|
|
|
|
|
|
local $@; |
|
1716
|
|
|
|
|
|
|
local $_; |
|
1717
|
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
## Create a boolean hash to test for isa. Make sure current |
|
1719
|
|
|
|
|
|
|
## package and the object's class are members. |
|
1720
|
|
|
|
|
|
|
$class = ref $obj; |
|
1721
|
|
|
|
|
|
|
@isa = eval "\@${class}::ISA"; |
|
1722
|
|
|
|
|
|
|
push @isa, $class; |
|
1723
|
|
|
|
|
|
|
($curr_pkg) = caller 1; |
|
1724
|
|
|
|
|
|
|
push @isa, $curr_pkg; |
|
1725
|
|
|
|
|
|
|
%isa = map { $_ => 1 } @isa; |
|
1726
|
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
## Search back in call frames for a package that's not in isa. |
|
1728
|
|
|
|
|
|
|
$i = 1; |
|
1729
|
|
|
|
|
|
|
while (($pkg, $file, $line) = caller ++$i) { |
|
1730
|
|
|
|
|
|
|
next if $isa{$pkg}; |
|
1731
|
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
return ($pkg, $file, $line); |
|
1733
|
|
|
|
|
|
|
} |
|
1734
|
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
## If not found, choose outer most call frame. |
|
1736
|
|
|
|
|
|
|
($pkg, $file, $line) = caller --$i; |
|
1737
|
|
|
|
|
|
|
return ($pkg, $file, $line); |
|
1738
|
|
|
|
|
|
|
} |
|
1739
|
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
1; |
|
1741
|
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
__END__ |