globus-rls-server 4.9-11 / usr / share / globus / aggrexec / globus-rls-aggregatorsource.pl

#! /usr/bin/perl

# 
# Copyright 1999-2006 University of Chicago
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
# http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# 


# Constants
# NOTE: The rvalues have no particular significance.
$LRC_TYPE = 1;
$RLI_TYPE = 2;
$BLOOMFILTER = 1;
$LFNLIST = 2;

# Variables
$debug = 0;
$gotStats = 0;
@stats;
$type = 0;
$error = 0;
$errmsg = 0;
$rls_version = "unknown";
$rls_uptime = "unknown";
@rls_type;
@lrc_update_methods;
@lrc_updates;
$lrc_lfnlist_update_int = "unknown";
$lrc_bloomfilter_update_int = "unknown";
$lrc_numlfn = "unknown";
$lrc_numpfn = "unknown";
$lrc_nummap = "unknown";
@rli_updatedby;
@rli_updatedvia;

# Command line input
$rlsurl = $ARGV[0];
$globus_location = $ENV{GLOBUS_LOCATION};
$globus_location = "/usr" unless defined $globus_location;
$rlsstatscmd = $globus_location . "/sbin/globus-rls-admin -S " . $rlsurl;

if ($debug) {
    print "CMD: ", $rlsstatscmd, "\n";
}

# Invoke RLS stats command
if (open(FD, "$rlsstatscmd 2>&1 |")) {
    @stats = <FD>;
    close(FD);
    $gotStats = 1;
}
else {
    $error = 1;
    $errmsg = "Failed to execute command: \"$rlsstatscmd\"";
    do toXml();
}

if ($gotStats) {
    do parseRlsStats();
    do toXml();
}

if ($debug) {
    do dumpVariables();
}

# Parse RLS statistics from output array
sub parseRlsStats
{
    # Parse stats output
    foreach $line (@stats)
    {
        if ($debug) {
            print "LINE: $line";
        }

        if ($line =~ /^LRC/) {
            $type = $LRC_TYPE;
            push(@rls_type, 'lrc');
        }
        elsif ($line =~ /^RLI/) {
            $type = $RLI_TYPE;
            push(@rls_type, 'rli');
        }
        elsif ($type == $LRC_TYPE) {
            do parseLrcStats($line);
        }
        elsif ($type == $RLI_TYPE) {
            do parseRliStats($line);
        }
        else {
            #Parse general stats
            if ($line =~ /^Version:/) {
                $_ = $line;
                ($ignore, $rls_version) = split;
            }
            elsif ($line =~ /^Uptime:/) {
                $_ = $line;
                ($ignore, $rls_uptime) = split;
            }
            else {
                # Most likely, this indicates an error
                $errmsg = $line;
                $error = 1;
                return 1;
            }
        }
    }
}

# Parses LRC statistics
sub parseLrcStats {
    local($input) = $_[0];
    if ($input =~ /^\s*update method/) {
        $_ = $input;
        ($ignore, $ignore, $method) = split;
        push(@lrc_update_methods, $method);
    }
    elsif ($input =~ /^\s*updates/) {
        $_ = $input;
        ($ignore, $method, $site, $ignore, $date, $time) = split;
        chop($method);
        push(@lrc_updates, ($site, $method, $date, $time));
    }
    elsif ($input =~ /^\s*lfnlist update interval/) {
        $_ = $input;
        ($ignore, $ignore, $ignore, $lrc_lfnlist_update_int) = split;
    }
    elsif ($input =~ /^\s*bloomfilter update interval/) {
        $_ = $input;
        ($ignore, $ignore, $ignore, $lrc_bloomfilter_update_int) = split;
    }
    elsif ($input =~ /^\s*numlfn/) {
        $_ = $input;
        ($ignore, $lrc_numlfn) = split;
    }
    elsif ($input =~ /^\s*numpfn/) {
        $_ = $input;
        ($ignore, $lrc_numpfn) = split;
    }
    elsif ($input =~ /^\s*nummap/) {
        $_ = $input;
        ($ignore, $lrc_nummap) = split;
    }
    else {
        # This is an unexpected condition
    }
}

sub parseRliStats {
    local($input) = $_[0];
    if ($input =~ /^\s*updated by/) {
        $_ = $input;
        ($ignore, $ignore, $site, $ignore, $date, $time) = split;
        push(@rli_updatedby, ($site, $date, $time));
    }
    elsif ($input =~ /^\s*updated via/) {
        $_ = $input;
        ($ignore, $ignore, $method) = split;
        push(@rli_updatedvia, $method);
    }
    else {
        # This is an unexpected condition
    }
}

# Print XML (user-friendly format for debugging purposes only)
sub toXml {

    # Header
    print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";

    # If error encountered, output relevant fields only
    if ($error) {
        print "<rlsStats>\n";
        print "  <site>$rlsurl</site>\n";
        print "  <uptime>$rls_uptime</uptime>\n";
        print "  <error>$errmsg</error>\n";
        print "</rlsStats>\n";
        return 1;
    }

    # Normal output follows
    print "<rlsStats>\n";
    print "  <site>$rlsurl</site>\n";
    print "  <version>$rls_version</version>\n";
    print "  <uptime>$rls_uptime</uptime>\n";
    print "  <serviceList>\n";
    foreach $type (@rls_type) {
        print "    <service>$type</service>\n";
    }
    print "  </serviceList>\n";
    if ("@rls_type" =~ /lrc/) {
        print "  <lrc>\n";
        print "    <updateMethodList>\n";
        foreach $method (@lrc_update_methods) {
            print "      <updateMethod>$method</updateMethod>\n";
        }
        print "    </updateMethodList>\n";
        print "    <updatesList>\n";
        for ($count=0; $count<length(@lrc_updates); $count++) {
            print "      <updates>\n";
            print "        <site>".$lrc_updates[$count*4+0]."</site>\n";
            print "        <method>".$lrc_updates[$count*4+1]."</method>\n";
            print "        <date>".$lrc_updates[$count*4+2]."</date>\n";
            print "        <time>".$lrc_updates[$count*4+3]."</time>\n";
            print "      </updates>\n";
        }
        print "    </updatesList>\n";
        print "    <numlfn>$lrc_numlfn</numlfn>\n";
        print "    <numpfn>$lrc_numpfn</numpfn>\n";
        print "    <nummap>$lrc_nummap</nummap>\n";
        print "  </lrc>\n";
    }
    if ("@rls_type" =~ /rli/) {
        print "  <rli>\n";
        print "    <updatedViaList>\n";
        foreach $method (@rli_updatedvia) {
            print "      <updatedVia>$method</updatedVia>\n";
        }
        print "    </updatedViaList>\n";
        print "    <updatedByList>\n";
        for ($count=0; $count<length(@rli_updatedby); $count++) {
            print "      <updatedBy>\n";
            print "        <site>".$rli_updatedby[$count*3+0]."</site>\n";
            print "        <date>".$rli_updatedby[$count*3+1]."</date>\n";
            print "        <time>".$rli_updatedby[$count*3+2]."</time>\n";
            print "      </updatedBy>\n";
        }
        print "    </updatedByList>\n";
        print "  </rli>\n";
    }
    print "</rlsStats>\n";
}

# Provided for debug purposes
sub dumpVariables {
    print "\nDUMP:\n";
    print "  Version: $rls_version\n";
    print "  Uptime: $rls_uptime\n";
    print "  RLS type: @rls_type\n";
    print "  Update methods: @lrc_update_methods\n";
    print "  Updates: @lrc_updates\n";
    print "  Lfnlist update int: $lrc_lfnlist_update_int\n";
    print "  Bloomfilter update int: $lrc_bloomfilter_update_int\n";
    print "  Numlfn: $lrc_numlfn\n";
    print "  Numpfn: $lrc_numpfn\n";
    print "  Nummap: $lrc_nummap\n";
    print "  Updated by: @rli_updatedby\n";
    print "  Updated via: @rli_updatedvia\n";
}