line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Telnet::Netgear; |
2
|
5
|
|
|
5
|
|
3019
|
use strict; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
167
|
|
3
|
5
|
|
|
5
|
|
19
|
use warnings; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
103
|
|
4
|
5
|
|
|
5
|
|
23
|
use warnings::register; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
586
|
|
5
|
5
|
|
|
5
|
|
2238
|
use parent 'Net::Telnet'; |
|
5
|
|
|
|
|
1258
|
|
|
5
|
|
|
|
|
20
|
|
6
|
5
|
|
|
5
|
|
194407
|
use Carp; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
300
|
|
7
|
5
|
|
|
5
|
|
29
|
use IO::Socket::INET; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
122
|
|
8
|
5
|
|
|
5
|
|
4431
|
use Net::Telnet::Netgear::Packet; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
161
|
|
9
|
5
|
|
|
5
|
|
24
|
use Scalar::Util (); |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
11349
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "0.03"; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Whether to die when 'select' is not available. (see 'THE MAGIC BEHIND TIMEOUTS') |
14
|
|
|
|
|
|
|
our $DIE_ON_SELECT_UNAVAILABLE = 0; |
15
|
|
|
|
|
|
|
our %NETGEAR_DEFAULTS = ( |
16
|
|
|
|
|
|
|
prompt => '/.* # $/', |
17
|
|
|
|
|
|
|
cmd_remove_mode => 1, |
18
|
|
|
|
|
|
|
exit_on_destroy => 1, # Calls 'exit' when the object is being destroyed |
19
|
|
|
|
|
|
|
waitfor => '/.* # $/' # Net::Telnet breaks when there are lines before the prompt |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub new |
23
|
|
|
|
|
|
|
{ |
24
|
15
|
|
|
15
|
1
|
4394
|
my $class = shift; |
25
|
|
|
|
|
|
|
# Our settings, including the default values. |
26
|
15
|
|
|
|
|
58
|
my $settings = { |
27
|
|
|
|
|
|
|
netgear_defaults => 0, |
28
|
|
|
|
|
|
|
exit_on_destroy => 0, |
29
|
|
|
|
|
|
|
packet_send_mode => "auto" |
30
|
|
|
|
|
|
|
}; |
31
|
|
|
|
|
|
|
# Packet information. Not populated when there are no named arguments. |
32
|
15
|
|
|
|
|
17
|
my %packetinfo; |
33
|
|
|
|
|
|
|
# The final packet instance. Must be a Net::Telnet::Netgear::Packet. |
34
|
|
|
|
|
|
|
my $packet; |
35
|
|
|
|
|
|
|
# The keys that make Net::Telnet open a connection in its constructor. |
36
|
0
|
|
|
|
|
0
|
my %removed_keys; |
37
|
|
|
|
|
|
|
# Parse the named arguments if there's any, but only those we care about. |
38
|
15
|
100
|
|
|
|
53
|
if (@_ > 1) |
|
|
50
|
|
|
|
|
|
39
|
|
|
|
|
|
|
{ |
40
|
10
|
|
|
|
|
32
|
my %args = @_; |
41
|
10
|
|
|
|
|
29
|
foreach (keys %args) |
42
|
|
|
|
|
|
|
{ |
43
|
|
|
|
|
|
|
# M-multiline regular expressions? W-what is this sorcery? |
44
|
14
|
50
|
|
|
|
114
|
if (/^-? # Match keys starting with '-', optionally. |
|
|
0
|
|
|
|
|
|
45
|
|
|
|
|
|
|
( # Match either keys that begin with 'packet_' and |
46
|
|
|
|
|
|
|
packet_( |
47
|
|
|
|
|
|
|
# are one of the following, |
48
|
|
|
|
|
|
|
mac|username|password|content|base64|instance|wait_timeout|delay|send_mode |
49
|
|
|
|
|
|
|
)| |
50
|
|
|
|
|
|
|
# Or keys that do not start with 'packet_' and are one of the following. |
51
|
|
|
|
|
|
|
host|fhopen |
52
|
|
|
|
|
|
|
)$ |
53
|
|
|
|
|
|
|
/xi) |
54
|
|
|
|
|
|
|
{ |
55
|
|
|
|
|
|
|
# If we matched 'packet_*' (aka: if the second group of the regexp is defined), |
56
|
|
|
|
|
|
|
# then the target variable is $packetinfo. Otherwise, it's %removed_keys. |
57
|
14
|
50
|
|
|
|
39
|
my $target = defined $2 ? \%packetinfo : \%removed_keys; |
58
|
14
|
|
33
|
|
|
67
|
$target->{lc ($2 || $1)} = $args{$_}; # Assign the matched option to the hash. |
59
|
|
|
|
|
|
|
# Delete the key, either because Net::Telnet croaks if unknown keys are detected |
60
|
|
|
|
|
|
|
# (when dealing with 'packet_*'), or because they are problematic. (see the |
61
|
|
|
|
|
|
|
# definition of %removed_keys) |
62
|
14
|
|
|
|
|
38
|
delete $args{$_}; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
# Match boolean settings not related to packets and Net::Telnet stuff. |
65
|
|
|
|
|
|
|
elsif (/^-?(netgear_defaults|exit_on_destroy)$/i) |
66
|
|
|
|
|
|
|
{ |
67
|
0
|
|
|
|
|
0
|
$settings->{lc $1} = !!$args{$_}; |
68
|
0
|
|
|
|
|
0
|
delete $args{$_}; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
# Process the packet information given by the user. |
72
|
|
|
|
|
|
|
# What? The user has given us a ::Packet instance? Jackpot! |
73
|
10
|
100
|
|
|
|
48
|
if (exists $packetinfo{instance}) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
74
|
|
|
|
|
|
|
{ |
75
|
2
|
100
|
66
|
|
|
274
|
Carp::croak "ERROR: packet_instance must be a Net::Telnet::Netgear::Packet instance" |
76
|
|
|
|
|
|
|
unless defined Scalar::Util::blessed ($packetinfo{instance}) |
77
|
|
|
|
|
|
|
and $packetinfo{instance}->isa ("Net::Telnet::Netgear::Packet"); |
78
|
1
|
|
|
|
|
4
|
$packet = $packetinfo{instance}; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
# If the user provided a MAC address... |
81
|
|
|
|
|
|
|
elsif (exists $packetinfo{mac}) |
82
|
|
|
|
|
|
|
{ |
83
|
|
|
|
|
|
|
# Pass the entire %packetinfo hash to Net::Telnet::Netgear::Packet->new. This allows to |
84
|
|
|
|
|
|
|
# avoid redundant stuff (mac => $packetinfo{mac}, brr) and unnecessary checks. |
85
|
3
|
|
|
|
|
20
|
$packet = Net::Telnet::Netgear::Packet->new (%packetinfo); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
elsif (exists $packetinfo{content}) # The following two cases are self-explanatory |
88
|
|
|
|
|
|
|
{ |
89
|
1
|
|
|
|
|
7
|
$packet = Net::Telnet::Netgear::Packet->from_string ($packetinfo{content}); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
elsif (exists $packetinfo{base64}) |
92
|
|
|
|
|
|
|
{ |
93
|
1
|
|
|
|
|
4
|
$packet = Net::Telnet::Netgear::Packet->from_base64 ($packetinfo{base64}); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
# What if the user did not supply a packet at all? Well, that means that the user does not |
96
|
|
|
|
|
|
|
# need this module, probably. Who cares? Just do our business. |
97
|
|
|
|
|
|
|
# Parse the packet send mode, if specified. |
98
|
9
|
100
|
|
|
|
24
|
if (exists $packetinfo{send_mode}) |
99
|
|
|
|
|
|
|
{ |
100
|
1
|
|
|
|
|
5
|
_sanitize_packet_send_mode ($packetinfo{send_mode}); # Croaks if it's invalid |
101
|
0
|
|
|
|
|
0
|
$settings->{packet_send_mode} = $packetinfo{send_mode}; |
102
|
|
|
|
|
|
|
} |
103
|
8
|
|
|
|
|
21
|
@_ = %args; # Magic? Nope, Perl. (hint: an hash is an unsorted array) |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
# If there's a single argument, then it's the hostname. Save it for later. |
106
|
|
|
|
|
|
|
elsif (@_ == 1) |
107
|
|
|
|
|
|
|
{ |
108
|
0
|
|
|
|
|
0
|
$removed_keys{host} = shift; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
# If there are no arguments, we are all set. |
111
|
|
|
|
|
|
|
# Create ourselves. Isn't that touching? :') |
112
|
13
|
|
|
|
|
83
|
my $self = $class->SUPER::new (@_); |
113
|
|
|
|
|
|
|
# Configure Net::Telnet::Netgear, in a Net::Telnet-esque way. (see the source of |
114
|
|
|
|
|
|
|
# "new" in Net::Telnet to understand what I'm saying) |
115
|
13
|
100
|
66
|
|
|
2167
|
*$self->{net_telnet_netgear} = { |
116
|
|
|
|
|
|
|
%$settings, |
117
|
|
|
|
|
|
|
packet => defined $packet && $packet->can ("get_packet") ? $packet->get_packet : undef, |
118
|
|
|
|
|
|
|
}; |
119
|
|
|
|
|
|
|
# Set packet_delay and packet_wait_timeout |
120
|
13
|
|
100
|
|
|
79
|
$self->packet_delay ($packetinfo{delay} // .3); # default value only if not defined (may be 0) |
121
|
12
|
|
100
|
|
|
82
|
$self->packet_wait_timeout ($packetinfo{wait_timeout} || 1); |
122
|
|
|
|
|
|
|
# Restore the keys we previously removed. |
123
|
11
|
50
|
|
|
|
49
|
if (exists $removed_keys{fhopen}) |
|
|
50
|
|
|
|
|
|
124
|
|
|
|
|
|
|
{ |
125
|
0
|
0
|
|
|
|
0
|
$self->fhopen ($removed_keys{fhopen}) || return; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
elsif (exists $removed_keys{host}) |
128
|
|
|
|
|
|
|
{ |
129
|
0
|
|
|
|
|
0
|
$self->host ($removed_keys{host}); |
130
|
0
|
0
|
|
|
|
0
|
$self->open || return; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
# We are done. |
133
|
11
|
|
|
|
|
60
|
$self; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub DESTROY |
137
|
|
|
|
|
|
|
{ |
138
|
12
|
|
|
12
|
|
1914
|
my $self = shift; |
139
|
|
|
|
|
|
|
# Try to send the 'exit' command before being destroyed, to avoid ghost shells. |
140
|
|
|
|
|
|
|
# (Yes, this is an issue in Netgear routers.) |
141
|
12
|
100
|
|
|
|
33
|
$self->cmd (string => "exit", errmode => "return") if $self->exit_on_destroy; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub open |
145
|
|
|
|
|
|
|
{ |
146
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
147
|
|
|
|
|
|
|
# If this method is being called from this package and it has '-callparent' as the first arg, |
148
|
|
|
|
|
|
|
# then execute the implementation of the superclass of it. This is a work-around, because |
149
|
|
|
|
|
|
|
# unfortunately $self->SUPER::$method does not work. :( |
150
|
0
|
0
|
0
|
|
|
0
|
return $self->SUPER::open (splice @_, 1) |
|
|
|
0
|
|
|
|
|
151
|
|
|
|
|
|
|
if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent; |
152
|
|
|
|
|
|
|
# Call our magical method. |
153
|
0
|
|
|
|
|
0
|
_open_method ($self, "open", @_); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub fhopen |
157
|
|
|
|
|
|
|
{ |
158
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
159
|
|
|
|
|
|
|
# If this method is being called from this package and it has '-callparent' as the first arg, |
160
|
|
|
|
|
|
|
# then execute the implementation of the superclass of it. This is a work-around, because |
161
|
|
|
|
|
|
|
# unfortunately $self->SUPER::$method does not work. :( |
162
|
0
|
0
|
0
|
|
|
0
|
return $self->SUPER::fhopen (splice @_, 1) |
|
|
|
0
|
|
|
|
|
163
|
|
|
|
|
|
|
if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent; |
164
|
|
|
|
|
|
|
# Call our magical method. |
165
|
0
|
|
|
|
|
0
|
_open_method ($self, "fhopen", @_); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub apply_netgear_defaults |
169
|
|
|
|
|
|
|
{ |
170
|
4
|
|
|
4
|
1
|
1935
|
my $self = shift; |
171
|
|
|
|
|
|
|
# Prefer user-provided settings, if available. |
172
|
4
|
100
|
|
|
|
17
|
local %NETGEAR_DEFAULTS = (%NETGEAR_DEFAULTS, @_) if @_ > 1; |
173
|
4
|
|
|
|
|
11
|
foreach my $k (keys %NETGEAR_DEFAULTS) |
174
|
|
|
|
|
|
|
{ |
175
|
14
|
50
|
33
|
|
|
175
|
$self->$k ($NETGEAR_DEFAULTS{$k}) if defined $NETGEAR_DEFAULTS{$k} and $self->can ($k); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Getters/setters. |
180
|
|
|
|
|
|
|
sub exit_on_destroy |
181
|
|
|
|
|
|
|
{ |
182
|
5
|
|
|
5
|
1
|
11
|
_mutator (shift, name => "exit_on_destroy", new => shift, sanitizer => sub { !!$_ }); |
|
22
|
|
|
22
|
|
453
|
|
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub packet_delay |
186
|
|
|
|
|
|
|
{ |
187
|
|
|
|
|
|
|
_mutator (shift, name => "delay", new => shift, sanitizer => sub { |
188
|
15
|
|
|
15
|
|
29
|
_sanitize_numeric_val ("packet_delay") |
189
|
16
|
|
|
16
|
1
|
360
|
}); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub packet_send_mode |
193
|
|
|
|
|
|
|
{ |
194
|
3
|
|
|
3
|
1
|
265
|
_mutator (shift, name => "packet_send_mode", new => shift, |
195
|
|
|
|
|
|
|
sanitizer => \&_sanitize_packet_send_mode); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub packet_wait_timeout |
199
|
|
|
|
|
|
|
{ |
200
|
|
|
|
|
|
|
_mutator (shift, name => "timeout", new => shift, sanitizer => sub { |
201
|
14
|
|
|
14
|
|
39
|
_sanitize_numeric_val ("packet_wait_timeout") |
202
|
15
|
|
|
15
|
1
|
57
|
}); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub packet |
206
|
|
|
|
|
|
|
{ |
207
|
10
|
|
|
10
|
1
|
1191
|
_mutator (shift, name => "packet", new => shift); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# Internal methods. |
211
|
|
|
|
|
|
|
# Handles getters and setters. Code partially taken from Net::Telnet. |
212
|
|
|
|
|
|
|
# %conf = ( |
213
|
|
|
|
|
|
|
# name => "xxx", # The name of the mutator |
214
|
|
|
|
|
|
|
# new => "yyy", # The new value. (may be undef) |
215
|
|
|
|
|
|
|
# sanitizer => CODE # A subroutine which returns a sanitized value of 'new'. |
216
|
|
|
|
|
|
|
# ) |
217
|
|
|
|
|
|
|
sub _mutator |
218
|
|
|
|
|
|
|
{ |
219
|
66
|
|
|
66
|
|
148
|
my ($self, %conf) = @_; |
220
|
66
|
|
|
|
|
86
|
my $s = *$self->{net_telnet_netgear}; |
221
|
66
|
|
|
|
|
103
|
my $prev = $s->{$conf{name}}; |
222
|
66
|
100
|
66
|
|
|
263
|
if (exists $conf{new} && defined $conf{new}) |
223
|
|
|
|
|
|
|
{ |
224
|
38
|
100
|
|
|
|
64
|
if (exists $conf{sanitizer}) |
225
|
|
|
|
|
|
|
{ |
226
|
36
|
|
|
|
|
40
|
local $_ = $conf{new}; |
227
|
36
|
|
|
|
|
67
|
$conf{new} = $conf{sanitizer}->($conf{new}, $prev); |
228
|
|
|
|
|
|
|
} |
229
|
33
|
|
|
|
|
61
|
$s->{$conf{name}} = $conf{new}; |
230
|
|
|
|
|
|
|
} |
231
|
61
|
|
|
|
|
302
|
$prev; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# Sanitizes numeric values. |
235
|
|
|
|
|
|
|
sub _sanitize_numeric_val |
236
|
|
|
|
|
|
|
{ |
237
|
29
|
|
|
29
|
|
30
|
my $param = shift; |
238
|
29
|
100
|
|
|
|
934
|
Carp::croak "ERROR: $param must be a number" |
239
|
|
|
|
|
|
|
unless /^-?\d+(?:\.\d+)?$/; |
240
|
25
|
|
|
|
|
59
|
$_; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Sanitizes the packet send mode. |
244
|
|
|
|
|
|
|
sub _sanitize_packet_send_mode |
245
|
|
|
|
|
|
|
{ |
246
|
3
|
|
|
3
|
|
5
|
my $val = shift; |
247
|
9
|
|
|
|
|
355
|
Carp::croak "ERROR: unknown packet_send_mode (must be auto, tcp or udp)" |
248
|
3
|
100
|
|
|
|
7
|
unless grep { $_ eq $val } "auto", "tcp", "udp"; |
249
|
1
|
|
|
|
|
2
|
$val; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# _can_read returns: |
253
|
|
|
|
|
|
|
# 1 if we can read. |
254
|
|
|
|
|
|
|
# 0 if we can't read (timeout reached). |
255
|
|
|
|
|
|
|
# -1 if an error occurred. |
256
|
|
|
|
|
|
|
sub _can_read |
257
|
|
|
|
|
|
|
{ |
258
|
|
|
|
|
|
|
# This is easy to implement if select is implemented, or tricky if it isn't. |
259
|
0
|
|
|
0
|
|
|
my ($self, $timeout) = @_; |
260
|
|
|
|
|
|
|
# Check if warnings are enabled. (-nowarnings as the second parameter disables warnings) |
261
|
0
|
|
0
|
|
|
|
my $should_warn = @_ < 3 || $_[2] ne -nowarnings; |
262
|
|
|
|
|
|
|
# Get access to the internals of Net::Telnet. |
263
|
0
|
|
|
|
|
|
my $net_telnet = *$self->{net_telnet}; |
264
|
|
|
|
|
|
|
# If select is supported... |
265
|
0
|
0
|
|
|
|
|
if ($net_telnet->{select_supported}) |
266
|
|
|
|
|
|
|
{ |
267
|
|
|
|
|
|
|
# Then use it! |
268
|
|
|
|
|
|
|
# The source code of Net::Telnet helped. |
269
|
0
|
|
|
|
|
|
my ($ready, $nfound); |
270
|
0
|
|
|
|
|
|
$nfound = select $ready = $net_telnet->{fdmask}, undef, undef, $timeout; |
271
|
|
|
|
|
|
|
# If $nfound is not defined or if it is less than 0, return -1 (error). |
272
|
|
|
|
|
|
|
# If it is greater than 0, return 1 (ok), otherwise 0 (timeout). |
273
|
0
|
0
|
0
|
|
|
|
return !defined $nfound || $nfound < 0 ? -1 : $nfound ? 1 : 0; |
|
|
0
|
|
|
|
|
|
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
# select is not supported. :( |
276
|
|
|
|
|
|
|
# Unfortunately, there is no other solution. Win32 does not interrupt blocking syscalls |
277
|
|
|
|
|
|
|
# (like read and sysread) with alarm, so it's useless. Let the user know. |
278
|
|
|
|
|
|
|
else |
279
|
|
|
|
|
|
|
{ |
280
|
|
|
|
|
|
|
# We have two options: die horribly and let the user know about his shitty OS, or |
281
|
|
|
|
|
|
|
# return a fake value which disables the TCP packets of this module. |
282
|
|
|
|
|
|
|
# Let the user pick... (with $DIE_ON_SELECT_UNAVAILABLE) |
283
|
0
|
0
|
|
|
|
|
my $base_msg = $DIE_ON_SELECT_UNAVAILABLE ? "ERROR" : "WARNING"; |
284
|
0
|
|
|
|
|
|
($base_msg .= <
|
285
|
|
|
|
|
|
|
: Unsupported platform detected (no select support). |
286
|
|
|
|
|
|
|
See the section 'THE MAGIC BEHIND TIMEOUTS' of the manual of Net::Telnet::Netgear. |
287
|
|
|
|
|
|
|
ERROR_MSG |
288
|
0
|
0
|
|
|
|
|
return $self->error ($base_msg . "Stopped") if $DIE_ON_SELECT_UNAVAILABLE; |
289
|
0
|
0
|
0
|
|
|
|
!$DIE_ON_SELECT_UNAVAILABLE && $should_warn && warnings::enabled() && warnings::warn ( |
|
|
|
0
|
|
|
|
|
290
|
|
|
|
|
|
|
$base_msg . "Disabling the capability of sending packets using TCP. Warned" |
291
|
|
|
|
|
|
|
); |
292
|
|
|
|
|
|
|
# NOTE: UDP packets will still work even if select is not available. |
293
|
0
|
|
|
|
|
|
return 1; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# Sends the packet over UDP. |
298
|
|
|
|
|
|
|
sub _udp_send_packet |
299
|
|
|
|
|
|
|
{ |
300
|
0
|
|
|
0
|
|
|
my $self = shift; |
301
|
0
|
|
|
|
|
|
my $s = *$self->{net_telnet_netgear}; |
302
|
|
|
|
|
|
|
# We have to use IO::Socket::INET to do this, since (obviously) Net::Telnet does not |
303
|
|
|
|
|
|
|
# support UDP. |
304
|
0
|
|
|
|
|
|
my ($host, $port) = ($self->host, $self->port); |
305
|
0
|
|
0
|
|
|
|
my $sock = IO::Socket::INET->new ( |
306
|
|
|
|
|
|
|
PeerAddr => $host, |
307
|
|
|
|
|
|
|
PeerPort => $port, |
308
|
|
|
|
|
|
|
Proto => "udp" |
309
|
|
|
|
|
|
|
) || return $self->error ("Error while creating the UDP socket for $host:$port: $!"); |
310
|
0
|
|
|
|
|
|
binmode $sock; |
311
|
0
|
0
|
|
|
|
|
$sock->send ($s->{packet}) |
312
|
|
|
|
|
|
|
|| return $self->error ("Can't send the packet to $host:$port (UDP): $!"); |
313
|
0
|
|
|
|
|
|
close $sock; |
314
|
|
|
|
|
|
|
# Wait packet_delay seconds. |
315
|
0
|
|
|
|
|
|
select undef, undef, undef, $self->packet_delay; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# The internal function used to handle the *open calls. |
319
|
|
|
|
|
|
|
sub _open_method |
320
|
|
|
|
|
|
|
{ |
321
|
0
|
|
|
0
|
|
|
my ($self, $method, @params) = @_; |
322
|
|
|
|
|
|
|
# Get access to our internals. |
323
|
0
|
|
|
|
|
|
my $s = *$self->{net_telnet_netgear}; |
324
|
|
|
|
|
|
|
# Fix 'select_supported' for older versions of Net::Telnet. |
325
|
0
|
0
|
|
|
|
|
unless (exists *$self->{net_telnet}->{select_supported}) |
326
|
|
|
|
|
|
|
{ |
327
|
|
|
|
|
|
|
# Taken from the source code of Net::Telnet 3.04, search for 'select_supported' |
328
|
0
|
0
|
0
|
|
|
|
*$self->{net_telnet}->{select_supported} = $method eq "open" ? |
329
|
|
|
|
|
|
|
1 : |
330
|
|
|
|
|
|
|
($^O ne "MSWin32" || -S $self); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
# Handle the different packet_send_mode conditions, but only when we have a packet. |
333
|
0
|
0
|
|
|
|
|
if (defined $s->{packet}) |
334
|
|
|
|
|
|
|
{ |
335
|
|
|
|
|
|
|
# If the packet send mode is "auto", then suppress connection errors, because we need to |
336
|
|
|
|
|
|
|
# check whether the connection is successful or not later. |
337
|
0
|
0
|
|
|
|
|
if ($self->packet_send_mode eq "auto") |
|
|
0
|
|
|
|
|
|
338
|
|
|
|
|
|
|
{ |
339
|
0
|
|
|
0
|
|
|
push @params, errmode => sub {}; |
|
0
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
# Otherwise, if the connection mode is "udp", then we pre-send the packet over UDP before |
342
|
|
|
|
|
|
|
# connecting. |
343
|
|
|
|
|
|
|
elsif ($self->packet_send_mode eq "udp") |
344
|
|
|
|
|
|
|
{ |
345
|
|
|
|
|
|
|
# We can't pre-send the packet if the 'host' and 'port' variables are not defined |
346
|
|
|
|
|
|
|
# correctly, so we fix that. |
347
|
0
|
0
|
|
|
|
|
if (@params == 1) |
|
|
0
|
|
|
|
|
|
348
|
|
|
|
|
|
|
{ |
349
|
0
|
|
|
|
|
|
$self->host (shift @params); |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
elsif (@params >= 2) |
352
|
|
|
|
|
|
|
{ |
353
|
0
|
|
|
|
|
|
my %args = @params; |
354
|
0
|
|
|
|
|
|
foreach (keys %args) |
355
|
|
|
|
|
|
|
{ |
356
|
0
|
0
|
|
|
|
|
if (/^-?(host|port)$/i) |
357
|
|
|
|
|
|
|
{ |
358
|
|
|
|
|
|
|
# Use the matched option as a method name. |
359
|
0
|
|
|
|
|
|
my $method = lc $1; |
360
|
0
|
|
|
|
|
|
$self->$method ($args{$_}); |
361
|
|
|
|
|
|
|
# Delete the argument to avoid redundancy. |
362
|
0
|
|
|
|
|
|
delete $args{$_}; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
} |
365
|
0
|
|
|
|
|
|
@params = %args; # Magic? Nope, Perl. (hint: an hash is an unsorted array) |
366
|
|
|
|
|
|
|
} |
367
|
0
|
|
|
|
|
|
_udp_send_packet ($self); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
# Call the original method and get the return value. |
371
|
|
|
|
|
|
|
# This does not cause infinite recursion thanks to '-callparent' and the magical check. |
372
|
|
|
|
|
|
|
# Use unshift to propagate '-callparent' to every other call. This is important!!! |
373
|
0
|
|
|
|
|
|
unshift @params, -callparent; |
374
|
0
|
|
|
|
|
|
my $v = $self->$method (@params); |
375
|
|
|
|
|
|
|
# No packet, no party. |
376
|
0
|
0
|
|
|
|
|
return $v unless defined $s->{packet}; |
377
|
0
|
0
|
0
|
|
|
|
if ($v && $self->packet_send_mode ne "udp") |
|
|
0
|
|
|
|
|
|
378
|
|
|
|
|
|
|
{ |
379
|
|
|
|
|
|
|
# It looks like the open was successful. Time to do something useful. |
380
|
|
|
|
|
|
|
# Check if we can read within the timeout. |
381
|
0
|
|
|
|
|
|
my $can_read = _can_read ($self, $s->{timeout}); |
382
|
0
|
0
|
|
|
|
|
if ($can_read == 0) # Timeout |
|
|
0
|
|
|
|
|
|
383
|
|
|
|
|
|
|
{ |
384
|
|
|
|
|
|
|
# We can't read, so this (usually) means that the router is expecting a Telnet packet. |
385
|
|
|
|
|
|
|
# Send it. |
386
|
0
|
|
|
|
|
|
$self->put (string => $s->{packet}, binmode => 1, telnetmode => 0); |
387
|
0
|
|
|
|
|
|
$self->close; |
388
|
|
|
|
|
|
|
# Wait for a bit. (it's Netgear's fault) |
389
|
0
|
|
|
|
|
|
select undef, undef, undef, $self->packet_delay; |
390
|
|
|
|
|
|
|
# Re-open. If we can't read again, then I have bad news. |
391
|
0
|
0
|
|
|
|
|
return $self->error ("Can't reopen the socket after sending the Telnet packet.") |
392
|
|
|
|
|
|
|
unless $self->$method (@params); |
393
|
0
|
0
|
|
|
|
|
return $self->error ("Can't read from the socket after sending the Telnet packet.") |
394
|
|
|
|
|
|
|
if _can_read ($self, $s->{timeout}, -nowarnings) != 1; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
elsif ($can_read == -1) # Error |
397
|
|
|
|
|
|
|
{ |
398
|
0
|
|
|
|
|
|
return $self->error ( |
399
|
|
|
|
|
|
|
"Read error while trying to determine if the Telnet packet is necessary." |
400
|
|
|
|
|
|
|
); |
401
|
|
|
|
|
|
|
} # $can_read == 1 -> OK, but we don't care if it is |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
elsif ($s->{packet_send_mode} eq "auto") |
404
|
|
|
|
|
|
|
{ |
405
|
|
|
|
|
|
|
# The connection to the Telnet server failed. But wait! Netgear changed the Telnet enabling |
406
|
|
|
|
|
|
|
# system. Now the packet has to be sent on UDP and by default the Telnet daemon is not even |
407
|
|
|
|
|
|
|
# running, so this could be the case. Try to send the packet over UDP. |
408
|
0
|
|
|
|
|
|
_udp_send_packet ($self); |
409
|
|
|
|
|
|
|
# Now, open the connection over TCP and see if everything is OK. |
410
|
0
|
|
|
|
|
|
$v = $self->$method (@params); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
# Load the Netgear defaults, if requested. |
413
|
0
|
0
|
0
|
|
|
|
$self->apply_netgear_defaults if $v && $s->{netgear_defaults}; |
414
|
0
|
|
|
|
|
|
$v; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
1; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=encoding utf8 |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head1 NAME |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
Net::Telnet::Netgear - Generate and send Netgear Telnet-enable packets through Net::Telnet |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=head1 SYNOPSIS |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
use Net::Telnet::Netgear; |
428
|
|
|
|
|
|
|
my $telnet = Net::Telnet::Netgear->new ( |
429
|
|
|
|
|
|
|
# Standard Net::Telnet parameters are allowed |
430
|
|
|
|
|
|
|
host => 'example.com', |
431
|
|
|
|
|
|
|
packet_mac => 'AA:BB:CC:DD:EE:FF', # or AABBCCDDEEFF |
432
|
|
|
|
|
|
|
packet_username => 'admin', |
433
|
|
|
|
|
|
|
packet_password => 'hunter2', |
434
|
|
|
|
|
|
|
netgear_defaults => 1 |
435
|
|
|
|
|
|
|
); |
436
|
|
|
|
|
|
|
# The magic is done transparently: the packet has already been sent, |
437
|
|
|
|
|
|
|
# if necessary, and the standard Net::Telnet API can now be used. |
438
|
|
|
|
|
|
|
my @lines = $telnet->cmd ('whoami'); |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
use Net::Telnet::Netgear::Packet; |
441
|
|
|
|
|
|
|
# Manually create a packet. |
442
|
|
|
|
|
|
|
my $packet = Net::Telnet::Netgear::Packet->new (mac => '...'); |
443
|
|
|
|
|
|
|
say length $packet->get_packet; # or whatever you want |
444
|
|
|
|
|
|
|
$packet = Net::Telnet::Netgear::Packet->from_base64 ('...'); |
445
|
|
|
|
|
|
|
$packet = Net::Telnet::Netgear::Packet->from_string ('...'); |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=head1 DESCRIPTION |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
This module allows to programmatically generate and send magic Telnet-enabling packets for |
450
|
|
|
|
|
|
|
Netgear routers with a locked Telnet interface. The packet can either be user-provided or it can |
451
|
|
|
|
|
|
|
be automatically generated given the username, password and MAC address of the router. Also, this |
452
|
|
|
|
|
|
|
module is capable of sending packets using TCP or UDP (the latter is used on new firmwares), and |
453
|
|
|
|
|
|
|
can automatically pick the right protocol to use, making it compatible with old and new firmwares |
454
|
|
|
|
|
|
|
without any additional configuration. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
The work on the Telnet protocol is done by L, which is subclassed by this module. |
457
|
|
|
|
|
|
|
In fact, it's possible to use the entire L API and configuration parameters. |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=head1 METHODS |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
L inherits all methods from L and implements the following new |
462
|
|
|
|
|
|
|
ones. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=head2 new |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
my $instance = Net::Telnet::Netgear->new (%options); |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
Creates a new C instance. Returns C on failure. |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
C<%options> can contain any of the options valid with the constructor of L, |
471
|
|
|
|
|
|
|
with the addition of: |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=over 4 |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=item * C<< packet_mac => 'AA:BB:CC:DD:EE:FF' >> |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
The MAC address of the router where the packet will be sent to. Each non-hexadecimal character |
478
|
|
|
|
|
|
|
(like colons) will be removed. |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=item * C<< packet_username => 'admin' >> |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
The username that will be put in the packet. Defaults to C for compatibility reasons. |
483
|
|
|
|
|
|
|
With new firmwares, the username C should be used. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Has no effect if C is not specified. |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item * C<< packet_password => 'password' >> |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
The password that will be put in the packet. Defaults to C for compatibility reasons. |
490
|
|
|
|
|
|
|
With new firmwares, the password of the router interface should be used. |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Has no effect if C is not specified. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item * C<< packet_content => 'string' >> |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
The content of the packet to be sent, as a string. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
Only makes sense if the packet is not defined elsewhere. |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=item * C<< packet_base64 => 'b64_string' >> |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
The content of the packet to be sent, as a Base64 encoded string. |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
Only makes sense if the packet is not defined elsewhere. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=item * C<< packet_instance => ... >> |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
A subclass of L to be used as the packet. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Only makes sense if the packet is not defined elsewhere. |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
B Packets generated with L, |
513
|
|
|
|
|
|
|
L and L |
514
|
|
|
|
|
|
|
can be used too. |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=item * C<< packet_delay => .50 >> |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
The amount of time, in seconds, to wait after sending the packet. |
519
|
|
|
|
|
|
|
In pseudo-code: C |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Defaults to C<.3> seconds, or 300 milliseconds. Can be C<0>. |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=item * C<< packet_wait_timeout => .75 >> |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
The amount of time, in seconds, to wait for a response from the server before sending the packet. |
526
|
|
|
|
|
|
|
In pseudo-code: C |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
Only effective when the packet is sent using TCP. Defaults to C<1> second. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=item * C<< packet_send_mode => 'auto|tcp|udp' >> |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
Determines how to send the packet. See L"packet_send_mode"> below. |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Defaults to C. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=item * C<< netgear_defaults => 0|1 >> |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
If enabled, the default values defined in the hash C<%Net::Telnet::Netgear::NETGEAR_DEFAULTS> are |
539
|
|
|
|
|
|
|
applied once the connection is established. See L"DEFAULT VALUES USING %NETGEAR_DEFAULTS">. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
Defaults to C<0>. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=item * C<< exit_on_destroy => 0|1 >> |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
If enabled, the C shell command is sent before the object is destroyed. This is useful to |
546
|
|
|
|
|
|
|
avoid ghost processes when closing a Telnet connection without killing the shell first. |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
Defaults to C<0>. |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=back |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=head2 apply_netgear_defaults |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
$instance->apply_netgear_defaults; |
555
|
|
|
|
|
|
|
$instance->apply_netgear_defaults ( |
556
|
|
|
|
|
|
|
prompt => '/rxp/', |
557
|
|
|
|
|
|
|
cmd_remove_mode => 0 |
558
|
|
|
|
|
|
|
); |
559
|
|
|
|
|
|
|
%Net::Telnet::Netgear::NETGEAR_DEFAULTS = (exit_on_destroy => 1); |
560
|
|
|
|
|
|
|
$instance->apply_netgear_defaults; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
Applies the values specified in the hash C<%Net::Telnet::Netgear::NETGEAR_DEFAULTS>. If any |
563
|
|
|
|
|
|
|
argument is specified, it is temporarily added to the hash. |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
See L"DEFAULT VALUES USING %NETGEAR_DEFAULTS">. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head2 exit_on_destroy |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
my $current_value = $instance->exit_on_destroy; |
570
|
|
|
|
|
|
|
# Set exit_on_destroy to 1 |
571
|
|
|
|
|
|
|
my $old_value = $instance->exit_on_destroy (1); |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
Gets or sets the value of the boolean flag C, which causes the module to send |
574
|
|
|
|
|
|
|
the C shell command before being destroyed. This is to avoid ghost processes when closing |
575
|
|
|
|
|
|
|
a Telnet connection without killing the shell first. |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=head2 packet |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
my $current_value = $instance->packet; |
580
|
|
|
|
|
|
|
# Set the content of the packet to '...' |
581
|
|
|
|
|
|
|
my $old_value = $instance->packet ('...'); |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Gets or sets the value of the packet B. This is basically equivalent to the |
584
|
|
|
|
|
|
|
C constructor parameter. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
Note that objects cannot be used - you have to call L |
587
|
|
|
|
|
|
|
before passing the value to this method. |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head2 packet_delay |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
my $current_value = $instance->packet_delay; |
592
|
|
|
|
|
|
|
# Set packet_delay to .75 seconds |
593
|
|
|
|
|
|
|
my $old_value = $instance->packet_delay (.75); |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Gets or sets the amount of time, in seconds, to wait after sending the packet. |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=head2 packet_send_mode |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
my $current_value = $instance->packet_send_mode; |
600
|
|
|
|
|
|
|
# Set packet_send_mode to 'udp' |
601
|
|
|
|
|
|
|
my $old_value = $instance->packet_send_mode ('udp'); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
Gets or sets the protocol used to send the packet, between C, C and C. |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
If it is C, then the module will try to guess the correct protocol to use. More specifically, |
606
|
|
|
|
|
|
|
if the initial C performed on the specified C and C fails, the packet is sent |
607
|
|
|
|
|
|
|
using UDP (and then the connection is reopened). Otherwise, if the C succeeds but it's |
608
|
|
|
|
|
|
|
impossible to read within the L"packet_wait_timeout">, the packet is sent using TCP. |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
If it is C, the packet is sent using TCP. |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
If it is C, the packet is sent using UDP. Note that in this case the packet is always sent |
613
|
|
|
|
|
|
|
before an C call. |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
B Generally, specifying the protocol instead of using C is faster, especially when |
616
|
|
|
|
|
|
|
the packet has to be sent using UDP (due to the additional connection that has to be made). |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=head2 packet_wait_timeout |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
my $current_value = $instance->packet_wait_timeout; |
621
|
|
|
|
|
|
|
# Set packet_wait_timeout to 1.25 |
622
|
|
|
|
|
|
|
my $old_value = $instance->packet_wait_timeout (1.25); |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
Gets or sets the the amount of time, in seconds, to wait for a response from the server before |
625
|
|
|
|
|
|
|
sending the packet. |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
Only effective when the packet is sent using TCP. |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=head1 IMPLEMENTATION DETAILS |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
When you open a connection with L (either with the C<(fh)open> methods |
632
|
|
|
|
|
|
|
inherited from L or by specifying the C constructor parameter), the following |
633
|
|
|
|
|
|
|
actions are performed depending on the value of L"packet_send_mode">. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
B when C is used, "socket" refers to the filehandle. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=over 4 |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item "auto" |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
This is the default. First, L tries to open the socket. If it succeeds, |
642
|
|
|
|
|
|
|
then it's assumed that the server may want a TCP packet. To check if the server actually needs |
643
|
|
|
|
|
|
|
it, a L call is performed on the socket to determine if data is available |
644
|
|
|
|
|
|
|
to read. If data is available, then nothing is done. Otherwise, the packet is sent using TCP and |
645
|
|
|
|
|
|
|
then the socket is re-opened. |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
If the initial C didn't succeed, then the server is not listening on the port. It's assumed |
648
|
|
|
|
|
|
|
that the server wants an UDP packet, and it is immediately sent. The socket is re-opened, and if |
649
|
|
|
|
|
|
|
it fails again the error is propagated. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item "tcp" |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
The actions specified in the first case apply, except that if the initial C goes wrong the |
654
|
|
|
|
|
|
|
error is immediately propagated. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=item "udp" |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
The packet is immediately sent before the C performed by L. If it fails, the |
659
|
|
|
|
|
|
|
error is immediately propagated. |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=back |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=head1 DEFAULT VALUES USING %NETGEAR_DEFAULTS |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
As an added feature, it's possible to enable a set of options suitable for Netgear routers. |
666
|
|
|
|
|
|
|
This is possible with the hash C<%Net::Telnet::Netgear::NETGEAR_DEFAULTS>, which contains a list |
667
|
|
|
|
|
|
|
of methods to be called on the current instance along with their parameters. This is done by the |
668
|
|
|
|
|
|
|
method L"apply_netgear_defaults">. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
The current version specifies the following list of default values: |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
method value |
673
|
|
|
|
|
|
|
----------------- ----------- |
674
|
|
|
|
|
|
|
cmd_remove_mode 1 |
675
|
|
|
|
|
|
|
exit_on_destroy 1 |
676
|
|
|
|
|
|
|
prompt '/.* # $/' |
677
|
|
|
|
|
|
|
waitfor '/.* # $/' |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
It is possible to edit this list either by interacting directly with it: |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
$Net::Telnet::Netgear::NETGEAR_DEFAULTS{some_option} = 'some_value'; |
682
|
|
|
|
|
|
|
delete $Net::Telnet::Netgear::NETGEAR_DEFAULTS{some_option}; |
683
|
|
|
|
|
|
|
%Net::Telnet::Netgear::NETGEAR_DEFAULTS = ( |
684
|
|
|
|
|
|
|
option1 => 'value1', |
685
|
|
|
|
|
|
|
option2 => 'value2' |
686
|
|
|
|
|
|
|
); |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Or you can supply additional parameters to L"apply_netgear_defaults">, which will be temporarily |
689
|
|
|
|
|
|
|
added to the list. Note that user-specified values have priority over the ones in the hash, and |
690
|
|
|
|
|
|
|
if you specify the value of an option as C, it won't be set at all. |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
# cmd_remove_mode is set to 0 instead of 1, along with all the other |
693
|
|
|
|
|
|
|
# default values |
694
|
|
|
|
|
|
|
$instance->apply_netgear_defaults (cmd_remove_mode => 0); |
695
|
|
|
|
|
|
|
# do not set cmd_remove_mode at all, but apply every other default |
696
|
|
|
|
|
|
|
$instance->apply_netgear_defaults (cmd_remove_mode => undef); |
697
|
|
|
|
|
|
|
# the standard list of default values is applied plus 'some_option' |
698
|
|
|
|
|
|
|
$instance->apply_netgear_defaults (some_option => 'some_value'); |
699
|
|
|
|
|
|
|
# equivalent to: |
700
|
|
|
|
|
|
|
{ |
701
|
|
|
|
|
|
|
local %Net::Telnet::Netgear::NETGEAR_DEFAULTS = ( |
702
|
|
|
|
|
|
|
%Net::Telnet::Netgear::NETGEAR_DEFAULTS, |
703
|
|
|
|
|
|
|
some_option => 'some_value' |
704
|
|
|
|
|
|
|
); |
705
|
|
|
|
|
|
|
$instance->apply_netgear_defaults; |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=head1 THE MAGIC BEHIND TIMEOUTS |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
C uses a timeout to determine if it should send the packet (using TCP). |
711
|
|
|
|
|
|
|
But what's the magic behind this mysterious decimal number? |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
Timeouts, under normal conditions, are implemented using the L function (which |
714
|
|
|
|
|
|
|
calls the L |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
It would be great if the story ended here, but happy endings are pretty rare in real life. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
C |
719
|
|
|
|
|
|
|
certain systems when dealing with generic filehandles (I). |
720
|
|
|
|
|
|
|
L can make Telnet work on arbitrary filehandles (thanks to L), |
721
|
|
|
|
|
|
|
but that means that C |
722
|
|
|
|
|
|
|
what to do in this case with the boolean variable |
723
|
|
|
|
|
|
|
C<$Net::Telnet::Netgear::DIE_ON_SELECT_UNAVAILABLE>. |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
If this variable is false (the default), then if C |
726
|
|
|
|
|
|
|
never send packets using TCP and emit a warning. This may not be always desiderable. |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
If this variable is true, then if C |
729
|
|
|
|
|
|
|
C<< Net::Telnet->error >> which, when C is the default, stops the execution of the script. |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
B If L"packet_send_mode"> is set to C, then C |
732
|
|
|
|
|
|
|
C<$Net::Telnet::Netgear::DIE_ON_SELECT_UNAVAILABLE> won't have any effect even if C |
733
|
|
|
|
|
|
|
unavailable. |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head1 CAVEATS |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
An C call may require serious amounts of time, depending on the L"packet_send_mode"> and |
738
|
|
|
|
|
|
|
L"packet_wait_timeout">. |
739
|
|
|
|
|
|
|
Particularly, if no packet has to be sent, then C or C are the fastest. Otherwise, |
740
|
|
|
|
|
|
|
C is the fastest (because there are no timeouts, and the packet is immediately sent). |
741
|
|
|
|
|
|
|
C is the slowest when the router requires the packet on UDP, because a connection is |
742
|
|
|
|
|
|
|
attempted on the TCP port, while it has the same speed of C when the packet is expected on |
743
|
|
|
|
|
|
|
TCP. |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head1 SEE ALSO |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
L, L, |
748
|
|
|
|
|
|
|
L, |
749
|
|
|
|
|
|
|
L |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
=head1 AUTHOR |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
Roberto Frenna (robertof AT cpan DOT org) |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
=head1 THANKS |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
Thanks to L for the precious contribution to |
758
|
|
|
|
|
|
|
the OpenWRT wiki page, and for helping me to discovery the mistery behind the "strange" packets |
759
|
|
|
|
|
|
|
generated with long passwords. |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
Thanks to L for inspiration about the license and the |
762
|
|
|
|
|
|
|
documentation. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=head1 LICENSE |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
Copyright (C) 2014-2015, Roberto Frenna. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
This program is free software, you can redistribute it and/or modify it under the terms of the |
769
|
|
|
|
|
|
|
Artistic License version 2.0. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=cut |