# NASD::Client.pm
#
# Base class for the NASD scriptable clients
#
# Author: Nat Lanza
#
# Copyright (c) of Carnegie Mellon University, 2000.
#
# Permission to reproduce, use, and prepare derivative works of
# this software for internal use is granted provided the copyright
# and "No Warranty" statements are included with all reproductions
# and derivative works. This software may also be redistributed
# without charge provided that the copyright and "No Warranty"
# statements are included in all redistributions.
#
# NO WARRANTY. THIS SOFTWARE IS FURNISHED ON AN "AS IS" BASIS.
# CARNEGIE MELLON UNIVERSITY MAKES NO WARRANTIES OF ANY KIND, EITHER
# EXPRESSED OR IMPLIED AS TO THE MATTER INCLUDING, BUT NOT LIMITED
# TO: WARRANTY OF FITNESS FOR PURPOSE OR MERCHANTABILITY, EXCLUSIVITY
# OF RESULTS OR RESULTS OBTAINED FROM USE OF THIS SOFTWARE. CARNEGIE
# MELLON UNIVERSITY DOES NOT MAKE ANY WARRANTY OF ANY KIND WITH RESPECT
# TO FREEDOM FROM PATENT, TRADEMARK, OR COPYRIGHT INFRINGEMENT.
#

package NASD::Client;

use strict;
use FileHandle;
use IO::File;
use POSIX qw(:sys_wait_h);
use Fcntl;

my $_DEFAULT_VERSION = '1.00';

sub new {
  my ($class, %args) = @_;

  my $self = bless {}, (ref($class) || $class);

  $self->{version} = $_DEFAULT_VERSION;

  for (keys %args) { $self->{$_} = $args{$_}; }

  return $self;
}


sub DESTROY { $_[0]->shutdown_client; }


sub _init {
  my ($self) = @_;
  
  ($self->{_read_fh},        $self->{_childout_fh})     = FileHandle::pipe();
  ($self->{_childin_fh},     $self->{_write_fh})        = FileHandle::pipe();
  ($self->{_childdatain_fh}, $self->{_datawrite_fh})    = FileHandle::pipe();
  ($self->{_dataread_fh},    $self->{_childdataout_fh}) = FileHandle::pipe();
  
  $self->{_read_fh}->autoflush(1);
  $self->{_write_fh}->autoflush(1);
  $self->{_dataread_fh}->autoflush(1);
  $self->{_datawrite_fh}->autoflush(1);

  my $cpath;
  if (defined $ENV{NASD_ROOT}) {
    $cpath = $ENV{NASD_ROOT} . "/" . $self->{client_prog};
  } else {
    $cpath = "../../" . $self->{client_prog};
  }

  if (! -x $cpath) { die "Can't find the client program '$cpath'!\n"; }

  if ($self->{_pid} = fork) { # parent
    $SIG{CHLD} = sub { 1 while (waitpid(-1, WNOHANG)) > 0 };
  } else { #child
    open STDIN, "<&=". $self->{_childin_fh}->fileno()
      or die "Couldn't dup stdin in child: $!\n";
    open STDOUT, ">&=" . $self->{_childout_fh}->fileno()
      or die "Couldn't dup stdout in child: $!\n";

    $self->{_childdatain_fh}->fcntl(Fcntl::F_SETFD(), 0);
    $self->{_childdataout_fh}->fcntl(Fcntl::F_SETFD(), 0);

    exec($cpath, $self->{_childdatain_fh}->fileno,
	 $self->{_childdataout_fh}->fileno);

    die "Couldn't exec the script client: $!";
  }

  my ($kind, $output) = $self->get_response;
  
  if ($kind) {
    if ($output =~ /^VERSION\s+([0-9.]+)/) {
      if ($1 ne $self->get_version) { $self->abort("Bad version $1!\n"); }
    } else { $self->abort("Couldn't understand version line!\n"); }
  } else {
    if (defined $kind) { $self->abort("Client gave us an error: $1\n"); }
    else               { $self->abort("Got weird line '$output'\n");    }
  }
}


sub abort {
  my ($self, @msg) = @_;
  $self->shutdown_client();
  die @msg;
}


sub shutdown_client {
  my ($self) = @_;
  
  $self->{_read_fh}->close();
  $self->{_write_fh}->close();
}


sub send_command {
  my ($self, @args) = @_;

  my $cmdline = join ' ', @args;

  $self->{_write_fh}->print($cmdline, "\n");
}


sub get_response {
  my ($self) = @_;
  my $read = $self->{_read_fh};

  my $line = $read->getline;
  chomp($line);

  my ($num, $type);

  if ($line =~ /^([.!\#])\s+([0-9]+)$/) { $type = $1; $num = $2; }
  else { abort "Couldn't understand start line '$line'!\n"; }

  my $data = ""; my $i;
  for ($i = 0; $i < $num; $i++) { $data .= $read->getline; }

  chomp($data);

  if    ($type eq '.') { return (1, $data);     }
  elsif ($type eq '!') { return (0, $data);     }
  else                 { return (undef, $data); }
}


sub send_data {
  my ($self, $data) = @_;
  my $write = $self->{_write_fh};

  return $write->syswrite($data);
}


sub get_data {
  my ($self, $length) = @_;

  my $data = "";

  my $got = $self->{_dataread_fh}->sysread($data, $length);

  print STDERR "Short read! expected $length bytes, got $got.\n"
    if ($got != $length);
  
  return $data;
}

sub get_version { $_[0]->{version}; }
sub get_client_prog { $_[0]->{client_prog}; }
1;
