#!/usr/bin/perl
# by Rocco Stanzione  2006-01-17
#################################################################
# Socket/Expect server to:                                      #
#   * Open a tcp socket and listen for connections              #
#   * Launch Framemaker via dzbatcher via wine                  #
#   * Accept filenames on the socket to be converted by         #
#       Framemaker to .mif                                      #
#   * Return the new filename to the client via the socket      #
#################################################################

# listen on this address and port
my $addr      = "127.0.0.1";  # 0.0.0.0 to accept remote connections
my $port      = 26989;

# how to run dzbatcher
my $wine      = "/opt/cxoffice/bin/wine";
my $display   = ":2";    # the display to use for framemaker
my $timeout   = 60;      # how long to wait for a dzbatcher prompt
my $tmpdrive  = "t:";    # wine's drive mapped to $tmpdir
my $tmpdir    = "/tmp";  # real path to the work directory

my $logfile   = "/tmp/dzexpect.log";

#################### END CONFIG ###############################

my $prompt    = qr/dzbatcher->/;
my $stoned    = qr/RETURN|Usage|unknown/;

use IO::Socket;
use Expect;
use File::Glob qw(:globally :nocase);
use DateTime;

sub logprint {
	# Print the supplied message to stdout and $logfile
	open(LOGFILE,">>$logfile") or print "Warning: unable to open log $logfile\n";
	my $msg = shift;
	chomp($msg);
	print "$msg\n";
	$msg = DateTime->now() . ": " . $msg;
	if($dzb) {
		$dzb->print_log_file("$msg\n");
	} else {
		print LOGFILE "$msg\n";
	}
	close(LOGFILE);
}

sub dzbexpect {
	# This subroutine contains init-script-like functionality for
	# the expect part of the server: start, stop and restart
	my $arg  = shift;
	my $wine = shift;
	my $log  = shift;
	my $dzbatcher = ($wine,"--display",$display,"dzbatcher");
	if($_[0] == "start") {
		my $dzb = Expect->spawn($wine,"--display",$display,"dzbatcher") 
			or die "Failed to run dzbatcher: $!\n";
		&logprint("dzbatcher started with pid " . $dzb->pid() . "\n");
		$dzb->log_file($log, "w");
		return $dzb;
	} elsif($_[0] == "restart") {
		$dzb->hard_close();
		my $dzb = Expect->spawn($wine,"--display",$display,"dzbatcher") 
			or die "Failed to run dzbatcher: $!\n";
		$dzb->log_file($log, "w");
		&logprint("dzbatcher started with pid " . $dzb->pid() . "\n");
		return $dzb;
	} elsif($_[0] == "stop") {
		$dzb->hard_close();
	} else {
		my $dzb = Expect->spawn($wine,"--display",$display,"dzbatcher") 
			or die "Failed to run dzbatcher: $!\n";
		$dzb->log_file($log, "w");
		&logprint("dzbatcher started with pid " . $dzb->pid() . "\n");
		return $dzb;
	}
}

&logprint("Starting");

$dzb = &dzbexpect("start",$wine,$logfile);

sub openfm($) {
	# Open what is currently presumed to be an existing .fm file
	local $fmfile = "$tmpdrive\\" . shift;
	$dzb->expect($timeout, 
		[ $prompt => sub {
			my $dzb = shift;
			$dzb->send("Open $fmfile\n"); 
			&logprint("Opened $fmfile\n");
			}
		],
		[ $stoned => sub { 
			return "Stoned dzbatcher prompt.\n"; 
			&dzbexpect("restart");
			&dzbatch($fmfile);
			} 
		]
	);
}

sub saveasmif($$) {
	# Convert a currently-open framemaker file to .mif
	&logprint("Preparing to save\n");
	local $fmfile  = "$tmpdrive\\" . $_[0]; 
	local $miffile = "$tmpdrive\\" . $_[1];
	chomp($fmfile);
	chomp($miffile);
	$dzb->expect($timeout, 
		[ $prompt => sub {
			my $dzb = shift;
			$dzb->send("SaveAs -m $fmfile $miffile\n");
			&logprint("Saved $fmfile as $miffile\n");
			}
		],
		[ $stoned => sub { return "Stoned dzbatcher prompt.\n"; } ]
	);
	return $miffile;
}

sub closefile {
	# Close an open .mif file
	local $openfile = "$tmpdrive\\$_[0]";
	$dzb->expect($timeout, 
		[ $prompt => sub {
			my $dzb = shift;
			$dzb->send("Close $openfile\n"); 
			&logprint("Closed $openfile\n");
			}
		],
		[ $stoned => sub { return "Stoned dzbatcher prompt.\n"; } ]
	);
}

sub listopen {
	# List all files currently open by framemaker
	$dzb->expect($timeout,
		[ $prompt => return sub {
			my $dzb = shift;
			$dzb->send("ListOpen\n");
			$dzb->expect(5, /.+/);
			return $dzb->after();
			}
		]
	);
}

sub cleanup {
	unlink(glob("$tmpdir/*.{mif,fm}.lck}"));
}

sub dzbatch {
	# perform all required operations on a .fm file to
	# convert it to .mif and get ready for the next
	# conversion operation
	$fm  = $_[0];
	$mif = $fm . ".mif";
	&openfm($fm);
	&saveasmif($fm,$mif);
	&closefile($mif);
	&cleanup;
	return $mif;
}

# create a reusable socket, bind to port, listen
socket(SERVER, 2, 1, 6) or die "socket: $!\n";
bind(SERVER, pack('S n a4 x8', 2, $port, inet_aton($addr))) or die "bind: $!\n";
listen(SERVER, SOMAXCONN) or die "listen: $!\n";
&logprint("Listening on $addr:$port\n");

# accepting a connection
my $client_addr;
while ($client_addr = accept(CLIENT, SERVER)) {
	my ($client_port, $client_ip) = sockaddr_in($client_addr);
	my $client_ipnum = inet_ntoa($client_ip);
	my $client_host  = gethostbyaddr($client_ip, AF_INET);
	&logprint("Got a connection from: $client_host", "[$client_ipnum]\n");
	while ($m=<CLIENT>) {
		chomp($m);
		my $framefile = "$tmpdir/$m";
		if (-z $framefile) {
			print CLIENT "$framefile is an empty file.\n";
			close CLIENT;
		} else {
			my $newfile = &dzbatch($m);
			print CLIENT "$newfile\n";
			close CLIENT;
			&logprint("$client_ipnum disconnected\n");
			&logprint("Deleting $framefile\n");
			if ($newfile) {
				unlink $framefile;
			}
		}
	}
}