[Bio] / FigWebServices / Emergency.cgi Repository:
ViewVC logotype

View of /FigWebServices/Emergency.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.21 - (download) (annotate)
Tue Sep 9 20:58:27 2008 UTC (11 years, 5 months ago) by parrello
Branch: MAIN
CVS Tags: rast_rel_2008_12_18, rast_2008_0924, rast_rel_2008_09_30, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, mgrast_rel_2008_0625, rast_rel_2008_10_09, rast_release_2008_09_29, mgrast_rel_2008_0923, mgrast_rel_2008_0919, mgrast_rel_2008_1110, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, rast_rel_2008_11_24
Changes since 1.20: +1 -1 lines
Fixed host pattern to allow more segments.

#!/usr/bin/perl -w

use strict;
use Tracer qw(:DEFAULT PrintLine);
use CGI;
use CGI::Cookie;
use FIG_Config;
use FIGRules;
use LogReader;

=head1 EmergencyTracing

This script configures emergency tracing and displays the trace file. Emergency tracing
is used to debug web and command-line applications. A cookie is stored on the user's
computer that the web applications use to determine what to trace and where to put the
messages. This script is generally run from the Debug Console in the NMPDR Wiki, where
you can find further documentation and examples.

The following CGI parameters are used.

=over 4

=item action

Command to execute. C<Activate> will activate tracing and clear the temporary file (if any).
C<Terminate> will turn tracing off, and C<Show> will display the trace messages or the error

=item key

The tracing key (C<key>). This is usually the user's login name (and defaults to that

=item level

The trace level. The higher the trace level, the more messages will appear. This parameter
is used for the C<Activate> action only.

=item packages[]

An array of tracing modules to turn on. Most tracing is configured using the lowest-level
name of the package containing the trace message, but there are some special names defined as well.
This parameter is used for the C<Activate> action only.

=item destination

Tracing destination. C<FILE> to write to a temporary file, or C<APPEND> to append to a temporary file.
This parameter is used for the C<Activate> action only.

=item hours

The number of hours to leave tracing active (C<hours>). This parameter is used for the C<Activate>
action only.

=item section

The number of bytes to display in the trace file or error log file. This
parameter is used for the C<Show> action only.

=item direction

C<+> to display the trace or error log file after the starting offset; C<-> to display
the trace or error log file before the starting offset. The default is C<+>. This parameter
is used for the C<Show> action only.

=item offset

The starting offset from which the trace file or error log file should be displayed. A positive
number is treated as an offset from the start of the file. A negative number is treated as an
offset from the end of the file. A zero is treated as the end of the file if going backward or
the start of the file if going forward. This parameter is used for the C<Show> action only.

=item logType

The log to display. C<Trace> will display the trace log and C<Error> will display the error log.
This parameter is used for the C<Show> action only.

=item runEnvironment

The environment in which CGI scripts should run. This is stored in the C<SPROUT> cookie
and is interrogated by the SEED Viewer to determine where it should get the data and
what display styles it should use.

=item innerTracing

If specified, then this script will trace at level 3 to a file named C<EmergencyDiagnostics.log>
in the FIG temporary directory.

=item robotic

TRUE if this user should be considered a robot. This causes the C<test_bot> flag to be set
for WebApplications.


=head2 Globals


This is a list of directories in which to look for the error log. The first location
is the B<FIG_Config> variable C<error_log>. Subsequent locations are based on the various
configurations found on the Argonne MCS machines.


my @LOG_FINDER = ($FIG_Config::error_log, qw(/var/log/httpd/error_log /var/log/apache2/error.log));

=head3 Methods


# Denote we have not yet started the output page. We need to know this when recovering
# from errors.
my $PageStarted = 0;
# Get the CGI query object.
my $cgi = CGI->new();
# Insure we recover from errors.
eval {
    # Get the tracing key.
    my $key = $cgi->param('key') || "";
    if (! $key) {
        die "No tracing key specified.";
    # Insure we come from a safe place. Safe places include this server and
    # the NMPDR development server. Get the referring URL and parse out the host
    # name. Note that we presume the host is three parts (xxx.yyy.zzz), because
    # that is true of all our machines, and that there's always a slash at the end of
    # the name, because we are supposed to be coming from a wiki script.
    my $source = $ENV{HTTP_REFERER};
    if ($source !~ m#([^/.]+(?:\.[^/.]+){2,3})/#) {
        die "Invalid referrer $source.";
    } elsif ($1 ne $FIG_Config::dev_server && $1 ne $ENV{HTTP_HOST}) {
        die "Access denied for $source";
    } else {
        # Configure our internal tracing, if necessary.
        if ($cgi->param('innerTracing')) {
            TSetup("3 LogReader Tracer", ">$FIG_Config::temp/EmergencyDiagnostics.log");
        } else {
            TSetup("0", "NONE");
        # Get the action to take.
        my $action = $cgi->param('action') || 'Show';
        # Get the emergency file name.
        my $efileName = Tracer::EmergencyFileName($key);
        # Process the action.
        if ($action eq 'Activate') {
            # Get the package list. Note that part of our package list may come in as
            # a comma- or space-delimited string, so we split the individual parameters up.
            my @packages = map { split(/\s*[\s,]\s*/, $_) } $cgi->param('packages');
            # Get the other parameters. Note we have defaults for everything.
            my $level = $cgi->param('level') || 0;
            my $destination = $cgi->param('destination') || 'FILE';
            my $hours = $cgi->param('hours') || 4;
            my $environment = $cgi->param('runEnvironment');
            my $robotic = $cgi->param('robotic') || 0;
            # Create cookies so that the tracing key and operating environment can be retrieved
            # by other scripts.
            my @cookies = (CGI::Cookie->new(-name => 'IP', -value => $key, -path => '/'),
                           CGI::Cookie->new(-name => 'SPROUT', -value => $environment, -path => '/'),
                           CGI::Cookie->new(-name => 'Robot', -value => $robotic, -path => '/'));
            # Make the environment variable more displayable.
            if (! $environment) {
                $environment = (FIGRules::nmpdr_mode($cgi) ? '(Sprout)' : '(FIG)');
            # Indicate the robotic status.
            $environment = ($robotic ? "robotic" : "normal") . " $environment";
            # Start the output page.
            StartPage("Activate Tracing for $key", \@cookies);
            # If there's already a trace file, delete it.
            my $traceFileName = Tracer::EmergencyFileTarget($key);
            if (-f $traceFileName) {
                unlink $traceFileName;
                PrintLine $cgi->p("$traceFileName deleted.");
            # Turn on emergency tracing.
            Emergency($key, $hours, $destination, $level, @packages);
            # Tell the user about it.
            print join("\n",$cgi->p("Destination is " . Tracer::EmergencyTracingDest($key, $destination) . "."),
                            $cgi->p("Duration is $hours hours (or end of session)."),
                            $cgi->p("Trace level is $level."),
                            $cgi->p("Operating environment is $environment."),
                            $cgi->p("Modules activated:"),
                            $cgi->ul(map { $cgi->li($_) } @packages),
        } elsif ($action eq 'Terminate') {
            # Turn off tracing. We do this by deleting the tracing key file and deleting
            # the environment cookies. First, the cookies.
            my @cookies = (CGI::Cookie->new(-name => 'SPROUT', -value => '', -path => '/', -expires => '-1M'),
                           CGI::Cookie->new(-name => 'Robot', -value => '', -path => '/', -expires => '-1M'));
            # We start the page with the cookies included.
            StartPage("Tracing Terminated for $key", \@cookies);
            # Now delete the tracing key file.
            if (-f $efileName) {
                unlink $efileName;
                FormatStatus("Tracing key file deleted.");
            } else {
                FormatError("Tracing was already turned off.");
        } elsif ($action eq 'Show') {
            # Get the number of bytes to display and the offset from which to start.
            my $section = $cgi->param('section');
            my $offset = $cgi->param('offset');
            # Apply the direction to the section size value.
            my $direction = $cgi->param('direction') || '+';
            $section = -$section if $direction eq '-';
            # Handle the end offset.
            $offset = undef if $offset == 0 && $direction eq '-';
            # Get the file type.
            my $type = $cgi->param('logType') || 'Trace';
            # Start the output page. Note that we use a cleaned copy of the file type in the title.
            my $title = Tracer::Clean("$type Log Display");
            # Find the log file and compute its column count. The column count is currently
            # the same for both, but this might not always be the case.
            my $fileName;
            my $columnCount = 5;
            if ($type eq 'Trace') {
                # Get the trace file name.
                $fileName = FindTraceLog($key);
            } elsif ($type eq 'Error') {
                # Get the error log name.
                $fileName = FindErrorLog();
            } else {
                FormatError("Unknown log file type \"$type\".");
            # Only proceed if we found a file.
            if ($fileName) {
                # Display the file found.
                ShowLogFile($fileName, $columnCount, $offset, $section);
        } else {
            # Here we have an unknown command.
            StartPage("Tracing Console Error", []);
            FormatError("Unknown tracing command $action.");

if ($@) {
    # Here we have a fatal error. Save the message.
    my $errorText = $@;
    # Insure we have a page to which we can write.
    if (! $PageStarted) {
        StartPage("Tracing Console Error", []);
    # Output the error message.
    FormatError("CONSOLE ERROR: $errorText");
# If we have an output page in progress, close it.
if ($PageStarted) {
    PrintLine CGI::end_html();


=head2 Utility Methods

=head3 ShowLogFile

    ShowLogFile($fileName, $columnCount, $offset, $section);

Write a section of a log file to the standard output as an HTML table. The
column count indicates the format of the file (number of columns of
data), and the offset and section indicate which section of the file to

=over 4

=item fileName

Name of the file to display.

=item columnCount

Number of columns of data generally found in the file.

=item offset

Starting location for the display. A positive number or zero is an offset
from the beginning of the file. A negative number is an offset from the
end of the file. An undefined value indicates the end of the file.

=item section

Number of bytes of file data to display. A positive number indicates that
the display extends prior to the offset. A negative number indicates that
the display extends after the offset.



sub ShowLogFile {
    # Get the parameters.
    my ($fileName, $columnCount, $offset, $section) = @_;
    # Create a log reader for the file.
    my $logrdr = LogReader->new($fileName, columnCount => $columnCount);
    # Compute the starting offset of the section to display.
    my $fileSize = $logrdr->FileSize();
    my $start;
    if (! defined $offset) {
        $start = $fileSize;
    } elsif ($offset < 0) {
        $start = $fileSize + $offset;
    } else {
        $start = $offset;
    # Insure the start point is valid.
    $start = Tracer::Constrain($start, 0, $fileSize);
    # Apply the section size to compute the end point. If the section size is
    # negative, this could mean moving the start point.
    my $end;
    if ($section < 0) {
        $end = $start;
        $start = Constrain($end + $section, 0, $fileSize);
    } else {
        $end = Constrain($start + $section, 0, $fileSize);
    # Start with a status message.
    my $len = $end - $start;
    FormatStatus("Displaying approximately $len characters starting at position $start.");
    # Position the log reader.
    $logrdr->SetRegion($start, $end);
    # We will be marking the time column in the table as a header whenever it is different from
    # the previous value. We prime the loop with the fragment indicator, so that if we start
    # with a fragment, we don't flag it.
    my $lastTime = LogReader::FragmentString();
    # Similarly, we throw away redundant referrers. We prime the loop with an empty referrer string.
    my $lastReferrer = "";
    # Start the table.
    PrintLine CGI::start_table();
    # Loop through the file, reading records.
    my $record;
    while (defined ($record = $logrdr->GetRecord())) {
        # We'll put the output table row in here.
        my $line = "";
        # Pop off the timestamp.
        my $time = shift @{$record};
        # See if it's changed. Note that these are formatted times, so we do a string compare.
        # They are not numbers!
        if ($time ne $lastTime) {
            # It's a new time stamp. Append it as a row header.
            $line .= CGI::th($time);
            # Clear the remembered referrer so that the user can see it again.
            $lastReferrer = "";
        } else {
            # This is part of the same event, so put in the time stamp normally.
            $line .= CGI::td($time);
        # Save the time stamp for the next time row.
        $lastTime = $time;
        # Pop off the last column. This is the free-form string, and it requires special handling.
        my $string = pop @{$record};
        # Append the middle columns. We take advantage of the distributive capability of the CGI
        # functions: when passed an array reference, they generate one tag pair per array element.
        $line .= CGI::td($record);
        # HTML-escape the final string.
        my $escaped = CGI::escapeHTML($string);
        # Delete leading whitespace.
        $escaped =~ s/^\s+//;
        # Delete the leading tab thingy (if any).
        $escaped =~ s/^\\t//;
        # Check for a referrer indication.
        if ($escaped =~ /(.+),\s+referr?er:\s+(.+)/) {
            # We've got one. Split it from the main message.
            $escaped = $1;
            my $referrer = $2;
            # If it's new, tack it back on with a new-line so it separates from
            # the main message when displayed.
            if ($referrer ne $lastReferrer) {
                $escaped .= "\n  Via $referrer";
                # Save it for the next check.
                $lastReferrer = $referrer;
        } else {
            # No referrer, so clear the remembered indicator.
            $lastReferrer = "";
        # The final string may contain multiple lines. The first line is treated as normal text,
        # but subsequent lines are preformatted.
        my ($cell, $others) = split /\s*\n/, $escaped, 2;
        if ($others) {
            # Here there are other lines, so we preformat them. Note that we first strip off any final
            # new-line.
            chomp $others;
            $cell .= CGI::pre($others);
        # Output the string cell.
        $line .= CGI::td($cell);
        # Output the row.
        PrintLine CGI::Tr($line);
    # Close the table.
    PrintLine CGI::end_table();

=head3 FormatError


Format an output message as an error. Error messages are shown as block
quotes, which makes them stand out very violently.

=over 4

=item message

Error message to output.



sub FormatError {
    # Get the parameters.
    my ($message) = @_;
    # Write the error message.
    PrintLine CGI::blockquote($message);

=head3 FormatStatus


Format an output message as a status line. Status lines are shown as
ordinary paragraphs.

=over 4

=item message

Status message to output.



sub FormatStatus{
    # Get the parameters.
    my ($message) = @_;
    # Write the status message.
    PrintLine CGI::p($message);

=head3 StartPage

    StartPage($title, $cookies);

Start an Html page.

=over 4

=item title

Title for the page.

=item cookies

Reference to a list of cookies to set.



sub StartPage {
    # Get the parameters.
    my ($title, $cookies) = @_;
    # Write the HTTP header.
    print CGI::header(-cookie => $cookies);
    # Write the HTML header.
    PrintLine CGI::start_html(-title => $title,
                          -style => { src => "$FIG_Config::cgi_url/Html/css/WikiConsole.css" });
    # Echo the title as a body heading.
    PrintLine CGI::h1($title);
    # Denote we've started the page.
    $PageStarted = 1;

=head3 FindTraceLog

    my $fileName = FindTraceLog($key);

Find the trace log for the specified key.

=over 4

=item key

Tracing key that identifies the file to display.

=item RETURN

Returns the trace file name, or an undefined value if the trace file is empty or nonexistent.



sub FindTraceLog {
    # Get the parameters.
    my ($key) = @_;
    # Declare the return variable.
    my $retVal;
    # Get the trace file name.
    my $traceFileName = Tracer::EmergencyFileTarget($key);
    FormatStatus("Tracing data from $traceFileName for $key.");
    # See if tracing is turned on.
    if (! -f $traceFileName) {
        FormatStatus("No trace file found for $key.");
    } elsif (! -s $traceFileName) {
        FormatStatus("The trace file for $key is empty.");
    } else {
        # Here we have a file to read.
        $retVal = $traceFileName;
    # Return the result.
    return $retVal;

=head3 FindErrorLog

    my $fileName = FindErrorLog();

Return the name of the error log file.


sub FindErrorLog {
    # Declare the return variable.
    my $retVal;
    # Loop through the possible log file names until we find one.
    for my $log (@LOG_FINDER) { last if $retVal;
        # We do a defined check here in case the FIG_Config variable is not set.
        if (defined $log && -f $log) {
            $retVal = $log;
    # Check for unusual conditions.
    if (! defined $retVal) {
        FormatError("Error log file not found. Locate the log and put its name in \$FIG_Config::error_log.");
    } elsif (! -s $retVal) {
        FormatStatus("Error log file \"$retVal\" is empty.");
        # Denote we haven't found an error log.
        undef $retVal;
    # Return the result.
    return $retVal;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3