os_select.in

#!/usr/bin/perl -wT

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# All rights reserved.
#

# os_select sets the os that should boot next on a node, and sets
# next_op_mode accordingly.

sub usage() {
    print <<"EOF";
Usage: os_select [-h] [-d] [-v] [-1] [-p | -m] <osid> <node> [<node> ...]
 -h    Display this help message
 -d    Debug mode
 -v    Verbose mode
 -p    Path mode: osid is really a path to a kernel
 -1    Set up one-time boot to OS instead of changing default OS
 -m    MFS mode: osid={"PXEFBSD","PXEFRISBEE","PXEBOOT","host:/tftpboot/file"}
 osid  OS identifier for the selected OS (see web interface for listing)
 node  Node identifiers (ie pcXX)
EOF
    exit(-1);
}

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

$| = 1; #Turn off line buffering on output

# Configure variables
my $TB          = "@prefix@";
my $TBOPS       = '@TBSTATEDEMAIL@';

# Testbed Support libraries
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use English;
use Getopt::Std;
use Sys::Syslog;

# Constants
my $MBKERNEL = TB_OSID_MBKERNEL;
my %osidmap = # Map some magic OSIDs to op_modes
    ( $MBKERNEL => "MINIMAL");

# Global vars
my $d=0; # debug/verbose
my $oneshot=0; # is this a one-shot OS boot?
my $pathmode=0; # is osid really a path instead of an osid?
my $mfs=0; # is this for a pxe_boot_path change?

# Set up syslog
openlog("osselect","pid","user");

# Find default pxe boot path
my $cmd = "select path from os_info where osid='".TB_OSID_PXEBOOT."'";
my $q = DBQueryFatal($cmd);
my @r = $q->fetchrow_array();
my $pxebootpath = $r[0];
my $cmdline = join(" ",$0,@ARGV);
debug("ARGV= ".join(" ",@ARGV)."\n");

# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
my  $optlist = "hdvp1m";
%options = ();
if (! getopts($optlist, \%options)) { usage(); }
if (defined($options{"h"})) { usage(); }
if (defined($options{"d"})) { $d++; }
if (defined($options{"v"})) { $d++; }
if (defined($options{"p"})) { $pathmode=1; }
if (defined($options{"1"})) { $oneshot=1; }
if (defined($options{"m"})) { $mfs=1; }
#debug("DEBUG LEVEL $d\n");

if (@ARGV < 2) { warning("An osid and a node list are required.\n"); usage(); }

my $osid = shift;
my @nodes = @ARGV;

# Untaint args.
if ($osid =~ /^([-\@\w\/\.]+)$/) { $osid = $1; }
elsif (!$mfs) { fatal("Bad data in osid: '$osid'\n"); }

if ($mfs) {
    if ($osid =~ /^[-0-9a-z\.]+:\/tftpboot\/[-0-9a-z\.\/]+$/) {
	debug("MFS osid '$osid' is a PXE path\n");
	$pxebootpath=$osid;
	my $cmd = "select osid from os_info where path='$osid';";
	my $q = DBQueryFatal($cmd);
	if ($q->numrows() > 0) {
	    my @r = $q->fetchrow_array();
	    debug("Path '$osid' => OSID '$r[0]'\n");
	    $osid=$r[0];
	    $pathmode=0;
	} else { $pathmode=1; }
    } else {
	my $cmd = "select path from os_info where osid='$osid';";
	my $q = DBQueryFatal($cmd);
	if ($q->numrows() < 1) {
	    fatal("Invalid osid '$osid' does not exist.\n");
	}
	my @r = $q->fetchrow_array();
	my $path=$r[0];
	if (defined($path) && $path ne "") {
	    $pxebootpath=$path;
	} else {
	    fatal("Invalid osid for use with -m: '$osid'\n");
	}
    }
}

my @temp;
foreach $n (@nodes) {
    if ($n =~ /^([-\w]+)$/) { push(@temp,$1); }
    else { warning("Ignoring bad data in node_id: '$n'\n"); }
}
@nodes=@temp;

if (@nodes < 1) { fatal("No valid nodes supplied.\n"); }

# Figure out who called us. Only root, people with admin status
# in the DB, or members of the right project can do this.
if ($UID && !TBAdmin($UID)) {
    my ($me) = getpwuid($UID)
        or fatal("$UID not in passwd file\n");
    #debug("Not an admin.\n");
    if (! TBNodeAccessCheck($UID,TB_NODEACCESS_MODIFYINFO,@nodes)) {
        fatal("os_select: You do not have permission to modify ".
	    "one or more of the nodes.\n");
    }
    debug("Access granted to all nodes requested.\n");
} else { debug("Running as an admin.\n"); }

my $pernodeopmode=0;
my $opmode = os_opmode($osid);
debug("Found opmode '$opmode' for osid '$osid'.\n");
if ($opmode eq TBDB_NODEOPMODE_BOOTWHAT ) { $pernodeopmode=1; }

foreach $n (@nodes) {
    my $curmode = node_opmode($n);
    if (!$curmode) { next; }
    debug("Current opmode for node '$n' is '$curmode'.\n");
    # Always set the pxe_boot_path (to the osid in mfs mode, else PXEBOOT)
    set_pxe_path($n);
    # Only do the boot osid if we're not in mfs mode
    if (!$mfs) { set_boot_osid($n); }
    my $boot = TBBootWhat($n);
    if (!$boot) { fatal("***Bootwhat query failed. Contact testbed-ops.\n"); }
    debug("Bootwhat says: $n => $boot\n");
    if ($pernodeopmode) { 
	# in per-node mode, opmode is the mode for the os that we're going 
	# to boot, whatever that may be on each node
	$opmode= os_opmode($boot); 
	debug("Desired opmode for node '$n' is '$opmode'.\n");
    }
    if (!$curmode || ($curmode ne $opmode)) { set_nextmode($n); }
    else { set_nextmode($n,""); } # Make sure it is clear
}

exit();

#
# Subroutines
#

sub set_nextmode() {
    my $node = shift || "";
    my $mode = shift;
    if (!defined($mode)) { $mode = $opmode; }
    my $cmd = "update nodes set next_op_mode='$mode' where node_id='$node';";
    debug("Setting next_op_mode for node '$node' to '$mode'.\n");
    my $q = DBQueryFatal($cmd);
    return 0;
}

sub set_boot_osid() {
    my $node = shift || "";
    my $field = ($oneshot?"next":"def")."_boot_".($pathmode?"path":"osid");
    my $cmd = "update nodes set $field='$osid'";
    # Clear out the paths and the next_boot_osid except for possibly
    # one that we're going to set. Never clear def_boot_osid, since it
    # won't ever get in the way of what we really want to boot, and we
    # want something to fall back on.
    foreach $f ("next_boot_path", "def_boot_path", "next_boot_osid") {
	if ($f ne $field) { $cmd .= ", $f=''"; }
    }
    $cmd .= " where node_id='$node';";
    #debug("cmd=$cmd\n");
    debug("Setting $field for node '$node' to '$osid'.\n");
    my $q = DBQueryFatal($cmd);
    return 0;
}

sub set_pxe_path() {
    my $node = shift || "";
    my $field = ($oneshot?"next_":"")."pxe_boot_path";
    my $cmd = "update nodes set $field='$pxebootpath'";
    # Clear out the next_pxe_boot_path if we're not going to set it
    foreach $f ("next_pxe_boot_path") {
	if ($f ne $field) { $cmd .= ", $f=''"; }
    }
    $cmd .= " where node_id='$node';";
    #debug("cmd=$cmd\n");
    debug("Setting $field for node '$node' to '$pxebootpath'.\n");
    my $q = DBQueryFatal($cmd);
    return 0;
}

sub node_opmode() {
    my $node = shift || "";
    my $cmd = "select op_mode from nodes where node_id='$node';";
    my $q = DBQueryFatal($cmd);
    if ($q->numrows() < 1) {
	warning("Ignoring invalid node '$node' (non-existent)\n");
	return 0;
    }
    my @r = $q->fetchrow_array();
    my $opmode=$r[0];
    if (defined($opmode) && $opmode) { return $opmode; }
    warning("Invalid opmode '$opmode' for node '$node'.\n");
    return 0;
}

sub os_opmode() {
    my $osid = shift || "";
    if ($pathmode) { return $osidmap{$MBKERNEL}; }
    if (defined($osidmap{$osid})) { return $osidmap{$osid}; }
    my $cmd = "select op_mode from os_info where osid='$osid';";
    my $q = DBQueryFatal($cmd);
    if ($q->numrows() < 1) {
	fatal("Invalid osid '$osid' is non-existent.\n");
    }
    my @r = $q->fetchrow_array();
    my $opmode=$r[0];
    debug("OpMode for '$osid' is '$opmode'\n");
    if (defined($opmode) && $opmode ne "") { return $opmode; }
    fatal("No opmode found for osid '$osid'.\n");
}

sub debug ( $;$ ) {
  my $msg = shift;
  my $notice = shift || 0;
  my $prio="info";
  if ($notice) { $prio = "notice"; }
  syslog($prio,$msg) || notify("syslog failed: $! $?\n");
  if ($d) { print $msg; }
}

sub notify ( $ ) {
  my $msg = shift;
  my $user= getpwuid($UID);
  $msg .= "\ndate=".`date`."\ncmdline=\n$cmdline\n\npid=$$\n\nuser=$user\n";
  if (!$d) {
    SENDMAIL($TBOPS,"os_select error",$msg,$TBOPS);
  } else {
    debug("notify: Not sending mail in debug mode\n");
  }
  debug($msg,1);
}

sub info ( $;$ ) {
  my $msg = shift;
  debug($msg);
}

sub fatal ( $ ) {
  my $msg = shift;
  notify("FATAL: ".$msg);
  die($msg);
}

sub warning ( $ ) {
  my $msg = shift;
  info("WARNING: ".$msg);
  warn($msg);
}

# This is called when we exit with exit() or die()
END {
  closelog();
}