You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@vcl.apache.org by ar...@apache.org on 2015/04/22 20:41:03 UTC

svn commit: r1675454 - in /vcl/trunk/managementnode/lib/VCL/Module: OS.pm OS/Linux.pm OS/Linux/Ubuntu.pm OS/Windows.pm OS/Windows/Version_5.pm

Author: arkurth
Date: Wed Apr 22 18:41:02 2015
New Revision: 1675454

URL: http://svn.apache.org/r1675454
Log:
VCL-844
Added OS.pm::get_os_perl_package. Added Windows.pm::_get_os_perl_package which is called by OS.pm::get_os_perl_package.

Updated OS.pm::get_os_type to return 'linux-ubuntu' if Ubuntu is detected rather than just 'linux'.

Added generate_ssh_key_files,generate_ssh_public_key_string, and create_ssh_public_key_file subroutines to OS.pm. These are used to facilitate host to host copying of files for VM migrations.

Added hibernate subroutine to Linux.pm, Ubuntu.pm, Windows.pm, and Version_5.pm.

Added Windows.pm::enable_hibernation.

Added is_process_running and is_display_manager_running to Linux.pm. These are used by Ubuntu.pm::hibernate to overcome issues which cause hibernation to fail.

Added subroutines to Ubuntu.pm to help overcome issues with hibernation:
* grubenv_unset_recordfail
* install_package
* _install_package_helper
* simulate_install_package
* apt_get_update
* fix_debconf_db

VCL-860
Updated Linux.pm::create_user to display a warning if any output line begins with 'useradd:'.

Modified:
    vcl/trunk/managementnode/lib/VCL/Module/OS.pm
    vcl/trunk/managementnode/lib/VCL/Module/OS/Linux.pm
    vcl/trunk/managementnode/lib/VCL/Module/OS/Linux/Ubuntu.pm
    vcl/trunk/managementnode/lib/VCL/Module/OS/Windows.pm
    vcl/trunk/managementnode/lib/VCL/Module/OS/Windows/Version_5.pm

Modified: vcl/trunk/managementnode/lib/VCL/Module/OS.pm
URL: http://svn.apache.org/viewvc/vcl/trunk/managementnode/lib/VCL/Module/OS.pm?rev=1675454&r1=1675453&r2=1675454&view=diff
==============================================================================
--- vcl/trunk/managementnode/lib/VCL/Module/OS.pm (original)
+++ vcl/trunk/managementnode/lib/VCL/Module/OS.pm Wed Apr 22 18:41:02 2015
@@ -518,7 +518,7 @@ sub get_currentimage_txt_contents {
 		return;
 	}
 
-	my $computer_node_name   = $self->data->get_computer_node_name();
+	my $computer_node_name = $self->data->get_computer_node_name();
 
 	# Attempt to retrieve the contents of currentimage.txt
 	my $cat_command = "cat ~/currentimage.txt";
@@ -2783,7 +2783,7 @@ sub execute_new {
  Returns     : If successful: string
                If failed: false
  Description : Determines the OS type currently installed on the computer. It
-               returns 'windows' or 'linux'.
+               returns 'windows', 'linux', or 'linux-ubuntu'.
 
 =cut
 
@@ -2807,6 +2807,10 @@ sub get_os_type {
 		notify($ERRORS{'WARNING'}, 0, "error occurred attempting to determine OS type currently installed on $computer_node_name\ncommand: '$command'\noutput:\n" . join("\n", @$output));
 		return;
 	}
+	elsif (grep(/ubuntu/i, @$output)) {
+		notify($ERRORS{'DEBUG'}, 0, "Ubuntu Linux OS is currently installed on $computer_node_name, output:\n" . join("\n", @$output));
+		return 'linux-ubuntu';
+	}
 	elsif (grep(/linux/i, @$output)) {
 		notify($ERRORS{'DEBUG'}, 0, "Linux OS is currently installed on $computer_node_name, output:\n" . join("\n", @$output));
 		return 'linux';
@@ -2823,6 +2827,62 @@ sub get_os_type {
 
 #/////////////////////////////////////////////////////////////////////////////
 
+=head2 get_os_perl_package
+
+ Parameters  : $computer_name
+ Returns     : string
+ Description : Attempts to determine the Perl package which should be used to
+               control the computer.
+
+=cut
+
+sub get_os_perl_package {
+	my $computer_identifier = shift;
+	if (ref($computer_identifier)) {
+		$computer_identifier = shift
+	}
+	if (!$computer_identifier) {
+		notify($ERRORS{'WARNING'}, 0, "computer identifier argument not specified");
+		return;
+	}
+	
+	my $os = VCL::Module::create_object('VCL::Module::OS', { computer_identifier => $computer_identifier});
+	if (!$os) {
+		notify($ERRORS{'WARNING'}, 0, "unable to determine perl package to use for OS installed on $computer_identifier, OS object could not be created");
+		return;
+	}
+	
+	
+	my $command = "uname -a";
+	my ($exit_status, $output) = $os->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to determine OS installed on $computer_identifier");
+		return;
+	}
+	
+	my $os_perl_package;
+	if (grep(/Cygwin/i, @$output)) {
+		my $windows_os = VCL::Module::create_object('VCL::Module::OS::Windows', { computer_identifier => $computer_identifier});
+		if (!$windows_os) {
+			notify($ERRORS{'WARNING'}, 0, "unable to determine perl package to use for OS installed on $computer_identifier, Windows OS object could not be created");
+			return;
+		}
+		return $windows_os->_get_os_perl_package($os);
+	}
+	elsif (grep(/Ubuntu/i, @$output)) {
+		return "VCL::Module::OS::Linux::Ubuntu"
+	}
+	elsif (grep(/Linux/i, @$output)) {
+		return "VCL::Module::OS::Linux"
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to determine OS installed on $computer_identifier, unsupported output returned from '$command':\n" . join("\n", @$output));
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
 =head2 process_connect_methods
 
  Parameters  : $remote_ip (optional), $overwrite
@@ -4035,6 +4095,182 @@ sub get_cluster_info_file_path {
 	return $self->{cluster_info_file_path};
 }
 
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 generate_ssh_key_files
+
+ Parameters  : $private_key_file_path, $type (optional), $bits (optional), $comment (optional), $passphrase, $options (optional)
+ Returns     : boolean
+ Description : Calls ssh-keygen to generate an SSH private key file.
+
+=cut
+
+sub generate_ssh_key_files {
+	my $self = shift;
+	if (ref($self) !~ /VCL::Module::OS/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($private_key_file_path, $type, $bits, $comment, $passphrase, $options) = @_;
+	if (!$private_key_file_path) {
+		notify($ERRORS{'WARNING'}, 0, "private key file path argument was not specified");
+		return;
+	}
+	$type = 'rsa' unless $type;
+	$passphrase = '' unless $passphrase;
+	
+	my $computer_name = $self->data->get_computer_short_name();
+	
+	# Make sure the file does not already exist
+	if ($self->file_exists($private_key_file_path)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to generate SSH key, file already exists on $computer_name: $private_key_file_path");
+		return;
+	}
+	
+	my $command = "ssh-keygen -t $type -f \"$private_key_file_path\" -N \"$passphrase\"";
+	$command .= " -b $bits" if defined($bits);
+	$comment .= " $options" if defined($options);
+	
+	if (defined($comment)) {
+		$comment =~ s/\\*(["])/\\"$1/g;
+		$command .= " -C \"$comment\"";;
+	}
+	
+	my ($exit_status, $output) = $self->mn_os->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to generate SSH key on $computer_name: $command");
+		return;
+	}
+	elsif ($exit_status ne '0') {
+		notify($ERRORS{'WARNING'}, 0, "failed to generate SSH key on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+	else {
+		notify($ERRORS{'OK'}, 0, "generated SSH key on $computer_name: $private_key_file_path, command: $command");
+		return 1;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 generate_ssh_public_key_string
+
+ Parameters  : $private_key_file_path, $comment (optional)
+ Returns     : boolean
+ Description : Calls ssh-keygen to retrieve the corresponding SSH public key
+               from a private key file.
+
+=cut
+
+sub generate_ssh_public_key_string {
+	my $self = shift;
+	if (ref($self) !~ /VCL::Module::OS/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($private_key_file_path, $comment) = @_;
+	if (!$private_key_file_path) {
+		notify($ERRORS{'WARNING'}, 0, "private key file path argument was not specified");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_short_name();
+	
+	# Make sure the private key file exists
+	if (!$self->file_exists($private_key_file_path)) {
+		notify($ERRORS{'WARNING'}, 0, "unable to generate SSH public key, private key file does not exist on $computer_name: $private_key_file_path");
+		return;
+	}
+	
+	my $command = "ssh-keygen -y -f \"$private_key_file_path\"";
+	my ($exit_status, $output) = $self->mn_os->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to generate SSH public key string from $private_key_file_path on $computer_name");
+		return;
+	}
+	elsif ($exit_status ne '0') {
+		notify($ERRORS{'WARNING'}, 0, "failed to generate SSH public key string from $private_key_file_path on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+	
+	my ($ssh_public_key_string) = grep(/^ssh-.*/, @$output);
+	if ($ssh_public_key_string) {
+		if ($comment) {
+			if ($ssh_public_key_string !~ /=/) {
+				$ssh_public_key_string .= "==";
+			}
+			$ssh_public_key_string .= " $comment";
+		}
+		notify($ERRORS{'OK'}, 0, "generated SSH public key string from $private_key_file_path on $computer_name: $ssh_public_key_string");
+		return $ssh_public_key_string;
+	}
+	else {
+		notify($ERRORS{'OK'}, 0, "failed to generate SSH public key string from $private_key_file_path on $computer_name, output does not contain a line beginning with 'ssh-', command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 create_ssh_public_key_file
+
+ Parameters  : $private_key_file_path, $public_key_file_path, $comment (optional)
+ Returns     : boolean
+ Description : Calls ssh-keygen to retrieve the corresponding SSH public key
+               from a private key file and generates a file containing the
+               public key.
+
+=cut
+
+sub create_ssh_public_key_file {
+	my $self = shift;
+	if (ref($self) !~ /VCL::Module::OS/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($private_key_file_path, $public_key_file_path, $comment) = @_;
+	if (!$private_key_file_path) {
+		notify($ERRORS{'WARNING'}, 0, "private key file path argument was not specified");
+		return;
+	}
+	if (!$public_key_file_path) {
+		notify($ERRORS{'WARNING'}, 0, "public key file path argument was not specified");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_short_name();
+	
+	# Make sure the private key file exists
+	if (!$self->file_exists($private_key_file_path)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to generate SSH public key file, private key file does not exist on $computer_name: $private_key_file_path");
+		return;
+	}
+	
+	# Make sure the public key file does not exist
+	if ($self->file_exists($public_key_file_path)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to create SSH public key file, public key file already exists on $computer_name: $public_key_file_path");
+		return;
+	}
+	
+	my $public_key_string = $self->generate_ssh_public_key_string($private_key_file_path, $comment);
+	if (!$public_key_string) {
+		notify($ERRORS{'WARNING'}, 0, "failed to create SSH public key file: $public_key_file_path, public key string could not be retrieved from private key file: $private_key_file_path");
+		return;
+	}
+	
+	if ($self->create_text_file($public_key_file_path, $public_key_string)) {
+		notify($ERRORS{'DEBUG'}, 0, "created SSH public key file: $public_key_file_path");
+		return 1;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to create SSH public key file: $public_key_file_path");
+		return;
+	}
+}
+
 #///////////////////////////////////////////////////////////////////////////
 
 1;

Modified: vcl/trunk/managementnode/lib/VCL/Module/OS/Linux.pm
URL: http://svn.apache.org/viewvc/vcl/trunk/managementnode/lib/VCL/Module/OS/Linux.pm?rev=1675454&r1=1675453&r2=1675454&view=diff
==============================================================================
--- vcl/trunk/managementnode/lib/VCL/Module/OS/Linux.pm (original)
+++ vcl/trunk/managementnode/lib/VCL/Module/OS/Linux.pm Wed Apr 22 18:41:02 2015
@@ -2608,11 +2608,70 @@ sub shutdown {
 
 #/////////////////////////////////////////////////////////////////////////////
 
+=head2 hibernate
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Hibernates the computer.
+
+=cut
+
+sub hibernate {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my $computer_node_name = $self->data->get_computer_node_name();
+	
+	my $command = 'echo disk > /sys/power/state &';
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to hibernate $computer_node_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		notify($ERRORS{'OK'}, 0, "executed command to hibernate $computer_node_name: $command" . (scalar(@$output) ? "\noutput:\n" . join("\n", @$output) : ''));
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+	
+	# Wait for computer to power off
+	my $power_off = $self->provisioner->wait_for_power_off(300, 5);
+	if (!defined($power_off)) {
+		# wait_for_power_off result will be undefined if the provisioning module doesn't implement a power_status subroutine
+		notify($ERRORS{'OK'}, 0, "unable to determine power status of $computer_node_name from provisioning module, sleeping 1 minute to allow computer time to hibernate");
+		sleep 60;
+		return 1;
+	}
+	elsif (!$power_off) {
+		notify($ERRORS{'WARNING'}, 0, "$computer_node_name never powered off after executing hibernate command: $command");
+		return;
+	}
+	else {
+		notify($ERRORS{'DEBUG'}, 0, "$computer_node_name powered off after executing hibernate command");
+		return 1;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
 =head2 create_user
 
- Parameters  : 
+ Parameters  : $argument_hash_ref
  Returns     : boolean
- Description : 
+ Description : Creates a user on the computer. The argument hash reference
+               should be constructed as follows:
+					{
+						username => $username,
+						password => $password, (optional)
+						root_access => $root_access,
+						uid => $uid, (optional)
+						ssh_public_keys => $ssh_public_keys, (optional)
+					});
 
 =cut
 
@@ -2679,11 +2738,11 @@ sub create_user {
 				notify($ERRORS{'WARNING'}, 0, "failed to execute command to add user '$username' to $computer_node_name: '$useradd_command'");
 				return;
 			}
-			elsif (grep(/^useradd: warning/, @$useradd_output)) {
+			elsif (grep(/^useradd: /, @$useradd_output)) {
 				notify($ERRORS{'WARNING'}, 0, "warning detected on add user '$username' to $computer_node_name\ncommand: '$useradd_command'\noutput:\n" . join("\n", @$useradd_output));
 			}
 			else {
-				notify($ERRORS{'OK'}, 0, "added user '$username' to $computer_node_name");
+				notify($ERRORS{'OK'}, 0, "added user '$username' to $computer_node_name, output:" . (scalar(@$useradd_output) ? "\n" . join("\n", @$useradd_output) : ' <none>'));
 			}
 		}
 		else {
@@ -5627,6 +5686,173 @@ sub kill_process {
 	}
 }
 
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_process_running
+
+ Parameters  : $process_regex
+ Returns     : array or hash reference
+ Description : Determines if any processes matching the $process_regex
+               argument are running on the computer. The $process_regex must be
+               a valid Perl regular expression.
+               
+               The following command is used to determine if a process is
+               running:
+               ps -e -o pid,args | grep -P "$process_regex"
+               
+               The behavior is different than if the -P argument is not used.
+               The following characters must be escaped with a backslash in
+               order for a literal match to be found:
+               | ( ) [ ] . +
+               
+               If these are not escaped, grep will interpret them as the
+               corresponing regular expression operational character. For
+               example:
+               
+               To match this literal string:
+               |(foo)|
+               Pass this:
+               \|\(foo\)\|
+               
+               To match 'foo' or 'bar, pass this:
+               (foo|bar)
+               
+               To match a pipe character ('|'), followed by either 'foo' or
+               'bar, followed by another pipe character:
+               |foo|
+               Pass this:
+               \|(foo|bar)\|
+               
+               The return value differs based on how this subroutine is called.
+               If called in scalar context, a hash reference is returned. The
+               hash keys are PIDs and the values are the full name of the
+               process. If called in list context, an array is returned
+               containing the PIDs.
+
+=cut
+
+sub is_process_running {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	# Check the arguments
+	my ($process_regex) = @_;
+	if (!defined($process_regex)) {
+		notify($ERRORS{'WARNING'}, 0, "process regex pattern argument was not specified");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_short_name();
+	
+	my $command = "ps -e -o pid,args | grep -P \"$process_regex\"";
+	my ($exit_status, $output) = $self->execute($command, 0);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command on $computer_name to determine if process is running: $command");
+		return;
+	}
+	
+	my $processes_running = {};
+	for my $line (@$output) {
+		my ($pid, $process_name) = $line =~ /^\s*(\d+)\s*(.*[^\s])\s*/g;
+		
+		if (!defined($pid)) {
+			notify($ERRORS{'DEBUG'}, 0, "ignoring line, it does not begin with a number: '$line'");
+			next;
+		}
+		elsif ($pid eq $PID) {
+			#notify($ERRORS{'DEBUG'}, 0, "ignoring line for the currently running process: $line");
+			next;
+		}
+		elsif ($line =~ /grep -P/) {
+			#notify($ERRORS{'DEBUG'}, 0, "ignoring line containing for this command: $line");
+			next;
+		}
+		elsif ($line =~ /sh -c/) {
+			# Ignore lines containing 'sh -c', probably indicating a duplicate process of a command run remotely
+			#notify($ERRORS{'DEBUG'}, 0, "ignoring containing 'sh -c': $line");
+			next;
+		}
+		else {
+			#notify($ERRORS{'DEBUG'}, 0, "found matching process: $line");
+			$processes_running->{$pid} = $process_name;
+		}
+	}
+	
+	my $process_count = scalar(keys %$processes_running);
+	if ($process_count) {
+		if (wantarray) {
+			my @process_ids = sort keys %$processes_running;
+			notify($ERRORS{'DEBUG'}, 0, "process is running on $computer_name, identifier: '$process_regex', returning array containing PIDs: @process_ids");
+			return @process_ids;
+		}
+		else {
+			notify($ERRORS{'DEBUG'}, 0, "process is running on $computer_name, identifier: '$process_regex', returning hash reference:\n" . format_data($processes_running));
+			return $processes_running;
+		}
+	}
+	else {
+		notify($ERRORS{'DEBUG'}, 0, "process is NOT running on $computer_name, identifier: '$process_regex', command: $command");
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_display_manager_running
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Checks if a display manager (GUI) is running on the computer.
+
+=cut
+
+sub is_display_manager_running {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_short_name();
+	
+	# Note: runlevel isn't reliable for all distros
+	# On Ubuntu, it displays 2 even if the GUI is running
+	
+	my $process_pattern;
+	
+	# CentOS "Welcome" screen
+	#  1700 /usr/bin/Xorg :9 -ac -nolisten tcp vt6 -br
+	
+	# ' 416 lightdm'
+	# '2955 lightdm --session-child 12 21'
+	$process_pattern .= '^\s*\d+\s+(kdm|lightdm)(\s|$)';
+	
+	# Gnome
+	# 1870 /usr/sbin/gdm-binary -nodaemon
+	# 1898 /usr/libexec/gdm-simple-slave --display-id /org/gnome/DisplayManager/Display1
+	# 1901 /usr/bin/Xorg :0 -br -verbose -audit 4 -auth /var/run/gdm/auth-for-gdm-laIZj5/database -nolisten tcp vt1
+	# 1989 /usr/bin/gnome-session --autostart=/usr/share/gdm/autostart/LoginWindow/
+	$process_pattern .= '|(gnome-session|gdm-binary)';
+	
+	# ' 2891 /usr/bin/X -core :0 -seat seat0 -auth /var/run/lightdm/root/:0 -nolisten tcp vt7 -novtswitch'
+	$process_pattern .= '|bin\/X';
+	
+	$process_pattern = "($process_pattern)";
+	
+	my $process_info = $self->is_process_running($process_pattern);
+	if ($process_info) {
+		notify($ERRORS{'DEBUG'}, 0, "display manager is running on $computer_name:\n" . format_data($process_info));
+		return 1;
+	}
+	else {
+		notify($ERRORS{'DEBUG'}, 0, "display manager is not running on $computer_name");
+		return 0
+	}
+}
+
 ##/////////////////////////////////////////////////////////////////////////////
 1;
 __END__

Modified: vcl/trunk/managementnode/lib/VCL/Module/OS/Linux/Ubuntu.pm
URL: http://svn.apache.org/viewvc/vcl/trunk/managementnode/lib/VCL/Module/OS/Linux/Ubuntu.pm?rev=1675454&r1=1675453&r2=1675454&view=diff
==============================================================================
--- vcl/trunk/managementnode/lib/VCL/Module/OS/Linux/Ubuntu.pm (original)
+++ vcl/trunk/managementnode/lib/VCL/Module/OS/Linux/Ubuntu.pm Wed Apr 22 18:41:02 2015
@@ -894,6 +894,477 @@ sub activate_interfaces {
 }
 
 #/////////////////////////////////////////////////////////////////////////////
+
+=head2 hibernate
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Hibernates the computer.
+
+=cut
+
+sub hibernate {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	# Notes (ARK): Ubuntu 14+ seems to have issues hibernating. The machine's
+	# console may turn into a black screen with a blinking cursor if the GUI
+	# isn't running and SSH access may become unavailable. I haven't found a way
+	# to recover from this when it happens without a hard reset.
+
+	my $computer_name = $self->data->get_computer_node_name();
+	
+	# Make sure pm-hibernate command exists
+	if (!$self->command_exists('pm-hibernate')) {
+		if (!$self->install_package('pm-utils')) {
+			notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_name, pm-hibernate command does not exist and pm-utils could not be installed");
+			return;
+		}
+	}
+	
+	# Ubuntu seems to have problems hibernating if a display manager isn't running
+	# If it is not running, attempt to install and start lightdm
+	if (!$self->is_display_manager_running()) {
+		#if (!$self->install_package('xfce4')) {
+		#	notify($ERRORS{'WARNING'}, 0, "hibernation of $computer_name not attempted, display manager/GUI is not running, failed to install xfce4");
+		#	return;
+		#}
+		if (!$self->install_package('lightdm')) {
+			notify($ERRORS{'WARNING'}, 0, "hibernation of $computer_name not attempted, display manager/GUI is not running, failed to install xfce4");
+			return;
+		}
+		if (!$self->start_service('lightdm')) {
+			notify($ERRORS{'WARNING'}, 0, "hibernation of $computer_name not attempted, display manager/GUI is not running, failed to start lightdm service");
+			return;
+		}
+		if (!$self->is_display_manager_running()) {
+			notify($ERRORS{'WARNING'}, 0, "hibernation of $computer_name not attempted, unable to verify display manager/GUI is running, hibernate may fail to shut down the computer unless GUI is running");
+			return;
+		}
+	}
+	
+	# Delete old log files
+	$self->delete_file('/var/log/pm-*');
+	
+	# Try to determine if NetworkManager or network service is being used
+	my $network_service_name = 'network';
+	if ($self->service_exists('network-manager')) {
+		$network_service_name = 'network-manager';
+	}
+	
+	my $private_interface_name = $self->get_private_interface_name() || 'eth0';
+	my $public_interface_name = $self->get_public_interface_name() || 'eth1';
+	
+	# Some versions of Ubuntu fail to respond after resuming from hibernation
+	# Networking is up but not responding
+	# Add script to restart networking service
+	my $fix_network_script_path = '/etc/pm/sleep.d/50_restart_networking';
+	my $fix_network_log_path = '/var/log/50_restart_networking.log';
+	
+	$self->delete_file($fix_network_log_path);
+	
+	my $fix_network_script_contents = <<"EOF";
+#!/bin/sh
+echo >> /var/log/50_restart_networking.log
+date -R >> /var/log/50_restart_networking.log
+echo "\$1: begin" >> /var/log/50_restart_networking.log
+
+case "\$1" in
+   hibernate)
+      ifdown $private_interface_name 2>&1 >> /var/log/50_restart_networking.log
+      ifdown $public_interface_name 2>&1 >> /var/log/50_restart_networking.log
+      initctl stop $network_service_name 2>&1 >> /var/log/50_restart_networking.log
+      modprobe -r vmxnet3 2>&1 >> /var/log/50_restart_networking.log
+      ;;
+   thaw)
+      modprobe vmxnet3 2>&1 >> /var/log/50_restart_networking.log
+      initctl restart $network_service_name 2>&1 >> /var/log/50_restart_networking.log
+      ifup $private_interface_name 2>&1 >> /var/log/50_restart_networking.log
+      ifup $public_interface_name 2>&1 >> /var/log/50_restart_networking.log
+      ;;
+esac
+
+echo "\$1: done" >> $fix_network_log_path
+date -R >> /var/log/50_restart_networking.log
+EOF
+	if (!$self->create_text_file($fix_network_script_path, $fix_network_script_contents)) {
+		notify($ERRORS{'WARNING'}, 0, "hibernate not attempted, failed to create $fix_network_script_path on $computer_name in order to prevent networking problems after computer is powered back on");
+		return;
+	}
+	if (!$self->set_file_permissions($fix_network_script_path, '755')) {
+		notify($ERRORS{'WARNING'}, 0, "hibernate not attempted, failed to set file permissions on $fix_network_script_path on $computer_name, networking problems may occur after computer is powered back on");
+		return;
+	}
+	
+	# Make sure the grubenv recordfail flag is not set
+	if (!$self->unset_grubenv_recordfail()) {
+		notify($ERRORS{'WARNING'}, 0, "hibernate not attempted, failed to unset grubenv recordfail flag, computer may hang on grub boot screen after it is powered back on");
+		return;
+	}
+	
+	my $command = 'pm-hibernate';
+	#$command .= ' --quirk-dpms-on' 				if ($computer_name =~ /32$/);
+	#$command .= ' --quirk-dpms-suspend' 		if ($computer_name =~ /33$/);
+	#$command .= ' --quirk-radeon-off' 			if ($computer_name =~ /34$/);
+	#$command .= ' --quirk-s3-bios' 				if ($computer_name =~ /35$/);
+	#$command .= ' --quirk-s3-mode' 				if ($computer_name =~ /36$/);
+	#$command .= ' --quirk-vbe-post' 				if ($computer_name =~ /37$/);
+	#$command .= ' --quirk-vbemode-restore' 	if ($computer_name =~ /38$/);
+	#$command .= ' --quirk-vbestate-restore' 	if ($computer_name =~ /39$/);
+	#$command .= ' --quirk-vga-mode-3' 			if ($computer_name =~ /40$/);
+	#$command .= ' --quirk-save-pci' 				if ($computer_name =~ /41$/);
+	#$command .= ' --store-quirks-as-lkw' 		if ($computer_name =~ /42$/);
+	$command .= ' &';
+	
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to hibernate $computer_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		notify($ERRORS{'OK'}, 0, "executed command to hibernate $computer_name: $command" . (scalar(@$output) ? "\noutput:\n" . join("\n", @$output) : ''));
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+	
+	# Wait for computer to power off
+	my $power_off = $self->provisioner->wait_for_power_off(300, 5);
+	if (!defined($power_off)) {
+		# wait_for_power_off result will be undefined if the provisioning module doesn't implement a power_status subroutine
+		notify($ERRORS{'OK'}, 0, "unable to determine power status of $computer_name from provisioning module, sleeping 1 minute to allow computer time to hibernate");
+		sleep 60;
+		return 1;
+	}
+	elsif (!$power_off) {
+		notify($ERRORS{'WARNING'}, 0, "$computer_name never powered off after executing hibernate command: $command");
+		return;
+	}
+	else {
+		notify($ERRORS{'DEBUG'}, 0, "$computer_name powered off after executing hibernate command");
+		return 1;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 grubenv_unset_recordfail
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Unsets the grub "recordfail" flag. If this is set, the computer
+               may hang at the grub boot screen when rebooted.
+
+=cut
+
+sub unset_grubenv_recordfail {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_node_name();
+	
+	if (!$self->command_exists('grub-editenv')) {
+		return 1;
+	}
+	
+	my $command = "grub-editenv /boot/grub/grubenv unset recordfail";
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to unset grubenv recordfail on $computer_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		notify($ERRORS{'OK'}, 0, "unset grubenv recordfail on $computer_name, command: '$command'" . (scalar(@$output) ? "\noutput:\n" . join("\n", @$output) : ''));
+		return 1;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to unset grubenv recordfail on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 install_package
+
+ Parameters  : $package_name
+ Returns     : boolean
+ Description : Installs a Linux package using apt-get.
+
+=cut
+
+sub install_package {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($package_name) = @_;
+	if (!$package_name) {
+		notify($ERRORS{'WARNING'}, 0, "package name argument was not supplied");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_node_name();
+	
+	# Run apt-get update before installing package - only do this once
+	$self->apt_get_update();
+	
+	# Some packages are known to cause debconf database errors
+	# Check if package being installed will also install/update a package with known problems
+	# Attempt to fix the debconf database if any are found
+	my @simulate_lines = $self->simulate_install_package($package_name);
+	if (@simulate_lines) {
+		my @problematic_packages = grep { $_ =~ /(dictionaries-common)/; $_ = $1; } @simulate_lines;
+		if (@problematic_packages) {
+			@problematic_packages = remove_array_duplicates(@problematic_packages);
+			notify($ERRORS{'DEBUG'}, 0, "installing $package_name requires the following packages to be installed which are known to have problems with the debconf database, attempting to fix the debconf database first:\n" . join("\n", @problematic_packages));
+			for my $problematic_package (@problematic_packages) {
+				$self->fix_debconf_db();
+				$self->_install_package_helper($problematic_package);
+			}
+			$self->fix_debconf_db();
+		}
+	}
+	
+	my $attempt = 0;
+	my $attempt_limit = 2;
+	for (my $attempt = 1; $attempt <= $attempt_limit; $attempt++) {
+		my $attempt_string = ($attempt > 1 ? "attempt $attempt/$attempt_limit: " : '');
+		if ($self->_install_package_helper($package_name, $attempt_string)) {
+			return 1;
+		}
+	}
+	
+	notify($ERRORS{'WARNING'}, 0, "failed to install $package_name on $computer_name, made $attempt_limit attempts");
+	return;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _install_package_helper
+
+ Parameters  : $package_name, $attempt_string (optional)
+ Returns     : boolean
+ Description : Helper subroutine to install_package. Executes command to
+               installs a Linux package using apt-get.
+
+=cut
+
+sub _install_package_helper {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($package_name, $attempt_string) = @_;
+	if (!$package_name) {
+		notify($ERRORS{'WARNING'}, 0, "package name argument was not supplied");
+		return;
+	}
+	$attempt_string = '' unless defined($attempt_string);
+	
+	my $computer_name = $self->data->get_computer_node_name();
+	
+	my $command = "apt-get -qq -y install $package_name";
+	notify($ERRORS{'DEBUG'}, 0, $attempt_string . "installing package on $computer_name: $package_name");
+	my ($exit_status, $output) = $self->execute($command, 0, 300);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, $attempt_string . "failed to execute command to install $package_name on $computer_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		if (grep(/$package_name is already/, @$output)) {
+			notify($ERRORS{'OK'}, 0, $attempt_string . "$package_name is already installed on $computer_name");
+		}
+		else {
+			notify($ERRORS{'OK'}, 0, $attempt_string . "installed $package_name on $computer_name");
+		}
+		return 1;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, $attempt_string . "failed to install $package_name on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return 0;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 simulate_install_package
+
+ Parameters  : $package_name
+ Returns     : array
+ Description : Simulates the installation of a Linux package using apt-get.
+               Returns the output lines as an array.
+
+=cut
+
+sub simulate_install_package {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($package_name) = @_;
+	if (!$package_name) {
+		notify($ERRORS{'WARNING'}, 0, "package name argument was not supplied");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_node_name();
+	
+	my $command = "apt-get -s install $package_name";
+	notify($ERRORS{'DEBUG'}, 0, "attempting to simulate the installation of $package_name on $computer_name");
+	my ($exit_status, $output) = $self->execute($command, 0, 300);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to simulate the installation of $package_name on $computer_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		#notify($ERRORS{'DEBUG'}, 0, "simulated the installation of $package_name on $computer_name, output:\n" . join("\n", @$output));
+		return @$output;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to simulate the installation of $package_name on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 apt_get_update
+
+ Parameters  : $force (optional)
+ Returns     : boolean
+ Description : Runs 'apt-get update' to resynchronize package index files from
+               their sources. By default, this will only be executed once. The
+               $force argument will cause apt-get update to be executed even if
+               it was previously executed.
+
+=cut
+
+sub apt_get_update {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my ($force) = @_;
+	
+	return 1 if (!$force && $self->{apt_get_update});
+	
+	my $computer_name = $self->data->get_computer_node_name();
+	
+	# Clear out the files under lists to try to avoid these errors:
+	#    W: Failed to fetch http://us.archive.ubuntu.com/ubuntu/dists/trusty-updates/universe/i18n/Translation-en  Hash Sum mismatch
+	#    E: Some index files failed to download. They have been ignored, or old ones used instead.
+	$self->delete_file('/var/lib/apt/lists/*');
+	
+	notify($ERRORS{'DEBUG'}, 0, "executing 'apt-get update' on $computer_name");
+	my $command = "apt-get -qq update";
+	my ($exit_status, $output) = $self->execute($command, 0, 300);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute 'apt-get update' on $computer_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		notify($ERRORS{'OK'}, 0, "executed 'apt-get update' on $computer_name");
+		$self->{apt_get_update} = 1;
+		return 1;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute 'apt-get update' on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 fix_debconf_db
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Executes /usr/share/debconf/fix_db.pl to attempt to fix problems
+               installing packages via apt-get.
+
+=cut
+
+sub fix_debconf_db {
+	my $self = shift;
+	if (ref($self) !~ /linux/i) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+	
+	my $computer_name = $self->data->get_computer_node_name();
+
+	# Setting up dictionaries-common (1.20.5) ...
+	# debconf: unable to initialize frontend: Dialog
+	# debconf: (TERM is not set, so the dialog frontend is not usable.)
+	# debconf: falling back to frontend: Readline
+	# debconf: unable to initialize frontend: Readline
+	# debconf: (This frontend requires a controlling tty.)
+	# debconf: falling back to frontend: Teletype
+	# update-default-wordlist: Question empty but elements installed for class "wordlist"
+	# dictionaries-common/default-wordlist: return code: "0", value: ""
+	# Choices: , Manual symlink setting
+	# shared/packages-wordlist: return code: "10" owners/error: "shared/packages-wordlist doesn't exist"
+	# Installed elements: english (Webster's Second International English wordlist)
+	# Please see "/usr/share/doc/dictionaries-common/README.problems", section
+	# "Debconf database corruption" for recovery info.
+	# update-default-wordlist: Selected wordlist ""
+	# does not correspond to any installed package in the system
+	# and no alternative wordlist could be selected.
+	# dpkg: error processing package dictionaries-common (--configure):
+	# subprocess installed post-installation script returned error exit status 255
+
+	my $command = "/usr/share/debconf/fix_db.pl";
+	my $attempt = 0;
+	my $attempt_limit = 5;
+	while ($attempt < $attempt_limit) {
+		$attempt++;
+		
+		my ($exit_status, $output) = $self->execute($command, 0, 60);
+		if (!defined($output)) {
+			notify($ERRORS{'WARNING'}, 0, "failed to execute command to attempt to fix debconf database on $computer_name: $command");
+			return;
+		}
+		
+		# This command occasionally needs to be run multiple times to fix all problems
+		# If output contains a line such as the following, run it again:
+		#    debconf: template "base-passwd/user-change-uid" has no owners; removing it.
+		if ($exit_status == 0) {
+			my @lines = grep(/^debconf: /, @$output);
+			my $line_count = scalar(@lines);
+			if ($line_count) {
+				notify($ERRORS{'DEBUG'}, 0, "attempt $attempt/$attempt_limit: executed command to fix debconf database on $computer_name, $line_count problems were detected and/or fixed, another attempt will be made");
+				next;
+			}
+			else {
+				notify($ERRORS{'DEBUG'}, 0, "attempt $attempt/$attempt_limit: no debconf database problems were detected on $computer_name");
+				return 1;
+			}
+		}
+		else {
+			notify($ERRORS{'WARNING'}, 0, "attempt $attempt/$attempt_limit: failed to execute command to fix debconf database on $computer_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+			return;
+		}
+	}
+	
+}
+
+#/////////////////////////////////////////////////////////////////////////////
 1;
 __END__
 

Modified: vcl/trunk/managementnode/lib/VCL/Module/OS/Windows.pm
URL: http://svn.apache.org/viewvc/vcl/trunk/managementnode/lib/VCL/Module/OS/Windows.pm?rev=1675454&r1=1675453&r2=1675454&view=diff
==============================================================================
--- vcl/trunk/managementnode/lib/VCL/Module/OS/Windows.pm (original)
+++ vcl/trunk/managementnode/lib/VCL/Module/OS/Windows.pm Wed Apr 22 18:41:02 2015
@@ -9954,6 +9954,57 @@ sub set_device_path_key {
 
 #/////////////////////////////////////////////////////////////////////////////
 
+=head2 enable_hibernation
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Enables the hibernation feature.
+
+=cut
+
+sub enable_hibernation {
+	my $self = shift;
+	unless (ref($self) && $self->isa('VCL::Module')) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine can only be called as a VCL::Module module object method");
+		return;
+	}
+	
+	my $computer_node_name = $self->data->get_computer_node_name();
+	my $system32_path = $self->get_system32_path() || return;
+	
+	# Rename disableGuestHibernate.dll if it exists, this can prevent hibernation from working as expected
+	my $disable_hibernate_file_path = 'C:\Program Files\VMware\VMware Tools\plugins\vmsvc\disableGuestHibernate.dll';
+	if ($self->file_exists($disable_hibernate_file_path)) {
+		$self->move_file($disable_hibernate_file_path, "$disable_hibernate_file_path.disabled");
+	}
+	
+	# Run powercfg.exe to enable hibernation
+	my $command = "$system32_path/powercfg.exe -HIBERNATE ON";
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to enable hibernation on $computer_node_name");
+		return;
+	}
+	elsif ($exit_status == 0) {
+		notify($ERRORS{'OK'}, 0, "enabled hibernation on $computer_node_name" . (scalar(@$output) ? ", output:\n" . join("\n", @$output) : ''));
+	}
+	elsif (grep(/PAE mode/i, @$output)) {
+		# The following may be displayed:
+		#    Hibernation failed with the following error: The request is not supported.
+		#    The following items are preventing hibernation on this system.
+		#    The system is running in PAE mode, and hibernation is not allowed in PAE mode.
+		notify($ERRORS{'OK'}, 0, "hibernation NOT enabled because $computer_node_name is running in PAE mode");
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to enable hibernation on $computer_node_name, exit status: $exit_status, output:\n" . join("\n", @$output));
+		return;
+	}
+	
+	return 1;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
 =head2 disable_hibernation
 
  Parameters  : None
@@ -9970,28 +10021,34 @@ sub disable_hibernation {
 		return;
 	}
 	
-	my $computer_node_name   = $self->data->get_computer_node_name();
-	my $system32_path        = $self->get_system32_path() || return;
-
+	my $computer_node_name = $self->data->get_computer_node_name();
+	my $system32_path = $self->get_system32_path() || return;
+	
+	# Rename disableGuestHibernate.dll if it exists, this can prevent hibernation from working as expected
+	my $disable_hibernate_file_path = 'C:\Program Files\VMware\VMware Tools\plugins\vmsvc\disableGuestHibernate.dll';
+	if ($self->file_exists($disable_hibernate_file_path)) {
+		$self->move_file($disable_hibernate_file_path, "$disable_hibernate_file_path.disabled");
+	}
+	
 	# Run powercfg.exe to disable hibernation
-	my $powercfg_command = "$system32_path/powercfg.exe -HIBERNATE OFF";
-	my ($powercfg_exit_status, $powercfg_output) = $self->execute($powercfg_command, 1);
-	if (defined($powercfg_exit_status) && $powercfg_exit_status == 0) {
-		notify($ERRORS{'OK'}, 0, "disabled hibernation");
+	my $command = "$system32_path/powercfg.exe -HIBERNATE OFF";
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to disable hibernation on $computer_node_name");
+		return;
+	}
+	elsif ($exit_status == 0) {
+		notify($ERRORS{'OK'}, 0, "disabled hibernation on $computer_node_name" . (scalar(@$output) ? ", output:\n" . join("\n", @$output) : ''));
 	}
-	elsif (grep(/PAE mode/i, @$powercfg_output)) {
+	elsif (grep(/PAE mode/i, @$output)) {
 		# The following may be displayed:
 		#    Hibernation failed with the following error: The request is not supported.
 		#    The following items are preventing hibernation on this system.
 		#    The system is running in PAE mode, and hibernation is not allowed in PAE mode.
 		notify($ERRORS{'OK'}, 0, "hibernation NOT disabled because $computer_node_name is running in PAE mode");
 	}
-	elsif ($powercfg_exit_status) {
-		notify($ERRORS{'WARNING'}, 0, "failed to disable hibernation, exit status: $powercfg_exit_status, output:\n" . join("\n", @$powercfg_output));
-		return;
-	}
 	else {
-		notify($ERRORS{'WARNING'}, 0, "failed to run SSH command to disable hibernation");
+		notify($ERRORS{'WARNING'}, 0, "failed to disable hibernation on $computer_node_name, exit status: $exit_status, output:\n" . join("\n", @$output));
 		return;
 	}
 	
@@ -10006,6 +10063,60 @@ sub disable_hibernation {
 
 #/////////////////////////////////////////////////////////////////////////////
 
+=head2 hibernate
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Hibernate the computer.
+
+=cut
+
+sub hibernate {
+	my $self = shift;
+	unless (ref($self) && $self->isa('VCL::Module')) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine can only be called as a VCL::Module module object method");
+		return;
+	}
+	
+	my $computer_node_name = $self->data->get_computer_node_name();
+	my $system32_path = $self->get_system32_path() || return;
+	
+	if (!$self->enable_hibernation()) {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, hibernation could not be enabled");
+		return;
+	}
+	
+	# Run powercfg.exe to enable hibernation
+	my $command = "/bin/cygstart.exe \$SYSTEMROOT/system32/cmd.exe /c \"$system32_path/shutdown.exe -h -f\"";
+	my $start_time = time;
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to hibernate $computer_node_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		notify($ERRORS{'OK'}, 0, "executed command to hibernate $computer_node_name: $command" . (scalar(@$output) ? "\noutput:\n" . join("\n", @$output) : ''));
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, exit status: $exit_status, command:\n$command\noutput:\n" . join("\n", @$output));
+		return;
+	}
+	
+	# Wait for the computer to stop responding
+	my $wait_seconds = 300;
+	if ($self->provisioner->wait_for_power_off($wait_seconds, 3)) {
+		my $duration = (time - $start_time);
+		notify($ERRORS{'DEBUG'}, 0, "hibernate successful, $computer_node_name stopped responding after $duration seconds");
+		return 1;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, still responding to ping after $wait_seconds seconds");
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
 =head2 disable_ceip
 
  Parameters  : None
@@ -12291,6 +12402,43 @@ sub set_computer_hostname {
 }
 
 #/////////////////////////////////////////////////////////////////////////////
+
+=head2 _get_os_perl_package
+
+ Parameters  : $windows_os
+ Returns     : string
+ Description : 
+
+=cut
+
+sub _get_os_perl_package {
+	my $windows_os = shift;
+	unless (ref($windows_os) && $windows_os->isa('VCL::Module')) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+		return;
+	}
+
+	my $product_name = $windows_os->get_product_name();
+	my $perl_package;
+	if (!$product_name) {
+		return;
+	}
+	elsif ($product_name =~ /(XP|2003)/i) {
+		$perl_package = "VCL::Module::OS::Windows::Version_5::$1";
+	}
+	elsif ($product_name =~ /(Vista|2008|2012|7|8)/ig) {
+		$perl_package = "VCL::Module::OS::Windows::Version_6::$1";
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to determine OS installed on computer, unsupported Windows product name: $product_name");
+		return;
+	}
+	
+	notify($ERRORS{'DEBUG'}, 0, "perl package to use for '$product_name': $perl_package");
+	return $perl_package;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
 
 1;
 __END__

Modified: vcl/trunk/managementnode/lib/VCL/Module/OS/Windows/Version_5.pm
URL: http://svn.apache.org/viewvc/vcl/trunk/managementnode/lib/VCL/Module/OS/Windows/Version_5.pm?rev=1675454&r1=1675453&r2=1675454&view=diff
==============================================================================
--- vcl/trunk/managementnode/lib/VCL/Module/OS/Windows/Version_5.pm (original)
+++ vcl/trunk/managementnode/lib/VCL/Module/OS/Windows/Version_5.pm Wed Apr 22 18:41:02 2015
@@ -757,6 +757,60 @@ sub disable_sleep {
 
 #/////////////////////////////////////////////////////////////////////////////
 
+=head2 hibernate
+
+ Parameters  : none
+ Returns     : boolean
+ Description : Hibernate the computer.
+
+=cut
+
+sub hibernate {
+	my $self = shift;
+	unless (ref($self) && $self->isa('VCL::Module')) {
+		notify($ERRORS{'CRITICAL'}, 0, "subroutine can only be called as a VCL::Module module object method");
+		return;
+	}
+	
+	my $computer_node_name = $self->data->get_computer_node_name();
+	my $system32_path = $self->get_system32_path() || return;
+	
+	if (!$self->enable_hibernation()) {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, hibernation could not be enabled");
+		return;
+	}
+	
+	# Run powercfg.exe to enable hibernation
+	my $command = "/bin/cygstart.exe \$SYSTEMROOT/system32/cmd.exe /c \"$system32_path/rundll32.exe powrprof.dll,SetSuspendState\"";
+	my $start_time = time;
+	my ($exit_status, $output) = $self->execute($command);
+	if (!defined($output)) {
+		notify($ERRORS{'WARNING'}, 0, "failed to execute command to hibernate $computer_node_name");
+		return;
+	}
+	elsif ($exit_status eq 0) {
+		notify($ERRORS{'OK'}, 0, "executed command to hibernate $computer_node_name:\n$command" . (scalar(@$output) ? "\noutput:\n" . join("\n", @$output) : ''));
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, exit status: $exit_status, output:\n" . join("\n", @$output));
+		return;
+	}
+	
+	# Wait for the computer to stop responding
+	my $wait_seconds = 300;
+	if ($self->provisioner->wait_for_power_off($wait_seconds, 3)) {
+		my $duration = (time - $start_time);
+		notify($ERRORS{'DEBUG'}, 0, "hibernate successful, $computer_node_name stopped responding after $duration seconds");
+		return 1;
+	}
+	else {
+		notify($ERRORS{'WARNING'}, 0, "failed to hibernate $computer_node_name, still responding to ping after $wait_seconds seconds");
+		return;
+	}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
 1;
 __END__