-- SPDX-License-Identifier: CC0-1.0 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 Vfs/inline = λ(name : Text) → λ(body : Text) → XML.element { name = "inline" , attributes = toMap { name = name } , content = [ XML.text body ] } 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 = Init.Config::{ , attributes = toMap { vbox_file = "machine.vbox", vm_name = params.vmName } , content = [ XML.leaf { name = "libc" , attributes = toMap { stdout = "/dev/log" , stderr = "/dev/log" , rtc = "/dev/rtc" } } , XML.element { name = "vfs" , attributes = XML.emptyAttributes , content = let tag = λ(name : Text) → XML.leaf { name = name , attributes = XML.emptyAttributes } let mutableVfs = let fsNode = [ XML.leaf { name = "ram" , attributes = XML.emptyAttributes } , XML.leaf { name = "fs" , attributes = toMap { label = "nix/store" , root = "${params.bootPkg}" } } ] in merge { ISO = 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 , XML.element { name = "dir" , attributes = toMap { name = "dev" } , content = [ tag "log", tag "rtc" ] } ] # mutableVfs } ] } , resources = Resources::{ , caps = 1024 , ram = Genode.units.MiB 128 + Genode.units.MiB params.memorySize } , routes = [ ServiceRoute.parent "File_system" , ServiceRoute.parent "Nic" , ServiceRoute.parent "Nitpicker" , ServiceRoute.parent "Rtc" , ServiceRoute.parent "Timer" , ServiceRoute.parent "VM" , ServiceRoute.parent "Report" , ServiceRoute.parentLabel "ROM" (Some "platform_info") (Some "platform_info") ] } in toVbox