add flex-grid folder for flexlm license manager accounting
This commit is contained in:
221
flex-grid/scripts/GridEngine-git-config
Executable file
221
flex-grid/scripts/GridEngine-git-config
Executable file
@@ -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
|
||||
|
||||
usage: ${0##*/} [OPTION | GIT_COMMAND]
|
||||
options:
|
||||
-help display this usage
|
||||
init initialize git repo in $GIT_DIR
|
||||
|
||||
pass-through git commands:
|
||||
log ls-files
|
||||
show whatchanged
|
||||
|
||||
Snapshot of the current GridEngine configuration using git for the
|
||||
backend storage and tracking mechanism.
|
||||
|
||||
* git repository stored here:
|
||||
$GIT_DIR
|
||||
|
||||
copyright (c) 2009-10 <Mark.Olesen@faurecia.com>
|
||||
|
||||
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
|
||||
#------------------------------------------------------------------------------
|
||||
5
flex-grid/scripts/abaqus_lmutil
Executable file
5
flex-grid/scripts/abaqus_lmutil
Executable file
@@ -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
|
||||
124
flex-grid/scripts/filter-accounting
Executable file
124
flex-grid/scripts/filter-accounting
Executable file
@@ -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 <Mark.Olesen\@faurecia.com>
|
||||
|
||||
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
|
||||
517
flex-grid/scripts/qlic
Executable file
517
flex-grid/scripts/qlic
Executable file
@@ -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{^(.+?)</query>}{}s or return;
|
||||
my $header = $1;
|
||||
|
||||
for ($header) {
|
||||
if (m{<host (?:\s+([^<>]*))? > \s*(.+?)\s* </host>}sx) {
|
||||
my ( $attr, $content ) = ( $1, $2 );
|
||||
$self->{-host} = $content;
|
||||
}
|
||||
if (m{<time (?:\s+([^<>]*))? > \s*(.+?)\s* </time>}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 <resources> contents
|
||||
s{^.*?<resources>}{}s and s{</resources>.*$}{}s or return;
|
||||
|
||||
## process <resource .../>
|
||||
while (s{<resource (?:\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 <resource ...> CONTENT </resource>
|
||||
while (s{<resource (?:\s+([^<>]*))? > \s* (.*?) \s* </resource>}{}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 <user ...> COUNT </user>
|
||||
while ( $content =~ s{<user (?:\s+([^<>]*))? >\s*(\d+)\s*</user>}{}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 ) {
|
||||
<FILE>;
|
||||
}
|
||||
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*$/ } <FILE> )[-1];
|
||||
}
|
||||
defined $limit or $limit = "NONE";
|
||||
$self->{$name} = $limit;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for ($fileString) {
|
||||
defined or next;
|
||||
|
||||
# strip out all comments
|
||||
s{<!--.*?-->\s*}{}sg;
|
||||
|
||||
## process <resource .../> and <resource ...></resource>
|
||||
while (s{<resource (?:\s+([^/<>]*))? />}{}sx
|
||||
or s{<resource (?:\s+([^/<>]*))? >\s*</resource>}{}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 <Mark.Olesen\@faurecia.com>
|
||||
|
||||
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 '<?xml version="1.0"?><someTag ...' at the start
|
||||
# and '</someTag>' 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;
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------------
|
||||
Reference in New Issue
Block a user