#!/usr/bin/perl -w

# $Id: confMon.pl,v 1.14 2007/08/29 13:45:08 swick Exp $

# Continuously monitors the Zakim teleconference schedule as known
# by the bridge hardware and reports the state as RDF.
#
# Author: Ralph R. Swick
# Date: 5 June, 2002

# Copyright 2002 World Wide Web Consortium, (Massachusetts Institute
# of Technology, Institut National de Recherche en Informatique et en
# Automatique, Keio University).

# All Rights Reserved. http://www.w3.org/Consortium/Legal/

# This W3C work (including software, documents, or other related
# items) is being provided by the copyright holders under the
# following license. By obtaining, using and/or copying this work, you
# (the licensee) agree that you have read, understood, and will comply
# with the following terms and conditions:

# Permission to use, copy, modify, and distribute this software and its
# documentation, with or without modification, for any purpose and
# without fee or royalty is hereby granted, provided that you include
# the following on ALL copies of the software and documentation or
# portions thereof, including modifications, that you make:

# 1. The full text of this NOTICE in a location viewable to users of
# the redistributed or derivative work.

# 2. Any pre-existing intellectual property disclaimers, notices, or
# terms and conditions. If none exist, a short notice of the following
# form (hypertext is preferred, text is permitted) should be used
# within the body of any redistributed or derivative code: "Copyright
# © [$date-of-software] World Wide Web Consortium, (Massachusetts
# Institute of Technology, Institut National de Recherche en
# Informatique et en Automatique, Keio University). All Rights
# Reserved. http://www.w3.org/Consortium/Legal/"

# 3. Notice of any changes or modifications to the W3C files,
# including the date changes were made. (We recommend you provide URIs
# to the location from which the code is derived.)

# THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT
# HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED,
# INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
# FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
# OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS,
# COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.

# COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT,
# SPECIAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF ANY USE OF THE
# SOFTWARE OR DOCUMENTATION.

# The name and trademarks of copyright holders may NOT be used in
# advertising or publicity pertaining to the software without
# specific, written prior permission. Title to copyright in this
# software and any associated documentation will at all times remain
# with copyright holders.

# To Do:
# - Parameterize the start and end of Daylight Savings Time

   use strict;
   use FileHandle;
   use File::Basename;
   use Getopt::Long;
   use IO::Socket::INET;
   use IO::Select;
   use POSIX qw(strftime);
   use Time::Local;

   my $STX = v2;
   my $ETX = v3;

my $lastTick = undef;

my $bridge = undef;		# host:port of bridge
my $debug = 0;			# 1 to output debug trace
my $logfn = undef;		# path to log all data received from the MAT
my $RDF_output = "/dev/null";	# path to write the RDF output
my $TEXT_output = undef;	# path to write text version of schedule
my $hidden_codes = undef;	# regex to match name for unpublished confcode

my %Conference;

sub checksum($)
{
    my ($data) = @_;
    my ($xorsum, $bytesum) = (2^3, 2+3); # includes STX and ETX
    for (my $p = 0; $p < length($data); $p++) {
	my $c = ord(substr($data, $p, 1));
	$xorsum ^= $c;
	$bytesum += $c;
	$xorsum &= 0xff;
	$bytesum &= 0xff;
    }


    $xorsum = sprintf("%02X", $xorsum);
    $bytesum = sprintf("%02X", $bytesum);

    return ($xorsum, $bytesum);
}

my @receiveQueue;

sub response($;$)
{
    my ($sock, $logfile) = @_;
    my $s = IO::Select->new($sock);
    my $line;

    while (not (defined($line))) {
	unless (defined $receiveQueue[0]) {
	    my $buff;
	    my $rval = recv($sock, $buff, 2048,0);
	    if (!defined $rval || !$buff) {
		print "lost bridge connection\n" if $debug;
		die "quitting";
	    }
	    @receiveQueue = split(/$STX/o, $buff);
	    print "read $#receiveQueue msgs\n" if $debug;
	}

	($line,my $chk) = split(/$ETX/o, shift(@receiveQueue));

	if (not defined $line) {
	    next;
	}
	if (not defined $chk) {
	    $chk = "";
	}
	if ($line =~ m/^t~/o) {
	    $lastTick = $line;
	    $line = undef;
	    next;
	}
#	print $lastTick, "\n" if $lastTick && $debug;
	my ($xor, $byte) = checksum($line);
	print "heard: ", $line, " [", $chk, "]\n" if $debug;
	if ("$xor$byte" ne $chk) { print ">> checksum mismatch ($xor$byte) <<\n" }
	if (defined $logfile) {
	    print $logfile $lastTick, "\n" if $lastTick;
	    print $logfile $line, " [", $chk, "]\n";
	}
#	$lastTick = undef;
    }
    print "returning '$line'\n" if $debug;
    return $line;
}

sub transmit($$)
{
    my ($sock, $command) = @_;

    my ($xor, $byte) = checksum($command);

    my $msg = $STX.$command.$ETX.$xor.$byte;

    print "sending '$msg'\n" if $debug;

    $sock->send($msg, 0)
}

sub parseConfRec($)
{
    my ($entry) = @_;
    print $entry, "\n" if $debug;
    my (undef, $a, $record, $c, $hcode, $gcode, $date, $time,
	$duration, $i, $j, $confName, $schedID, $ports,
	$n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z)
      = split('~', $entry);
    print "Duplicate conference record number $record for $date, schedID $schedID\n"
	if $Conference{$record};

    $schedID =~ s/^0*//;

    $Conference{$record}->{hcode} = $hcode;
    $Conference{$record}->{gcode} = $gcode;
    $Conference{$record}->{date} = $date;
    $Conference{$record}->{time} = $time;
    $Conference{$record}->{duration} = $duration;
    $Conference{$record}->{name} = $confName;
    $Conference{$record}->{schedID} = $schedID;
    $Conference{$record}->{ports} = $ports;
}

my $logfh;
my $sock;

sub getConf
{
    my $usage="usage: ".basename($0,".pl")." [-debug] [-hide regex] [-log path] [-rdf path] [-text path] -bridge host:port\n";

    print '$Id: confMon.pl,v 1.14 2007/08/29 13:45:08 swick Exp $',"\n"
	if $debug;

    die $usage unless GetOptions (
	'bridge=s'	=> \$bridge,
	'debug!'	=> \$debug,
	'hide=s'	=> \$hidden_codes,
	'log=s'		=> \$logfn,
	'rdf=s'		=> \$RDF_output,
	'text=s'	=> \$TEXT_output,
	) && @ARGV<3;

    die "-bridge must be specified" unless $bridge;

    $sock = IO::Socket::INET->new(PeerAddr => $bridge,
				     Proto => "tcp",
                                    )
    or die "cannot connect to server $bridge";

    if (defined $sock->timeout()) {
        print "timeout is ", $sock->timeout(), "\n";
    }

    if ($logfn) {
	$logfh = new FileHandle;
	$logfh->open(">>$logfn") or die "can't open $logfn";
	$logfh->autoflush;
    }

    {
	my $CCI = response($sock, $logfh);
    }

    my $WOC = "??";

    {
	my $CCC = response($sock, $logfh);
	(undef, $WOC) = split('~', $CCC);
	$WOC++;
	print "This is WOC $WOC\n" if $debug;
    }

    transmit($sock, 't');

    transmit($sock, 'WG');
    {
	response($sock, $logfh);
    }

    transmit($sock, "F~ZAKIM confMon started; OP $WOC");
    {
	response($sock, $logfh);
    }

    {
	my $entry = '';
	my $continue = 0;

	while ($entry !~ m/^wUD/) {
	    transmit($sock, "wU~$continue");
	    $entry = response($sock, $logfh);
	    parseConfRec($entry) if ($entry =~ m/^wUL/);
	    $continue = 1;
	}
    }

#    while (1) {
#	response($sock, $logfh);
#    }

#    close ($sock)            || die "close: $!";
#    $logfh->close;
}

sub xml_escape ($) {
  my $string=shift;
  $string =~ s/\&/\&amp;/g;
  $string =~ s/</\&lt;/g;
  $string =~ s/>/\&gt;/g;
  $string =~ s/[\x00-\x1F]//g;  # remove ASCII 0-31
  $string =~ s/([\x80-\xFF])/"\&#".ord($1).";"/ge; # escape ASCII 128-255
  return $string;
}

sub dumpConf
{
    my @list = sort {$Conference{$a}->{date}.
			 $Conference{$a}->{time}.
			     $Conference{$a}->{name}
				 cmp
		     $Conference{$b}->{date}.
			 $Conference{$b}->{time}.
			     $Conference{$b}->{name}}
	           keys %Conference;

    my ($tick_month, $tick_day, $tick_year, $tick_hour, $tick_minute);
    if ($lastTick) {
	(undef, $tick_month, $tick_day, $tick_year, $tick_hour, $tick_minute, undef)
	    = split('~', $lastTick);
    }

    if ($TEXT_output) {
	open( TEXT, ">$TEXT_output") or die "cannot open $TEXT_output for writing";
	printf TEXT "As of %d-%02d-%02dT%02d:%02d there are ",
		$tick_year, $tick_month, $tick_day, $tick_hour, $tick_minute;
	print TEXT $#list, " conferences in the directory:\n";
    }

    open( RDF, ">$RDF_output") or die "cannot open $RDF_output for writing";
    print RDF "<?xml-stylesheet type=\"text/css\" href=\"http://www.w3.org/2002/06/conf-style.css\" ?>
<rdf:RDF 
    xml:base=\"http://www.w3.org/1998/12/bridge/conferences\"
    xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
    xmlns:rdfs=\"http://www.w3.org/2000/01/rdf-schema#\"
    xmlns:dc=\"http://purl.org/dc/elements/1.1/\" 
    xmlns:conf=\"http://www.w3.org/2002/06/conf#\">\n\n";

    print RDF '<rdf:Description rdf:about="">
  <dc:date>', strftime( "%Y-%m-%dT%H:%MZ",
			gmtime( timelocal( 0, $tick_minute, $tick_hour,
					   $tick_day, $tick_month-1,
					   $tick_year)
			      )
		      ), '</dc:date>
</rdf:Description>
';

    foreach my $c (@list)
    {
	printf TEXT "%8s %8s %4s %s\n",
	    $Conference{$c}->{schedID},
	    $Conference{$c}->{date},
	    $Conference{$c}->{time},
	    $Conference{$c}->{name}
	  if $TEXT_output;

	next if $Conference{$c}->{date} eq "";

	$Conference{$c}->{date} =~ m/(\d\d\d\d)(\d\d)(\d\d)/;
	my ($year, $month, $day) = ($1, $2, $3);
	$Conference{$c}->{time} =~ m/(\d\d)(\d\d)/;
	my ($hour, $min) = ($1, $2);

	# convert local time to UTC
	my $start_tm = timelocal(0, $min, $hour, $day, $month-1, $year);
	my $start = strftime( "%Y-%m-%dT%H:%MZ", gmtime($start_tm) );

	print RDF "<conf:ScheduledConference rdf:about='#m",
	    $Conference{$c}->{schedID},
	    "'>\n",
	    "  <conf:id>", $Conference{$c}->{schedID}, "</conf:id>\n";
	print RDF "  <conf:code>", $Conference{$c}->{gcode}, "</conf:code>\n"
	  unless $hidden_codes && $Conference{$c}->{name} =~ m/$hidden_codes/;

	# delete the time, empty '()'s, and trailing '_' from the conf name
	# remove the magic '*' first.
	my $shortName = $Conference{$c}->{name};
	$shortName =~ s/\((.*)\*(.*)\)/\($1$2\)/;
	$shortName =~ s/_?(\(\))?\d+:\d+[AP]M$//;

	print RDF "  <conf:name>", xml_escape($Conference{$c}->{name}), "</conf:name>\n",
            "  <rdfs:label>", xml_escape($shortName), "</rdfs:label>\n",
	    "  <conf:start>", $start, "</conf:start>\n",
	    "  <conf:duration>", $Conference{$c}->{duration}, "</conf:duration>\n",
	    "  <conf:ports>", $Conference{$c}->{ports}, "</conf:ports>\n",
	    "</conf:ScheduledConference>\n\n";
    }

    print RDF "</rdf:RDF>\n";
    close RDF;
    close TEXT if $TEXT_output;
}

sub main
{
    getConf;
    dumpConf;

    while (1) {
	my $msg = response($sock, $logfh);
	my $changed = undef;
	if ($msg =~ m/^uU~V~/) {
	    parseConfRec($msg);
	    $changed = 1;
	}
	elsif ($msg =~ m/^uU~R~/) {
	    my (undef, undef, $record, $a, $b) = split('~', $msg);
	    printf "deleting %8s %s\n",
		  $Conference{$record}->{schedID},
		  $Conference{$record}->{name}
	      if $debug;
	    delete $Conference{$record};
	    $changed = 1;
	}
	dumpConf if $changed;
    }
}

&main;

exit;
