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