Programming :  Student Freelance Forum For Work Experience Builders' (CertificationPoint) The fastest message board... ever.
 
PERL-Watching the error_log File Without Telneting to the Server
Posted by: adcertpoint (Moderator)
Date: April 29, 2020 04:36PM

I wrote this script a long time ago, when I had to debug my CGI scripts but didn't have access to the error_log file. I asked the admin to install this script and have used it happily since then.

If your scripts are running on these 'Get-free-site' servers, and you cannot debug your script because you can't telnet to the server or can't see the error_log, you can ask your sysadmin to install this script.

Note, that it was written for plain Apache, and isn't prepared to handle the complex multiline error and warning messages generated by mod_perl. It also uses a system() call to do the main work with the tail() utility, probably a more efficient perl implementation is due (take a look at File::Tail module). You are welcome to fix it and contribute it back to mod_perl community. Thank you!

Here is the code:
# !/usr/bin/perl -Tw

use strict;

my $default = 10;
my $error_log = "/usr/local/apache/logs/error_log";
use CGI;

# untaint $ENV{PATH}
$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

my $q = new CGI;

my $counts = (defined $q->param('count') and $q->param('count'))
? $q->param('count') : $default;

print $q->header,
$q->start_html(-bgcolor => "white",
-title => "Error logs"winking smiley,
$q->start_form,
$q->center(
$q->b('How many lines to fetch? '),
$q->textfield('count',10,3,3),
$q->submit('', 'Fetch'),
$q->reset,
),
$q->end_form,
$q->hr;

# untaint $counts
$counts = ($counts =~ /(\d+)/) ? $1 : 0;

print($q->b("$error_log doesn't exist!!!"winking smiley),exit unless -e $error_log;

open LOG, "tail -$counts $error_log|"
or die "Can't tail $error_log :$!\n";
my @logs = <LOG>;
close LOG;
# format and colorize each line nicely
foreach (@logs) {
s{
\[(.*?)\]\s* # date
\[(.*?)\]\s* # type of error
\[(.*?)\]\s* # client part
(.*) # the message
}
{
"[$1] <BR> [".
colorize($2,$2).
"] <BR> [$3] <PRE>".
colorize($2,$4).
"</PRE>"
}ex;
print "<BR>$_<BR>";
}



#############
sub colorize{
my ($type,$context) = @_;

my %colors =
(
error => 'red',
crit => 'black',
notice => 'green',
warn => 'brown',
);

return exists $colors{$type}
? qq{<B><FONT COLOR="$colors{$type}">$context</FONT></B>}
: $context;
}

Options: ReplyQuote


Sorry, only registered users may post in this forum.
This forum powered by Phorum.