let Genode = env:DHALL_GENODE let Prelude = Genode.Prelude let XML = Prelude.XML let Init = Genode.Init let Child = Init.Child let Resources = Init.Resources let ServiceRoute = Init.ServiceRoute let Libc = Genode.Libc let VFS = Genode.VFS let BootFormat = < ISO | VDI > let Params : Type = { bootFilename : Text , bootPkg : Text , bootUuid : Text , bootFormat : BootFormat , memorySize : Natural , vmName : Text } let toVbox = λ(params : Params) → let vboxConfig = let hardDisks = merge { ISO = XML.text "" , VDI = XML.leaf { name = "HardDisk" , attributes = toMap { uuid = "{${params.bootUuid}}" , location = "${params.bootFilename}" , format = "VDI" , type = "Normal" } } } params.bootFormat let dvdImages = merge { ISO = XML.leaf { name = "Image" , attributes = toMap { uuid = "{${params.bootUuid}}" , location = "${params.bootFilename}" } } , VDI = XML.text "" } params.bootFormat let attachedDevices = XML.element { name = "AttachedDevice" , attributes = merge { ISO = toMap { passthrough = "false" , type = "DVD" , port = "3" , device = "0" } , VDI = toMap { type = "HardDisk", port = "0", device = "0" } } params.bootFormat , content = [ XML.leaf { name = "Image" , attributes = toMap { uuid = "{${params.bootUuid}}" } } ] } in '' ${XML.render hardDisks} ${XML.render dvdImages} ${XML.render attachedDevices} '' in Child.flat Child.Attributes::{ , binary = "virtualbox5" , config = ( Libc.toConfig Libc::{ , vfs = let mutableVfs = let fsNode = [ XML.leaf { name = "fs" , attributes = toMap { label = "nix/store" , root = "${params.bootPkg}" } } ] in merge { ISO = [ XML.leaf { name = "fs" , attributes = toMap { writeable = "yes" } } , XML.element { name = "import" , attributes = toMap { overwrite = "no" } , content = fsNode } ] , VDI = [ XML.leaf { name = "fs" , attributes = toMap { writeable = "yes" } } , XML.element { name = "import" , attributes = toMap { overwrite = "no" } , content = fsNode } ] } params.bootFormat in [ VFS.inline "machine.vbox" vboxConfig , VFS.dir "dev" [ VFS.leaf "log" , VFS.leaf "null" , VFS.leaf "rtc" ] ] # mutableVfs } ) with attributes = toMap { vbox_file = "machine.vbox", vm_name = params.vmName } , resources = Resources::{ , caps = 1024 , ram = Genode.units.MiB 128 + Genode.units.MiB params.memorySize } , routes = [ ServiceRoute.parent "File_system" , ServiceRoute.parent "Nic" , ServiceRoute.parent "Gui" , ServiceRoute.parent "Rtc" , ServiceRoute.parent "Timer" , ServiceRoute.parent "VM" , ServiceRoute.parent "Report" , ServiceRoute.parentLabel "ROM" (Some "platform_info") (Some "platform_info") ] } in toVbox