nordugrid-arc-arex 4.0.0-1 / usr / share / arc / CEinfo.pl

#!/usr/bin/perl -w

package CEInfo;

########################################################
# Driver for information collection
########################################################

use File::Basename;
use Getopt::Long;
use Sys::Hostname;
use Data::Dumper;
use Cwd;

## enable this below to dump datastructures
## Note: Concise is not an ARC dependency!
## must be installed separately.
# use Data::Dumper::Concise;
## usage:
# print Dumper($datastructure); 

use strict;

# Some optional features that may be unavailable in older Perl versions.
# Should work with Perl v5.8.0 and up.
BEGIN {
    # Makes sure the GLUE document is valid UTF8
    eval {binmode(STDOUT, ":utf8")};
    # Used for reading UTF8 encoded grid-mapfile
    eval {require Encode; import Encode "decode"};
    # Fall back to whole-second precision if not avaiable
    eval {require Time::HiRes; import Time::HiRes "time"};
}

BEGIN {
    my $pkgdatadir = dirname($0);
    unshift @INC, $pkgdatadir;
}

use ConfigCentral;
use LogUtils; 

use HostInfo;
use RTEInfo;
use GMJobsInfo;
use LRMSInfo;

use ARC0ClusterInfo;
use ARC1ClusterInfo;

use GLUE2xmlPrinter;
use GLUE2ldifPrinter;
use NGldifPrinter;
use InfosysHelper;

our $log = LogUtils->getLogger(__PACKAGE__);
our $configfile;
our $nojobs;

sub timed {
    my ($fname, $func) = @_;
    my $t0 = time();
    my $result = &$func();
    my $dt = sprintf('%.3f', time() - $t0);
    $log->verbose("Time spent in $fname: ${dt}s");
    return $result;
}


sub main {

    LogUtils::level('INFO');

    # Parse command line options
    my $splitjobs;
    my $nonordugrid;
    my $print_help;

    GetOptions("config:s" => \$configfile,
               "nojobs|n" => \$nojobs,
               "splitjobs|s" => \$splitjobs,
               "nonordugrid|g" => \$nonordugrid,
               "help|h"   => \$print_help ); 

    if ($print_help) { 
        print "Usage: $0 <options>
        --config   - location of arc.conf
        --help     - this help\n";
        exit 1;
    }

    unless ( $configfile ) {
        $log->error("a command line argument is missing, see --help ");
    }

    # Read ARC configuration
    my $config = timed 'ConfigCentral', sub { ConfigCentral::parseConfig($configfile) };

    # Change level for root logger (affects all loggers from now on)
    LogUtils::level($config->{debugLevel}) if defined $config->{debugLevel};

    my $providerlog = $config->{ProviderLog} || "/var/log/arc/infoprovider.log";
    $log->info("Redirecting further messages to $providerlog");

    # Attempt to recursively create directory
    my @paths;
    for (my $path = dirname $providerlog; length $path > 1; $path = dirname $path) {
        push @paths, $path;
    }
    mkdir $_ for reverse @paths;
    $log->error("Failed to create log directory $paths[0]") if @paths and not -d $paths[0];

    open STDERR, ">>", $providerlog or $log->error("Failed to open to $providerlog");
    LogUtils::timestamps(1);
    $log->info("############## A-REX infoprovider started  ##############");

    fix_config($config);
    check_config($config);

    my $data = timed 'all info collectors', sub { CEInfo::collect($config) };
    $data->{nojobs} = $nojobs;

    # Print GLUE2 XML
    $log->info("Generating GLUE2 XML rendering");
    my $glue2data = timed 'ARC1ClusterInfo', sub { ARC1ClusterInfo::collect($data) };
    my $xmlPrinter = GLUE2xmlPrinter->new(*STDOUT, $splitjobs);
    $xmlPrinter->begin('InfoRoot');
    timed 'GLUE2xml', sub { $xmlPrinter->Domains($glue2data) };
    $xmlPrinter->end('InfoRoot');

    # Generate ldif for infosys-ldap
	$log->info("Generating LDIF renderings");
	my $ngdata;
	$ngdata = timed 'ARC0ClusterInfo', sub { ARC0ClusterInfo::collect($data) }
		if ($config->{infosys_nordugrid} or $config->{infosys_glue12});

	my $print_ldif = sub {
		my ($fh) = @_;
		if ($config->{infosys_glue2_ldap}) {                
		   # introduced to find GLUE2 LDAP schema version
			my $glue2schemaversion;
			unless (open (GLUE2_SCHEMA, "</etc/ldap/schema/GLUE20.schema")) {
				$log->debug("CEinfo.pl didn't find GLUE20.schema in standard location. Will create LDIF in compatibitity mode.");
			} else {
				 my $linecnt=0;
				 while (my $line = <GLUE2_SCHEMA>) {
					chomp $line;
					next unless $line;
					if ($line =~ m/# Schema Version: (\d).*/) {
						$glue2schemaversion = $1; 
						$log->debug("GLUE2 schema version major identified. It is: $glue2schemaversion");
						last
					}
					if ($linecnt > 25) {
						$log->debug("Can't identify GLUE2 schema version. Will create LDIF in compatibility mode");
						last
					}
					$linecnt++;
				}
			close GLUE2_SCHEMA;
			}
			# override splitjobs for ldap if option specified in arc.conf
			if ( $config->{infosys_glue2_ldap_showactivities} ) { $splitjobs = 0 };
			$log->info("Generating GLUE2 LDIF rendering");
			my $ldifPrinter = GLUE2ldifPrinter->new($fh, $splitjobs, $glue2schemaversion);
			timed 'GLUE2ldif', sub { $ldifPrinter->Top($glue2data) };
		}
		if ($config->{infosys_nordugrid} or $config->{infosys_glue12}) {
			$log->info("Generating NorduGrid LDIF rendering");
			my $ldifPrinter = NGldifPrinter->new($fh, $config->{ttl});
			timed 'NGldif', sub { $ldifPrinter->Top($ngdata) };
		}
	};

	# only notifiy ldap infosys if ldap is enabled!
	if ($config->{infosys_nordugrid} or $config->{infosys_glue12} or $config->{infosys_glue2_ldap}) {
		# check that fifo is working and notify if so.
		if (InfosysHelper::createLdifScript($config, $print_ldif)) {
			if (InfosysHelper::notifyInfosys($config)) {
				$log->verbose("LDAP information system notified");
			} else {
				$log->warning("Failed to notify LDAP information system");
			}
		} else {
		   $log->warning("Failed to create ldif generator script for LDAP information system");
		}
	} else {
		$log->verbose("LDAP/ldif information generation is disabled. To enable it, enable one of the options infosys_nordugrid, infosys_glue12, infosys_glue2_ldap.");
	}

    $log->info("############## A-REX infoprovider finished ##############");
}


##################################################
# information collector
##################################################

sub collect($) {
    my ($config) = @_;

# uncomment for a dump of the whole config hash
# print Dumper($config);

    # get all local users from grid-map. Sort unique
    $log->info("Reading grid-mapfiles");
    my @localusers;
    my $usermap = {};
    if ($config->{gridmap}) {
        my %saw = ();
        $usermap = read_grid_mapfile($config->{gridmap});
        @localusers = grep !$saw{$_}++, values %$usermap;
    } else {
        $log->info("gridmap not configured");
        my $defaultuser = $config->{defaultLocalName};
        @localusers = ($defaultuser) if $defaultuser;
    }
    $log->warning("Cannot determine local users") unless @localusers;

    $log->info("Fetching job information from control directory (GMJobsInfo.pm)");
    my $gmjobs_info = get_gmjobs_info($config);

    $log->info("Updating job status information");
    # build the list of all jobs in state INLRMS
    my @jobids;
    for my $job (values %$gmjobs_info) {
        next unless $job->{status} and $job->{status} eq 'INLRMS';
        next unless defined $job->{localid} and length $job->{localid};
        push @jobids, $job->{localid};
    }

    # build hash with all the input necessary for the renderers
    my $data = {};
    $data->{config} = $config;
    $data->{usermap} = $usermap;
    $log->info("Updating frontend information (HostInfo.pm)");
    $data->{host_info} = get_host_info($config,\@localusers);
    $log->info("Updating RTE information (RTEInfo.pm)");
    $data->{rte_info} = get_rte_info($config);
    $data->{gmjobs_info} = $gmjobs_info;
    $log->info("Updating LRMS information (LRMSInfo.pm)");
    $data->{lrms_info} = get_lrms_info($config,\@localusers,\@jobids);

    $log->info("Discovering adotf values");
    fix_adotf($config->{service}, $data->{host_info});
    fix_adotf($_, $data->{host_info}) for values %{$config->{xenvs}};

    return $data;
}


##################################################
# Calling other information collectors
##################################################

sub get_host_info($$) {
    my ($config,$localusers) = @_;

    my $host_opts = {};
    $host_opts->{localusers} = $localusers;
    $host_opts->{processes} = ['arched', 'gridftpd'];
    $host_opts->{x509_user_cert} = $config->{x509_user_cert};
    $host_opts->{x509_cert_dir} = $config->{x509_cert_dir};
    $host_opts->{wakeupperiod} = $config->{wakeupperiod};
    $host_opts->{sessiondir} = $config->{sessiondir};
    $host_opts->{control} = $config->{control};
    $host_opts->{remotegmdirs} = $config->{remotegmdirs};

    return timed 'HostInfo', sub { HostInfo::collect($host_opts) };
}

sub get_rte_info($) {
    my ($config) = @_;

    my $rte_opts;
    $rte_opts->{configfile} = $configfile;
    $rte_opts->{runtimedir} = $config->{runtimedir} if $config->{runtimedir};
    $rte_opts->{use_janitor} = $config->{use_janitor} if $config->{use_janitor};
    $rte_opts->{pkgdatadir} = dirname($0);

    return timed 'RTEInfo', sub { RTEInfo::collect($rte_opts) };
}

sub get_lrms_info($$$) {
    my ($config,$localusers,$jobids) = @_;

    # possibly any options from config are needed, so just clone it all
    my $lrms_opts = Storable::dclone($config);
    delete $lrms_opts->{$_} for qw(control xenvs shares);
    $lrms_opts->{jobs} = $jobids;
    for my $share ( keys %{$config->{shares}} ) {
        $lrms_opts->{queues}{$share} = $config->{shares}{$share};
        $lrms_opts->{queues}{$share}{users} = $localusers;
    }

    return timed 'LRMSInfo', sub { LRMSInfo::collect($lrms_opts) };
}

sub get_gmjobs_info($) {
    my $config = shift;

    my $gmjobs_info = timed 'GMJobsInfo', sub { GMJobsInfo::collect($config->{control},
                                                                    $config->{remotegmdirs},
                                                                    $nojobs) };
    return fix_jobs($config, $gmjobs_info);
}


##################################################
# 
##################################################

# Check validity and fill in missing 'share' and 'queue' attributes of jobs.

sub fix_jobs {
    my ($config, $gmjobs_info) = @_;

    my ($lrms, $defaultshare) = split /\s+/, $config->{lrms} || '';
    for my $jobid (keys %$gmjobs_info) {
        my $job = $gmjobs_info->{$jobid};
        my $share = $job->{share};

        # If A-REX has not choosen a share for the job, default to one.
        if (not $share) {
            my $msg = "A-REX has not choosen a share for job $jobid";
            if ($defaultshare) {
                $log->info($msg.". Assuming default: ".$defaultshare);
                $share = $defaultshare;
            } else {
                my @shares = keys %{$config->{shares}};
                if (@shares == 1) {
                    $log->info($msg.". Assuming: ".$shares[0]);
                    $share = $shares[0];
                } else {
                    $log->warning($msg." and no default share is defined.");
                }
            }
        }

        # Set correct queue
        if ($share) {
            my $sconfig = $config->{shares}{$share};
            if ($sconfig) {
                $job->{queue} = $sconfig->{MappingQueue} || $share;
            } else {
                $log->warning("Job $jobid belongs to an invalid share '$share'");
                $share = undef;
            }
        }

        # Group jobs not belonging to any known share into a catch-all share named ''
        $job->{share} = $share || '';
    }
    return $gmjobs_info;
}


# reads grid-mapfile. Returns a ref to a DN => uid hash

sub read_grid_mapfile($) {
    my $gridmapfile = shift;
    my $usermap = {};

    unless (open MAPFILE, "<$gridmapfile") {
        $log->warning("can't open gridmapfile at $gridmapfile");
        return;
    }
    while (my $line = <MAPFILE>) {
        chomp($line);
        if ( $line =~ m/\"([^\"]+)\"\s+(\S+)/ ) {
            my $subject = $1;
            eval {
                $subject = decode("utf8", $subject, 1);
            };
            $usermap->{$subject} = $2;
        }
    }
    close MAPFILE;

    return $usermap;
}


# Alters the parsed configuration options by:
#  * adding some defaults
#  * flattening per-user options

sub fix_config {
    my ($config) = @_;

    my %config_defaults = (
                   arcversion     => '4.0.0',
                   infosys_nordugrid   => 1,
                   infosys_glue12      => 0,
                   infosys_glue2_ldap  => 1,
                   GridftpdEnabled     => 0,
                   GridftpdMountPoint  => '/jobs',
                   GridftpdPort        => 2811,
                   GridftpdAllowNew    => 1,
                   GridftpdPidFile     => '/var/run/gridftpd.pid',
                   ttl            =>  600,
                   # TODO: this is supposed to be in control->defaulttl
                   defaultttl     => 604800,
                   SlapdPort      => 2135,
                   infosys_glue2_service_qualitylevel   => 'production',
                   shared_filesystem => 1

    );
    for (keys %config_defaults) {
        $config->{$_} = $config_defaults{$_} if not defined $config->{$_};
    }

    $config->{control} ||= {};
    $config->{service} ||= {};
    $config->{shares} ||= {};
    $config->{xenvs} ||= {};

    delete $config->{location} unless $config->{location} and %{$config->{location}};
    delete $config->{contacts} unless $config->{contacts} and @{$config->{contacts}};

    my $hostname = $config->{hostname} || hostname();
    {  
        my @dns = split /\./, $hostname;
        my $shorthost = shift @dns;
        my $dnsdomain = join ".", @dns;

        $log->info("AdminDomain config option is missing in XML. Defaulting to arc.conf values") unless $config->{AdminDomain};
        $log->info("AdminDomain name in [infosys/admindomain] block is missing or incorrect in arc.conf. Defaulting to UNDEFINEDVALUE") unless $config->{admindomain}{Name};

        chomp ($config->{admindomain}{Name} ||= "UNDEFINEDVALUE");
        chomp ($config->{AdminDomain} ||= "UNDEFINEDVALUE");
        
        
        $log->info("ClusterName config option is missing in XML. Trying cluster_alias...") unless $config->{service}{ClusterName};
        $log->info("ClusterAlias in XML or cluster-alias in arc.conf missing. Defaulting to $shorthost") unless $config->{service}{ClusterAlias};
        chomp ($config->{service}{ClusterName} ||= $config->{service}{ClusterAlias} ||= $shorthost);
    }

    if ($config->{endpoint} and $config->{endpoint} =~ m{^(https?)://([^:/]+)(?::(\d+))?(.*)}) {
        my ($proto,$host,$port,$mountpoint) = ($1,$2,$3,$4);
        $port ||= 80 if $proto eq "http";
        $port ||= 443 if $proto eq "https";
        $config->{arexhostport} = "$host:$port";
        # fix endpoint information if not complete
        $config->{endpoint} = "$proto://$host:$port$mountpoint"
    } 
    
    if ($config->{enable_emies_interface} and $config->{enable_emies_interface} = "yes") {
        if (!$config->{arexhostport}) { $log->warning("EMI-ES interface cannot be enabled. arex_mount_point not defined in configuration."); }
    }
    
    # fire warning if GLUE2 Service Quality Level is not good
    # TODO: I'd like this to be done by InfoChecker
    if ($config->{infosys_glue2_service_qualitylevel}) {
        my $qualitylevelstring = $config->{infosys_glue2_service_qualitylevel};
        my $closedenumeration = {'development' => '1',
                                 'pre-production' => '1',
                                 'production' => '1',
                                 'testing' => '1'
                                };
        if (! $closedenumeration->{$qualitylevelstring} ) {
            $log->error("infosys_glue2_service_qualitylevel contains \"$qualitylevelstring\" which is an invalid value. Allowed value is one of: testing production pre-production development"); 
        }
    }

    # Cross-check MappingPolicy references and move them to the share wehre they belong
    for my $s (@{$config->{mappingpolicies}}) {
        $log->error("MappingPolicy must include a ShareName option")
            unless $s->{ShareName};
        $log->error("MappingPolicy must include a Rule option")
            unless $s->{Rule};
        $log->error("MappingPolicy must include a UserDomainID option")
            unless $s->{UserDomainID};
        for my $name (@{$s->{ShareName}}) {
            $log->error("MappingPolicy associated with non-existent Share: $name")
                unless $config->{shares}{$name};
            push @{$config->{shares}{$name}{mappingpolicies}}, $s;
        }
    }

}


# Does some consistency checks on the parsed configuration options

sub check_config {
    my ($config) = @_;

    $log->error("No queue or ComputingShare configured") unless %{$config->{shares}};
    $log->error("No ExecutionEnvironment configured") unless %{$config->{xenvs}};

    $log->error("No control directory configured")
        unless %{$config->{control}} or $config->{remotegmdirs};
    while (my ($user, $control) = each %{$config->{control}}) {
        $log->error("No control directory configured for user $user") unless $control->{controldir};
        $log->error("No session directory configured for user $user") unless $control->{sessiondir};
    }

    # Cross-check ExecutionEnvironment references
    for my $s (values %{$config->{shares}}) {
        next unless $s->{ExecutionEnvironmentName};
        for my $group (@{$s->{ExecutionEnvironmentName}}) {
            $log->error("ComputingShare associated with non-existent ExecutionEnvironment: $group")
                unless $config->{xenvs}{$group};
        }
    }
    for my $s (values %{$config->{xenvs}}) {
        delete $s->{NodeSelection} unless %{$s->{NodeSelection}};
    }

    my ($lrms, $defaultshare) = split /\s+/, $config->{lrms} || '';
    $log->error("defaultShare set to nonexistent ComputingShare")
        if $defaultshare and not $config->{shares}{$defaultshare};

    if ($config->{contacts}) {
        for (@{$config->{contacts}}) {
            $log->warning("Contact is missing Type") and next unless $_->{Type};
            $log->warning("Contact is missing Detail") and next unless $_->{Detail};
            $log->warning("Contact Detail is not an URI: ".$_->{Detail}) and next
                unless $_->{Detail} =~ m/^\w+:/;
        }
    }
}


# Replaces 'adotf' in config options with autodetected values

sub fix_adotf {
    my ($h, $hostinfo) = @_;
    if ($h->{nodecpu}) {
        if ($h->{nodecpu} =~ m/(.*?)(?:\s+stepping\s+(\d+))?\s+@\s+([.\d]+)\s*(M|G)Hz$/i) {
            $h->{CPUModel} ||= $1;
            $h->{CPUVersion} ||= $2;
            $h->{CPUClockSpeed} ||= ($4 eq 'G') ? int($3 * 1000) : int($3);
        } elsif ($h->{nodecpu} eq 'adotf') {
            $h->{CPUVendor} ||= 'adotf';
            $h->{CPUModel} ||= 'adotf';
            $h->{CPUClockSpeed} ||= 'adotf';
        } else {
            $log->warning("Invalid value for nodecpu option: ".$h->{nodecpu});
        }
        delete $h->{nodecpu};
    }
    if ($h->{OpSys} and grep {$_ eq 'adotf'} @{$h->{OpSys}}) {
        $h->{OpSys} = [ grep {$_ ne 'adotf'} @{$h->{OpSys}} ];
        unless (defined($hostinfo->{osname})) {
            $log->warning("Failed to autodetect value for 'OSName'. Enter correct value in config file");
            $h->{OSName} = 'unknown';
        }
        $h->{OSName} ||= 'adotf';
        $h->{OSVersion} ||= 'adotf';
        $h->{OSFamily} ||= 'adotf';
    }
    my %hostkey = (Platform => 'machine',
                   PhysicalCPUs => 'cpusocketcount',
                   LogicalCPUs => 'cputhreadcount',
                   CPUVendor => 'cpuvendor',
                   CPUModel => 'cpumodel',
                   CPUClockSpeed => 'cpufreq',
                   MainMemorySize => 'pmem',
                   VirtualMemorySize => 'vmem',
                   OSFamily => 'sysname',
                   OSName => 'osname',
                   OSVersion => 'osversion'
    );
    for my $key (keys %hostkey) {
        if (exists $h->{$key} and $h->{$key} eq 'adotf') {
            $log->warning("Failed to autodetect value for '$key'. Enter correct value in config file")
                unless defined $hostinfo->{$hostkey{$key}};
            $h->{$key} = $hostinfo->{$hostkey{$key}};
        }
    }
}

main();