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