@@ 0,0 1,163 @@
+-- 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 toVbox =
+ λ ( params
+ : { vdiFilename : Text
+ , vdiRoot : Text
+ , vdiUuid : Text
+ , memorySize : Natural
+ , vmName : Text
+ }
+ )
+ → let vboxConfig =
+ ''
+ <VirtualBox xmlns="http://www.virtualbox.org/" version="1.14-freebsd">
+ <Machine uuid="{37ab43a5-38d8-4491-93f5-5b0b077f5c32}" name="ubuntu_16_04_64" OSType="Ubuntu_64" snapshotFolder="Snapshots" lastStateChange="2018-01-23T18:40:00Z">
+ <MediaRegistry>
+ <HardDisks>
+ <HardDisk uuid="{${params.vdiUuid}}" location="${params.vdiFilename}" format="VDI" type="Normal"/>
+ </HardDisks>
+ <DVDImages/>
+ </MediaRegistry>
+ <Hardware>
+ <CPU count="2">
+ <PAE enabled="true"/>
+ <LongMode enabled="true"/>
+ <HardwareVirtExLargePages enabled="false"/>
+ </CPU>
+ <Memory RAMSize="${Prelude.Natural.show
+ params.memorySize}"/>
+ <HID Pointing="USBTablet"/>
+ <Display VRAMSize="20"/>
+ <RemoteDisplay enabled="false"/>
+ <BIOS>
+ <IOAPIC enabled="true"/>
+ </BIOS>
+ <USB>
+ <Controllers/>
+ </USB>
+ <Network>
+ <Adapter slot="0" enabled="true" MACAddress="0800271D7901" cable="true" type="82540EM">
+ <BridgedInterface/>
+ </Adapter>
+ </Network>
+ <UART>
+ <Port slot="0" enabled="false" IOBase="0x3f8" IRQ="4" hostMode="Disconnected"/>
+ <Port slot="1" enabled="false" IOBase="0x2f8" IRQ="3" hostMode="Disconnected"/>
+ </UART>
+ <LPT>
+ <Port slot="0" enabled="false" IOBase="0x378" IRQ="7"/>
+ <Port slot="1" enabled="false" IOBase="0x378" IRQ="7"/>
+ </LPT>
+ <AudioAdapter controller="HDA" driver="OSS" enabled="false"/>
+ <RTC localOrUTC="UTC"/>
+ <SharedFolders/>
+ </Hardware>
+ <StorageControllers>
+ <StorageController name="SATA" type="AHCI" PortCount="4" useHostIOCache="true" Bootable="true" IDE0MasterEmulationPort="0" IDE0SlaveEmulationPort="1" IDE1MasterEmulationPort="2" IDE1SlaveEmulationPort="3">
+ <AttachedDevice type="HardDisk" port="0" device="0">
+ <Image uuid="{${params.vdiUuid}}"/>
+ </AttachedDevice>
+ </StorageController>
+ </StorageControllers>
+ </Machine>
+ </VirtualBox>
+ ''
+
+ 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
+ }
+
+ in [ Vfs/inline "machine.vbox" vboxConfig
+ , XML.element
+ { name = "dir"
+ , attributes = toMap { name = "dev" }
+ , content = [ tag "log", tag "rtc" ]
+ }
+ , XML.leaf
+ { name = "fs"
+ , attributes = toMap { writeable = "yes" }
+ }
+ , XML.element
+ { name = "import"
+ , attributes = toMap { overwrite = "no" }
+ , content =
+ [ XML.leaf
+ { name = "fs"
+ , attributes = toMap
+ { label = "nix"
+ , root = "${params.vdiRoot}"
+ }
+ }
+ ]
+ }
+ ]
+ }
+ ]
+ }
+ , 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
@@ 0,0 1,601 @@
+-- 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 label =
+ λ(label : Text)
+ → { local = label, route = label } : Child.Attributes.Label
+
+let routeLogRom =
+ λ(label : Text) → ServiceRoute.parentLabel "ROM" (Some "log") (Some label)
+
+let rootInit =
+ λ(guests : Init.Children.Type)
+ → Init::{
+ , routes = [ ServiceRoute.child "Timer" "timer" ]
+ , verbose = True
+ , children = toMap
+ { timer =
+ Child.flat
+ Child.Attributes::{
+ , binary = "timer_drv"
+ , provides = [ "Timer" ]
+ }
+ , rtc =
+ Child.flat
+ Child.Attributes::{
+ , binary = "rtc_drv"
+ , provides = [ "Rtc" ]
+ , routes =
+ [ ServiceRoute.parent "IO_PORT"
+ , ServiceRoute.parent "IO_MEM"
+ ]
+ }
+ , acpi_drv =
+ Child.flat
+ Child.Attributes::{
+ , binary = "acpi_drv"
+ , priority = 1
+ , resources = Resources::{
+ , caps = 350
+ , ram = Genode.units.MiB 4
+ }
+ , romReports = [ label "acpi", label "smbios_table" ]
+ , routes = [ ServiceRoute.parent "IO_MEM" ]
+ }
+ , platform_drv =
+ Child.flat
+ Child.Attributes::{
+ , binary = "platform_drv"
+ , resources = Resources::{
+ , caps = 400
+ , ram = Genode.units.MiB 4
+ , constrainPhys = True
+ }
+ , reportRoms = [ label "acpi" ]
+ , romReports = [ label "pci" ]
+ , provides = [ "Acpi", "Platform" ]
+ , routes =
+ [ ServiceRoute.parent "IRQ"
+ , ServiceRoute.parent "IO_MEM"
+ , ServiceRoute.parent "IO_PORT"
+ , ServiceRoute.parentLabel
+ "ROM"
+ (Some "system")
+ (Some "system")
+ ]
+ , config = Init.Config::{
+ , attributes = toMap { system = "yes" }
+ , content =
+ let PciPolicy/Type =
+ { labelSuffix : Text, pciClass : Text }
+
+ in [ XML.text
+ ''
+ <report pci="yes"/>
+ <policy label_suffix="ps2_drv">
+ <device name="PS2"/>
+ </policy>
+ <policy label_suffix="intel_fb_drv">
+ <pci class="VGA"/>
+ <pci bus="0" device="0" function="0"/>
+ <pci class="ISABRIDGE"/>
+ </policy>
+ <policy label_suffix="audio">
+ <pci class="AUDIO"/>
+ <pci class="HDAUDIO"/>
+ </policy>
+ <policy label="acpica"/>
+ ''
+ ]
+ # Prelude.List.map
+ PciPolicy/Type
+ XML.Type
+ ( λ(policy : PciPolicy/Type)
+ → XML.element
+ { name = "policy"
+ , attributes = toMap
+ { label_suffix = policy.labelSuffix }
+ , content =
+ [ XML.leaf
+ { name = "pci"
+ , attributes = toMap
+ { class = policy.pciClass }
+ }
+ ]
+ }
+ )
+ [ { labelSuffix = "ahci_drv"
+ , pciClass = "AHCI"
+ }
+ , { labelSuffix = "nic_drv"
+ , pciClass = "ETHERNET"
+ }
+ , { labelSuffix = "usb_drv", pciClass = "USB" }
+ , { labelSuffix = "vesa_fb_drv"
+ , pciClass = "VGA"
+ }
+ ]
+ }
+ }
+ , framebuffer =
+ Child.flat
+ Child.Attributes::{
+ , binary = "intel_fb_drv"
+ , provides = [ "Framebuffer" ]
+ , resources = Init.Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 48
+ }
+ , routes =
+ [ ServiceRoute.parent "IO_MEM"
+ , ServiceRoute.parent "IO_PORT"
+ , ServiceRoute.childLabel
+ "Platform"
+ "platform_drv"
+ (None Text)
+ (Some "intel_fb_drv")
+ ]
+ }
+ , input_filter =
+ Child.flat
+ Child.Attributes::{
+ , binary = "input_filter"
+ , config =
+ let key =
+ λ(name : Text)
+ → XML.leaf
+ { name = "key"
+ , attributes = toMap { name = name }
+ }
+
+ let remap =
+ λ(name : Text)
+ → λ(to : Text)
+ → XML.leaf
+ { name = "key"
+ , attributes = toMap { name = name, to = to }
+ }
+
+ in Init.Config::{
+ , content =
+ [ XML.leaf
+ { name = "input"
+ , attributes = toMap { label = "ps2" }
+ }
+ , XML.element
+ { name = "output"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ XML.element
+ { name = "chargen"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ XML.element
+ { name = "remap"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ remap
+ "KEY_LEFTMETA"
+ "KEY_SCREEN"
+ , XML.leaf
+ { name = "input"
+ , attributes = toMap
+ { name = "ps2" }
+ }
+ ]
+ }
+ , XML.element
+ { name = "mod1"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ key "KEY_LEFTSHIFT"
+ , key "KEY_RIGHTSHIFT"
+ ]
+ }
+ , XML.element
+ { name = "mod2"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ key "KEY_LEFTCTRL"
+ , key "KEY_RIGHTCTRL"
+ ]
+ }
+ , XML.element
+ { name = "mod3"
+ , attributes = XML.emptyAttributes
+ , content = [ key "KEY_RIGHTALT" ]
+ }
+ ]
+ }
+ ]
+ }
+ ]
+ }
+ , provides = [ "Input" ]
+ , routes =
+ [ ServiceRoute.parentLabel
+ "ROM"
+ (Some "config")
+ (Some "config -> input_filter.config")
+ , ServiceRoute.childLabel
+ "Input"
+ "ps2_drv"
+ (Some "ps2")
+ (None Text)
+ ]
+ }
+ , ps2_drv =
+ Child.flat
+ Child.Attributes::{
+ , binary = "ps2_drv"
+ , provides = [ "Input" ]
+ , routes =
+ [ ServiceRoute.childLabel
+ "Platform"
+ "platform_drv"
+ (None Text)
+ (Some "ps2_drv")
+ ]
+ }
+ , nitpicker =
+ Child.flat
+ Child.Attributes::{
+ , binary = "nitpicker"
+ , config = Init.Config::{
+ , content =
+ [ XML.text
+ ''
+ <domain name="pointer" layer="1" content="client" label="no" origin="pointer" />
+ <domain name="log" layer="2" content="client" label="yes" hover="always"/>
+ <domain name="default" layer="3" content="client" label="yes" hover="always" focus="click"/>
+ <policy label_prefix="log" domain="log"/>
+ <default-policy domain="default"/>
+ ''
+ ]
+ }
+ , provides = [ "Nitpicker" ]
+ , resources = Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 64
+ }
+ , routes =
+ [ ServiceRoute.child "Framebuffer" "framebuffer"
+ , ServiceRoute.child "Input" "input_filter"
+ ]
+ }
+ , pointer =
+ Child.flat
+ Child.Attributes::{
+ , binary = "pointer"
+ , provides = [ "Report" ]
+ , routes = [ ServiceRoute.child "Nitpicker" "nitpicker" ]
+ }
+ , nit_fb =
+ Child.flat
+ Child.Attributes::{
+ , binary = "nit_fb"
+ , config = Init.Config::{
+ , attributes = toMap
+ { xpos = "600", width = "600", height = "768" }
+ }
+ , provides = [ "Framebuffer", "Input" ]
+ , resources = Resources::{ ram = Genode.units.MiB 8 }
+ , routes =
+ [ ServiceRoute.childLabel
+ "Nitpicker"
+ "nitpicker"
+ (None Text)
+ (Some "log")
+ ]
+ }
+ , terminal =
+ Child.flat
+ Child.Attributes::{
+ , binary = "terminal"
+ , provides = [ "Terminal" ]
+ , resources = Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 4
+ }
+ , routes =
+ [ ServiceRoute.child "Framebuffer" "nit_fb"
+ , ServiceRoute.child "Input" "nit_fb"
+ ]
+ , config = Init.Config::{
+ , content =
+ [ Prelude.XML.text
+ ''
+ <vfs>
+ <rom name="Inconsolata.ttf"/>
+ <dir name="fonts">
+ <dir name="monospace">
+ <ttf name="regular" path="/Inconsolata.ttf" size_px="10"/>
+ </dir>
+ </dir>
+ </vfs>
+ ''
+ ]
+ }
+ }
+ , terminal_log =
+ Child.flat
+ Child.Attributes::{
+ , binary = "terminal_log"
+ , provides = [ "LOG" ]
+ , routes = [ ServiceRoute.child "Terminal" "terminal" ]
+ }
+ , log_core =
+ Child.flat
+ Child.Attributes::{
+ , binary = "log_core"
+ , routes =
+ [ routeLogRom "core_log"
+ , ServiceRoute.childLabel
+ "LOG"
+ "terminal_log"
+ (Some "log")
+ (Some "core")
+ ]
+ }
+ , log_kernel =
+ Child.flat
+ Child.Attributes::{
+ , binary = "log_core"
+ , routes =
+ [ routeLogRom "kernel_log"
+ , ServiceRoute.childLabel
+ "LOG"
+ "terminal_log"
+ (Some "log")
+ (Some "kernel")
+ ]
+ }
+ , block =
+ Child.flat
+ Child.Attributes::{
+ , binary = "ahci_drv"
+ , config = Init.Config::{
+ , content =
+ [ Genode.Prelude.XML.leaf
+ { name = "default-policy"
+ , attributes = toMap
+ { device = "0", writeable = "yes" }
+ }
+ ]
+ }
+ , provides = [ "Block" ]
+ , resources = Init.Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 10
+ }
+ , routes =
+ [ ServiceRoute.childLabel
+ "Platform"
+ "platform_drv"
+ (None Text)
+ (Some "ahci_drv")
+ ]
+ }
+ , block_partitions =
+ Child.flat
+ Child.Attributes::{
+ , binary = "part_block"
+ , config = Init.Config::{
+ , content =
+ Prelude.List.map
+ Natural
+ XML.Type
+ ( λ(i : Natural)
+ → XML.leaf
+ { name = "policy"
+ , attributes =
+ let partition =
+ Prelude.Natural.show (i + 1)
+
+ in toMap
+ { label_suffix = " ${partition}"
+ , partition = partition
+ , writeable = "yes"
+ }
+ }
+ )
+ (Prelude.Natural.enumerate 128)
+ # [ XML.leaf
+ { name = "report"
+ , attributes = toMap { partitions = "yes" }
+ }
+ ]
+ }
+ , resources = Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 8
+ }
+ , provides = [ "Block" ]
+ , routes =
+ [ ServiceRoute.child "Block" "block"
+ , ServiceRoute.child "Report" "block_router"
+ ]
+ }
+ , block_router =
+ Child.flat
+ Child.Attributes::{
+ , binary = "block_router"
+ , config = Init.Config::{
+ , attributes = toMap { verbose = "yes" }
+ , content =
+ [ XML.element
+ { name = "default-policy"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ XML.leaf
+ { name = "partition"
+ , attributes = toMap
+ { type = ./partition-type
+ , writeable = "yes"
+ }
+ }
+ ]
+ }
+ ]
+ }
+ , resources = Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 8
+ }
+ , provides = [ "Block", "Report" ]
+ , routes = [ ServiceRoute.child "Block" "block_partitions" ]
+ }
+ , file_system =
+ Child.flat
+ Child.Attributes::{
+ , binary = "vfs"
+ , config = Init.Config::{
+ , content =
+ [ XML.element
+ { name = "vfs"
+ , attributes = XML.emptyAttributes
+ , content =
+ [ XML.element
+ { name = "dir"
+ , attributes = toMap { name = "ext2" }
+ , content =
+ [ XML.leaf
+ { name = "rump"
+ , attributes = toMap
+ { fs = "ext2fs"
+ , writeable = "yes"
+ , ram = "8M"
+ }
+ }
+ ]
+ }
+ , XML.element
+ { name = "dir"
+ , attributes = toMap { name = "audit" }
+ , content =
+ [ XML.leaf
+ { name = "audit"
+ , attributes = toMap { path = "ext2" }
+ }
+ ]
+ }
+ ]
+ }
+ , XML.leaf
+ { name = "policy"
+ , attributes = toMap
+ { label_prefix = "chroot"
+ , root = "/audit"
+ , writeable = "yes"
+ }
+ }
+ , XML.leaf
+ { name = "policy"
+ , attributes = toMap
+ { label = "nix"
+ , root = "/audit/store"
+ , writeable = "no"
+ }
+ }
+ ]
+ }
+ , provides = [ "File_system" ]
+ , resources = Init.Resources::{
+ , caps = 256
+ , ram = Genode.units.MiB 12
+ }
+ , routes = [ ServiceRoute.child "Block" "block_router" ]
+ }
+ , store_rom =
+ Child.flat
+ Child.Attributes::{
+ , binary = "cached_fs_rom"
+ , provides = [ "ROM" ]
+ , resources = Init.Resources::{
+ , ram =
+ let TODO_paramater = Genode.units.MiB 64
+
+ in TODO_paramater
+ }
+ , routes =
+ [ Init.ServiceRoute.childLabel
+ "File_system"
+ "file_system"
+ (None Text)
+ (Some "nix")
+ ]
+ }
+ , chroot =
+ Child.flat
+ Child.Attributes::{
+ , binary = "chroot"
+ , config = Init.Config::{
+ , content =
+ [ XML.leaf
+ { name = "default-policy"
+ , attributes = toMap { writeable = "yes" }
+ }
+ ]
+ }
+ , provides = [ "File_system" ]
+ , routes = [ ServiceRoute.child "File_system" "file_system" ]
+ }
+ , nic_drv =
+ Child.flat
+ Child.Attributes::{
+ , binary = "ipxe_nic_drv"
+ , provides = [ "Nic" ]
+ , resources = Init.Resources::{
+ , caps = 128
+ , ram = Genode.units.MiB 4
+ }
+ , routes =
+ [ ServiceRoute.childLabel
+ "Platform"
+ "platform_drv"
+ (None Text)
+ (Some "nic_drv")
+ ]
+ }
+ , guests =
+ Init.toChild
+ Init::{ children = guests, verbose = True }
+ Init.Attributes::{
+ , routes =
+ [ ServiceRoute.parent "VM"
+ , ServiceRoute.child "Nitpicker" "nitpicker"
+ , { service =
+ { name = "File_system"
+ , label = Init.LabelSelector.Type.Last "nix"
+ }
+ , route =
+ Init.Route.Type.Child
+ { name = "file_system", label = Some "nix" }
+ }
+ , ServiceRoute.child "File_system" "chroot"
+ , ServiceRoute.child "Nic" "nic_drv"
+ , ServiceRoute.child "Rtc" "rtc"
+ , ServiceRoute.parentLabel
+ "ROM"
+ (Some "platform_info")
+ (Some "platform_info")
+ , ServiceRoute.child "Report" "_report_rom"
+ ]
+ }
+ }
+ }
+
+in rootInit