From 81897cf2853dc4898b70090ea90d48f7c118654c Mon Sep 17 00:00:00 2001 From: "Kasper D. Fischer" Date: Mon, 26 Aug 2024 17:54:28 +0200 Subject: [PATCH] add flex-grid folder for flexlm license manager accounting --- flex-grid/cache | 1 + flex-grid/config/abaqus_licenses.conf | 33 + flex-grid/config/comsol_licenses.conf | 31 + flex-grid/config/local_licenses.conf | 36 + flex-grid/config/matlab_licenses.conf | 32 + flex-grid/config/trelis_licenses.conf | 31 + flex-grid/licenses/comsol.lic | 1 + flex-grid/licenses/hyperworks.lic | 2 + flex-grid/licenses/ifort.lic | 2 + flex-grid/licenses/matlab.lic | 1 + flex-grid/licenses/multiphysics.lic | 2 + flex-grid/scripts/GridEngine-git-config | 221 +++ flex-grid/scripts/abaqus_lmutil | 5 + flex-grid/scripts/filter-accounting | 124 ++ flex-grid/scripts/qlic | 517 +++++ flex-grid/site/qlicserver | 2327 +++++++++++++++++++++++ flex-grid/site/qloadsensor | 325 ++++ 17 files changed, 3691 insertions(+) create mode 120000 flex-grid/cache create mode 100644 flex-grid/config/abaqus_licenses.conf create mode 100644 flex-grid/config/comsol_licenses.conf create mode 100644 flex-grid/config/local_licenses.conf create mode 100644 flex-grid/config/matlab_licenses.conf create mode 100644 flex-grid/config/trelis_licenses.conf create mode 120000 flex-grid/licenses/comsol.lic create mode 100755 flex-grid/licenses/hyperworks.lic create mode 100755 flex-grid/licenses/ifort.lic create mode 120000 flex-grid/licenses/matlab.lic create mode 100755 flex-grid/licenses/multiphysics.lic create mode 100755 flex-grid/scripts/GridEngine-git-config create mode 100755 flex-grid/scripts/abaqus_lmutil create mode 100755 flex-grid/scripts/filter-accounting create mode 100755 flex-grid/scripts/qlic create mode 100755 flex-grid/site/qlicserver create mode 100755 flex-grid/site/qloadsensor diff --git a/flex-grid/cache b/flex-grid/cache new file mode 120000 index 0000000..b0fda03 --- /dev/null +++ b/flex-grid/cache @@ -0,0 +1 @@ +/rscratch/minos19/flex_grid_cache \ No newline at end of file diff --git a/flex-grid/config/abaqus_licenses.conf b/flex-grid/config/abaqus_licenses.conf new file mode 100644 index 0000000..91ec8b8 --- /dev/null +++ b/flex-grid/config/abaqus_licenses.conf @@ -0,0 +1,33 @@ + + + + /opt/SGE/flex-grid/scripts/abaqus_lmutil + + 27000@vmrz0300.vm.ruhr-uni-bochum.de + /opt/SGE/flex-grid/cache + qlicserver_abaqus.xml + + + + + + + diff --git a/flex-grid/config/comsol_licenses.conf b/flex-grid/config/comsol_licenses.conf new file mode 100644 index 0000000..7bf3791 --- /dev/null +++ b/flex-grid/config/comsol_licenses.conf @@ -0,0 +1,31 @@ + + + + /opt/matlab/etc/glnxa64/lmutil + /opt/SGE/flex-grid/licenses/comsol.lic + /opt/SGE/flex-grid/cache + qlicserver_comsol.xml + + + + + + diff --git a/flex-grid/config/local_licenses.conf b/flex-grid/config/local_licenses.conf new file mode 100644 index 0000000..a2f3b71 --- /dev/null +++ b/flex-grid/config/local_licenses.conf @@ -0,0 +1,36 @@ + + + + /opt/matlab/etc/glnxa64/lmutil + /opt/SGE/flex-grid/licenses/multiphysics.lic + /opt/SGE/flex-grid/cache + qlicserver_local.xml + qhost.xml + qstat.xml + + + + + + diff --git a/flex-grid/config/matlab_licenses.conf b/flex-grid/config/matlab_licenses.conf new file mode 100644 index 0000000..ae36186 --- /dev/null +++ b/flex-grid/config/matlab_licenses.conf @@ -0,0 +1,32 @@ + + + + /opt/matlab/etc/glnxa64/lmutil + /opt/SGE/flex-grid/licenses/matlab.lic + /opt/SGE/flex-grid/cache + qlicserver_matlab.xml + + + + + + + diff --git a/flex-grid/config/trelis_licenses.conf b/flex-grid/config/trelis_licenses.conf new file mode 100644 index 0000000..1d7153a --- /dev/null +++ b/flex-grid/config/trelis_licenses.conf @@ -0,0 +1,31 @@ + + + + /opt/matlab/etc/glnxa64/lmutil + /opt/SGE/flex-grid/licenses/matlab.lic + /opt/SGE/flex-grid/cache + qlicserver_trelis.xml + + + + + + diff --git a/flex-grid/licenses/comsol.lic b/flex-grid/licenses/comsol.lic new file mode 120000 index 0000000..5f84a17 --- /dev/null +++ b/flex-grid/licenses/comsol.lic @@ -0,0 +1 @@ +/opt/comsol53a/multiphysics/license/license.dat \ No newline at end of file diff --git a/flex-grid/licenses/hyperworks.lic b/flex-grid/licenses/hyperworks.lic new file mode 100755 index 0000000..ef5003d --- /dev/null +++ b/flex-grid/licenses/hyperworks.lic @@ -0,0 +1,2 @@ +SERVER kamikaze 80b660b0 7788 +USE_SERVER diff --git a/flex-grid/licenses/ifort.lic b/flex-grid/licenses/ifort.lic new file mode 100755 index 0000000..9a15792 --- /dev/null +++ b/flex-grid/licenses/ifort.lic @@ -0,0 +1,2 @@ +SERVER kamikaze 80b660b0 28518 +USE_SERVER diff --git a/flex-grid/licenses/matlab.lic b/flex-grid/licenses/matlab.lic new file mode 120000 index 0000000..4512208 --- /dev/null +++ b/flex-grid/licenses/matlab.lic @@ -0,0 +1 @@ +/opt/matlab/licenses/01network.lic \ No newline at end of file diff --git a/flex-grid/licenses/multiphysics.lic b/flex-grid/licenses/multiphysics.lic new file mode 100755 index 0000000..31d263c --- /dev/null +++ b/flex-grid/licenses/multiphysics.lic @@ -0,0 +1,2 @@ +SERVER phaidra.geophysik.ruhr-uni-bochum.de 00163ef90680 1718 +USE_SERVER diff --git a/flex-grid/scripts/GridEngine-git-config b/flex-grid/scripts/GridEngine-git-config new file mode 100755 index 0000000..c2cf55d --- /dev/null +++ b/flex-grid/scripts/GridEngine-git-config @@ -0,0 +1,221 @@ +#!/bin/sh +# +# Snapshot of the current GridEngine configuration using git for the +# backend storage and tracking mechanism. +# +# Should normally be called via a cronjob. +# +# Following Edward Dale's idea: +# http://scompt.com/blog/archives/2009/10/13/versioned-grid-engine-configuration +# but using git for the backend +# +# initialize: +# +# git --git-dir=$GIT_DIR init --bare --shared=world +# +# Note: we use Perl for inplace editing since some versions of sed have +# problems with this task. +################################################################################ +################################################################################ +# CUSTOMIZE THESE SETTINGS TO MATCH YOUR REQUIREMENTS: + +SGE_ROOT=/opt/grid +SGE_CELL=default +GIT_DIR=/data/cfd/share/git-repo/gridengine-config.git + +# +# END OF CUSTOMIZE SETTINGS +################################################################################ +################################################################################ +Script=${0##.*/} +saveScript="$SGE_ROOT/util/upgrade_modules/save_sge_config.sh" +export SGE_ROOT SGE_CELL GIT_DIR + +for i in git perl +do + type $i >/dev/null 2>&1 || { + echo "Error: $Script - no '$i' found" + exit 1 + } +done + +#------------------------------------------------------------------------------ +usage() { + while [ "$#" -ge 1 ]; do echo "$1"; shift; done + cat< + +USAGE + exit 1 +} +#------------------------------------------------------------------------------ +# parse options +while [ "$#" -gt 0 ] +do + case "$1" in + ( help | -h | -help ) + usage + ;; + ( init ) + shift + if [ -d "$GIT_DIR" ] + then + echo "Error: $Script - $GIT_DIR already exists" + exit 1 + else + git --git-dir=$GIT_DIR init --bare --shared=world $@ + rc=$? + + # add a description for gitweb + i="$GIT_DIR/description" + if [ -f "$i" -a -w "$i" ] + then + echo "snapshot of the current GridEngine configuration" > $i + fi + fi + exit $rc + ;; + ( log | ls-files | show | whatchanged ) + git --git-dir=$GIT_DIR $@ + exit $? + ;; + (*) + usage "unknown option/argument: '$*'" + ;; + esac +done + + + +[ -d "$GIT_DIR" ] || { + echo "git repo: $GIT_DIR does not exist" + exit 1 +} + + +i="$SGE_ROOT/$SGE_CELL/common/settings.sh" +if [ -f "$i" -a -r "$i" ] +then + . "$i" +else + echo "cannot read $i" + exit 1 +fi + +[ -f "$saveScript" -a -r "$saveScript" ] || { + echo "cannot read $i" + exit 1 +} + +# Create a fresh empty directory +# cannot use --tmpdir on older systems +tmpDir=$(mktemp -d "/tmp/sgeSaveConfig.XXXXXXXXXX") +trap "rm -rf $tmpDir 2>/dev/null; exit 0" EXIT TERM INT + +[ -d "$tmpDir" ] || { + echo "Error: temp dir '$tmpDir' does not exist" + exit 1 +} + +$saveScript $tmpDir + +#------------------------------------------------------------------------------ +# cleanup +# +( + cd $tmpDir || exit 1 + + # all operations are now in the current directory + GIT_WORK_TREE=. + export GIT_WORK_TREE + + # minor error checking that the save script worked + if [ -f backup_date -a -r backup_date ] + then + msg=$(cat backup_date) + else + echo "cannot read backup_date - $saveScript might have failed" + exit 1 + fi + + + # ignore accounting (too big) + rm -f cell/accounting + + # ignore current users + rm -f users/* + + # ignore current load_values for exec hosts + perl -i -ne '/^load_values/ or print' execution/* + + # assign (consumable) complex_values to zero - otherwise we indirectly + # track the external license usage when qlicserver is being used + # also sort the complexes to avoid spurious changes + perl -i -p -e 'if (/^complex_values/) { chomp; ' \ + -e 's/=\d+/=0/g; s/^(complex\S+\s+)//; ' \ + -e '$_ = $1 . join("," => sort split /,/) . "\n" }' \ + execution/global + + # + # determine if the configuration changed + # + # this is fairly roundabout until we find a better way + needsCommit=false + + if [ -n "$(git ls-files -d)" ] # files deleted? + then + needsCommit=true + elif [ -n "$(git ls-files -o)" ] # files added? + then + needsCommit=true + else + # files modified? + # do it the long way to ensure we also get staged modifications + set -- $(git status | perl -ne 's/^#\s+modified:// and print') + + # changes in backup_date, jobseqnum etc alone are not enough + # to warrant a commit + while [ "$#" -ge 1 ] + do + case $1 in + ( arseqnum | backup_date | jobseqnum ) + shift + ;; + (*) + needsCommit=true + break + ;; + esac + done + fi + + if [ "$needsCommit" = true ] + then + # register all new files + git add . + + # commit everything + git commit -a -m "$msg" + else + echo "no changes to be committed $msg" + fi +) + +exit 0 +#------------------------------------------------------------------------------ diff --git a/flex-grid/scripts/abaqus_lmutil b/flex-grid/scripts/abaqus_lmutil new file mode 100755 index 0000000..6eaf595 --- /dev/null +++ b/flex-grid/scripts/abaqus_lmutil @@ -0,0 +1,5 @@ +#!/bin/sh +# $Id: abaqus_lmutil 180 2010-09-17 15:46:41Z kasper $ + +/opt/abaqus/Commands/abaqus licensing lmstat -a -f abaqus -S ABAQUSLM +/opt/abaqus/Commands/abaqus licensing lmstat -a -f cae -S ABAQUSLM diff --git a/flex-grid/scripts/filter-accounting b/flex-grid/scripts/filter-accounting new file mode 100755 index 0000000..ed3c4da --- /dev/null +++ b/flex-grid/scripts/filter-accounting @@ -0,0 +1,124 @@ +#!/usr/bin/perl -w +use strict; +use Getopt::Std qw( getopts ); +use Time::Local qw( timelocal ); + +my ($releaseDate) = qw( 2009-10-02 ); + +( my $Script = $0 ) =~ s{^.*/}{}; +# ------------------------------------------------------------------------- +sub usage { + $! = 0; # clean exit + warn "@_\n" if @_; + die <<"USAGE"; +usage: + $Script [OPTION] file1 [ .. fileN ] + +with options: + -b YYYY[-MM[-DD]] + begin date for accounting (job end_time > DATE 2 A.M.) + -e YYYY[-MM[-DD]] + end date for accounting (job end_time <= DATE 2 A.M.) + -h usage + +Extract portions of the GridEngine accounting(5) file according to the +job end_time. For example, + $Script -b 2008-01-01 -e 2009 ... +extracts the accounting for jobs that finished running in 2008. + +The value of 2 A.M. avoids problems that daylight savings time might +otherwise cause. + +version ($releaseDate) +copyright (c) 2009 + +Licensed and distributed under the Creative Commons +Attribution-NonCommercial-ShareAlike 3.0 License. +http://creativecommons.org/licenses/by-nc-sa/3.0 +USAGE +} + +# ------------------------------------------------------------------------- +my %opt; +getopts( "hb:e:", \%opt ) or usage(); +usage() if $opt{h}; + +@ARGV or usage(); + +for (@ARGV) { + -f $_ or die "no file '$_'\n"; + + ## handle compressed files transparently + if (/\.bz2$/) { + $_ = qq{bzip2 -dc "$_"|}; + } + elsif (/\.gz$/) { + $_ = qq{gzip -dc "$_"|}; + } +} + +for (qw( b e )) { + if ( $opt{$_} ||= 0 ) { + my ( $yy, $mm, $dd ); + + if ( $opt{$_} =~ /^(\d{2,4})-(\d{1,2})-(\d{1,2})$/ ) { + ## YYYY-MM-DD + ( $yy, $mm, $dd ) = ( $1, $2, $3 ); + } + elsif ( $opt{$_} =~ /^(\d{2,4})-(\d{1,2})$/ ) { + ## YYYY-MM + ( $yy, $mm ) = ( $1, $2 ); + } + elsif ( $opt{$_} =~ /^(\d{2,4})$/ ) { + ## YYYY + ($yy) = ($1); + } + else { + usage("invalid date format: '$opt{$_}'"); + } + + # treat missing month/day as '1' + $mm ||= 1; + $dd ||= 1; + + # convert from YYYY-MM-DD to epoch, + # start at 2am - avoid problems with daylight savings time + $opt{$_} = timelocal( 0, 0, 2, $dd, $mm - 1, $yy ); # month (0..11) + } +} + +$opt{b} or $opt{e} or usage("must specify at least one of -b or -e"); + +if ( $opt{e} and $opt{b} >= $opt{e} ) { + usage("-b DATE must less than -e DATE"); +} + +my $fileCount; +while (<>) { + if (/^\s*#/) { + ## pass-thru comments, but only for the first file + print unless $fileCount; + next; + } + + my ($endtime) = ( split /:/ )[10]; + + # only allow things that ran (endtime non-zero) + # and that are within the filter limits + if ( $endtime + and ( $opt{b} ? ( $endtime > $opt{b} ) : 'okay' ) + and ( $opt{e} ? ( $endtime <= $opt{e} ) : 'okay' ) ) + { + print; + } +} +continue { + $fileCount++ if eof; +} + +__END__ + +FORMAT - see accounting(5) +08 submission_time +09 start_time +10 end_time diff --git a/flex-grid/scripts/qlic b/flex-grid/scripts/qlic new file mode 100755 index 0000000..f492dad --- /dev/null +++ b/flex-grid/scripts/qlic @@ -0,0 +1,517 @@ +#!/usr/bin/perl -w +use strict; +use Getopt::Std qw( getopts ); +use POSIX qw( ); + +( my $Script = $0 ) =~ s{^.*/}{}; + +my $time = time; +my $date = POSIX::strftime( "%F %T", localtime $time ); + +$ENV{SGE_ROOT} or die "Error $Script: \$SGE_ROOT is not set\n"; +$ENV{SGE_CELL} ||= "default"; # sge_cell + +my ($siteLocation) = join "/" => ( $ENV{SGE_ROOT}, $ENV{SGE_CELL}, "site" ); + +my $config = { + -site => ( $siteLocation || '' ), + -cache => ( $siteLocation || '' ) . "/cache/" . "qlicserver.xml", + -limits => ( $siteLocation || '' ) . "/" . "qlicserver.limits", +}; + +# ------------------------------------------------------------------------ +# utils + +# +# calculate age from an epoch value +# +sub age { + my ( $a, $b ) = @_; + my $diff = ( $a - $b ); + + my $sign = ''; + if ( $diff < 0 ) { # handle negatives + $sign = '-'; + $diff = abs($diff); + } + + sprintf "$sign%d:%02d:%02d", # format into hh:mm:ss + ( int $diff / 3_600 ), # hh + ( ( int $diff / 60 ) % 60 ), # mm + ( $diff % 60 ); # ss +} + +# +# change hash references to a comma-delimited string of key=value entries +# +sub hashRefToString { + map { + my $ref = $_; + ref $ref ? map { "$_=$ref->{$_}" } sort keys %$ref : () + } @_; +} + +# +# extract attrib="value" ... attrib="value" +# +sub parseXMLattrib { + my $str = shift || ''; + my %attr; + + while ($str =~ s{^\s*(\w+)=\"([^\"]*)\"}{}s + or $str =~ s{^\s*(\w+)=\'([^\']*)\'}{}s ) + { + $attr{$1} = $2; + } + + %attr; +} + +# ------------------------------------------------------------------------ +# processing of qlicserver.xml output +# +package qlicCache; + +sub new { + my $caller = shift; + my $file = shift; + + my $self = bless { + ( map { $_ => {} } qw( -rc ) ), + ( map { $_ => '' } qw( -date -host -age ) ) + }, $caller; + + -f $file or return $self; + + local $_ = do { local ( @ARGV, $/ ) = $file; <>; }; + + # strip out all xml comments + s{\s*}{}sg; + + # get the header section + s{^(.+?)}{}s or return; + my $header = $1; + + for ($header) { + if (m{]*))? > \s*(.+?)\s* }sx) { + my ( $attr, $content ) = ( $1, $2 ); + $self->{-host} = $content; + } + if (m{}sx) { + my ( $attr, $content ) = ( $1, $2 ); + my %attr = main::parseXMLattrib($attr); + + $self->{-age} = main::age( $time, $attr{epoch} ) if $attr{epoch}; + $self->{-date} = $content; + } + } + + # only retain the contents + s{^.*?}{}s and s{.*$}{}s or return; + + ## process + while (s{]*))? />}{}sx) { + my ($attr) = ($1); + my %attr = main::parseXMLattrib($attr); + my $name = delete $attr{name}; + + if ( defined $name ) { + for ( keys %attr ) { + $self->{-rc}{$name}{$_} = $attr{$_} || 0; + } + } + } + + ## process CONTENT + while (s{]*))? > \s* (.*?) \s* }{}sx) { + my ( $attr, $content ) = ( $1, $2 ); + my %attr = main::parseXMLattrib($attr); + my $name = delete $attr{name}; + + if ( defined $name ) { + for ( keys %attr ) { + $self->{-rc}{$name}{$_} = $attr{$_} || 0; + } + } + + ## process COUNT + while ( $content =~ s{]*))? >\s*(\d+)\s*}{}sx ) + { + my ( $attr, $count ) = ( $1, $2 ); + my %attr = main::parseXMLattrib($attr); + my $user = delete $attr{name}; + my $host = delete $attr{host}; + + if ( defined $user ) { + if ( defined $host ) { + $self->{-rc}{$name}{-where}{"$user\@$host"} = $count; + } + else { + ## tag waiting with '[]' + $self->{-rc}{$name}{-where}{$user} = "[$count]"; + } + } + } + } + + return $self; +} + +sub query { + my $self = shift; + %{ $self->{-rc} }; +} + +sub dump { + use Data::Dumper; + print Dumper( $_[0] ); +} + +sub available { + my $self = shift; + sort keys %{ $self->{-rc} }; +} + +# ------------------------------------------------------------------------ +# processing of qlicserver.limits FILE or DIRECTORY +# +package qlicLimits; + +sub new { + my $caller = shift; + my $diskValues = shift; + + my $self = bless {}, $caller; + + my $fileString; + if ( defined $diskValues and -f $diskValues ) { + $fileString = do { + local ( *FILE, $/ ); + + if ( open FILE, $diskValues ) { + ; + } + else { + undef; + } + }; + } + elsif ( defined $diskValues and -d $diskValues ) { + local *DIR; + my $dir = $diskValues; + if ( opendir DIR, $dir ) { + my @files = grep { -f "$dir/$_" and -r _ } readdir DIR; + for my $name (@files) { + my $limit; + + # use the last value + if ( open FILE, "$dir/$name" ) { + $limit = ( map { /^\s*(-?\d+)\s*$/ } )[-1]; + } + defined $limit or $limit = "NONE"; + $self->{$name} = $limit; + } + } + } + + for ($fileString) { + defined or next; + + # strip out all comments + s{\s*}{}sg; + + ## process and + while (s{]*))? />}{}sx + or s{]*))? >\s*}{}sx ) + { + my %attr = main::parseXMLattrib($1); + my $name = delete $attr{name}; + my $limit = delete $attr{limit}; + if ( defined $name and defined $limit ) { + $self->{$name} = $limit; + } + } + } + + return $self; +} + +sub change { + my $caller = shift; + my $diskValues = shift; + my @args = @_; + + @args or return; + + my ( %pending, %adjusted ); + + for (@args) { + s{,}{ }g; # comma -> space-delimited + + my %h = map { /^(.+?)=(.*)$/ } split; + for ( keys %h ) { + defined $h{$_} and length $h{$_} or $h{$_} = "NONE"; + $pending{$_} = $h{$_}; + } + } + + keys %pending or return; + + my $user = getpwuid $<; + if ( defined $diskValues and -d $diskValues ) { + local *DIR; + my $dir = $diskValues; + if ( opendir DIR, $dir ) { + my @files = grep { -f "$dir/$_" and -w _ } readdir DIR; + + for my $name (@files) { + if ( exists $pending{$name} ) { + local *FILE; + if ( open FILE, ">", "$dir/$name" ) { + print FILE "# adjusted by $user $date\n", + "$pending{$name}\n"; + $adjusted{$name} = delete $pending{$name}; + } + } + } + } + } + + for ( [ "adjusted" => \%adjusted ], [ "not adjusted" => \%pending ], ) { + my ( $label, $href ) = @$_; + keys %$href or next; + print "$label: ", + join( "," => map { qq{$_=$href->{$_}} } sort keys %$href ), "\n"; + } +} + +sub output { + my $self = shift; + + my @list = map { qq{$_=$self->{$_}} } sort keys %$self; + + print "limits: "; + if (@list) { + print join( "," => @list ), "\n"; + } + else { + print "NONE\n"; + } +} + +# ------------------------------------------------------------------------ +# main +# + +package main; +import qlicCache; + +# ------------------------------------------------------------------------ +sub usage { + $! = 0; # clean exit + warn "@_\n" if @_; + die <<"USAGE"; +usage: + $Script [OPTION] + $Script [OPTION] resource=limit .. resource=limit + +with options: + -c FILE alternative location for the license cache + -C FILE alternative location for the license limit + -d dump cache file as raw xml + -D dump license cache in perl format + -f display free licenses only + -l list license limit + -q display free licenses via qhost query + -u license usage via 'lacct' + -U license usage per user via 'lacct -u' + -w show who/where ('[]' indicates waiting jobs) + -h this help + +* extract / display information for the GridEngine license cache + $config->{-cache} + +* adjust / display information for the license limits + $config->{-limits} + +copyright (c) 2003-10 + +Licensed and distributed under the Creative Commons +Attribution-NonCommercial-ShareAlike 3.0 License. +http://creativecommons.org/licenses/by-nc-sa/3.0 +USAGE +} + +# ------------------------------------------------------------------------- +my %opt; +getopts( 'hc:C:DdflqUuw', \%opt ) or usage(); +$opt{h} and usage(); + +if ( $opt{U} ) { + ## user-based usage from accounting + my @query = ( "lacct", "-u" ); + exec @query; + exit 2; +} +elsif ( $opt{u} ) { + ## usage from accounting + my @query = ( "lacct", $opt{w} ? "-w" : () ); + exec @query; + exit 2; +} + +if ( $opt{d} ) { + my $file = $opt{c} || $config->{-cache}; + + if ( not -f $file and $file !~ m{/} ) { + $file = "$config->{-site}/$file"; + } + + -f $file or exit 1; + + local $_ = do { local ( @ARGV, $/ ) = $file; <>; }; + + # do a basic check for well-formed xml + # this might not be the case if there is a race condition + # and the file has not been fully written + + # check for '' at the end + my ($tag) = m{^<\?xml (?:\s+[^<>]*?)? \?>\s*\<(\w+)}sx; + unless ( $tag and m{\s*$} ) { + sleep 2; ## wait and try again + $_ = do { local ( @ARGV, $/ ) = $file; <>; }; + } + + $_ ||= ''; ## avoid uninitialized + + print; + exit; +} + +if ( $opt{q} ) { + my %free = + map { /^\s+gc:(\S+?)=(\d\S*)\s*$/ } + grep { /^global/ ... /^\S/ } qx{qhost -F}; + + $_ += 0 for values %free; + + for ( sort keys %free ) { + my $intval = $free{$_} + 0; # normalize as integers + print "$_=$intval\n"; + } + exit; +} + +if ( $opt{l} ) { + qlicLimits->new( $opt{C} || $config->{-limits} )->output(); + exit; +} + +if (@ARGV) { + qlicLimits->change( $opt{C} || $config->{-limits}, @ARGV ); + exit; +} + +my $info = qlicCache->new( $opt{c} || $config->{-cache} ); +$info->dump() if $opt{D}; + +my %resources = $info->query(); + +# +# display free licenses +# +if ( $opt{f} ) { + for my $resource ( sort keys %resources ) { + my $count = $resources{$resource} || {}; + my $free = $count->{free} || 0; + print "$resource=$free\n" if $free; + } + + exit; +} + +# +# display who/where +# +if ( $opt{w} ) { + my ($len) = sort { $b <=> $a } map { length } keys %resources; + $len += 2; + + my $fmt = "%-${len}s"; + my $indent = sprintf "\n$fmt", ''; + + for my $resource ( sort keys %resources ) { + my $count = $resources{$resource} || {}; + my @list = hashRefToString( $count->{-where} ); + if (@list) { + printf $fmt, $resource; + print join( $indent => @list ), "\n"; + } + } + + exit; +} + +# +# define table output format +# +my @outputList; + +format = +# name total limit extern intern wait free +@<<<<<<<<<<< @>>>>> @>>>>> @>>>>> @>>>>> @>>>> @>>>> +@outputList +. + +# +# display table header +# -------------------- +{ + my @info = qw( host age ); + my ($len) = sort { $b <=> $a } map { length } @info; + + print map { + my $k = sprintf "%-${len}s", $_; + my $v = $info->{"-$_"}; + $v ? "$k = $v\n" : (); + } @info; + + print "\n"; + + @outputList = qw( resource total limit extern intern wait free ); + + write; + s/./-/g for @outputList; + write; +} + +# +# display table body +# ------------------ +for my $resource ( sort keys %resources ) { + my $count = $resources{$resource} || {}; + @outputList = + ( $resource, @{$count}{qw( total limit extern intern waiting free )} ); + + my $type = $resources{$resource}{type} || 0; + + # no total? + $_ ||= "?" for $outputList[1]; + + if ( $type eq "intern" ) { + $_ = "*" for $outputList[3]; + } + elsif ( $type eq "track" ) { + $_ = "*" for $outputList[4]; + } + + # easy to read representation for zero + for (@outputList) { + defined $_ or $_ = '.'; + } + + write; +} + +# ------------------------------------------------------------------------ diff --git a/flex-grid/site/qlicserver b/flex-grid/site/qlicserver new file mode 100755 index 0000000..2a34f8f --- /dev/null +++ b/flex-grid/site/qlicserver @@ -0,0 +1,2327 @@ +#!/usr/bin/perl -w +# avoid shell starter method here - otherwise we cannot kill the daemon +use 5.008; ## minimum perl version +use strict; +use threads; ## REMOVE FOR UNTHREADED PERL +use Getopt::Std qw( getopts ); +use POSIX qw( ); +import License; +import GridEngine; +import Qconf; + +my ($releaseDate) = qw( 2010-01-20 ); +my ( $Path, $Script ) = map { m{^(.+)/([^/]+)$} } $0; # instead of fileparse + +################################################################################ +################################################################################ +# CUSTOMIZE THESE SETTINGS TO MATCH YOUR REQUIREMENTS: +# +my $config = { + ## file locations: can only be overwritten by command-line parameters + -config => "$Path/qlicserver.config", + -limits => "$Path/qlicserver.limits", + + ## fallback configuration - can be removed or left empty as desired + -defaultConfig => qq{ + + + + + + +}, + +}; + +# +# +# END OF CUSTOMIZE SETTINGS +################################################################################ +################################################################################ + +# ------------------------------------------------------------------------------ +sub usage { + $! = 0; # clean exit + warn "@_\n" if @_; + die <<"USAGE"; +usage: $Script [OPTION] [PARAM] + Query availability of floating licenses for the GridEngine. + +help/debug options: + -h help + +initialization options: + -c show complex definitions (format as per 'qconf -sc') + for possible inclusion via 'qconf -Mc ...' + + -C provide initial values for + 'qconf -mattr exechost complex_values ... global' + + -i information about license features + (generates text for the config lookup table) + +query options: + -l resource=value,... + + similar to qsub(1), query the license server for the availability + of the requested resources. A missing value is treated as 1. + The resource 'slots' will be used to scale the resource requests + as required. Prints the resources available and exits with '99' if + the condition cannot be satisfied. Only externally served resources + are checked - resources internal to the GridEngine should never + need this check. + + -n suppress adjustment of the managed licenses (useful for testing) + +daemon options: + -d run query as a daemon + + -k kill running daemon + + -w wake-up daemon from sleep + +params: + dir=DIR + base directory for output,qhost,qstat parameters + + output=FILE + save query status to FILE + + qhost=FILE + add extra qhost query and save status to FILE + + qstat=FILE + save qstat query to FILE + + timeout=N + command timeout in seconds (default: 10 seconds) + + LM_LICENSE_FILE=STRING + override environment setting for server query + + lmutil=STRING + fully qualified path to lmutil command + + SGE_CLUSTER_NAME=STRING + provide cluster name + +static params: + delay=N + waiting period in seconds between queries in daemon mode + (a delay of 0 is interpreted as 30 seconds) + + ppid=(ppid | N | CMD) + which parent process id to watch in daemon mode. + This can be decisive for migration etc. + ppid = watch the lauching parent (default) + CMD = watch a particular process + N = watch a particular pid + +command-line params: + debug emit debug information for the developer + + config=FILE + specify alternative configuration file + (default: $config->{-config}) + + limits=FILE + specify alternative limits file/directory + (default: $config->{-limits}) + +This program has 2 major modes: + 1. Adjust the number of managed licenses, based on license availability + and the number of granted resources (as determined by 'qstat') using the + 'qconf -mattr exechost complex_values ... global' command + + 2. Query the license server for the availability of requested resources. + Exit with '99' (requeue) if the condition cannot be satisfied. + Prints the resources available. + +FILES: + The configuration can be hardcoded into this program and/or controlled + via an XML configuration file: + $config->{-config} + + The current limits for the resources are specified here: + $config->{-limits} + + This can be either an XML file, or a directory. + When it is a directory, the limits are specified as a single digit + in each file that corresponds to a resource name. + +NOTES: + Further information about the configuration can be found on the wiki + http://wiki.gridengine.info/wiki/index.php/Olesen-FLEXlm-Configuration + + This code is provided as a courtesy to other users with absolutely no + guarantees! Post usage questions to the users\@gridengine.sunsource.net + mailing list - please do not email the author directly. + +version ($releaseDate) +copyright (c) 2003-10 + +Licensed and distributed under the Creative Commons +Attribution-NonCommercial-ShareAlike 3.0 License. +http://creativecommons.org/licenses/by-nc-sa/3.0 +USAGE +} + +# ------------------------------------------------------------------------------ +my ( %opt, %cmdParam ); +getopts( "hcCdikl:nw", \%opt ) or usage(); +$opt{h} and usage(); +my $Debugging; + +# extract command-line parameters of the form param=value +for (@ARGV) { + if (/^([A-Za-z]\w*)=(.+?)$/) { + $cmdParam{$1} = $2; + } + elsif (/^([A-Za-z]\w*)$/) { + $cmdParam{$1} = undef; + } +} + +# add debugging +if ( exists $cmdParam{debug} ) { + $Debugging++; +} + +# override file locations: command-line parameters only +for (qw( config limits )) { + if ( exists $cmdParam{$_} ) { + $config->{"-$_"} = $cmdParam{$_}; + } +} + +# ------------------------------------------------------------------------------ + +# +# change hash references to a comma-delimited string of key=value entries +# +sub hashrefToString { + join ',' => map { + my $r = $_; + ref $r ? join ',' => map { "$_=$r->{$_}" } sort keys %$r : ''; + } @_; +} + +# +# extract attrib="value" ... attrib="value" +# +sub parseXMLattrib { + my $str = shift || ''; + my %attr; + + while ($str =~ s{^\s*(\w+)=\"([^\"]*)\"}{}s + or $str =~ s{^\s*(\w+)=\'([^\']*)\'}{}s ) + { + $attr{$1} = $2; + } + + %attr; +} + + +# +# resolve output file name from the config->{-parameter} +# relative to output 'dir' +# stdout (-) and absolute names are left untouched, +# as are names in the current working directory (starting with "./") +# +sub resolveOutputFile { + my $name = shift; + + my $file; + my $dir = $config->{-parameter}{dir}; + if ( exists $config->{-parameter}{$name} + and defined $config->{-parameter}{$name} ) + { + $file = $config->{-parameter}{$name}; + + if ( defined $dir + and length $dir + and $file !~ m{^\.?/} + and $file ne "-" ) + { + -d $dir or mkdir $dir; + $file = "$dir/$file"; + } + } + + return $file; +} + +# +# update the configuration as required +# +sub updateConfig { + my $configFile = $config->{-config}; + my $defaultConfig = $config->{-defaultConfig}; + + $config->{-configUpdate} ||= 0; # previous file update time + + my $needUpdate; + keys %{ $config->{-resources} } or $needUpdate++; # first-time + + my $fileString; + if ( defined $configFile and -f $configFile and -r _ ) { + my $mtime = ( stat $configFile )[9]; + + if ( $config->{-configUpdate} < $mtime ) { + $fileString = do { + local *FILE; + local $/; + if ( open FILE, $configFile ) { + $needUpdate++; + ; + } + else { + undef; + } + }; + + $config->{-configUpdate} = $mtime; + } + } + + return unless $needUpdate; + + # clear old values + $config->{-parameter} = {}; # command-line and file '' entries + $config->{-resources} = {}; # all the resources, original parameters + $config->{-derived} = {}; # derived resources only + $config->{-intern} = {}; # internal resources only + $config->{-managed} = {}; # managed internal/external/derived resources + $config->{-lookup} = {}; # reverse lookup (complex -> resource) + $config->{-mapFrom} = {}; # (optional) mapping based on server + + # config precedence: + # -defaultConfig (hard-coded) + # -config (FILE) + + # parameters precedence: + # -defaultConfig (hard-coded) + # -config (FILE) + # command-line + + my ( %cfg, %param ); + for ( $defaultConfig, $fileString ) { + defined or next; + + # strip out all xml comments + s{\s*}{}sg; + + ## an overwrite mechanism for 'parameters' and 'resources' + if (s{<(parameters|resources) \s*([^<>]+) >}{}sx) { + my ( $tag, $attr ) = ( $1, $2 ); + my %attr = parseXMLattrib($attr); + my $type = delete $attr{type}; + if ( defined $type and $type eq "overwrite" ) { + if ( $tag eq "parameters" ) { + %param = (); + } + elsif ( $tag eq "resources" ) { + %cfg = (); + } + } + } + + ## process .. + while (s{]+) > (.+?) }{}sx) { + my ( $attr, $value ) = ( $1, $2 ); + my %attr = parseXMLattrib($attr); + my $name = delete $attr{name}; + if ( defined $name ) { + $value =~ s{^\s+|\s+$}{}g; + $param{$name} = $value; + } + } + + ## process and .. + while (s{]+?) />}{}sx + or s{]+) > (.*?) }{}sx ) + { + my ( $attr, undef ) = ( $1, $2 ); + my %attr = parseXMLattrib($attr); + my $name = delete $attr{name}; + ## overwrite old value + if ( defined $name ) { + $cfg{$name} = {%attr}; + } + } + + ## process CONTENT + while (s{]+) > (.+?) }{}sx) { + my ( $attr, $content ) = ( $1, $2 ); + my %attr = parseXMLattrib($attr); + my $name = delete $attr{name}; + if ( defined $name ) { + delete $attr{served}; # derived are not served + delete $cfg{$name}; + + my @elem; + ## process ... + while ( $content =~ s{ \s*(\w+)\s* }{}sx ) { + push @elem, $1; + } + + if (@elem) { + $cfg{$name} = {%attr}; + $cfg{$name}{element} = [@elem]; + } + } + } + } + + for ( keys %cmdParam ) { + $param{$_} = $cmdParam{$_}; + } + + # assign the parameters + %{ $config->{-parameter} } = %param; + + for my $name ( keys %cfg ) { + ## All managed complexes are 'consumable' (mark as zero) + ## unless otherwise noted + my $type; + if ( exists $cfg{$name}{type} ) { + $type = $cfg{$name}{type}; + } + $type ||= 0; + + if ( exists $cfg{$name}{element} ) { + ## transfer derived information + # NB: probably can only have normal consumables + $config->{-derived}{$name} = delete $cfg{$name}; + } + elsif ( exists $cfg{$name}{served} ) { + ## create served -> resource lookup + my $served = $cfg{$name}{served}; + + if ( exists $cfg{$name}{from} ) { + ## insert server-specific remapping, server name in lowercase + for ( map { split } lc $cfg{$name}{from} ) { + $config->{-mapFrom}{$_}{$served} = $name; + + # since remapping occurs in the query, + # '-lookup' is an identity + $config->{-lookup}{$name} = [ $name, $type ]; + } + } + else { + $config->{-lookup}{$served} = [ $name, $type ]; + } + } + else { + ## not served and not derived -> internal resource + ## transfer information + $config->{-intern}{$name} = delete $cfg{$name}; + } + + ## only tracked resources are unmanaged + $config->{-managed}{$name} = $type unless $type =~ /track/i; + } + + # assign the rest + %{ $config->{-resources} } = %cfg; + + ## TODO: + ## check that the derived type is consistently job/non-job + + # update parameters: + # adjust timeout - the license server is the Achilles heel + if ( exists $config->{-parameter}{timeout} ) { + Shell->timeout( $config->{-parameter}{timeout} ); + } + + # adjust the license manager environment(s) and command(s) + for (@License::Manager) { + eval { + my $name = $_->envname(); + if ( defined $name and exists $config->{-parameter}{$name} ) { + $_->setenv( $config->{-parameter}{$name} ); + } + }; + + eval { + my $name = $_->cmdname(); + if ( defined $name and exists $config->{-parameter}{$name} ) { + $_->setcmd( $config->{-parameter}{$name} ); + } + }; + } +} + +# +# extract limits from the specified file: +# +# +# +# +# +# +# +# +# +# OR from files within the specified directory: +# The limits are specified as a single digit in each file that corresponds +# to a resource name. Negative limits are deducted from the total. +# +sub updateLimits { + my $diskValues = $config->{-limits}; + my $limits; + + # get defaults + for my $href ( + $config->{-intern}, ## + $config->{-resources}, ## + $config->{-derived}, ## + ) + { + for my $name ( keys %$href ) { + if ( exists $href->{$name}{limit} ) { + my $limit = $href->{$name}{limit}; + if ( defined $limit ) { + $limits->{$name} = $limit; + } + } + } + } + + my $fileString; + if ( defined $diskValues and -f $diskValues ) { + ## read from a single file (xml format) + $fileString = do { + local *FILE; + local $/; + if ( open FILE, $diskValues ) { + ; + } + else { + undef; + } + }; + } + elsif ( defined $diskValues and -d $diskValues ) { + ## read from multiple files (text format) + local *DIR; + my $dir = $diskValues; + if ( opendir DIR, $dir ) { + my @files = grep { -f "$dir/$_" and -s _ } readdir DIR; + for my $name (@files) { + my $limit; + + # use the last value + if ( open FILE, "$dir/$name" ) { + $limit = ( map { /^\s*(-?\d+)\s*$/ } )[-1]; + } + if ( defined $limit ) { + $limits->{$name} = $limit; + } + } + } + } + + for ($fileString) { + defined or next; + + # strip out all xml comments + s{\s*}{}sg; + + ## process and + while (s{]+) />}{}sx + or s{]+) >\s*}{}sx ) + { + my %attr = parseXMLattrib($1); + my $name = delete $attr{name}; + my $limit = delete $attr{limit}; + if ( defined $name and defined $limit ) { + $limits->{$name} = $limit; + } + } + } + + # negative limits on internal resources are only possible + # when a total is known + for my $name ( keys %$limits ) { + if ( $limits->{$name} < 0 + and exists $config->{-intern}{$name} + and not exists $config->{-intern}{$name}{total} ) + { + delete $limits->{$name}; + } + } + + $limits; +} + +# +# Prototype: mungeLicenses( HASHREF1 [, HASHREF2, [, HASHREF3]] ) +# +# HASHREF1 => { # from the license manager +# feature => { +# total => NUM, +# "user@machine nlicense" => occurances, +# "*user@machine" => NUM, ## waiting licenses +# ... +# }, +# } +# +# HASHREF2 => { # from qstat +# complex => { +# waiting => { +# "user" => NUM, +# }, +# jobid => { +# "user@machine nlicense" => occurances, +# ... +# }, +# total => NUM, # iff. an internal tracked value +# }, +# } +# +# HASHREF3 => { # ulimit +# complex => NUM, +# } +# +# munge into +# +# HASHREF => { +# complex => { +# extern => NUM, +# intern => NUM, +# limit => NUM, +# total => NUM, +# waiting => NUM, +# served => STRING, +# users => { +# extern => { "user@machine" => NUM, }, +# intern => { "user@machine" => NUM, }, +# waiting => { "user" => NUM, }, +# }, +# }, +# } +# +sub mungeLicenses { + my $served = shift; + my $consumed = shift || {}; + my $limits = shift || {}; + my $report = {}; + + # + # cast the interesting features into the desired format. + # include 'intern' usage, but do not adjust 'extern' yet. + # + for my $feature ( keys %$served ) { + my $externUsers = $served->{$feature} or next; + exists $config->{-lookup}{$feature} or next; + my ( $resource, $type ) = @{ $config->{-lookup}{$feature} }; + + # remove 'total' from hash + my $total = delete $externUsers->{total} || 0; + + # internal job allocation, jobs waiting + my $internUsers = delete( $consumed->{$resource} ) || {}; + my $waitingUsers = delete( $internUsers->{waiting} ) || {}; + + # potential management limits + # negative limit implies subtract from total + my $limit = $limits->{$resource}; + if ( defined $limit ) { + $limit += $total if $limit < 0; + $limit = 0 if $limit < 0; + } + defined $limit and $limit < $total or $limit = $total; + + $report->{$resource} = { + type => $type, + served => $feature, + total => $total, + limit => $limit, + users => { + extern => $externUsers, + intern => $internUsers, + waiting => $waitingUsers, + }, + }; + } + + # + # add in internal features + # + for my $resource ( keys %$consumed ) { + my $total = delete $consumed->{$resource}{total}; + defined $total or next; + + # internal job allocation, jobs waiting + my $internUser = delete( $consumed->{$resource} ) || {}; + my $waitingUser = delete( $internUser->{waiting} ) || {}; + + # potential management limits + # negative limit implies subtract from total + my $limit = $limits->{$resource}; + if ( defined $limit ) { + $limit += $total if $limit < 0; + $limit = 0 if $limit < 0; + } + defined $limit and $limit < $total or $limit = $total; + + $report->{$resource} = { + type => "intern", + total => $total, + limit => $limit, + users => { + extern => {}, + intern => $internUser, + waiting => $waitingUser, + }, + }; + } + + # derived resources + # - external licenses are the external licenses of the components + # - the derived sub-resources may be reported/managed themselves + # or simply available directly from the server + for my $resource ( keys %{ $config->{-derived} } ) { + my $internUser = delete( $consumed->{$resource} ) || {}; + my $waitingUser = delete( $internUser->{waiting} ) || {}; + + my $entry = $report->{$resource} = { + total => 0, + limit => 0, + users => { + extern => {}, + intern => $internUser, + waiting => $waitingUser, + }, + }; + + for my $subResource ( @{ $config->{-derived}{$resource}{element} } ) { + my $part; + + ## reported sub-resource - already in the correct structure + if ( exists $report->{$subResource} ) { + $part = $report->{$subResource}; + } + elsif ( exists $served->{$subResource} ) { + ## served sub-resource - adjust into correct structure + $part = { -extern => { %{ $served->{$subResource} } } }; + my $total = delete $part->{-extern}{total} || 0; + + $part->{total} = $part->{limit} = $total; + } + + defined $part or next; # not reported/managed and not served + + # collect total/limit and extern + $entry->{total} += $part->{total} || 0; + $entry->{limit} += $part->{limit} || 0; + for ( keys %{ $part->{users}{extern} } ) { + $entry->{users}{extern}{$_} += $part->{users}{extern}{$_}; + } + } + + # the specified limit might be more stringent than that determined + # from the sub-resources + my $limit = $limits->{$resource}; + if ( defined $limit ) { + if ( $entry->{limit} > $limit ) { + $limit += $entry->{total} if $limit < 0; + $limit = 0 if $limit < 0; + $entry->{limit} = $limit; + } + } + } + + # - remove usage that is already accounted for + # - remove non-existent / implausible entry + # - prepend jobid.taskid with -ve to prevent it from being + # processed more than once + my $juggle = sub { + my ( $externUser, $internUser ) = @_; + + for my $jobIdent ( grep { /^\d+[\.\d]*$/ } keys %$internUser ) { + for ( keys %{ $internUser->{$jobIdent} } ) { + if ( $externUser->{$_} + and $externUser->{$_} >= $internUser->{$jobIdent}{$_} ) + { + $externUser->{$_} -= $internUser->{$jobIdent}{$_}; + $internUser->{"-$jobIdent"}{$_} = + delete $internUser->{$jobIdent}{$_}; + $externUser->{$_} > 0 or delete $externUser->{$_}; + } + } + ## remove empty hash references + keys %{ $internUser->{$jobIdent} } + or delete $internUser->{$jobIdent}; + } + }; + + for my $resource ( keys %$report ) { + my $entry = $report->{$resource}; + my $externUsers = $entry->{users}{extern} or next; # cannot happen + my $internUsers = $entry->{users}{intern} or next; + my $waitingUsers = $entry->{users}{waiting} ||= {}; + + # + # juggle extern/intern consumption + # + $juggle->( $externUsers, $internUsers ); + + # + # reduce extern/intern user to canonical form + # "user@host" => count + # + for ( [ extern => $externUsers ], [ intern => $internUsers ] ) { + my ( $label, $ref ) = @$_; + for my $r ( $label =~ /intern/ ? values %$ref : $ref ) { + my %hash; + for ( keys %$r ) { + my ( $key, $value ) = split; + defined $value or $value = 1; # for pre-reduced format + my $count = $r->{$_}; + $hash{$key} += $value * $count; + } + %$r = %hash; + } + } + + # + # juggle again - licenses may be split across several groups or servers + # + $juggle->( $externUsers, $internUsers ); + + # + # collapse one level of indirection and drop job numbers + # user/intern => { + # jobid => { + # "user@machine" => count, + # }, + # }, + # --> + # user/intern => { + # "user@machine" => count, + # }, + %$internUsers = do { + my %hash; + for my $ref ( values %$internUsers ) { + $hash{$_} += $ref->{$_} for keys %$ref; + } + %hash; + }; + + # add licenses reported as waiting by FlexLM + for ( grep { /^\*/ } keys %$externUsers ) { + $waitingUsers->{$_} += delete $externUsers->{$_}; + } + + # remove needless limiters + if ( $entry->{limit} >= $entry->{total} ) { + delete $entry->{limit}; + } + + # summarize the hashes to -> count + for ( + [ extern => $externUsers ], + [ intern => $internUsers ], + [ waiting => $waitingUsers ], + ) + { + my ( $label, $ref ) = @$_; + my $total; + $total += $_ for values %$ref; + $entry->{$label} = $total || 0; + } + } + + return $report; +} + +# +# Prototype qlic_output(fileName, HASHREF1, HASHREF2) +# +# HASHREF1 => { +# feature => { +# extern => NUM, +# intern => NUM, +# limit => NUM, +# total => NUM, +# waiting => NUM, +# served => STRING, +# user => { +# extern => { "user@machine" => NUM, }, +# intern => { "user@machine" => NUM, }, +# waiting => { "user" => NUM, }, +# }, +# }, +# } +# +# +# HASHREF2 => { # the changes +# feature => NUM, +# } +# +sub qlic_output { + my $cacheFile = shift; + my $report = shift; + my $mattr = hashrefToString(shift) || "NONE"; + + defined $cacheFile and length $cacheFile or return; + + # use temp file with rename to avoid race conditions + my $tmpFile = $cacheFile; + if ( $cacheFile ne "-" ) { # catch "-" STDOUT alias + $tmpFile .= ".TMP"; + unlink $tmpFile; + } + local *FILE; + open FILE, ">$tmpFile" or return; + + # write dates, administration information, some environment variables + my $time = time; + my $date = POSIX::strftime( "%FT%T", localtime $time ); + my $host = ( POSIX::uname() )[1]; + my $user = getpwuid $<; + + # cluster names/locations + my $sgeRoot = $ENV{SGE_ROOT} || ""; + my $sgeCell = $ENV{SGE_CELL} || "default"; + + # cluster name is not standard - maybe from env or config file + my $clusterName = $ENV{SGE_CLUSTER_NAME} || ""; + + # cluster name might just be in the config information + if ( exists $config->{-parameter}{SGE_CLUSTER_NAME} ) { + my $value = $config->{-parameter}{SGE_CLUSTER_NAME}; + if ( defined $value and length $value ) { + $clusterName = $value; + } + } + # $clusterName ||= "default"; ## fallback value + $clusterName = "default"; ## always use "default" + + + # header with comment about possible changes + print FILE << "XML_TEXT"; + + + + + + + $host + $user + + + +XML_TEXT + + # environment + for (qw( SGE_ROOT SGE_CELL SGE_ARCH SGE_BINARY_PATH SGE_qmaster )) { + if ( $ENV{$_} ) { + print FILE qq{ $ENV{$_}\n}; + } + } + + # show inherited license environment(s) + for (@License::Manager) { + my ( $name, $value ) = ( $_->envname(), $_->envvalue() ); + if ( defined $name and not exists $config->{-parameter}{$name} ) { + print FILE qq{ } + . ( $value || '' ) + . qq{\n}; + } + } + + # other parameters + for ( sort keys %{ $config->{-parameter} } ) { + my $value = $config->{-parameter}{$_}; + if ( defined $value and length $value ) { + print FILE qq{ $value\n}; + } + } + + # finish parameters and start resources + print FILE ## + qq{ \n}, ## + qq{ \n}; + + for my $name ( sort keys %{ $config->{-derived} } ) { + my @elem = @{ $config->{-derived}{$name}{element} }; + if (@elem) { + print FILE +( + qq{ \n}, + ( map { qq{ $_\n} } @elem ), + qq{ \n}, + ); + } + } + + for my $resource ( sort keys %$report ) { + my $entry = $report->{$resource} + or warn "(WW) '$resource' not defined\n" + and next; + + # hash some output values here: + my %output = ( + name => $resource, + ( map { $_ => $entry->{$_} } qw( served type waiting ) ) + ); + + my ( $total, $limit, $extern, $intern ) = + @{$entry}{qw( total limit extern intern )}; + + my $managed = ( $total - $extern ); + + if ( defined $limit and $limit < $total ) { + if ( $managed > $limit ) { + $managed = $limit; + } + } + else { + undef $limit; + } + + my $free = $managed - $intern; + + $_ >= 0 or $_ = 0 for ( $free, $managed ); # should not be required + + # transcribe directly from original data structure + if ( exists $config->{-resources}{$resource} ) { + my $rc = $config->{-resources}{$resource}; + + for (qw( served from note )) { + if ( exists $rc->{$_} ) { + $output{$_} = $rc->{$_}; + } + } + } + + print FILE qq{ $output{name} ], + [ served => $output{served} ], + [ from => $output{from} ], + [ total => $total ], + [ limit => $limit ], + [ extern => $extern ], + [ intern => $intern ], + [ waiting => $output{waiting} ], + [ free => $free ], + [ type => $output{type} ], + [ note => $output{note} ], + ) + { + my ( $k, $v ) = @$_; + if ( $k =~ /(total|limit)/ ) { + ## unconditional output + print FILE qq{ $k="$v"} if defined $v; + } + else { + print FILE qq{ $k="$v"} if $v; + } + } + + my $output; # track if anything was written + my $users = $entry->{users} || {}; + + for ( ## + [ extern => $users->{extern} ], ## + [ intern => $users->{intern} ], ## + [ waiting => $users->{waiting} ], ## + ) + { + my ( $label, $ref ) = @$_; + my %user; + $user{$_} += $ref->{$_} || 0 for keys %$ref; + + # output users + for my $tag ( sort keys %user ) { + my $count = $user{$tag}; + if ($count) { + my ( $name, $host ) = split /\@/, $tag; + + if ( not $output++ ) { + print FILE qq{>\n}; + } + print FILE qq{ $count\n}; + } + } + } + + # finish contents or finish as an empty element + if ($output) { + print FILE qq{ \n}; + } + else { + print FILE qq{/>\n}; + } + } + + # footer + print FILE ## + qq{ \n}, ## + qq{\n}; + + close FILE; # explicitly close before rename + if ( $tmpFile ne $cacheFile ) { + chmod 0444 => $tmpFile; # output cache is readonly + rename $tmpFile => $cacheFile; # atomic + } +} + +# +# get the pid of a command +# +sub pidof { + my $cmd = shift; + map { /^\s*(\d+)\s*$/ } qx{/bin/ps -C $cmd -o pid= 2>/dev/null}; +} + +# +# kill programs with the same name as this program +# +sub kill_daemon { + my $signal = shift || 9; + my @list = grep { $_ != $$ } pidof($Script); + kill $signal => @list if @list; +} + +# ------------------------------------------------------------------------------ +# '-k' +# terminate processes +# ------------------------------------------------------------------------------ +if ( $opt{k} ) { + kill_daemon 15; # TERM + exit 0; +} + +# ------------------------------------------------------------------------------ +# '-w' +# wakeup daemon +# ------------------------------------------------------------------------------ +if ( $opt{w} ) { + kill_daemon 10; # USR1 + exit 0; +} + +# for rest of the options, we need an updated configuration +updateConfig(); + +# ------------------------------------------------------------------------------ +# '-c' / '-C' +# configuration +# ------------------------------------------------------------------------------ +if ( $opt{C} or $opt{c} ) { + + # + # show complexes (format as per 'qconf -sc'); + # + if ( $opt{c} ) { + print <<'PRINT'; +# +# complexes for re-importing via "qconf -mc", +# licenses mostly weighted with '0' urgency (slot count used instead) +# +# name shortcut type relop requestable consumable default urgency +# ------------------------------------------------------------------------------ +PRINT + for my $name ( sort keys %{ $config->{-managed} } ) { + my $consumable = + $config->{-managed}{$name} =~ /job/i ? "JOB" : "YES"; + my $urgency = 0; + + # brute-force search for urgency + for my $href ( + $config->{-resources}, # + $config->{-derived}, # + $config->{-intern}, # + ) + { + if ( exists $href->{$name} ) { + if ( exists $href->{$name}{urgency} ) { + $urgency = $href->{$name}{urgency}; + } + last; + } + } + print "$name\t$name\tINT\t<=\tYES\t$consumable\t0\t$urgency\n"; + } + } + + if ( $opt{C} ) { + my $qconf = Qconf->query(); + + ## ignore complexes that are already known + delete @{ $config->{-managed} }{ keys %$qconf }; + + if ( %{ $config->{-managed} } ) { + ## initialize all values with zero + for ( values %{ $config->{-managed} } ) { + $_ = 0; + } + + print <<'PRINT'; +# initialize remaining managed resources with the following command: +PRINT + print " qconf -mattr exechost complex_values ", + hashrefToString( $config->{-managed} ), " global\n\n"; + } + else { + print "# nothing to do\n"; + } + } + + exit 0; +} + +# ------------------------------------------------------------------------------ +# '-i' +# query the license servers for available license features +# ------------------------------------------------------------------------------ +if ( $opt{i} ) { + my $license = License->query(); + + # header + print << 'XML_TEXT'; + + + + +XML_TEXT + + my @new; + for ( sort keys %$license ) { + my ( $type, $feature, $resource ) = ( "", $_, lc $_ ); + + if ( exists $config->{-lookup}{$feature} ) { + ( $resource, $type ) = @{ $config->{-lookup}{$feature} }; + print qq{ {-resources}{$resource} }; + delete $h{served}; + for ( sort keys %h ) { + print qq{ $_="$h{$_}"}; + } + } + print qq{/>\n}; + } + else { + push @new, $feature; + } + } + + # footer + print << 'XML_TEXT'; + + +XML_TEXT + + if (@new) { + print << 'XML_TEXT'; + +\n}; + } + + exit 0; +} + +# ------------------------------------------------------------------------------ +# '-l resource=value,...' +# query the license server for the availability +# ------------------------------------------------------------------------------ +if ( $opt{l} ) { + + # only check served/derived resources, to avoid extra qconf -se + # and since this check should be unnecessary for internal resources anyhow + delete @{ $config->{-managed} }{ keys %{ $config->{-intern} } }; + + # comma -> space-delimited, extracting 'slots' along the way + my $slots; + my @list = + map { + my ( $rc, $request ) = split /=+/; + defined $request and $request =~ /^\d+\.?\d*$/ or $request ||= 1; + + if ( exists $config->{-managed}{$rc} ) { + [ $rc => $request ]; + } + else { + ## number of slots ('slots=' or 's=') + $slots = $request if $rc =~ /^(?:s|slots)$/; + (); + } + } + map { s{,}{ }g; split; } $opt{l}; + + @list or exit 0; + + # qstat query + my $qstat = GridEngine->qstat( + undef, ## without file caching + $config->{-managed} ## distinguish complex types + ); + + # get my own job identifier from the environment + # treat non-array job (task=undefined) as task=0 + ( my $jobIdent = ( $ENV{JOB_ID} || 0 ) . '.' . ( $ENV{SGE_TASK_ID} || 0 ) ) + =~ s/[a-z]+$/0/i; + + # never count myself in the overal balance, otherwise we block our own way! + for ( values %$qstat ) { + delete $_->{$jobIdent}; + } + + # get the projected resource availability: + my $licenses = mungeLicenses( + License->query( $config->{-mapFrom} ), ## license availability + $qstat, ## qstat query + updateLimits() ## limits are interesting + ); + + my $failed; + $slots ||= 1; # safety + for (@list) { + my ( $rc, $request ) = @$_; + if ( exists $licenses->{$rc} ) { # safety + my ( $total, $limit, $extern, $intern ) = + @{ $licenses->{$rc} }{qw( total limit extern intern )}; + + my $managed = ( $total - $extern ); + + if ( defined $limit and $limit < $total ) { + if ( $managed > $limit ) { + $managed = $limit; + } + } + else { + undef $limit; + } + + my $free = $managed - $intern; + + if ( $free < 0 ) { + $free = 0; + } + + ## scale non-'job' consumables + $request *= $slots unless $config->{-managed}{$rc} =~ /job/i; + $request = sprintf "%.0f", $request; + + if ( $request > $free ) { + $request = $free; + $failed++; + } + } + $_ = "$rc=$request"; + } + print join( ',' => @list ), "\n"; + + exit( $failed ? 99 : 0 ); +} + +# ------------------------------------------------------------------------------ +# standard query, with optional '-d' (daemonize) +# ------------------------------------------------------------------------------ +my $daemon = $opt{d}; + +if ($daemon) { # daemonize + + # the delay between loops + my $delay = $config->{-parameter}{delay}; + $daemon = ( $delay and $delay =~ /^\d+$/ ) ? $delay : 30; + + # terminate old processes + kill_daemon 15; # TERM + + # option 1 (default): + # - watch the pid of the original parent process + # option 2: + # - watch the pid of a particular process (eg, sge_qmaster) + # option 3: + # - watch a particular pid (a pid <= 1 implies a true daemon) + + my $ppid = getppid(); # get ppid before forking + + # we can can check this process quite simply + *check_ppid = sub { kill 0 => $ppid }; + + if ( exists $config->{-parameter}{ppid} ) { + my $value = $config->{-parameter}{ppid}; + if ( $value ne "ppid" ) { + if ( $value =~ /^\d+$/ ) { + $ppid = $value; + } + else { + ($ppid) = pidof($value); + defined $ppid + or die "no pid for command '$value' ... exiting\n"; + } + + no warnings 'redefine'; + if ( $ppid <= 1 ) { + ## a true daemon - ignore the parent + *check_ppid = sub { 1; }; + } + else { + ## kill 0 doesn't always work if we don't own the process + ## use the /proc system if it seems to exist + if ( -d "/proc/$$" and -d "/proc/$ppid" ) { + *check_ppid = sub { -d "/proc/$ppid"; }; + } + else { + ## or revert to a more expensive system call + *check_ppid = sub { + system "/bin/ps -p $ppid -o pid= >/dev/null 2>&1"; + ($?) ? 0 : 1; + }; + } + } + + # test if we can watch this pid before attempting to fork + check_ppid() + or die "cannot watch ppid=$ppid '$value' ... exiting\n"; + } + } + + # + # this makes the code quasi-independent of the parent process + # but should allow it to detect when the launching load-sensor + # has restarted + # + *processing = sub { + if ( $daemon > 0 and check_ppid() ) { + ## daemon still running and ppid still alive + sleep( $daemon || 0 ); + } + else { + ## ppid looks dead - let's die too + $daemon = 0; + } + return $daemon; + }; + + my $pid = fork; + exit if $pid; # let parent exit + defined $pid or die "Couldn't fork: $!"; + + # a new process group for the child + POSIX::setsid() or die "Can't start a new session: $!"; +} +else { + $daemon = 0; + *processing = sub { $daemon = 0; }; +} + +if ($daemon) { + ## Trap fatal signals, setting flag to exit gracefully + $SIG{INT} = $SIG{TERM} = sub { $daemon = 0; }; + $SIG{PIPE} = "IGNORE"; + $SIG{USR1} = sub { sleep 0; }; # allow wake-up on demand + $SIG{USR2} = sub { + sleep 0; # wake-up + $daemon = -1; # signal end + }; +} + +# +# the main license query and 'qconf -mattr' code +# standard - execute once +# daemon - loop until killed +# +do { + updateConfig(); + + my $limits = updateLimits(); + my $served = License->query( $config->{-mapFrom} ); + my $qconf = Qconf->query(); + + # qstat query and cache to a file + my $qstat = GridEngine->qstat( + resolveOutputFile("qstat"), ## optional cache + $config->{-managed} ## distinguish complex types + ); + + # cache qhost query to a file + GridEngine->qhost( resolveOutputFile("qhost") ); + + # merge in the intern tracked resources + # take total from config, for the limits or from qconf + for ( keys %{ $config->{-intern} } ) { + if ( exists $qconf->{$_} ) { + if ( exists $config->{-intern}{$_}{total} ) { + $qstat->{$_}{total} = $config->{-intern}{$_}{total}; + } + elsif ( exists $limits->{$_} and $limits->{$_} >= 0 ) { + $qstat->{$_}{total} = $limits->{$_}; + } + else { + $qstat->{$_}{total} = $qconf->{$_}; + } + } + } + + # assign 'total => 0' for managed licenses that were not + # reported from the server (eg, server down) + for ( keys %{ $config->{-lookup} } ) { + $served->{$_} ||= { total => 0 }; + } + + my $licenses = mungeLicenses( $served, $qstat, $limits ); + my $change = Qconf->diff( $qconf, $licenses ); + + # cache output to a file + qlic_output( resolveOutputFile("output"), $licenses, $change ); + + if ($Debugging) { + $opt{n}++; + eval { + use Data::Dumper; + warn Data::Dumper->Dump( [ $licenses, $change ], + [qw(License Change)] ), "\n"; + }; + + exit; + } + + Qconf->mattr( hashrefToString($change) ) unless $opt{n}; + +} while processing(); + +exit 0; + +# ------------------------------------------------------------------ end-of-main +# somewhat like the qx// command with a timeout mechanism, +# but for safety it only handles a list form (no shell escapes) +# + +package Shell; +our ( $timeout, $report ); + +BEGIN { + $timeout = 10; +} + +# +# assign new value for reporting the timeout +# +sub report { + my ( $caller, $value ) = @_; + $report = $value; +} + +# +# assign new timeout +# +sub timeout { + my ( $caller, $value ) = @_; + $timeout = ( $value and $value =~ /^\d+$/ ) ? $value : 10; +} + +sub cmd { + my ( $caller, @command ) = @_; + my ( @lines, $pid, $redirected ); + local ( *OLDERR, *PIPE ); + + # kill off truant child: this works well for unthreaded processes, + # but threaded processes are still an issue + local $SIG{__DIE__} = sub { kill TERM => $pid if $pid; }; + + eval { + local $SIG{ALRM} = sub { die "TIMEOUT\n" }; # NB: '\n' required + alarm $timeout if $timeout; + @command or die "$caller: Shell->cmd with an undefined query\n"; + + if ( open OLDERR, ">&", \*STDERR ) { + $redirected++; + open STDERR, ">/dev/null"; + } + + $pid = open PIPE, '-|', @command; # open without shell (forked) + if ($pid) { + @lines = ; + } + + die "(EE) ", @lines if $?; + alarm 0; + }; + + # restore stderr + open STDERR, ">&OLDERR" if $redirected; + + if ($@) { + if ( $@ =~ /^TIMEOUT/ ) { + warn "(WW) TIMEOUT after $timeout seconds on '@command'\n" if $report; + return undef; + } + else { + die $@; # propagate unexpected errors + } + } + + wantarray ? @lines : join '' => @lines; +} + +1; + +# --------------------------------------------------------------- end-of-package +# FlexLM queries +# +# The env variable 'LM_LICENSE_FILE' contains a colon-delimited list +# with "port@server:port@server". +# The queries for the same server (but different ports) are grouped together +# and run in a common thread. +# eg, +# port1@server1:port1@server2:port2@server1 +# -> port1@server1:port2@server1 + port1@server2 +# running in two threads. +# +# NOTE: for grouping to work, the servers must be named consistently +# eg, +# port1@server1.domain:port2@server1:port3@server1.ip.addr +# -> port1@server1.domain + port2@server1 + port3@server1.ip.addr +# +# To suppress grouping by server, entries can be surrounded by brace brackets. +# eg, +# port1@server1:port1@server2:{port2@server1} +# -> port2@server1 + port1@server1 + port1@server2 +# +# or, +# {port1@server1:port1@server2:port2@server1} +# -> port1@server1:port1@server2:port2@server1 +# +# +# This behaviour can be useful when license server triads are in use. +# When a triad is in place, the single query to all three servers returns the +# correct information, whereas three separate queries would incorrectly return +# a triple count! +# eg, +# port1@server1:{port@triad1:port@triad2:port@triad3} +# -> port@triad1:port@triad2:port@triad3 + port1@server1 +# +# As a side-effect, entries enclosed in brace brackets will be queried first. +# +package Flexlm; +our ( $env, $cmd, @args, @servers ); + +BEGIN { + $env = $ENV{LM_LICENSE_FILE}; + $cmd = "lmutil"; # query + @args = qw( lmstat -a -c ); # cmd (query) arguments + push @License::Manager, __PACKAGE__; + + sub _assign_servers { + my $value = shift; + @servers = (); + + if ($value) { + my %index; + my $index = 0; + + # get grouped server queries + while ( $value =~ s/\{(.*?)\}// ) { + if ($1) { + push @servers, $1; + $index++; + } + } + + for ( map { s{[:;]+}{ }g; split } $value ) { + ( my $name = $_ ) =~ s/^\d*\@//; ## port@server or @server + if ( defined $index{$name} ) { + $servers[ $index{$name} ] .= ":$_"; + } + else { + $index{$name} = $index++; + push @servers, $_; + } + } + } + } + + _assign_servers($env); +} + +sub cmdname { + return "lmutil"; +} + +sub envname { + return "LM_LICENSE_FILE"; +} + +sub envvalue { + return $env; +} + +sub setcmd { + my ( $caller, $value ) = @_; + + if ( defined $value ) { + $cmd = $value; + } +} + +# setenv does not actually need to set the environment since we use +# the '-c' option directly +sub setenv { + my ( $caller, $value ) = @_; + + if ( defined $value and ( not defined $env or $env ne $value ) ) { + $env = $value; + _assign_servers($value); + } +} + +# ------------------------------------------------------------------------------ +# PARSE Flexlm output that looks like this +# +# License server status: port@server +# License file(s) on server: ... +# +# Users of PATRAN: (Total of 7 licenses available) +# +# "PATRAN" v2003.1130, vendor: MSC +# floating license +# +# user1 host1 host1 (v2002.0120) (server.domain/port 861), start Fri 1/31 11:00 +# user2 host2 host2 (v2001.0523) (server.domain/port 1007), start Fri 1/31 12:24 +# user3 host3 /dev/pts/0 (v1999.1020) (license.server.domain/port 352), start Fri 1/31 13:11 +# +# ------------------------------------------------------------------------------ +# +# Note that 'lmstat' also seems to use entries from the ~/.flexlmrc file and/or +# daemon-specific environment variables such as '*_LICENSE_FILE'. +# +# We thus limit the query to the entries explicitly found in LM_LICENSE_FILE +# +# return: +# HASHREF => { +# feature => { +# total => number, +# "user@machine nlicense" => occurances, +# "user@machine nlicense" => occurances, +# }, +# } +sub query_server { + my ( $caller, $server ) = @_; + my $license = {}; + + $server ||= join( ":" => @servers ); + + my @lines = Shell->cmd( $cmd, @args, $server ); + + defined $lines[0] or return $license; + + # warn "parse <@lines>\n"; + my ( $serverInfo, $feature ); + + for (@lines) { + defined or next; + + ## We don't currently do anything with this information + ## capture server port/name + # if (/^License \s+ server \s+ status: \s+ (\d+\@\S+?)\s*$/mgcx) + # { + # $serverInfo = lc $1; + # next; + # } + + ## capture error status + ## e.g. Users of DesignWare-Regression: (Error: 10 licenses, unsupported by licensed server) + if ( my ( $what, $total ) = +/^Users \s+ of \s+ (\S+?): .+? [Ee]rror:\s+ (\d+) \s+ licen[cs]e/mgcx + ) + { + $feature = $what; + $license->{$feature} ||= { total => 0 }; + next; + } + + ## extract total licenses available, record the 'feature' name + if ( my ( $what, $total ) = + /^Users \s+ of \s+ (\S+?): .+? \s+ (\d+) \s+ licen[cs]e/mgcx ) + { + $feature = $what; + $license->{$feature}{total} += $total; + next; + } + + $feature and exists $license->{$feature} or next; + + # lines with ", start" indicate a license is in use + # + # 'user' and 'machine' are the first 2 entries + # + if (/, \s+ start \s+/x) { + my ($count) = /(\d+) \s+ licen[cs]e/x; + $count ||= 1; + + my ( $user, $host ) = map { lc } split; + $host =~ s/\..*$//; # unqualified hostname + + $license->{$feature}{"$user\@$host $count"}++; + next; + } + + # add in queued licenses - identify with '*' prefix + if ( my ($count) = /\s+ queued \s+ for \s+ (\d+) \s+ licen[cs]es/x ) { + my ( $user, $host ) = map { lc } split; + $host =~ s/\..*$//; # unqualified hostname + + $license->{$feature}{"*$user\@$host"} += $count || 1; + next; + } + } + + return $license; +} + +# +# spawn threads and merge results from multiple 'query_server' calls +# +# The optional remapping field can be used to rename features on a +# server-by-server basis before returning the hash. This only works when +# threading works correctly - ie, each query corresponds to exactly a +# single server +# +sub query { + my $caller = shift; + my $mapFrom = shift || {}; + my $license = {}; + + @servers or return $license; + + if ( @servers <= 1 and keys %$mapFrom ) { + return $caller->query_server(); + } + + ## REMOVE REMAINDER FOR UNTHREADED PERL + + my @threads; # record the server names / thread ids here + for my $server (@servers) { + my $thread = threads->create( sub { $caller->query_server($server) } ); + if ( defined $thread ) { + my ( $lookup, %server ); + + # group the servers, avoid touching the alias + for ( map { s{[:;]+}{ }g; split } ( my $srv = $server ) ) { + ( $lookup = $_ ) =~ s/^\d*\@//; ## port@server or @server + $lookup = lc $lookup; + $server{$lookup}++; + } + + keys %server == 1 or undef $lookup; + push @threads, [ $lookup, $thread ]; + } + else { + warn "could not start thread for server $server\n;"; + } + } + + # collect data, waiting for all threads to finish + # each thread returns a hash-of-hashes + for (@threads) { + my ( $lookup, $thread ) = @$_; + my ($hash) = $thread->join(); + + # establish possible server-specific remapping + my $remap = {}; + if ( defined $lookup and exists $mapFrom->{$lookup} ) { + $remap = $mapFrom->{$lookup}; + } + + for ( keys %$hash ) { + my $subhash = $hash->{$_}; + ## allow server-specific remapping + my $feature = exists $remap->{$_} ? $remap->{$_} : $_; + + for my $k ( keys %$subhash ) { + my $v = $subhash->{$k}; + $license->{$feature}{$k} += $v; + } + } + } + + return $license; +} + +1; + +# --------------------------------------------------------------- end-of-package +# A class for combining several types of license managers. +# Assumes that the same license feature cannot be managed by more than a +# single license manager type + +package License; + +sub query { + my $caller = shift; + return +{ map { %{ $_->query(@_) } } @License::Manager }; +} + +sub envnames { + my $caller = shift; + return map { $_->envname() } @License::Manager; +} + +1; + +# --------------------------------------------------------------- end-of-package +# provide paths to GridEngine bin/ and utilbin/ +# and wrappers to the Shell->cmd() + +package GridEngine; +our ( $bin, $utilbin ); + +BEGIN { + $ENV{SGE_SINGLE_LINE} = 1; # do not break up long lines with backslashes + + $bin = $ENV{SGE_BINARY_PATH} || ''; + $utilbin = $ENV{SGE_utilbin} || ''; + + if ( -d ( $ENV{SGE_ROOT} || '' ) ) { + my $arch = $ENV{SGE_ARCH} + || qx{$ENV{SGE_ROOT}/util/arch} + || 'NONE'; + + chomp $arch; + + -d $bin or $bin = "$ENV{SGE_ROOT}/bin/$arch"; + -d $utilbin or $utilbin = "$ENV{SGE_ROOT}/utilbin/$arch"; + } + + for ( $bin, $utilbin ) { + if ( -d $_ ) { + s{/*$}{/}; + } + else { + $_ = ''; + } + } +} + +# relay command to Shell +sub bin { + my $caller = shift; + my $cmd = $bin . (shift); + + return Shell->cmd( $cmd, @_ ); +} + +# relay command to Shell +sub utilbin { + my $caller = shift; + my $cmd = $utilbin . (shift); + + return Shell->cmd( $cmd, @_ ); +} + +# write readonly cache file, +# using temp file with rename to avoid race conditions +sub writeCache { + my $caller = shift; + my $cacheFile = shift; + + defined $cacheFile and length $cacheFile and @_ or return; + + my $tmpFile = $cacheFile; + if ( $cacheFile ne "-" ) { # catch "-" STDOUT alias + $tmpFile .= ".TMP"; + unlink $tmpFile; + } + local *FILE; + open FILE, ">$tmpFile" or return; + + for (@_) { + print FILE $_; + } + + close FILE; # explicitly close before rename + if ( $tmpFile ne $cacheFile ) { + chmod 0444 => $tmpFile; # output cache is readonly + rename $tmpFile => $cacheFile; # atomic + } +} + +# ------------------------------------------------------------------------------ +# qhost query +# +# PARSE qhost xml output that looks like this: +# +# +# +# +# lx26-amd64 +# 2 +# 0.09 +# 3.9G +# 663.7M +# 4.0G +# 679.3M +# +# BIP +# 0 +# 1 +# +# +# +# '0.630035' +# queue@host +# NAME +# OWNER +# r +# 1198055059 +# MASTER +# +# +# +# +# fix xmlns=... with xmlns:xsd=... +# issue: +# http://gridengine.sunsource.net/issues/show_bug.cgi?id=2515 +# +sub qhost { + my $caller = shift; + my $cacheFile = shift; + + # record qhost xml output to a file + defined $cacheFile and length $cacheFile or return; + + my @args = qw( -q -j -xml ); + my $lines = GridEngine->bin( qhost => @args ) or return; + + # replace xmlns= with xmlns:xsd= + # only needed for older GridEngine versions + $lines =~ s{\s+xmlns=}{ xmlns:xsd=}s; + + # document the request without affecting the xml structure: + # inject the query date and arguments as processing instructions + # newer perl can use \K for a variable-length look behind + my $date = POSIX::strftime( "%FT%T", localtime ); + $lines =~ s{^(<\?xml[^\?]+\?>)}{$1\n\n}; + + GridEngine->writeCache( $cacheFile, $lines ); +} + +# ------------------------------------------------------------------------------ +# PARSE qstat xml output that looks like this: +# +# +# +# +# +# 934 +# 0.56000 +# my_job_name +# user_name +# r +# 11/30/2004 10:38:23 +# cfd@host.domain +# 1 +# 1 +# cfd +# +# +# +# +# +# ------------------------------------------------------------------------------ + +# extract +# * +# return: +# HASHREF => { +# complex => { +# waiting => { +# "*user" => count, +# }, +# jobid => { +# "user@machine nlicense" => occurances, +# "user@machine nlicense" => occurances, +# }, +# }, +# } +# +sub qstat { + my $caller = shift; + my $cacheFile = shift; + my $managedType = shift || {}; + my $status = {}; + + my @args = qw( -u * -xml -r -s prs ); + + my $lines = GridEngine->bin( qstat => @args ) + or return $status; + + # optionally record qstat xml output to a file + if ($cacheFile) + { + # document the request without affecting the xml structure: + # inject the query date and arguments as processing instructions + # newer perl can use \K for a variable-length look behind + my $date = POSIX::strftime( "%FT%T", localtime ); + $lines =~ s{^(<\?xml[^\?]+\?>)}{$1\n\n}; + + GridEngine->writeCache( $cacheFile, $lines ); + } + + my %re = ( + state => qr{([A-Za-z]+)}, + slots => qr{(\d+)}, + tasks => qr{(\d+.*?)}, + job => qr{(.+?)}, + user => qr{(.+?)}, + host => qr{.+?\@(.+?)}, + ); + + for ( grep { $_ } split m{}, $lines ) { + my ($state) = /$re{state}/; + my ($slots) = /$re{slots}/ or last; + my ($user) = /$re{user}/ or last; + my ($jobIdent) = /$re{job}/ or last; + my ($host) = /$re{host}/; + my ($tasks) = /$re{tasks}/; + + $tasks ||= 0; + $jobIdent .= ".$tasks"; + + ## waiting jobs/tasks + if ( $state and $state =~ /[qw]/ ) { + my $ntasks; + if ($tasks) { + my ( $min, $max, $step ); + + # parse n[-m[:s]] and n,m + # these should be the only possibilities + if ( ( $min, $max, $step ) = + $tasks =~ /^(\d+)(?:-(\d+)(?::(\d+))?)?$/ + or ( $min, $max ) = $tasks =~ /^(\d+),(\d+)?$/ ) + { + $max ||= $min; + $step ||= 1; + for ( ; $min <= $max ; $min += $step ) { + $ntasks++; + } + } + } + $ntasks ||= 1; + + while ( + s{<(\S*hard_request).*?\s+name=\"(\S+)\".*?>(\d[\.\d]*)}{}) + { + my ( $name, $request ) = ( $2, $3 ); + + ## scale non-'job' consumables + $request *= $slots + unless exists $managedType->{$name} + and $managedType->{$name} =~ /job/i; + + my $count = sprintf "%.0f", ( $request * $ntasks ); + $status->{$name}{waiting}{$user} += $count; + } + } + else { + $host or next; # safety + $host =~ s{\..*$}{}; # strip domain - unqualified host name + my $consumer = "\L$user\@$host"; + + while ( + s{<(\S*hard_request).*?\s+name=\"(\S+)\".*?>(\d[\.\d]*)}{}) + { + my ( $name, $request ) = ( $2, $3 ); + + ## scale non-'job' consumables + $request *= $slots + unless exists $managedType->{$name} + and $managedType->{$name} =~ /job/i; + + my $count = sprintf "%.0f", $request; + $status->{$name}{$jobIdent}{"$consumer $count"}++; + } + } + } + + return $status; +} + +1; + +# --------------------------------------------------------------- end-of-package +package Qconf; + +BEGIN { + $ENV{SGE_SINGLE_LINE} = 1; # do not break up long lines with backslashes +} + +# extract 'administrator_mail' + +sub mail { + my $caller = shift; + + my @lines = GridEngine->bin( qconf => qw( -sconf ) ); + defined $lines[0] or return undef; + + @lines = grep { s{^\s*administrator_mail\s+}{} } @lines; + chomp @lines; + + return $lines[0]; +} + +# query 'complex_values' from the global host +# return hashref +sub query { + my $caller = shift; + + my @lines = GridEngine->bin( qconf => qw( -se global ) ); + defined $lines[0] or return +{}; + + return +{ + map { + s/,/ /g; + map { /^(.+)=(.+)\s*$/ } split; + } grep { s/^\s*complex_values\s+// } @lines + }; +} + +# +# set 'complex_values' of the global host +# +sub mattr { + my $caller = shift; + my $val = shift; + + GridEngine->bin( + qconf => ( qw( -mattr exechost complex_values ), $val, "global" ) ) + if $val; +} + +# determine what exists in the globals and in complex_values and has changed +# +# Prototype ->diff( HASHREF1, HASHREF2 ); +# +# +# HASHREF1 => { # from the 'qconf -se global' +# feature => total, +# } +# +# HASHREF2 => { # from 'mungeLicenses' +# feature => { +# type => STRING or undef, +# total => INT, +# limit => INT, +# extern => INT, +# ... +# } +# } +# +# determine the number of resources that can be managed by the GridEngine: +# managed = total - external_count +# +sub diff { + my $caller = shift; + my ( $complex_values, $licenses ) = @_; + my $changes = {}; + + for my $resource ( keys %$complex_values ) { + my $entry = $licenses->{$resource} or next; + + my ( $total, $limit, $extern ) = @{$entry}{qw( total limit extern )}; + my $managed = $total - $extern; + if ( defined $limit and $limit < $managed ) { + $managed = $limit; + } + + $managed >= 0 or $managed = 0; # should not be required + + $complex_values->{$resource} == $managed + or $changes->{$resource} = $managed; + } + + return $changes; +} + +1; + +# --------------------------------------------------------------- end-of-package + +# ------------------------------------------------------------------ end-of-file diff --git a/flex-grid/site/qloadsensor b/flex-grid/site/qloadsensor new file mode 100755 index 0000000..c77bc2a --- /dev/null +++ b/flex-grid/site/qloadsensor @@ -0,0 +1,325 @@ +#!/bin/bash +# $Id: qloadsensor 180 2010-09-17 15:46:41Z kasper $ +# +# qloadsensor: +# load sensor for particular file systems and floating licenses +# +# NB: +# 1) add the new complexes (via qconf -mc) for the following: +# * complex configurations managed in the shell script +# eg, 'perl -x qloadsensor' +# * complex consumables managed global +# eg, 'qlicserver -c' +# 2) initialize the global complex consumables to be managed +# eg, 'qlicserver -C' +# +# copyright (c) 2003-10 +# +# Licensed and distributed under the Creative Commons +# Attribution-NonCommercial-ShareAlike 3.0 License. +# http://creativecommons.org/licenses/by-nc-sa/3.0 +# ----------------------------------------------------------------------------- + +# +# impose default GridEngine environment + ascertain the binary architecture +# +# you likely don't need to adjust these values, since the loadsensor is called +# from sge_execd, which in turn is started from /etc/init.d/n1ge and +# these variables should be correctly exported there +# +[ -d "$SGE_ROOT" ] || { echo "Error: SGE_ROOT=$SGE_ROOT not found"; exit 1; } +: ${SGE_CELL:=default} +: ${SGE_ARCH:=`$SGE_ROOT/util/arch`} + +export SGE_ROOT SGE_CELL SGE_ARCH + +# ----------------------------------------------------------------------------- +# this script should run as the 'admin_user' registered in 'bootstrap' +# +if [ "$UID" -eq 0 ] +then + admin_user=$(sed -ne 's/^admin_user *//p' $SGE_ROOT/$SGE_CELL/common/bootstrap) + : ${admin_user:=root} + if [ $admin_user != root -a $(echo $admin_user | tr "A-Z" "a-z") != none ] + then + exec $SGE_ROOT/utilbin/$SGE_ARCH/adminrun $admin_user $0 + fi +fi + +# +# ======================================================================== +# now that we are the admin_user, we can source our standard settings +# - customize *all* settings there (eg, license server settings) +# - ENSURE THAT '$SGE_site' IS DEFINED !!! +# +for i in $SGE_ROOT/$SGE_CELL/site/environ; do [ -f $i ] && . $i; done + +# define (unique) cluster name if not already defined +if [ -z "$SGE_CLUSTER_NAME" -a -r "$SGE_ROOT/$SGE_CELL/common/cluster_name" ] +then + SGE_CLUSTER_NAME=$(cat $SGE_ROOT/$SGE_CELL/common/cluster_name 2>/dev/null) +fi +: ${SGE_CLUSTER_NAME:=default} +export SGE_CLUSTER_NAME + +SGE_site="$SGE_ROOT/flex-grid/site" + +# +# ======================================================================== +# + +############################################################################### +############################################################################### +# CUSTOMIZE THESE SETTINGS - iff. required + +qlicserver="$SGE_site/qlicserver config=$SGE_site/../config/local_licenses.conf dir=$SGE_ROOT/flex-grid/cache output=$SGE_ROOT/flex-grid/cache/qlicserver.xml qhost=qhost.xml qstat=qstat.xml" +diskmon="$SGE_site/diskmon.pl" + +# END OF CUSTOMIZE SETTINGS +############################################################################### +############################################################################### + +# +# the real (not compiled in) architecture +# +os_arch=`$SGE_ROOT/util/arch` +SGE_utilbin=$SGE_ROOT/utilbin/$os_arch + +# +# set some constants +# +HOST=$($SGE_utilbin/gethostname -aname) +UQHOST=$(echo $HOST | cut -f1 -d.) +SGE_qmaster=unknown; export SGE_qmaster + +# ----------------------------------------------------------------------------- +# act_qmaster +# +# extract the unqualified host name from the "act_qmaster" file +# return this value or 'unknown' on failure +# +act_qmaster() +{ + tmp=$(cat $SGE_common/act_qmaster 2>/dev/null) + echo ${tmp:-unknown} +} + +# ----------------------------------------------------------------------------- +# df_info +# +# echo the $1_{total,used,free} space on filesystem $2 +# +# gridengine uses the suffixes +# 'k' => blocksize 1000 +# 'K' => blocksize 1024 +# +# return 0 if 'df' fails +df_info() +{ + # 1:tag 2:mount 3:filesys 4:total 5:Used 6:Avail 7:Used% 8:Mount + [ -d "$2" ] && set -- $1 $2 $( df -k -P $2 2>/dev/null | tail -1 ) + + #!# we could add the following check: + #!# [ "$2" != "$8" ] && set -- $1 $2; # mount point mismatch? + + [ "$#" -ge 6 ] || set -- $1 $2 filesystem 0 0 0 + + echo "$UQHOST:$1_total:$4K" + echo "$UQHOST:$1_used:$5K" + + #if [ -w "$2" ] + #then + echo "$UQHOST:$1_free:$6K" + #else + # echo "$UQHOST:$1_free:0" + #fi +} + +# invariant values +if [ -e "/proc/cpuinfo" ] +then + # mips=$(awk '{if (/mips/) printf "%.0f\n", $NF}' /proc/cpuinfo | tail -1) + mips=$(awk 'BEGIN {mips=0} /mips/ {if ($NF > mips) mips=$NF }; END {print mips}' /proc/cpuinfo) +else + mips=0 +fi + +unset os_name +# extract lsb_release +if [ -e "/usr/bin/lsb_release" ] +then + os_name=$(/usr/bin/lsb_release -ircs | xargs echo | sed 's/ /_/g') +else + os_name='unkown' +fi +: ${os_name:=NONE} + +# ----------------------------------------------------------------------------- +# host_info +# +# report host specific information about filesystems, logins, +# special hardware extensions, etc. +# +host_info() +{ + echo "$UQHOST:arch:$os_arch" + echo "$UQHOST:os:$os_name" +# df_info tmp /tmp + df_info scratch /scratch + echo "$UQHOST:mips:$mips" +} + +# ----------------------------------------------------------------------------- +# iidle_info() +# report a machine's idle time +# +# parse the contents from /proc/interrupts, which looks like the following: +# +# CPU0 +# 0: 23024789 XT-PIC timer +# 1: 13 XT-PIC keyboard +# 2: 0 XT-PIC cascade +# 5: 0 XT-PIC usb-uhci +# 8: 2 XT-PIC rtc +# 9: 0 XT-PIC acpi +# 10: 0 XT-PIC ehci-hcd, usb-uhci +# 11: 16687253 XT-PIC eth0, usb-uhci, Intel 82801DB-ICH4, nvidia +# 12: 20 XT-PIC PS/2 Mouse +# 14: 77178 XT-PIC ide0 +# 15: 2 XT-PIC ide1 +# NMI: 0 +# LOC: 0 +# ERR: 0 +# MIS: 0 +# +# or, +# +# CPU0 CPU1 +# 0: 12820049 12818168 IO-APIC-edge timer +# 1: 42889 43309 IO-APIC-edge keyboard +# 2: 0 0 XT-PIC cascade +# 8: 2 0 IO-APIC-edge rtc +# 9: 0 0 IO-APIC-edge acpi +# 12: 287235 296531 IO-APIC-edge PS/2 Mouse +# 14: 47423 40923 IO-APIC-edge ide0 +# 15: 2 3 IO-APIC-edge ide1 +# 16: 7733868 7737081 IO-APIC-level nvidia +# 17: 159 156 IO-APIC-level Intel ICH 82801AA +# 19: 2155710 2159943 IO-APIC-level e100, usb-uhci +# NMI: 0 0 +# LOC: 25641034 25641033 +# ERR: 0 +# MIS: 0 +# +# Thus, we need the [-1, 1..$ncpu] fields for the following sources: +# keyboard, Mouse, serial +# +# NB: adding 'usb-uhci' gives problems, since this is sometimes +# attached to the ethernet card +# +# set the variable 'iidle' to the idle time (seconds) since the last call +# +last="0 -1"; +iidle_info() +{ + set -- $( + perl -e ' + my @last = @ARGV; + @ARGV = "/proc/interrupts"; + $_ = <>; + + my $ncpu = s/\s*CPU\d+//g || 0; + my ( $iidle, $int, $now ) = ( 0, 0, time ); + + $int += $_ + for + map { /\s+(keyboard|Mouse|serial)$/ ? (split)[ 1 .. $ncpu ] : (); } + <>; + + if ( $int == $last[-1] ) { # no interactivity since last round + $iidle = ( $now - $last[0] ); + } + else { + @last = ( $now, $int ); + } + + print "$iidle @last\n"; + ' $last + ); + + echo "$UQHOST:iidle:$1"; + + shift; last="$@"; # save for later +} +# ----------------------------------------------------------------------------- +# +# The execd running on the qmaster queries the license server +# The contents of 'act_qmaster' should suffice to migrate the load sensor +# for a controlled migration. +# + +while : +do + read input || exit 1 # wait for input + [ "$input" = quit ] && exit 0 + + echo begin # begin load report + host_info # host information + iidle_info # machine's idle time + echo end # end load report + + # let the license query run between load reports + # SGE_qmaster=`act_qmaster` # refresh the name of the qmaster + # if [ "$HOST" = "$SGE_qmaster" ] + if [ "$HOST" = "minos19" ] + then + # $qlicserver 2>> qloadsensor.err + $SGE_ROOT/flex-grid/site/qlicserver config=$SGE_ROOT/flex-grid/config/local_licenses.conf output=$SGE_ROOT/flex-grid/cache/qlicserver_local.xml + $SGE_ROOT/flex-grid/site/qlicserver config=$SGE_ROOT/flex-grid/config/abaqus_licenses.conf timeout=60 output=$SGE_ROOT/flex-grid/cache/qlicserver_abaqus.xml + # $SGE_ROOT/flex-grid/site/qlicserver config=/opt/SGE/flex-grid/config/trelis_licenses.conf timeout=60 output=$SGE_ROOT/flex-grid/cache/qlicserver_trelis.xml + $SGE_ROOT/flex-grid/site/qlicserver config=/opt/SGE/flex-grid/config/comsol_licenses.conf timeout=60 output=$SGE_ROOT/flex-grid/cache/qlicserver_comsol.xml + $SGE_ROOT/flex-grid/site/qlicserver config=$SGE_ROOT/flex-grid/config/matlab_licenses.conf timeout=60 output=$SGE_ROOT/flex-grid/cache/qlicserver_matlab.xml + lockfile $SGE_ROOT/flex-grid/cache/qlicserver.xml.lock + # (sed '/<\/resources>/,$ d' $SGE_ROOT/flex-grid/cache/qlicserver_abaqus.xml ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_trelis.xml | grep -v qlicserver | grep -v resources ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_local.xml | grep -v qlicserver | grep -v resources ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_matlab.xml;) > $SGE_ROOT/flex-grid/cache/qlicserver.xml + # (sed '/<\/resources>/,$ d' $SGE_ROOT/flex-grid/cache/qlicserver_abaqus.xml ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_local.xml | grep -v qlicserver | grep -v resources ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_matlab.xml;) > $SGE_ROOT/flex-grid/cache/qlicserver.xml + (sed '/<\/resources>/,$ d' $SGE_ROOT/flex-grid/cache/qlicserver_abaqus.xml ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_local.xml | grep -v qlicserver | grep -v resources; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_comsol.xml | grep -v qlicserver | grep -v resources ; sed '1,//d' $SGE_ROOT/flex-grid/cache/qlicserver_matlab.xml;) > $SGE_ROOT/flex-grid/cache/qlicserver.xml + rm -f $SGE_ROOT/flex-grid/cache/qlicserver.xml.lock + # $diskmon -m 2>> qloadsensor.err + # force rescheduling of express jobs + # $SGE_site/qxprs >/dev/null 2>&1 + # else + # $diskmon 2>> qloadsensor.err + fi +done +exit 0 # we never get here, but just in case + +#------------------------------------------------------------------------------ +# feed via 'perl -x' to extract the 'host' complex configuration + +#!/usr/bin/perl -w +print +__DATA__ +# +# host complex configuration +# +#name shortcut type relop requestable consumable default urgency +#--------------------------------------------------------------------------- +tmp_total tmpt MEMORY <= YES NO 0 0 +tmp_used tmpu MEMORY >= NO NO 0 0 +tmp_free tmpf MEMORY <= YES NO 0 0 +iidle iidle INT <= YES NO 0 0 +mips mips INT <= YES NO 0 0 +os os RESTRING == YES NO NONE 0 +abaqus abaqus DOUBLE <= YES YES 0 0 +cae cae DOUBLE <= YES YES 0 0 +comsol comsol DOUBLE <= YES YES 0 0 +hyper hyper DOUBLE <= YES YES 0 0 +ifort ifort DOUBLE <= YES YES 0 0 +matlab matlab DOUBLE <= YES YES 0 0 +mcc mcc DOUBLE <= YES YES 0 0 +multiphysics multiphysics DOUBLE <= YES YES 0 0 +trelis trelis DOUBLE <= YES YES 0 0 +scratch_free scratch_free MEMORY <= YES YES 0 0 +scratch_total scratch_total MEMORY <= YES NO 0 0 +scratch_used scratch_used MEMORY >= NO NO 0 0 +# -----------------------------------------------------------------------------