#!/usr/bin/perl -w -Iblib/arch -Iblib/lib -I/usr/lib/perl5/5.6.0/i386-linux -I/usr/lib/perl5/5.6.0 -I. 
#
# Copyright 1998 VMware, Inc.  All rights reserved. -- VMware Confidential
#

# maps each constant type to a hash which in turn maps user params or return result to meaningful strings
my %constantmap = (
          'VM_EXECUTION_STATE' => {
                                    '1' => 'on',
                                    '2' => 'off',
                                    '3' => 'suspended',
                                    '4' => 'stuck',
                                    '5' => 'unknown'
                                  },
          'VM_TIMEOUT_ID' => {
                               'default' => '1'
                             },
          'VM_PRODUCT' => {
                            '1' => 'ws',
                            '2' => 'gsx',
                            '3' => 'esx',
                            '4' => 'unknown'
                          },
          'VM_PLATFORM' => {
                             '1' => 'windows',
                             '2' => 'linux',
                             '3' => 'vmnix',
                             '4' => 'unknown'
                           },
          'VM_POWEROP_MODE' => {
                                 'hard' => '1',
                                 'soft' => '2',
                                 'trysoft' => '3'
                               },
          'VM_PRODINFO' => {
                             'product' => '1',
                             'platform' => '2',
                             'build' => '3',
                             'majorversion' => '4',
                             'minorversion' => '5',
                             'revision' => '6'
                           },
        );


my @vm_usage_order = qw(getstate start stop reset suspend setconfig getconfig setguestinfo 
                        getguestinfo getproductinfo connectdevice
                        disconnectdevice getconfigfile getheartbeat getuptime
                        gettoolslastactive getresource setresource 
                        hassnapshot createsnapshot revertsnapshot removesnapshots
                        answer);
my %vm_operations = 
(
 #
 # "operation"        => [real_operation_name, returnmap_type, (parameter_type,)* description]
 #
 "answer"             => [undef, undef, "answers a question for a VM requesting input"],
 "getstate"           => ["get_execution_state", "VM_EXECUTION_STATE", "gets the execution state of the VM"],
 "start"              => [undef, undef, "VM_POWEROP_MODE", "powers on or resumes a VM"],
 "stop"               => [undef, undef, "VM_POWEROP_MODE", "stops a VM"],
 "reset"              => [undef, undef, "VM_POWEROP_MODE", "resets a VM"],
 "suspend"            => [undef, undef, "VM_POWEROP_MODE", "suspends a VM"],
 "connectdevice"      => ["connect_device", undef, "device_name", "connects a virtual device to a VM"],
 "disconnectdevice"   => ["disconnect_device", undef, "device_name", "disconnects a virtual device from a VM"],
 "deviceisconnected"  => ["device_is_connected", undef, "device_name", "checks if a virtual device is connected"],
 "addredo"            => ["add_redo", undef, "disk_device_name", "adds a redo log to a virtual disk"],
 "commit"             => [undef, undef, "disk_device_name", "level", "freeze", "wait", "commits the redo log of a virtual disk"],
 "setconfig"          => ["set_config", undef, "variable", "value", "sets a configuration variable"],
 "getconfig"          => ["get_config", undef, "variable", "retrieves the value for a configuration variable"],
 "setguestinfo"       => ["set_guest_info", undef, "variable", "value", "sets a guest info variable"],
 "getguestinfo"       => ["get_guest_info", undef, "variable", "retrieves the value for a guest info variable"],
 "getconfigfile"      => ["get_config_file_name", undef, "retrieves the path to the configuration file"],
 "getheartbeat"       => ["get_heartbeat", undef, "retrieves the heartbeat value of the guest OS"],
 "getuptime"          => ["get_uptime", undef, "retrieves the uptime of the guest OS"],
 "gettoolslastactive" => ["get_tools_last_active", undef, "retrieves the number of seconds since last notification from the tools"],
 "getproductinfo"     => ["get_product_info", \&return_type_for_getproductinfo, "VM_PRODINFO", "gets various product information"],
 "setresource"        => ["set_resource", undef, "variable", "value", "sets a VM resource"],
 "getresource"        => ["get_resource", undef, "variable", "retrieves a VM resource"],
 "getid"              => ["get_id", undef, "retrieves the VM id"],
 "getpid"             => ["get_pid", undef, "retrieves the process id of the running VM"],
 "getcapabilities"    => ["get_capabilities", undef, "retrieves the access permissions of the current user on a VM"],
 "getremoteconnections" => ["get_remote_connections", undef, "retrieves the number of remote connections to a VM"],
 "hassnapshot"        => ["has_snapshot", undef, "determine if a VM has a snapshot"],
 "createsnapshot"     => ["create_snapshot", undef, "name", "description", "quiesce", "memory", "creates a snapshot of a VM"],
 "removesnapshots"    => ["remove_snapshots", undef, "remove all snapshots of a VM"],
 "revertsnapshot"     => ["revert_to_snapshot", undef, "revert to the last snapshot of a VM"]
 );


my @server_usage_order = qw(register unregister getresource setresource);
my %server_operations = 
(
 "register"           => ["register_vm", undef, "config_file_path", "registers a VM"],
 "unregister"         => ["unregister_vm", undef, "config_file_path", "unregisters a VM"],
 "setresource"        => ["set_resource", undef, "variable", "value", "sets a server resource"],
 "getresource"        => ["get_resource", undef, "variable", "retrieves a server resource"]
 );

BEGIN {
   if ( $^O eq "MSWin32" ) {
      my $PREFIX_PATH;
      if (-d '%winlibdir%') {
         $PREFIX_PATH = '%winlibdir%';

         push(@INC,
              "$PREFIX_PATH/perl5/site_perl/5.005",
              "$PREFIX_PATH/perl5/site_perl/5.005/MSWin32-x86"
              );
      }
   }

   # VMware internal development -- redirect Perl to find devel modules
   if (defined($ENV{VMTREE}) && defined($ENV{VMBLD})) {
      my $vmpath = $ENV{VMTREE} . "/build/" . $ENV{VMBLD} . "/apps/perl-control";
      my $matchedVersion = 0;
      foreach my $version ("local/$]","cross/5.00503") {
         if (-d $vmpath . "/$version/blib/arch") {
            #print STDERR "Using devel tree for Perl API: $vmpath/$version\n";
            unshift(@INC, $vmpath . "/$version/blib/lib");
            unshift(@INC, $vmpath . "/$version/blib/arch");
            $matchedVersion = 1;
            last;
         }
      }
      unless ($matchedVersion) {
         print STDERR "** Warning: devel tree Perl API not found in either: " .
             "$vmpath/local/$] or $vmpath/cross/5.00503\n";
      }
   }

  # Attempt to load the VMware::VmPerl Perl libraries
  eval {
      require VMware::VmPerl;
      import VMware::VmPerl;
      require VMware::VmPerl::Server;
      require VMware::VmPerl::VM;
      require VMware::VmPerl::ConnectParams;
      require VMware::VmPerl::Question;
  };
  if ($@) {
      my $err = $@;
      if ($^O ne "MSWin32" and not defined($ENV{'VMWARE_PERL_NESTED_EXEC'})) {
          if (open CONFIG, '</etc/vmware/config') {
              my $libdir;
              my $line;

              while (defined($line = <CONFIG>)) {
                  chomp $line;
                  if ($line =~ /^\s*libdir\s*=\s*\"(.*)\"\s*$/) {
                      $libdir = $1;
                      last;
                  }
              }
              close CONFIG;
              if (defined($libdir)) {
                  my $perl_binary = $libdir . '/perl5/bin/perl';

                  if (-x $perl_binary) {
                      $ENV{'VMWARE_PERL_NESTED_EXEC'} = 1;
                      exec $perl_binary, '-I'.$libdir.'/perl5/site_perl/5.005',
                                         $0, @ARGV;
                  }
              }
          }
      }
      print STDERR
          "$err $0 requires the VMware::VmPerl Perl libraries to be installed.\n";
      print STDERR "Check that your installation did not encounter errors.\n";
      exit(255);
  }

}

use strict;
use 5.004;

my $verbose = 0;
my $quiet = 0;

my $hostname = undef;
my $port = 0;
my $username = undef;
my $password = undef;

my $extension = ( $^O eq "MSWin32" ) ? ".vmx" : ".cfg";
my $dirsep = ( $^O eq "MSWin32" ) ? "\\" : "/";
my $help = 0;
my $passthrough = 0;

sub return_type_for_getproductinfo {
   my $arg = shift;
   $arg =~ tr/a-z/A-Z/;
   return "VM_" . $arg;
}

sub need_constant_mapping {
   my $arg = shift;
   return $arg =~ /^[A-Z_]*$/;
}

sub usage_argument_desc {
    my $arg_id = shift;

    if (need_constant_mapping($arg_id)) {
       my $arg_readable = $arg_id;
       $arg_readable =~ s/^VM_//;
       $arg_readable =~ tr/A-Z/a-z/;
       if (defined($constantmap{$arg_id})) {
          return "<$arg_readable>";
       }
    } 

    return "<$arg_id>";
}

sub print_ops_usage {
   my($ops_hashref, $ops_order_arrayref, $cmdlineprefix) = @_;

   foreach my $op (@{$ops_order_arrayref}) {
      my @op_info = @{$ops_hashref->{$op}};
      my $realop = shift(@op_info) || $op;
      my $returnmap = shift(@op_info) || "raw";
      my $desc = pop(@op_info) || "";
      print STDERR $cmdlineprefix . " $op";
      foreach my $argid (@op_info) {
         print STDERR " " . usage_argument_desc($argid);
      }
      print STDERR "\n";
      print STDERR "      -- $desc\n" if $help;
   }
}

sub usage {
    print STDERR "Usage: $0 <options> <vm-cfg-path> <vm-action> <arguments>\n";
    print STDERR "       $0 -s <options> <server-action> <arguments>\n";

    print STDERR "\n";
    print STDERR "  Options:\n";
    print STDERR "    Connection Options:\n";
    print STDERR "       -H <host>       specifies an alternative host (if set, -U and -P must also be set)\n";
    print STDERR "       -O <port>       specifies an alternative port\n";
    print STDERR "       -U <username>   specifies a user\n";
    print STDERR "       -P <password>   specifies a password\n";
    print STDERR "    General Options:\n";
    print STDERR "       -h More detailed help.\n";
    print STDERR "       -q Quiet. Minimal output\n";
    print STDERR "       -v Verbose.\n";

    print STDERR "\n  Server Operations:\n";
    print STDERR "    $0 -l \n"; 
    print STDERR "      -- lists the registered VMs\n" if $help;
    print_ops_usage(\%server_operations, \@server_usage_order, "    $0 -s");

    print STDERR "\n  VM Operations:\n";
    print STDERR "    $0 <cfg> getconnectedusers\n";
    print_ops_usage(\%vm_operations, \@vm_usage_order, "    $0 <cfg>");
    exit(255);
}

sub remap_action {
   my ($mapref, $action, @args) = @_;
   my @newargs = ();

   if (!defined($mapref->{$action})) {
      if ($passthrough) {
         return ($action, @args);
      } else {
         print STDERR "Error executing the command \"$action\"\n\n";
         print STDERR $@ if ($verbose);
         print STDERR "Run $0 -h to see usage information.\n";
         exit(255);
      }
   }

   my @op_info = @{$mapref->{$action}};
   my $newaction = shift(@op_info) || $action;

   shift(@op_info); #return
   pop(@op_info); #desc

   foreach my $arg (@args) {
       my $argtype = shift(@op_info);
       if (defined($argtype) && need_constant_mapping($argtype)) {
           my $hashref = $constantmap{$argtype};
           push(@newargs, $constantmap{$argtype}{$arg});
       } else {
           push(@newargs, $arg);
       }
   }

   return ($newaction, @newargs);
}

sub remap_action_return {
   my ($mapref, $action, $ret, @args) = @_;
   my $newret = $ret;

   if (!defined($mapref->{$action})) {
      return $ret;
   }

   my @op_info = @{$mapref->{$action}};

   my $rettype = $op_info[1];

   if (!defined($rettype)) {
      return $ret;
   } elsif (ref($rettype) eq "CODE") {
      my $rettype_func = $op_info[1];
      $rettype = &{$rettype_func}(@args);
   } 

   if (need_constant_mapping($rettype)) { 
      $newret = $constantmap{$rettype}{$ret};
      if (!defined($newret)) {
         #warn "Cannot find constant string mapping for $ret : type = $rettype\n";
         $newret = $ret;
      }
   }
    
   return $newret;
}

sub pretty_print {
    my $first = 1;
    while (defined($_ = shift)) {
	if (!$first) {
	    print " ";
	} else {
	    $first = 0;
	}
        if (ref($_)) {
            print "[ ";
            if (ref($_) eq "ARRAY") {
                pretty_print(@{$_});
            } elsif (ref($_) eq "HASH") {
                pretty_print(%{$_});
            } else {
                pretty_print(${$_});
            }
            print " ]";
        } else {
            print $_;
        }
    }
}                                                                                                                      

sub check_version {
    my $v = VMware::VmPerl::version();
    if (! $v) {
        print STDERR "$0: Could not run Perl VMware::VmPerl module\n";
        exit(255);
    }

    print "API Version: ",$v,"\n" if ($verbose);
}

sub get_connectparams_local {
    check_version();

    my $cp = &VMware::VmPerl::ConnectParams::new($hostname, $port, $username, $password);
    return $cp;
}

sub get_server_local {
    check_version();

    my $vms = &VMware::VmPerl::Server::new();
    return $vms;
}

sub connect_server_local {
    my $vms = get_server_local();
    my $cp = get_connectparams_local();

    if (! $vms || ! $vms->connect($cp)) {
        my ($err, $errstr) = $vms->get_last_error();
        print STDERR "$0: Could not connect to server\n";
        print STDERR "  (VMControl error $err: $errstr)\n";
        exit(-$err);
    }
    return $vms;
}

sub do_list {
    my $vms = connect_server_local();

    my @list = $vms->registered_vm_names();

    if (!@list) {
        my ($err, $errstr) = $vms->get_last_error();
	if ($err != 0) {
	    print STDERR "VMControl error $err: $errstr\n";
            # cleanup object's resources
	    undef $vms;
	    exit(-$err);
	}
    }

    while($_ = shift @list) {
        print $_,"\n";
    }
    # cleanup object's resources
    undef $vms;
}

sub do_server_action {
    my @args = @_;
    
    my $vms = get_server_local();

    if ($args[0] eq "register_vm" || $args[0] eq "unregister_vm") {
        if ( $^O eq "linux" && $args[1] !~ m%^/% ) {
            #Relative path --> absolute path (Linux)
            my $cwd;
            chomp($cwd = `pwd`);
            $args[1] = $cwd . "/" . $args[1];
        }
    }

    my $cp = get_connectparams_local();
    if (! $vms || ! $vms->connect($cp)) {
        my ($err, $errstr) = $vms->get_last_error();
        print STDERR "$0: Could not connect\n";
        print STDERR "  (VMControl error $err: $errstr)\n";
        exit(-$err);
    }

    do_action(\%server_operations, $vms, @args);
}

sub do_vm_action {
    my $cfg = shift;
    my @args = @_;
    
    my $vm = &VMware::VmPerl::VM::new();

    my $cp = get_connectparams_local();
    if (! $vm || ! $vm->connect($cp, $cfg)) {
        my ($err, $errstr) = $vm->get_last_error();
        print STDERR "$0: Could not connect to VM $cfg\n";
        print STDERR "  (VMControl error $err: $errstr)\n";
        exit(-$err);
    }

    if ($args[0] eq "getconnectedusers") {
      do_get_connected_users($vm);
    } else {
      do_action(\%vm_operations, $vm, @args);
    }
}

# connected users is being treated specially since it gets an array instead of a scalar back.
sub do_get_connected_users {
  my $vm = shift;
  my @results = $vm->get_connected_users();

  if (!@results) {
    my ($err, $errstr) = $vm->get_last_error();
    print STDERR "VMControl error $err: $errstr\n";
    $vm->disconnect( );
    exit(-$err);
  } else {
    my $iter;
    my $i = 0;
    my $field_count = shift(@results);
    foreach $iter (@results) {
      $i++;
      if ($i % $field_count == 0) {
        printf "%-20s\n", $iter;
      } else {
        printf "%-20s  ", $iter;
      }
    }
  }
}

sub do_vm_answer {
   my $cfg = shift;

   my $vm = &VMware::VmPerl::VM::new();
   my $cp = get_connectparams_local();
   
   if (! $vm || ! $vm->connect($cp, $cfg, 0)) {
      my ($err, $errstr) = $vm->get_last_error();
      print STDERR "$0: Could not connect to VM $cfg\n";
      print STDERR "  (VMControl error $err: $errstr)\n";
      exit(-$err);
   }

   my $state  = $vm->get_execution_state();
   if ($state != VM_EXECUTION_STATE_STUCK) { 
      print STDERR "No questions pending.\n";
      exit(0);
   }

   my $q = $vm->get_pending_question();

   print "\nQuestion (id = " . $q->get_id() . ") :" . $q->get_text() . "\n";
   my @choices = $q->get_choices();

   for (my $i = 0; $i <= $#choices; $i++) {
      print "\t$i) $choices[$i]\n";
   }

   print "Select choice. Press enter for default <0> : ";
   my $input = <STDIN>;
   chop($input);
   my $choice = 0;
   if ( $input =~ s/^\D*(\d+)// ) {
      $choice = $1;
      print "selected $choice : $choices[$choice]\n";
   }

   $vm->answer_question($q, $choice);

   # cleanup object's resources
   undef $vm;
}

sub do_action {
    my $mapref = shift;
    my $obj = shift;
    my $action = shift;
    my @args = @_;

    my ($newaction, @newargs) = remap_action($mapref, $action, @args);
    
    my @ret;
    
    eval {
        @ret = $obj->$newaction(@newargs);
        if (!defined($ret[0])) {
            my ($err, $errstr) = $obj->get_last_error();
            if ($err == VM_E_NOTCONNECTED) {
                $obj->connect(1);
                @ret = $obj->$newaction(@newargs);                
            }
        }
    };
    if ($@) {
        #eval error
        print STDERR "Error executing the command \"$action\"\n\n";
        print STDERR $@ if ($verbose);
        print STDERR "Run $0 -h to see usage information.\n";
    }

    if (!defined($ret[0])) {
        my ($err, $errstr) = $obj->get_last_error();
        print STDERR "VMControl error $err: $errstr\n";
	$obj->disconnect( );
        exit(-$err);
    }

    # only support single scalar return right now
    my $newreturn = remap_action_return($mapref, $action, $ret[0], @args); 
    # output in utf-8 for non-windows
    my $uArgs = "@args";
    if ($^O ne "MSWin32") {
        utf8::decode($uArgs);
    }
    print "$action($uArgs) = " unless ($quiet);
    print "$newreturn\n";

    undef $obj;
}

sub check_password {
    if (defined($username) && !defined($password)) {
	# Query the user for a password since a username was specified but not password
	print "Password for user $username: ";
	system("stty -echo");
	$password = <STDIN>;
	chop($password);
	print "\n";
	system("stty echo");
    }
}

sub main {
  my $i;
 
  # Scan the command line
  my @arguments = ();
  my $list = 0;
  my $server = 0;
  my $answer = 0;

  for ($i = 0; $i < $#ARGV + 1; $i++) {
    if ($ARGV[$i] eq "--") {
      last;
    }
    if ($ARGV[$i] eq "-h") {
      $help = 1;
    }
    if ($ARGV[$i] eq "-v") {
      $verbose = 1;
      next;
    }
    if ($ARGV[$i] eq "-l") {
      $list = 1;
      next;
    }
    if ($ARGV[$i] eq "-a") {
      $answer = 1;
      next;
    }
    if ($ARGV[$i] eq "-s") {
      $server = 1;
      next;
    }
    if ($ARGV[$i] eq "-q") {
      $quiet = 1;
      next;
    }
    if ($ARGV[$i] eq "-p") {
      $passthrough = 1;
      next;
    }
    if ($ARGV[$i] eq "-H") {
      if (++$i > $#ARGV) {
	usage();
      }
      $hostname = $ARGV[$i];
      next;
    }
    if ($ARGV[$i] eq "-O") {
      if (++$i > $#ARGV) {
	usage();
      }
      $port = $ARGV[$i];
      next;
    }
    if ($ARGV[$i] eq "-U") {
      if (++$i > $#ARGV) {
	usage();
      }
      $username = $ARGV[$i];
      next;
    }
    if ($ARGV[$i] eq "-P") {
      if (++$i > $#ARGV) {
	usage();
      }
      $password = $ARGV[$i];
      next;
    }
    push @arguments, $ARGV[$i];
  }
 
  # Check the options validity
  if ($list) {
      if ($#arguments != -1) {
          usage();
      }
      check_password();
      do_list();
  } else {
      if ($server) {
          #Require at least 1 argument (server-action)
          if ($#arguments < 0) {
              usage();
          }
	  check_password();
          do_server_action(@arguments);
      } else {
          #Require at least 2 arguments (config file, vm-action)
          if ($#arguments < 1) {
              usage();
              exit();
          }
	  check_password();

          if ($arguments[1] =~ /answer/) {
             do_vm_answer(@arguments);
          } else {
             do_vm_action(@arguments);
          }
      }
  }      
  return 0;
}

main();

__END__

=head1 NAME

vmware-cmd -- Command-line control of VMware virtual machines.

=head1 SYNOPSIS

  Options:
    Connection Options:
       -H <host> specifies an alternative host (if set, -U and -P must also be set)
       -O <port> specifies an alternative port
       -U <username> specifies a user
       -P <password> specifies a password
    General Options:
       -h More detailed help.
       -q Quiet. Minimal output (only print the result, not the query)
       -v Verbose.

  Server Operations:
    vmware-cmd -l
      -- lists the registered VMs
    vmware-cmd -s register <config_file_path>
      -- registers a VM
    vmware-cmd -s unregister <config_file_path>
      -- unregisters a VM

  VM Operations:
    vmware-cmd <cfg> getstate
      -- gets the execution state of the VM
    vmware-cmd <cfg> start <powerop_mode>
      -- powers on or resumes a VM
    vmware-cmd <cfg> stop <powerop_mode>
      -- stops a VM
    vmware-cmd <cfg> reset <powerop_mode>
      -- resets a VM
    vmware-cmd <cfg> suspend <powerop_mode>
      -- suspends a VM
    vmware-cmd <cfg> setconfig <variable> <value>
      -- sets a configuration variable
    vmware-cmd <cfg> getconfig <variable>
      -- retrieves the value for a configuration variable
    vmware-cmd <cfg> setguestinfo <variable> <value>
      -- sets a guest info variable
    vmware-cmd <cfg> getguestinfo <variable>
      -- retrieves the value for a guest info variable
    vmware-cmd <cfg> getproductinfo <prodinfo>
      -- gets various product information
    vmware-cmd <cfg> connectdevice <device_name>
      -- connects a virtual device to a VM
    vmware-cmd <cfg> disconnectdevice <device_name>
      -- disconnects a virtual device from a VM
    vmware-cmd <cfg> addredo <disk_device_name>
      -- adds a redo log to a virtual disk
    vmware-cmd <cfg> commits <disk_device_name> <level> <freeze> <wait>
      -- commits a redo log of a virtual disk
    vmware-cmd <cfg> getconfigfile
      -- retrieves the path to the configuration file
    vmware-cmd <cfg> getheartbeat
      -- retrieves the heartbeat value of the guest OS
    vmware-cmd <cfg> gettoolslastactive
      -- retrieves the number of seconds since last notification from the tools
    vmware-cmd <cfg> answer
      -- answers a question for a VM requesting input

  Examples

    # Same thing, on windows:
    vmware-cmd /home/vmware/win2000.cfg getstate

    # Same thing, on windows:
    vmware-cmd C:\home\vmware\win2000.vmx getstate

    # Power on a particular VM.  Be verbose.
    vmware-cmd -v /home/vmware/win2000.cfg start

    # Performs a hard reset. Be quiet, only prints result.
    vmware-cmd -q /home/vmware/win2000.cfg reset hard

=head1 DESCRIPTION

This program provides a simple command-line interface to most of the
operations in the VMware::VmPerl Perl module.

See the VMware VmPerl Scripting API documentation for more information.
