#!/usr/bin/perl

# splitp -- de-facto standard split-tunnel autoconfiguration
#
# PROCEDURE:
# Cleans up bad routes installed by some -nodefaultroute tunneled PPP sessions
# Installs pin-down routes for remote tunnel endpoint IP 
# Sends a DHCP Inform to a PPP peer after LCP configuration completes
# Retrieves subnet mask and ip static routes option from a DHCP Ack response
# Installs interface-based routes as per the retrieved values
# If no DHCP Ack is received installs a classful route based on local address
#
# LICENSE:
# version 0.1 Copyright (c) 2007 Clark University by Brian S. Julin
# Redistributable under terms of the BSD License
#
# USAGE:
# This script may be installed directly in /etc/ppp/ip-up.d
# It uses the same positional commandline parameters or environment variables
# as either /etc/ppp/ip-up or any script in /etc/ppp/ip-up.d/
# 
# REQUIREMENTS:
# This script requires a functional iproute/iproute2 package/utility.
#
# TODO:
# Works only on linux.  Darwin/BSD require a plugin.
# This code will currently break if the VPN sends a default route.
# Add options 6, 15 (DNS) and 44 (WINS), in case desired (and then do what??)
# If needed to fully ape an MS box, use option 43 with vendor ID "MSFT 5.0"

######################## Configuration Section ##############################
# Which PPP sessions should use this?
# You'll need to make sure these strings are passed in the "ipparam" option
# in the options files for each connection that has DHCPInform split tunnelling
#
@isvpn{ qw(tunnel vpn vpn_tunnel pptp) } = ();
#
# Set nonzero if classful route should be installed when DHCP fails.
$do_classful = 1;
#
###################### End configuration section ############################

use IO::Socket::INET;


# Load ppp variables.  Works both for ip-up and for ip-up.d/*
# If called as a sub-script, make sure ENV is exported or pass by commandline.
@pppv = qw(PPP_IFACE PPP_TTY PPP_SPEED PPP_LOCAL PPP_REMOTE PPP_IPPARAM);
@pppv{@pppv} = exists($ENV{PPP_IFACE}) ? @ENV{@pppv} : @ARGV[0..5];
# Unencumber frequently used variables
($laddr, $raddr, $iface) = @pppv{qw(PPP_LOCAL PPP_REMOTE PPP_IFACE)};


# Connection eligibility and sanity check
exit unless exists $isvpn{$pppv{PPP_IPPARAM}};
$ipre = qr/\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/;
(warn "Cannot proceed without valid PPP link info\n"), exit 
    unless "$iface#$raddr#$laddr" =~ m/\A[\w\d]+#$ipre#$ipre\Z/;


# Some VPNs may send their ISKMP address as the remote PPP address, which 
# is outside the local side net/mask -- PPP addresses are usually ornamental.
# Some pppds may install a host route in this case, causing a packet loop.
# (ESP packets are sent back into the tunnel rather than directly to the VPN.)

# Remove bad route to ornamental PPP address.
# (If the route is not there we just get/ignore an error.)
system('ip', 'route', 'del', "$raddr/32", 'dev', $iface);

# Put in pin-down host routes to the VPN tunnel endpoint IP through 
# all the normal routing paths already being used to reach it.
for my $route (qx(ip route list match $raddr)) {
    next if $route =~ m"\Q$raddr\E( |/32)"; # Already a host route
    next unless $route =~ m/\s+(via|dev)\s+(\S+)/;
    system('ip', 'route', 'add', "$raddr/32", $1, $2);
}

# Build a VPN/L2TP DHCPInform packet.
$tid = time(); @tid = unpack("C4", pack("L", $tid));
@dinf = (1,8,6,0, @tid,                           # header + transaction ID
	 0, 1, 0, 0, $laddr =~ m/(\d+)/g,         # flags + client IP
	 (0)x12,                                  # unused fields
	 0, @tid , 0,                             # fake but legal "MAC"
	 (0)x204,                                 # unused fields
	 0x63, 0x82, 0x53, 0x63,                  # DHCP magic cookie
	 0x35, 0x01, 0x08,                        # message type Inform
	 0x37, 0x02, 1, 249,                      # parameter request list
         0xff, 00                                 # end of options + pad
	 );
$dinf = pack('C*', @dinf);

# The DHCPInform is sent to the broadcast address
$dio = new IO::Socket::INET(
           Proto => 'udp', Timeout => 1, Broadcast => 1, ReuseAddr => 1, 
           LocalAddr => $laddr, LocalPort => 68,
           PeerAddr => inet_ntoa(INADDR_BROADCAST), PeerPort => 67
           ) or die ("Could not create outgoing socket $@\n");
$dio->autoflush(1);

# The DHCPAck comes in from the VPN unicast address as a unicast
$dri = new IO::Socket::INET(
           Proto => 'udp', Timeout => 1, ReuseAddr => 1, Blocking => 0,
           LocalAddr => $laddr, LocalPort => 68,
           PeerAddr => $raddr, PeerPort => 67
           ) or die ("Could not create incoming socket $@\n");
$dri->autoflush(1);

# Temporarily remove reverse path filtering on the interface
open (FILTER, "+</proc/sys/net/ipv4/conf/$iface/rp_filter");
$wasrpf = <FILTER>; 
print FILTER "0\n"; 
seek(FILTER,0,0); 

# Send out DHCPInform requests and grab DHCPAck results
for (1..5) {
    $dio->send($dinf);
    sleep 1;
    $dri->recv($dgram, 500);
    $scrape = $dgram if length($dgram) > length($scrape);
}

# Restore reverse path filtering
print FILTER "$wasrpf"; 
close FILTER;

# Clean up sockets
($dio, $dri) = ();

# Check if we actually have anything to work with
(warn "No split-tunnel DHCPInform seen\n"), exit unless (length($scrape));

# Get options area of packet
%dop = (unpack("(C C/a)*", ($scrape =~ m/\x63\x82\x53\x63(.*)\xff\Z/smig)[0]));

# Parse the static routes option -- FIXME: note 0/0 route may break if present
%r = (reverse unpack("(C X C/B xxxx)*",$dop{249})); 
%r = (map { (join(".", unpack("C4", pack("B*", $_) . "\0\0\0\0")), $r{$_}) } 
      keys %r );
# for mask use: join(".", unpack("C4", pack("B32", "1" x $r{$_} . "0" x 32)))

# Use subnet mask to construct a route in case it is not explicitly provided
$snet = unpack("L",pack("C4", $laddr =~ m/(\d+)/g));
if (exists($dop{1})) {
    $smsk = unpack("L",$dop{1});
    $snet &= $smsk;
    $snet = join(".", unpack("C4",pack("L",$snet)));
    $smsk = unpack("%32b32",$dop{1});
    # for mask use: $smsk = join ".", unpack("C4",$dop{1});
    $r{$snet} = $smsk;
}
if ($do_classful and not (keys(%r) + 0)) {
    $laddr =~ m/\A(\d+)/;
    $smsk = (($1 + 0) & 0xc0) >> 6;
    $smsk = 1 if !$smsk;
    $smsk *= 8;
    $snet &= unpack("L",pack("B32", 1 x (32 - $smsk), 0 x 32));
    $snet = join(".", unpack("C4",pack("L",$snet)));
    $r{$snet} = $smsk;
}

# TODO: Add an option to reject routes to certain networks or to networks
# of too large a class, for when the VPN is not entirely trustworthy.

# Install the split-tunnel routes
while (($n, $m) = each %r) {
    system('ip', 'route', 'add', "$n/$m", 'dev', $iface);
}