#!/usr/athena/bin/perl -w
# zwrite.pl  --  adapted from zwrite.c

use Term::ReadLine;
use POSIX;
use Zephyr;

$DEFAULT_CLASS = "MESSAGE";
$DEFAULT_INSTANCE = "PERSONAL";
$URGENT_INSTANCE = "URGENT";
$DEFAULT_OPCODE = "";
$FILSRV_CLASS = "FILSRV";

usage() if (scalar(@ARGV) < 1);

$auth = Zephyr::ZAUTH();
$verbose = 0;
$quiet = 0;
$msgarg  = 0;
$nocheck = 0;
$filsys = 0;
$nodot = 0;
$tabexpand  = 1;
$format = "";

$class = Zephyr::GetVariable("zwrite-class");
$class = $DEFAULT_CLASS if not defined($class);

$inst = Zephyr::GetVariable("zwrite-inst");
$inst = $DEFAULT_INSTANCE if not defined($inst);

$opcode = Zephyr::GetVariable("zwrite-opcode");
$opcode = $DEFAULT_OPCODE if not defined($opcode);

while (@ARGV and not $msgarg) {
    my $arg = shift @ARGV;
    if ($arg !~ /^-/) {
	push @recips,$arg;
	next;
    }
    usage() if (length($arg)>2);
    $arg = substr($arg,1,1);
    if ($arg eq "a") {
	$auth = Zephyr::ZAUTH();
    } elsif ($arg eq "o") {
	$class  = $DEFAULT_CLASS;
	$inst   = $DEFAULT_INSTANCE;
	$opcode = $DEFAULT_OPCODE;
    } elsif ($arg eq "d") {
	$auth = Zephyr::ZNOAUTH();
    } elsif ($arg eq "v") {
	$verbose = 1;
    } elsif ($arg eq "q") {
	$quiet = 1;
    } elsif ($arg eq "n") {
	$nocheck = 1;
    } elsif ($arg eq "t") {
	$tabexpand = 0;
    } elsif ($arg eq "u") {
	$inst = URGENT_INSTANCE;
    } elsif ($arg eq "O") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$opcode = $arg;
    } elsif ($arg eq "i") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$inst = $arg;
	$filsys = -1;
    } elsif ($arg eq "c") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$class = $arg;
	$filsys = -1;
    } elsif ($arg eq "f") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$class = $FILSRV_CLASS;
	$inst = fix_filsrv_inst($arg);
	$filsys = 1;
	$nocheck = 1;
    } elsif ($arg eq "s") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$signature = $arg;
    } elsif ($arg eq "m") {
	usage() if not scalar(@ARGV);
	$nocheck = 1;
	$msgarg = join(" ",@ARGV);
    } elsif ($arg eq "l") {
	$nodot = 1;
    } elsif ($arg eq "F") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$format = $arg;
    } elsif ($arg eq "r") {
	$arg = shift @ARGV;
	usage() if  not defined($arg);
	$realm = $arg;
    } elsif ($arg eq "C") {
	$cc = 1;
    } else {
	usage();
    }
}

if (not defined($signature)) {
    my @pwd = getpwnam($ENV{USER});
    $signature = $pwd[6];
    $signature =~ s/,.*//;
}

if (not scalar(@recips) and (($class eq $DEFAULT_CLASS and 
			      ($inst eq $DEFAULT_INSTANCE) or
			      ($inst eq $URGENT_INSTANCE)))) {
    print STDERR "No recipients specified.\n";
    usage();
}

if (not $format) {
  if ($filsys == 1) {
    $pingformat = '@bold(Filesystem Operation Message for $instance:)\n' .
      'From: @bold($sender) at $time $date\n$message';
  } elsif ($auth == Zephyr::ZAUTH()) {
    if ($signature) {
      $pingformat = 'Class $class, Instance $instance:\n'.
	'To: @bold($recipient) at $time $date\n'.
	  'From: @bold($1) <$sender>\n\n$2';
    } else {
      $pingformat = 'Class $class, Instance $instance:\n'.
	'To: @bold($recipient) at $time $date\n$message';
    } 
  } else {
    if ($signature) {
      $pingformat = '@bold(UNAUTHENTIC) Class $class, '.
	'Instance $instance at $time $date:\n'.
	  'From: @bold($1) <$sender>\n\n$2';
    } else {
      $pingformat = '@bold(UNAUTHENTIC) Class $class, '.
	'Instance $instance at $time $date:\n$message';
    }
  }
}

my $notice = new Zephyr::Notice('kind' => Zephyr::ACKED(),
				'port' => 0,
				'auth' => $auth,
				'opcode' => "PING",
				'format' => $pingformat);

if (scalar(@recips)) {
    my $targets = [];
    foreach my $recip (@recips) {
	push @$targets,[$class,$inst,$realm?"$recip\@$realm":$recip];
    }
    $notice->set('targets',$targets);
} else {
    my $targets = [$class,$inst,$realm?"\@$realm":""];
    $notice->set('targets',[$targets]);
}

if (not $nocheck and scalar(@recips)) {
    send_off($notice,0);
}

if (not $msgarg and POSIX::isatty(STDIN)) {
  if ($nodot) {
    print "Type your message now.  End with the end-of-file character.\n"
  } else {
    print "Type your message now.  End with control-D or a dot on a line by itself.\n";
  }
}

if ($signature) {
  $message = $signature;
} else {
  $message = "";
}

if ($cc and scalar(@recips) > 1) {
  $message = "CC: ".join(",",@recips).$message;
}

if ($msgarg) {
  $message = join(" ",@ARGV)."\n";
} else {
  $message = "";
  if (POSIX::isatty(STDIN)) {
    my $term = new Term::ReadLine('');
    while (defined($_ = $term->readline("")) and $_ ne '.') {
      $message .= "$_\n";
    }
  } else {
    while (defined( $_ = <STDIN>)) { $message .= $_; }
  }
}
$notice->set('opcode',$opcode);

$message =~ s/\t/        /gs if ($tabexpand);
my @ref = ($signature,$message);
$notice->set('message',\@ref);
send_off($notice,1);
exit(0);

sub send_off {
  my ($notice,$real) = @_;
  my $success = 0;

  my @sents = $notice->send();

  foreach my $sent (@sents) {
    my $notice = $sent->[0];
    my @targets = $notice->getTargets();
    my ($class,$inst,$recip) = @{$targets[0]};
    
    if ($recip) {
      $dest = $recip;
    } elsif ($class eq $DEFAULT_CLASS) {
      $dest = "instance \"$inst\"";
    } elsif ($inst eq $DEFAULT_INSTANCE) {
      $dest = "class \"$class\"";
    } else {
      $dest = "class \"$class\" instance \"$inst\"";
    }

    if ($real && not $quiet) {
	print "Message queued for $dest... ";
    }
    if (not ($retnotice = Zephyr::PeekIfNotice(Zephyr::PRED_UID(),
					       $notice->getUID()))) {
      print STDERR "Error while waiting for acknowledgement for $dest\n";
      next;
    }

    if ($retnotice->getKind() != Zephyr::SERVACK()) {
      print "Detected server failure while receiving ".
	"acknowledgement for $dest\n" if not $quiet;
      next;
    }
    my @msg = $retnotice->getMessage();
    if ($msg[0] eq Zephyr::ZSRVACK_SENT()) {
      $success = 1;
      print "sent\n" if ($real and not $quiet);
    } elsif ($msg[0] eq Zephyr::ZSRVACK_NOTSENT()) {
      if ($verbose and $real and not $quiet) {
	if ($class ne $DEFAULT_CLASS) {
	  print STDERR "Not logged in or not subscribing to class ",
	  "$class, instance $inst\n";
	} else {
	  print STDERR "Not logged in or not subscribing to messages\n";
	}
      } elsif (not $quiet) {
	if (not scalar @recips) {
	  print STDERR "No on subscribing to class $class",
	      ", instance $inst\n";
	} else {
	  if ($class ne $DEFAULT_CLASS) {
	    print STDERR "$recip: Not logged in or not subscribing to class ",
	    "$class, instance $inst\n";
	  } else {
	    print STDERR "$recip: Not logged in or not subscribing to messages\n";
	  }
	}
      }
    } else {
      print "Internal failure - illegal message field in server response\n";
    }
  }
  exit(1) if (not $success);
}

sub usage {
  print STDERR "Usage: $0 [-a] [-o] [-d] [-v] [-q] [-n] [-t] [-u] [-l]\n\
\t[-c class] [-i inst] [-O opcode] [-f fsname] [-s signature] [-C]\n\
\t[user ...] [-F format] [-r realm] [-m message]\n";
  print STDERR "\t-f and -c are mutually exclusive\n\
\t-f and -i are mutually exclusive\n\
\trecipients must be specified unless -c or -f specifies a class\n\
\tother than the default class or -i or -f specifies an instance\n\
\tother than the default or urgent instance\n";
  exit(1);
}