diff --git a/bin/vbox-start.hs b/bin/vbox-start.hs
new file mode 100644
index 0000000..cdd2b88
--- /dev/null
+++ b/bin/vbox-start.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+--------------------------------------------------------------------------------
+-- | Start a VirtualBox instance with a sentinel wrapper process.
+--
+-- The only reason why this is needed is because I want to manage virtualboxes
+-- in their own dynamic workspaces, which are currently set up to correspond to
+-- one process. The problem with Virtualbox is that the VBoxManage command
+-- spawns a new VM and then exits, which means the process that was originally
+-- attached to the dynamic workspace only exists for a few seconds when the VM
+-- is starting.
+--
+-- Solution: Run VBoxManage in a wrapper binary that launches the VM and sleeps
+-- until its PID exits. By monitoring this wrapper, the dynamic workspace only
+-- has one process to track and will maintain the workspace throughout the
+-- lifetime of the VM.
+
+module Main (main) where
+
+import           Control.Exception
+
+import           Data.List
+
+import           Text.Read
+import           Text.XML.Light
+
+import           System.Environment
+import           System.Exit
+
+import           XMonad.Internal.Concurrent.VirtualBox
+import           XMonad.Internal.Process
+
+main :: IO ()
+main = runAndWait =<< getArgs
+
+runAndWait :: [String] -> IO ()
+runAndWait [n] = either putStrLn runConfig =<< vmInstanceConfig n
+  where
+    runConfig c = maybe err runID =<< vmMachineID c
+    runID i = do
+      vmLaunch i
+      p <- vmPID i
+      waitUntilExit p
+    err = putStrLn "Could not get machine ID"
+
+runAndWait _ = putStrLn "Usage: vbox-start VBOXNAME"
+
+vmLaunch :: String -> IO ()
+vmLaunch i = do
+  (rc, _, _) <- readCreateProcessWithExitCode' cmd ""
+  case rc of
+    ExitSuccess -> return ()
+    _           -> putStrLn $ "Failed to start VM: " ++ i
+  where
+    cmd = proc "VBoxManage" ["startvm", i]
+
+vmPID :: String -> IO (Maybe Int)
+vmPID vid = do
+  (rc, out, _) <- readCreateProcessWithExitCode' cmd ""
+  return $ case rc of
+    ExitSuccess -> readMaybe out
+    _           -> Nothing
+  where
+    cmd = proc "pgrep" ["-f", "VirtualBoxVM.*" ++ vid]
+
+vmMachineID :: FilePath -> IO (Maybe String)
+vmMachineID iPath = do
+  (s :: Either IOException String) <- try $ readFile iPath
+  return $ case s of
+    (Left _)  -> Nothing
+    (Right x) -> findMachineID =<< parseXMLDoc x
+  where
+    findMachineID e = stripPrefix "{"
+      =<< (fmap reverse . stripPrefix "}" . reverse)
+      =<< findAttr (blank_name { qName = "uuid" })
+      =<< findChild (qual e "Machine") e
+
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 3673b88..765a229 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -262,6 +262,7 @@ gimpDynamicWorkspace = sometimesIO_ "gimp workspace" "gimp" tree dw
       <&&> className =? c
     c = "Gimp-2.10" -- TODO I don't feel like changing the version long term
 
+-- TODO don't hardcode the VM name/title/shortcut
 vmDynamicWorkspace :: Sometimes DynWorkspace
 vmDynamicWorkspace = Sometimes "virtualbox workspace" xpfVirtualBox
   [Subfeature root "windows 8 VM"]
diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs
index 4ec10e4..c72d7f3 100644
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@@ -286,6 +286,7 @@ runToggleEthernet = Sometimes "ethernet toggle" xpfEthernet
 runRestart :: X ()
 runRestart = restart "xmonad" True
 
+-- TODO only recompile the VM binary if we have virtualbox enabled
 runRecompile :: X ()
 runRecompile = do
   -- assume that the conf directory contains a valid stack project
diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
index ceefbb2..b128cc8 100644
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@@ -4,6 +4,8 @@
 
 module XMonad.Internal.Concurrent.VirtualBox
   ( vmExists
+  , vmInstanceConfig
+  , qual
   ) where
 
 import           Control.Exception
@@ -13,18 +15,23 @@ import           Data.Internal.Dependency
 import           Text.XML.Light
 
 import           System.Directory
+import           System.FilePath
 
 import           XMonad.Internal.Shell
 
 vmExists :: String -> IO (Maybe Msg)
-vmExists vm = do
-  d <- vmDirectory
-  either (return . Just . Msg Error) findVMDir d
+vmExists vm = either (const Nothing) (Just . Msg Error) <$> vmInstanceConfig vm
+
+vmInstanceConfig :: String -> IO (Either String FilePath)
+vmInstanceConfig vmName = do
+  either (return . Right) findInstance =<< vmDirectory
   where
-    findVMDir vd = do
-      vs <- listDirectory vd
-      return $ if vm `elem` vs then Nothing
-        else Just $ Msg Error $ "could not find " ++ singleQuote vm
+    path = vmName </> (vmName ++ ".vbox")
+    findInstance dir = do
+      res <- findFile [dir] path
+      return $ case res of
+        Just p  -> Right p
+        Nothing -> Left $ "could not find VM instance: " ++ singleQuote vmName
 
 vmDirectory :: IO (Either String String)
 vmDirectory = do
@@ -38,7 +45,9 @@ vmDirectory = do
     findDir e = findAttr (unqual "defaultMachineFolder")
       =<< findChild (qual e "SystemProperties")
       =<< findChild (qual e "Global") e
-    qual e n = (elName e) { qName = n }
+
+qual :: Element -> String -> QName
+qual e n = (elName e) { qName = n }
 
 vmConfig :: IO FilePath
 vmConfig = getXdgDirectory XdgConfig "VirtualBox/VirtualBox.xml"
diff --git a/my-xmonad.cabal b/my-xmonad.cabal
index fdd7c20..af9b902 100644
--- a/my-xmonad.cabal
+++ b/my-xmonad.cabal
@@ -89,3 +89,15 @@ executable xmobar
                  , unix >= 2.7.2.2
     default-language: Haskell2010
     ghc-options: -Wall -Werror -Wpartial-fields -fno-warn-missing-signatures -threaded
+
+executable vbox-start
+    main-is: bin/vbox-start.hs
+    build-depends: base
+                 , my-xmonad
+                 , process >= 1.6.5.0
+                 , filepath >= 1.4.2.1
+                 , directory >= 1.3.3.0
+                 , unix >= 2.7.2.2
+                 , xml >= 1.3.14
+    default-language: Haskell2010
+    ghc-options: -Wall -Werror -Wpartial-fields -fno-warn-missing-signatures -threaded
\ No newline at end of file