use strict;
use warnings;
#use diagnostics;

use lib ".";


use Net::UPnP::ControlPoint;
use Net::UPnP::GW::Gateway;

my $obj = Net::UPnP::ControlPoint->new();

my $retry_cnt = 0;
my @dev_list = ();
while (@dev_list <= 0 || $retry_cnt > 5) {
    #@dev_list = $obj->search(st =>'urn:schemas-upnp-org:device:Intern
+etGatewayDevice:1', mx => 10);
    @dev_list = $obj->search(st =>'upnp:rootdevice', mx => 3);
    $retry_cnt++;
    print Dumper(@dev_list);

 }

my $devNum = 0;
foreach my $dev (@dev_list) {
    my $device_type = $dev->getdevicetype();
    if  ($device_type ne 'urn:schemas-upnp-org:device:InternetGatewayD
+evice:1') {
        next;
    }
    print "[$devNum] : " . $dev->getfriendlyname() . "\n";
    unless ($dev->getservicebyname('urn:schemas-upnp-org:service:WANIP
+Connection:1')) {
        next;
    }
    my $gwdev = Net::UPnP::GW::Gateway->new();
    $gwdev->setdevice($dev);
    print "\tExternalIPAddress = " . $gwdev->getexternalipaddress() . 
+"\n";
    print "\tPortMappingNumberOfEntries = " . $gwdev->getportmappingnu
+mberofentries() . "\n";
    my @port_mapping = $gwdev->getportmappingentry();
    my $port_num = 0;
    foreach my $port_entry (@port_mapping) {
        if ($port_entry) {
            my $port_map_name = $port_entry->{'NewPortMappingDescripti
+on'};
            if (length($port_map_name) <= 0) {
                $port_map_name = "(No name)";
            }
            print "  [$port_num] : $port_map_name\n";
            foreach my $name ( keys %{$port_entry} ) {
                print "    $name = $port_entry->{$name}\n";
            }
        }
        else {
            print "  [$port_num] : Unknown\n";
        }
        $port_num++;
    }
}
[download]

Your router needs to support UPnP.
You might need to enable it through some sort of router control panel.

However, these details are very model specific. You should google for it, search for something like "UPnP <insert model name here>".


acid06
perl -e "print pack('h*', 16369646), scalar reverse $="