Browse files

New folder with cool 3rd party scripts

  • Loading branch information...
1 parent 1643abd commit 9eff1d9f408e20e312156298353fb7c3e5f847fe @richo richo committed Mar 17, 2011
Showing with 566 additions and 0 deletions.
  1. +566 −0 3rdparty/igdctl.pl
View
566 3rdparty/igdctl.pl
@@ -0,0 +1,566 @@
+#!/usr/bin/perl
+#########################################################################################
+#
+# igdctl -:- Internet gateway device administration tool written in perl
+#
+# VERSION: 0.1
+# AUTHOR: Vincent Wochnik
+# EMAIL: v.wochnik@yahoo.com
+# 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.

0 comments on commit 9eff1d9

Please sign in to comment.