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{\Q$tag\E>\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]*)\1>}{})
+ {
+ 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]*)\1>}{})
+ {
+ 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
+# -----------------------------------------------------------------------------