Re: flexfax: cgi-script

[Nico Garcia <raoul@cirl.meei.harvard.edu>]

-----BEGIN PGP SIGNED MESSAGE-----

On Wed, 3 Dec 1997 abehrens@datarupt.sax.de wrote:

> I am looking for a cgi-script to request faxstat over Apache.
> thanks.

Phil Abercrombie wrote this one:

   #!/usr/local/bin/perl -wT

   =head1 NAME

   faxstat.pl - CGI interface to interrogating HylaFAX server

   =head1 SYNOPSIS

    http://www/cgi-bin/faxstat.pl
    http://www/cgi-bin/faxstat.pl?FAXSERVER=faxserver.com
    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

   =head1 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.

   =head2 Other HTTP parameters

   =over 4

   =item 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.

   =item 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

   =back

   =head1 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


   =head1 AUTHOR

   Phil Abercrombie <phil@mcs.vuw.ac.nz>, September 1997

   =cut
   #';# emacs

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

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

   my $cgi = new CGI;
   $FAXSERVER = $cgi->param("FAXSERVER")||"faxserver";
   $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 ($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");
       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>!;
       }

       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/fax" );
     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 );
   }


-----BEGIN PGP SIGNATURE-----
Version: 2.6.2

iQCVAwUBNIf20T/+ItycgIJRAQHoDwP/XUpgvOgEhfB58cR1fZW656owjketWRkn
uu6nHnwllzLmQRBr7wF6yHXsnRO4usP2mYGD1XiTugtdZZfZJwOqHoFyGYVMnlkJ
A/+MZ/FvVEdRk303NHWFLQqGZZD2QgxH5KalbZua4hEsgWrdBzkhg1MQu+Ea0v5H
om8yJ7/8TgQ=
=Ckp8
-----END PGP SIGNATURE-----