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

$|=1;

our (%gui, %signal, %sensgrp, %ETruth, %EAbled, %hostspec, %osfamily, %osversion, $EIMachineM, %prefs);
$endpoint = 'http://localhost:18083';
$fault = \&vboxerror;

&log_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 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_list_guest();
    $gui{textbufferDescription}->set_text('');
}

sub show_connect_dialog() {
    &clr_list($gui{liststoreConnectURL}, $gui{liststoreConnectUser});
    &addrow_list($gui{liststoreConnectURL}, 0, $_) foreach (keys (%{$prefs{URL}}));
    &addrow_list($gui{liststoreConnectUser}, 0, $_) foreach (keys(%{$prefs{USER}}));
    my $response = $gui{dialogConnect}->run;
    $gui{dialogConnect}->hide;
    $gui{dialogConnect}->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}, " ($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}, " ($url)");
                &virtualbox_logoff();
            }
            else {
                &log_msg("Logged onto $endpoint.");
                &show_err_msg('vboxver', $gui{messagedialogWarning}, "\nDetected Version: $ver") if ($ver !~ m/^3.2/);
                &show_err_msg('vboxose', $gui{messagedialogWarning}) if ($ver =~ m/_OSE$/);
                &populate_hostspec();
                &log_msg("Server is running VirtualBox $hostspec{vbver}.");
                &populate_ostypes();
                &fill_list_guest();
                &sensitive_on(@{ $sensgrp{connect} });
            }
        }
    }
}

sub show_about_dialog() {
    $gui{aboutdialog}->run;
    $gui{aboutdialog}->hide;
}

sub show_serverinfo_dialog() {
    &fill_list_serverinfo();
    $gui{dialogServerInfo}->run;
    $gui{dialogServerInfo}->hide;
}

sub show_snapshotdetails_dialog() {
    my %snap = &getsel_list_snapshots();
    $gui{entrySnapshotName}->set_text(ISnapshot_getName($snap{ISnapshot}));
    $gui{textbufferSnapshotDescription}->set_text(ISnapshot_getDescription($snap{ISnapshot}));
    my $response = $gui{dialogSnapshot}->run;
    $gui{dialogSnapshot}->hide;

    if ($response eq 'ok') {
        my $iter_s = $gui{textbufferSnapshotDescription}->get_start_iter();
        my $iter_e = $gui{textbufferSnapshotDescription}->get_end_iter();
        ISnapshot_setDescription($snap{ISnapshot}, $gui{textbufferSnapshotDescription}->get_text($iter_s, $iter_e, 0));
        ISnapshot_setName($snap{ISnapshot}, $gui{entrySnapshotName}->get_text());
        &fill_list_snapshots();
    }
}

sub show_snapshot_dialog() {
    my ($widget) = @_; # Need to reuse dialog for snapshot details
    $gui{entrySnapshotName}->set_text('Snapshot');
    $gui{textbufferSnapshotDescription}->set_text('');
    my $response = $gui{dialogSnapshot}->run();
    $gui{dialogSnapshot}->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));
    }
}

sub reset_guest() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_reset($IConsole);
        ISession_close($ISession);
        &log_msg("Reset signal sent to $guest{Name}.");
    }
}

sub stop_guest_poweroff() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_powerDown($IConsole);
        &show_progress_window2($IProgress, "Powering off $guest{Name}...", '', $guest{IMachine}, 'PoweredOff');
    }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &log_msg("Power off signal sent to $guest{Name}.");
    &fill_list_guest();
}

sub stop_guest_acpi() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_powerButton($IConsole);
    }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &log_msg("APCI shutdown signal sent to $guest{Name}.");
    &fill_list_guest();
}

sub stop_guest_savestate() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_saveState($IConsole);
        &show_progress_window2($IProgress, "Saving state of $guest{Name}...", '', $guest{IMachine}, 'Saved');
    }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &fill_list_guest();
    &log_msg("Saved the state of $guest{Name}.");
}

sub pause_guest() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_pause($IConsole);
    }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &fill_list_guest();
    &log_msg("Paused the state of $guest{Name}.");
}

sub resume_guest() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        IConsole_resume($IConsole);
    }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &fill_list_guest();
    &log_msg("Resumed the state of $guest{Name}.");
}

sub start_guest() {
    my %guest = &getsel_list_guest();
    my $ISession = IWebsessionManager_getSessionObject($gui{websn});
    my $IProgress = IVirtualBox_openRemoteSession($gui{websn}, $ISession, $guest{Uuid}, 'vrdp', "");

    if ($IProgress) {
        my $resultcode = &show_progress_window($IProgress, "Starting $guest{Name}...", 'cancel');

        if ( $resultcode != 0) {
            my $IVirtualBoxErrorInfo = IProgress_getErrorInfo($IProgress);
            &show_err_msg('startguest', $gui{messagedialogError}, "Guest: $guest{Name}\nCode: $resultcode\nError:\n" . IVirtualBoxErrorInfo_getText($IVirtualBoxErrorInfo));
        }
        else { &log_msg("Start signal sent to $guest{Name}."); }

    }
    else { &show_err_msg('sessionopen', $gui{messagedialogError}, " ($guest{Name})"); }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
    &fill_list_guest();
}

sub delete_guest() {
    my %guest = &getsel_list_guest();

    # Say we can't delete if a machine has snapshots
    if (IMachine_getCurrentSnapshot($guest{IMachine})) {
        &show_err_msg('delguestwsnap', $gui{messagedialogWarning}, " ($guest{Name})");
        return 1;
    }

    my $response = $gui{dialogDeleteGuest}->run;
    $gui{dialogDeleteGuest}->hide;

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

        if ($ISession) {
            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) if (ISession_getState($ISession) ne 'Closed');
            IVirtualBox_unregisterMachine($gui{websn}, $machineid);
            IMachine_deleteSettings($guest{IMachine});
            &log_msg("Deleted $guest{Name}.");
            &fill_list_guest();
        }
        else { &show_err_msg('deleteguest', $gui{messagedialogWarning}, " ($guest{Name})"); }
    }
}

sub recurse_snapshot() {
    my ($ISnapshot, $iter, $ISnapshot_current) = @_;
    my $citer = $gui{treestoreSnapshots}->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)"; }
    $gui{treestoreSnapshots}->set($citer, 0, $snapname, 1, $date, 2, $ISnapshot);
    my @snapshots = ISnapshot_getChildren($ISnapshot);
    if (@snapshots > 0) { &recurse_snapshot($_, $citer, $ISnapshot_current) foreach (@snapshots); }
}

sub restore_snapshot() {
    my %snap = &getsel_list_snapshots();
    my %guest = &getsel_list_guest();
    my ($ISession, $IMachineM) = &get_mutable_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_restoreSnapshot($IConsole, $snap{ISnapshot});
        &show_progress_window($IProgress, "Restoring $guest{Name} to $snap{Name}...");
        &log_msg("Snapshot of $guest{Name} restored.");
        &fill_list_snapshots();
    }
    else { &show_err_msg('restorefail', $gui{messagedialogError}, " ($guest{Name})"); }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
}

sub delete_snapshot() {
    my %snap = &getsel_list_snapshots();
    my %guest = &getsel_list_guest();
    my $suuid = ISnapshot_getId($snap{ISnapshot});
    my ($ISession, $IMachineM) = &get_mutable_session($guest{IMachine}); # Try running machine first
    $ISession = &get_existing_session($guest{IMachine}) if (!$ISession); # Fall back to powered off

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_deleteSnapshot($IConsole, $suuid);
        &show_progress_window($IProgress, "Deleting snapshot of $guest{Name}...");
        &log_msg("Snapshot of $guest{Name} deleted.");
        &fill_list_snapshots();
    }
    else { &show_err_msg('snapdelete', $gui{messagedialogError}, " ($guest{Name})"); }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
}

sub take_snapshot() {
    my ($name, $description) = @_;
    $name = 'Snapshot' if (!$name);
    my %guest = &getsel_list_guest();
    my ($ISession, $IMachineM) = &get_mutable_session($guest{IMachine}); # Try running machine first
    $ISession = &get_existing_session($guest{IMachine}) if (!$ISession); # Fall back to powered off

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IProgress = IConsole_takeSnapshot($IConsole, $name, $description);
        &show_progress_window($IProgress, "Taking snapshot of $guest{Name}...");
        &log_msg("Created a new snapshot of $guest{Name}.");
        &fill_list_snapshots();
    }
    else { &show_err_msg('snapshotfail', $gui{messagedialogError}, " ($guest{Name})"); }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
}

sub open_remote_display() {
    my %guest = &getsel_list_guest();
    my $rdpcmd = $prefs{RDPCLIENT};
    my ($user, $pass) = ($gui{comboboxentryConnectUser}->get_active_text(), $gui{entryConnectPassword}->get_text());
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IRemoteDisplayInfo = IConsole_getRemoteDisplayInfo($IConsole);
        ISession_close($ISession);

        if ($$IRemoteDisplayInfo{port} > 0) {
            my $dst = $endpoint;
            $dst =~ s/^.*:\/\///;
            $dst =~ s/:\d+$//;
            $rdpcmd =~ s/%h/$dst/g;
            $rdpcmd =~ s/%p/$$IRemoteDisplayInfo{port}/g;
            $rdpcmd =~ s/%n/$guest{Name}/g;
            $rdpcmd =~ s/%o/$guest{Os}/g;
            $rdpcmd =~ s/%U/$user/g;
            $rdpcmd =~ s/%P/$pass/g;
            system("$rdpcmd &");
            &log_msg("Sent request to open remote display: $dst:$$IRemoteDisplayInfo{port}");
        }
        else { &show_err_msg('remotedisplay', $gui{messagedialogError}, " ($guest{Name})"); }
    }
}

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("$Bin/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}}{icon} = Gtk2::Gdk::Pixbuf->new_from_file("$Bin/share/remotebox/icons/os/$$type{familyId}.png");
        }

        $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 "$Bin/share/remotebox/icons/os/$$type{id}.png") {
            $osversion{$$type{id}}{icon} = Gtk2::Gdk::Pixbuf->new_from_file("$Bin/share/remotebox/icons/os/$$type{id}.png");
        }
        else { $osversion{$$type{id}}{icon} = $iconosunknown; }
    }
}

# Saves the guest's description
sub set_guest_description() {
    my %guest = &getsel_list_guest();
    my ($ISession, $IMachineM) = &get_mutable_session($guest{IMachine});

    if ($ISession) {
        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);
        &log_msg("Saved description of $guest{Name}.");
    }
    else { &show_err_msg('savedesc', $gui{messagedialogWarning}, " ($guest{Name})"); }

    ISession_close($ISession) if (ISession_getState($ISession) ne 'Closed');
}

sub show_tg_menu() {
    my ($widget, $event) = @_;
    my %guest = &getsel_list_guest();

    if ($guest{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($guest{IMachine});
        foreach my $ctr (@IStorageController) {
            my $bus = IStorageController_getBus($ctr);
            if ($bus eq 'IDE') {
                my $cname = IStorageController_getName($ctr);
                my @IMediumAttachments = IMachine_getMediumAttachmentsOfController($guest{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($guest{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;
}

# 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}));
    }
}

# 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 %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{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 %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{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 keyboard_CAD() {
    my %guest = &getsel_list_guest();
    my $ISession = &get_existing_session($guest{IMachine});

    if ($ISession) {
        my $IConsole = ISession_getConsole($ISession);
        my $IKeyboard = IConsole_getKeyboard($IConsole);
        IKeyboard_putCAD($IKeyboard);
        &log_msg("Sent Ctrl-Alt-Delete to $guest{Name}");
        ISession_close($ISession);
    }
}

# 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;
}

# 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;
}

# 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;
    my $state = IMachine_getState($IMachine);

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

    return $ISession;
}
