CGI faxstat & browser

[Phil Abercrombie <Philip.Abercrombie@MCS.VUW.AC.NZ>]

Here's a useful little tool I put together for monitoring our fax
server.  Put this perl script in your cgi-bin directory and make sure
you modify FAXSERVER as required.  You'll need to get CGI and libNet
from your local CPAN site (see http://www.perl.com/CPAN)

What you get is a tables-based view of the current modem status,
sendq, doneq and recvq, with clickable links to detailed job
information, and clickable links to tiff and postscript documents.

The script attempts to contact the server with the $REMOTE_USER
username and no password.  This is not particularly clever, and I am
open to ideas.

I am also open (wide open!) to suggestions for functionality to add,
(e.g., to emulate faxrm better, to add faxalter-style functions, to
allow users to log in using the fax system password so they can query
their own documents and no others), especially if they come with
user-interface suggestions too!

        -phil

#!/usr/local/bin/perl

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

$FAXSERVER = "downstage";
$HYLAFAX   = 4559;

my $cgi = new CGI;

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->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 ($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;
  my @results = <$cx>;
  $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;
  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)
    {
      $_->{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 $self = $cgi->self_url;
      
      print <<JOB;
<TR>
<TD><A HREF="$self">$_->{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 "Cannot retrieve job info";
  my @job=<$cx> or die "No job info available";
  $cx->close or die "Data connection error";

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

  print "<TABLE BORDER>\n";
  for (@job)
  {
    chomp;
    $cgi->delete("poscript","tiff");
    my ($key,$val)=split(/:/,$_,2);
    $val = localtime($val) if $key eq 'tts' || $key =~ /time$/;
    if ($key =~ /postscript|tiff/)
    {     
      my $param = ($& eq postscript)?"ps":"tiff";
      my ($ref) = ($val =~ m!(docq/\S+)!);
      $cgi->param($param,$ref);
      my $self = $cgi->self_url;
      $val =~ s!docq/\S+!<a href="$self">$&</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 "Cannot retrieve postscript file";
  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 "Cannot retrieve tiff file";
  my @job=<$cx>;
  $cx->close or die "Data connection error";

  print CGI->header( "image/tiff" );
  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 );
}