#!/usr/bin/perl -w

package CEInfo;

## RESTRUCTURING PHASE ################
## changes are identified by the tags
## #C changenumber
#######################################


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

use File::Basename;
use Getopt::Long;
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;
}

# Attempt to recursively create directory
# takes absolute filename (absolute path and file name)
sub createdirs {
    my ($fullpathfilename, $log) = @_;
    my @paths;
    for (my $path = dirname $fullpathfilename; length $path > 1; $path = dirname $path) {
        push @paths, $path;
    }
    mkdir $_ for reverse @paths;
    $log->error("Failed to create directory $paths[0], error: $!") if @paths and not -d $paths[0];
}

# minimal set of vars before loading the profiler
our $configfile;
our $NYTPROF_PRESENT = 0;

# Profiler config and code moved here because we need
# to get more data before main starts
BEGIN {
    use ConfigCentral;
    use LogUtils;
    use Getopt::Long;

    LogUtils::level('WARNING');
    LogUtils::indentoutput(1);

    my $log = LogUtils->getLogger(__PACKAGE__);
    my $dumpconfig = 0;
    my $nojobs;
    my $splitjobs;
    my $perffreq = 1800;
    my $print_help;

    # Make a copy of @ARGV and restore it after extracting options from it.

    my @options = @ARGV;
    GetOptions("config:s" => \$configfile,
               "dumpconfig|d" => \$dumpconfig,
               "nojobs|n" => \$nojobs,
               "splitjobs|s" => \$splitjobs,
               "perffreq:i" => \$perffreq,
               "help|h"   => \$print_help );

    @ARGV = @options;

    unless ( $configfile ) {
        $log->warning("Performance code setup: No 'config' option, skipping performance configuration. See --help ");
    } else {

        my $perflogdir;
        my $perflognytprofdir;
        my $perflognytproffilepath;

        # TODO: update according to new config

        # C134
        my $infosysloglevel = ConfigCentral::getValueOf($configfile,'infosys','loglevel');
        $log->error("Can\'t determine loglevel. Probably the [infosys] block is missing. Exiting...") if ($infosysloglevel eq '');
        #C 134
        LogUtils::level($infosysloglevel);

        my $enable_perflog_reporting = ConfigCentral::isBlockPresent($configfile,'monitoring/perflog');

        if ($enable_perflog_reporting) {
            # The profiling tool might be missing in some distributions.
            # Default is to assume is not present.
            $perflogdir = ConfigCentral::getValueOf($configfile,'monitoring/perflog','perflogdir');
            $log->error("perflogdir parameter not defined or no default set in code, $perflogdir") if ((!defined $perflogdir) || $perflogdir eq '');
            $perflognytprofdir = $perflogdir.'/perl_nytprof/';
            $log->info("Performance reporting enabled. The database files will be stored in $perflognytprofdir");

            # reduce performance reporting depending on interval by checking dir last modification time
            if ( -e $perflognytprofdir ) {
                my $t0 = time();
                my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($perflognytprofdir);
                my $timediff = $t0 - $mtime;
                if ($timediff <= $perffreq) {
                    $log->debug("$perflognytprofdir changed $timediff seconds ago, less than $perffreq. Skipping performance data collection");
                    undef $log;
                    no ConfigCentral;
                    no LogUtils;
                    return 0;
                }
            }

            # append and create raw folder for NYTProf database files
            my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
            my $timestamp=POSIX::strftime("%Y%m%d%H%M%S", $sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
            my $perflognytproffilename = 'infosys_'.$timestamp.'.perflog.raw';
            $perflognytproffilepath = $perflognytprofdir.$perflognytproffilename;
            createdirs($perflognytproffilepath,$log);
            if ( -e $perflogdir ) {
                $ENV{NYTPROF} = "savesrc=0:start=no:file=".$perflognytproffilepath;
                $NYTPROF_PRESENT = eval { require Devel::NYTProf; 1; };
                if ($NYTPROF_PRESENT) {
                    DB::enable_profile($perflognytproffilepath);
                    $log->info("Performance reporting enabled. The database file is $perflognytproffilepath");
                } else { $log->warning("Devel::NYTProf PERL module not installed. Performance data cannot be collected."); }
            } else { $log->warning("Cannot access directory $perflogdir. Unable to open performance file $perflognytproffilepath. Check arc.conf perflogdir option, directories and permissions"); }
        }
    }
    undef $log;
    no ConfigCentral;
    no LogUtils;
}

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 $nojobs;
our $log = LogUtils->getLogger(__PACKAGE__);


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');
    LogUtils::indentoutput(1);

    # Parse command line options
    my $dumpconfig = 0;
    my $splitjobs;
    my $perffreq = 1800;
    my $print_help;

    GetOptions("config:s" => \$configfile,
               "dumpconfig|d" => \$dumpconfig,
               "nojobs|n" => \$nojobs,
               "splitjobs|s" => \$splitjobs,
               "perffreq:i" => \$perffreq,
               "help|h"   => \$print_help );

    if ($print_help) {
        print "Usage: $0 <options>
        --config <path-to-arc.conf> - location of arc.conf
        --dumpconfig                - dumps internal representation of a-rex configuration and exits.
        --nojobs|n                  - don't include information about jobs
        --splitjobs|s               - write job info in a separate XML file for each job in the controldir
        --perffreq|p <seconds>      - interval between performance collections, in seconds. Default is 1200
        --help                      - this help\n";
        exit 1;
    }

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

    # setup output to logfile before parsing the complete config file

    # C134
    my $infosysloglevel = ConfigCentral::getValueOf($configfile,'infosys','loglevel');
    $log->error("Can\'t determine loglevel. Probably the [infosys] block is missing. Exiting...") if ($infosysloglevel eq '');
    # Change level for root logger (affects all loggers from now on)
    #C 134
    LogUtils::level($infosysloglevel);
    #C 133
    my $providerlog = ConfigCentral::getValueOf($configfile,'infosys','logfile');

    $log->info("Redirecting further messages to $providerlog");
    LogUtils::indentoutput(0);

    # Attempt to recursively create directory
    createdirs($providerlog,$log);

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

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

    # Dump config (uncomment if needed)
    #print Dumper($config);

    # Dump internal datastructure if required and exit

    if ($dumpconfig) {
        $log->info("Dumping configuration and exiting");
        ConfigCentral::dumpInternalDatastructure($config);
        $log->info("############## A-REX infoprovider finished ##############");
        exit 0;
    };

    $log->info('Start data collection...');
    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;
    if ( defined $config->{infosys}{nordugrid} ) {
        if ($config->{gridftpd}{enabled}) {
            $ngdata = timed 'ARC0ClusterInfo', sub { ARC0ClusterInfo::collect($data) } if ( defined $config->{infosys}{nordugrid} );
        } else {
            $log->info('[gridftpd] block not found. NorduGRID schema disabled. NorduGRID schema only works properly when the gridftpd interface is enabled. No NorduGRID information will be generated. Configure [gridftpd] and [gridftpd/jobs] to fix this. NOTE: Also Glue 1.2/1.3 information will NOT be generated WITHOUT the NorduGRID schema!');
        }
    }   
    
    # Write out LDIF document(s)
    my $print_ldif = sub {
        my ($fh) = @_;
        if ( defined $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}{enabled} and $config->{gridftpd}{enabled}) {
            $log->info("Generating NorduGrid LDIF rendering");
            my $ldifPrinter = NGldifPrinter->new($fh, $config->{infosys}{validity_ttl});
            timed 'NGldif', sub { $ldifPrinter->Top($ngdata) };
        }
    };

    # only notifiy ldap infosys if ldap is enabled!
    # C 141 use block to check if ldap is enabled
    if ( $config->{infosys}{ldap}{enabled} ) {
        # check that fifo is working and notify if so.
        if (InfosysHelper::createLdifScript($config->{infosys}{ldap}, $print_ldif)) {
            if (InfosysHelper::notifyInfosys($config->{infosys}{ldap})) {
                $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 [infosys/ldap] AND one of the blocks [infosys/nordugrid], [infosys/glue1], [infosys/glue2/ldap]");
    }

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

    # close performance file if enabled
    DB::disable_profile() if ($NYTPROF_PRESENT && (defined $config->{enable_perflog_reporting}));
}


##################################################
# 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->verbose("Reading grid-mapfiles. These are obsolete, one should use other methods, this message can be ignored.");
    my @localusers;
    my $usermap = {};
    if ($config->{gridmap}) {
        my %saw = ();
        $usermap = read_grid_mapfile($config->{gridmap});
        @localusers = grep !$saw{$_}++, values %$usermap;
    } else {
        $log->verbose("gridmap not configured. Gridmap files are obsolete, this message can be ignored");
        my $defaultuser = $config->{defaultLocalName};
        @localusers = ($defaultuser) if $defaultuser;
    }
    $log->verbose("Cannot determine local users from gridmapfile or config. This approach is obsolete, this message can be discarded.") 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','slapd'];
    $host_opts->{ports}{'arched'} = ['443'];
    $host_opts->{ports}{'gridftpd'} = [$config->{gridftpd}{port}] if $config->{gridftpd}{enabled};
    $host_opts->{ports}{'slapd'} = [$config->{infosys}{ldap}{port}] if $config->{infosys}{ldap}{enabled};
    $host_opts->{x509_host_cert} = $config->{x509_host_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->{controldir} = $config->{control}{'.'}{controldir} if $config->{control}{'.'}{controldir};

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

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

    # TODO: possibly any options from config are needed, but they should be
    # moved into the lrms block if required.

    # this conforms to LRMSInfo.pm specification
    my $lrms_opts = Storable::dclone($config->{lrms});
    
    # Additional info used by LRMS modules
    $lrms_opts->{controldir} = $config->{control}{'.'}{controldir};
    $lrms_opts->{loglevel} = $config->{infosys}{loglevel};
    
    # TODO: double check this cleanup, if needed
    delete $lrms_opts->{$_} for qw(xenvs shares);
    $lrms_opts->{jobs} = $jobids;
    ## TODO: review and implement this, is cleaner than what we have now
    ## This former implementation of shares might solve problems in ARC1ClusterInfo.
    ## nowadays it is not used.
    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) = @_;

    # TODO: this should be already splitted in ConfigCentral
    my ($lrms, $defaultshare) = split /\s+/, $config->{lrms}{lrms} || ''; # C 10
    for my $jobid (keys %$gmjobs_info) {
        my $job = $gmjobs_info->{$jobid};
        my $share = $job->{share};

        # If A-REX has not chosen a share for the job, default to one.
        # why?!? and how do we know?
        if (not $share) {
            my $msg = "A-REX has not chosen 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;
}

## CHECK: This probably belongs here, info from HostInfo.pm and LRMS modules is required
# 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();
