File Coverage

blib/lib/Net/Telnet/Netgear.pm
Criterion Covered Total %
statement 79 147 53.7
branch 34 96 35.4
condition 12 54 22.2
subroutine 22 28 78.5
pod 9 9 100.0
total 156 334 46.7


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