#!/usr/local/bin/perl -wT
#
# NAME  faxstat.pl - CGI interface to interrogating HylaFAX server
#                    by Phil Abercrombie <phil@mcs.vuw.ac.nz>, September 1997
#
# SYNOPSIS
#
#    http://www/cgi-bin/faxstat.pl
#    http://www/cgi-bin/faxstat.pl?FAXSERVER=localhostname.net
#    http://www/cgi-bin/faxstat.pl?j=2000
#    http://www/cgi-bin/faxstat.pl?ps=docq%2Fdoc17777.ps
#    http://www/cgi-bin/faxstat.pl?fax=recvq%2Ffax00009.fax
#
#    http://www/cgi-bin/faxstat.pl?d=2000
#
# DESCRIPTION
#
#   C<faxstat.pl> implements a web interface to querying a HylaFAX server,
#   in a manner similar to L<faxstat(1)>.
#
#   With no HTTP parameters, an HTML page is generated listing faxes in the
#   sendq (queued, not yet sent), the doneq (queued and sent), and the
#   recvq (faxes received).
#
#   With a C<j=nnnn> parameter, an HTML page is generated containing all the
#   job info for job nnnn.
#
#   With a C<ps=xxx> parameter, the script attempts to access the document named xxx
#   and serve it as content type application/postscript
#
#   With a C<fax=xxx> parameter, the script attempts to access the document named xxx
#   and serve is as content type image/fax
#
#   With a C<d=nnnn> parameter, the script attempts to delete the pending (or
#   completed) job nnnn.
#
# Other HTTP parameters
#
#   FAXSERVER
#
#   FAXSERVER may be used with any of the above to nominate the host which
#   the script should attempt to query.  In practice it might be easier to
#   edit the code.
#
#   debug
#
#   The value of the C<debug> parameter will be passed to the C<debug>
#   method of the C<Net::FTP> object used internally.  Note that debugging
#   is to STDERR so will probably appear in your server log
#
# BUGS
#
#   There is no way to contact the HylaFAX server as a particular
#   (authenticated) user, other than by relying on the www server to do
#   authentication and to require no passwords on the hylafax server.
#   That sucks.
#
#   Doesn't read the system hyla.conf file for FAXSERVER
#

# <PJA> 19-Sep-1997
# Added POD

use CGI;
use Config;
use Net::FTP;

my $cgi = new CGI;
$FAXSERVER = $cgi->param("FAXSERVER")||"localhostname.com";
$HYLAFAX   = 4559;


eval{&main};
if ($@)
{
  my $a=$@;
  print CGI->header,CGI->start_html("Error"), "<P>", join ("<BR>", split "\n", "$a"), CGI->end_html;
  die $a
}



sub main
{
  my $hfax = new Net::FTP $FAXSERVER, Port=>$HYLAFAX
    or die "Can't connect to host $FAXSERVER";
  $hfax->debug($cgi->param("debug"));
  $hfax->login(CGI->remote_user)
    or die "Can't login to host $FAXSERVER";
  $hfax->binary;

  if ($cgi->param("ps"))
  {
    &psinfo($hfax, $cgi->param("ps"))
  }
  elsif ($cgi->param("tiff"))
  {
    &tiffinfo($hfax, $cgi->param("tiff"))
  }
  elsif ($in{comm})
  {
    &comminfo($hfax, "log/c$in{comm}")
  }
  elsif ($cgi->param("d"))
  {
    &killjob($hfax, $cgi->param("d"))

  }
  elsif ($cgi->param("j"))
  {
    &jobinfo($hfax, $cgi->param("j"))
  }
  else
  {
    &faxstat($hfax)
  }
}

sub list ($@)
{
  my $hfax = shift;
  my $cx = $hfax->list(@_) || die $hfax->message;
  my @results;

  # <PJA> 19-Sep-1997
  # handle continuation lines correctly
  while(<$cx>)
  {
    if($results[$#results]=~ /\\\n$/)
    {
	$results[$#results].=$_;
    }
    else
    {
	push(@results,$_);
    }
  }
  $cx->close;
  @results;
}

sub list_jobs($@)
{
  my $hfax = shift;
  map do { my %d; @d{"a".."z","A".."Z"}=split /$;/; \%d }, list $hfax, @_;
}

sub faxstat
{
  my $hfax = shift;
  my $jobfmt = join "$;", map "%$_", "a".."z", "A".."Z";

  print CGI->header;
  print CGI->start_html("Fax System Status");
  print "<H1>Fax System Status</H1>\n";


  my @status = map [split(/:/)], list $hfax, "status";

  $hfax->quot("JOBFMT","\"$jobfmt\"") or die $hfax->message;
  my @send = list_jobs $hfax, "sendq";
  $hfax->quot("JOBFMT","\"$jobfmt\"");
  die $hfax->message unless $hfax->ok;
  my @done = list_jobs $hfax, "doneq";
  $hfax->quot("RCVFMT","\"$jobfmt\"");
  die $hfax->message unless $hfax->ok;
  my @recv = list_jobs $hfax, "recvq";

  print "<H2>Status</H2><TABLE BORDER>\n";
  for(@status)
  {
    for($_->[1])
    {
	if (/job (\d+)/)
	{
	   $cgi->param(j=>$1);
	   my $surl = $cgi->self_url;
	   s!job (\d+)!job <A href="$surl">$1</a>!g;
	   $cgi->delete("j");
	}
    }
    print "<TR>", map( "<TD>$_</TD>", @$_), "</TR>\n";
  }
  print "</TABLE>\n";

  &show_outq( "Jobs in Send Queue", @send );
  &show_outq( "Jobs in Done Queue", @done );
  &show_inq( "Jobs in Receive Queue", @recv );

  print CGI->end_html;
}

sub show_outq
{
  my $title = shift;
  my @jobs = @_;

  if (@jobs)
  {
    print qq{<H2>$title</H2>\n<TABLE BORDER>\n};
    print "<TR>",map "<TH>$_</TH>",
    "Job", "Sender", "To","Dials","Pages","Status";
    print "</TR>\n";
    for(@jobs)
    {
	my $k;
	for $k (keys %$_){$_->{$k} ||= "&nbsp;"};

	$_->{"e"} =~ s/^\+644/+64&nbsp;4&nbsp;/;
	$_->{"s"} =~ s/ /&nbsp;/g;

	$cgi->param(j=>$_->{j});
	my $self = $cgi->self_url;
	print <<JOB;
<TR>
<TD><A HREF="$self">$_->{j}</a></TD>
<TD><A HREF="mailto:$_->{M}">$_->{M}</a></TD>
<TD><TT>$_->{e}</TT></TD>
<TD>$_->{D}</TD>
<TD>$_->{P}</TD>
<TD>$_->{"s"}</TD>
</TR>
JOB
  ;
    }
    print "</TABLE>\n";
  }
}

sub show_inq
{
  my $title = shift;
  my @jobs = @_;
  my $self = $cgi->self_url;

  if (@jobs)
  {
    print qq{<H2>$title</H2>\n<TABLE BORDER>\n};
    print "<TR>",map "<TH>$_</TH>",
    "Filename", "Sender/TSI", "Pages","Received@";
    print "</TR>\n";
    for(@jobs)
    {
	$cgi->param(tiff=>"recvq/$_->{f}");
	my $myself = $cgi->self_url;

	print <<JOB;
<TR>
<TD><A HREF="$myself">$_->{f}</a></TD>
<TD><TT>$_->{"s"}</TT></TD>
<TD>$_->{p}$_->{z}</TD>
<TD>$_->{t}</TD>
</TR>
JOB
  ;
    }
    print "</TABLE>\n";
  }
}

sub jobinfo
{
  my $hfax = shift;
  my $job = shift;
  my $cx;
  my $self = CGI->script_name;

  print CGI->header;
  print CGI->start_html("Fax Job Info");

  print "<H1>Job Info for job $job</H1>\n";

  $cx = $hfax->retr( "sendq/q$job" ) || $hfax->retr( "doneq/q$job" ) || die $hfax->message;
  my @job;
  while(<$cx>)
  {
    if(@job && $job[$#job] =~ s/\\$/<BR>/)
    {
	$job[$#job] .= $_;
    }
    else
    {
	push(@job,$_);
    }    
  }

  die "No job info available" unless @job;
  $cx->close or die "Data connection error";

  $cgi->param(d=>$job);
  my $myself=$cgi->self_url;
  print qq{<A HREF="$myself">Delete Me</A>\n};
  $cgi->delete('d');

  print "<TABLE BORDER>\n";
  for (@job)
  {
    chomp;
    $cgi->delete("ps","tiff","comm");
    my ($key,$val)=split(/:/,$_,2);
    $val = localtime($val) if $key eq 'tts' || $key =~ /time$/;
    if ($key =~ /postscript|tiff|fax/)
    {
	my $param = ($& eq "postscript")?"ps":"tiff";
	my ($ref) = ($val =~ m!(docq/\S+)!);
	$cgi->param($param,$ref);
	my $myself = $cgi->self_url;
	$val =~ s!docq/\S+!<a href="$myself">$&</a>!;
    }
    elsif($key eq commid)
    {
      $cgi->param(comm=>$val);
      my $self = $cgi->self_url;
      $val = qq{<A HREF="$self">$val</A>};
    }

    print "<TR><TD>$key</TD><TD>$val</TD></TR>\n";
  }
  print "</TABLE>\n";

  print CGI->end_html;
}

sub psinfo
{
  my $hfax = shift;
  my $psfile = shift;

  $cx = $hfax->retr( $psfile ) || die $hfax->message;
  my @job=<$cx>;
  $cx->close or die "Data connection error";

  print CGI->header( "application/postscript" );
  print @job;
}

sub tiffinfo
{
  my $hfax = shift;
  my $tiff = shift;

  $cx = $hfax->retr( $tiff ) || die $hfax->message;
  my @job=<$cx>;
  $cx->close or die "Data connection error";

  print CGI->header( "image/tiff" );
  print @job;
}

sub comminfo
{
  my $hfax = shift;
  my $comm = shift;

  $cx = $hfax->retr( $comm ) || die $hfax->message;
  my @job=<$cx>;
  $cx->close or die "Data connection error";

  print CGI->header( "text/plain" );
  print @job;
}

sub killjob
{
  my $hfax = shift;
  my $job = shift;
  $hfax->quot( "JSUSP", $job );
  my ($mess,$ok)=($hfax->message, $hfax->ok);
  $hfax->quot( "JDELE", $job );
  die "$mess\n".$hfax->message unless $hfax->ok;

  print CGI->redirect( $cgi->self_url );
}