Administrating Your Gateway Device Via UPnP

Do you often need to reconnect due to download purposes or forward ports manually because some applications don't support it natively? Then this is the right thing for you! This howto covers a Perl script allowing you to administrate your gateway device via UPnP. You can reconnect, add and remove port forwarding entries and many more.

This Perl script allows you to do the following things:

* Trigger a reconnect
* Print all information your gateway offers
* Add a port forwarding entry
* Remove a port forwarding entry
* Print a port forwarding entry
* Print a list of all port forwarding entries
* Remove all port forwarding entries
* Enable or disable internet access globally


Installation

If you want to give it a try, follow these steps to install the script.

1. Copy the script to a file

You can find the script at the bottom of this article. Open your favorite editor and paste the script. Save it to ~/igdctl.pl.

Make the script executable by executing this command:

chmod +x ./igdctl.pl
2. Install a perl module
This script needs a perl module called Net::UPnP to work correctly. Run the following command in a terminal:

sudo apt-get install -y libnet-upnp-perl

This works only with DEB based systems. For RPM based systems you need a different installation command.

Triggering a reconnect

If you want your DSL router to get a new IP address just execute following command:

./igdctl.pl -r

Explanation: The script automaticly looks for an internet gateway device. -r tells the script to send a ForceTermination signal to the gateway.

Print information

You can print all information the gateway offers via UPnP. Use the following command:

./igdctl.pl -p

Explanation: -p tells the script to call some information returning procedures the device offers.

Adding a port forwarding entry

This procedure is needed if you want to use a program which don't support port forwarding via UPnP or NAT natively. Of course you could setup the port forwarding via the gateway's web interface, but the way described here is more comfortable.

The syntax is quite easy:

./igdctl.pl -a -e PORT -i PORT -E REMOTE -I CLIENT -P [TCP|UDP]

Explanation: -a tells the script to add a port mapping entry. -e tells the external port number and -i the internal one. In most cases the port numbers are equivalent. -E tells the remote host. This parameter is optional – in most cases it is left out. -I tells the client address. -P tells the protocol which can be TCP or UDP.

./igdctl.pl -a -e 4332 -i 4332 -I 192.168.0.5 -P TCP

Explanation: This command will setup a TCP port forwarding from the external port 4332 to the internal port 4332 of the client 192.168.0.5.

Removing a port forwarding entry

If you want to remove a port forwarding entry you previously added you can use the remove procedure.

The syntax is as easy as the one above:

./igdctl.pl -R -e PORT -E REMOTE -P [TCP/UDP]

Explanation: span class="system">-R tells the script to remove a previously added port mapping entry. -e tells the external port number. You don't have to specify the internal port number. -E tells the remote host. This parameter is optional. -P tells the protocol which can be TCP or UDP.

./igdctl.pl -R -e 4332 -P TCP

Explanation: This command will remove the previously added port mapping entry (see above).

Printinig a port forwarding entry

You can print information about a port forwarding entry by external port number, remote host and protocol.

The syntax is almost equal to the remove syntax:

./igdctl.pl -g -e PORT -E REMOTE -P [TCP/UDP]

Explanation: span class="system">-g tells the script to print information about a previously added port mapping entry. -e tells the external port number. -E tells the remote host. This parameter is optional. -P tells the protocol.

./igdctl.pl -g -e 4332 -P TCP

Explanation: This command will print the previously added port mapping entry (see above).

Printing a list of all port forwarding entries

If you want to get an overview of all ports being forwarded to clients, use this procedure.

./igdctl.pl -l -I CLIENT

Explanation: -l-I tells the client address. This is optional. Use this if you only want to print entries belonging to a specific client.

./igdctl.pl -l -I 192.168.0.5

Explanation: This will print out all port forwarding entries by 192.168.0.5

Removing all port forwarding entries at once

Quite useful if you want to remove all port forwarding entries globally or by a specific client.

./igdctl.pl -c -I CLIENT

Explanation: -c-I tells the client address. This is optional. Use this if you only want to remove entries belonging to a specific client.

./igdctl.pl -c -I 192.168.0.5

Explanation: This will remove all port forwarding entries by 192.168.0.5

Enabling or disabling internet access globally

You can enable or disable internet access globally if your gateway manufacturer has implemented this functionality.

WARNING: This functionality is almost unimplemented. Don't worry if you get an error.

./igdctl.pl [--enable|--disable]

Explanation: I think the syntax is self-explaining. --enable or --disable tells the script to enable or disable internet access globally.

Listings
igdctl.pl

#!/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 <> 65535))) ||
((($action_add_port) || ($action_remove_port) || ($action_get_port)) && (($external_port <> 65535))) ||
(($action_add_port) && (($duration) && ($duration < help =" 1;"> 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 <>= $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 <>= $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 <>= $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.


Copyright © 2009 Vincent
All Rights Reserved.