# IBM(c) 2008 EPL license http://www.eclipse.org/legal/epl-v10.html
# Ver. 2.1 (4) - sf@mauricebrinkmann.de
# Ver. 3.0     - Herbert Mehlhose, IBM - add support of VirtualBox V4
#
#-------------------------------------------------------

=head1
  xCAT plugin package to handle VirtualBox machines

   Supported command:
		 rpower

=cut

#-------------------------------------------------------
package xCAT_plugin::vbox;
require Sys::Hostname;
require xCAT::Table;

require xCAT::Utils;
require xCAT::TableUtils;
require xCAT::ServiceNodeUtils;
require xCAT::MsgUtils;
use Getopt::Long;
1;

use strict;
use warnings;

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

=head3	handled_commands

Return list of commands handled by this plugin

=cut

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

sub handled_commands
{
    return { rpower => 'nodehm:power,mgt' };
}

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

=head3	preprocess_request

  Check and setup for hierarchy 

=cut

#-------------------------------------------------------
sub preprocess_request
{
    my $req = shift;
    my $cb  = shift;
    if ($req->{_xcatpreprocessed}->[0] == 1) { return [$req]; }

    #exit if preprocessed
    my $nodes   = $req->{node};
    my $service = "xcat";

    # find service nodes for requested nodes
    # build an individual request for each service node
    my $sn = xCAT::ServiceNodeUtils->get_ServiceNode($nodes, $service, "MN");

    my @requests = ();

    # build each request for each service node
    foreach my $snkey (keys %$sn) {
        my $n = $sn->{$snkey};
        print "snkey=$snkey, nodes=@$n\n";
        my $reqcopy = {%$req};
        $reqcopy->{node}                   = $sn->{$snkey};
        $reqcopy->{'_xcatdest'}            = $snkey;
        $reqcopy->{_xcatpreprocessed}->[0] = 1;
        push @requests, $reqcopy;

    }
    return \@requests;
}


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

=head3	process_request

  Process the command

=cut

#-------------------------------------------------------
sub process_request
{

    my $request = shift;
    our $callback = shift;
    my $nodes   = $request->{node};
    my $command = $request->{command}->[0];
    my $args    = $request->{arg};
    my $envs    = $request->{env};
    our $rsp;
    my $node;

    my $soapsupport = eval { require SOAP::Lite; };
    unless ($soapsupport) {    #Still no SOAP::Lite module
        $callback->({ error => "SOAP::Lite perl module missing, unable to fulfill Virtual Box plugin requirements", errorcode => [42] });
        return [];
    }
    require xCAT::vboxService;

    my @nodes = @$nodes;

  PROCESSNODES: foreach $node (@nodes)    ######################################
    {
        # Load node information from xCAT tables
        my ($error, $url, $username, $password, $vmname, $vncport) = getInfo($node);
        next PROCESSNODES if ($error == 1);
        last PROCESSNODES if ($error == 2);

        # Create connection to VirtualBox web service
        my $api;                          # we assume V4 as default API
        my $vbox = getWebService($url, $username, $password, $node);
        next PROCESSNODES if (!$vbox);

        # get version
        my $vboxvers = xCAT::vboxService->IVirtualBox_getVersion($url, $vbox);

        #$callback->({info=>"$node: Vbox version: '$vboxvers', requested vncport via xCAT 'vm' table: '$vncport'"});
        if ($vboxvers =~ "^3.0" and $vncport =~ ",")
        {
            addError("$node: VirtualBox version 3.0 does only support a single RDP port, please correct entry vncport='$vncport' in table 'vm' for this node.");
            next PROCESSNODES;
        }
        if ($vboxvers =~ "^3.") {
            $api = "3";    # There is no getAPIVersion in Version 3, set to 3
        } elsif ($vboxvers =~ "^4.0") {
            $api = "4_0";  # There is no getAPIVersion in Version 4.0 set to 4_0
        } else {
            $api = xCAT::vboxService->IVirtualBox_getAPIVersion($url, $vbox);
        }

        # Get the machine
        my $machine = getMachine($api, $url, $vbox, $vmname, $node);
        if ($machine) {

            # Command differentiation #------------------------------------

            if ($command eq "rpower" and @$args > 0) {
                powerCtrl($vboxvers, $api, $url, $vbox, $machine, $vmname, $node, $vncport, $args);
            }

            #else # unrecognized command
            #{
            #	 addError("$node: $command unsupported on vm");
            #}

            # End Command differentiation #--------------------------------

        }    # /existing $machine reference

        xCAT::vboxService->IWebsessionManager_logoff($url, $vbox);

    }    # /for each $node in @nodes
    continue
    {
        # print out status before waiting for others and others and ..
        printMessages();

        # yield???
    }

    # last chance to print remaining messages
    printMessages();

    return;


    sub addMessage  ############################################################
    {
        push @{ $rsp->{data} }, shift;

    }               # /addMessage

    sub addError  ##############################################################
    {
        push @{ $rsp->{error} }, shift;

    }             # /addError


    sub printMessages  #########################################################
    {
        if (defined($rsp->{data}) or defined($rsp->{error})) {
            if (defined($rsp->{error})) {
                push @{ $rsp->{errorcode} }, 1;
                xCAT::MsgUtils->message("E", $rsp, $callback, 0);
            } else {
                xCAT::MsgUtils->message("I", $rsp, $callback, 0);
            }
        }

    }                  # /printMessages


    sub powerCtrl  #############################################################
    {
        my ($vboxvers, $api, $url, $vbox, $machine, $vmname, $node, $vncport, $args) =
          (shift, shift, shift, shift, shift, shift, shift, shift, shift);

        # Get state of the machine first
        my $cmd = "IMachine_getState";
        if ($api eq "3") {
            $cmd = $cmd . "_V3";
        }
        my $vmstate = xCAT::vboxService->$cmd($url, $machine);

        # Check if there is anything to do
        if (!$vmstate) {
            addError("$node: Can not determine vm's state!");
            return;
        } elsif ($vmstate =~ m/^PoweredOff|^Aborted|^Saved/) {
            if ($args->[0] eq "off") {
                addMessage("$node: off");
                return;
            } elsif ($args->[0] =~ m/^reset|^boot/) {

                # if machine is off: turn on when reset was choosen
                $args->[0] = "on reset";
            } elsif ($args->[0] =~ m/^stat/) {

                # addMessage("$node: off ($vmstate)");
                addMessage("$node: off");
                return;
            }
        } else {
            if ($args->[0] eq "on") {
                addMessage("$node: on");
                return;
            } elsif ($args->[0] =~ m/^stat/) {

                # addMessage("$node: on ($vmstate)");
                addMessage("$node: on");
                return;
            }
        }

        # Determine machine's UUID - Should work since we got the state
        $cmd = "IMachine_getId";
        if ($api eq "3") { $cmd = $cmd . "_V3"; }
        my $uuid = xCAT::vboxService->$cmd($url, $machine);

        # Open Session
        my $session = getSession($api, $url, $vbox, $node, $vmname);
        if ($session) {

            # Decide what to do
            if ($args->[0] =~ m/^on/) {
                if ($api eq "3") {
                    powerOn_V3($vboxvers, $url, $vbox, $machine, $session, $uuid, $node, $vncport, $args);
                } else {
                    powerOn($url, $vbox, $machine, $session, $uuid, $node, $vncport, $args);
                }
            } else {
                if ($api eq "3") {
                    powerOff_V3($url, $vbox, $session, $machine, $uuid, $node, $args);
                } else {
                    powerOff($url, $vbox, $session, $machine, $uuid, $node, $args);
                }
            }

            xCAT::vboxService->ISession_unlockMachine($url, $session);
        }    # /existing $session

        return;


        sub powerOn  #**********************************************************
        {
            my ($url, $vbox, $machine, $session, $uuid, $node, $vncport, $args) =
              (shift, shift, shift, shift, shift, shift, shift, shift);

            my $locktype = "Write";
            xCAT::vboxService->IMachine_lockMachine($url, $machine, $session, $locktype);

            my $directmachine = xCAT::vboxService->ISession_getMachine($url, $session);
            if (!$directmachine) {
                addError("$node: Could not access mutable machine");
            } else {
                my $vrde = xCAT::vboxService->IMachine_getVRDEServer($url, $directmachine);

                # 'Oracle VM VirtualBox Extension Pack' needs to be installed on vbox server
                # to be able to use RDP
                my $extpack;
                my @VRDEextpack = xCAT::vboxService->IVRDEServer_getVRDEExtPack($url, $vrde);
                foreach (@VRDEextpack) {
                    if ($_ eq "Oracle VM VirtualBox Extension Pack") {
                        $extpack = 1;
                    }
                }

                if ($extpack) {
                    my $hasVRDE = xCAT::vboxService->IVRDEServer_getEnabled($url, $vrde);

                    my $prop = "TCP/Ports";
                    my $portno = xCAT::vboxService->IVRDEServer_getVRDEProperty($url, $vrde, $prop);

                    if ($vncport) { # vncport determines, if rdp will be enabled
                        my $change;

                        # If port is specified but different: Update machine settings
                        if ($hasVRDE eq "false") {
                            $hasVRDE = "true";
                            xCAT::vboxService->IVRDEServer_setEnabled($url, $vrde, $hasVRDE);
                            $change = 1;
                        }
                        if ($vncport ne $portno) {
                            xCAT::vboxService->IVRDEServer_setVRDEProperty($url, $vrde, $prop, $vncport);
                            $change = 1;
                        }
                        if ($change) {
                            xCAT::vboxService->IMachine_saveSettings($url, $directmachine);
                        }
                    } elsif (!$vncport and $hasVRDE eq "true") {

                        # If not specified: disable RDP for the guest
                        $hasVRDE = "false";
                        xCAT::vboxService->IVRDEServer_setEnabled($url, $vrde, $hasVRDE);
                        xCAT::vboxService->IMachine_saveSettings($url, $directmachine);
                    }

                    #xCAT::vboxService->IMachine_saveSettings($url, $directmachine);
                    xCAT::vboxService->IManagedObjectRef_release($url, $directmachine);
                } else {
                    if ($vncport) {
                        addMessage("Warning: for VirtualBox Version 4 and above, RDP needs the VRDE Extension Pack to be installed on the VirtualBox host system. Either install this package to use RDP with the guest machine or remove the 'vncport' from xCAT vm table for '$node' to avoid this warning message to appear. Starting without RDP for now.");
                    }
                }
            }

            xCAT::vboxService->ISession_unlockMachine($url, $session);

            my $progress = xCAT::vboxService->IMachine_launchVMProcess($url, $machine, $session, "headless", ""); #gui

            if (!$progress) {
                addError("$node: Can not open remote session");
            } else {    # existing $progress
                xCAT::vboxService->IProgress_waitForCompletion($url, $progress, -1);

                if (xCAT::vboxService->IProgress_getCompleted($url, $progress)) {
                    addMessage("$node: $args->[0]");
                } else {    # not successfully completed
                    addError("$node: Power on failed");
                }

            }    # /existing $progress

            return;

        }    # /powerOn


        sub powerOn_V3 #**********************************************************
        {
            my ($vboxvers, $url, $vbox, $machine, $session, $uuid, $node, $vncport, $args) =
              (shift, shift, shift, shift, shift, shift, shift, shift, shift);

            xCAT::vboxService->IVirtualBox_openSession_V3($url, $vbox, $session, $uuid);

            my $directmachine = xCAT::vboxService->ISession_getMachine_V3($url, $session);
            my $hasVRDP;
            if (!$directmachine) {
                addError("$node: Could not access mutable machine");
            } else {
                my $vrdp = xCAT::vboxService->IMachine_getVRDPServer_V3($url, $directmachine);
                $hasVRDP = xCAT::vboxService->IVRDPServer_getEnabled_V3($url, $vrdp);
                my $portno;
                my $vncportmismatch; # current rdp port differs from vm table vncport definition
                if ($vboxvers =~ "^3.0") { # returns single port as unsigned long
                    $portno = xCAT::vboxService->IVRDPServer_getPort_V30($url, $vrdp);
                    if ($vncport and ($vncport != $portno)) {
                        $vncportmismatch = 1;
                    }
                } else {                   # returns one or more ports as string
                    $portno = xCAT::vboxService->IVRDPServer_getPorts_V3($url, $vrdp);
                    if ($vncport and ($vncport ne $portno)) {
                        $vncportmismatch = 1;
                    }
                }
                my $change;
                if ($vncport and ($hasVRDP eq "false")) {
                    $hasVRDP = "true";
                    xCAT::vboxService->IVRDPServer_setEnabled_V3($url, $vrdp, $hasVRDP);
                    $change = 1;
                }
                if ($vncportmismatch) {
                    if ($vboxvers =~ "^3.0") { # returns single port as unsigned long
                        xCAT::vboxService->IVRDPServer_setPort_V30($url, $vrdp, $vncport);
                    } else {
                        xCAT::vboxService->IVRDPServer_setPorts_V3($url, $vrdp, $vncport);
                    }
                    $change = 1;
                }
                if (!$vncport and $hasVRDP eq "true") {
                    $hasVRDP = "false";
                    xCAT::vboxService->IVRDPServer_setEnabled_V3($url, $vrdp, $hasVRDP);
                    $change = 1;
                }
                if ($change) {
                    xCAT::vboxService->IMachine_saveSettings_V3($url, $directmachine);
                }
                xCAT::vboxService->IManagedObjectRef_release_V3($url, $vrdp);
                xCAT::vboxService->IManagedObjectRef_release_V3($url, $directmachine);
            }

            xCAT::vboxService->ISession_close_V3($url, $session);
            my $v3session;
            if ($hasVRDP eq "true") {
                $v3session = "vrdp";    #vrdp
            } else {

                # found "headles" to be undocumented in SDK ref, but this allows to open a headless session w/o VRDP
                # and thus we can disable rdp without being forced to launch the gui. This allows to follow
                # the logic, that an empty vncport in the vm table will disable rdp, and having a value in
                # table vm will define the port and enable rdp.
                $v3session = "headless";    # gui
            }

            #my $progress = xCAT::vboxService->IVirtualBox_openRemoteSession_V3($url, $vbox, $session, $uuid, "vrdp", "");
            my $progress = xCAT::vboxService->IVirtualBox_openRemoteSession_V3($url, $vbox, $session, $uuid, $v3session, "");

            if (!$progress) {
                addError("$node: Can not open remote session");
            } else {                        # existing $progress
                xCAT::vboxService->IProgress_waitForCompletion_V3($url, $progress, -1);

                if (xCAT::vboxService->IProgress_getCompleted_V3($url, $progress)) {
                    addMessage("$node: $args->[0]");
                } else {                    # not successfully completed
                    addError("$node: Power on failed");
                }

            }    # /existing $progress

            return;
        }    # /powerOn_V3

        sub powerOff  #*********************************************************
        {
            my ($url, $vbox, $session, $machine, $uuid, $node, $args) =
              (shift, shift, shift, shift, shift, shift, shift);

            # Lock session with machine
            my $vmsessionstate = xCAT::vboxService->IMachine_getSessionState($url, $machine);
            my $vmsessiontype = xCAT::vboxService->IMachine_getSessionType($url, $machine);

            if ($vmsessionstate eq "Locked") {
                my $locktype = "Shared";
                xCAT::vboxService->IMachine_lockMachine($url, $machine, $session, $locktype);
            } elsif ($vmsessionstate eq "Unlocked") {
                my $locktype = "Write";
                xCAT::vboxService->IMachine_lockMachine($url, $machine, $session, $locktype);
            } else {    # !$vmsessionstate
                addError("$node: No direct session to machine");
            }

            # just test: check sessiontype - it turns out, that this needs a lock from traces
            #my $teste = xCAT::vboxService->ISession_getType($url, $session);
            #addError("$node: sessiontype =$teste");

            # The session is now locked with the machine, now its direct session or console can be optained and manipulated
            # Now get the console for the mutable machine
            my $console = xCAT::vboxService->ISession_getConsole($url, $session);
            if (!$console) {
                addError("$node: No console for mutable machine");
            } else {    # existing $console
                if ($args->[0] =~ m/^reset|^boot/) {
                    xCAT::vboxService->IConsole_reset($url, $console);
                    xCAT::vboxService->IManagedObjectRef_release($url, $console);
                    addMessage("$node: on reset");

                    #xCAT::vboxService->IManagedObjectRef_release($url, $console);
                    return;
                } else {
                    xCAT::vboxService->IConsole_powerButton($url, $console);
                    unless (xCAT::vboxService->IConsole_getPowerButtonHandled($url, $console) eq "true") {

                        # In case of no reaction: force to power down machine
                        xCAT::vboxService->IConsole_powerDown($url, $console);
                    } addMessage("$node: off");
                }

                xCAT::vboxService->IManagedObjectRef_release($url, $console);

            }    # /existing $console

            return;

        }    # /powerOff

        sub powerOff_V3 #*********************************************************
        {
            my ($url, $vbox, $session, $machine, $uuid, $node, $args) =
              (shift, shift, shift, shift, shift, shift, shift);

            # Lock session with machine
            my $vmsessionstate = xCAT::vboxService->IMachine_getSessionState_V3($url, $machine);

            if ($vmsessionstate eq "Open") {
                xCAT::vboxService->IVirtualBox_openExistingSession_V3($url, $vbox, $session, $uuid);
            } elsif ($vmsessionstate eq "Closed") {
                xCAT::vboxService->IVirtualBox_openSession_V3($url, $vbox, $session, $uuid);
            } else {
                addError("$node: No direct session to machine");
            }

            # Now get the console for the mutable machine
            my $console = xCAT::vboxService->ISession_getConsole_V3($url, $session);
            if (!$console) {
                addError("$node: No console for mutable machine");
            } else {    # existing $console
                if ($args->[0] =~ m/^reset|^boot/) {
                    xCAT::vboxService->IConsole_reset_V3($url, $console);
                    xCAT::vboxService->IManagedObjectRef_release_V3($url, $console);
                    addMessage("$node: on reset");

                    #xCAT::vboxService->IManagedObjectRef_release_V3($url, $console);
                    return;
                } else {
                    xCAT::vboxService->IConsole_powerButton_V3($url, $console);
                    unless (xCAT::vboxService->IConsole_getPowerButtonHandled_V3($url, $console) eq "true") {

                        # In case of no reaction: force to power down machine
                        xCAT::vboxService->IConsole_powerDown_V3($url, $console);
                    } addMessage("$node: off");
                }

                xCAT::vboxService->IManagedObjectRef_release_V3($url, $console);

            }    # /existing $console

            return;
        }    # /powerOff_V3

    }    # /powerCtrl


    sub getSession  ############################################################
    {
        my $sess;
        my ($api, $url, $vbox, $node, $vmname) = (shift, shift, shift, shift, shift);

        my $cmd = "IWebsessionManager_getSessionObject";
        if ($api eq "3") { $cmd = $cmd . "_V3"; }

        eval {
            $sess = xCAT::vboxService->$cmd($url, $vbox);
        };

        return $sess if ($sess and not $@);

        addError("$node: No session for $vmname on web service @ $url.");
        return undef;
    }    # /getSession


    sub getMachine  ############################################################
    {
        my $machine;
        my ($api, $url, $vbox, $vmname, $node) = (shift, shift, shift, shift, shift);

        my $cmd = "IVirtualBox_findMachine";
        if ($api eq "3") { $cmd = $cmd . "_V3"; }

        eval {
            $machine = xCAT::vboxService->$cmd($url, $vbox, $vmname);
        };
        return $machine if ($machine and not $@);

        addError("$node: VM $vmname not known by the web service @ $url.");
        return undef;
    }    # /getMachine


    sub getWebService  #########################################################
    {
        my $ws;
        my ($url, $user, $passwd, $node) = (shift, shift, shift, shift);

        my $cmd = "IWebsessionManager_logon";
        eval {
            $ws = xCAT::vboxService->$cmd($url, $user, $passwd);
        };

        return $ws if ($ws and not $@);

        addError("$node: No connection to the web service @ $url.");
        return undef;
    }    # /getWebService


    sub getInfo  ###############################################################
    {
        my $node = shift;

        # Open tables first, return in case of a critical error = 2
        my $hostsTab = openTable('hosts');
        return (2, undef, undef, undef, undef) if (!$hostsTab);

        my $vmTab = openTable('vm');
        return (2, undef, undef, undef, undef) if (!$vmTab);

        my $websrvTab = openTable('websrv');
        return (2, undef, undef, undef, undef) if (!$websrvTab);

        # Load attributes, return in case of missing information error = 1
        my $values;

        my @attributes = ('host', 'vncport', 'comments');
        $values = loadValues($vmTab, $node, \@attributes);
        return (1, undef, undef, undef, undef) if (!defined($values));

        my $hostname = $values->{host};
        my $vncport  = $values->{vncport};
        my $comments = $values->{comments};
        my $vmname   = undef;
        if ($comments =~ m/vmname:(.+)!/) {
            $vmname = $1;
        } else {
            $vmname = $node;
        }

        @attributes = ('port', 'username', 'password');
        $values = loadValues($websrvTab, $hostname, \@attributes);
        return (1, undef, undef, undef, undef) if (!defined($values));

        my $port     = $values->{port};
        my $username = $values->{username};
        my $password = $values->{password};

        @attributes = ('ip');
        $values = loadValues($hostsTab, $hostname, \@attributes);
        return (1, undef, undef, undef, undef) if (!defined($values));

        my $ipaddr = $values->{ip};
        my $url    = "http://$ipaddr:$port/";

        return (0, $url, $username, $password, $vmname, $vncport);


        sub loadValues  #*******************************************************
        {
            my ($table, $node, $attributes) = (shift, shift, shift);
            my ($values) = $table->getAttribs({ 'node' => $node }, @$attributes);
            $table->close;

            addError("$node: Missing information: @$attributes")
              if (!defined($values));

            return $values;

        }               # /loadValues


        sub openTable  #********************************************************
        {
            my $tabname = shift;
            my $table   = xCAT::Table->new($tabname);

            # try to create vbox tables if they don't exist yet
            if (!$table and $tabname =~ m/websrv/)
            {
                $table = xCAT::Table->new($tabname, -create => 1, -autocommit => 1);
                $table->close;
                addMessage("[xCAT] Info: The table $tabname has been created.");
                $table = xCAT::Table->new($tabname);
            }

            addError("[xCAT] Can not open table: $tabname. Command aborted.")
              if (!$table);

            return $table;

        }    # /openTable

    }    # /getInfo
}

# see Lite.pm for other serializer code, e.g. as_string
sub SOAP::Serializer::as_LockType
{
    my ($self, $value, $name, $type, $attr) = @_;
    die "String value expected instead of @{[ref $value]} reference\n"
      if ref $value;
    return [
        $name,
        { 'xsi:type' => 'vbox:LockType', %$attr },
        SOAP::Utils::encode_data($value)
    ];
}

1;