Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Punch hole inbound for Apple NAT-PMP Router

by merlyn (Sage)
on Jan 01, 2008 at 04:52 UTC ( [id://659847]=sourcecode: print w/replies, xml ) Need Help??
Category: Networking Code
Author/Contact Info merlyn
Description: Recent apple base-stations understand the Apple-created (but open documented) "NAT-PMP" protocol to dynamically establish forwarded ports. This is similar to the uPnP protocol for windows-compatible firewalls.

I couldn't find any existing tool to forward an arbitrary port, but hey, it's just simple UDP, so I whipped up this Perl program to do the forwarding.

Adjust the capitalized configuration constants in this program as follows:

$GATEWAY
Internal IP address of your NAT-PMP-enabled router
$PROTO
1 = udp, 2 = tcp
$EXTERNAL
external port on router to map
$INTERNAL
internal port on your box to map to
$TIME
Time in seconds to keep alive (max one hour = 3600)
Then let it run in the background. It'll start by printing the external IP address of the router if all goes well, and then it'll start mapping the port. Every half of $TIME (as recommended), it'll renew the mapping for another $TIME seconds.

Quick and dirty. No warrantees expressed or implied.


#!/usr/bin/env perl
use strict;
$|++;

use Socket;
use IO::Socket::INET;

BEGIN {

  my $GATEWAY = "10.0.1.1";
  my $sock = IO::Socket::INET->new(Proto => 'udp') or die;
  my $pmp = sockaddr_in(5351, inet_aton($GATEWAY));

  sub chat {
    my $to_send = shift;
    send($sock, $to_send, 0, $pmp) or die "send: $!";
    my $portaddr = recv($sock, my $incoming, 256, 0) or die "recv: $!"
+;
    return sockaddr_in($portaddr), $incoming;
  }
}

{
  ## get external IP:
  my @r = chat(pack("C C", 0, 0));
  my ($vers, $op, $result, $epoch, @ip) =
    unpack "C C n N C C C C", $r[2];
  print "$vers $op $result $epoch @ip\n";
}

my $PROTO = 2; # 1 = udp, 2 = tcp
my $EXTERNAL = 8000;
my $INTERNAL = 80;
my $TIME = 3600; # seconds (max is 3600)

while (1) {
  ## map external to internal
  my @r = chat(pack("C C n n n N", 0, $PROTO, 0, $INTERNAL, $EXTERNAL,
+ $TIME));
  my ($vers, $op, $result, $epoch, $priv, $pub, $life) =
    unpack "C C n N n n N", $r[2];
  print "$vers $op $result $epoch $priv $pub $life\n";
  sleep $TIME / 2; # recommended
}

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://659847]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2024-04-24 05:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found