File Coverage

blib/lib/Net/Telnet/Netgear.pm
Criterion Covered Total %
statement 79 145 54.4
branch 34 92 36.9
condition 12 51 23.5
subroutine 22 28 78.5
pod 9 9 100.0
total 156 325 48.0


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 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.
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.
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, 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.
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.
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, 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 syscall). This magic function is awesome, and it works beautifully.
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 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 and
728             L.
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