Skip to content

Instantly share code, notes, and snippets.

@peterstrapp
Created July 3, 2012 14:24
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save peterstrapp/3040026 to your computer and use it in GitHub Desktop.
Save peterstrapp/3040026 to your computer and use it in GitHub Desktop.
Vincent Wochnik's upnp script
#!/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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment