QEMU.hs

{-# LANGUAGE OverloadedStrings #-}

module Haskus.Apps.System.Build.QEMU
   ( qemuExecRamdisk
   , qemuExecISO
   , qemuGetProfileConfig
   , qemuExec
   )
where

import Haskus.Apps.System.Build.Config
import Haskus.Apps.System.Build.Utils
import Haskus.Apps.System.Build.Ramdisk
import Haskus.Apps.System.Build.Linux

import Data.List
import qualified Data.Text as Text

-- | Execute (ramdisk + kernel)
qemuExecRamdisk :: SystemConfig -> IO ()
qemuExecRamdisk config = do
   
   (args,kargs) <- qemuGetProfileConfig (qemuConfig config)

   kernel  <- linuxKernelFile (linuxConfig config)
   ramdisk <- ramdiskGetPath (ramdiskConfig config)
   let rdinit = Text.unpack (ramdiskInit (ramdiskConfig config))

   let kerRdArgs = concat $ intersperse " "
         [ "-kernel", kernel
         , "-initrd", ramdisk
         , "-append", ("\"rdinit=/" ++ rdinit ++ " " ++ kargs ++ "\"")
         ]

   qemuExec (args ++ " " ++ kerRdArgs)

-- | Execute ISO
qemuExecISO :: SystemConfig -> FilePath -> IO ()
qemuExecISO config isoPath = do
   
   (args,_) <- qemuGetProfileConfig (qemuConfig config)

   let kerRdArgs = concat $ intersperse " "
         [ "-cdrom", isoPath
         ]

   qemuExec (args ++ " " ++ kerRdArgs)


qemuExec :: String -> IO ()
qemuExec args = do
   let cmd = "qemu-system-x86_64 " ++ args

   showStep "Launching QEMU..."
   shellWaitErr cmd $ failWith "Cannot execute QEMU"


qemuGetProfileConfig :: QEMUConfig -> IO (String,String)
qemuGetProfileConfig config =
   case qemuProfile config of
      "vanilla" -> return ( Text.unpack (qemuOptions config)
                          , Text.unpack (qemuKernelArgs config)
                          )
      "default" -> return $
         (concat $ intersperse " "
            [ "-enable-kvm"
            , "-machine q35"
            , "-serial stdio"
            , "-vga std"
            --, "-show-cursor"
            , "-usb"
            , "-device usb-ehci,id=ehci"
            , "-device usb-tablet,bus=usb-bus.0"
            , "-device intel-hda -device hda-duplex"
            , Text.unpack (qemuOptions config)
            ]
         , concat $ intersperse " "
            [ "console=ttyS0 atkbd.softraw=0 quiet"
            , Text.unpack (qemuKernelArgs config)
            ]
         )
      p         -> failWith $ "Invalid QEMU profile: " ++ Text.unpack p