upnp-control.pl

#!/usr/bin/perl

use strict;

use Data::Dumper;
use Net::UPnP::ControlPoint;
use Net::UPnP::Device;

my $output = <<"_DATA_";
upnp-control.pl - List, Add or Delete port mapping of your UPnP powered router.

Usage: perl upnp-control.pl [operation] <port_number>

Operations
  list:   List all port mapping entries
  add:    Add new port mapping entry
  delete: Delete port mapping entry
_DATA_

my $op   = shift;
my $port = shift;

if ($op) {
  # Get local IP address
  chomp(my $hostname = `hostname`);
  my $ip = join(".", unpack("C4", (gethostbyname($hostname))[4]));

  # Get UPnP devices
  my $cp = Net::UPnP::ControlPoint->new();
  my @devices;

  foreach my $device ($cp->search(st => 'upnp:rootdevice', mx => '1')) {
    if ($device->getdevicetype() =~ m/^urn:schemas-upnp-org:device:InternetGatewayDevice:1$/) {
      push @devices, $device;
    }
  }

  # Select 1st device (buggy)
  my $device = $devices[0];

  # Get WANIPConnection service
  my $service = $device->getservicebyname("urn:schemas-upnp-org:service:WANIPConnection:1");

  # List port mapping entries
  if ($op eq "list") {
    $output = "";

    for (my $i = 0; $i > -1; $i++) {
      my %arguments = (
        'NewPortMappingIndex' => $i
      );

      my $response = $service->postaction("GetGenericPortMappingEntry", \%arguments);

      if ($response->getstatuscode() != 200) {
        $output = "There is no port mapping entries.\n" if $i == 0;
        last;
      }

      $output .= Dumper($response);
    }
  }
  # Add port mapping
  elsif ($op eq "add") {
    my %arguments = (
      'NewRemoteHost'             => "",
      'NewExternalPort'           => $port,
      'NewProtocol'               => "TCP",
      'NewInternalPort'           => $port,
      'NewInternalClient'         => $ip,
      'NewEnabled'                => 1,
      'NewPortMappingDescription' => "upnp-control.pl",
      'NewLeaseDuration'          => 0
    );

    my $response = $service->postaction("AddPortMapping", \%arguments);

    $output = Dumper($response);
  }
  # Delete port mapping
  elsif ($op eq "delete") {
    my %arguments = (
      'NewRemoteHost'   => "",
      'NewExternalPort' => $port,
      'NewProtocol'     => "TCP"
    );

    my $response = $service->postaction("DeletePortMapping", \%arguments);

    $output = Dumper($response);
  }
}

print $output;

exit;