|
Hylafax Mailing List Archives
|
[Date Prev][Date Next][Thread Prev][Thread Next]
[Date Index]
[Thread Index]
Re: cgi-script
-----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} ||= " "};
$_->{"e"} =~ s/^\+644/+64 4 /;
$_->{"s"} =~ s/ / /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-----
