#!/usr/bin/perl
use Net::POP3;
use Digest::MD5;
use Getopt::Std;
$ConfFile = "/etc/ppp/dtcp.conf";
$AddrFile = "/var/run/dtcp.addr";
$StopFile = "/tmp/dtcp.stop";
$LogFile  = "/var/log/dtcp.log";
$ENV{'PATH'} = "/sbin:/usr/sbin:/bin:/usr/bin";
$U_ID = 65534;
$G_ID = 65534;

getopts('rxd') || &help;
$Repeat = $opt_r;
$Debug = $opt_d;
if ($opt_x) {
    open(OUT, ">$StopFile") || die;
    chown $U_ID, $G_ID, $StopFile;
    close(OUT);
    exit 0;
}
if (-f $AddrFile) {
    unlink $AddrFile;
}

open(CONF, $ConfFile) || die;
while (<CONF>) {
    chop;
    next if /^#/ || /^$/;
    last;
}
die unless /^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)$/;
$host = $1;
$port = $2;
$user = $3;
$pass = $4;
close(CONF);
open(LOG, ">>$LogFile") || open(LOG, ">&STDERR");
select(LOG);
$| = 1;
select(stdout);
print LOG &strtime(time), " host=$host port=$port user=$user\n";

if (!open(DTCP, "-|")) {
    $| = 1;
    ($(,$)) = ($G_ID, $G_ID);  # gid: nogroup
    ($<,$>) = ($U_ID, $U_ID);  # uid: nobody
    while (! &dtcp($host, $port, $user, $pass) && $Repeat) {
	sleep 10;
	print STDERR "reconnecting...\n" if $Debug;
    }
    exit 0;
}
$ret = 1;
while (<DTCP>) {
    s/[\r\n]*$//;
    last unless /^\d+\.\d+\.\d+\.\d+$/;
    $remote = $_;
    system "ip -6 tunnel del sit1";
    if (open(OUT, ">$AddrFile")) {
	print OUT "$remote\n";
	close(OUT);
    }
    print STDERR "execute: ifconfig sit0 up tunnel ::$remote\n" if $Debug;
    system "ifconfig sit0 up tunnel ::$remote";
    exit 0 unless $Repeat;
    $ret = 0;
}
if (-f $AddrFile) {
    unlink $AddrFile;
}
exit $ret;

sub help {
    print <<EOF;
Usage: setup-dtcp <opt>
opt:   -r     ; reconnect
       -x     ; stop
       -d     ; debug
EOF
    exit 1;
}

sub dtcp {
    my ($host, $port, $user, $pass) = @_;
    my $pop = Net::POP3->new($host, Port => $port, Debug => $Debug);
    return undef unless $pop;
    my $banner = ${*$pop}{'net_pop3_banner'};
    if ($banner =~ /^(\S+)\s/) {
	$banner = $1;
    } else {
	print LOG &strtime(time), " Unknown banner: $banner\n";
	$pop->close();
	return undef;
    }

    my $md = Digest::MD5->new();
    $md->add($user, $banner, $pass);
    my $cmd = $pop->command('tunnel', $user, $md->hexdigest, 'network');
    my $response = $cmd->getline();
    $pop->debug_print(0, $response) if $Debug;
    if ($response =~ /^\+OK\s+(\d+\.\d+\.\d+\.\d+)\s+(\d+\.\d+\.\d+\.\d+)\s+([\d\:a-fA-F]+)\/(\d+)/) {
	($local, $remote, $prefix, $nbits) = ($1, $2, $3, $4);
    } else {
	$response =~ s/[\r\n]*$//;
	print LOG &strtime(time), " Unknown response: $response\n";
	$pop->close();
	return undef;
    }
    print LOG &strtime(time), " local=$local remote=$remote network=$prefix/$nbits\n";
    print "$remote\n";

    while (1) {
	sleep 30;
	my $cmd = $pop->command('ping');
	my $pong = $cmd->getline();
	$pop->debug_print(0, $pong) if $Debug;
	unless ($pong =~ /^\+OK pong/) {
	    $pong =~ s/[\r\n]*$//;
	    print LOG &strtime(time), " Unknown pong: $pong\n";
	    $pop->close();
	    return undef;
	}
	if (-f $StopFile) {
	    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		$atime,$mtime,$ctime,$blksize,$blocks) = stat($StopFile);
	    if ($uid == $U_ID) {
		print LOG &strtime(time), " found $StopFile, terminating\n";
		unlink $StopFile;
		last;
	    }
	}
    }
    $response = $pop->command('quit')->getline();
    $pop->debug_print(0, $response) if $Debug;
    $pop->close();
    return 1;
}

sub strtime {
    my ($time) = @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime($time);
    sprintf("%4d-%02d-%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec);
}