Created
July 3, 2012 14:24
-
-
Save peterstrapp/3040026 to your computer and use it in GitHub Desktop.
Vincent Wochnik's upnp script
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/usr/bin/perl | |
| ######################################################################################### | |
| # | |
| # igdctl -:- Internet gateway device administration tool written in perl | |
| # | |
| # VERSION: 0.1 | |
| # AUTHOR: Vincent Wochnik | |
| # EMAIL: [email protected] | |
| # WWW: ubuntu.blogetery.com | |
| # COPYRIGHT: (c) by Vincent Wochnik 2009 | |
| # | |
| # Permission is hereby granted, free of charge, to any person obtaining a copy | |
| # of this software and associated documentation files (the "Software"), to | |
| # deal in the Software without restriction, including without limitation the | |
| # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | |
| # sell copies of the Software, and to permit persons to whom the Software is | |
| # furnished to do so, subject to the following conditions: | |
| # | |
| # The above copyright notice and this permission notice shall be included in | |
| # all copies or substantial portions of the Software. | |
| # | |
| # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | |
| # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
| # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | |
| # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
| # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | |
| # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | |
| # IN THE SOFTWARE. | |
| # | |
| ######################################################################################### | |
| use strict; | |
| use Getopt::Long; | |
| use Net::UPnP::Device; | |
| use Net::UPnP::ControlPoint; | |
| ## allow bundling of command line options | |
| Getopt::Long::Configure('bundling'); | |
| ## | |
| ## PARSE COMMAND LINE OPTIONS | |
| ## | |
| my $help = 0; | |
| my $verbose = 0; | |
| my $action_print = 0; | |
| my $action_enable = 0; | |
| my $action_disable = 0; | |
| my $action_reconnect = 0; | |
| my $action_add_port = 0; | |
| my $action_get_port = 0; | |
| my $action_remove_port = 0; | |
| my $action_list_ports = 0; | |
| my $action_clear_ports = 0; | |
| my $devnum = -1; | |
| my $external_ip = ''; | |
| my $external_port = ''; | |
| my $internal_ip = ''; | |
| my $internal_port = ''; | |
| my $protocol = ''; | |
| my $duration = ''; | |
| my $active = 1; ## flag is set by default | |
| if (!GetOptions('h|help', => \$help, | |
| 'v|verbose', => \$verbose, | |
| 'p|print' => \$action_print, ## print statistics | |
| 'r|reconnect' => \$action_reconnect, ## reconnect | |
| 'enable' => \$action_enable, ## enable internet access | |
| 'disable' => \$action_disable, ## disable internet access | |
| 'a|add-port' => \$action_add_port, ## add port mapping | |
| 'g|get-port' => \$action_get_port, ## get a port by external host, ip and protocol | |
| 'R|remove-port' => \$action_remove_port, ## remove port mapping | |
| 'c|clear-ports' => \$action_clear_ports, ## clear port mapping list | |
| 'l|list-ports' => \$action_list_ports, ## list port mappings | |
| 'd|device=i' => \$devnum, ## device number | |
| 'E|external-ip=s' => \$external_ip, ## external ip address | |
| 'e|external-port=i' => \$external_port, ## external port | |
| 'I|internal-ip=s' => \$internal_ip, ## client ip address | |
| 'i|internal-port=i' => \$internal_port, ## internal port | |
| 'P|protocol=s' => \$protocol, ## protocol (TCP/UDP | |
| 'D|duration=i' => \$duration, ## expiration time | |
| 'A|active=i' => \$active)) { ## active flag | |
| $help = 1; | |
| } | |
| if ($action_print+$action_enable+$action_disable+$action_reconnect+$action_add_port+$action_get_port+$action_remove_port+$action_clear_ports+$action_list_ports > 1) { | |
| ## No multiple action parameters!!! | |
| $help = 1; | |
| } elsif ($action_print+$action_enable+$action_disable+$action_reconnect+$action_add_port+$action_get_port+$action_remove_port+$action_clear_ports+$action_list_ports == 0) { | |
| ## No action parameter found!!! | |
| $help = 1; | |
| } elsif ($action_print+$action_enable+$action_disable+$action_reconnect == 1) { | |
| ## Some action parameters don't require additional parameters | |
| if (($external_ip) || ($external_port) || ($internal_ip) || ($internal_port) || ($duration)) { | |
| $help = 1; | |
| } | |
| } elsif ($action_add_port+$action_get_port+$action_remove_port+$action_clear_ports+$action_list_ports == 1) { | |
| ## Check if all parameters are valid | |
| if ( | |
| ((($action_add_port) || ((($action_clear_ports) || ($action_list_ports)) && ($internal_ip))) && ($internal_ip !~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/)) || | |
| ((($action_add_port) || ($action_remove_port) || ($action_get_port)) && ($external_ip) && ($external_ip !~ m/^[0-9*]{1,3}\.[0-9*]{1,3}\.[0-9*]{1,3}\.[0-9*]{1,3}$/)) || | |
| (($action_add_port) && (($internal_port < 0) || ($internal_port > 65535))) || | |
| ((($action_add_port) || ($action_remove_port) || ($action_get_port)) && (($external_port < 0) || ($external_port > 65535))) || | |
| (($action_add_port) && (($duration) && ($duration < 0))) || | |
| ((($action_add_port) || ($action_remove_port) || ($action_get_port)) && ($protocol !~ m/(TCP|UDP)/)) || | |
| (($action_add_port) && ($duration) && ($duration !~ m/^\d$/)) || | |
| (($action_add_port) && ($active) && ($active !~ m/^(0|1)$/)) | |
| ) { | |
| $help = 1; | |
| } | |
| } | |
| ## Display help content and exit | |
| if ($help) { | |
| ## Help content is located at the bottom after the __DATA__ statement | |
| print STDOUT <data> and exit 2; | |
| } | |
| ## scanning for devices | |
| print STDOUT "Scanning for devices ...\n" if $verbose; | |
| my @devices = get_igd_devices(); | |
| my $devcount = length(@devices); | |
| ## error handling | |
| print STDERR "No device found.\n\n" and exit 1 if (!@devices); | |
| ## if there is only one device, auto-choose | |
| $devnum = 0 if ($devcount == 1); | |
| ## if verbose or device number invalid | |
| if (($verbose) || ($devnum < 0) || ($devnum >= $devcount)) { | |
| printf STDOUT 'Found %d ', $devcount; | |
| print STDOUT "device.\n\n" if ($devcount == 1); | |
| print STDOUT "devices.\n\n" if ($devcount != 1); | |
| } | |
| ## print list and ask the user if no device number is given per command argument | |
| if (($devnum < 0) || ($devnum >= $devcount)) { | |
| ## print device list | |
| list_devices(@devices); | |
| ## user choice | |
| while (($devnum !~ m/^[0-9]+$/) || ($devnum >= $devcount)) { | |
| print("Please select a device.\nDevice: "); | |
| chomp($devnum = <>); | |
| print STDOUT "Invalid choice. Try again!\n" if (($devnum < 0) || ($devnum >= $devcount)); | |
| print STDOUT "\n"; | |
| } | |
| } | |
| ## Get chosen device | |
| my $device = @devices[$devnum]; | |
| my $service; | |
| ## get service handler | |
| if ($action_enable+$action_disable+$action_print) { | |
| ## Get WANIPCommonInterfaceConfig service | |
| $service = $device->getservicebyname("urn:schemas-upnp-org:service:WANCommonInterfaceConfig:1"); | |
| print STDERR "WANCommonInterfaceConfig service not avaleble.\n\n" and exit 1 if (!$service); | |
| } else {##if ($action_reconnect+$action_add_port+$action_get_port+$action_remove_port+$action_clear_ports+$action_list_ports) | |
| ## Get WANIPConnection service | |
| $service = $device->getservicebyname("urn:schemas-upnp-org:service:WANIPConnection:1"); | |
| print STDERR "WANCommonInterfaceConfig service not avaleble.\n\n" and exit 1 if (!$service); | |
| } | |
| if ($action_print) { | |
| my $res, my $out_args, my $out=""; | |
| ## Get internet enabled | |
| print STDOUT "Trying to get internet access state ...\n" if $verbose; | |
| $res = $service->postaction("GetEnabledForInternet"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| if ($out_args->{'NewEnabledForInternet'}) { | |
| $out .= sprintf('Internet access : enabled'."\n"); | |
| } else { | |
| $out .= sprintf('Internet access : disabled'."\n"); | |
| } | |
| } | |
| ## Get connection properties ... | |
| print STDOUT "Trying to get connection properties ...\n" if $verbose; | |
| $res = $service->postaction("GetCommonLinkProperties"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('WAN access type : %s'."\n", $out_args->{'NewWANAccessType'}); | |
| $out .= sprintf('Maximum upstream rate : %s bps'."\n", $out_args->{'NewLayer1UpstreamMaxBitRate'}); | |
| $out .= sprintf('Maximum downstream rate : %s bps'."\n", $out_args->{'NewLayer1DownstreamMaxBitRate'}); | |
| $out .= sprintf('Physical link state : %s'."\n", $out_args->{'NewPhysicalLinkStatus'}); | |
| } | |
| ## Get wan access provider | |
| print STDOUT "Trying to get WAN access provider ...\n" if $verbose; | |
| $res = $service->postaction("GetWANAccessProvider"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('WAN access provider : %s'."\n", $out_args->{'NewWANAccessProvider'}); | |
| } | |
| ## Get maximum number of active connections | |
| print STDOUT "Trying to get maximum number of active connections ...\n" if $verbose; | |
| $res = $service->postaction("GetMaximumActiveConnections"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('Max. number of active connections : %d'."\n", $out_args->{'MaximumActiveConnections'}); | |
| } | |
| ## Get total bytes sent | |
| print STDOUT "Trying to get total number of bytes sent ...\n" if $verbose; | |
| $res = $service->postaction("GetTotalBytesSent"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('Total bytes sent : %s'."\n", readable_size($out_args->{'NewTotalBytesSent'})); | |
| } | |
| ## Get total packets sent | |
| print STDOUT "Trying to get total number of packets sent ...\n" if $verbose; | |
| $res = $service->postaction("GetTotalPacketsSent"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('Total packets sent : %d'."\n", $out_args->{'NewTotalPacketsReceived'}); | |
| } | |
| ## Get total bytes received | |
| print STDOUT "Trying to get total number of bytes received ...\n" if $verbose; | |
| $res = $service->postaction("GetTotalBytesReceived"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('Total bytes received : %s'."\n", readable_size($out_args->{'NewTotalBytesReceived'})); | |
| } | |
| ## Get total packets received | |
| print STDOUT "Trying to get total number of packets received ...\n" if $verbose; | |
| $res = $service->postaction("GetTotalPacketsReceived"); | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out .= sprintf('Total packets received : %d'."\n", $out_args->{'NewTotalPacketsReceived'}); | |
| } | |
| print STDOUT $out."\n" and exit 0 if $out; ## print information | |
| print STDERR "Nothing to print out.\n" and exit 1; ## otherwise print an error | |
| } elsif ($action_enable) { ## OK <-- based on Documentation | |
| my $res, my %in_args, my $success=1; | |
| %in_args = ('NewEnabledForInternet' => '1'); | |
| ## Enable internet access ... | |
| print STDOUT "Trying to enable internet access ...\n" if $verbose; | |
| $res = $service->postaction("SetEnabledForInternet", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() == 401) { | |
| print STDERR "Operation not supported. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| print STDOUT "Command successful.\n" and exit 0 if $success; | |
| print STDERR "Command failed.\n" and exit 1; | |
| } elsif ($action_disable) { ## OK <-- based on Documentation | |
| my $res, my %in_args, my $success=1; | |
| %in_args = ('NewEnabledForInternet' => '0'); | |
| ## Disable internet access ... | |
| print STDOUT "Trying to disable internet access ...\n" if $verbose; | |
| $res = $service->postaction("SetEnabledForInternet", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() == 401) { | |
| print STDERR "Operation not supported. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| print STDOUT "Command successful.\n" and exit 0 if $success; | |
| print STDERR "Command failed.\n" and exit 1; | |
| } elsif ($action_reconnect) { ## OK <-- based on Documentation | |
| my $res, my $success=1; | |
| ## Force termination ... | |
| print STDOUT "Trying to terminate WANIPConnection ...\n" if $verbose; | |
| $res = $service->postaction("ForceTermination"); | |
| ## error handling | |
| if ($res->getstatuscode() == 501) { | |
| print STDERR "Action failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 710) { | |
| print STDERR "Invalid connection type. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 702) { | |
| print STDERR "Disconnect in progress. (WARNING ".$res->getstatuscode().")\n\n" if $verbose; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| print STDERR "Command failed.\n" and exit 1 if (!$success); | |
| ## Requesting new connection ... | |
| print STDOUT "Requesting new connection ...\n" if $verbose; | |
| $res = $service->postaction("RequestConnection"); | |
| ## error handling | |
| if ($res->getstatuscode() == 704) { | |
| print STDERR "Connection setup failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 708) { | |
| print STDERR "Invalid Layer2 address. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 709) { | |
| print STDERR "Internet access disabled. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 710) { | |
| print STDERR "Invalid connection type. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 705) { | |
| print STDERR "Connection setup in progress. (WARNING ".$res->getstatuscode().")\n\n" if $verbose; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| print STDOUT "Command successful.\n" and exit 0 if $success; | |
| print STDERR "Command failed.\n" and exit 1; | |
| } elsif ($action_add_port) { | |
| my $res, my %in_args, my $success=1; | |
| %in_args = ('NewRemoteHost' => $external_ip, | |
| 'NewExternalPort' => $external_port, | |
| 'NewProtocol' => $protocol, | |
| 'NewInternalPort' => $internal_port, | |
| 'NewInternalClient' => $internal_ip, | |
| 'NewEnabled' => $active, | |
| 'NewPortMappingDescription' => 'mapped by '.__FILE__, | |
| 'NewLeaseDuration' => $duration); | |
| ## trying to add port mapping entry | |
| print STDOUT "Trying to add a port mapping entry ...\n" if $verbose; | |
| $res = $service->postaction("AddPortMapping", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() == 402) { | |
| print STDERR "Invalid args. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 715) { | |
| print STDERR "Wildcard not allowed in remote host address. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 716) { | |
| print STDERR "Wildcard not allowed in external port. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() == 718) { | |
| print STDERR "Conflicting with another mapping entry. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| print STDOUT "Command successful.\n" and exit 0 if $success; | |
| print STDERR "Command failed.\n" and exit 1; | |
| } elsif ($action_remove_port) { | |
| my $res, my %in_args, my $success=1; | |
| %in_args = ('NewRemoteHost' => $external_ip, | |
| 'NewExternalPort' => $external_port, | |
| 'NewProtocol' => $protocol); | |
| ## remove port mapping entry | |
| print STDOUT "Trying to remove a port mapping entry matching specified criteria ...\n" if $verbose; | |
| $res = $service->postaction("DeletePortMapping", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() == 714) { | |
| print STDERR "Entry not found. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success = 0; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| print STDOUT "Command successful.\n" and exit 0 if $success; | |
| print STDERR "Command failed.\n" and exit 1; | |
| } elsif ($action_get_port) { | |
| my $res, my %in_args, my $out_args, my $out; | |
| %in_args = ('NewRemoteHost' => $external_ip, | |
| 'NewExternalPort' => $external_port, | |
| 'NewProtocol' => $protocol); | |
| ## print port mapping entry | |
| print STDOUT "Trying to print a port mapping entry matching specified criteria ...\n" if $verbose; | |
| $res = $service->postaction("GetSpecificPortMappingEntry", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() == 714) { | |
| print STDERR "Entry not found. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| $out = sprintf('%6s %15s %13s %15s %13s %10s'."\n", 'ACTIVE', 'REMOTE HOST', 'EXTERNAL PORT', 'CLIENT HOST', 'INTERNAL PORT', 'LEASE TIME') if (!$out); | |
| if ($external_ip) { | |
| $out .= sprintf('%6s %15s %13s %15s %13s %10s'."\n", $out_args->{'NewEnabled'}, $external_ip, $external_port, $out_args->{'NewInternalClient'}, $out_args->{'NewInternalPort'}, $out_args->{'NewLeaseDuration'}); | |
| } else { | |
| $out .= sprintf('%6s %15s %13s %15s %13s %10s'."\n", $out_args->{'NewEnabled'}, '*', $external_port, $out_args->{'NewInternalClient'}, $out_args->{'NewInternalPort'}, $out_args->{'NewLeaseDuration'}); | |
| } | |
| } | |
| print STDOUT $out."\n" and exit 0 if $out; ## print information | |
| print STDERR "Nothing to print out.\n" and exit 1; ## otherwise print an error | |
| } elsif ($action_list_ports) { | |
| my $res, my %in_args, my $out_args, my $i=0, my $out=""; | |
| while ($i >= 0) { | |
| %in_args = ('NewPortMappingIndex' => $i); | |
| ## search port mapping entry | |
| print STDOUT "Trying to search port mapping entry ...\n" if $verbose; | |
| $res = $service->postaction("GetGenericPortMappingEntry", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $i = -1; ## stop loop - there are no more entries | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| if ((!$internal_ip) || ($out_args->{'NewInternalClient'} =~ m/^($internal_ip)$/)) { | |
| $out = sprintf('%6s %15s %13s %15s %13s %10s'."\n", 'ACTIVE', 'REMOTE HOST', 'EXTERNAL PORT', 'CLIENT HOST', 'INTERNAL PORT', 'LEASE TIME') if (!$out); | |
| if ($out_args->{'NewRemoteHost'}) { | |
| $out .= sprintf('%6s %15s %13s %15s %13s %10s'."\n", $out_args->{'NewEnabled'}, $out_args->{'NewRemoteHost'}, $out_args->{'NewExternalPort'}, $out_args->{'NewInternalClient'}, $out_args->{'NewInternalPort'}, $out_args->{'NewLeaseDuration'}); | |
| } else { | |
| $out .= sprintf('%6s %15s %13s %15s %13s %10s'."\n", $out_args->{'NewEnabled'}, '*', $out_args->{'NewExternalPort'}, $out_args->{'NewInternalClient'}, $out_args->{'NewInternalPort'}, $out_args->{'NewLeaseDuration'}); | |
| } | |
| } | |
| $i++; | |
| } | |
| } | |
| print STDOUT $out."\n" and exit 0 if $out; ## print information | |
| print STDERR "Nothing to print out.\n" and exit 1; ## otherwise print an error | |
| } elsif ($action_clear_ports) { | |
| my $res, my %in_args, my $out_args, my $i=0, my $success=1; | |
| while ($i >= 0) { | |
| %in_args = ('NewPortMappingIndex' => $i); | |
| ## search port mapping entry | |
| print STDOUT "Trying to search port mapping entry ...\n" if $verbose; | |
| $res = $service->postaction("GetGenericPortMappingEntry", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $i = -1; ## stop loop - there are no more entries | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| $out_args = $res->getargumentlist(); | |
| if ((!$internal_ip) || ($out_args->{'NewInternalClient'} =~ m/^($internal_ip)$/)) { | |
| %in_args = ('NewRemoteHost' => $out_args->{'NewRemoteHost'}, | |
| 'NewExternalPort' => $out_args->{'NewExternalPort'}, | |
| 'NewProtocol' => $out_args->{'NewProtocol'}); | |
| ## remove port mapping entry | |
| printf STDOUT 'Trying to remove port mapping entry number %d...'."\n", $i+1 if $verbose; | |
| $res = $service->postaction("DeletePortMapping", \%in_args); | |
| ## error handling | |
| if ($res->getstatuscode() == 714) { | |
| print STDERR "Entry not found. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success=0; | |
| $i = -1; ## stop loop - there is an error | |
| } elsif ($res->getstatuscode() != 200) { | |
| print STDERR "Operation failed. (ERR ".$res->getstatuscode().")\n\n" if $verbose; | |
| $success=0; | |
| $i = -1; ## stop loop - there is an error | |
| } else { | |
| print STDOUT "Done (OK ".$res->getstatuscode().")\n\n" if $verbose; | |
| } | |
| } else { | |
| $i++; | |
| } | |
| } | |
| } | |
| print STDOUT "Command successful.\n" and exit 0 if $success; | |
| print STDERR "Command failed.\n" and exit 1; | |
| } | |
| sub get_igd_devices() { | |
| my $cp, my @devices, my $device, my @filtereddevs; | |
| $cp = Net::UPnP::ControlPoint->new(); | |
| ## scan for devices | |
| @devices = $cp->search(st => 'upnp:rootdevice', mx => '1'); | |
| ## and another time if none found | |
| @devices = $cp->search(st => 'upnp:rootdevice', mx => '3') if (!@devices); | |
| if (@devices) { | |
| foreach $device (@devices) { | |
| my $devtype = $device->getdevicetype(); | |
| if ($devtype =~ m/^urn:schemas-upnp-org:device:InternetGatewayDevice:1$/) { | |
| push(@filtereddevs, $device); | |
| } | |
| } | |
| } | |
| @filtereddevs; | |
| } | |
| sub list_devices() { | |
| my @devices, $devcount; | |
| my $devnum, my $devmanuf, my $devmodel, my $devsn, my $devudn, my $devupc; | |
| @devices = $_[0]; | |
| $devcount = length(@devices); | |
| for ($devnum = 0; $devnum < $devcount; $devnum++) { | |
| $devmanuf = $devices[$devnum]->getmanufacturer(); | |
| $devmodel = $devices[$devnum]->getmodelname(); | |
| $devsn = $devices[$devnum]->getserialnumber(); | |
| $devudn = $devices[$devnum]->getudn(); | |
| $devupc = $devices[$devnum]->getupc(); | |
| $devsn = "n/a" if (!$devsn); | |
| $devudn = "n/a" if (!$devudn); | |
| $devupc = "n/a" if (!$devupc); | |
| printf STDOUT 'Device: : %d'."\n", $devnum; | |
| printf STDOUT 'Manufacturer : %s'."\n", $devmanuf; | |
| printf STDOUT 'Model : %s'."\n", $devmodel; | |
| printf STDOUT 'Serial number : %s'."\n", $devsn; | |
| printf STDOUT 'UDN : %s'."\n", $devudn; | |
| printf STDOUT 'UPC : %s'."\n\n", $devupc; | |
| } | |
| } | |
| sub readable_size() { | |
| my $size = $_[0]; | |
| my $readable; | |
| if ($size >= 1024*1024*1024*1024) { | |
| $readable = sprintf('%.2f TB', $size/1024/1024/1024/1024); | |
| } elsif ($size >= 1024*1024*1024) { | |
| $readable = sprintf('%.2f GB', $size/1024/1024/1024); | |
| } elsif ($size >= 1024*1024) { | |
| $readable = sprintf('%.2f MB', $size/1024/1024); | |
| } elsif ($size >= 1024*1024*1024*1024) { | |
| $readable = sprintf('%.2f KB', $size/1024); | |
| } else { | |
| $readable = sprintf('%.2f Bytes', $size); | |
| } | |
| $readable; | |
| } | |
| __DATA__ | |
| igdctl -:- IGD administration tool written in perl | |
| Version 0.1 | |
| USAGE | |
| ./igdctl.pl [-h|-p|-r|-a|-g|-R|-l|-c|--enable|--disable] | |
| [-d DEVICE] [-E IP] [-e PORT] [-I IP] [-i PORT] | |
| [-P PROTOCOL] [-D DURATION] [-A ACTIVE] | |
| Example: | |
| ./igdctl.pl -r | |
| Actions: | |
| -h, --help : Displays this help text. | |
| -v, --verbose : Verbose mode. | |
| -p, --print : Prints connection information avaleble. | |
| --enable : Enable internet access if supported. | |
| --disable : Disable internet access if supported. | |
| -r, --reconnect : Triggers a reconnect. | |
| -a, --add-port : Adds or overwrites a port mapping entry with the | |
| same internal client address. | |
| -e, -I, -i, -P are needed, -E, -D, -A are | |
| optional. | |
| -g, --get-port : Gets a port mapping entry by remote host, | |
| port and protocol. -e, -P are needed, -E is | |
| optional. | |
| -R, --remove-port : Removes a port mapping entry. | |
| -e, -P are needed, -E is optional. | |
| -l, --list-ports : Lists all port mapping entries. If -I was | |
| specified, only entries by a given IP are shown. | |
| -c, --clear-ports : Removes all port mapping entries. If -I was | |
| specified, only entries by a given IP are | |
| removed. | |
| Options: | |
| -d, --device=DEV : specifies the device number when more then one | |
| devices are avaleble. | |
| -E, --external-ip=IP : specifies a remote host. Wildcards are supported. | |
| -e, --external-port=PORT : specifies an external port number. | |
| -I, --internal-ip=IP : specifies a client ip address. | |
| -i, --internal-port=PORT : specifies a client port number. | |
| -P, --protocol=PROTOCOL : specifies a protocol. TCP and UDP are allowed. | |
| -D, --duration=DURATION : specifies a number of seconds until a port mapping | |
| entry expires. | |
| -A, --active=ACTIVE : Specifies whether a port mapping entry is enabled. | |
| Values 0 and 1 are allowed. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment