#!/usr/bin/perl

#####################################
# This script is distributed on the understanding
# that if you make improvements you will return
# them to the community of Perl and Mac users. This
# is pint-ware -- if you find it particularly useful
# a thank you pint would be appreciated but is not
# required.
#
# For more information visit http://www.reades.com/
#
# Please note that I *cannot* offer support on VPN
# configuration from the systems side -- not only
# is each and every VPN different but, frankly, I do
# not know enough about how they work to be of any
# use.
#
# Enjoy,
#          jon reades
####################################

BEGIN {
	# Normally, you will want to
	# keep your script and files
	# here, but definitely the
	# modules
	push @INC, "/etc/racoon/";
}

use constant INPUT_DIR  => '/etc/racoon/';
use constant OUTPUT_DIR => '/etc/racoon/';

use Cwd;
use strict;
use Templates;

if ($ARGV[0] eq "--help") {
	print STDOUT "Usage:\n";
	print STDOUT "\tperl setup.pl config|restart|all\n";
	print STDOUT "\tProfiles.pm should be in " . INPUT_DIR . "\n";
	print STDOUT "\tScripts will be written to " . OUTPUT_DIR . "\n";
	print STDOUT "\tThese can be overidden by passing in either:\n";
	print STDOUT "\t\tprofile=/path/to/alternate/Profile.pm\n";
	print STDOUT "\t\tdir=/path/to/alternate/output/directory\n";
	exit 0;
}

# The default setup
my $profile = INPUT_DIR . "Profiles.pm";
my $dir     = OUTPUT_DIR;
my $to_do   = "restart";

# See if there are any 
# command-line arguments
foreach(@ARGV) {
	my ($key, $val) = split /=/;

	# Override the profile
	$profile = $val if ($key eq 'profile');

	# Override the output directory
	$dir     = $val if ($key eq 'dir');

	# What to do?
	$to_do   = "configure" if ($key eq 'config' || $key eq 'configure');
	$to_do   = "restart"   if ($key eq 'restart');
	$to_do   = "all"       if ($key eq 'all');
}

# Are we generating a config file?
if ($to_do eq 'all' || $to_do eq 'configure') {
	print STDOUT "Using profile $profile to generate configuration files\n";
	print STDOUT "Configuration files will be written to $dir\n";
	generateConfig($profile, $dir);
}

# Are we restarting racoon and setting the tunnels?
if ($to_do eq 'all' || $to_do eq 'restart') {
	print STDOUT "Using configuration files in $dir to restart\n";
	restartRacoon($dir);
}

exit 0;

# Reads in the profile file and splits
# it based on a key => val syntax
sub parseProfile {

	my $profile = shift;
	my %lookup;

	# We slurp it in so that we can 
	# properly handle arrays and hashes
	# spread across multiple lines of
	# the profile file
	my $delimiter = $/;
	$/ = undef;

	open (PROFILE, "<$profile") or die ("Couldn't open profile ($profile) to read: $!");
	my $slurp = <PROFILE>;
	close PROFILE;

	my (@params) = split /\;/, $slurp;

	foreach my $param (@params) {
		# Remove any comments
		$param =~ s|^\#.*?$||gm;

		# Parse out the parameter
		my ($key, $val) = parseParam($param);

		# And assign it to the lookup
		# hash for interpolation
		$lookup{$key} = $val if ($key);
	}
	$/ = $delimiter;
	return \%lookup;
}

sub parseParam {
	my $param = shift;

	# We're assuming that everything
	# after the '=>' is part of the value
	my ($key, $val) = $param =~ m/(\S+)\s+=>\s+(.*)$/s;

	# This 'vivifies' the
	# hash or array
	my $ref = eval ($val);
	return $key, $ref;
}

sub interpolate {
	my $string = shift;
	my $lookup = shift;

#print STDOUT "Subbing: $string\n";

	$string =~ s/@@([^@]+)@@/$lookup->{$1}/g;
	return $string;
}

sub generateConfig {

	my $profile = shift;
	my $dir     = shift;
	my %lookup  = %{parseProfile($profile)};

	# Look for a recognisable IP address
	# on the interface specified in
	# the profile file
	my $match;
	open (IP, "/sbin/ifconfig |") or die ("Couldn't open pipe (/sbin/ifconfig) to read: $!");
	while (<IP>) {
		$match = 'found' if ($_ =~ m|$lookup{INTERFACE}|);
		next if ($match ne 'found');

		if ($_ =~ m|inet ((?:\d{1,3}\.){3}\d{1,3})|) {
			$lookup{CLIENT_IP} = $1;
			last;
		}
	}
	close IP;

	print STDOUT "\nSetting up racoon on " . $lookup{INTERFACE} . " : " . $lookup{CLIENT_IP} . "\n\n";

	############################
	# Set up the psk.txt file
	# for private shared keys
	############################
	print STDOUT "Setting up psk.txt file\n";

        my @copy = ('cp', "$dir/psk.txt", "$dir/psk.bak.txt");
        if (-e "$dir/psk.txt") {
                system(@copy);
                print STDOUT "\t*Backup of previous psk.txt file in psk.bak.txt*\n";
        }

        open (OUT, ">$dir/psk.txt") or die ("Couldn't open $dir/psk.txt to write: $!");

	foreach my $profile (@{$lookup{PROFILES}}) {
		print STDOUT "\tSetting up profile: " . $profile->{NAME} . "\n";

                if (defined $profile->{PSK}) {
                        print OUT interpolate(PSK_FILE_TMPL, $profile);
                } else {
                        print STDOUT "\t\tSkipping: no PSK defined\n";
                        print STDOUT "\t\tThis is fine if you are using certificates.\n";
                }
        }
        close OUT;

        print STDOUT "PSK setup complete\n\n";


	############################
	# Set up the tunnels to be
	# run via a shell script
	############################
	print STDOUT "Setting up tunnels on " . $lookup{INTERFACE} . "\n";
	open (OUT, ">$dir/interface.sh") or die ("Couldn't open $dir/interface.sh to write: $!");
        print OUT SCRIPT_HEADER_TMPL;

	foreach my $profile (@{$lookup{PROFILES}}) {
		print STDOUT "\tSetting up profile: " . $profile->{NAME} . "\n";

		foreach my $network (@{$profile->{NETWORKS}}) {
			print STDOUT "\t\tSetting up subnet: " . $network . "\n";

                        # We will need these in the 
                        # tunnel script so copy them
                        # into the profile
                        $profile->{CLIENT_IP} = $lookup{CLIENT_IP};
			$profile->{NETWORK}   = $network;
			print OUT interpolate(TUNNEL_TMPL, $profile);
		}
	}
	print OUT SCRIPT_FOOTER_TMPL;
	close OUT;

	print STDOUT "Tunnel setup complete.\n\n";


	############################
	# Set up the racoon.conf file
	############################
	print STDOUT "Setting up racoon.conf\n";

	open (OUT, ">$dir/racoon.conf") or die ("Couldn't open $dir/racoon.conf to write: $!");
	print OUT interpolate(RACOON_HEADER_TMPL, \%lookup);

	foreach my $profile (@{$lookup{PROFILES}}) {
		print STDOUT "\tSetting up profile: " . $profile->{NAME} . "\n";
		print OUT interpolate(PROFILE_TMPL, $profile);

                ############################
                # Create a local copy so that
	        # we can overwrite only those
	        # values that need overriding
	        # from the profile itself
	        ############################
                my %local = (%lookup, %{$profile});

                ############################
	        # Set up the remote servers section
	        # of the racoon.conf file
	        ############################
                print STDOUT "\t\tSetting up Remote Server section\n";

                # Set up the connection method
                my $connection_method = "";
                if ($profile->{PSK}) {
                    $connection_method .= interpolate(PSK_TMPL, \%local);
                } elsif ($profile->{CERT}) {
                    $connection_method .= interpolate(CERT_TMPL, \%local);
                } else {
                    die("Uh, you need either a PSK or a CERT section here");
                }
                $local{CONNECTION_METHOD} = $connection_method;
		print OUT interpolate(REMOTE_SERVER_TMPL, \%local);

                ############################
                # Set up the SAInfo section
	        # of the racoon.conf file
	        ############################
                print STDOUT "\t\tSetting up SAInfo section\n";

		foreach my $network (@{$profile->{NETWORKS}}) {
			$local{NETWORK} = $network;
			print OUT interpolate(SAINFO_TMPL, \%local);
		}
	}

	print OUT interpolate(RACOON_FOOTER_TMPL, \%lookup);
	close OUT;

	print STDOUT "Racoon setup complete.\n\n";

	print STDOUT "Until your IP changes you can just run 'sudo ${dir}interface.sh'.\n";
	print STDOUT "Until your IP changes you can just run: 'sudo racoon -f ${dir}racoon.conf'.\n";
	print STDOUT "Alternately, you can just run \`sudo vpn.pl\` and this script will do it all for you.\n";

        my @cmd;
        my $retval;

        (@cmd) = ("/usr/sbin/chown", "-R", "root:wheel", $dir);
        $retval = system(@cmd);
	if ($retval) {
		 print STDOUT "Couldn't change ownership of $dir to root:wheel\n";
	}

        (@cmd) = ('/usr/bin/sudo /usr/bin/find ' . $dir . ' -type f -exec /bin/chmod 600 {} \;');
        $retval = system(@cmd);
	if ($retval) {
		 print STDOUT "Couldn't change mode of files to 600\n";
	}

        (@cmd) = ('/usr/bin/sudo /usr/bin/find ' . $dir . ' -type d -exec /bin/chmod 700 {} \;');
        $retval = system(@cmd);
	if ($retval) {
		 print STDOUT "Couldn't change mode of $dir to 700\n";
	}

	return;
}

sub restartRacoon {
	my $dir = shift;

	print STDOUT "\nRestarting\n";

	my $retval1 = system('sudo', 'killall', 'racoon');
	if ($retval1) {
		 print STDOUT "Couldn't kill any running racoon processes: $retval1\n";
	}
        sleep 1;

	my $retval2 = system ('sudo', '/bin/sh', $dir . '/interface.sh');
	if ($retval2) {
		print STDOUT "Couldn't run interface.sh: $retval2\n";
	}
        sleep 1;

	my $retval3 = system ('sudo', '/usr/sbin/racoon', '-f', $dir . '/racoon.conf');
	if ($retval3) {
		print "Couldn't start racoon: $retval3\n";
	}

	if (!($retval1 || $retval2 || $retval3)) {
		print STDOUT "Restart complete\n";
	}

	return;
}

