#!/usr/bin/perl
#  $HeadURL$ $LastChangedRevision$
my($progname) = ($0 =~ /.*\/([^\/]*)$/);

use strict;
use Socket;
use Carp;
use File::Basename;
use Sys::Syslog;
use POSIX qw(setsid);
use Cwd 'abs_path';

my($modroot) = $ENV{'MDI_MODROOT'} ? ($ENV{'MDI_MODROOT'}) : (abs_path($0) =~ /(.*)\/bin\/[^\/]+$/);
if (! -d "$modroot/lib/helpers") { 
    print STDERR "$progname: ERROR: can't find components (do you need to set 'MDI_MODROOT'?)\n";
    exit(1);
}

#  Load config and support functions
#  (none)

#  Globals
my ($mdi_cmd, $releaseserver_port);
$mdi_cmd = $modroot . "/bin/mdi";
$releaseserver_port = 55000;   

sub main
{
    my ($uname, $release_cmdline);
    my ($paddr, $name, $iaddr, $eol, $proto, $output, $pid);

    $eol   = "\015\012";
    $proto = getprotobyname('tcp');

    #  initiate logging
    openlog($progname, "pid", "local0") || die "openlog: $!\n";

    #  become a daemon
    $SIG{INT} = $SIG{TERM} = sub { &log("exiting on SIG$_[0] ..."); exit 0; };
    &log("detaching from terminal ...");
    open STDIN, '/dev/null' || die "can't read /dev/null: $!";
    open STDOUT, '>/dev/null';
    open STDERR, '>/dev/null'; 
    POSIX::setsid() || die "can't detach from tty : $!\n";
    umask(0);
    defined($pid=fork) || die "fork failed: $!\n";
    return (0) if ($pid);

    #  start listening
    &log("starting listening ...");
    socket(Server, PF_INET, SOCK_STREAM, $proto)               || die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
    bind(Server, sockaddr_in($releaseserver_port, INADDR_ANY)) || die "bind: $!";
    listen(Server,SOMAXCONN)                                   || die "listen: $!";

    #  process all incoming connections
    while (1) {
        #  Get uname from socket
        &log("awaiting connection ...");
        $paddr = accept(Client,Server); 
        #  First parameter returned by sockaddr_in() is the port number
        #  again and as we know this we discard it into undef.
        (undef,$iaddr) = sockaddr_in($paddr);
        $name = gethostbyaddr($iaddr,AF_INET);
        $name =~ s/\..*$//;
        $name = "<not-resolvable>" if (!$name);
        &log("connection established from $name");
        chomp($uname = <Client>);
        close Client;

        #  Tell mdi that its being called by the releaser and, as such, it should
        #  not delete VMs and their storage.
        $ENV{'RELEASER_FLAG'} = 'true';

        $release_cmdline = "$mdi_cmd delete $uname";
        &log("release command is [$release_cmdline]");

        chomp($output = `$release_cmdline 2>&1`);
        &log("output was [$output]");
    }
}

sub log { syslog("info", $_[0]); }

main(@ARGV);