#! /usr/bin/perl -w
# $Header: /auto/homes/pb22/pl/RCS/cl-condor-list.pl,v 1.15 2013/11/18 12:07:16 pb22 Exp $

# Use "pod2text" for info

=head1 NAME

condor-list - list condor machines

=head1 SYNOPSIS

B<condor-list>

=head1 OPTIONS

=over 4

=item B<--machine> I<regexp>

Get info for about machines matching I<regexp>

=item B<--free>

Only show free (halted) machines

=item B<--on> I<regexp>

Only show machines running on, or with affinity to, I<regexp>

=item B<--memory>

Sort machines by available memory

=item B<--verbose>

Show what it's doing

=item B<--help>

Generate help info.

=item B<--parallel>

Connect to all servers in parallel. Can be piped to B<sort>.

=item B<--server> I<server>

Use the XenE server I<server> (experts only)

=back

=head1 DESCRIPTION

List machines which match I<machine> (default is condor pool machines) with their
current state,
CPUs (current/at next boot:max)
and memory settings (static-max/dynamic-max/dynamic-min/static-min/target/actual)

Unless there is a shortage of memory, it is normally best to use the B<max> number of cores.
Depending on the expected pool use, some cores may not be available to Condor.
B<sxp21> and B<sxp22> have 32 cores. B<sxp23> has 64 cores.
The other B<sxp*> machines and B<bretzel> have 8 cores.
The others have 4 cores.

=cut

use POSIX ":sys_wait_h";

$TRACE = $ENV{'TRACE'};
$onscmd	= "cl-onserver";

$condormsg = "Use the max number of CPUs unless there are memory or similar problems.\nsxp21 and sxp22 have 32 cores. sxp23 has 64 cores.\nThe other sxp* machines and bretzel have 8 cores. Others have 4 cores.\n";

use Getopt::Long;
# abuse bundling_override to allow -W and -w as different
use Getopt::Long qw(:config require_order bundling_override);
use Pod::Usage;
%opts = (
	"verbose|v"	=> \$verbose,
	"server|s:s"	=> \$server,
	"on:s"	        => \$on,
	"free|f"	=> \$free,
	"memory|m"	=> \$memory,
	"machine:s"	=> \$machine,
	"parrallel|p"	=> \$parrallel,
	"help|h"	=> \$help,
);

$cmd = $0;
$cmd =~ s=^/usr/bin/==;

$notavailable = ();

@orig = ($0, @ARGV);
GetOptions (%opts) || pod2usage();
pod2usage(-verbose => 2) if $help;

unless ($machine || $on) {
	print STDERR $condormsg unless $parrallel && $server;
	$machine = "^pb0\\d\\d\$" 
}
if ($server) {
	@servers =  $server;
} else {
	@servers = ();
	foreach $line (`host -t ptr xene-pools`) {
		print STDERR "# $line" if $verbose;
		if ($line =~ /xene-pools.cl.cam.ac.uk domain name pointer (\S+).cl.cam.ac.uk./) {
			if ($parrallel) {
				exec("@orig --server $1") if ($child = fork()) == 0;
				print STDERR "pid:$child: system(@orig --server $1)\n" if $verbose;
			} else {
				push @servers, $1;
			}
		} else {
			print STDERR "# unrecognised host output: $line";
		}
	}
	if ($parrallel) {
		while (($rc = waitpid(-1, WNOHANG)) >= 0) { print STDERR "[waited $rc]\n" if $verbose; sleep 1 if $rc == 0};
		die("$0: rc = $rc, ? = $?; C = ${^CHILD_ERROR_NATIVE}\n") if $verbose;
		exit
	}
}

$cmd = "";
for $server (@servers) {
	$cmd .= sprintf "echo CMD=v-$server; %s%s%s --xe vm-list params=all; echo CMD=h-$server; %s%s%s --xe host-list;", $onscmd, ($server) ? " --server " : "", $server, $onscmd, ($server) ? " --server " : "", $server;
}

$vms = "($cmd) 2>&1|";

print STDERR "# run: $vms\n" if $verbose;
open(VMS, $vms) || die("$cmd: failed to open '$vms': $!\n");
&process;
$extra = '';
while (<VMS>) {
	chomp;
	print STDERR "'$_'\n" if $TRACE;
	if (/^\s*$/) {
		$_ = <VMS>;
		chomp;
		if (/^\s*uid\s/ || /^\s*$/) { &process; next if /^\s*$/}
		elsif (/user-version/) { }
		else { print STDERR "# $0: unexpected line after blank: '$_'\n"; }
	}
	if (/^CMD=(\S)-(\S+)/) {
		$pool = $2;
		$pool =~ s/^xene-//;
		next;
	}
	# uuid ( RO)                          : cc42dec1-c6d5-262d-ecf8-a78245f919ab
	#                     name-label ( RW): pb023
	#               name-description ( RW): CentOS 5x clonable Condor machine
	#                   user-version ( RW): 1
	#                  is-a-template ( RW): false
	#                  is-a-snapshot ( RO): false
	#                    snapshot_of ( RO): <not in database>
	#                      snapshots ( RO): 
	#                  snapshot_time ( RO): 19700101T00:00:00Z
	#              is-control-domain ( RO): false
	#                    power-state ( RO): halted
	#                  memory-actual ( RO): 8192
	#                  memory-target ( RO): 31457280000
	#              memory-static-max ( RW): 7864320000
	#             memory-dynamic-max ( RW): 7864320000
	#             memory-dynamic-min ( RW): 7864320000
	#              memory-static-min ( RW): 16777216
	#               suspend-VDI-uuid ( RO): <not in database>
	#                   VCPUs-params (MRW): 
	#                      VCPUs-max ( RW): 1
	#               VCPUs-at-startup ( RW): 1
	#         actions-after-shutdown ( RW): Destroy
	#           actions-after-reboot ( RW): Restart
	#            actions-after-crash ( RW): Restart
	#                  console-uuids (SRO): 
	#                       platform (MRW): nx: false; acpi: true; apic: true; pae: true; viridian: true
	#             allowed-operations (SRO): make_into_template; destroy; export; start_on; start; clone; copy; snapshot
	#             current-operations (SRO): 
	#             blocked-operations (MRW): 
	#            allowed-VBD-devices (SRO): <expensive field>
	#            allowed-VIF-devices (SRO): <expensive field>
	#                 possible-hosts ( RO): <expensive field>
	#                HVM-boot-policy ( RW): 
	#                HVM-boot-params (MRW): order: 
	#          HVM-shadow-multiplier ( RW): 1.000
	#                      PV-kernel ( RW): 
	#                     PV-ramdisk ( RW): 
	#                        PV-args ( RW): graphical utf8
	#                 PV-legacy-args ( RW): 
	#                  PV-bootloader ( RW): pygrub
	#             PV-bootloader-args ( RW): 
	#            last-boot-CPU-flags ( RO): 
	#               last-boot-record ( RO): <expensive field>
	#                    resident-on ( RO): <not in database>
	#                       affinity ( RW): <not in database>
	#                   other-config (MRW): last_shutdown_time: 20090609T19:41:51Z; last_shutdown_action: Destroy; last_shutdown_initiator: internal; last_shutdown_reason: halted; import_task: OpaqueRef:f7f9776b-590e-4732-8489-7abe233d16ba; mac_seed: 2fbda7ae-212a-4438-de01-a6a7f9016773; machine-address-size: 36; install-methods: cdrom,nfs,http,ftp; install-repository: cdrom; rhel5: true; linux_template: true
	#                         dom-id ( RO): -1
	#                recommendations ( RO): <restrictions><restriction field="memory-static-max" max="34359738368" /><restriction field="vcpus-max" max="8" /><restriction property="number-of-vbds" max="7" /><restriction property="number-of-vifs" max="7" /></restrictions>
	#                  xenstore-data (MRW): 
	#                  ha-always-run ( RW): false
	#            ha-restart-priority ( RW): 
	#                          blobs ( RO): 
	#                     start-time ( RO): 20090609T19:37:01Z
	#                   install-time ( RO): 19700101T00:00:00Z
	#                   VCPUs-number ( RO): 1
	#              VCPUs-utilisation (MRO): <expensive field>
	#                     os-version (MRO): <not in database>
	#             PV-drivers-version (MRO): <not in database>
	#          PV-drivers-up-to-date ( RO): <not in database>
	#                         memory (MRO): <not in database>
	#                          disks (MRO): <not in database>
	#                       networks (MRO): <not in database>
	#                          other (MRO): <not in database>
	#                           live ( RO): <not in database>
	#     guest-metrics-last-updated ( RO): <not in database>
	# ... and things like:
	#      cooperative ( RO) [DEPRECATED]: <expensive field>> <      cooperative 
	if (/^\s*([A-Za-z_-]+)\s+\([ MS]R[OW]\)\s*(.DEPRECATED.)?:\s+(.*)$/) {
		$val{$1} = $3;
		# print STDERR "## <$1> $2 = <$3>\n";
	}
	# <# exit code 255 for sxp01 / sxp01: /usr/bin/cl-onserver --server sxp01 --xe vm-list params=all>
	elsif (/exit code (255) for (\S+)\s*\/\s*\S+: \/usr\/bin\/cl-onserver --server \S+ --xe (\S+)/) {
		if ($2 eq "xene-poolt") {
			print STDERR "# $2 currenty not available (not a problem)\n" unless $notavailable{$2};
			$notavailable{$2} = 1;
		} else {
			print STDERR "# failed $1 for $2: $3 <<$extra>>\n";
		}
		$extra = '';
	}
	else { chomp; $extra .= " <$_>"; }
}
print "# $extra\n" if $extra;
&process;
$length = 0;
$size = 0;
foreach $name (sort keys %mc) {
	$serv = $serv{$name} || "";
	$serv = $name{$serv} if $name{$serv};
	$serv =~ s/<not in database>/-/;
	$pool = $pool{$name} || "";
	$serv = "$pool/$serv" if $pool;
	$val = $mc{$name};
	$val =~ s/^\S*\s+//;
	if (! $on || $serv =~ /$on/o) {
		$len = length($name);
		$length = $len if $len > $length;
		$siz = length($val);
		$size = $siz if $siz > $size;
	}
}
$length = 40 if $length > 40;
$size = 60 if $size > 60;
$length = (80 - $size -10) if $length > (80 - $size -10);
foreach $name (sort keys %mc) {
	$serv = $serv{$name} || "";
	$serv = $name{$serv} if $name{$serv};
	$serv =~ s/<not in database>/-/;
	$pool = $pool{$name} || "";
	$serv = "$pool/$serv" if $pool;
	$val = $mc{$name};
	$val =~ s/^\S*\s+//;
	printf "%-${length}s %-${size}s %s\n", $name, $val, $serv if ! $on || $serv =~ /$on/o;
}
close(VMS) || die("$cmd: failed to close '$vms': $!\n");

sub process {
	$name = $val{'name-label'};
	return unless $name;
	print STDERR "## name = <$name>, uuid=$val{'uuid'} pool=$pool\n" if $verbose;
	$name =~ s/Control domain on host: /dom0:/;
	$name =~ s/.cl.cam.ac.uk$//;
	$name{$val{'uuid'}} = $name;
	if (!$machine || $name =~ /$machine/io) {
		$state = $val{'power-state'} || "<none>";
		# Allow search by "running on host
		$affinity = $val{'affinity'} || "<none>";
		$residenton = $val{'resident-on'} || "<none>";
		$ison = ($state eq "halted") ? $affinity : $residenton;
		if (! $free || $state eq "halted") {
			$M6 = &mems($val{'memory-actual'}) || "?";
			$M5 = &mems($val{'memory-target'}) || "?";
			$M1 = &mems($val{'memory-static-max'}) || "?";
			$M2 = &mems($val{'memory-dynamic-max'}) || "?";
			$M3 = &mems($val{'memory-dynamic-min'}) || "?";
			$M4 = &mems($val{'memory-static-min'}) || "?";
			$M6 = "" if $M6 eq $M5;
			$M5 = "" if $M5 eq $M4;
			$M4 = "" if $M4 eq $M3;
			$M3 = "" if $M3 eq $M2;
			$M2 = "" if $M2 eq $M1;
			$cpus = $val{'VCPUs-at-startup'} || -99;
			$cpum = $val{'VCPUs-max'} || -99;
			$cpu = $val{'VCPUs-number'};
			$cpu = -99 unless defined $cpu;
			$cpu = -999 if $cpu eq "<not in database>";
			$key = $name;
			$key = sprintf "%015d %s", $val{'memory-static-max'}, $key if $memory;
			$mc{$key} = sprintf "%s %-7s %d/%d:%d %s/%s/%s/%s/%s/%s", $name, $state, $cpu, $cpus, $cpum, $M1, $M2, $M3, $M4, $M5, $M6;
			$serv{$key} = $ison;
			$pool{$key} = $pool;
		}
	}
	%val = ();
}

sub mems {
	my ($size) = @_;
	return "undef" unless $size;
	return "[undef]" if $size eq "<not in database>";
	return "[-]" if $size eq "<expensive field>";
	return "[$size]" unless $size =~ /^\d+$/;
	return int($size / (1)) . "B" if $size < 100000;
	return int($size / (1000)) . "K" if $size < 100000000;
	return int($size / (1000 * 1000)) . "M" if $size < 100000000000;
	return int($size / (1000 * 1000 * 1000)) . "G";
}
