#!/usr/bin/perl -w
# rschedule - User interface to perl Schedule::Load
# See copyright, etc in below POD section.
######################################################################
require 5.004;
use lib 'blib/lib'; # testing
use Getopt::Long;
use Sys::Hostname;
use Pod::Usage;
use Schedule::Load;
use Schedule::Load::Schedule;
use Config;
######################################################################
# configuration
######################################################################
# globals
######################################################################
# main
$Debug = 0;
my %server_params = ();
my @commands = ();
my @match_params;
my $opt_fixed_load = 1; # For fixedload
my @opt_classes = ();
my $opt_comment;
my $opt_kill;
my $opt_similar;
my $opt_host = hostname();
if ($0 =~ /(^|[\\\/])rtop$/) {
# Special program name, force defaults
push @ARGV, ("hosts", "top");
}
if ($0 =~ /(^|[\\\/])rhosts$/) {
# Special program name, force defaults
push @ARGV, ("hosts");
}
if ($0 =~ /(^|[\\\/])rloads$/) {
# Special program name, force defaults
push @ARGV, ("loads");
}
if (!GetOptions (
"help" => \&usage,
"debug" => \&debug,
"version" => \&version,
"port=i" => sub {shift; $server_params{port} = shift;},
"dhost=s" => sub {shift; push @{$server_params{dhost}}, split(':',shift);},
"host=s" => \$opt_host,
"class=s" => \@opt_classes,
"load=i" => \$opt_fixed_load,
"comment=s" => \$opt_comment,
"kill:i" => \$opt_kill,
"allow-reserved!"=> sub {shift; push @match_params, (allow_reserved => shift);},
"similar!" => \$opt_similar,
"<>" => \&cmd,
)) {
die "%Error: Bad usage, try 'rschedule --help'\n";
}
push @match_params, (classes=>\@opt_classes);
if ($opt_similar) {
push @match_params,
(match_cb=>('sub { return 1'
.'&& ($_[0]->get_undef(qw(archname)) eq \''.$Config{archname}."')"
.'&& ($_[0]->get_undef(qw(osvers)) eq \''.$Config{osvers}."')"
.'; }'));
}
# Create scheduler just once for speed
$scheduler = Schedule::Load::Schedule->new(%server_params);
my $secondcmd = 0;
foreach (@commands) {
print "\n" if $secondcmd++;
&$_;
}
exit (0);
######################################################################
BEGIN {#static
my $Last_Cmd = "";
my $Opt_Value = 0;
sub cmd {
my $param = shift;
# Options to a command just specified
if ($Last_Cmd eq "class") {
$Last_Cmd = "";
my $class = $param;
$class = "class_$param" if $param !~ /^class_/;
push @commands, sub {
$scheduler->set_stored (host=>$opt_host,
$class =>$Opt_Value, );
};
}
elsif ($Last_Cmd eq "set_const"
|| $Last_Cmd eq "set_stored") {
$Last_Cmd = "";
my $key = $param;
my $value = 1;
$value = $1 if $key =~ s/=(.*$)//;
push @commands, sub {
$scheduler->set_stored (host=>$opt_host,
set_const => ($Last_Cmd eq "set_const"),
$key=>$value, );
};
}
elsif ($Last_Cmd eq "fixed_load") {
$Last_Cmd = "";
push @commands, sub {
($param =~ /^\d+$/) or die "%Error: Fixed_load requires PID argument\n";
$scheduler->fixed_load (host=>$opt_host,
load=>$opt_fixed_load,
pid=>$param);
};
}
elsif ($Last_Cmd eq "cmnd_comment") {
$Last_Cmd = "";
push @commands, sub {
($param =~ /^\d+$/) or die "%Error: Cmnd_comment requires PID argument\n";
($opt_comment) or die "%Error: Cmnd_comment requires --comment setting\n";
$scheduler->cmnd_comment (host=>$opt_host,
comment=>$opt_comment,
pid=>$param);
};
} elsif ($Last_Cmd eq "sleep") {
$Last_Cmd = "";
push @commands, sub {
# For debug only
print "Sleeping $param...\n" if $Debug;
sleep $param;
print "\n\n\n","="x70,"\n" if $Debug;
};
}
# New command options
elsif ($param eq "top") {
push @commands, sub { print $scheduler->print_top; };
} elsif ($param eq "hosts") {
push @commands, sub { print $scheduler->print_hosts; };
} elsif ($param eq "idle_host_names") {
push @commands, sub { print join(' ',$scheduler->idle_host_names(@match_params,)),"\n"; };
} elsif ($param eq "holds") {
push @commands, sub { print $scheduler->print_holds; };
} elsif ($param eq "hostnames") {
push @commands, sub { print join(' ',$scheduler->hostnames(@match_params,)),"\n"; };
} elsif ($param eq "jobs") {
push @commands, sub { print $scheduler->jobs(@match_params,),"\n"; };
} elsif ($param eq "loads") {
if (defined $opt_kill) {
push @commands, sub { print $scheduler->print_kills(signal=>$opt_kill); };
} else {
push @commands, sub { print $scheduler->print_loads; };
}
} elsif ($param eq "classes") {
push @commands, sub { print $scheduler->print_classes; };
} elsif ($param eq "restart") { # Undocumented as is nasty
push @commands, sub { $scheduler->restart; };
} elsif ($param eq "restart_chooser") { # Undocumented as is nasty
push @commands, sub { $scheduler->restart (reporter=>0); };
} elsif ($param eq "restart_reporter") { # Undocumented as is nasty
push @commands, sub { $scheduler->restart (chooser=>0); };
} elsif ($param eq "status") {
push @commands, sub { print $scheduler->print_status; };
} elsif ($param eq "_chooser_close_all") { # Undocumented, for debugging
push @commands, sub { $scheduler->_chooser_close_all(); };
}
elsif ($param eq "reserve") {
push @commands, sub {
my @param = ();
if (defined $opt_comment) {
if ($opt_comment !~ s/^-//) {
$opt_comment = $scheduler->reserve_default_comment . "; " . $opt_comment;
}
push @param, (comment=>$opt_comment);
}
$scheduler->reserve (host=>$opt_host, @param);
}
} elsif ($param eq "release") {
push @commands, sub {
$scheduler->release (host=>$opt_host);
}
} elsif ($param eq "allow_class") {
$Last_Cmd = "class";
$Opt_Value = 1;
} elsif ($param eq "deny_class") {
$Last_Cmd = "class";
$Opt_Value = 0;
} elsif ($param eq "set_const") {
$Last_Cmd = $param;
} elsif ($param eq "set_stored") {
$Last_Cmd = $param;
} elsif ($param eq "sleep") {
$Last_Cmd = $param;
} elsif ($param eq "fixed_load") {
$Last_Cmd = $param;
} elsif ($param eq "cmnd_comment") {
$Last_Cmd = $param;
} elsif ($param eq "best") {
push @commands, sub {
my $val = $scheduler->best(@match_params, );
print "$val\n" if (defined $val);
die "%Error: No best host found\n" if (!defined $val);
};
} elsif ($param eq "best_or_none") {
push @commands, sub {
my $val = $scheduler->best(@match_params, allow_none=>1,);
print "$val\n" if (defined $val);
die "%Error: No host as low enough loading\n" if (!defined $val);
};
} else {
die "%Error: Unknown command option $param\n";
}
}
END {
if ($Last_Cmd) { die "%Error: Command $Last_Cmd needs another argument\n"; }
}
}#static
######################################################################
sub usage {
print "Version: $Schedule::Load::VERSION\n";
pod2usage(-verbose=>2, -exitval => 2);
exit(1);
}
sub version {
print "Version: $Schedule::Load::VERSION\n";
exit (1);
}
sub debug {
$Debug = 1;
$Schedule::Load::Debug = $Debug;
$Schedule::Load::Schedule::Debug = $Debug;
$Schedule::Load::Hosts::Debug = $Debug;
}
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################
__END__
=pod
=head1 NAME
rschedule - User interface for Perl Schedule::Load configuration and status
=head1 SYNOPSIS
B<rschedule>
[ B<--help> ]
[ B<--port=>I<port> ]
[ B<--dhost=>I<host> ]
[ B<--version> ]
B<rschedule> B<top>
B<rtop>
B<rschedule> B<hosts>
B<rhosts>
B<rschedule> B<loads>
B<rloads>
B<rschedule> B<holds>
B<rschedule> B<status>
B<rschedule> [ B<--host=>I<host> ] B<reserve>
B<rschedule> [ B<--host=>I<host> ] B<release>
B<rschedule> [ B<--host=>I<host> ] B<allow_class> B<class>
B<rschedule> [ B<--host=>I<host> ] B<deny_class> B<class>
B<rschedule> [ B<--host=>I<host> ] B<set_const> B<var>=B<value>
B<rschedule> [ B<--host=>I<host> ] B<set_stored> B<var>=B<value>
B<rschedule> B<--class=>I<class> B<best>
B<rschedule> B<--class=>I<class> B<best_or_none>
B<rschedule> [ B<--load=>I<load> ] B<fixed_load> B<pid>
=head1 DESCRIPTION
rschedule will report or set status for load distribution using the
Perl Schedule::Load package.
If symbolically linked to the name "rtop" rschedule will by default produce
a listing of each host and the top loads on those hosts. Similarly, a link
to "rhosts" will show the host report by default, and a link to "rloads"
will show the load report.
=head1 COMMANDS
=over 4
=item allow_class <class>
Sets the hostname to allow the specified class of jobs. This sticks across reboots.
=item best
Returns the best host for a new job.
=item best_or_none
Returns the best host if there are free CPUs laying around, else fails.
=item classes
Displays a listing of the classes of jobs each host can run.
=item cmnd_comment <pid>
Sets the command comment for the given process ID. In rschedule top (rtop)
displays, this will be shown rather than the name of the command. Command
comments are inherited by children of commented parents.
=item deny_class <class>
Sets the hostname to deny the specified class of jobs.
=item fixed_load <pid>
Sets the given process ID to have that process count as one host load, even
if it is using less CPU time than that due to high disk activity or other
sleeps.
=item holds
Displays a listing of jobs that are blocked waiting for resources.
=item hosts
Displays a listing of each host being monitored along with its
load and system type.
=item hostnames
Displays list of each hostname. Multi-CPU hosts appear once.
=item idle_host_names
Displays list of each idle CPU. Multi-CPU hosts appear multiple times.
=item loads
Displays a longer command line of top jobs, along with any fixed_load
jobs.
=item release
Releases a host from dedicated use. Use --host to specify which host.
Any person may release a host, not just the original user requesting the
reservation. You may also use "release reserve" together to change an
existing reservation.
=item reserve
Reserves a host for dedicated use. To be reservable the C<reservable> flag
must be set when that host's L<slreportd> is invocated. This is indicated
on the top report by a "R" in the column next to the command. To override
a existing reservation you need to release the reservation first. Use
--host to specify which host. A optional --comment specifies the
reservation comment; the default time and user will be prepended unless a
leading - is used.
=item set_const B<var=value>
Sets a constant reporter parameter to the specified value. Slreportd will
loose the information when rebooted, so this should only be used to avoid
restarting the daemon after changing the slreportd's boot flags.
=item set_stored B<var=value>
Sets a stored reporter parameter to the specified value. Slreportd will
keep the information when rebooted, and override any set_const setting.
=item sleep B<secs>
For debugging only, sleep the specified number of seconds.
=item status
Displays a listing of each host and its daemon's status. Intended only for
debugging problems with the scheduler.
=item top
Displays a listing of top processes across all hosts being monitored.
=back
=head1 ARGUMENTS
=over 4
=item --allow-reserved
=item --no-allow-reserved
Specifies if reserved hosts may be returned by the best, best_or_none,
hostnames, idle_host_names, and jobs commands.
=item --class <class>
Specifies the job class for the best, best_or_none, hostnames,
idle_host_names, and jobs commands.
=item --comment <comment>
Specifies the command comment for the cmnd_comment command.
=item --dhost <hostname>
Specifies the host name that slchoosed uses. May be specified multiple
times to specify backup hosts. Defaults to SLCHOOSED_HOST environment
variable, which contains colon separated host names.
=item --help
Displays this message and program version and exits.
=item --kill <signal>
With the "loads" command, convert the listing to a form that will login to
the host and kill the processes. With a argument, use the argument as the
signal name.
=item --load <load>
Specifies the load value for the fixed_load command, defaults to 1.
=item --port <portnumber>
Specifies the port number that slchoosed uses.
=item --similar
Specifies only machines with the same OS version as the current host should
be returned for the best, best_or_none, hostnames, idle_host_names, and
jobs commands.
=item --version
Displays program version and exits.
=back
=head1 DISTRIBUTION
The latest version is available from CPAN and from L<http://www.veripool.org/>.
Copyright 1998-2011 by Wilson Snyder. This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
=head1 SEE ALSO
L<Schedule::Load>
=head1 AUTHORS
Wilson Snyder <wsnyder@wsnyder.org>
=cut
######################################################################