#! /usr/bin/perl -w
# $Header: /global/src/usr.bin/src/RCS/asuser.pl,v 1.121 2022/03/03 08:52:53 pb22 Exp $

# Use "pod2text" for info

=head1 NAME

asuser - as the registered user of a machine, run a priv command

=head1 SYNOPSIS

B<asuser> [--help] [--list] [B<-->] B<command> [args]*

=head1 OPTIONS

=over 4

=item B<--verbose>

show what it's doing

=item B<--help>

generate help info.

=item B<--list>

list the available commands

=back

=head1 DESCRIPTION

Machines can have a registered user who is permitted to configure the machine
in various ways,
such as change the loaded bundles by editing B</etc/user-info/bundles>.
This command allows the user to run certain commands under sudo.

If it has not been called under sudo (i.e. "SUDO_USER" is not set) it exec's
itself under sudo or cl-xsudo as appropriate.

=cut

use Getopt::Long;
use Getopt::Long qw(:config require_order);
use Pod::Usage;
%opts = (
	"verbose"	=> \$verbose,
	"help"		=> \$help,
	"ireadthesource"=> \$ireadthesource,
	"list"		=> \$list,
);
@ORIG_ARGV = @ARGV;
GetOptions (%opts) || pod2usage();
pod2usage(-verbose => 2) if $help;

$system_config_display		= "system-config-display";
$system_config_lvm		= "system-config-lvm";
$system_config_keyboard		= "system-config-keyboard";
$system_config_soundcard	= "system-config-soundcard";
$system_config_securitylevel	= "system-config-securitylevel";
$system_config_language		= "system-config-language";

# List of permitted commands. SUDO has not taken care of PATH, as not --with-secure-path.
%sub = (
	"aptitude"	=> \&sub_aptitude,
	"apt"		=> \&sub_apt_get,
	"apt-get"	=> \&sub_apt_get,
	"aticonfig"	=> \&sub_ati_nvidia_config,
	"blkid"		=> \&sub_blkid,
	"cdrecord"	=> \&sub_NOCHECK,
	"cfdisk"	=> \&sub_NOCHECK,
	"cgdisk"	=> \&sub_NOCHECK,
	"chroot"	=> \&sub_chroot,
	"dpkg"		=> \&sub_dpkg,
	"dpkg-reconfigure"=>\&sub_NOCHECK,
	"chkconfig"	=> \&sub_chkconfig,
	"setup-rc.d"	=> \&sub_setuprcd,
	"chmod"		=> \&sub_chmod,
	"chown"		=> \&sub_chown,
	"cl-add-rpms"	=> \&sub_addrpms,
	"cl-add-user"	=> \&sub_NOCHECK,
	"cl-isidle"	=> \&sub_NOCHECK,
	"cl-krenew"	=> \&sub_cl_krenew,
	"cl-make-ownfiles"=> \&sub_NOCHECK,
	"cl-hostid-fix"	=> \&sub_NOCHECK,
	"cl-mkscratchdir"=> \&sub_NOCHECK,
	"cl-patch-file"	=> \&sub_patchfile,
	# "cl-update-authorized-keys"=> \&sub_NOCHECK,
	"cl-update-system"=> \&sub_NOCHECK,
	"cl-writedvdimage"=> \&sub_NOCHECK,
	"dd"		=> \&sub_dd,
	"debuginfo-install"=> \&sub_debuginfo_install,
	"dellmgr"	=> \&sub_NOCHECK,
	"dhclient"	=> \&sub_NOCHECK,
	"eject"		=> \&sub_NOCHECK,
	"env"		=> \&sub_env,
	"envyng"	=> \&sub_NOCHECK,
	"ethtool"	=> \&sub_NOCHECK,
	"ext2online"	=> \&sub_ext2online,
	"fdisk"		=> \&sub_NOCHECK,
	"fix.files"	=> \&sub_NOCHECK,
	"fsck"		=> \&sub_NOCHECK,
	"fstrim"	=> \&sub_NOCHECK,
	"gdisk"		=> \&sub_NOCHECK,
	"gdmsetup"	=> \&sub_NOCHECK,
	"gparted"	=> \&sub_NOCHECK,
	"hdparm"	=> \&sub_NOCHECK,
	"ipmitool"	=> \&sub_NOCHECK,
	"iptables"	=> \&sub_NOCHECK,
	"ip6tables"	=> \&sub_NOCHECK,
	"ipt_recent"	=> \&sub_ipt_recent,
	"ifconfig"	=> \&sub_NOCHECK,
	"iwconfig"	=> \&sub_NOCHECK,
	"k3b"		=> \&sub_NOCHECK,
	"klist"		=> \&sub_klist,
	"list"		=> \&sub_list,
	"lvm"		=> \&sub_NOCHECK,
	"mdadm"		=> \&sub_NOCHECK,
	"mdadm-E"	=> \&sub_mdadm_E,
	"repo-able"	=> \&sub_repo_able,
	"mkdir"		=> \&sub_mkdir,
	"mkfs"		=> \&sub_NOCHECK,
	"mknod"		=> \&sub_mknod,
	"mkswap"	=> \&sub_NOCHECK,
	"modprobe"	=> \&sub_NOCHECK,
	"mount"		=> \&sub_mount,
	"nscd"		=> \&sub_nscd,
	"nspluginwrapper"=> \&sub_NOCHECK,
	"ntpdate"	=> \&sub_ntpdate,
	"nvidia-xconfig"=> \&sub_ati_nvidia_config,
	"passwd"	=> \&sub_passwd,
	"parted"	=> \&sub_NOCHECK,
	"partprobe"	=> \&sub_NOCHECK,
	"pirut"		=> \&sub_NOCHECK,
	"pkg_add"	=> \&sub_pkg_add,
	"pkg"		=> \&sub_pkg,
#	"pkg"		=> \&sub_NOCHECK,
	"pup"		=> \&sub_NOCHECK,
	"pm-hibernate"	=> \&sub_NOCHECK,
	"pm-suspend"	=> \&sub_NOCHECK,
	"pm-suspend-hybrid"=> \&sub_NOCHECK,
	"reiserfsck"	=> \&sub_NOCHECK,
	"resize2fs"	=> \&sub_resize2fs,
	"restorecon"	=> \&sub_NOCHECK,
	"rm"		=> \&sub_rm,
	"rpm"		=> \&sub_rpm,
	"semanage"	=> \&sub_NOCHECK,
	"semodule"	=> \&sub_NOCHECK,
	"sensors"	=> \&sub_NOCHECK,
	"sensors-detect"=> \&sub_NOCHECK,
	"service"	=> \&sub_service,
	"invoke-rc.d"	=> \&sub_invokercd,
	"setenforce"	=> \&sub_NOCHECK,
	"sfdisk"	=> \&sub_NOCHECK,
	"sgdisk"	=> \&sub_NOCHECK,
	"shutdown"	=> \&sub_NOCHECK,
	"ssh-wrong-host"=> \&sub_ssh_wrong_host,
	"smartctl"	=> \&sub_NOCHECK,
	"swapoff"	=> \&sub_NOCHECK,
	"swapon"	=> \&sub_NOCHECK,
	"tune2fs"	=> \&sub_NOCHECK,
	"tw_cli"	=> \&sub_NOCHECK,
	"ufw"		=> \&sub_NOCHECK,
	"umount"	=> \&sub_NOCHECK,
	"usermod"	=> \&sub_usermod,
	"virsh"		=> \&sub_virsh,
	"virt-install"	=> \&sub_NOCHECK,
	"virt-manager"	=> \&sub_NOCHECK,
	"wifi-radar"	=> \&sub_NOCHECK,
	"xenguest-install"=> \&sub_NOCHECK,
	"xenmon.py"	=> \&sub_NOCHECK,
	"xvpappliance"	=> \&sub_NOCHECK,
	"xm"		=> \&sub_xm,
	"yum"		=> \&sub_yum,
	"yumex"		=> \&sub_NOCHECK,
	"yum-complete-transaction"=> \&sub_NOCHECK,
	"zpool"		=> \&sub_zpool,
	$system_config_display	=> \&sub_system_config,
	$system_config_keyboard	=> \&sub_system_config,
	$system_config_lvm	=> \&sub_system_config,
	$system_config_securitylevel	=> \&sub_system_config,
	$system_config_soundcard	=> \&sub_system_config,
	$system_config_language	=> \&sub_system_config,
);
# If not run under sudo, should xsudo be used?
%needs_X = (
	"wifi-radar"	=> 1,
	"k3b"		=> 1,
	"pirut"		=> 1,
	"pup"		=> 1,
	"virt-install"	=> 1,			# Does it?
	"virt-manager"	=> 1,
	"xenguest-install"=> 1,			# Does it?
	"yumex"		=> 1,
	$system_config_display	=> 1,
	$system_config_keyboard	=> 1,
	$system_config_lvm	=> 1,
	$system_config_soundcard	=> 1,
	$system_config_language	=> 1,
	$system_config_securitylevel	=> 1,
);
sub_list(), exit(0) if $list;

$CHOWN_STD	= 1;	# Use this filename raw
$CHOWN_GLOB	= 2;	# Use glob to expand the re
%chown = (
	"/etc/sysconfig/iptables"=>$CHOWN_STD,
	"/etc/sysconfig/ip6tables"=>$CHOWN_STD,
	"/etc/X11/xorg.conf"	=> $CHOWN_STD,
	"/var/www/cgi-bin"	=> $CHOWN_STD,
	"/var/www/html"		=> $CHOWN_STD,
	"/var/www/error"	=> $CHOWN_STD,
	"/var/www/trac"		=> $CHOWN_STD,
	"/var/www/site"		=> $CHOWN_STD,
	"/etc/php.ini"		=> $CHOWN_STD,
	"/etc/httpd/conf"	=> $CHOWN_STD,
	"/etc/httpd/conf/webauth_keys"=> $CHOWN_STD,
	"/etc/httpd/conf.d"	=> $CHOWN_STD,
	"/etc/httpd/conf.d/*"	=> $CHOWN_GLOB,
	"/etc/tomcat5"		=> $CHOWN_STD,
	"/etc/tomcat5/*"	=> $CHOWN_GLOB,
	"/etc/my.cfg"		=> $CHOWN_STD,
	"/proc/bus/usb/*/*"	=> $CHOWN_GLOB,
	"/dev/ttyS*"		=> $CHOWN_GLOB,
	"/dev/ttyUSB*"		=> $CHOWN_GLOB,
	"/dev/snd/*"		=> $CHOWN_GLOB,
);

%chmod = (
	"/etc/X11/xorg.conf"	=> $CHOWN_STD,
	"/etc/php.ini"		=> $CHOWN_STD,
	"/var/log/httpd"	=> $CHOWN_STD,
	"/etc/httpd/conf"	=> $CHOWN_STD,
	"/etc/httpd/conf/webauth_keys"=> $CHOWN_STD,
	"/etc/httpd/conf.d"	=> $CHOWN_STD,
	"/etc/httpd/conf.d/*"	=> $CHOWN_GLOB,
	"/etc/tomcat5"		=> $CHOWN_STD,
	"/etc/tomcat5/*"	=> $CHOWN_GLOB,
	"/etc/my.cfg"		=> $CHOWN_STD,
	"/dev/ttyS*"		=> $CHOWN_GLOB,
	"/dev/ttyUSB*"		=> $CHOWN_GLOB,
	"/dev/snd/*"		=> $CHOWN_GLOB,
);

%usermod = (
	"fuse"			=> 1,
);

%rpmfirst	= (
	"--rebuilddb"	=> 1,
	"-e"		=> 1,
	"-V"		=> 1,
);

%yumflags = (
	"-h"		=> 1,
	"--help"	=> 1,
	"-t"		=> 1,
	"--tolerant"	=> 1,
	"-C"		=> 1,
	"-c"		=> 0,	#  Disable!
	"-R"		=> 1,
	"-d"		=> 1,
	"-e"		=> 1,
	"-q"		=> 1,
	"--quiet"	=> 1,
	"-v"		=> 1,
	"--verbose"	=> 1,
	"-y"		=> 1,
	"--version"	=> 1,
	"-x"		=> 1,
	"--obsoletes"	=> 1,
	"--noplugins"	=> 1,
	"--nogpgcheck"	=> 0,	# Disable!
	"--changelog"	=> 1,
	"--skip-broken"	=> 1,
	"Office/Productivity" => 1,	# groupinstall Office/Productivity
	"--installroot="=> 2,
	"--enablerepo="	=> 2,
	"--disablerepo="=> 2,
	"--exclude="	=> 2,
	"--disableplugin="=> 2,
);


# viInfFrRMSK
%pkgaddflags = (
	"-v"			=> 1,
	"-i"			=> 1,
	"-I"			=> 1,
	"-n"			=> 1,
	"-f"			=> 1,
	"-F"			=> 1,
	"-r"			=> 1,
	"-R"			=> 1,
	"-M"			=> 1,
	"-S"			=> 1,
	"-K"			=> 1,
);

%pkgflags = (
	"-v"			=> 1,
	"-d"			=> 1,
	"-l"			=> 1,
	"-n"			=> 1,
	"-j"			=> 0,
	"-c"			=> 0,
	"-C"			=> 0,
);

%pkgcmds = (
	"upgrade"		=> 2,
	"update"		=> 1,
	"install"		=> 2,
	"delete"		=> 2,
);

%dpkgflags = (
	"-a"			=> 1,
	"--configure"		=> 1,
);

%aptgetflags = (
	"-b"			=> 0,
	"--compile"		=> 0,
	"--build"		=> 0,
	"--allow-unauthenticated"=>0,
	"-c"			=> 0,
	"--config-file"		=> 0,
	"-o"			=> 0,
	"--option"		=> 0,

	"-d"			=> 1,
	"--download-only"	=> 1,
	"-f"			=> 1,
	"--fix-broken"		=> 1,
	"-m"			=> 1,
	"--ignore-missing"	=> 1,
	"--fix-missing"		=> 1,
	"--no-download"		=> 1,
	"-q"			=> 1,
	"-q=0"			=> 1,
	"-q=1"			=> 1,
	"-q=2"			=> 1,
	"--quiet"		=> 1,
	"-s"			=> 1,
	"--simulate"		=> 1,
	"--just-print"		=> 1,
	"--dry-run"		=> 1,
	"--recon"		=> 1,
	"--no-act"		=> 1,
	"-y"			=> 1,
	"--yes"			=> 1,
	"--assume-yes"		=> 1,
	"-u"			=> 1,
	"--show-upgraded"	=> 1,
	"-V"			=> 1,
	"--verbose-versions"	=> 1,
	"--ignore-hold"		=> 1,
	"--no-upgrade"		=> 1,
	"--force-yes"		=> 1,
	"--print-uris"		=> 1,
	"--purge"		=> 1,
	"--reinstall"		=> 1,
	"--list-cleanup"	=> 1,
	"-t"			=> 1,
	"--target-release"	=> 1,
	"--default-release"	=> 1,
	"--trivial-only"	=> 1,
	"--no-remove"		=> 1,
	"--auto-remove"		=> 1,
	"--only-source"		=> 1,
	"--diff-only"		=> 1,
	"--dsc-only"		=> 1,
	"--tar-only"		=> 1,
	"--arch-only"		=> 1,
	"-h"			=> 1,
	"--help"		=> 1,
	"-v"			=> 1,
	"--version"		=> 1,
);

%nscdflags = (
     "--debug"			=> 0,
     "-d"			=> 0,
     "--version"		=> 1,
     "-V"			=> 1,
     "-?"			=> 1,
     "--help"			=> 1,
     "--usage"			=> 1,
     "-g"			=> 1,
     "--statistic"		=> 1,
     "-i"			=> 2,
     "--invalidate"		=> 2,
     "-K"			=> 1,
     "--shutdown"		=> 1,
);
%aptgetcmds = (
	"update"		=> 1,
	"upgrade"		=> 1,
	"full-upgrade"		=> 1,
	"safe-upgrade"		=> 1,
	"dist-upgrade"		=> 1,
	"dselect-upgrade"	=> 1,
	"install"		=> 2,
	"remove"		=> 2,
	"purge"			=> 2,
	"source"		=> 2,
	"build-dep"		=> 2,
	"search"		=> 1,
	"show"			=> 1,
	"check"			=> 1,
	"clean"			=> 1,
	"autoclean"		=> 1,
	"autoremove"		=> 1,
);

%virsh_cmds = (
	"help"			=> 1,	# print help
	"attach-device"		=> 1,	# attach device from an XML file
	"attach-disk"		=> 1,	# attach disk device
	"attach-interface"	=> 1,	# attach network interface
	"autostart"		=> 1,	# autostart a domain
	"capabilities"		=> 1,	# capabilities
	"connect"		=> 1,	# (re)connect to hypervisor
	"console"		=> 1,	# connect to the guest console
	"create"		=> 0,	# create a domain from an XML file
	"start"			=> 1,	# start a (previously defined) inactive domain
	"destroy"		=> 1,	# destroy a domain
	"detach-device"		=> 1,	# detach device from an XML file
	"detach-disk"		=> 1,	# detach disk device
	"detach-interface"	=> 1,	# detach network interface
	"define"		=> 1,	# define (but don't start) a domain from an XML file
	"domid"			=> 1,	# convert a domain name or UUID to domain id
	"domuuid"		=> 1,	# convert a domain name or id to domain UUID
	"dominfo"		=> 1,	# domain information
	"domname"		=> 1,	# convert a domain id or UUID to domain name
	"domstate"		=> 1,	# domain state
	"domblkstat"		=> 1,	# get device block stats for a domain
	"domifstat"		=> 1,	# get network interface stats for a domain
	"dumpxml"		=> 1,	# domain information in XML
	"freecell"		=> 1,	# NUMA free memory
	"hostname"		=> 1,	# print the hypervisor hostname
	"list"			=> 1,	# list domains
	"migrate"		=> 1,	# migrate domain to another host
	"net-autostart"		=> 1,	# autostart a network
	"net-create"		=> 1,	# create a network from an XML file
	"net-define"		=> 1,	# define (but don't start) a network from an XML file
	"net-destroy"		=> 1,	# destroy a network
	"net-dumpxml"		=> 1,	# network information in XML
	"net-list"		=> 1,	# list networks
	"net-name"		=> 1,	# convert a network UUID to network name
	"net-start"		=> 1,	# start a (previously defined) inactive network
	"net-undefine"		=> 1,	# undefine an inactive network
	"net-uuid"		=> 1,	# convert a network name to network UUID
	"nodeinfo"		=> 1,	# node information
	"quit"			=> 1,	# quit this interactive terminal
	"reboot"		=> 1,	# reboot a domain
	"restore"		=> 1,	# restore a domain from a saved state in a file
	"resume"		=> 1,	# resume a domain
	"save"			=> 1,	# save a domain state to a file
	"schedinfo"		=> 1,	# show/set scheduler parameters
	"dump"			=> 1,	# dump the core of a domain to a file for analysis
	"shutdown"		=> 1,	# gracefully shutdown a domain
	"setmem"		=> 1,	# change memory allocation
	"setmaxmem"		=> 1,	# change maximum memory limit
	"setvcpus"		=> 1,	# change number of virtual CPUs
	"suspend"		=> 1,	# suspend a domain
	"ttyconsole"		=> 1,	# tty console
	"undefine"		=> 1,	# undefine an inactive domain
	"uri"			=> 1,	# print the hypervisor canonical URI
	"vcpuinfo"		=> 1,	# domain vcpu information
	"vcpupin"		=> 1,	# control domain vcpu affinity
	"version"		=> 1,	# show version
	"vncdisplay"		=> 1,	# vnc display
);

%zpool_cmds = (
	"events"		=> 1,	# X
	"get"			=> 1,	# X
	"history"		=> 1,	# X
	"iostat"		=> 1,	# X
	"list"			=> 1,	# X
	"status"		=> 1,	# X
	"scrub"			=> 1,	# X
       # "add [-fgLnP] [-o property=value] pool vdev ...
       # "attach [-f] [-o property=value] pool device new_device
       # "clear pool [device]
       # "create [-fnd] [-o property=value] ... [-O file-system-property=value] ... [-m mountpoint] [-R root] [-t tname] pool vdev ...
       # "destroy [-f] pool
       # "detach pool device
       # "export [-a] [-f] pool ...
       # "import [-d dir] [-D]
       # "import [-o mntopts] [-o property=value] ... [-d dir | -c cachefile] [-D] [-f] [-m] [-N] [-R root] [-F [-n] [-X] [-T]] -a
       # "import [-o mntopts] [-o property=value] ... [-d dir | -c cachefile] [-D] [-f] [-m] [-R root] [-F [-n] [-X] [-T]] [-t]] pool |id [newpool]
       # "labelclear [-f] device
       # "offline [-t] pool device ...
       # "online pool device ...
       # "reguid pool
       # "reopen pool
       # "remove pool device ...
       # "replace [-f] [-o property=value]  pool device [new_device]
       # "set property=value pool
       # "split [-gLnP] [-R altroot] [-o property=value] pool newpool [device ...]
       # "upgrade	Unsafe
       # "upgrade -v	Safe
);

$testfile	= "/etc/user-config/bundles";
$STAT_MODE	= 2;
$STAT_UID	= 4;
$STAT_GID	= 5;

$mkdirpat	= "^/local/[A-Za-z0-9][A-Za-z0-9.-]*\$";
$rmpat		= "^/var/run/yum.pid\$";

# Commands to raise privs if not already done
$sudoc		= "/usr/bin/sudo";	# sudo without X
$sudoc2		= "/usr/local/bin/sudo";# sudo without X on FreeBSD
$xsudoc		= "/usr/bin/cl-xsudo";	# sudo with X
$xsudoc2	= "/usr/bin/xsudo";	# Alternative sudo with X
@P		= ("-P");		# Preserve group to check for group access

# FreeBSD may use a different path for files
$sudoc		= "/usr/local/bin/sudo" unless -e $sudoc;

# Lists of service / actions which are allowed or denied for "service" and "chkconfig"
$service_action_deny = -1;
$service_action_default = 0;
$service_action_allow = 1;
$service_action_deny, $service_action_allow if 0;
$service_action_min_allow = $service_action_default; # Or $service_action_allow
%list_service_action = ( "ntpd-restart"	=> $service_action_allow, );
%list_service = ( "Dangerous"	=> $service_action_deny, );
%list_action = ( "Dangerous"   => $service_action_deny, );

# xm commands which need care
%xm_commands = ( "create" => \&sub_xm_create );
%virsh_commands = ( );
$xen_auto	= "/etc/xen/auto";	# where config files live

pod2usage unless $command = shift;
$ENV{'PATH'} = "/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin";
if (-d "/etc/rc.scripts/") {
	$ENV{'PATH'} = "/etc/rc.scripts:$ENV{'PATH'}";
	$command =~ s=^/etc/rc.scripts/==;
}
$NOUSER = "<root>";

$user = $ENV{'SUDO_USER'} || $NOUSER;
&list_subs("Unknown command '$command'") unless $sub = $sub{$command};
&check_root || &check_user;
print STDERR "# Use $command to run $sub with $#ARGV (@ARGV)\n" if $verbose;
&$sub;

# =============================================================================
sub check_root {
	# Check that it's running under sudo. If not, exec under sudo or xsudo.
	unless ($user && ($user ne $NOUSER)) {
		print STDERR "# No user: IN_ASUSER=", &val($ENV{'IN_ASUSER'}), ", $</$>\n" if $verbose;
		return 1 unless $< || $>;	# allow root to do anything
		die("$0: no SUDO_USER: not run under sudo?\n") if $ENV{'IN_ASUSER'};
		my($privc) = $sudoc;

		# Check that the command is available.
		$sudoc  = $sudoc2 unless -x $sudoc;
		$xsudoc = $xsudoc2 unless -x $xsudoc;
		$xsudoc = $sudoc unless -x $xsudoc;
		$sudoc  = $xsudoc if $needs_X{$command};

		print STDERR "# exec($sudoc, @P, $0, @ORIG_ARGV);\n" if $verbose;
		$ENV{'IN_ASUSER'} = 1;
		exec($sudoc, @P, $0, @ORIG_ARGV);
	}
	return 0;
}

# Check the user (as per $SUDO_USER) and group of the calling user
sub check_user {
	# If we can map the username to a user number,
	# then fork a test process to see if that user can write the file.
	# This removes the need to re-implement the simple and ACL access
	# code in perl.
	if (($user ne $NOUSER) && (@userinfo = getpwnam($user))) {
		my($eval) = eval { if ($pid = fork) 
			# parent process. Wait for child and return:
			#  1: child returned 1 << 8
			# -1: child returned 3 << 8
			# Anything else return "undefined",
			# which means "mechanism not available".
			{ waitpid($pid, 0);
			  print STDERR "# $0: pid $pid gave $?\n" if $verbose;
			  ($? == 256) ? 1 : ($? == 768) ? -1: undef 
			} 
			else
			# Child forked test process
			# return 0 [mechanism not available] if no filetest
			{ use filetest 'access' || exit(0);
			  # return 0 [mechanism not available] if can't setuid
			  print STDERR "groups= $( vs $)\n" if $verbose;
			  $( = $) = $groups if ($groups = $)) =~ s/^[0-9]+ //;
			  print STDERR "groups= $( vs $)\n" if $verbose;
			  $< = $> = $userinfo[2] || exit(0);
			  # Return 1 if writable, else 3.
			  exit((-W "$testfile") ? 1: 3)
			} 
		};
		print STDERR "# $0: eval ($user=$userinfo[2] <$)>) gave $eval for $testfile ($?)\n" if $verbose;
		#$( = $) = $groups if ($groups=$)) =~ s/^[0-9]+ ([0-9]+).*/$1/;
		$groups = $);
		while ($groups =~ s/ [0-9]+//) { $( = $) = $groups }
		print STDERR "# groups reduced to $)\n" if $verbose;
		return $eval if defined($eval) && $eval > 0; # OK -- user can write.
		# Fail if the testing mechanism worked, but access denied
		die("$0: command not executed as run as user $user\n") if defined $eval;
		# Drop through if mechanism failed.
	}

	my($ok) = 0;
	my($group) = "<unknown>";
	my($groups) = $group;
	my($why) = "<unset>";

	print STDERR "# Check_user (", &val($user), ")\n" if $verbose;
	(my(@stat) = stat($testfile)) || die("$0: failed to stat $testfile: $!\n");
	$acl = `getfacl $testfile 2>&1`;
	print STDERR "# $0: getfacl $testfile' gave:\n$acl" if $verbose;
	# getfacl: Removing leading '/' from absolute path names
	# # file: tmp/test
	# # owner: root
	# # group: root
	# user::rw-
	# user:pb22:rwx
	# group::r--
	# mask::rwx
	# other::r--
	print STDERR "# Check_user ($stat[$STAT_UID]): @stat\n" if $verbose;
	my($who) = getpwuid $stat[$STAT_UID];
	my($mode) = sprintf("0%3o",  $stat[$STAT_MODE]);
	print STDERR "# $testfile is mode $mode\n" if $verbose;
	print STDERR "# compare '$user' and '$who'\n" if $verbose;
	# Check *IN ORDER* the user, group and "other" perms as appropriate
	# See "man acl" for correct procedure
	# Try "user"
	if ($user eq $who) { $ok = ($stat[$STAT_MODE] & 0200) ? 1 : -1; $why = "user"; }
	# Try "user" ACL
	elsif ($acl  =~ /user:$user:.(.)/) { $ok = ($1 eq "w") ? 1 : -1; $why = "useracl"; }
	else {	$group = getgrgid $stat[$STAT_GID];
		chomp($groups = `groups`);
		print STDERR "# $testfile is $group / $stat[$STAT_GID]  [$groups] \n" if $verbose;
		# Try "group"
		if (" $groups " =~ / $group /) {
			$ok = ($stat[$STAT_MODE] & 020) ? 1 : -1; $why = "group=$group";
		}
		# Try "group" ACL
		else { foreach $one (split(/ /, $groups)) {	# Look for "OK" for any group.
			print STDERR "# $0: try $one from <$groups>\n" if $verbose;
			if ($acl  =~ /group:$one:.(.)/) { $ok = ($1 eq "w") ? 1 : -1; $why = "groupacl=$one";  last if $ok > 0; }
		     }
		}
		# Try "other"
		unless ($ok) {	$ok = ($stat[$STAT_MODE] &  02) ? 1 : -1; $why = "other"; }
	}
	print STDERR "# $0: ok=$ok ($why)\n" if $verbose;
	die("$0: run as $user,<$groups> rather than $who,<$group> (mode $mode)\n") unless $ok > 0;
}

sub list_subs {
	my($why)	= @_;
	print STDERR "$0: $why\n" if $why;
	print STDERR "$0: valid commands are:\n";
	# foreach $cmd (sort keys %sub) { print STDERR "\t$cmd\n"; }
	print STDERR &format(1,16,80, sort keys %sub);
	exit(!!$why);
}

sub log_yum {
	my(@text) = @_;
	my($logfile) = "/var/log/yum-sudo";
	my ($when) = localtime() . ": $user: ";
	open(LOG, ">> $logfile") || die("$0: failed to open $logfile: $!\n");
	(my(@stat1) = lstat($logfile)) || die("$0: lstat($logfile) failed: $!\n");
	(my(@stat2) = stat(LOG)) || die("$0: stat($logfile) failed: $!\n");
	die("$0: Problems with $logfile\n") unless $stat1[1] == $stat2[1];
	print LOG $when, @text, "\n";
	close(LOG);
}

# =============================================================================

# List the available commands
sub sub_list {
	&list_subs("");
}

# -----------------------------------------------------------------------------

# look at blkid info
sub sub_blkid {
	my @argv = ();
	while (defined($arg = shift(@ARGV))) {
		# Allow (e.g.) -y
		if ($arg =~ /^-[fhlv]$/) { # OK -- pass it through
		} elsif ($arg =~ /^-[ost]$/) { push @argv, $arg; $arg = shift(@ARGV);
		} elsif ($arg eq "-w") { die("$0: '$command $arg' not permitted\n");
		} elsif ($arg eq "-c") {
			push @argv, $arg; $arg = shift(@ARGV);
			die("$0: '$command -c $arg' not permitted\n") unless $arg eq "/dev/null";
		} else {
			die("$0: $command does not accept argument $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	exec($command, @argv);
}

# -----------------------------------------------------------------------------

# Apply the std patches
sub sub_patchfile {
	my @argv = ();
	my $seen_auto = 0;
	while (defined($arg = shift(@ARGV))) {
		# Allow (e.g.) -y
		if ($arg eq "-a" || $arg eq "--auto") {
			$seen_auto++;
		} elsif ($arg eq "-h" || $arg eq "-v" || $arg eq "-n") {
			# OK -- pass it through
		} else {
			die("$0: $command does not accept argument $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	die("$0: $command requires '--auto'\n") unless $seen_auto;
	exec($command, @argv);
}

# -----------------------------------------------------------------------------

# install the std RPMs
sub sub_addrpms {
	my @argv = ();
	my $seen_auto = 0;
	while (defined($arg = shift(@ARGV))) {
		# Allow (e.g.) -y
		if ($arg eq "-a" || $arg eq "--auto") {
			$seen_auto++;
		} elsif ($arg eq "-h" || $arg eq "-v" || $arg eq "-n" || $arg eq "-y" || $arg eq "-f") {
			# OK -- pass it through
		} else {
			die("$0: $command does not accept argument $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	die("$0: $command requires '--auto'\n") unless $seen_auto;
	exec($command, @argv);
}

# -----------------------------------------------------------------------------

# manipulate a service (redhat)
sub sub_service {
	my $status_all = "--status-all";
	if ($#ARGV == 1) {
		($service, $action) = ($ARGV[0], $ARGV[1]);
		$servact = "$service-$action";
		$ok = $service_action_default;
		if (defined $list_service_action{$servact}){$ok=$list_service_action{$servact}}
		elsif (defined $list_service{$service})	{ $ok = $list_service{$service}}
		elsif (defined $list_action{$action})	{ $ok = $list_action{$action}}
		if ($ok < $service_action_min_allow) {
			die("$0: $command $service $action not permitted\n");
		}
	} elsif (($#ARGV != 0) || ($ARGV[0] ne $status_all)) {
		die("$0: Usage: $command (<service> <action>) | ($status_all) \n")
	}
	# Put in a block by itself to avoid warning
	{ exec($command, @ARGV); }
	# If we get here, exec failed
	$command = "invoke-rc.d";
	exec($command, @ARGV);
}
# -----------------------------------------------------------------------------

# manipulate a service (ubuntu)
sub sub_invokercd {
	# Add  --quiet --force --try-anyway --disclose-deny --query --no-fallback --help; extra args
	die("$0: Usage: $command <service> <action>\n") unless $#ARGV == 1;
	($service, $action) = ($ARGV[0], $ARGV[1]);
	$servact = "$service-$action";
	$ok = $service_action_default;
	if (defined $list_service_action{$servact}){$ok=$list_service_action{$servact}}
	elsif (defined $list_service{$service})	{ $ok = $list_service{$service}}
	elsif (defined $list_action{$action})	{ $ok = $list_action{$action}}
	if ($ok < $service_action_min_allow) {
		die("$0: $command $service $action not permitted\n");
	}
	exec($command, $ARGV[0], $ARGV[1]);
}
# -----------------------------------------------------------------------------

# set the date
sub sub_ntpdate {
	die("$0: Usage: $command <IPaddr>\n") unless $#ARGV == 0;
	$addr = $ARGV[0];
	die("$0: Usage: $command 128.232.0.[6-9]\n") unless $addr =~ /^128.232.0.[6-9]$/;
	exec($command, $ARGV[0]);
}

# -----------------------------------------------------------------------------

# chroot to /32 and reset the process ID, user and group
# Typical use: setarch i686 cl-asuser chroot /32  bash --login
sub sub_chroot {
	use POSIX 'setsid';
	my ($newroot) = "/32";

	# Check that the arguments are as expected.
	die("$0: Usage: $command $newroot <command>\n") unless ($#ARGV > 1) && ($ARGV[0] eq $newroot);

	# Check that the cwd exists on the other FS
	my ($root) =  shift(@ARGV);
	my ($cwd) = `pwd`; chomp($cwd);
	chdir("$root$cwd") || die("$0: failed to chdir to $root$cwd: $!\n");

	# Do the chroot
	chroot($root) || die("$0: failed to chroot to $root: $!\n");

	# Change the group. NB: should be groups rather than just one group ...
	$( = $) = $id = $ENV{'SUDO_GID'};
	die("$0: failed to set (e)gid to $id ($(, $)): $!\n") unless $( == $id && $) ==  $id;

	# Get a new process group
	setsid() || die("$0: setsid failed: $!\n");

	# All priv operations done -- can drop privs
	$< = $> = $id = $ENV{'SUDO_UID'};
	die("$0: failed to set (e)uid to $id ($<, $>): $!\n") unless $< ==  $id && $> ==  $id;

	# Avoid confusing things -- there should no longer be relevant.
	delete($ENV{'IN_ASUSER'});
	delete($ENV{'SUDO_GID'});
	delete($ENV{'SUDO_UID'});
	delete($ENV{'SUDO_USER'});
	delete($ENV{'SUDO_COMMAND'});

	# Do whatever the user requested.
	exec(@ARGV);
}

# -----------------------------------------------------------------------------

# manipulate services at boot time
sub sub_chkconfig {
	die("$0: Usage: $command <chkconfig> <action>\n") unless $#ARGV == 1;
	($service, $action) = ($ARGV[0], $ARGV[1]);
	$servact = "$service-$action";
	$ok = $service_action_default;
	if (defined $list_service_action{$servact}){$ok=$list_service_action{$servact}}
	elsif (defined $list_service{$service})	{ $ok = $list_service{$service}}
	elsif (defined $list_action{$action})	{ $ok = $list_action{$action}}
	if ($ok < $service_action_min_allow) {
		die("$0: $command $service $action not permitted\n");
	}
	exec($command, $ARGV[0], $ARGV[1]);
}

# -----------------------------------------------------------------------------

# manipulate services at boot time
sub sub_setuprcd {
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# extend a mounted FS. Command replaced by resize2fs on FC6
sub sub_ext2online {
	die("$0: Usage: $command <FS> <size>\n") unless
		$#ARGV == 1 &&
		$ARGV[1] =~ /^\d+[bKMGT]?$/;
	exec($command, $ARGV[0], $ARGV[1]);
}

# -----------------------------------------------------------------------------

# run klist -k
sub sub_klist {
	my ($sen_k) = 0;
	$ENV{'PATH'} .= ":/usr/kerberos/bin";
	@ARGS = ();
	while ($#ARGV > 0) {
		if ($ARGV[0] eq "-k") { $seen_k = 1 }
		elsif ($ARGV[0] eq "-e") { ; }
		elsif ($ARGV[0] eq "-t") { ; }
		elsif ($ARGV[0] =~ /^-/) {
			die("$0: flag '$ARGV[0]' not accepted for $command\n");
		}
		else { last; }
		push @ARGS,  shift(@ARGV);
	}
	die("$0: Usage: $command -k [-e] [-t] /etc/krb5.keytab\n") unless
		$seen_k &&
		$#ARGV == 0 &&
		$ARGV[0] =~ m=/etc/krb5.keytab=;
	exec($command, @ARGS, @ARGV);
}

# -----------------------------------------------------------------------------

# extend a (mounted) FS - replaces resize2fs on FC6
sub sub_resize2fs {
	@ARGS = ();
	while ($#ARGV > 0) {
		if ($ARGV[0] eq "-p") { ; }
		elsif ($ARGV[0] eq "-d") { push @ARGS, shift(@ARGV); }
		elsif ($ARGV[0] eq "-S") { push @ARGS, shift(@ARGV); }
		elsif ($ARGV[0] =~ /^-/) {
			die("$0: flag '$ARGV[0]' not accepted for $command\n");
		}
		else { last; }
		push @ARGS,  shift(@ARGV);
	}
	die("$0: Usage: $command <FS> <size>\n") unless
		$#ARGV == 1 &&
		$ARGV[1] =~ /^\d+[bKMGT]?$/;
	exec($command, @ARGS, $ARGV[0], $ARGV[1]);
}

# -----------------------------------------------------------------------------

# Configure nvidia or ati, without reading/writing inappropriate files
sub sub_ati_nvidia_config {
	foreach $arg (@ARGV) {
		die("$0: Cannot set X config file name ($arg) for $command\n")
		 if $arg =~ /^-[co]/ || $arg =~ /^--(xconfig|output-xconfig|input|output)/;
	}
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# run a system config GUI
sub sub_system_config {
	@ARGS = ();
	while ($#ARGV > 0) {
		if (($ARGV[0] =~ /^-o/ || $ARGV[0] =~ /^--output/) &&
			($command eq $system_config_display)) {
			die("$0: flag '$ARGV[0]' not accepted for $command\n");
		}
		push @ARGS,  shift(@ARGV);
	}
	exec($command, @ARGS);
}

# -----------------------------------------------------------------------------

# allow very restricted rpm commands
sub sub_rm {
	my (@testargs) = @ARGV;
	while (defined($_ = shift(@testargs))) {
		if (/^-f$/) { shift; next; }
		elsif (/^-/) { die("$0: $command: flag '$_' not accepted\n"); }
		last;
	}
	die("$0: $command: no file given\n") unless $_;
	die("$0: $command: only a single file is allowed\n") if $#testargs >= 0;
	die("$0: $command: '$_' does not match '$rmpat'\n") unless /$rmpat/;
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# allow very restricted rpm commands
sub sub_rpm {
	unless ($rpmfirst{$ARGV[0]}) {
		die("$0: $command does not accept '$ARGV[0]' as initial flag, only " . join(", ", keys %rpmfirst) . "\n");
	}
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# run an virsh command, taking special care as necessary
sub sub_virsh {
	if ($#ARGV < 0) { die("$0: interactive $command not permitted\n"); }
	elsif ($cmd = $virsh_commands{$ARGV[0]}) { &$cmd; }
	elsif (! defined($virsh_cmds{$ARGV[0]})) { die("$0: unknown $command subcommand '$ARGV[0]'\n"); }
	elsif (! $virsh_cmds{$ARGV[0]}) { die("$0: '$command $ARGV[0]' not permitted\n"); }
	else { exec($command, @ARGV); }
}

# -----------------------------------------------------------------------------

# run a zpool command
sub sub_zpool {
	if ($#ARGV < 0) { die("$0: interactive $command not permitted\n"); }
	elsif (! defined($zpool_cmds{$ARGV[0]})) { die("$0: unknown $command subcommand '$ARGV[0]'\n"); }
	elsif (! $zpool_cmds{$ARGV[0]}) { die("$0: '$command $ARGV[0]' not permitted\n"); }
	else { exec($command, @ARGV); }
}

# -----------------------------------------------------------------------------

# run an xm command, taking special care as necessary
sub sub_xm {
	if (($#ARGV > 0) && ($cmd = $xm_commands{$ARGV[0]})) { &$cmd; }
	else { exec($command, @ARGV); }
}

# -----------------------------------------------------------------------------

# Create a xen machine
sub sub_xm_create {
	@ARGS = ();

	# Heuristic for "can domU access VLAN 100" ...
	my($test) = `ifconfig peth0 2>&1`;
	if ($test =~ /Device not found/) { exec($command, @ARGV); }

	# Copy the "create"
	push @ARGS,  shift(@ARGV);
	# Copy the optionsl "-c"
	push @ARGS,  shift(@ARGV) if $#ARGV > 0 && $ARGV[0] eq "-c";
	# Should now have the machine name. Force it to be in /etc/xen/auto/
	if ($#ARGV < 0) { die("$0: xm create needs a config file\n"); }
	$file = shift(@ARGV);
	$file =~ s=^$xen_auto/==;
	if ($file =~ m=/=) {
		die("$0: xm create config files should be relative to $xen_auto\n");
	}
	$file = "$xen_auto/$file";
	push  @ARGS, $file;
	while ($#ARGV > 0) { push @ARGS,  shift(@ARGV); }
	print STDERR "# Use $command (@ARGS)\n" if $verbose;
	exec($command, @ARGS);
}

# -----------------------------------------------------------------------------

# change the default enable state of a repo
# Single arg looks for a repo; three args sets repo in foo to en/dis
sub sub_repo_able {
	$repod = "/etc/yum.repos.d/";
	unless ($#ARGV == 2) { die("$0: Specify a repository, a file and a state\n"); }
	$repo = $ARGV[0];
	$file = $ARGV[1];
	$val = $ARGV[2];

	# Check args looks OK
	unless ($repo =~ /^[a-zA-Z-]+$/) { die("$0: invalid repo $repo\n") }
	$file =~ s/^$repod//;
	unless ($file =~ /^[a-zA-Z0-9.-]+$/) { die("$0: invalid file $file\n") }
	unless ($val =~ /^[01]$/) { die("$0: invalid value $val\n") }

	$file = $repod . $file;
	open(REPO, $file) || die("$0: $file open failed: $!\n");
	$was = $res = '';
	$done = $thisone = 0;
	# Copy over old data, editing the "enabled" line as needed.
	while (<REPO>) {
		$was .= $_;

		# "[core]"
		# Is this the repository of interest?
		if (/^\[(.+)\]$/) {
			die("$0: $repo found, but no 'enabled=' found\n")
				if $thisone && ! $done;
			$thisone = ($1 eq $repo);
			$done = 0;
		}

		# "enabled=0"
		# If processing the repository of interest, do the edit
		$done = 1 if $thisone && s/^(enabled=)[01]$/$1$val/;

		$res .= $_;
	}
	close(REPO) || die("$0: close of $file failed: $!\n");

	# If no change, do nothing
	return if $was eq $res;

	# Write new tmp file, rename and reset context
	open(REPO, ">$file-t") || die("$0: $file-t open failed: $!\n");
	print REPO $res || die("$0: $file-t write failed: $!\n");
	unless (close(REPO)) { unlink "$file-t"; die("$0: close $file-t failed: $!\n"); }
	unless (rename "$file-t",  $file) { unlink "$file-t"; die("$0: rename $file-t $file failed: $!\n"); }
	&restorecon($file);
}

sub restorecon {
	my($file) = @_;
	system("restorecon -v $file") if system("restorecon -n -i /xxx > /dev/null 2>&1");
}
# -----------------------------------------------------------------------------

# run "mdadm -E -s" to update /etc/mdadm.conf
sub sub_mdadm_E {
	$mdadmconf = "/etc/mdadm.conf";
	# debian uses a different file
	$mdadmconf = "/etc/mdadm/mdadm.conf" unless -e $mdadmconf;
	$data = `mdadm -E -s`;
	open(MDADM, $mdadmconf) || die("$0: $mdadmconf failed: $!\n");
	$was = $res = '';
	$inarray = 0;
	# Copy over old data, removing ARRAY lines and continuation lines
	while (<MDADM>) {
		$was .= $_;
		if (/^ARRAY/) { $inarray = 1; next; }
		next if $inarray && /^\s/;
		$inarray = 0;
		$res .= $_;
	}
	close(MDADM) || die("$0: close of $mdadmconf failed: $!\n");
	# Append new ARRAY lines
	$res .= "$data";

	# If no change, do nothing
	return if $was eq $res;

	# Write new tmp file, rename and reset context
	open(MDADM, ">$mdadmconf-t") || die("$0: $mdadmconf-t open failed: $!\n");
	print MDADM $res || die("$0: $mdadmconf-t write failed: $!\n");
	unless (close(MDADM)) { unlink "$mdadmconf-t"; die("$0: close $mdadmconf-t failed: $!\n"); }
	unless (rename "$mdadmconf-t",  $mdadmconf) { unlink "$mdadmconf-t"; die("$0: rename $mdadmconf-t $mdadmconf failed: $!\n"); }
	&restorecon($mdadmconf);

	my($dev) = '';
	open(MDADM, $mdadmconf) || return;
	while (<MDADM>) {
		$dev .= " $1" if /^ARRAY\s+(\/dev\S+)/;
	}
	close(MDADM);
	print STDERR "# run: mdadm -D$dev > $mdadmconf-full\n";
	system("mdadm -D$dev > $mdadmconf-full") if $dev;
}

# -----------------------------------------------------------------------------

# run mknod to create an md or sd device
sub sub_mknod {
	die("$0: $command: expects 4 args: /dev/{md|sd}* b {9,8} <n> ($#ARGV)\n")
		unless $#ARGV == 3;
	# Look for md or sd, and set up expected subsequent args
	if ($ARGV[0] =~ m=^/dev/md(\d+)$=) {
		$arg2 = 'b';
		$arg3 = 9;
		$arg4 = $1;
		die("$0: $command: max minor is 255 ($ARGV[0])\n") unless $1 eq '' || $1 <= 255;
	}
	elsif ($ARGV[0] =~ m=^/dev/sd([a-z])(\d*)$=) {
		my($dev,$sub) = ($1,$2);
		$arg2 = 'b';
		$arg3 = 8;
		$arg4 = 16 * (ord($dev) - ord('a'));
		$arg4 += $sub if $sub =~ /^\d$/;
		die("$0: $command: max minor is 15 ($ARGV[0])\n") unless $sub eq '' || $sub <= 15;
	}
	else { die("$0: $command: first arg should be '/dev/{md|sd}*' ($ARGV[1])\n")}
	die("$0: $command: second arg should be '$arg2' ($ARGV[1])\n")
		unless $ARGV[1] eq $arg2;
	die("$0: $command: third arg should be '$arg3' ($ARGV[2])\n")
		unless $ARGV[2] eq $arg3;
	die("$0: $command: fourth arg should be '$arg4' ($ARGV[3])\n")
		unless $ARGV[3] eq $arg4;
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# run cl-krenew with "safe" options
sub sub_cl_krenew {
	my (@testargs) = @ARGV;
	my $safecmd = 0;
	while (defined($_ = shift(@testargs))) {
		if (/^--status$/) { $safecmd++; }
		elsif (/^--purge$/) { ; }
		elsif (/^--norefresh$/) { ; }
		else { die("$0: $command: argument '$_' not accepted\n"); }
	}
	die("$0: $command: no suitable argument given\n") unless $safecmd == 1;
	exec($command, @ARGV, "--norefresh");
}

# -----------------------------------------------------------------------------

# run mkdir to create a directory
sub sub_mkdir {
	my (@testargs) = @ARGV;
	while (defined($_ = shift(@testargs))) {
		if (/^-m$/) { shift; next; }
		elsif (/^-m[0-9]+$/) { next; }
		elsif (/^--mode=[0-9]+$/) { next; }
		elsif (/^-Z$/) { shift; next; }
		elsif (/^-Z\S+$/) { next; }
		elsif (/^--context=\S+$/) { next; }
		elsif (/^-p$/) { next; }
		elsif (/^-/) { die("$0: $command: flag '$_' not accepted\n"); }
		last;
	}
	die("$0: $command: no directory given\n") unless $_;
	die("$0: $command: only a single directory is allowed\n") if $#testargs >= 0;
	die("$0: $command: '$_' does not match '$mkdirpat'\n") unless /$mkdirpat/;
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# No checks
sub sub_NOCHECK {
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# run mount in various guises ...
sub sub_mount {
	my @argv = ();
	my $is_user = 0;
	return exec($command, @ARGV) if ($#ARGV == 0 && $ARGV[0] eq "-a");
	return exec($command, @ARGV) if ($#ARGV == 0 && $ARGV[0] =~ /^\//);

	while (defined($arg = shift(@ARGV))) {
		# Look for "-o .*users.*" or "-u.*user[s]*"
		if ($arg =~ /^-o/) {
			if ($arg eq "-o") {
				push @argv, $arg if defined $arg;
				$arg = shift(@ARGV);
				$match = ",$arg,";
			} else {
				$match = "$arg,";
				$match =~ s/^-o/,/;
			}
			$is_user ++ if $match =~ /,user[s]?,/;
		}
		push @argv, $arg if defined $arg;
	}
	die("$0: $command options should be just '-a', a single path, or should include the user or users option\n") unless $is_user;

	# Check where the mount is to occur: /local/* or /mnt
	$dest = $argv[$#argv];
	die("$0: $command must mount in /local/* or /mnt, not $dest\n") unless $dest =~ /^\/(mnt|local\/[^\/]+)$/;
	die("$0: $command expects a directory in $dest\n") if $dest =~ /\/(\.|\.\.)$/;

	exec($command, @argv);
}

# -----------------------------------------------------------------------------

# run "nscd -i"
sub sub_nscd {
	my @argv = ();
	my $op = 0;
	while (defined($arg = shift(@ARGV))) {
		my $args = $nscdflags{$arg};
		if(!defined($args)) {
			die("$0: $command does not allow flag $arg\n");
		} elsif ($args == 0) {
			# OK -- pass it through
		} elsif ($args == 1) {
			# OK -- pass it through
			$op++;
		} elsif ($args == 2) {
			$op++;
			push @argv, $arg;
			$arg = shift(@ARGV);
		} else {
			die("$0: $command incorrectly configured flag $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	print STDERR "# Run: " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	die("$0: expecting 1 meaningful flag, not $op: $command, @argv\n") unless $op == 1;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
	exit($rc >> 8);
}

# -----------------------------------------------------------------------------

# Run a debug-install command
sub sub_debuginfo_install {
	die("$0: $command expects one argument\n") if $#ARGV;
	my $rpm = $ARGV[0];
	die("$0: $command does not allow .rpm suffix on $rpm\n")
		if $rpm =~ /\.rpm$/;
	&log_yum("Run: $command $rpm");
	print STDERR "# Run: $command $rpm\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, $rpm);
	&log_yum("# $rc for $rpm");
	exit($rc >> 8);
}

# -----------------------------------------------------------------------------

# Run a yum command
sub sub_yum {
	my @argv = ();
	while (defined($arg = shift(@ARGV))) {
		my $args = $yumflags{$arg};
		if ($args) {
			# OK -- pass it through
		} elsif ($arg =~ /^([^=]+=)/ && ($arge = $yumflags{$1}) && $arge == 2) {
			# OK -- pass it through
		} elsif ($arg =~ /^-/) {
			die("$0: $command does not allow flag $arg\n");
		} elsif ($arg =~ /\//) {
			die("$0: $command does not allow path $arg\n");
		} elsif ($arg =~ /\.rpm$/) {
			die("$0: $command does not allow .rpm suffix on $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	&log_yum("Run: " . join(", ", @argv));
	print STDERR "# Run: " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
	exit($rc >> 8);
}

# -----------------------------------------------------------------------------

# Run dpkg --configure -a
sub sub_dpkg {
	my @argv = ();
	while (defined($arg = shift(@ARGV))) {
		my $args = $dpkgflags{$arg};
		if ($args) {
			# OK -- pass it through
		} elsif (defined($args)) {
			die("$0: $command does not allow flag $arg\n");
		} elsif ($arg =~ /^-/) {
			die("$0: $command does not recognise flag $arg\n");
		} else {
			die("$0: $command: unrecognised subcommand $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	&log_yum("Run: " . join(", ", @argv));
	print STDERR "# Run: $command " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
}

# -----------------------------------------------------------------------------

# Run an apt-get command
sub sub_apt_get {
	my @argv = ();
	my $pkgs = 0;	# command does not take a list of packages
	while (defined($arg = shift(@ARGV))) {
		my $args = $aptgetflags{$arg};
		if ($args) {
			# OK -- pass it through
		} elsif ($arg eq "-o" && $#ARGV > 0 && $ARGV[0] =~ /^DPkg::Options::=--force-conf(new|def)$/) {
			push @argv, $arg;
			$arg = shift(@ARGV);
		} elsif (defined($args)) {
			die("$0: $command does not allow flag $arg\n");
		} elsif ($arg =~ /^([^=]+=)/ && ($arge = $aptgetflags{$1}) && $arge == 2) {
			# OK -- pass it through
		} elsif ($arg =~ /^-/) {
			die("$0: $command does not recognise flag $arg\n");
		} elsif (defined($aptgetcmds{$arg})) {
			last;
		} elsif ($arg =~ /\//) {
			die("$0: $command does not allow path $arg\n");
		} elsif ($arg =~ /\.rpm$/) {
			die("$0: $command does not allow .rpm suffix on $arg\n");
		} else {
			die("$0: $command: unrecognised subcommand $arg\n");
		}
		push @argv, $arg if defined $arg;
	}
	die("$0: $command: no command found\n") unless $arg;
	die("$0: $command: no command recognised\n") unless $aptgetcmds{$arg};
	push @argv, $arg;
	if ($aptgetcmds{$arg} == 2) {
		# Allow :  cl-asuser apt-get -f install
		if ($#ARGV < 0 && $arg ne "install") {
			die("$0: $command: Missing args for $arg\n");
		}
		while (defined($arg = shift(@ARGV))) {
			push @argv, $arg if defined $arg;
		}
	} elsif ($#ARGV >= 0) {
		die("$0: $command: Unexpected extra args for $arg: @ARGV\n");
	}
	&log_yum("Run: " . join(", ", @argv));
	print STDERR "# Run: " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
}

# -----------------------------------------------------------------------------

# Run a pkg_add command
sub sub_pkg_add {
	my @argv = ();
	my $pkgs = 0;	# command does not take a list of packages
	while (defined($arg = shift(@ARGV))) {
		my $args = $pkgaddflags{$arg};
		if ($args) {
			# OK -- pass it through
		# } elsif ($arg eq "-o" && $#ARGV > 0 && $ARGV[0] =~ /^DPkg::Options::=--force-conf(new|def)$/) {
		# 	push @argv, $arg;
		# 	$arg = shift(@ARGV);
		} elsif (defined($args)) {
			die("$0: $command does not allow flag $arg\n");
		} elsif ($arg =~ /^([^=]+=)/ && ($arge = $pkgaddflags{$1}) && $arge == 2) {
			# OK -- pass it through
		} elsif ($arg =~ /^-/) {
			die("$0: $command does not recognise flag $arg\n");
		} elsif (defined($pkgcmds{$arg})) {
			last;
		} elsif ($arg =~ /\//) {
			die("$0: $command does not allow path $arg\n");
		} elsif ($arg =~ /\.rpm$/) {
			die("$0: $command does not allow .rpm suffix on $arg\n");
		} else {
			last;
		}
		push @argv, $arg if defined $arg;
	}
	die("$0: $command: no package name found\n") unless $arg;
	push @argv, $arg;
	while (defined($arg = shift(@ARGV))) {
		push @argv, $arg if defined $arg;
	}
	&log_yum("Run: " . join(", ", @argv));
	print STDERR "# Run: " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
}
# -----------------------------------------------------------------------------

# Run a pkg command
sub sub_pkg {
	my @argv = ();
	my $pkgs = 0;	# command does not take a list of packages
	while (defined($arg = shift(@ARGV))) {
		my $args = $pkgflags{$arg};
		if ($args) {
			# OK -- pass it through
		# } elsif ($arg eq "-o" && $#ARGV > 0 && $ARGV[0] =~ /^DPkg::Options::=--force-conf(new|def)$/) {
		# 	push @argv, $arg;
		# 	$arg = shift(@ARGV);
		} elsif (defined($args)) {
			die("$0: $command does not allow flag $arg\n");
		} elsif ($arg =~ /^([^=]+=)/ && ($arge = $pkgaddflags{$1}) && $arge == 2) {
			# OK -- pass it through
		} elsif ($arg =~ /^-/) {
			die("$0: $command does not recognise flag $arg\n");
		} elsif ($arg =~ /\//) {
			die("$0: $command does not allow path $arg\n");
		} elsif ($arg =~ /\.rpm$/) {
			die("$0: $command does not allow .rpm suffix on $arg\n");
		} else {
			last;
		}
		push @argv, $arg if defined $arg;
	}
	die("$0: $command: no command found\n") unless $arg;
	die("$0: $command: no command recognised\n") unless $pkgcmds{$arg};
	push @argv, $arg;
	if ($aptgetcmds{$arg} == 2) {
		# Allow :  cl-asuser apt-get -f install
		if ($#ARGV < 0 && $arg ne "install") {
			die("$0: $command: Missing args for $arg\n");
		}
		while (defined($arg = shift(@ARGV))) {
			push @argv, $arg if defined $arg;
		}
	} elsif ($#ARGV >= 0) {
		die("$0: $command: Unexpected extra args for $arg: @ARGV\n");
	}
	&log_yum("Run: " . join(", ", @argv));
	print STDERR "# Run: " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
}

# -----------------------------------------------------------------------------

# Run an aptitude command
sub sub_aptitude {
	my @argv = ();
	my $pkgs = 0;	# command does not take a list of packages
	$arg = shift(@ARGV);
	die("$0: $command: no command found\n") unless $arg;
	die("$0: $command: no command recognised\n") unless $aptgetcmds{$arg};
	push @argv, $arg;
	if ($aptgetcmds{$arg} == 2) {
		if ($#ARGV < 0) {
			die("$0: $command: Missing args for $arg\n");
		}
		while (defined($arg = shift(@ARGV))) {
			push @argv, $arg if defined $arg;
		}
	} elsif ($#ARGV >= 0) {
		die("$0: $command: Unexpected extra args for $arg: @ARGV\n");
	}
	&log_yum("Run: " . join(", ", @argv));
	print STDERR "# Run: " , join(", ", @argv), " ($#ARGV, $#argv)\n" if $verbose;
	chdir "/" || die("$0: chdir / failed: $!\n");
	$rc = system($command, @argv);
	&log_yum("# $rc " . join(", ", @argv));
	exit($rc >> 8);
}

# -----------------------------------------------------------------------------

# generate a swap file
sub sub_dd {
	die("$0: Usage: $command if=/dev/zero of=/SWAP* bs=<n> count=<n>\n") unless $#ARGV == 3;
	my($if, $of, $bs, $count) = @ARGV;
	die("$0: Unexpected input '$if'\n") unless $if eq "if=/dev/zero";
	die("$0: Unexpected output '$of'\n") unless $of =~ /^of=\/SWAP[A-Za-z0-9.-]*$/;
	die("$0: Unexpected block size '$bs'\n") unless $bs =~ /^bs=\d+(|c|w|b|kB|K|NB|M|GB|G)$/;
	die("$0: Unexpected count '$count'\n") unless $count =~ /^count=\d+$/;
	exec($command, @ARGV);
}
# -----------------------------------------------------------------------------

# chown a file
sub sub_chown {
	die("$0: Usage: $command <owner> <file>\n") unless $#ARGV == 1;
	my($owner) = $ARGV[0];
	my($file) = $ARGV[1];
	die("$0: Unexpected owner '$owner'\n") unless $owner =~ /^[a-z0-9.-]*$/;
	die("$0: Unexpected file '$file'\n") unless $chown{$file};
	if ($chown{$file} == $CHOWN_GLOB) { @ARGV = ($owner, glob $file); }
	exec($command, @ARGV);
}


# -----------------------------------------------------------------------------

# chmod a file
sub sub_chmod {
	die("$0: Usage: $command <mode> <file>\n") unless $#ARGV == 1;
	my($mode) = $ARGV[0];
	my($file) = $ARGV[1];
	die("$0: Unexpected mode '$mode'\n") unless $mode =~ /^[a-z0-9.=+-]*$/;
	# Don't allow symbolic setting of setuid bit
	die("$0: Cannot set setuid bit '$mode'\n") if $mode =~ /^[au].*[+=].*[sgo]/;
	# Don't allow numeric setting of setuid bit
	die("$0: Cannot set setuid bit '$mode'\n") if $mode =~ /[4-7]\d\d\d$/;
	unless ($chmod{$file}) {
		if ($ireadthesource) {
			print STDERR "$0: the expected files are: ", join(", ", sort keys %chown), "\n";
		}
		die("$0: Unexpected file '$file'\n")
	}
	if ($chmod{$file} == $CHOWN_GLOB) { @ARGV = ($mode, glob $file); }
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# env:
sub sub_env {
	die("$0: Usage: $command\n") unless $#ARGV == -1;
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# usermod: add a user to a group (e.g. for sshfs)
sub sub_usermod {
	die("$0: Usage: $command -a --groups <group> <user>\n") unless $#ARGV == 3;
	my($all)	= $ARGV[0];
	my($groups)	= $ARGV[1];
	my($group)	= $ARGV[2];
	my($user)	= $ARGV[3];
	die("$0: First arg should be '-a' not '$all'\n") unless $all eq "-a";
	die("$0: Second arg should be '--groups' not '$groups'\n") unless $groups eq "--groups";
	die("$0: group '$group' not permitted\n") unless $usermod{$group};
	die("$0: user '$user' not alphanumeric\n") unless $user =~ /^[a-z][a-z0-9]*$/;
	exec($command, @ARGV);
}

# -----------------------------------------------------------------------------

# ipt_recent: manipulate the iptables recent info
# In /etc/sudoers neds:
#	##1 cl.cam.ac.uk: allow cl-asuser ipt_recent SSH self
#	Defaults env_keep += "SSH_CLIENT SSH_CONNECTION"
sub sub_ipt_recent {
	die("$0: Usage: $command <table> <data>\n") unless $#ARGV == 1;
	die("$0: First arg should be a file component not '$ARGV[0]'\n") unless $ARGV[0] =~ /^[A-Za-z0-9.-]+$/;
	if ($ARGV[1] =~ /^-?SSH_C$/) {
		my($IP1, $IP2) = ($ENV{'SSH_CLIENT'}, $ENV{'SSH_CONNECTION'});
		die("$0: Failed to find SSH_CLIENT and SSH_CONNECTION\n") unless $IP1 && $IP2;
		$IP1 =~ s/ .*//;
		$IP2 =~ s/ .*//;
		die("$0: SSH_CLIENT and SSH_CONNECTION addresses disagree: $IP1 vs $IP2\n") unless $IP1 eq $IP2;
		$ARGV[1] = $IP1;
	}
	die("$0: Second arg should be '[-]<IP address>' or 'clear' not '$ARGV[1]'\n") unless $ARGV[1] eq "clear" || $ARGV[1] =~ /^-?\d+\.\d+\.\d+\.\d+$/;
	my($file) = "/proc/net/ipt_recent/$ARGV[0]";
	print STDERR "$0: open $file\n" if $verbose;
	open(RECENT, ">$file") || die("$0: failed to open $file: $!\n");
	print STDERR "$0: write '$ARGV[1]' to $file\n" if $verbose;
	print RECENT $ARGV[1], "\n" || die("$0: write to $file failed: $!\n");
	print STDERR "$0: close $file\n" if $verbose;
	close(RECENT) || die("$0: failed to close $file: $!\n");
	print STDERR "$0: exit\n" if $verbose;
	exit(0);
}

# -----------------------------------------------------------------------------

# passwd: reset a user password IFF that user's PW is the same as root's,
sub sub_passwd {
	die("$0: Invalid user '$user'\n") unless $user =~ /^[a-z]+[0-9]*$/;
	my $filename = "/etc/shadow";
	my $cmd = "passwd $user";
	my $rootpw = 'NotFound';
	my $adminw = 'NotFound';

	$filename = "/etc/master.passwd" unless -e $filename;
	open(SHADOW, $filename) || die("$0: failed to open $filename: $!\n");
	print STDERR "$0: looking for $user in $filename\n" if $verbose;
	while (<SHADOW>) {
		chomp;
		@F=split(/:/);
		# print STDERR "# $F[0],$F[1]: $_\n";
		$rootpw = $F[1] if $F[0] eq "root";
		$adminw = $F[1] if $F[0] eq "localadmin";
		next unless $F[0] eq $user;
		# print STDERR "$0: found $user: $rootpw / $adminw vs $F[1]\n" if $verbose;
		die("$0: password for $user is too short\n") unless length($F[1]) > 1;
		die("$0: password for $user is not the same as for localadmin / root\n") unless $rootpw eq $F[1] || $adminw eq $F[1];
		exec($cmd);
		die("$0: failed to exec $cmd: $!\n");
	}
	close(SHADOW) || die("$0: failed to close $filename: $!\n");
	die("$0: failed to find $user in $filename\n");
}

# -----------------------------------------------------------------------------

# ssh wrong host: look for ssh calls from the wrong host
sub sub_ssh_wrong_host {
	die("$0: Invalid user '$user'\n") unless $user =~ /^[a-z]+[0-9]*$/;
	my (@files) = </var/log/secure* /var/log/auth.log*>;
	my ($regexp) = "Authentication tried for $user";
	die("$0: found no log files\n") unless $#files >= 0;
	print "$0: looking for $user in ", join(" ", @files), ":\n";
	foreach $file (@files) {
		if ($file =~ /\.gz$/) {
			system("gunzip < $file | grep '$regexp'");
		} else {
			system("< $file grep '$regexp'");
		}
	}
	exit(0);
}

# -----------------------------------------------------------------------------

sub format {
	my($offset, $item, $max, @items) = @_;
	my($pref) = " " x $offset;
	my($res) = $pref;
	my($len) = $offset;
	foreach $val (@items) {
		$ilen = length($val);
		if (($len + $ilen) > $max) {
			$res =~ s/  *$/\n$pref/;
			$len = $offset;
		} 
		$ilen = (int ($ilen / $item) +1) * $item;
		$len += $ilen;
		$res .= sprintf("%-${ilen}s", $val);
	}
	$res =~ s/  *$/\n/;
	return $res;
}

# -----------------------------------------------------------------------------

sub val {
	return "<UnDefined>" unless defined $_[0];
	return "<Null>" if $_[0] eq '';
	return $_[0];
}
