#!/usr/bin/perl -w
#
# Konfigurator vtund.
#
# (c)2002 Schuyler Erle & Rob Flickenger
#
################ KONFIGURACJA

# Jeeli warto zmiennej TunnelName jest pusta, konfigurator uyje @ARGV lub $0.
#
# Format konfiguracji - TunnelName, LocalIP, RemoteIP, TunnelHost, TunnelPort, Secret
#
my $TunnelName = ""; 
my $Config   = q{
  home    208.201.239.33 208.201.239.32 208.201.239.5  5000  sHHH
  tunnel2   10.0.1.100       10.0.1.1        192.168.1.4       6001  foobar
};

################ TU ZACZYNA SI GWNA CZʌ PROGRAMU

use POSIX 'tmpnam';
use IO::File;
use File::Basename;
use strict;

# Poszukiwania...
#
$ENV{PATH}  = "/bin:/usr/bin:/usr/local/bin:/sbin:/usr/sbin:/usr/local/[RETURN]sbin";
my $IP_Match = '((?:\d{1,3}\.){3}\d{1,3})';      # dopasowanie do xxx.xxx.xxx.xxx
my $Ifconfig = "ifconfig -a";
my $Netstat = "netstat -rn";
my $Vtund  = "/bin/echo";
my $Debug  = 1;

# Pobieranie szablonu z sekcji danych.
#
my $template = join( "", );

# Otwarcie pliku tymczasowego -- uyto przykadu z Perl Cookbook, Wyd. I, receptura 7.5.
#
my ( $file, $name ) = ("", "");
$name = tmpnam(  )
  until $file = IO::File->new( $name, O_RDWR|O_CREAT|O_EXCL );
END { unlink( $name ) or warn "Nie mog usun pliku tymczasowego $name!\n"; }

# Jeeli zmienna TunnelName nie zawiera adnej wartoci, uywany jest pierwszy argument wiersza polece.
# Jeeli nie ma adnych argumentw uywana jest nazwa, ktr zosta uruchomiony skrypt.
# Umoliwia to tworzenie dowiza symbolicznych do tego samego skryptu o nazwach takich jak nazwy tuneli.
#
$TunnelName ||= shift(@ARGV) || basename($0);
die "Nie potrafi okreli konfiguracji tunelu!\n" unless $TunnelName;

# Przetwarzanie konfiguracji.
#
my ($LocalIP, $RemoteIP, $TunnelHost, $TunnelPort, $Secret);
for (split(/\r*\n+/, $Config)) {
  my ($conf, @vars) = grep( $_ ne "", split( /\s+/ ));
  next if not $conf or $conf =~ /^\s*#/o; # pomijanie pustych wierszy
                                          # i komentarzy 
  if ($conf eq $TunnelName) {
    ($LocalIP, $RemoteIP, $TunnelHost, $TunnelPort, $Secret) = @vars;
    last;
  }
}

die "Nie mog okreli konfiguracji tunelu o nazwie '$TunnelName'!\n"
  unless $RemoteIP and $TunnelHost and $TunnelPort;

# Szukanie bramy domylnej.
#
my ( $GatewayIP, $ExternalDevice );
for (qx{ $Netstat }) {
  # W Linuksie i BSD brama znajduje si w nastpnej pozycji wiersza,
  # a interfejs znajduje si w pozycji ostatniej.
  #
  if ( /^(?:0.0.0.0|default)\s+(\S+)\s+.*?(\S+)\s*$/o ) {
    $GatewayIP = $1;
    $ExternalDevice = $2;
    last;
  }
}

die "Nie mog okreli bramy domylnej!\n" unless $GatewayIP and $ExternalDevice;

# Okrelanie LocalIP oraz LocalNetwork.
#
my ( $LocalNetwork );
my ( $iface, $addr, $up, $network, $mask ) = "";

sub compute_netmask {
  ($addr, $mask) = @_;
  # Musimy maskowa $addr za pomoc $mask, poniewa program Linuksowy /sbin/route
  # ma zastrzeenia, gdy adres sieciowy nie odpowiada masce.
  #
  my @ip = split( /\./, $addr );
  my @mask = split( /\./, $mask );
  $ip[$_] = ($ip[$_] + 0) & ($mask[$_] + 0) for (0..$#ip);
  $addr = join(".", @ip);
  return $addr;
}

for (qx{ $Ifconfig }) {
  last unless defined $_;

  # Jeeli istnieje nowe urzdzenie, trzeba pozby si poprzedniego (jeli byo).
  if ( /^([^\s:]+)/o ) {
    if ( $iface eq $ExternalDevice and $network and $up ) {
      $LocalNetwork = $network;
      last;
    }
    $iface = $1;
    $up = 0;
  }

  # Okrelenie maski biecego interfejsu.
  if ( /addr:$IP_Match.*?mask:$IP_Match/io ) {
    # ifconfig rodzaju linuksowego.
    compute_netmask($1, $2);
    $network = "$addr netmask $mask";
  } elsif ( /inet $IP_Match.*?mask 0x([a-f0-9]{8})/io ) {
    # ifconfig rodzaju BSD.
    ($addr, $mask) = ($1, $2);
    $mask = join(".", map( hex $_, $mask =~ /(..)/gs )); 
    compute_netmask($addr, $mask);
    $network = "$addr/$mask";
  }

  # Interfejsy loopback lub interfejsy nieaktywne s pomijane.
  $iface = "" if /\bLOOPBACK\b/o;
  $up++    if /\bUP\b/o;
}

die "Nie mog okreli lokalnego adresu IP!\n" unless $LocalIP and $LocalNetwork;
# Konfiguracja zmiennych zalenych od systemu operacyjnego.
#
my ( $GW, $NET, $PTP );
if ( $^O eq "linux" ) {
  $GW = "gw"; $PTP = "pointopoint"; $NET = "-net";
} else {
  $GW = $PTP = $NET = "";
}

# Przetwarzanie szablonu konfiguracji.
#
$template =~ s/(\$\w+)/$1/gee;

# Zapis do pliku tymczasowego i uruchomienie programu vtund.
#
if ($Debug) {
  print $template;
} else {
  print $file $template;
  close $file;
  system("$Vtund $name");
}

_  _DATA_  _

options {
  port $TunnelPort;
  ifconfig /sbin/ifconfig;
  route /sbin/route;
}

default {
  compress no;
  speed 0;
}

# Dla automatycznego wyboru konfiguracji zamiast 'mytunnel' powinno w rzeczywistoci by 
# `basename $0` lub co podobnego
$TunnelName {   
  type tun;
  proto tcp;
  keepalive yes;

  pass $Secret;

  up {
   ifconfig "%% $LocalIP $PTP $RemoteIP arp";
   route "add $TunnelHost $GW $GatewayIP";
   route "delete default";
   route "add default $GW $RemoteIP";
   route "add $NET $LocalNetwork $GW $GatewayIP";
  };

  down {
   ifconfig "%% down";
   route "delete default";
   route "delete $TunnelHost $GW $GatewayIP";
   route "delete $NET $LocalNetwork";
   route "add default $GW $GatewayIP";
  };
}
-------------------------
# ln -s vtundconf home 
# ln -s vtundconf tunnel2 
-------------------------
# vtundconf home > /usr/local/etc/vtund.conf 
