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__ |