genodepkgs/nixos-modules/dhall/vbox-guest.dhall

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 }
          , 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  ''
                  <VirtualBox xmlns="http://www.virtualbox.org/" version="1.14-freebsd">
                    <Machine uuid="{37ab43a5-38d8-4491-93f5-5b0b077f5c32}" name="${params.vmName}" OSType="Linux26_64" snapshotFolder="Snapshots" lastStateChange="2018-01-23T18:40:00Z">
                      <MediaRegistry>
                        <HardDisks>${XML.render hardDisks}</HardDisks>
                        <DVDImages>${XML.render dvdImages}</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">
                           ${XML.render attachedDevices}
                        </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 = "/log", stderr = "/log", rtc = "/dev/rtc" }
                      }
                  , XML.element
                      { name = "vfs"
                      , attributes = XML.emptyAttributes
                      , content =
                          let tag =
                                λ(name : Text) →
                                  XML.leaf
                                    { name, attributes = XML.emptyAttributes }

                          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
                                , 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 "Gui"
                , ServiceRoute.parent "Rtc"
                , ServiceRoute.parent "Timer"
                , ServiceRoute.parent "VM"
                , ServiceRoute.parent "Report"
                , ServiceRoute.parentLabel
                    "ROM"
                    (Some "platform_info")
                    (Some "platform_info")
                ]
              }

in  toVbox