#!/usr/bin/perl
# ^^^ You may need to change this to the location of your perl interpreter
# RemoteBox v0.4 (c) 2010 Ian Chapman. Licenced under the terms of the GPL
use strict;
use warnings;
use FindBin qw($Bin);
use lib "/usr/share/remotebox";
use vboxService qw($endpoint $fault :all);
require 'vboxserializers.pl';
require 'rbox_enums.pl';
require 'rbox_gui_init.pl';
require 'rbox_gui_edit.pl';
require 'rbox_gui_vmm.pl';
require 'rbox_err.pl';

$|=1;

our (%gui, %signal, %sensgrp, %EAudioDriverType, %EAudioControllerType, %ENetworkAdapterType,
     %ENetworkAttachmentType, %ETruth, %EAbled, %hostspec, %osfamily, %osversion, $EIMachineM);

my %prefs = (RDPCLIENT => 'rdesktop -T "RemoteBox - %n" %h:%p');
$endpoint = 'http://localhost:18083';
$fault = \&vboxerror;

&set_status_msg("Welcome to $gui{appname} $gui{appver}.");
&get_prefs();
Gtk2->main;

sub vboxerror() {
    my ($soap, $res) = @_;
    &show_err_msg('webservice', $gui{messagedialogError}, $res->faultstring);
}

sub get_prefs() {
    if (defined($ENV{HOME})) {
        if (open(PREFS, "$ENV{HOME}/.remotebox.conf")) {
            my @contents = <PREFS>;
            chomp(@contents);
            close(PREFS);
            foreach (@contents) {
                if ($_ =~ m/^URL=(.*)$/) { $prefs{URL}{$1} = 'URL'; }
                elsif ($_ =~ m/^USER=(.*)$/) { $prefs{USER}{$1} = 'USER'; }
                elsif ($_ =~ m/^(.*)=(.*)$/) { $prefs{$1} = $2; }
            }
        }
    }
}

sub save_prefs() {
    if (defined($ENV{HOME})) {
        if (open(PREFS, ">$ENV{HOME}/.remotebox.conf")) {
            foreach my $key (keys %prefs) {
                if ($key eq 'URL') {
                    foreach (keys %{$prefs{URL}}) { print PREFS "URL=$_\n"; }
                }
                elsif ($key eq 'USER') {
                    foreach (keys %{$prefs{USER}}) { print PREFS "USER=$_\n"; }
                }
                else { print PREFS "$key=$prefs{$key}\n"; }
            }
            close(PREFS);
        }
        else { warn "Unable to save preferences: $ENV{HOME}/.remotebox.conf\n"; }
    }
}

sub quit_remotebox() {
    &virtualbox_logoff();
    # This must be reset on exit, otherwise garbage collection will fail.
    $gui{menuitemTGFloppy}->set_submenu(undef);
    $gui{menuitemTGDVD}->set_submenu(undef);
    $gui{menuitemTGFloppy}->set_submenu($gui{menuTGtmp1});
    $gui{menuitemTGDVD}->set_submenu($gui{menuTGtmp2});
    exit; # Gtk2->main_quit is deprecated
}

sub virtualbox_logon() {
    my ($url, $user, $password) = @_;
    &virtualbox_logoff(); # Ensure we disconnect from an existing connection
    $endpoint = $url;
    eval { $gui{websn} = IWebsessionManager_logon($user, $password); }
}

sub virtualbox_logoff() {
    if ($gui{websn}) {
        eval{ IWebsessionManager_logoff($gui{websn}) };
        $gui{websn} = undef;
    }
    &sensitive_off(@{ $sensgrp{unselected} });
    &sensitive_off(@{ $sensgrp{connect} });
    &clr_lstore($gui{liststoreGuest}, $gui{liststoreDetails}, $gui{treestoreSnapshots});
    $gui{textbufferDescription}->set_text('');
}

sub reset_guest() {
    my ($widget, $treeview) = @_;
    my ($gname, $IMachine) = (&get_selected($treeview, 0), &get_selected($treeview, 2));
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_reset($IConsole);
        ISession_close($ISession);
        &set_status_msg("Sent request to reset $gname.");
    }
    else { &set_status_msg("$gname does not appear to be running."); }
}

sub stop_guest_poweroff() {
    my ($widget, $treeview) = @_;
    my ($gname, $IMachine) = (&get_selected($treeview, 0), &get_selected($treeview, 2));
    my $statusmsg = "Sent request to power off $gname.";
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_powerDown($IConsole);
        ISession_close($ISession);
    }
    else { $statusmsg = "$gname already appears to be powered off."; }

    &tv_guest_fill();
    &set_status_msg($statusmsg);
}

sub stop_guest_acpi() {
    my ($widget, $treeview) = @_;
    my ($gname, $IMachine) = (&get_selected($treeview, 0), &get_selected($treeview, 2));
    my $statusmsg = "Sent ACPI power off request to shutdown $gname.";
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_powerButton($IConsole);
        ISession_close($ISession);
    }
    else { $statusmsg = "$gname already appears to be powered off."; }

    &tv_guest_fill();
    &set_status_msg($statusmsg);
}

sub stop_guest_savestate() {
    my ($widget, $treeview) = @_;
    my ($gname, $IMachine) = (&get_selected($treeview, 0), &get_selected($treeview, 2));
    my $statusmsg = "Saved the state of $gname.";
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        &busy_window($gui{windowMain});
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_saveState($IConsole);
        &set_status_msg("Saving guest state of $gname...");
        IProgress_waitForCompletion($IProgress, -1);
        ISession_close($ISession);
        &unbusy_window($gui{windowMain});
    }
    else { $statusmsg = "$gname already appears to be powered off."; }

    &tv_guest_fill();
    &set_status_msg($statusmsg);
}

sub start_guest() {
    my ($widget, $treeview) = @_;
    my ($gname, $guuid) = (&get_selected($treeview, 0), &get_selected($treeview, 5));
    &busy_window($gui{windowMain});
    my $statusmsg = "Attempting to start $gname...";
    my $ISession = IWebsessionManager_getSessionObject($gui{websn});
    my $IProgress = IVirtualBox_openRemoteSession($gui{websn}, $ISession, $guuid, 'vrdp', "");

    if ($IProgress) {
        &set_status_msg($statusmsg);
        IProgress_waitForCompletion($IProgress, -1);
        my $resultcode = IProgress_getResultCode($IProgress);

        if ( $resultcode != 0) {
            my $IVirtualBoxErrorInfo = IProgress_getErrorInfo($IProgress);
            &show_err_msg('startguest', $gui{messagedialogError}, "Code: $resultcode\nError:\n" . IVirtualBoxErrorInfo_getText($IVirtualBoxErrorInfo));
            $statusmsg = "Failed to start $gname. Error Code: $resultcode";
        }
        else { $statusmsg = "Request sent to start $gname"; }
    }
    else {
        &show_err_msg('sessionopen', $gui{messagedialogError});
        $statusmsg = "Failed to start $gname. Session in use.";
    }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &tv_guest_fill();
    &set_status_msg($statusmsg);
    &unbusy_window($gui{windowMain});
}

sub delete_guest() {
    my ($widget, $treeview) = @_;
    my ($gname, $gos, $IMachine, $status, $gosid) = &get_selected($treeview);
    &busy_window($gui{windowMain});
    my $response = $gui{dialogDeleteGuest}->run;
    $gui{dialogDeleteGuest}->hide;

    if ($response eq 'ok') {
        my ($ISession, $IMachineM) = &get_mutable_session($IMachine);

        if ($ISession) {
            &set_status_msg("Deleting $gname...");
            my $machineid = IMachine_getId($IMachineM);
            my @IMediumAttachment = IMachine_getMediumAttachments($IMachineM);

            foreach my $attach (@IMediumAttachment) {
                IMachine_detachDevice($IMachineM, $$attach{controller}, $$attach{port}, $$attach{device});
            }

            IMachine_saveSettings($IMachineM);
            ISession_close($ISession);
            IVirtualBox_unregisterMachine($gui{websn}, $machineid);
            IMachine_deleteSettings($IMachine);
            &tv_guest_fill();
            &set_status_msg("Deleted $gname...");

        }
        else { &show_err_msg('deleteguest', $gui{messagedialogWarning}); }
    }

    &unbusy_window($gui{windowMain});
}

# Returns a mutable IMachine and corresponding session, otherwise returns 0 if
# one cannot be obtained.
sub get_mutable_session() {
    my ($IMachine) = @_;
    my ($ISession, $IMachineM) = (0, 0);

    if (IMachine_getSessionState($IMachine) eq 'Closed') {
        $ISession = IWebsessionManager_getSessionObject($gui{websn});
        IVirtualBox_openSession($gui{websn}, $ISession, IMachine_getId($IMachine));
        $IMachineM = ISession_getMachine($ISession);
    }

    return $ISession, $IMachineM;
}

# Opens an existing session but only if the guest is running otherwise it will
# still return a session if a guest is having its settings edited for example
sub get_existing_session() {
    my ($IMachine) = @_;
    my $ISession = 0;

    if (IMachine_getSessionState($IMachine) eq 'Open' and IMachine_getState($IMachine) eq 'Running') {
        $ISession = IWebsessionManager_getSessionObject($gui{websn});
        IVirtualBox_openExistingSession($gui{websn}, $ISession, IMachine_getId($IMachine));
    }

    return $ISession;
}

sub recurse_snapshot() {
    my ($treestore, $ISnapshot, $iter, $ISnapshot_current) = @_;
    my $citer = $treestore->append($iter);
    my $snapname = ISnapshot_getName($ISnapshot);
    my $date = scalar(localtime((ISnapshot_getTimeStamp($ISnapshot))/1000)); # VBox returns msecs so / 1000
    if ($ISnapshot_current and $ISnapshot eq $ISnapshot_current) { $snapname = "$snapname (Current State)"; }
    $treestore->set($citer, (0 => $snapname, 1 => $date, 2 => $ISnapshot));
    my @snapshots = ISnapshot_getChildren($ISnapshot);
    if (@snapshots > 0) { &recurse_snapshot($treestore, $_, $citer, $ISnapshot_current) foreach (@snapshots); }
}

sub tv_snapshot_fill() {
    my ($widget, $treestore) = @_;
    &busy_window($gui{windowMain});
    &sensitive_off(@{ $sensgrp{snap} });
    &clr_lstore($treestore);
    my $IMachine =  &get_selected($gui{treeviewGuest}, 2);
    my $ISnapshot_current = IMachine_getCurrentSnapshot($IMachine);
    &set_status_msg("Retrieving snapshot information from $endpoint...");

    if (IMachine_getSnapshotCount($IMachine) > 0) {
        my $ISnapshot = IMachine_getSnapshot($IMachine, undef); # get first snapshot
        &recurse_snapshot($treestore, $ISnapshot, undef, $ISnapshot_current);
        $gui{treeviewSnapshots}->expand_all();
    }
    &set_status_msg('Retrieved snapshot information.');
    &unbusy_window($gui{windowMain});
}

sub tv_snapshot_selected() {
    my ($widget, $treestore) = @_;
    my $ISnapshot = &get_selected($gui{treeviewSnapshots}, 2);
    &sensitive_on(@{ $sensgrp{snap} });
    #my @snapshots = ISnapshot_getChildren($ISnapshot);
    #if (@snapshots > 0) { &sensitive_off($gui{buttonDeleteSnapshot}); }
}

sub restore_snapshot() {
    my ($widget, $treestore) = @_;
    &busy_window($gui{windowMain});
    my $ISnapshot = &get_selected($gui{treeviewSnapshots}, 2);
    my ($gname, $IMachine) = (&get_selected($gui{treeviewGuest}, 0), &get_selected($gui{treeviewGuest}, 2));
    my ($ISession, $IMachineM) = &get_mutable_session($IMachine);

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_restoreSnapshot($IConsole, $ISnapshot);

        do {
            &set_status_msg("Restoring snapshot of $gname..." . IProgress_getPercent($IProgress) . '% complete.');
            sleep 1; # Poll only every 1 second
        } until (IProgress_getCompleted($IProgress) eq 'true');

        ISession_close($ISession);
        &set_status_msg("Snapshot of $gname restored.");
        &tv_snapshot_fill($gui{buttonRefreshSnapshots}, $gui{treestoreSnapshots});
    }
    else { &show_err_msg('restorefail', $gui{messagedialogError}); } # change this
    &unbusy_window($gui{windowMain});
}

sub delete_snapshot() {
    my ($widget, $treestore) = @_;
    &busy_window($gui{windowMain});
    my $ISnapshot = &get_selected($gui{treeviewSnapshots}, 2);
    my $suuid = ISnapshot_getId($ISnapshot);
    my ($gname, $IMachine) = (&get_selected($gui{treeviewGuest}, 0), &get_selected($gui{treeviewGuest}, 2));
    my ($ISession, $IMachineM) = &get_mutable_session($IMachine); # Try running machine first
    $ISession = &get_existing_session($IMachine) if (!$ISession); # Fall back to powered off
    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_deleteSnapshot($IConsole, $suuid);

        do {
            &set_status_msg("Deleting snapshot of $gname..." . IProgress_getPercent($IProgress) . '% complete.');
            sleep 1; # Poll only every 1 second
        } until (IProgress_getCompleted($IProgress) eq 'true');

        ISession_close($ISession);
        &set_status_msg("Snapshot of $gname deleted.");
        &tv_snapshot_fill($gui{buttonRefreshSnapshots}, $gui{treestoreSnapshots});
    }
    else { &show_err_msg('snapshotfail', $gui{messagedialogError}); } # change this
    &unbusy_window($gui{windowMain});
}

sub take_snapshot() {
    my ($name, $description) = @_;
    $name = 'Snapshot' if (!$name);
    &busy_window($gui{windowMain});
    my ($gname, $IMachine) = (&get_selected($gui{treeviewGuest}, 0), &get_selected($gui{treeviewGuest}, 2));
    my ($ISession, $IMachineM) = &get_mutable_session($IMachine); # Try running machine first
    $ISession = &get_existing_session($IMachine) if (!$ISession); # Fall back to powered off

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_takeSnapshot($IConsole, $name, $description);

        do {
            &set_status_msg("Taking snapshot of $gname..." . IProgress_getPercent($IProgress) . '% complete.');
            sleep 1; # Poll only every 1 second
        } until (IProgress_getCompleted($IProgress) eq 'true');

        ISession_close($ISession);
        &set_status_msg("Snapshot of $gname 100% complete.");
        &tv_snapshot_fill($gui{buttonRefreshSnapshots}, $gui{treestoreSnapshots});
    }
    else { &show_err_msg('snapshotfail', $gui{messagedialogError}); }
    &unbusy_window($gui{windowMain});
}


# Determines the next free port on a controller
sub get_free_deviceport() {
    my ($IMachine, $IStorCtr) = @_;
    my @free = (-1, -1);
    my @used;
    my $ctrname = IStorageController_getName($IStorCtr);
    my @IMediumAttachment = IMachine_getMediumAttachmentsOfController($IMachine, $ctrname);
    my $hiport = (IStorageController_getMaxPortCount($IStorCtr)) - 1;
    my $hidev = (IStorageController_getMaxDevicesPerPortCount($IStorCtr)) - 1;
    # Get a list of all used ports
    foreach my $attach (@IMediumAttachment) { $used[$$attach{device}][$$attach{port}] = $attach; }

    foreach my $dev (0..$hidev) {
        last if ($free[0] != -1);

        foreach my $port (0..$hiport) {
            next if ($used[$dev][$port]);
            $free[0] = $dev;
            $free[1] = $port;
            last;
        }
    }

    return @free;
}

sub tv_details_fill() {
    my ($widget, $lstore) = @_;
    &busy_window($gui{windowMain});
    &set_status_msg("Retrieving guest details...");
    &clr_lstore($lstore);
    my $IMachine =  &get_selected($gui{treeviewGuest}, 2);
    my $IVRDPServer = IMachine_getVRDPServer($IMachine);
    my @IStorageController = IMachine_getStorageControllers($IMachine);
    my $IAudioAdapter = IMachine_getAudioAdapter($IMachine);
    my $IUSBController = IMachine_getUSBController($IMachine);

    &append_lstore($lstore, (0 => 'GENERAL', 2 => 800));
    &append_lstore($lstore, (0 => 'Name:', 1 => IMachine_getName($IMachine), 2 => 400));
    &append_lstore($lstore, (0 => 'OS Type:', 1 => IMachine_getOSTypeId($IMachine), 2 => 400));
    &append_lstore($lstore, (0 => 'SYSTEM', 2 => 800));
    &append_lstore($lstore, (0 => 'Firmware:', 1 => IMachine_getFirmwareType($IMachine), 2 => 400));
    &append_lstore($lstore, (0 => 'Base Memory:', 1 => IMachine_getMemorySize($IMachine) . ' MiB', 2 => 400));
    &append_lstore($lstore, (0 => 'Processor(s):', 1 => IMachine_getCPUCount($IMachine), 2 => 400));

    foreach (1..4) {
        my $bootdev = IMachine_getBootOrder($IMachine,$_);
        &append_lstore($lstore, (0 => "Boot Device $_:", 1 => $bootdev), 2 => 400) if ($bootdev ne 'Null');
    }

    &append_lstore($lstore, (0 => 'VT-x/AMV-V:', 1 => $EAbled{IMachine_getHWVirtExProperty($IMachine, 'Enabled')}, 2 => 400));
    &append_lstore($lstore, (0 => 'VT-x VPID:', 1 => $EAbled{IMachine_getHWVirtExProperty($IMachine, 'VPID')}, 2 => 400));
    &append_lstore($lstore, (0 => 'Nested Paging:', 1 => $EAbled{IMachine_getHWVirtExProperty($IMachine, 'NestedPaging')}, 2 => 400));
    &append_lstore($lstore, (0 => 'DISPLAY', 2 => 800));
    &append_lstore($lstore, (0 => 'Video Memory:', 1 => IMachine_getVRAMSize($IMachine) . ' MiB', 2 => 400));
    &append_lstore($lstore, (0 => '3D Acceleration:', 1 => $EAbled{IMachine_getAccelerate3DEnabled($IMachine)}, 2 => 400));
    &append_lstore($lstore, (0 => '2D Acceleration:', 1 => $EAbled{IMachine_getAccelerate2DVideoEnabled($IMachine)}, 2 => 400));

    if (IVRDPServer_getEnabled($IVRDPServer) eq 'true') {
        &append_lstore($lstore, (0 => 'Remote Display Server:', 1 => 'Enabled', 2 => 400));
        &append_lstore($lstore, (0 => 'Remote Display Port(s):', 1 => IVRDPServer_getPorts($IVRDPServer), 2 => 400));
    }
    else { &append_lstore($lstore, (0 => 'Remote Display Server:', 1 => 'Disabled', 2 => 400)); }

    &append_lstore($lstore, (0 => 'STORAGE', 2 => 800));

    foreach my $controller (@IStorageController) {
        my $controllername = IStorageController_getName($controller);
        &append_lstore($lstore, (0 => 'Controller:', 1 => $controllername, 2 => 400));
        my @IMediumAttachment = IMachine_getMediumAttachmentsOfController($IMachine, $controllername);
        foreach my $attachment (@IMediumAttachment) {
            if ($$attachment{medium}) {
                # Use the base medium for information purposes
                &append_lstore($lstore, (0 => "  Port $$attachment{port}:",
                                         1 => "$$attachment{type}: " . IMedium_getName(IMedium_getBase($$attachment{medium})),
                                         2 => 400));
            }
        }
    }

    &append_lstore($lstore, (0 => 'AUDIO', 2 => 800));

    if (IAudioAdapter_getEnabled($IAudioAdapter) eq 'true') {
        &append_lstore($lstore, (0 => 'Host Driver:', 1 => $EAudioDriverType{IAudioAdapter_getAudioDriver($IAudioAdapter)}{desc}, 2 => 400));
        &append_lstore($lstore, (0 => 'Controller:', 1 => $EAudioControllerType{IAudioAdapter_getAudioController($IAudioAdapter)}, 2 => 400));
    }
    else { &append_lstore($lstore, (0 => 'Audio Disabled', 2 => 400)); }

    &append_lstore($lstore, (0 => 'NETWORK', 2 => 800));

    foreach (0..($hostspec{maxnet}-1)) {
        my $INetworkAdapter = IMachine_getNetworkAdapter($IMachine,$_);
        if (INetworkAdapter_getEnabled($INetworkAdapter) eq 'true') {
            &append_lstore($lstore, (0 => "Adapter $_:",
                                     1 => $ENetworkAdapterType{INetworkAdapter_getAdapterType($INetworkAdapter)} . ', ' .
                                                               INetworkAdapter_getAttachmentType($INetworkAdapter),
                                     2 => 400));
        }
    }

    &append_lstore($lstore, (0 => 'SERIAL PORTS', 2 => 800));

    foreach (0..($hostspec{maxser}-1)) {
        my $ISerialPort = IMachine_getSerialPort($IMachine,$_);
        if (ISerialPort_getEnabled($ISerialPort) eq 'true') {
            &append_lstore($lstore, (0 => "Port #$_:",
                                     1 => 'Enabled, ' . ISerialPort_getHostMode($ISerialPort) . ', ' .
                                                        ISerialPort_getPath($ISerialPort),
                                     2 => 400));
        }
        else { &append_lstore($lstore, (0 => "Port #$_:", 1 => 'Disabled', 2 => 400)); }
    }

    &append_lstore($lstore, (0 => 'USB', 2 => 800));

    if (IUSBController_getEnabled($IUSBController) eq 'true' ) {
        my @IUSBDeviceFilter = IUSBController_getDeviceFilters($IUSBController);
        my $active = 0;
        my $inactive = 0;
        foreach my $filter (@IUSBDeviceFilter) {
            if (IUSBDeviceFilter_getActive($filter) eq 'true') { $active++; }
            else { $inactive++; }
        }
        &append_lstore($lstore, (0 => 'Active Device Filters:', 1 => $active, 2 => 400));
        &append_lstore($lstore, (0 => 'Inactive Device Filters:', 1 => $inactive, 2 => 400));
    }
    else { &append_lstore($lstore, (0 => 'Disabled', 2 => 400)); }

    my @sf = IMachine_getSharedFolders($IMachine);
    &append_lstore($lstore, (0 => 'SHARED FOLDERS', 2 => 800));
    &append_lstore($lstore, (0 => 'Shared Folders:', 1 => scalar(@sf), 2 => 400));
    &set_status_msg('Retrieved guest details.');
    &unbusy_window($gui{windowMain});
}

sub show_connect_dialog() {
    my ($widget, $dialog) = @_;

    &busy_window($gui{windowMain});
    &clr_lstore($gui{liststoreConnectURL}, $gui{liststoreConnectUser});
    &append_lstore($gui{liststoreConnectURL}, (0 => $_)) foreach (keys (%{$prefs{URL}}));
    &append_lstore($gui{liststoreConnectUser}, (0 => $_)) foreach (keys(%{$prefs{USER}}));
    my $response = $dialog->run;
    $dialog->hide;
    $dialog->get_display->flush;

    if ($response eq 'ok') {
        my $url = $gui{comboboxentryConnectURL}->get_active_text();
        my $user = $gui{comboboxentryConnectUser}->get_active_text();
        $url = $endpoint if (!$url);
        $url = "http://$url" if ($url !~ m/^.+:\/\//);
        $url = "$url:18083" if ($url !~ m/:\d+$/);

        if ($gui{checkbuttonConnectSave}->get_active()) {
            $prefs{URL}{$url} = 'URL' if ($url);
            $prefs{USER}{$user} = 'USER' if ($user);
            &save_prefs();
        }

        &virtualbox_logon($url, $user, $gui{entryConnectPassword}->get_text());

        if (!$gui{websn}) {
            &show_err_msg('connect', $gui{messagedialogError});
            &set_status_msg("Unable to connect to $url");
        }
        else {
            # Some VBox versions still 'log you in' but you can't do anything, so do a basic version test
            my $ver = IVirtualBox_getVersion($gui{websn});

            if (!$ver) {
                &show_err_msg('auth', $gui{messagedialogError});
                &set_status_msg("Failed to authenticate to $url");
                &virtualbox_logoff();
            }
            else {
                &show_err_msg('vboxver', $gui{messagedialogWarning}, "\n\nDetected Version: $ver") if ($ver !~ m/^3.2/);
                &show_err_msg('vboxose', $gui{messagedialogWarning}) if ($ver =~ m/_OSE$/);
                &populate_hostspec();
                &populate_ostypes();
                &tv_guest_fill();
                &sensitive_on(@{ $sensgrp{connect} });
                &set_status_msg("Logged onto $endpoint running VirtualBox $hostspec{vbver}");
            }
        }
    }

    &unbusy_window($gui{windowMain});
}

sub show_about_dialog() {
    my ($widget, $dialog) = @_;
    $dialog->run;
    $dialog->hide;
}

sub show_serverinfo_dialog() {
    my ($widget, $lstore) = @_;
    &busy_window($gui{windowMain});
    &clr_lstore($lstore);
    &append_lstore($lstore, (0 => 'URL:', 1 => $endpoint));
    &append_lstore($lstore, (0 => 'VirtualBox Version:', 1 => $hostspec{vbver}));
    &append_lstore($lstore, (0 => 'Build Revision:', 1 => $hostspec{buildrev}));
    &append_lstore($lstore, (0 => 'Package Type:', 1 => $hostspec{pkgtype}));
    &append_lstore($lstore, (0 => 'Global Settings File:', 1 => $hostspec{settingsfile}));
    &append_lstore($lstore, (0 => 'Machine Folder:', 1 => $hostspec{machinedir}));
    &append_lstore($lstore, (0 => 'Hard Disk Folder:', 1 => $hostspec{hddir}));
    &append_lstore($lstore, (0 => 'Server Logical CPUs:', 1 => $hostspec{maxhostcpuon}));
    &append_lstore($lstore, (0 => 'Server CPU Type:', 1 => $hostspec{cpudesc}));
    &append_lstore($lstore, (0 => 'Server CPU Speed:', 1 => "$hostspec{cpuspeed} Mhz (approx)"));
    &append_lstore($lstore, (0 => 'Server Memory Size:', 1 =>  "$hostspec{memsize} MiB"));
    &append_lstore($lstore, (0 => 'Server OS:', 1 => $hostspec{os}));
    &append_lstore($lstore, (0 => 'Server OS Version:', 1 => $hostspec{osver}));
    &append_lstore($lstore, (0 => 'Min Guest RAM:', 1 => "$hostspec{minguestram} MiB"));
    &append_lstore($lstore, (0 => 'Max Guest RAM:', 1 => "$hostspec{maxguestram} MiB"));
    &append_lstore($lstore, (0 => 'Min Guest Video RAM:', 1 => "$hostspec{minguestvram} MiB"));
    &append_lstore($lstore, (0 => 'Max Guest Video RAM:', 1 => "$hostspec{maxguestvram} MiB"));
    &append_lstore($lstore, (0 => 'Max Guest CPUs:', 1 => $hostspec{maxguestcpu}));
    &append_lstore($lstore, (0 => 'Max VDI Size:', 1 => "$hostspec{maxhdsize} MiB"));
    $gui{dialogServerInfo}->run;
    $gui{dialogServerInfo}->hide;
    &unbusy_window($gui{windowMain});
}

sub show_prefs_dialog() {
    my ($widget) = @_;
    &busy_window($gui{windowMain});
    $gui{entryPrefsRDPClient}->set_text($prefs{RDPCLIENT});
    my $response = $gui{dialogPrefs}->run;
    $gui{dialogPrefs}->hide;

    if ($response eq 'ok') {
        $prefs{RDPCLIENT} = $gui{entryPrefsRDPClient}->get_text();
        &save_prefs();
    }
    &unbusy_window($gui{windowMain});
}

sub show_new_dialog() {
    my ($widget, $dialog) = @_;
    &busy_window($gui{windowMain});
    my @IMedium = IVirtualBox_getHardDisks($gui{websn});
    $gui{entryNewName}->set_text('NewGuest' . int(rand(9999)));
    $gui{notebookNew}->set_current_page(0);
    $gui{spinbuttonNewMemory}->set_range(4, $hostspec{memsize});
    $gui{spinbuttonNewHDSize}->set_range(8.00, $hostspec{maxhdsize});
    $gui{comboboxNewOSFam}->signal_handler_block($signal{fam}); # Block to avoid signal emission when changing
    $gui{comboboxNewOSVer}->signal_handler_block($signal{ver});
    &clr_lstore($gui{liststoreNewOSFam}, $gui{liststoreNewOSVer}, $gui{liststoreNewChooseHD});

    foreach my $fam (sort(keys %osfamily)) {
        my $iter = &append_lstore($gui{liststoreNewOSFam}, (0 => "$osfamily{$fam}{description}", 1 => $fam ));
        $gui{comboboxNewOSFam}->set_active_iter($iter) if ($fam eq 'Windows');
    }

    if (@IMedium > 0) {
        &append_lstore($gui{liststoreNewChooseHD}, (0 => IMedium_getName($_), 1=> $_)) foreach (@IMedium);
        $gui{comboboxNewChooseHD}->set_active(0);
        &sensitive_on($gui{radiobuttonNewExistingHD});
    }
    else { &sensitive_off($gui{radiobuttonNewExistingHD}) };

    $gui{comboboxNewOSFam}->signal_handler_unblock($signal{fam});
    $gui{comboboxNewOSVer}->signal_handler_unblock($signal{ver});
    $gui{comboboxNewOSFam}->signal_emit('changed'); # Force update of other fields based on OS
    $gui{comboboxNewOSVer}->signal_emit('changed'); # Force update of other fields based on OS
    my $response = $dialog->run;
    $dialog->hide;

    if ($response eq 'ok') {
        &busy_window($dialog);
        my $buttongrp = $gui{radiobuttonNewNewHD}->get_group();
        my %guest = (name   => $gui{entryNewName}->get_text(),
                     fam    => &get_selected($gui{comboboxNewOSFam}, 1),
                     ver    => &get_selected($gui{comboboxNewOSVer}, 1),
                     mem    => $gui{spinbuttonNewMemory}->get_value_as_int(),
                     hdsize => $gui{spinbuttonNewHDSize}->get_value_as_int());

        $guest{name} = 'NewGuest' . int(rand(9999)) if (!$guest{name});
        my ($IMachine, $dvdctrname, $hdctrname) = &create_new_guest($guest{name},$guest{fam}, $guest{ver}, $guest{mem});

        if ($IMachine) {
            my ($ISession, $IMachineM) = &get_mutable_session($IMachine);
            my $IMediumHD;

            if ($$buttongrp[0]->get_active() == 1){ $IMediumHD = &get_selected($gui{comboboxNewChooseHD}, 1); }
            else {
                my $hdimgtype = 'Fixed';
                $hdimgtype = 'Standard' if ($gui{checkbuttonNewDynamic}->get_active());
                $IMediumHD = &create_new_HD($guest{name}, 'VDI', $hdimgtype, $guest{hdsize});
            }

            my $IStorCtrHD = IMachine_getStorageControllerByName($IMachineM, $hdctrname);
            &create_sas_sata_port($IStorCtrHD);
            my ($hddev, $hdport) = &get_free_deviceport($IMachineM, $IStorCtrHD);
            IMachine_attachDevice($IMachineM, $hdctrname, $hdport, $hddev, 'HardDisk', IMedium_getId($IMediumHD));

            # Attach Empty CD/DVD Device
            my $IStorCtrDVD = IMachine_getStorageControllerByName($IMachineM, $dvdctrname);
            &create_sas_sata_port($IStorCtrDVD);
            my ($dvddev, $dvdport) = &get_free_deviceport($IMachineM, $IStorCtrDVD);
            IMachine_attachDevice($IMachineM, $dvdctrname, $dvdport, $dvddev, 'DVD', 'UUID 00000000-0000-0000-0000-000000000000');
            IMachine_saveSettings($IMachineM);
            ISession_close($ISession);
        }
        else {
            &show_err_msg('createguest', $gui{messagedialogError});
            &set_status_msg("Failed to create the new guest $guest{name}");
        }
        &unbusy_window($dialog);
        &tv_guest_fill();
    }
    &unbusy_window($gui{windowMain});
}

sub show_snapshotdetails_dialog() {
    my ($widget, $dialog) = @_;
    &busy_window($gui{windowMain});
    my $ISnapshot = &get_selected($gui{treeviewSnapshots}, 2);
    $gui{entrySnapshotDetailsName}->set_text(ISnapshot_getName($ISnapshot));
    $gui{textbufferSnapshotDetailsDescription}->set_text(ISnapshot_getDescription($ISnapshot));
    $dialog->run;
    $dialog->hide;
    &unbusy_window($gui{windowMain});
}

sub show_snapshot_dialog() {
    my ($widget, $dialog) = @_;
    &busy_window($gui{windowMain});
    $gui{textbufferSnapshotDescription}->set_text('');
    my $response = $dialog->run;
    $dialog->hide;

    if ($response eq 'ok') {
        my $iter_s = $gui{textbufferSnapshotDescription}->get_start_iter();
        my $iter_e = $gui{textbufferSnapshotDescription}->get_end_iter();
        &take_snapshot($gui{entrySnapshotName}->get_text(), $gui{textbufferSnapshotDescription}->get_text($iter_s, $iter_e, 0));
    }
    &unbusy_window($gui{windowMain});
}

sub tv_guest_fill() {
    &busy_window($gui{windowMain});
    &sensitive_off(@{ $sensgrp{unselected} });
    &set_status_msg("Retrieving the list of guests from $endpoint...");
    &clr_lstore($gui{liststoreGuest}, $gui{liststoreDetails}, $gui{treestoreSnapshots});
    $gui{textbufferDescription}->set_text('');
    my @IMachine = IVirtualBox_getMachines($gui{websn});

    foreach my $machine (@IMachine) {
        my $gname = IMachine_getName($machine);
        my $prettygname = $gname;
        my $status = IMachine_getAccessible($machine);
        my $ISnapshot = IMachine_getCurrentSnapshot($machine);
        $prettygname .=  ' (' . ISnapshot_getName($ISnapshot) . ')' if ($ISnapshot);

        &set_status_msg("Processing guest: $gname...");

        if ($status eq 'false') {
            my $IVirtualBoxErrorInfo = IMachine_getAccessError($machine);
            $status = IVirtualBoxErrorInfo_getText($IVirtualBoxErrorInfo);
        }
        else { $status = IMachine_getState($machine); }
        my $osid = IMachine_getOSTypeId($machine);
        $prettygname .= "\n   $status";
        &append_lstore($gui{liststoreGuest}, (0 => $gname,
                                              1 => $osversion{$osid}{description},
                                              2 => $machine,
                                              3 => $status,
                                              4 => $osid,
                                              5 => IMachine_getId($machine),
                                              6 => $osversion{$osid}{icon},
                                              7 => $prettygname));
    }

    &set_status_msg("Retrieved list of guests from $endpoint.");
    &unbusy_window($gui{windowMain});
}

sub open_remote_display() {
    my ($widget, $treeview) = @_;
    my ($name, $os, $IMachine) = &get_selected($treeview);
    my $IVRDPServer = IMachine_getVRDPServer($IMachine);
    my $rdpcmd = $prefs{RDPCLIENT};
    my ($user, $pass) = ($gui{comboboxentryConnectUser}->get_active_text(), $gui{entryConnectPassword}->get_text());

    if (IVRDPServer_getEnabled($IVRDPServer) eq 'true') {
        my @ports = split ( ',', IVRDPServer_getPorts($IVRDPServer)); # Multiple ports may be return ',' separated
        my $dst = $endpoint;
        $dst =~ s/^.*:\/\///;
        $dst =~ s/:\d+$//;
        $rdpcmd =~ s/%h/$dst/g;
        $rdpcmd =~ s/%p/$ports[0]/g;
        $rdpcmd =~ s/%n/$name/g;
        $rdpcmd =~ s/%o/$os/g;
        $rdpcmd =~ s/%U/$user/g;
        $rdpcmd =~ s/%P/$pass/g;
        system("$rdpcmd &");
        &set_status_msg("Sent request to open remote display: $dst:$ports[0]");
    }
    else { &show_err_msg('remotedisplay', $gui{messagedialogError}); }
}

sub populate_hostspec() {
    my $IHost = IVirtualBox_getHost($gui{websn});
    my $ISystemProperties = IVirtualBox_getSystemProperties($gui{websn});
    %hostspec = (vbver        => IVirtualBox_getVersion($gui{websn}),
                 buildrev     => IVirtualBox_getRevision($gui{websn}),
                 pkgtype      => IVirtualBox_getPackageType($gui{websn}),
                 settingsfile => IVirtualBox_getSettingsFilePath($gui{websn}),
                 os           => IHost_getOperatingSystem($IHost),
                 osver        => IHost_getOSVersion($IHost),
                 maxhostcpuon => IHost_getProcessorOnlineCount($IHost),
                 cpudesc      => IHost_getProcessorDescription($IHost),
                 cpuspeed     => IHost_getProcessorSpeed($IHost),
                 memsize      => IHost_getMemorySize($IHost),
                 machinedir   => ISystemProperties_getDefaultMachineFolder($ISystemProperties),
                 hddir        => ISystemProperties_getDefaultHardDiskFolder($ISystemProperties),
                 maxhdsize    => ISystemProperties_getMaxVDISize($ISystemProperties),
                 maxnet       => ISystemProperties_getNetworkAdapterCount($ISystemProperties),
                 maxser       => ISystemProperties_getSerialPortCount($ISystemProperties),
                 hdfolder     => ISystemProperties_getDefaultHardDiskFolder($ISystemProperties),
                 minguestcpu  => ISystemProperties_getMinGuestCPUCount($ISystemProperties),
                 maxguestcpu  => ISystemProperties_getMaxGuestCPUCount($ISystemProperties),
                 minguestram  => ISystemProperties_getMinGuestRAM($ISystemProperties),
                 maxguestram  => ISystemProperties_getMaxGuestRAM($ISystemProperties),
                 minguestvram => ISystemProperties_getMinGuestVRAM($ISystemProperties),
                 maxguestvram => ISystemProperties_getMaxGuestVRAM($ISystemProperties),
                 maxbootpos   => ISystemProperties_getMaxBootPosition($ISystemProperties),
                 maxmonitors  => ISystemProperties_getMaxGuestMonitors($ISystemProperties));
}

sub populate_ostypes() {
    my @IGuestOSType = IVirtualBox_getGuestOSTypes($gui{websn});
    %osfamily=();
    %osversion=();
    my $iconosunknown = Gtk2::Gdk::Pixbuf->new_from_file("/usr/share/remotebox/icons/os/Other.png");

    foreach my $type (@IGuestOSType) {
        if (!defined($osfamily{$$type{familyId}})) {
            $osfamily{$$type{familyId}} = {};
            $osfamily{$$type{familyId}}{verids} = ();
        }

        $osfamily{$$type{familyId}}{description} = $$type{familyDescription};
        push @{ $osfamily{$$type{familyId}}{verids} }, $$type{id};
        $osversion{$$type{id}} = {} if (!defined($osversion{$$type{id}}));
        $osversion{$$type{id}}{description} = $$type{description};
        $osversion{$$type{id}}{adapterType} = $$type{adapterType};
        $osversion{$$type{id}}{recommendedHDD} = $$type{recommendedHDD};
        $osversion{$$type{id}}{is64Bit} = $$type{is64Bit};
        $osversion{$$type{id}}{recommendedVirtEx} = $$type{recommendedVirtEx};
        $osversion{$$type{id}}{recommendedIOAPIC} = $$type{recommendedIOAPIC};
        $osversion{$$type{id}}{recommendedVRAM} = $$type{recommendedVRAM};
        $osversion{$$type{id}}{recommendedRAM} = $$type{recommendedRAM};
        $osversion{$$type{id}}{recommendedHpet} = $$type{recommendedHpet};
        $osversion{$$type{id}}{recommendedUsbHid} = $$type{recommendedUsbHid};
        $osversion{$$type{id}}{recommendedVirtEx} = $$type{recommendedVirtEx};
        $osversion{$$type{id}}{recommendedPae} = $$type{recommendedPae};
        $osversion{$$type{id}}{recommendedUsbTablet} = $$type{recommendedUsbTablet};
        $osversion{$$type{id}}{recommendedHdStorageBus} = $$type{recommendedHdStorageBus};
        $osversion{$$type{id}}{recommendedFirmware} = $$type{recommendedFirmware};
        $osversion{$$type{id}}{recommendedDvdStorageBus} = $$type{recommendedDvdStorageBus};
        $osversion{$$type{id}}{recommendedHdStorageController} = $$type{recommendedHdStorageController};
        $osversion{$$type{id}}{recommendedDvdStorageController} = $$type{recommendedDvdStorageController};
        $osversion{$$type{id}}{recommendedRtcUseUtc} = $$type{recommendedRtcUseUtc};
        $osversion{$$type{id}}{familyId} = $$type{familyId};
        if (-e "/usr/share/remotebox/icons/os/$$type{id}.png") {
            $osversion{$$type{id}}{icon} = Gtk2::Gdk::Pixbuf->new_from_file("/usr/share/remotebox/icons/os/$$type{id}.png");
        }
        else { $osversion{$$type{id}}{icon} = $iconosunknown; }
    }
}

# Saves the guest's description
sub set_guest_description() {
    my ($widget, $treeview) = @_;
    my $IMachine = &get_selected($treeview, 2);
    my ($ISession, $IMachineM) = &get_mutable_session($IMachine);
    if ($ISession) {
        &set_status_msg('Saving description...');
        my $iter_s = $gui{textbufferDescription}->get_start_iter();
        my $iter_e = $gui{textbufferDescription}->get_end_iter();
        IMachine_setDescription($IMachineM, $gui{textbufferDescription}->get_text($iter_s, $iter_e, 0));
        IMachine_saveSettings($IMachineM);
        ISession_close($ISession);
        &set_status_msg('Description saved.');
    }
    else { &show_err_msg('savedesc', $gui{messagedialogWarning}); }
}

sub create_new_guest() {
    my ($name, $fam, $ver, $mem) = @_;
    my $IMachine;
    my $dvdctrname = $osversion{$ver}{recommendedDvdStorageBus} .  ' Controller';
    my $hdctrname = $osversion{$ver}{recommendedHdStorageBus} . ' Controller';
    &set_status_msg("Creating new guest $name...");
    my $portnum = int(rand(15000)) + 50000; # Pick random between 50000 and 65000
    $IMachine = IVirtualBox_createMachine($gui{websn}, $name, $ver, '', 'UUID 00000000-0000-0000-0000-000000000000');

    if ($IMachine) {
        my $IVRDPServer = IMachine_getVRDPServer($IMachine);
        my $IBIOSSettings = IMachine_getBIOSSettings($IMachine);
        IBIOSSettings_setIOAPICEnabled($IBIOSSettings, $ETruth{$osversion{$ver}{recommendedIOAPIC}});
        IMachine_setCPUProperty($IMachine, 'PAE', $ETruth{$osversion{$ver}{recommendedPae}});
        IMachine_setHWVirtExProperty($IMachine, 'Enabled', $ETruth{$osversion{$ver}{recommendedVirtEx}});
        IMachine_setVRAMSize($IMachine, $osversion{$ver}{recommendedVRAM});
        IMachine_setFirmwareType($IMachine, $osversion{$ver}{recommendedFirmware});
        IMachine_setMemorySize($IMachine, $mem);
        my $IStorCtrDVD = IMachine_addStorageController($IMachine, $dvdctrname, $osversion{$ver}{recommendedDvdStorageBus});
        IStorageController_setControllerType($IStorCtrDVD, $osversion{$ver}{recommendedDvdStorageController});

        if ($osversion{$ver}{recommendedHdStorageBus} ne $osversion{$ver}{recommendedDvdStorageBus}) {
            my $IStorCtrHD = IMachine_addStorageController($IMachine, $hdctrname, $osversion{$ver}{recommendedHdStorageBus});
            IStorageController_setControllerType($IStorCtrHD, $osversion{$ver}{recommendedHdStorageController});
        }

        IVRDPServer_setPorts($IVRDPServer, $portnum);
        IVRDPServer_setEnabled($IVRDPServer, 'true');
        IMachine_saveSettings($IMachine);
        IVirtualBox_registerMachine($gui{websn}, $IMachine);
        &set_status_msg("Completed creation of guest $name.");
    }

    return $IMachine, $dvdctrname, $hdctrname;
}

sub create_new_HD() {
    my ($diskname, $format, $type, $size) = @_;
    &set_status_msg("Creating new hard disk...");
    my $IMedium = IVirtualBox_createHardDisk($gui{websn}, $format, "$hostspec{hdfolder}/$diskname.vdi");
    my $IProgress = IMedium_createBaseStorage($IMedium, $size, $type);

    do {
        &set_status_msg('Creating new hard disk... ' . IProgress_getPercent($IProgress) . '% complete.');
        sleep 1; # Poll only every 1 second
    } until (IProgress_getCompleted($IProgress) eq 'true');

    &set_status_msg('Completed creation of hard disk.');
    return $IMedium;
}

# SATA/SAS Controllers need a port created before attachments can be made
sub create_sas_sata_port() {
    my ($IStorCtr) = @_;
    my $bus = IStorageController_getBus($IStorCtr);
    if ($bus eq 'SATA' or $bus eq 'SAS') {
        my ($pc, $mpc) = (IStorageController_getPortCount($IStorCtr), IStorageController_getMaxPortCount($IStorCtr));
        IStorageController_setPortCount($IStorCtr, $pc + 1) if ($pc < $mpc);
    }
}

sub keyboard_CAD() {
    my ($widget, $treeview) = @_;
    my ($gname, $IMachine) = (&get_selected($gui{treeviewGuest}, 0), &get_selected($gui{treeviewGuest}, 2));
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IKeyboard = IConsole_getKeyboard($IConsole);
        IKeyboard_putCAD($IKeyboard);
        &set_status_msg("Sent Ctr-Alt-Del to $gname");
        ISession_close($ISession);
    }
}


sub newgen_osfam() {
    my ($combofam, $combover) = @_;
    my $fam = &get_selected($combofam, 1);
    $combofam->signal_handler_block($signal{fam}); # Block to avoid signal emission when changing
    $combover->signal_handler_block($signal{ver});
    &clr_lstore($gui{liststoreNewOSVer});

    foreach my $ver (sort(@{ $osfamily{$fam}{verids} })) {
        my $iter = &append_lstore($gui{liststoreNewOSVer}, (0 => "$osversion{$ver}{description}", 1 => "$ver" ));
        $combover->set_active_iter($iter) if ($ver eq 'WindowsXP' | $ver eq 'Ubuntu' | $ver eq 'Solaris');
    }

    $combover->set_active(0) if ($combover->get_active() == -1);
    $combofam->signal_handler_unblock($signal{fam});
    $combover->signal_handler_unblock($signal{ver});
    $combover->signal_emit('changed'); # Force update of other fields based on OS
}

sub newgen_osver() {
    my ($combover, $combofam) = @_;
    my $ver = &get_selected($combover, 1);
    $combofam->signal_handler_block($signal{fam}); # Avoid signal emission when changing
    $combover->signal_handler_block($signal{ver});
    $gui{spinbuttonNewMemory}->set_value($osversion{$ver}{recommendedRAM});
    $gui{spinbuttonNewHDSize}->set_value($osversion{$ver}{recommendedHDD});
    $combofam->signal_handler_unblock($signal{fam});
    $combover->signal_handler_unblock($signal{ver});
}

sub newstor_new_exist() {
    my ($widget) = @_;
    my $buttongrp = $widget->get_group();

    if ($$buttongrp[0]->get_active() == 1) {
        &sensitive_on($gui{comboboxNewChooseHD});
        &sensitive_off($gui{checkbuttonNewDynamic}, $gui{spinbuttonNewHDSize});
    }
    else {
        &sensitive_off($gui{comboboxNewChooseHD});
        &sensitive_on($gui{checkbuttonNewDynamic}, $gui{spinbuttonNewHDSize});
    }
}

# Make DVD submenu. This gets called when the parent DVD menu is highlighted
# because it's less expensive here than calling it everytime the main menu is opened.
sub fill_TGDVD_menu() {
    # Hijack the submenu from the temporary one (gets restored on exit)
    my $dvdmenu = Gtk2::Menu->new();
    $gui{menuitemTGDVD}->set_submenu($dvdmenu);
    my %IMediumDVD = &get_all_media('DVD');
    my $item = Gtk2::MenuItem->new_with_label('Unmount CD/DVD');
    $dvdmenu->append($item);
    $item->show();
    $item->signal_connect(activate => \&mount_dvd, 'UUID 00000000-0000-0000-0000-000000000000');
    my $sep = Gtk2::SeparatorMenuItem->new();
    $dvdmenu->append($sep);
    $sep->show();

    foreach my $medium (sort { lc($a) cmp lc($b) } (keys %IMediumDVD)) {
        my $item = Gtk2::MenuItem->new_with_label($medium);
        $dvdmenu->append($item);
        $item->show();
        $item->signal_connect(activate => \&mount_dvd, IMedium_getId($IMediumDVD{$medium}));
    }
}

# Return a hash of media with key as name (useful for sorting)
sub get_all_media() {
    my ($type) = @_;
    my @IMedium;
    my %media;

    if ($type eq 'DVD') { @IMedium = IVirtualBox_getDVDImages($gui{websn}); }
    elsif ($type eq 'Floppy') { @IMedium = IVirtualBox_getFloppyImages($gui{websn}); }
    else { @IMedium = IVirtualBox_getHardDisks($gui{websn}); }

    foreach my $medium (@IMedium) {
        my $name = IMedium_getName($medium);
        $media{$name} = $medium;
    }

    return %media;
}

# Make Floppy submenu. This gets called when the parent Floppy menu is highlighted
# because it's less expensive here than calling it everytime the main menu is opened.
sub fill_TGFloppy_menu() {
    # Hijack the submenu from the temporary one (gets restored on exit)
    my $floppymenu = Gtk2::Menu->new();
    $gui{menuitemTGFloppy}->set_submenu($floppymenu);
    my %IMediumFloppy = &get_all_media('Floppy');
    my $item = Gtk2::MenuItem->new_with_label('Unmount Floppy');
    $floppymenu->append($item);
    $item->show();
    $item->signal_connect(activate => \&mount_floppy, 'UUID 00000000-0000-0000-0000-000000000000');
    my $sep = Gtk2::SeparatorMenuItem->new();
    $floppymenu->append($sep);
    $sep->show();

    foreach my $medium (sort { lc($a) cmp lc($b) } (keys %IMediumFloppy)) {
        my $item = Gtk2::MenuItem->new_with_label($medium);
        $floppymenu->append($item);
        $item->show();
        $item->signal_connect(activate => \&mount_floppy, IMedium_getId($IMediumFloppy{$medium}));
    }
}

sub mount_dvd() {
    my ($widget, $muuid) = @_;
    my $IMachine = &get_selected($gui{treeviewGuest}, 2);
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        my $IMachineM = ISession_getMachine($ISession);
        my $IConsole = ISession_getConsole($ISession);

        my @IMediumAttachment = IMachine_getMediumAttachments($IMachineM);
        foreach my $attach (@IMediumAttachment) {
            next if ($$attach{type} ne 'DVD');
            IMachine_mountMedium($IMachineM, $$attach{controller}, $$attach{port}, $$attach{device}, $muuid, 1);
            last;
        }
        IMachine_saveSettings($IMachineM);
        ISession_close($ISession);
    }
}

sub mount_floppy() {
    my ($widget, $muuid) = @_;
    my $IMachine = &get_selected($gui{treeviewGuest}, 2);
    my $ISession = &get_existing_session($IMachine);

    if ($ISession) {
        my $IMachineM = ISession_getMachine($ISession);
        my $IConsole = ISession_getConsole($ISession);

        my @IMediumAttachment = IMachine_getMediumAttachments($IMachineM);
        foreach my $attach (@IMediumAttachment) {
            next if ($$attach{type} ne 'Floppy');
            IMachine_mountMedium($IMachineM, $$attach{controller}, $$attach{port}, $$attach{device}, $muuid, 1);
            last;
        }
        IMachine_saveSettings($IMachineM);
        ISession_close($ISession);
    }
}

sub show_tg_menu() {
    my ($widget, $event) = @_;
    my $IMachine = &get_selected($widget, 2);

    if ($IMachine) { # in case button is clicked on an empty list
        # Check if guest has CDROM/Floppy connected and enable/disable option as appropriate
        &sensitive_off($gui{menuitemTGFloppy}, $gui{menuitemTGDVD});
        my @IStorageController = IMachine_getStorageControllers($IMachine);
        foreach my $ctr (@IStorageController) {
            my $bus = IStorageController_getBus($ctr);
            if ($bus eq 'IDE') {
                my $cname = IStorageController_getName($ctr);
                my @IMediumAttachments = IMachine_getMediumAttachmentsOfController($IMachine, $cname);
                foreach my $attach (@IMediumAttachments) {
                    &sensitive_on($gui{menuitemTGDVD}) if ($$attach{type} eq 'DVD');
                }
            }
            elsif ($bus eq 'Floppy') {
                my $cname = IStorageController_getName($ctr);
                my @IMediumAttachments = IMachine_getMediumAttachmentsOfController($IMachine, $cname);
                foreach my $attach (@IMediumAttachments) {
                    &sensitive_on($gui{menuitemTGFloppy}) if ($$attach{type} eq 'Floppy');
                }
            }
        }

        $gui{menuTG}->popup(undef, undef, undef, undef, 0, $event->time) if ($event->button == 3);
    }

    return 0;
}

sub tv_guest_selected() {
    my ($widget, $lstore) = @_;
    my $IMachine = &get_selected($gui{treeviewGuest}, 2);

    &clr_lstore($lstore);
    &sensitive_off(@{ $sensgrp{unselected} });
    $gui{textbufferDescription}->set_text(IMachine_getDescription($IMachine));
    my $status = IMachine_getState($IMachine);
    &tv_snapshot_fill($gui{buttonRefreshSnapshots}, $gui{treestoreSnapshots});
    if ($status eq 'Running' | $status eq 'Starting') { &sensitive_on(@{ $sensgrp{running} }); }
    elsif ($status eq 'Saved' | $status eq 'Paused') { &sensitive_on(@{ $sensgrp{saved} }); }
    elsif ($status eq 'PoweredOff' | $status eq 'Aborted') { &sensitive_on(@{ $sensgrp{poweroff} }); }
    else { &sensitive_off(@{ $sensgrp{unselected} }); }
    #}
}

# Fill snapshot and detail views on double click
sub tv_guest_double() {
    my ($widget) = @_;
    &tv_snapshot_fill($widget, $gui{treestoreSnapshots});
    &tv_details_fill($widget, $gui{liststoreDetails});
}

sub name_validate() {
    my ($entry, $char, $len, $pos) = @_;
    $char =~ s/[\?\/\;\*\\\<\>\|\.]//; # Strip these chars
    return $char, $pos;
}

sub hex_validate() {
    my ($entry, $char, $len, $pos) = @_;
    $char =~ s/[^A-F0-9a-f]//; # Strip everything but these chars
    return $char, $pos;
}

sub port_validate() {
    my ($entry, $char, $len, $pos) = @_;
    $char =~ s/[^0-9,-]//; # Strip everything but these chars
    return $char, $pos;
}

sub number_validate() {
    my ($entry, $char, $len, $pos) = @_;
    $char =~ s/[^0-9]//; # Strip everything but these chars
    return $char, $pos;
}

