File _service:obs_scm:mirage-4.4.0.obscpio of Package mirage

Overview Repositories Revisions Requests Users Attributes Meta

File _service:obs_scm:mirage-4.4.0.obscpio of Package mirage

07070100000000000081A4000000000000000000000001649164100000004F000000000000000000000000000000000000001800000000mirage-4.4.0/.gitignore_build
*~
\.\#*
\#*#
*.native
*.byte
*.install
_tests/
.merlin
_opam
.DS_Store
07070100000001000081A4000000000000000000000001649164100000005E000000000000000000000000000000000000001A00000000mirage-4.4.0/.ocamlformatversion = 0.25.1
profile = conventional
break-infix = fit-or-vertical
parse-docstrings = true
07070100000002000081A4000000000000000000000001649164100000D066000000000000000000000000000000000000001800000000mirage-4.4.0/CHANGES.md### v4.4.0 (2023-06-19)

- Fail configure if jobs without arguments are present
  (fixes #873 #1426, #1428 @hannesm)
- mirage-runtime & functoria-runtime: remove fmt dependency (#1417 @hannesm)
- Fix tests on macOS (#1425 @samoht)
- Adapt to happy-eyeballs 0.6.0 release (#1427 @hannesm)
- Adapt to logs-syslog 0.4.0 release (#1424 @hannesm)
- Adapt to docteur 0.0.6 release (#1419 @dinosaure)
- Upgrade tests to cmdliner 1.2.0 (#1418 @hannesm)
- Fail if jobs without arguments are registered (reported #873 @kit-ty-kate
  #1426 @reynir @PizieDust, fixed #1428 @hannesm and #1431 @reynir)
- Console is marked as deprecated (#1429 @hannesm)
- Tracing has been removed, since it was not used anymore and not supported with
  solo5-xen-pvh (#1430 @hannesm)

### v4.3.6 (2023-03-28)

- Allow paf 0.4 and 0.5 (#1414 @hannesm)
- Remove bytes dependency from functoria-runtime (#1411 @hannesm)
- Allow git-mirage 3.13 (#1412 @dinosaure @hannesm)

### v4.3.5 (2023-03-20)

#### Changed
- Remove OCaml dependency to allow OCaml 5 being chosen (#1409 @palainp)
- Disallow empty key names (#1407 @reynir)
- Allow tls-mirage 0.17 (#1405 @hannesm)
- Allow tcpip 8.0 (#1410 @hannesm)
- Fix typo in generated Makefile (#1406 @hannesm)

### v4.3.4 (2023-02-23)

#### Fixed

- Add -f <config> to Makefile output (#1394 @hannesm)

#### Added

- Add tar_kv_ro and tar_kv_rw (#1389 @reynir)

#### Changed

- Improved documentation of mirage.mli (#1390 #1391 @reynir)
- Deprecate Mirage.archive (use tar_kv_ro, #1389 @reynir)
- Removed deprecated device git_happy_eyeballs (#1388 @TaeminHa)
- Adapt bounds: mirage-crypto 0.11.0 (#1392 @hannesm) git-mirage 2.13.0
  (#1396 @hannesm) dns 7.0.0 tls 0.16.0 (#1399 @hannesm)
  mirage-block-ccm (#1400 @hannesm)
- mirage-runtime: conflict with ppxlib 0.29 (#1397 @hannesm)
- add upper bound to dune 3.7 until a release of chamelon with fixes lands (see
  https://github.com/mirage/mirage/pull/1401#issuecomment-1440762994)

### v4.3.3 (2023-01-30)

#### Fixed

- add (merlin) to the dune-workspace file -- this allows merlin to properly work
  with unikernels (#1385, fixes #1384 @TheLortex @hannesm)
- add "build" stanzas to packages that are supposed to be vendored (#1383,
  @Leonidas-from-XIV) for "opam-monorepo 0.3.5" compatibility

#### Changed

- raise upper bound for git to 3.12 (#1387 @dinosaure)

### v4.3.2 (2022-12-12)

#### Fixed

- use "printf" instead of "echo -e" in Makefiles for macOS support (#1370,
  @gridbugs)

#### Changed

- raise lower bound of solo5 to 0.7.5 (#1380 @dinosaure)
- remove "-warn-error -A" from generated dune file (for config) (#1379 @hannesm)

#### Added

- CCM device for block device encryption (#1364 @dinosaure)
- ALPN client and mimic device (#1376 @dinosaure)

### v4.3.1 (2022-10-25)

#### Fixed

- adapt to conduit 6.0.1 API (delay the parsing of the nameserver list)
  (#1362 #1369, @reynir @hannesm, fixes #1360)
- improve the generic_dns_client documentation (#1365, @dinosaure)
- upgrade to git 3.10.0 (#1366, @dinosaure)

#### Changed

- mirage-runtime: use Logs.level_of_string / level_to_string, avoid manual
  construction of Cmdliner.Arg.conv types (use the Cmdliner.Arg.conv function
  instead) (#1358, @hannesm)

#### Added

- functoria-runtime: provide argument_error exit code (#1361, @hannesm)
- add a http_server device using paf (#1367, @dinosaure)

### v4.3.0 (2022-09-26)

#### Fixed

- The chamelon format example invocation had the arguments in the wrong order
  (#1351, @hannesm)
- tar-mirage: allow the 2.x release series (#1352, @hannesm)
- Fix the separator for list and pair combinator (command-line arguments, #1354,
  @dinosaure, reported in #1349 #1348 by @rand00)
- Update references (hyperlinks) to erratique.ch documentation (#1343, @reynir)

#### Changed

- Allow more log levels (None / quiet) (#1275, @reynir, closes #1273 & #1274)
- Improve Functoria CLI: don't fail if context cache is invalid, handle
  situation when global arguments have a parse error (#1350, @TheLortex)
- Remove v4 & v6 stack, and other deprecated bindings (#1341, @hannesm)
- Remove FS remnants, and kv_ro of archive, and brittle shell scripts
  that used to generate FAT block storage devices (#1353, @hannesm)
- Update to OCamlFormat 0.23.0 (#1351, @dinosaure)

### v4.2.1 (2022-08-25)

#### Fixed

- In the generated opam file, also run "depext-lockfile" (#1342, @hannesm)

### v4.2.0 (2022-07-26)

#### Fixed

- Remove non-existing mirage-repo-add and mirage-repo-rm from PHONY in generated
  Makefile (#1332, @hannesm)
- Update deprecated references (#1337, @reynir)

#### Changed

- Prepare for reproducing unikernels with generated opam file (#1335, @hannesm)
  - split x-mirage-configure (mirage configure), x-mirage-pre-build
    (make lock pull), and build instructions in opam file
  - embed x-mirage-extra-repo (a list of opam repositories to use)
  - take relative paths up to git repository into account
  - include x-mirage-opam-lock-location (relative to git repository root)
- Adapt constraints for mirage-solo5 0.9.0 and mirage-xen 8.0.0 (ocaml-solo5
  0.8.1 with trim and improved memory metrics) (#1338, @hannesm, based on
  @palainp work)
- Require opam-monorepo 0.3.2 (#1332 #1334, @hannesm @dinosaure)
- Use OPAMVAR_monorepo instead of OPAMVAR_switch in generated opam file (#1332,
  @hannesm)
- Remove name from opam file (#1332, @hannesm)

### v4.1.1 (2022-04-05)

#### Fixed

- Update constraints on generated OPAM files (d21de15, @dinosaure)

### v4.1.0 (2022-05-02)

#### Changed

- Be able to make a docteur image with a relative path (@dinosaure, #1324)
- Update the project with `ocamlformat.0.21.0` (@gpetiot, @dinosaure, #1286)
- Upgrade the `mirage` tool with `opam-monorepo.0.3.0` and generate
  a single OPAM file (@TheLortex, @hannesm, @dinosaure, #1327)

You should check the `opam-monorepo.0.3.0` release to get more details about
  updates and fixes.

#### Added

- Add `chamelon` device, a filesystem with `littlefs` (@dinosaure, @yomimono, #1300)
- Add `pair` combinator for MirageOS key (@dinosaure, #1328)

### v4.0.0 (2022-03-28)

#### Fixed

- use `--solo5-abi=xen` for qubes target (#1312, @hannesm)
- Support using a different filename than `config.ml` with `-f`
  (#1309, @dinosaure)
- Fix build with dune 3.0 (#1296, @dinosaure)
- Check that the package name respects opam conventions
  (#1287, #1304, @TheLortex)
- Allow to specify version of pinned packages (#1295, @Julow)

#### Changed

- Use the same compilation as dune (#1313, #1316, #1317, @samoht, @hannesm)
- Remove unused `--warn-errors` and `--debug` flags (#1320, @samoht)
- Remove the deprecated `--target=ukvm` (#1321, @hannesm)
- Require cmdliner 1.1 (#1289, @samoht, @dinosaure, @dbuenzli)
- Require opam 2.1 to use MirageOS (#1239, 1311, @hannesm)
- Require conduit 5.1 (#1297, @hannesm)
- Rename `ocaml-freestanding` to `ocaml-solo5`
  (#1314, @dinosaure, @samoht, @hannesm)

#### Added

- Add Key.opt_all to allows usage of an argument multiple times
  (#1292, #1301, @dinosaure, @Drup)
- Add Git devices (#1291, @dinosaure, @samoht, @hannesm, @yomimono)
- Add happy-eyeballs devices (#1307, @dinosaure, @hannesm)
- Add docteur device to manage read-only persistent key-value stores
  (#1298, @dinosaure, @samoht)
- Add tcpv4v6_of_stackv4v6 device (#1293, @dinosaure)
- Add int64 converter (#1305, @dinosaure)
- Add dns_client device (#1302, #1306, @dinosaure, @hannesm)

### v4.0.0~beta3 (2022-02-02)

- Lint constraints on few packages to split the world between MirageOS 3.0 and
  MirageOS 4.0 (#1280, @dinosaure)

### v4.0.0~beta2 (2022-01-31)

- Update the generated minimal constraint required for `mirage-runtime` as
  Opam considers `4.0.0~beta* < 4.0.0` (#1276, @dinosaure)

### v4.0.0~beta1 (2022-01-29)

Refactor build process to use [Dune](https://dune.build/) build system. The
motivation is to drop `ocamlbuild`-induced technical debt and to obtain
first-class support for _cross-compilation_. To learn more about how Dune is
able to perform cross-compilation, please refer to the
[documentation](https://dune.readthedocs.io/en/stable/cross-compilation.html).

Main changes:

* Two opam files are generated when running `mirage configure`:
  - `<unikernel>-switch.opam`: for dependencies that are meant to be installed
    in the user's opam switch. It comprises of build tools such as
    `ocaml-freestanding` for Solo5 targets.
  - `<unikernel>-monorepo.opam`: for unikernel dependencies, they are locally
    fetched to compose a _dune workspace_.

* Unikernel dependencies are fetched in the source project using the
  `opam-monorepo` tool. This tool reads the `<unikernel>-monorepo.opam` file and
  make use of the opam solver to compute the transitive dependency set, saves
  that as a _lockfile_, and fetch sources in the `duniverse/` subfolder.
  More info on the
  [Github repository](https://github.com/ocamllabs/opam-monorepo).

* The compilation scheme use `dune`'s concept of a _workspace_: it's a set of
  libraries that are built together using the same _context_. For each
  compilation target, the Mirage tool is able to generate a _context_ definition
  able to compile for that target. A _context_ is defined by an OCaml compiler
  (or cross-compiler) toolchain, as defined by `findlib`, it can be tuned with
  environment variables and custom flags for the OCaml or underlying C compiler.

* The usual workflow `mirage configure && make depends && mirage build` does
  not change. However, files are now generated in the `./mirage` directory
  (OPAM files, `main.ml`, `key_gen.ml` or `manifest.json`), and
  the final artefact is created in the `./dist` directory.

Breaking changes:

* Unikernel dependencies need to use `dune` as a build system. Other build
  systems can be sandboxed, but the recommended way is to switch to `dune`.
  Many packages not compiling with dune yet have been ported  and are available
  as an additional
  [opam repository](https://github.com/dune-universe/opam-overlays) overlay.
  In addition, a few packages not supporting cross-compilation have been fixed
  and are available in another
  [opam repository](https://github.com/dune-universe/mirage-opam-overlays)
  overlay. The mirage tool uses these two opam overlays by default. To only
  use the default packages provided by Opam,
  use `mirage configure --no-extra-repo`.
* `Functoria_runtime.info` and `Mirage_runtime.info` now list all the libraries
  that are statically linked against the unikernel. The `packages` field have
  been removed and the `libraries` field is now accurate and contains the
  versions computed by `dune-build-info`.

* Update the DSL to describe devices into the `config.ml`.  We don't use
  objects anymore, and we replace it with the usage of `Mirage.impl` that
  expects the same _fields_ as before.

### v3.10.8 (2021-12-17)

- Allow tcpip 7.0.0, arp 3.0.0, ethernet 3.0.0 (#1259 @hannesm)

### v3.10.7 (2021-12-09)

- Allow mirage-clock 4.0.0 (@hannesm #1256)
- Use "opam var prefix" instead of "opam config var prefix" (@hannesm)

### v3.10.6 (2021-10-20)

- Adapt to conduit 5.0.0 API (and dns 6.0.0) @hannesm #1246
- Avoid deprecated Fmt functions @hannesm #1246

### v3.10.5 (2021-10-09)

- Allow tls-mirage 0.14 and 0.15 series (@hannesm)

### v3.10.4 (2021-04-20)

- Allow mirage-crypto-rng-mirage 0.10 (@hannesm)

### v3.10.3 (2021-04-19)

- Adapt to conduit 4.0.0 and cohttp 4.0.0 (@dinosaure #1221)

### v3.10.2 (2021-03-30)

* Adapt to conduit 2.3 and cohttp 4.0 (@samoht @dinosaure #1209)
* Allow mirage-crypto-rng-mirage 0.9 (@hannesm #1218)
* Adapt to tcpip 6.1.0 release (the unix sublibrary is no longer needed)

### v3.10.1 (2020-12-04)

* Fix serialising of Mirage_key.Arg.ip_address: remove superfluous '.'
  character (#1205 @hannesm)

### v3.10.0 (2020-12-02)

IPv6 and dual (IPv4 and IPv6) stack support #1187

Since a long time, IPv6 code was around in our TCP/IP stack (thanks to @nojb
who developed it in 2014). Some months ago, @hannesm and @MagnusS got excited
to use it. After we managed to fix some bugs and add some test cases, and
writing more code to setup IPv6-only and dual stacks, we are eager to share
this support for MirageOS in a released version. We expect there to be bugs
lingering around, but duplicate address detection (neighbour solicitation and
advertisements) has been implemented, and (unless
"--accept-router-advertisement=false") router advertisements are decoded and
used to configure the IPv6 part of the stack. Configuring a static IPv6 address
is also possible (with "--ipv6=2001::42/64").

While at it, we unified the boot arguments between the different targets:
namely, on Unix (when using the socket stack), you can now pass
"--ipv4=127.0.0.1/24" to the same effect as the direct stack: only listen
on 127.0.0.1 (the subnet mask is ignored for the Unix socket stack).

A dual stack unikernel has "--ipv4-only=BOOL" and "--ipv6-only=BOOL" parameters,
so a unikernel binary could support both Internet Protocol versions, while the
operator can decide which protocol version to use.

Please also note that the default IPv4 network configuration no longer uses
10.0.0.1 as default gateway (since there was no way to unset the default
gateway #1147).

For unikernel developers, there are some API changes in the Mirage module
- New "v4v6" types for IP protocols and stacks
- The ipv6_config record was adjusted in the same fashion as the ipv4_config
  type: it is now a record of a network (V6.Prefix.t) and gateway (V6.t option)

Some parts of the Mirage_key module were unified as well:
- Arp.ip_address is available (for a dual Ipaddr.t)
- Arg.ipv6_address replaces Arg.ipv6 (for an Ipaddr.V6.t)
- Arg.ipv6 replaces Arg.ipv6_prefix (for a Ipaddr.V6.Prefix.t)
- V6.network and V6.gateway are available, mirroring the V4 submodule

If you're ready to experiment with the dual stack, here's a diff for our basic
network example (from mirage-skeleton/device-usage/network) replacing IPv4
with a dual stack:

```
diff --git a/device-usage/network/config.ml b/device-usage/network/config.ml
index c425edb..eabc9d6 100644
--- a/device-usage/network/config.ml
+++ b/device-usage/network/config.ml
@@ -4,9 +4,9 @@ let port =
   let doc = Key.Arg.info ~doc:"The TCP port on which to listen for incoming connections." ["port"] in
   Key.(create "port" Arg.(opt int 8080 doc))

-let main = foreign ~keys:[Key.abstract port] "Unikernel.Main" (stackv4 @-> job)
+let main = foreign ~keys:[Key.abstract port] "Unikernel.Main" (stackv4v6 @-> job)

-let stack = generic_stackv4 default_network
+let stack = generic_stackv4v6 default_network

let () =
   register "network" [
diff --git a/device-usage/network/unikernel.ml b/device-usage/network/unikernel.ml
index 5d29111..1bf1228 100644
--- a/device-usage/network/unikernel.ml
+++ b/device-usage/network/unikernel.ml
@@ -1,19 +1,19 @@
 open Lwt.Infix

-module Main (S: Mirage_stack.V4) = struct
+module Main (S: Mirage_stack.V4V6) = struct

let start s =
     let port = Key_gen.port () in
-    S.listen_tcpv4 s ~port (fun flow ->
-        let dst, dst_port = S.TCPV4.dst flow in
+    S.listen_tcp s ~port (fun flow ->
+        let dst, dst_port = S.TCP.dst flow in
         Logs.info (fun f -> f "new tcp connection from IP %s on port %d"
-                  (Ipaddr.V4.to_string dst) dst_port);
-        S.TCPV4.read flow >>= function
+                  (Ipaddr.to_string dst) dst_port);
+        S.TCP.read flow >>= function
         | Ok `Eof -> Logs.info (fun f -> f "Closing connection!"); Lwt.return_unit
-        | Error e -> Logs.warn (fun f -> f "Error reading data from established connection: %a" S.TCPV4.pp_error e); Lwt.return_unit
+        | Error e -> Logs.warn (fun f -> f "Error reading data from established connection: %a" S.TCP.pp_error e); Lwt.return_unit
         | Ok (`Data b) ->
           Logs.debug (fun f -> f "read: %d bytes:\n%s" (Cstruct.len b) (Cstruct.to_string b));
-          S.TCPV4.close flow
+          S.TCP.close flow
       );

S.listen s
```

Other bug fixes include #1188 (in #1201) and adapt to charrua 1.3.0 and
arp 2.3.0 changes (#1199).

### v3.9.0 (2020-10-24)

The Xen backend is a minimal legacy-free re-write: Solo5 (since 0.6.6) provides
the low-level glue code, and ocaml-freestanding provides the OCaml runtime. The
PV-only Mini-OS implementation has been retired.

The only supported virtualization mode is now Xen PVH (version 2 or above),
supported since Xen version 4.10 or later (and Qubes OS 4.0).

The support for the ARM32 architecture on Xen has been removed.

Security posture improvements:

With the move to a Solo5 and ocaml-freestanding base MirageOS gains several
notable improvements to security posture for unikernels on Xen:

* Stack smashing protection is enabled unconditionally for all C code.
* W^X is enforced throughout, i.e. `.text` is read-execute, `.rodata` is
  read-only, non-executable and `.data`, heap and stack are read-write and
  non-executable.
* The memory allocator used by the OCaml runtime is now dlmalloc (provided by
  ocaml-freestanding), which is a big improvement over the Mini-OS malloc, and
  incorporates features such as heap canaries.

Interface changes:

* With the rewrite of the Xen core platform stack, several Xen-specific APIs
  have changed in incompatible ways; unikernels may need to be updated. Please
  refer to the mirage-xen v6.0.0 [change
  log](https://github.com/mirage/mirage-xen/releases/tag/v6.0.0) for a list of
  interfaces that have changed along with their replacements.

Other changes:

* OCaml 4.08 is the minimum supported version.
* A dummy `dev-repo` field is emitted for the generated opam file.
* .xe files are no longer generated.
* Previous versions of MirageOS would strip boot parameters on Xen, since Qubes
  OS 3.x added arguments that could not be interpreted by our command line
  parser. Since Qubes OS 4.0 this is no longer an issue, and MirageOS no longer
  strips any boot parameters. You may need to execute
  `qvm-prefs qube-name kernelopts ''`.

Acknowledgements:

* Thanks to Roger Pau Monné, Andrew Cooper and other core Xen developers for
  help with understanding the specifics of how PVHv2 works, and how to write an
  implementation from scratch.
* Thanks to Marek Marczykowski-Górecki for help with the Qubes OS specifics, and
  for forward-porting some missing parts of PVHv2 to Qubes OS version of Xen.
* Thanks to @palainp on Github for help with testing on Qubes OS.

### v3.8.1 (2020-09-22)

* OCaml runtime parameters (OCAMLPARAM) are exposed as boot and configure
  arguments. This allows e.g. to switch to the best-fit garbage collection
  strategy (#1180 @hannesm)

### v3.8.0 (2020-06-22)

* Emit type=pv in xl (instead of builder=linux), as required by xen 4.10+ (#1166 by @djs55)
* adapt to ipaddr 5.0.0, tcpip 5.0.0, mirage-crypto 0.8 (#1172 @hannesm)

### v3.7.7 (2020-05-18)

* handle errors from Bos.OS.Cmd.run_out
* use PREFIX if defined (no need to call "opam config var prefix")
* adapt to conduit 2.2.0, tls 0.12, mirage-crypto 0.7.0 changes

### v3.7.6 (2020-03-18)

* fix conduit with 3.7.5 changes (#1086 / #1087, @hannesm)

### v3.7.5 (2020-03-15)

* use mirage-crypto (and mirage-crypto-entropy) instead of nocrypto, also
  tls-mirage and up-to-date conduit (#1068 / #1079, @hannesm @samoht)

### v3.7.4 (2019-12-20)

* use `git rev-parse --abbrev-ref HEAD` instead of `git branch --show-current`
  for emitting branch information into the opam file. The latter is only
  available in git 2.22 or later, while the former seems to be supported by
  old git releases. (#1024, @hannesm)

### v3.7.3 (2019-12-17)

* `mirage configure` now emits build and install steps into generated opam file
  this allows to use `opam install .` to actually install a unikernel.
  (#1022 @hannesm)
* refactor configure, build and link step into separate modules (#1017 @dinosaure)

### v3.7.2 (2019-11-18)

* adjust fat-filesystem constraints to >= 0.14 && < 0.15 (#1015, @hannesm)

### v3.7.1 (2019-11-03)

* clean opam files when `mirage configure` is executed (#1013 @dinosaure)
* deprecate mirage-types and mirage-types-lwt (#1006 @hannesm)
* remove abstraction over 'type 'a io' and 'buffer', remove mirage-*-lwt packages (#1006 @hannesm)
* unify targets in respect to hooks (Mirage_runtime provides the hooks and registration)
* unify targets in respect to error handling (no toplevel try .. with installed anymore, mirage-unix does no longer ignore all errors)

### v3.7.0 (2019-11-01)

* mirage-runtime: provide at_enter_iter/at_exit_iter/at_exit hooks for the event loop (#1010, @samoht @dinosaure @hannesm)
* call `exit 0` after the Lwt event loop returned (to run at_exit handlers in freestanding environments) (#1011, @hannesm)
* NOTE: this release only contains the mirage-runtime opam package to unblock other releases, there'll be a 3.7.1 soon

### v3.6.0 (2019-10-02)

* solo5 0.6 support for multiple devices (#993, by @mato)
  please read https://github.com/Solo5/solo5/blob/v0.6.2/CHANGES.md for detailed changes
  observable mirage changes:
  - new target `-t spt` for sandboxed processed tender (seccomp on Linux)
  - new functions Mirage_key.is_solo5 and Mirage_key.is_xen, analogue to Mirage_key.is_unix
* respect verbosity when calling `ocamlbuild` -- verbose if log level is info or debug (#999, by @mato)

### v3.5.2 (2019-08-22)

* Adapt to conduit 2.0.0 release, including dns 4.0.0 (#996, by @hannesm)
* Adjust mirage-xen constraints to < 5.0.0 (#995, by @reynir)

### v3.5.1 (2019-07-11)

* Adapt to new tracing API (#985, by @talex5)
* Remove stubs for qrexec and qubes gui (qubes 3 is end of life, qubes 4 makes it configurable) (#984, by @linse & @yomimono)
* Update mirage-logs and charrua-client-mirage version constraints (#982, by @hannesm)
* Remove unused dockerfile, travis updates (#982 #990, by @hannesm)

### v3.5.0 (2019-03-03)

* Rename Mirage_impl_kv_ro to Mirage_impl_kv, and introduce `rw` (#975, by @hannesm)
* Adapt to mirage-kv 2.0.0 changes (#975, by @hannesm)
* Adapt to mirage-protocols and mirag-net 2.0.0 changes (#972, by @hannesm)
* mirage-types-lwt: remove unneeded io-page dependency (#971, by @hannesm)
* Fix regression introduced in 3.4.0 that "-l *:debug" did no longer work (#970, by @hannesm)
* Adjust various upper bounds (mirage-unix, cohttp-mirage, mirage-bootvar-xen) (#967, by @hannesm)

### v3.4.1 (2019-02-05)

* Provide a httpaf_server device, and a cohttp_server device (#955, by @anmonteiro)
* There can only be a single prng device in a unikernel, due to entropy
  harvesting setup (#959, by @hannesm)
* Cleanup zarith-freestanding / gmp-freestanding dependencies (#964, by @hannesm)
* ethernet is now a separate package (#965, by @hannesm)
* arp now uses the mirage/arp repository by default, the tcpip.arpv4
  implementation was removed in tcpip 3.7.0 (#965, by @hannesm)

### v3.4.0 (2019-01-11)

* use ipaddr 3.0 without s-expression dependency (#956, by @hannesm)
* use mirage-clock 2.x and tcpip 3.6.x libraries (#960, #962, by @hannesm)
* default to socket stack on unix and macos (#958, by @hannesm)
* use String.split_on_char in mirage-runtime to avoid astring dependency (#957, by @hannesm)
* add build-dependency on mirage to each unikernel (#953, by @hannesm)

### 3.3.1 (2018-11-21)

* fix regression: --yes was not passed to opam in 3.3.0 (#950, by @hannesm)

### 3.3.0 (2018-11-18)

New target: (via solo5) Genode:
"Genode is a free and open-source operating system framework consisting
of a microkernel abstraction layer and a collection of userspace components. The
framework is notable as one of the few open-source operating systems not derived
from a proprietary OS, such as Unix. The characteristic design philosophy is
that a small trusted computing base is of primary concern in a security oriented
OS." (from wikipedia, more at https://genode.org/ #942, by @ehmry)

User-visible changes
* use mirage-bootvar-unix instead of OS.Env.argv
  (deprecated since mirage-{xen,unix,os-shim}.3.1.0, mirage-solo5.0.5.0) on unix
  (#931, by @hannesm)

WARNING: this leads to a different semantics for argument passing on Unix:
  all arguments are concatenated (using a whitespace " " as separator), and
  split on the whitespace character again (by parse-argv). This is coherent
  with all other backends, but the whitespace in "--hello=foo bar" needs to
  be escaped now.

* mirage now generates upper bounds for hard-coded packages that are used in
  generated code. When we now break the API, unikernels which are configured with
  an earlier version won't accept the new release of the dependency. This means
  API breakage is much smoother for us, apart from that we now track version
  numbers in the mirage utility. The following rules were applied for upper bounds:
  - if version < 1.0.0 then ~min:"a.b.c" ~max:"a.(b+1).0"
  - if version > 1.0.0 then ~min:"a.b.c" ~max:"(a+1).0.0"`
  - exceptions: tcpip (~min:"3.5.0" ~max:"3.6.0"), mirage-block-ramdisk (unconstrained)

WARNING: Please be careful when release any of the referenced libraries by
  taking care of appropriate version numbering.
  (initial version in #855 by @avsm, final #946 by @hannesm)

* since functoria.2.2.2, the "package" function (used in unikernel configuration)
  is extended with the labeled argument ~pin that receives a string (e.g.
  ~pin:"git+https://github.com/mirage-random/mirage-random.git"), and is embedded
  into the generated opam file as [pin-depends](https://opam.ocaml.org/doc/Manual.html#opamfield-pin-depends)

* mirage-random-stdlib is now used for default_random instead of mirage-random
  (which since 1.2.0 no longer bundles the stdlib Random
  module). mirage-random-stdlib is not cryptographically secure, but "a
  lagged-Fibonacci F(55, 24, +) with a modified addition function to enhance the
  mixing of bits.", which is now seeded using mirage-entropy. If you configure
  your unikernel with "mirage configure --prng fortuna" (since mirage 3.0.0), a
  cryptographically secure PRNG will be used (read more at
  https://mirage.io/blog/mirage-entropy)

* mirage now revived its command-line "--no-depext", which removes the call to
  "opam depext" in the depend and depends target of the generated Makefile
  (#948, by @hannesm)

* make depend no longer uses opam pin for opam install --deps-only (#948, by @hannesm)

* remove unused io_page configuration (initial discussion in #855, #940, by @hannesm)

* charrua-client requires a Mirage_random interface since 0.11.0 (#938, by @hannesm)

* split implementations into separate modules (#933, by @emillon)

* improved opam2 support (declare ocaml as dependency #926)

* switch build system to dune (#927, by @emillon)

* block device writes has been fixed in mirage-solo5.0.5.0

### 3.2.0 (2018-09-23)

* adapt to solo5 0.4.0 changes (#924, by @mato)
Upgrading from Mirage 3.1.x or earlier

Due to conflicting packages, opam will not upgrade mirage to version 3.2.0 or newer if a version of mirage-solo5 older than 0.4.0 is installed in the switch. To perform the upgrade you must run `opam upgrade mirage` explicitly.

Changes required to rebuild and run ukvm unikernels

As of Solo5 0.4.0, the ukvm target has been renamed to hvt. If you are working out of an existing, dirty, source tree, you should initially run:

```
mirage configure -t hvt
mirage clean
mirage configure -t hvt
```

and then proceed as normal. If you are working with a clean source tree, then simply configuring with the new hvt target is sufficient:

`mirage configure -t hvt`

Note that the build products have changed:

The unikernel binary is now named `<unikernel>.hvt`,
the `ukvm-bin` binary is now named `solo5-hvt`.

* adapt to mirage-protocols, mirage-stack, tcpip changes (#920, by @hannesm)

This is a breaking change: mirage 3.2.0 requires mirage-protocols 1.4.0, mirage-stack 1.3.0, and tcpip 3.5.0 to work (charru-client-mirage 0.10 and mirage-qubes-ipv4 0.6 are adapted to the changes).  An older mirage won't be able to use these new libraries correctly.  Conflicts were introduced in the opam-repository.

In more detail,  direct and socket stack initialisation changed, which is automatically generated by the mirage tool for each unikernel (as part of `main.ml`).  A record was built up, which is no longer needed.

Several unneeded type aliases were removed:
  `netif` from Mirage_protocols.ETHIF
  `ethif` and `prefix` from Mirage_protocols.IP
  `ip` from Mirage_protocols.{UDP,TCP}
  `netif` and `'netif config` from Mirage_stack.V4
  `'netif stackv4_config` and `socket_stack_config` in Mirage_stack

* squash unnecessary warning from `mirage build` (#916, by @mato)

### 3.1.1 (2018-08-01)

* for the unix target, add `-tags thread`, as done for the mac osx target (#861,
  suggested by @cfcs)
* bump minimum mirage-solo5* and solo5-kernel* to 0.3.0 (#914, by @hannesm, as
  suggested by @mato)
* use the exposed signature in functoria for Key modules (#912, by @Drup)
* add ?group param to all generic devices (#913, by @samoht)

### 3.1.0 (2018-06-20)

* solo5 v0.3.0 support (#906, by @mato @kensan @hannesm):
  The major new user-visible features for the Solo5 backends are:
    ukvm: Now runs natively on FreeBSD vmm and OpenBSD vmm.
    ukvm: ARM64 support.
    muen: New target, for the Muen Separation Kernel.
    ukvm: Improved and documented support for debugging Solo5-based unikernels.
* generate libvirt.xml for virtio target (#903, by @bramford)
* don't make xen config documents for target qubes (#895, by @yomimono)
* use a path pin when making depends (#891, by @yomimono)
* move block registration to `configure` section (#892, by @yomimono)
* allow to directly specifying xenstore ids (#879, by @yomimono)

### 3.0.8 (2017-12-19)

* when passing block devices to `xen`, pass the raw filename rather than trying to infer the xenstore ID (#874, by @yomimono)
* make homepage in opam files consistent (#872, by @djs55)

### 3.0.7 (2017-11-24)

* the released version of `cohttp-mirage` is `1.0.0` (not `3.0.0`)
  (#870 by @hannesm)

### 3.0.6 (2017-11-16)

* remove macOS < yosemite support (#860 by @hannesm)
* rename `mirage-http` to `cohttp-mirage` (#863 by @djs55)
  See [mirage/ocaml-cohttp#572]
* opam: require OCaml 4.04.2+ (#867 by @hannesm)

### 3.0.5 (2017-08-08)

* Allow runtime configuration of syslog via config keys `--syslog`,
  `--syslog-port` and `--syslog-hostname` (#853 via @hannesm).
* Switch build of tool and libraries to Jbuilder (by @samoht)
* Fix a warning when connecting to a ramdisk device (#837 by @g2p)
* Fix reference to tar library when using `--kv-ro archive` (#848 by @mor1)
* Adapt to latest functoria API (#849 by @samoht)

* Add a `--gdb` argument for ukvm targets so that debuggers can be attached easily.
  This allows `mirage configure --gdb -t ukvm` to work (@ricarkol in #847).

* Adapt to latest functoria (#849 by @samoht)
* Adapt to latest charrua, tcpip (#854 by @yomimono)
* Switch to jbuilder (#850 by @samoht)

Packaging updates for latest opam repository:
* ARP is compatible with MirageOS3 since 0.2.0 (#851 by @hannesm)

### 3.0.4 (2017-06-15)
* add a --block configure flag for picking ramdisk or file-backed disk
* add lower bounds on packages
* fallback to system `$PKG_CONFIG_PATH`
* update for mirage-qubes-ipv4

### 3.0.2 (2017-03-15)

* restore ocamlbuild colors when `TERM <> dumb && Unix.isatty stdout` (#814, by @hannesm)

### 3.0.1 (2017-03-14)

* remove "-color always" from ocamlbuild invocation (bugfix for some scripts interpreting build output) (#811, by @hannesm)
* provide a "random" module argument when invoking IPv6.Make (compat with tcpip 3.1.0) (#801, by @hannesm)
* add a "depends" target to the generated Makefile (controversial and may be removed) (#805, by @yomimono)
* allow qubesdb to be requested in config.ml when the target is xen (#807, by @talex5)

### 3.0.0 (2017-02-23)

* rename module types modules: V1 -> Mirage_types, V1_LWT -> Mirage_types_lwt (#766, by @yomimono, @samoht, and @hannesm)
* split type signatures and error printers into separate libraries (#755, #753, #752, #751, #764, and several others, by @samoht and @yomimono)
* use mirage-fs instead of ocaml-fat to transform FS into KV_RO (#756, by @samoht)
* changes to simplify choosing an alternate ARP implementation (#750, by @hannesm)
* add configurators for syslog reporter (#749, by @hannesm)
* filter incoming boot-time arguments for all Xen backends, not just QubesOS (#746, by @yomimono)
* give mirage-types-lwt its own library, instead of a mirage-types sublibrary called lwt (#735, by @hannesm)
* remove `format` function and `Format_unknown` error from FS module type (#733, by @djs55)
* ocamlify FAT name (#723 by @yomimono)
* remove type `error` from DEVICE module type (#728, by @hannesm)
* UDP requires random for source port randomization (#726 by @hannesm)
* drop "mir-" prefix from generated binaries (#725 by @hannesm)
* BLOCK and FS uses result types (#705 by @yomimono)
* depext fixes (#718 by @mato)
* workflow changes: separate configure, depend, build phases, generate opam file during configure (#703, #711 by @hannesm)
* tap0 is now default_network (#715, #719 by @yomimono, @mato)
* ARP uses result types (#711 by @yomimono)
* ipv4 key (instead of separate ip and netmask) (#707, #709 by @yomimono)
* CHANNEL uses result types (#702 by @avsm)
* no custom myocamlbuild.ml, was needed for OCaml 4.00 (#693 by @hannesm)
* revert custom ld via pkg-config (#692 by @hannesm)
* result types for FLOW and other network components (#690 by @yomimono)
* removed `is_xen` key (#682, by @hannesm)
* mirage-clock-xen is now mirage-clock-freestanding (#684, by @mato)
* mirage-runtime is a separate opam package providing common functionality (#681, #615 by @hannesm)
* add `qubes` target for making Xen unikernels which boot & configure themselves correctly on QubesOS. (#553, by @yomimono)
* revised V1.CONSOLE interface: removed log, renamed log_s to log (#667, by @hannesm)
* remove Str module from OCaml runtime (#663, in ocaml-freestanding and mirage-xen-ocaml, by @hannesm)
* new configuration time keyword: prng to select the default prng (#611, by @hannesm)
* fail early if tracing is attempted with Solo5 (#657, by @yomimono)
* refactor ipv4, stackv4, and dhcp handling (#643, by @yomimono)
* create xen-related helper files only when the target is xen (#639, by @hannesm)
* improvements to nocrypto handling (#636, by @pqwy)
* disable warning #42 in generated code for unikernels (#633, by @hannesm)
* V1.NETWORK functions return a Result.t rather than polyvars indicating success or errors (#615, by @hannesm)
* remove GNUisms and unnecessary artifacts from build (#623, #627, by @mato and @hannesm)
* remove type `id` from `DEVICE` module type. (#612, by @yomimono and @talex5)
* revise the RANDOM signature to provide n random bytes; provide nocrypto_random and stdlib_random (#551 and #610, by @hannesm)
* expose `direct` as an option for `kv_ro`.  (#607, by @mor1)
* require a `mem` function in KV_RO, and add `Failure` error variant (#606, by @yomimono)
* `connect` functions are no longer expected to return polyvars, but rather to raise exceptions if `connect` fails and return the value directly. (#602, by @hannesm)
* new documentation using `odig` (#591, #593, #594, #597, #598, #599, #600, and more, by @avsm)
* change build system to `topkg` from `oasis`. (#558, #590, #654, #673, by @avsm, @samoht, @hannesm, @dbuenzli)
* express io-page dependency of crunch. (#585, by @yomimono and @mato)
* deprecate the CLOCK module type in favor of PCLOCK (POSIX clock) and
  MCLOCK (a monotonically increasing counter of elapsed nanoseconds).
  (#548 and #579, by @mattgray and @yomimono)
* emit an ocamlfind predicate that matches the target, reducing the
  amount of duplication by target required of library authors
  (#568, by @pqwy)
* implement an `is_unix` key (#575, by @mato)
* use an int64 representing nanoseconds as the argument for `TIME.sleep`,
  instead of a float representing seconds. (#547, by @hannesm)
* expose new targets `virtio` and `ukvm` via the `solo5` project. (#565,
  by @djwillia, @mato, and @hannesm).
* remove users of `base_context`, which includes command-line arguments `--unix`
  and `--xen`, and `config.ml` functions `add_to_ocamlfind_libraries` and
  `add_to_opam_packages`.  As a side effect, fix a long-standing error message
  bug when invoking `mirage` against a `config.ml` that does not build.
  (#560, by @yomimono)
* link `libgcc.a` only on ARM & other build improvements (#544, by @hannesm)
* allow users to use `crunch` on unix with `kv_ro`; clean up crunch .mlis on
  clean (#556, by @yomimono)
* remove console arguments to network functors (#554, by @talex5 and @yomimono)
* standardize ip source and destination argument names as `src` and `dst`, and
  source and destination ports as `src_port` and `dst_port` (#546, by @yomimono)
* a large number of documentation improvements (#549, by @djs55)
* require `pseudoheader` function for IP module types. (#541, by @yomimono)
* always build with `ocamlbuild -r`, to avoid repetitive failure message
  (#537, by @talex5)

### 2.9.1 (2016-07-20)

* Warn users of command-line arguments `--unix` and `--xen` that support for
  these will soon be dropped.  Instead, use `-t unix` and `-t xen` respectively.
  (see https://github.com/mirage/mirage-www/pull/475#issuecomment-233802501)
  (#561, by @yomimono)
* Warn users of functions `add_to_opam_packages p` and
  `add_to_ocamlfind_libraries l` that support for these will soon be dropped.
  Instead, use `register ~libraries:l` and `register:~packages:p`
  respectively. (#561, by @yomimono).

### 2.9.0 (2016-04-29)

* Add logging support. A new `reporter` parameter to `register` is now
  available. This parameter defines how to configure the log reporter,
  using `Logs` and `Mirage_logs`. Log reporters can also be configured
  at configuration AND runtime using on the new `-l` or `--logs`
  command-line argument.  (#534, by @samoht, @talex5 and @Drup)
* Allow to disable command-line parsing at runtime. There is a new
  `argv` parameter to the `register` function to allow to pass custom
  command-line argument parsing devices.  Use `register ~argv:no_argv`
  to disable command-line argument parsing. (#493, by @samoht and @Drup)

### 2.8.0 (2016-04-04)

* Define an ICMP and ICMPV4 module type. ICMPV4 is included in, and
  surfaced by, the STACKV4 module type. The previous default behavior
  of the IPv4 module with respect to ICMP is preserved by STACKV4 and
  the tcpip_stack_direct function provided by mirage. (#523, by
  @yomimono)
* Explicitly require OCaml compiler version 4.02.3 in opam files for
  mirage-types and mirage.

### 2.7.3 (2016-03-20)

* Fix another regression introduced in 2.7.1 which enable
  `-warn-error` by default. This is now controlled by a
  `--warn-error` flag on `mirage configure`. Currently it's
  default value is [false] but this might change in future
  versions (#520)

### 2.7.2 (2016-03-20)

* Fix regression introduced in 2.7.1 which truncates the ouput of
  `opam install` and breaks `opam depext` (#519, by @samoht)

### 2.7.1 (2016-03-17)

* Improve the Dockerfile (#507, by @avsm)
* Use Astring (by @samoht)
* Clean-up dependencies automatically added by the tool
  - do not require `lwt.syntax`, `cstruct.syntax` and `sexplib`, which
    should make the default unikernels camlp4-free (#510, #515 by @samoht)
  - always require `mirage-platform` (#512, by @talex5)
  - ensure that `mirage-types` and `mirage-types-lwt` are installed
* Turn on more warnings and enable "warning as errors".
* Check that the OCaml compiler is at least 4.02.3 (by @samoht)

### 2.7.0 (2016-02-17)

The mirage tool is now based on functoria. (#441 #450, by @drup @samoht)
See https://mirage.io/blog/introducing-functoria for full details.

* Command line interface: The config file must be passed with the -f option
  (instead of being just an argument).
* Two new generic combinators are available, generic_stack and generic_kv_ro.
* `get_mode` is deprecated. You should use keys instead. And in particular
  `Key.target` and `Key.is_xen`.
* `add_to_ocamlfind_libraries` and `add_to_opam_packages` are deprecated. Both
  the `foreign` and the `register` functions now accept the `~libraries` and
  `~packages` arguments to specify library dependencies.

* If you were using `tls` without the conduit combinator, you will be
  greeted during configuration by a message like this:
  ```
The "nocrypto" library is loaded but entropy is not enabled!
Please enable the entropy by adding a dependency to the nocrypto device.
You can do so by adding ~deps:[abstract nocrypto] to the arguments of Mirage.foreign.
  ```
  Data dependencies (such as entropy initialization) are now explicit.
  In order to fix this, you need to declare the dependency like so:
  ```ocaml
open Mirage

let my_functor =
  let deps = [abstract nocrypto] in
  foreign ~deps "My_Functor" (foo @-> bar)
  ```
  `My_functor.start` will now take an extra argument for each
  dependencies. In the case of nocrypto, this is `()`.

* Remove `nat-script.sh` from the scripts directory, to be available
  as an external script.

### 2.6.1 (2015-09-08)

* Xen: improve the .xl file generation. We now have
  - `name.xl`: this has sensible defaults for everything including the
    network bridges and should "just work" if used on the build box
  - `name.xl.in`: this has all the settings needed to boot (e.g. presence of
    block and network devices) but all the environmental dependencies are
    represented by easily-substitutable variables. This file is intended for
    production use: simply replace the variables for the paths, bridges, memory
    sizes etc. and run `xl create` as before.

### 2.6.0 (2015-07-28)

* Better ARP support. This needs `mirage-tcpip.2.6.0` (#419, by @yomimono)
  - [mirage-types] Remove `V1.IPV4.input_arp`
  - [mirage-types] Expose `V1.ARP` and `V1_LWT.ARP`
  - Expose a `Mirage.arp` combinator
* Provide noop configuration for default_time (#435, by @yomimono)
* Add `Mirage.archive` and `Mirage.archive_of_files` to support attaching files
  via a read-only tar-formatted BLOCK (#432, by @djs55)
* Add a .merlin file (#428, by @Drup)

### 2.5.1 (2015-07-17)

* [mirage-types] Expose `V1_LWT.FS.page_aligned_buffer = Cstruct.t`

### 2.5.0 (2015-06-10)

* Change the type of the `Mirage.http_server` combinator. The first argument
  (the conduit server configuration) is removed and should now be provided
  at compile-time in `unikernel.ml` instead of configuration-time in
  `config.ml`:

```ocaml
(* [config.ml] *)
(* in 2.4 *) let http = http_server (`TCP (`Port 80)) conduit
(* in 2.5 *) let http = http_server conduit

(* [unikernel.ml] *)
let start http =
(* in 2.4 *) http (S.make ~conn_closed ~callback ())
(* in 2.5 *) http (`TCP 80) (S.make ~conn_closed ~callback ())
    ```

* Change the type of the `Mirage.conduit_direct` combinator.
  Previously, it took an optional `vchan` implementation, an optional
  `tls` immplementation and an optional `stackv4` implemenation. Now,
  it simply takes a `stackv4` implementation and a boolean to enable
  or disable the `tls` stack. Users who want to continue to use
  `vchan` with `conduit` should now use the `Vchan` functors inside
  `unikernel.ml` instead of the combinators in `config.ml`. To
  enable the TLS stack:

```ocaml
(* [config.ml] *)
let conduit = conduit_direct ~tls:true (stack default_console)

(* [unikernel.ml] *)
module Main (C: Conduit_mirage.S): struct
  let start conduit =
    C.listen conduit (`TLS (tls_config, `TCP 443)) callback
end
    ```

* [types] Remove `V1.ENTROPY` and `V1_LWT.ENTROPY`. The entropy is now
  handled directly by `nocrypto.0.4.0` and the mirage-tool is only responsible to
  call the `Nocrypto_entropy_{mode}.initialize` function.

* Remove `Mirage.vchan`, `Mirage.vchan_localhost`, `Mirage.vchan_xen` and
  `Mirage.vchan_default`. Vchan users need to adapt their code to directly
  use the `Vchan` functors instead of relying on the combinators.
* Remove `Mirage.conduit_client` and `Mirage.conduit_server` types.
* Fix misleading "Compiling for target" messages in `mirage build`
  (#408 by @lnmx)
* Add `--no-depext` to disable the automatic installation of opam depexts (#402)
* Support `@name/file` findlib's extended name syntax in `xen_linkopts` fields.
  `@name` is expanded to `%{lib}%/name`
* Modernize the Travis CI scripts

### 2.4.0 (2015-05-05)

* Support `mirage-http.2.2.0`
* Support `conduit.0.8.0`
* Support `tcpip.2.4.0`
* Add time and clock parameters to IPv4 (#362, patch from @yomimono)
* Support for `ocaml-tls` 0.4.0.
* Conduit now takes an optional TLS argument, allowing servers to support
  encryption. (#347)
* Add the ability to specify `Makefile.user` to extend the generated
  `Makefile`. Also `all`, `build` and `clean` are now extensible make
  targets.
* Remove the `mirage run` command (#379)
* Call `opam depext` when configuring (#373)
* Add opam files for `mirage` and `mirage-types` packages
* Fix `mirage --version` (#374)
* Add a `update-doc` target to the Makefile to easily update the online
  documentation at http://mirage.github.io/mirage/

### 2.3.0 (2015-03-10)

* Remove the `IO_PAGE` module type from `V1`. This has now moved into the
  `io-page` pacakge (#356)
* Remove `DEVICE.connect` from the `V1` module types.  When a module is
  functorised over a `DEVICE` it should only have the ability to
  *use* devices it is given, not to connect to new ones. (#150)
* Add `FLOW.error_message` to the `V1` module types to allow for
  generic handling of errors. (#346)
* Add `IP.uipaddr` as a universal IP address type. (#361)
* Support the `entropy` version 0.2+ interfaces. (#359)
* Check that the `opam` command is at least version 1.2.0 (#355)
* Don't put '-classic-display' in the generated Makefiles. (#364)

### 2.2.1 (2015-01-29)

* Fix logging errors when `mirage` output is not redirected. (#355)
* Do not reverse the order of C libraries when linking.  This fixes Zarith
  linking in Xen mode. (#341).
* Fix typos in command line help. (#352).

### 2.2.0 (2014-12-18)

* Add IPv6 support. This alters some of the interfaces that were previously
  hardcoded to IPv4 by generalising them.  For example:

```ocaml
type v4
type v6

type 'a ip
type ipv4 = v4 ip
type ipv6 = v6 ip
    ```

Full support for configuring IPv6 does not exist yet, as this release is
intended for getting the type definitions in place before adding configuration
support.

### 2.1.1 (2014-12-10)

* Do not reuse the Unix linker options when building Xen unikernels.  Instead,
  get the linker options from the ocamlfind `xen_linkopts` variables (#332).
  See `tcpip.2.1.0` for a library that does this for a C binding.
* Only activate MacOS X compilation by default on 10.10 (Yosemite) or higher.
  Older revisions of MacOS X will use the generic Unix mode by default, since
  the `vmnet` framework requires Yosemite or higher.
* Do not run crunched filesystem modules through `camlp4`, which significantly
  speeds up compilation on ARM platforms (from minutes to seconds!) (#299).

### 2.1.0 (2014-12-07)

* Add specific support for `MacOSX` as a platform, which enables network bridging
  on Yosemite (#329).  The `--unix` flag will automatically activate the new target
  if run on a MacOS X host.  If this breaks for you due to being on an older version of
  MacOS X, then use the new `--target` flag to set either Unix, MacOSX or Xen to the
  `mirage configure` command.
* Add `mirage.runtime` findlib library and corresponding Mirage_runtime module (#327).
* If net driver in STACKV4_direct can't initialize, print a helpful error (#164).
* [xen]: fixed link order in generated Makefile (#322).
* Make `Lwt.tracing` instructions work for Fish shell too by improving quoting (#328).

### 2.0.1 (2014-11-21)

* Add `register ~tracing` to enable tracing with mirage-profile at start-up (#321).
* Update Dockerfile for latest libraries (#320).
* Only build mirage-types if Io_page is also installed (#324).

### 2.0.0 (2014-11-05)

* [types]: backwards incompatible change: CONSOLE is now a FLOW;
  'write' has a different signature and 'write_all' has been removed.
* Set on_crash = 'preserve' in default Xen config.
* Automatically install dependencies again, but display the live output to the
  user.
* Include C stub libraries in linker command when generating Makefiles for Xen.
* Add `Vchan`, `Conduit` and `Resolver` code generators.
* Generate a `*.xe` script which can upload a kernel to a XenServer.
* Generate a libvirt `*.xml` configuration file (#292).
* Fix determination of `mirage-xen` location for paths with spaces (#279).
* Correctly show config file locations when using a custom one.
* Fix generation of foreign (non-functor) modules (#293)

### 1.2.0 (2014-07-05)

The Mirage frontend tool now generates a Makefile with a `make depend`
target, instead of directly invoking OPAM as part of `mirage configure`.
This greatly improves usability on slow platforms such as ARM, since the
output of OPAM as it builds can be inspected more easily.  Users will now
need to run `make depend` to ensure they have the latest package set,
before building their unikernel with `make` as normal.

* Improve format of generated Makefile, and also colours in terminal output.
* Add `make depend` target to generated Makefile.
* Set `OPAMVERBOSE` and `OPAMYES` in the Makefile, which can be overridden.
* Add an `ENTROPY` device type for strong random sources (#256).

### 1.1.3 (2014-06-15)

* Build OPAM packages in verbose mode by default.
* [types] Add `FLOW` based on `TCPV4`.
* travis: build mirage-types from here, rather than 1.1.0.

### 1.1.2 (2014-04-01)

* Improvement to the Amazon EC2 deployment script.
* [types] Augment STACKV4 with an IPV4 module in addition to TCPV4 and UDPV4.
* Regenerate with OASIS 0.4.4 (which adds natdynlink support)

### 1.1.1 (2014-02-21)

* Man page fixes for typos and terminology (#220).
* Activate backtrace recording by default (#225).
* Fixes in the `V1.STACKV4` to expose UDPv4/TCPv4 types properly (#226).

### 1.1.0 (2014-02-05)

* Add a combinator interface to device binding that makes the functor generation
  significantly more succinct and expressive.  This breaks backwards compatibility
  with `config.ml` files from the 1.0.x branches.
* Integrate the `mirage-types` code into `types`.  This is built as a separate
  library from the command-line tool, via the `install-types` Makefile target.

### 1.0.4 (2014-01-14)

* Add default build tags for annot, bin_annot, principal and strict_sequence.
* Renane `KV_RO` to `Crunch`

### 1.0.3 (2013-12-18)

* Do not remove OPAM packages when doing `mirage clean` (#143)
* [xen] generate a simple main.xl, without block devices or network interfaces.
* The HTTP dependency now also installs `mirage-tcp-*` and `mirage-http-*`.
* Fix generated Makefile dependency on source OCaml files to rebuild reliably.
* Support `Fat_KV_RO` (a read-only k/v version of the FAT filesystem).
* The Unix `KV_RO` now passes through to the underlying filesystem instead of calling `crunch`, via `mirage-fs-unix`.

### 1.0.2 (2013-12-10)

* Add `HTTP` support.
* Fix `KV_RO` configuration for OPAM autoinstall.

### 1.0.1 (2013-12-09)

* Add more examples to the FAT filesystem test case.
* Fix `mirage-tcpip-*` support
* Fix `mirage-net-*` support

### 1.0.0 (2013-12-09)

* Adapt the latest library releases for Mirage 1.0 interfaces.

### 0.10.0 (2013-12.08)

* Complete API rewrite
* [xen] XL configuration phase is now created during configure phase, was during run phase.

### 0.9.7 (2013-08-09)

* Generate code that uses the `Ipaddr.V4` interface instead of `Nettypes`.

### 0.9.6 (2013-07-26)

* fix unix-direct by linking the unix package correctly (previously it was always dropped).

### 0.9.5 (2013-07-18)

* completely remove the dependency on obuild: use ocamlbuild everywhere now.
* adapt for mirage-0.9.3 OS.Netif interfaces (abstract type `id`).
* do not output network config when there are no `ip-*` lines in the `.conf` file.
* do not try to install `mirage-fs` if there is no filesystem to create.
* added `nat-script.sh` to setup xenbr0 with DNS, DHCP and masqerading under Linux.

### 0.9.4 (2013-07-09)

* build using ocamlbuild rather than depending on obuild.
* [xen] generate a symbol that can be used to produce stack traces with xenctx.
* mirari run --socket just runs the unikernel without any tuntap work.
* mirari run --xen creates a xl config file and runs `xl create -c unikernel.xl`.

### 0.9.3 (2013-06-12)

* Add a `--socket` flag to activate socket-based networking (UNIX only).
* Do not use OPAM compiler switches any more, as that's done in the packaging now.
* Use fd-passing in the UNIX backend to spawn a process.

### 0.9.2 (2013-03-28)

* Install `obuild` automatically in all compiler switches (such as Xen).
* Only create symlinks to `mir-foo` for a non-Xen target.
* Add a `mirari clean` command.
* Add the autoswitch feature via `mirari --switch=<compiler>` or the config file.

### 0.9.1 (2013-02-13)

* Fix Xen symlink upon build.
* Add a `--no-install` option to `mirari configure` to prevent invoking OPAM automatically.

### 0.9.0 (2013-02-12)

* Automatically install `mirage-fs` package if a filesystem crunch is requested.
* Remove the need for `mir-run` by including the final Xen link directly in Mirari.
* Add support for building Xen variants.
* Initial import of a unix-direct version.
07070100000003000081A4000000000000000000000001649164100000031C000000000000000000000000000000000000001800000000mirage-4.4.0/LICENSE.mdISC License

Permission to use, copy, modify, and distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.

THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
07070100000004000081A400000000000000000000000164916410000000B0000000000000000000000000000000000000001600000000mirage-4.4.0/Makefile.PHONY: all clean doc test

all:
	dune build

clean:
	dune clean

doc:
	dune build @doc

test:
	dune runtest
	INSIDE_FUNCTORIA_TESTS=1 dune exec -- test/functoria/e2e/test.exe
07070100000005000081A40000000000000000000000016491641000000B70000000000000000000000000000000000000001700000000mirage-4.4.0/README.md<div align="center">
  <a href="https://mirage.io">
    <img src="./logo.svg" alt="MirageOS logo"/>
  </a>
  <br />
  <strong>Build Unikernels in OCaml</strong>
</div>

[![OCaml-CI Build Status](https://img.shields.io/endpoint?url=https%3A%2F%2Fci.ocamllabs.io%2Fbadge%2Fmirage%2Fmirage%2Fmain&logo=ocaml&style=flat-square)](https://ci.ocamllabs.io/github/mirage/mirage)
[![docs](https://img.shields.io/badge/doc-online-blue.svg)](https://mirage.github.io/mirage/)

</div>

<hr />

<div align="center">
  <em>
    MirageOS is a library operating system that constructs secure,
    performant and resource-efficient unikernels.
  </em>
</div>

## About

MirageOS is a library operating system that constructs unikernels for
secure, high-performance network applications across various cloud
computing and mobile platforms. Developers can write code on a
traditional OS such as Linux or macOS. They can then compile their
code into a fully-standalone, specialised unikernel that runs under
the Xen or KVM hypervisors and lightweight hypervisors like FreeBSD's
BHyve, OpenBSD's VMM. These unikernels can deploy on public clouds,
like Amazon's Elastic Compute Cloud and Google Compute Engine, or
private deployments.

The most up-to-date documentation can be found at the
[homepage](https://mirage.io). The site is [a self-hosted
unikernel](https://github.com/mirage/mirage-www).  Simpler [skeleton
applications](https://github.com/mirage/mirage-skeleton) are also
available online.  MirageOS unikernels repositories are also available
[here](https://github.com/roburio/unikernels) or
[there](https://github.com/tarides/unikernels).

### This repository

This repository contains the `mirage` command-line tool to create and
deploy applications with MirageOS. This tool wraps the specialised
configuration and build steps required to build MirageOS on all the
supported targets.

**Local install**

You will need the following:

* a working [OCaml](https://ocaml.org) compiler (4.08.0 or higher).
* the [Opam](https://opam.ocaml.org) source package manager (2.1.0 or higher).
* an x86\_64 or armel Linux host to compile Xen kernels, or FreeBSD, OpenBSD or
  MacOS X for the solo5 and userlevel versions.

Then run:

```
$ opam install mirage
$ mirage --version
```

This should display at least version `4.0.0`.

### Using `mirage`

There are multiple stages to using `mirage`:

* write `config.ml` to describe the components of your applications;
* call `mirage configure` to generate the necessary code and metadata;
* optionally call `make depends` to install external dependencies and
  download Opam packages in the current [dune](https://dune.build/) workspace.
* call `dune build` to build a unikernel.

You can find documentation, walkthroughs and tutorials over on the
[MirageOS website](https://mirage.io).
The [install instructions](https://mirage.io/wiki/install)
are a good place to begin!
07070100000006000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001100000000mirage-4.4.0/bin07070100000007000081A40000000000000000000000016491641000000056000000000000000000000000000000000000001600000000mirage-4.4.0/bin/dune(executable
 (name main)
 (public_name mirage)
 (package mirage)
 (libraries mirage))
07070100000008000081A4000000000000000000000001649164100000033D000000000000000000000000000000000000001900000000mirage-4.4.0/bin/main.ml(*
 * Copyright (c) 2013 Thomas Gazagnaire <thomas@gazagnaire.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let () = Mirage.Tool.run ()
07070100000009000081A4000000000000000000000001649164100000002C000000000000000000000000000000000000001A00000000mirage-4.4.0/dune-project(lang dune 2.9)
(name mirage)
(cram enable)
0707010000000A000081A4000000000000000000000001649164100000038E000000000000000000000000000000000000002400000000mirage-4.4.0/functoria-runtime.opamopam-version: "2.0"
maintainer:   "Gabriel Radanne <drupyog@zoho.com>"
authors:      [ "Thomas Gazagnaire"
                "Anil Madhavapeddy"
                "Dave Scott"
                "Thomas Leonard"
                "Gabriel Radanne" ]
homepage:     "https://github.com/mirage/mirage"
bug-reports:  "https://github.com/mirage/mirage/issues"
dev-repo:     "git+https://github.com/mirage/mirage.git"
doc:          "https://mirage.github.io/mirage/"
license:      "ISC"
tags:         ["org:mirage"]

build: [
  ["dune" "subst"] {dev}
  ["dune" "build" "-p" name "-j" jobs]
  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
]

depends: [
  "ocaml" {>= "4.08.0"}
  "dune" {>= "2.9.0"}
  "cmdliner" {>= "1.1.1"}
  "cmdliner" {with-test & >= "1.2.0"}
]

synopsis: "Runtime support library for functoria-generated code"
description: """
This is the runtime support library for code generated by functoria.
"""
0707010000000B000081A40000000000000000000000016491641000000602000000000000000000000000000000000000001C00000000mirage-4.4.0/functoria.opamopam-version: "2.0"
maintainer:   "Gabriel Radanne <drupyog@zoho.com>"
authors:      [ "Thomas Gazagnaire"
                "Anil Madhavapeddy"
                "Dave Scott"
                "Thomas Leonard"
                "Gabriel Radanne" ]
homepage:     "https://github.com/mirage/mirage"
bug-reports:  "https://github.com/mirage/mirage/issues"
dev-repo:     "git+https://github.com/mirage/mirage.git"
doc:          "https://mirage.github.io/mirage/"
license:      "ISC"
tags:         ["org:mirage"]
available: opam-version >= "2.1.0"

build: [
  ["dune" "subst"] {dev}
  ["dune" "build" "-p" name "-j" jobs]
  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
  ["env" "INSIDE_FUNCTORIA_TESTS=1" "dune" "exec" "-p" name "-j" jobs "--"
     "test/functoria/e2e/test.exe"] {with-test}
]

depends: [
  "ocaml" {>= "4.08.0"}
  "dune" {>= "2.9.0"}
  "dune" {with-test & >= "3.0.0"}
  "base-unix"
  "cmdliner" {>= "1.1.1"}
  "cmdliner" {with-test & >= "1.2.0"}
  "rresult" {>= "0.7.0"}
  "result" {>= "1.5"}
  "astring"
  "fmt" {>= "0.8.7"}
  "logs"
  "bos"
  "fpath"
  "emile" {>= "1.1"}
  "uri" {>= "4.2.0"}
  "alcotest" {with-test}
  "functoria-runtime" {= version & with-test}
  "bigstringaf" {with-test & >= "0.5.0"}
]
synopsis: "A DSL to organize functor applications"
description: """
Functoria is a DSL to describe a set of modules and functors, their types and
how to apply them in order to produce a complete application.

The main use case is mirage. See the [mirage](https://github.com/mirage/mirage)
repository for details.
"""
0707010000000C000041ED0000000000000000000000046491641000000000000000000000000000000000000000000000001100000000mirage-4.4.0/lib0707010000000D000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001B00000000mirage-4.4.0/lib/functoria0707010000000E000081A4000000000000000000000001649164100000081C000000000000000000000000000000000000002200000000mirage-4.4.0/lib/functoria/DSL.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type 'a key = 'a Key.key
type 'a value = 'a Key.value
type abstract_key = Key.t
type package = Package.t
type scope = Package.scope
type 'a typ = 'a Type.t
type 'a impl = 'a Impl.t
type abstract_impl = Impl.abstract
type 'a device = ('a, Impl.abstract) Device.t
type context = Key.context
type job = Job.t
type info = Info.t

let package = Package.v
let ( @-> ) = Type.( @-> )
let typ = Type.v
let ( $ ) = Impl.( $ )
let of_device = Impl.of_device
let key = Key.v
let dep = Impl.abstract
let abstract = dep
let if_impl = Impl.if_
let match_impl = Impl.match_

let impl ?packages ?packages_v ?install ?install_v ?keys ?extra_deps ?connect
    ?dune ?configure ?files module_name module_type =
  of_device
  @@ Device.v ?packages ?packages_v ?install ?install_v ?keys ?extra_deps
       ?connect ?dune ?configure ?files module_name module_type

let main ?packages ?packages_v ?keys ?extra_deps module_name ty =
  let connect _ = Device.start in
  impl ?packages ?packages_v ?keys ?extra_deps ~connect module_name ty

let foreign ?packages ?packages_v ?keys ?deps module_name ty =
  main ?packages ?packages_v ?keys ?extra_deps:deps module_name ty
0707010000000F000081A40000000000000000000000016491641000001900000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/DSL.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** The Functoria DSL allows users to describe how to create portable and
    flexible applications. It allows to pass application parameters easily using
    command-line arguments either at configure-time or at runtime.

Users of the Functoria DSL composes their application by defining a list of
    {{!main} module} implementations, specify the command-line {!type-key} that
    are required and {{!section-combinators} combine} all of them together using
    {{:http://dx.doi.org/10.1017/S0956796807006326} applicative} operators.

The DSL expression is then compiled into an {{!section-app} application
    builder}, which will, once evaluated, produced the final portable and
    flexible application. *)

(** {1:combinators Combinators} *)

type 'a typ = 'a Type.t
(** The type for values representing module types. *)

val typ : 'a -> 'a typ
(** [type t] is a value representing the module type [t]. *)

val ( @-> ) : 'a typ -> 'b typ -> ('a -> 'b) typ
(** Construct a functor type from a type and an existing functor type. This
    corresponds to prepending a parameter to the list of functor parameters. For
    example:

{[
      kv_ro @-> ip @-> kv_ro
    ]}

This describes a functor type that accepts two arguments -- a [kv_ro] and an
    [ip] device -- and returns a [kv_ro]. *)

type 'a impl = 'a Impl.t
(** The type for values representing module implementations. *)

val ( $ ) : ('a -> 'b) impl -> 'a impl -> 'b impl
(** [m $ a] applies the functor [m] to the module [a]. *)

type abstract_impl = Impl.abstract
(** Same as {!type-impl} but with hidden type. *)

val dep : 'a impl -> abstract_impl
(** [dep t] is the (build-time) dependency towards [t]. *)

val abstract : 'a impl -> abstract_impl
  [@@ocaml.deprecated "Use Functoria.dep."]

(** {1:keys Keys} *)

type 'a key = 'a Key.key
(** The type for command-line parameters. *)

type abstract_key = Key.t
(** The type for abstract keys. *)

type context = Key.context
(** The type for keys' parsing context. See {!module-Key.type-context}. *)

type 'a value = 'a Key.value
(** The type for values parsed from the command-line. See {!Key.type-value}. *)

val key : 'a key -> Key.t
(** [key k] is an untyped representation of [k]. *)

val if_impl : bool value -> 'a impl -> 'a impl -> 'a impl
(** [if_impl v impl1 impl2] is [impl1] if [v] is resolved to true and [impl2]
    otherwise. *)

val match_impl : 'b value -> default:'a impl -> ('b * 'a impl) list -> 'a impl
(** [match_impl v cases ~default] chooses the implementation amongst [cases] by
    matching the [v]'s value. [default] is chosen if no value matches. *)

(** {1:pkg Package dependencies}

For specifying opam package dependencies, the type {!type-package} is used.
    It consists of the opam package name, the ocamlfind names, and optional
    lower and upper bounds. The version constraints are merged with other
    modules. *)

type package = Package.t
(** The type for opam packages. *)

type scope = Package.scope
(** Installation scope of a package. *)

val package :
  ?scope:scope ->
  ?build:bool ->
  ?sublibs:string list ->
  ?libs:string list ->
  ?min:string ->
  ?max:string ->
  ?pin:string ->
  ?pin_version:string ->
  string ->
  package
(** Same as {!Functoria.Package.val-v} *)

(** {1:app Application Builder}

Values of type {!type-impl} are tied to concrete module implementation with
    the {!device} and {!foreign} construct. Module implementations of type
    {!type-job} can then be {{!Functoria.Lib.Make.register} registered} into an
    application builder. The builder is in charge if parsing the command-line
    arguments and of generating code for the final application. See
    {!Functoria.Lib} for details. *)

type info = Info.t
(** The type for build information. *)

val foreign :
  ?packages:package list ->
  ?packages_v:package list value ->
  ?keys:abstract_key list ->
  ?deps:abstract_impl list ->
  string ->
  'a typ ->
  'a impl
(** Alias for {!main}, where [?extra_deps] has been renamed to [?deps]. *)

val main :
  ?packages:package list ->
  ?packages_v:package list value ->
  ?keys:abstract_key list ->
  ?extra_deps:abstract_impl list ->
  string ->
  'a typ ->
  'a impl
(** [foreign name typ] is the functor [name], having the module type [typ]. The
    connect code will call [<name>.start].

- If [packages] or [packages_v] is set, then the given packages are
      installed before compiling the current application.
    - If [keys] is set, use the given {{!Key.key} keys} to parse at configure
      and runtime the command-line arguments before calling [<name>.connect].
    - If [extra_deps] is set, the given list of {{!abstract_impl} abstract}
      implementations is added as data-dependencies: they will be initialized
      before calling [<name>.connect]. *)

(** {1 Devices} *)

type 'a device = ('a, abstract_impl) Device.t

val of_device : 'a device -> 'a impl
(** [of_device t] is the implementation device [t]. *)

val impl :
  ?packages:package list ->
  ?packages_v:package list Key.value ->
  ?install:(Info.t -> Install.t) ->
  ?install_v:(Info.t -> Install.t Key.value) ->
  ?keys:Key.t list ->
  ?extra_deps:abstract_impl list ->
  ?connect:(info -> string -> string list -> string) ->
  ?dune:(info -> Dune.stanza list) ->
  ?configure:(info -> unit Action.t) ->
  ?files:(info -> Fpath.t list) ->
  string ->
  'a typ ->
  'a impl
(** [impl ...] is [of_device @@ Device.v ...] *)

(** {1 Jobs} *)

type job = Job.t
07070100000010000081A40000000000000000000000016491641000005457000000000000000000000000000000000000002500000000mirage-4.4.0/lib/functoria/action.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 * Copyright (c) 2019-2020 Etienne Millon <etienne@tarides.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let src = Logs.Src.create "functoria.action" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)
open Astring

type 'a or_err = ('a, Rresult.R.msg) result
type tmp_name_pat = Bos.OS.File.tmp_name_pat

type 'a with_output = {
  mode : int option;
  path : Fpath.t;
  purpose : string;
  contents : Format.formatter -> 'a;
  append : bool;
}

type channel = [ `Null | `Fmt of Format.formatter ]
type cmd = { cmd : Bos.Cmd.t; err : channel; out : channel; trim : bool }
type ls = { root : Fpath.t; filter : Fpath.t -> bool }

and _ t =
  | Done : 'a -> 'a t
  | Fail : string -> 'a t
  | Run : 'r command * ('r -> 'a t) -> 'a t

let ok x = Done x
let error e = Fail e
let errorf fmt = Fmt.kstr error fmt

let rec bind ~f = function
  | Done r -> f r
  | Fail s -> Fail s
  | Run (c, k) ->
      let k2 r = bind ~f (k r) in
      Run (c, k2)

let map ~f x = bind x ~f:(fun y -> ok (f y))
let rec seq = function [] -> ok () | h :: t -> bind ~f:(fun () -> seq t) h
let wrap x = Run (x, ok)
let ( ! ) = Fpath.normalize
let rm path = wrap @@ Rm !path
let rmdir path = wrap @@ Rmdir !path
let mkdir path = wrap @@ Mkdir !path
let ls path filter = wrap @@ Ls { root = !path; filter }
let with_dir path f = wrap @@ With_dir (!path, f)
let pwd () = wrap @@ Pwd
let is_file path = wrap @@ Is_file !path
let is_dir path = wrap @@ Is_dir !path
let size_of path = wrap @@ Size_of !path
let set_var c v = wrap @@ Set_var (c, v)
let get_var c = wrap @@ Get_var c

let run_cmd ?(err = `Fmt Fmt.stderr) ?(out = `Fmt Fmt.stdout) cmd =
  wrap @@ Run_cmd { cmd; out; err; trim = false }

let run_cmd_out ?(err = `Fmt Fmt.stderr) cmd =
  wrap @@ Run_cmd_out { cmd; out = `Null; err; trim = true }

let run_cmd_cli cmd = wrap @@ Run_cmd_cli cmd
let write_file path contents = wrap @@ Write_file (!path, contents)
let read_file path = wrap @@ Read_file !path
let tmp_file ?mode pat = wrap @@ Tmp_file (mode, pat)

let with_output ?mode ?(append = false) ~path ~purpose contents =
  wrap @@ With_output { append; mode; path; purpose; contents }

let pfo ppf s = match ppf with `Null -> () | `Fmt ppf -> Fmt.pf ppf "%s%!" s

let interpret_cmd { cmd; err; out; trim } =
  Log.debug (fun l -> l "RUN: %a" Bos.Cmd.pp cmd);
  let open Rresult in
  let err =
    match err with
    | `Null -> Ok (Bos.OS.Cmd.err_null, fun () -> Ok ())
    | `Fmt ppf ->
        Bos.OS.File.tmp "cmd-err-%s" >>| fun path ->
        let flush () = Bos.OS.File.read path >>| fun s -> Fmt.pf ppf "%s%!" s in
        (Bos.OS.Cmd.err_file path, flush)
  in
  err >>= fun (err, flush_err) ->
  let res = Bos.OS.Cmd.run_out ~err cmd in
  let res = Bos.OS.Cmd.out_string ~trim res in
  res >>= fun (str_out, _) ->
  pfo out str_out;
  flush_err () >>= fun () -> Bos.OS.Cmd.success res

let interpret_cmd_cli cmd =
  Log.debug (fun l -> l "RUN-CLI: %a" Bos.Cmd.pp cmd);
  let res = Bos.OS.Cmd.run_out cmd in
  match Bos.OS.Cmd.out_stdout res with
  | Ok ((), (_, `Exited 0)) -> Ok ()
  | Ok ((), (_, `Exited _)) -> Error (`Msg "")
  | failure -> Bos.OS.Cmd.success failure

let rec interpret_command : type r. r command -> r or_err = function
  | Rmdir path ->
      Log.debug (fun l -> l "rmdir %a" Fpath.pp path);
      Bos.OS.Dir.delete ~recurse:true path
  | Mkdir path ->
      Log.debug (fun l -> l "mkdir %a" Fpath.pp path);
      Bos.OS.Dir.create ~path:true path
  | Ls { root; filter } ->
      let open Rresult in
      Log.debug (fun l -> l "ls %a" Fpath.pp root);
      Bos.OS.Path.matches ~dotfiles:true Fpath.(root / "$(file)")
      >>| fun files -> List.filter filter files
  | Rm path ->
      Log.debug (fun l -> l "rm %a" Fpath.pp path);
      Bos.OS.File.delete ~must_exist:false path
  | Is_file path ->
      Log.debug (fun l -> l "is-file %a" Fpath.pp path);
      Bos.OS.File.exists path
  | Is_dir path ->
      Log.debug (fun l -> l "is-dir %a" Fpath.pp path);
      Bos.OS.Dir.exists path
  | Size_of path -> (
      Log.debug (fun l -> l "size-of %a" Fpath.pp path);
      match Bos.OS.Path.stat path with
      | Ok s -> Ok (Some s.Unix.st_size)
      | _ -> Ok None)
  | Run_cmd cmd -> Rresult.(interpret_cmd cmd >>| fun _ -> ())
  | Run_cmd_out cmd -> interpret_cmd cmd
  | Run_cmd_cli cmd -> interpret_cmd_cli cmd
  | Set_var (c, v) ->
      Log.debug (fun l ->
          l "set_var %s %a" c Fmt.(option ~none:(any "<unset>") string) v);
      Bos.OS.Env.set_var c v
  | Get_var c ->
      Log.debug (fun l -> l "get_var %s" c);
      Ok (Bos.OS.Env.var c)
  | With_dir (dir, f) ->
      let f () = run (f ()) in
      let open Rresult in
      Bos.OS.Dir.current () >>= fun old ->
      Log.debug (fun l -> l "entering %a" Fpath.pp dir);
      Rresult.R.join @@ Bos.OS.Dir.with_current dir f () >>| fun r ->
      Log.debug (fun l -> l "entering %a" Fpath.pp old);
      r
  | Pwd ->
      Log.debug (fun l -> l "pwd");
      Bos.OS.Dir.current ()
  | Write_file (path, contents) ->
      Log.debug (fun l -> l "write %a" Fpath.pp path);
      Bos.OS.File.write path contents
  | Read_file path ->
      Log.debug (fun l -> l "read-file %a" Fpath.pp path);
      Bos.OS.File.read path
  | Tmp_file (mode, pat) ->
      Log.debug (fun l -> l "tmp-file %s" Fmt.(str pat "*"));
      Bos.OS.File.tmp ?mode pat
  | With_output { mode; path; purpose; contents; append } -> (
      try
        let oc =
          let path = Fpath.to_string path in
          let mode = match mode with None -> 0o666 | Some m -> m in
          if append then
            open_out_gen [ Open_wronly; Open_append; Open_text ] mode path
          else open_out path
        in
        let ppf = Format.formatter_of_out_channel oc in
        let r = contents ppf in
        Fmt.pf ppf "%!";
        flush oc;
        close_out oc;
        Ok r
      with e ->
        Rresult.R.error_msgf "couldn't open output channel for %s: %a" purpose
          Fmt.exn e)

and run : type r. r t -> r or_err = function
  | Done r -> Ok r
  | Fail f -> Error (`Msg f)
  | Run (cmd, k) -> Rresult.R.bind (interpret_command cmd) (fun x -> run @@ k x)

type files = [ `Passtrough of Fpath.t | `Files of (Fpath.t * string) list ]

let default_exec cmd =
  let cmd =
    Fmt.str "$(%a)\n" Fmt.(list ~sep:(any " ") string) (Bos.Cmd.to_list cmd)
  in
  Some (cmd, "")

(* (simple) virtual environment *)
module Env : sig
  type t

val eq : t -> t -> bool
  val pp : t Fmt.t
  val diff_files : old:t -> t -> Fpath.Set.t
  val pwd : t -> Fpath.t
  val chdir : t -> Fpath.t -> t
  val ls : t -> Fpath.t -> Fpath.t list option

val v :
    ?exec:(Bos.Cmd.t -> (string * string) option) ->
    ?env:(string * string) list ->
    ?pwd:Fpath.t ->
    ?files:files ->
    unit ->
    t

val exec : t -> Bos.Cmd.t -> (string * string) option
  val is_file : t -> Fpath.t -> bool
  val is_dir : t -> Fpath.t -> bool
  val mkdir : t -> Fpath.t -> (t * bool) option
  val rm : t -> Fpath.t -> (t * bool) option
  val rmdir : t -> Fpath.t -> t
  val size_of : t -> Fpath.t -> int option
  val write : t -> Fpath.t -> string -> t
  val read : t -> Fpath.t -> string option
  val tmp_file : t -> tmp_name_pat -> Fpath.t
  val set_var : t -> string -> string option -> t
  val get_var : t -> string -> string option
end = struct
  type t = {
    files : string Fpath.Map.t;
    pwd : Fpath.t;
    env : string String.Map.t;
    exec : Bos.Cmd.t -> (string * string) option;
  }

let diff_files ~old t =
    let to_set t =
      Fpath.Map.fold
        (fun f _ acc ->
          match Fpath.rem_prefix t.pwd f with
          | None -> acc
          | Some f -> Fpath.Set.add f acc)
        t.files Fpath.Set.empty
    in
    Fpath.Set.diff (to_set t) (to_set old)

let scan dir =
    (let open Rresult in
     Bos.OS.Path.fold ~dotfiles:true ~elements:`Files ~traverse:`Any
       (fun file files ->
         files >>= fun files ->
         Bos.OS.File.read file >>| fun c -> (file, c) :: files)
       (Ok []) [ dir ])
    |> Rresult.R.join
    |> Rresult.R.error_msg_to_invalid_arg

let v ?(exec = default_exec) ?env ?pwd ?(files = `Files []) () =
    let env =
      match env with Some e -> String.Map.of_list e | None -> String.Map.empty
    in
    let pwd = match pwd with None -> Fpath.v "/" | Some p -> p in
    let files =
      let files =
        match files with `Passtrough dir -> scan dir | `Files files -> files
      in
      let files =
        List.map
          (fun (f, c) ->
            match Fpath.is_rel f with
            | false -> (f, c)
            | true -> (Fpath.(pwd // f), c))
          files
      in
      List.map (fun (f, c) -> (Fpath.normalize f, c)) files
    in
    { files = Fpath.Map.of_list files; pwd; env; exec }

let eq x y =
    Fpath.Map.equal ( = ) x.files y.files
    && Fpath.equal x.pwd y.pwd
    && String.Map.equal ( = ) x.env y.env

let pp =
    let open Fmt.Dump in
    record
      [
        field "files" (fun t -> t.files) (Fpath.Map.dump string);
        field "pwd" (fun t -> t.pwd) Fpath.dump;
        field "env" (fun t -> t.env) (String.Map.dump string);
      ]

let pwd t = t.pwd
  let exec t cmd = t.exec cmd

let mk_path t path =
    match (Fpath.to_string t.pwd, Fpath.is_rel path) with
    | _, true -> Fpath.(normalize @@ (t.pwd // path))
    | _, false -> Fpath.normalize path

let chdir t path =
    let pwd = mk_path t path in
    { t with pwd }

let is_root path = Fpath.to_string path = "/"

let mkdir t path =
    let path = mk_path t path in
    if is_root path then Some (t, false)
    else
      match Fpath.Map.find path t.files with
      | Some f when f <> "<DIR>" -> None
      | r ->
          let t = { t with files = Fpath.Map.add path "<DIR>" t.files } in
          Some (t, r = None)

let rmdir t path =
    let path = mk_path t path in
    let files =
      Fpath.Map.filter
        (fun f _ ->
          let f = mk_path t f in
          let b = not (Fpath.is_prefix path f) in
          b)
        t.files
    in
    { t with files }

let ls t path =
    let root = mk_path t path in
    match Fpath.Map.find root t.files with
    | Some "<DIR>" -> Some []
    | Some _ -> Some [ path ]
    | None -> (
        Fpath.Map.fold
          (fun file _ acc ->
            let file = mk_path t file in
            match Fpath.relativize ~root file with
            | None -> acc
            | Some f -> f :: acc)
          t.files []
        |> function
        | [] -> None
        | x -> Some (List.rev x))

let write t path f =
    let path = mk_path t path in
    { t with files = Fpath.Map.add path f t.files }

let read t path =
    let path = mk_path t path in
    Fpath.Map.find path t.files

let tmp_file t pat =
    let rec aux n =
      let dir = Fpath.v "/tmp" in
      let file = Fpath.(dir / Fmt.str pat (string_of_int n)) in
      if Fpath.Map.mem file t.files then aux (n + 1) else file
    in
    aux 0

let is_dir t path =
    let path = mk_path t path in
    match Fpath.Map.find path t.files with
    | Some "<DIR>" -> true
    | Some _ -> false
    | None ->
        Fpath.Map.exists
          (fun f _ ->
            let f = mk_path t f in
            Fpath.is_prefix path f)
          t.files

let is_file t path =
    let path = mk_path t path in
    match Fpath.Map.find path t.files with
    | Some "<DIR>" | None -> false
    | Some _ -> true

let rm t path =
    let path = mk_path t path in
    match Fpath.Map.find path t.files with
    | Some "<DIR>" -> None
    | Some _ -> Some ({ t with files = Fpath.Map.remove path t.files }, true)
    | None -> if is_dir t path then None else Some (t, false)

let size_of t path =
    let path = mk_path t path in
    match Fpath.Map.find path t.files with
    | None -> None
    | Some "<DIR>" -> Some 0
    | Some f -> Some (String.length f)

let set_var t c = function
    | None -> { t with env = String.Map.remove c t.env }
    | Some v -> { t with env = String.Map.add c v t.env }

let get_var t c = String.Map.find c t.env
end

let error_msg = Rresult.R.error_msgf

type env = Env.t

let env = Env.v

type 'a domain = { result : 'a or_err; env : Env.t; logs : string list }

let pp_or_err pp_a = Rresult.R.pp ~error:Rresult.R.pp_msg ~ok:pp_a
let eq_or_err eq_a = Rresult.R.equal ~error:( = ) ~ok:eq_a

let pp_domain pp_a =
  let open Fmt.Dump in
  record
    [
      field "result" (fun t -> t.result) (pp_or_err pp_a);
      field "env" (fun t -> t.env) Env.pp;
      field "logs" (fun t -> t.logs) Fmt.Dump.(list string);
    ]

let eq_domain eq a b =
  eq_or_err eq a.result b.result && Env.eq a.env b.env && a.logs = b.logs

let dom result env logs = { result; env; logs }

let interpret_dry_cmd env { cmd; err; out; _ } : string domain =
  Log.debug (fun l -> l "Run_cmd '%a'" Bos.Cmd.pp cmd);
  let log x = Fmt.str "Run_cmd '%a' (%s)" Bos.Cmd.pp cmd x in
  match Env.exec env cmd with
  | None -> dom (error_msg "'%a' not found" Bos.Cmd.pp cmd) env [ log "error" ]
  | Some (o, e) ->
      pfo out o;
      pfo err e;
      dom (Ok o) env [ log "ok" ]

let interpret_dry_cmd_cli env cmd : unit domain =
  Log.debug (fun l -> l "Run_cmd_cli '%a'" Bos.Cmd.pp cmd);
  let log x = Fmt.str "Run_cmd_cli '%a' (%s)" Bos.Cmd.pp cmd x in
  match Env.exec env cmd with
  | None -> dom (error_msg "'%a' not found" Bos.Cmd.pp cmd) env [ log "error" ]
  | Some _ -> dom (Ok ()) env [ log "ok" ]

let rec interpret_dry : type r. env:Env.t -> r command -> r domain =
 fun ~env -> function
  | Mkdir path -> (
      Log.debug (fun l -> l "Mkdir %a" Fpath.pp path);
      let log s = Fmt.str "Mkdir %a (%s)" Fpath.pp path s in
      match Env.mkdir env path with
      | Some (env, true) -> dom (Ok true) env [ log "created" ]
      | Some (env, false) -> dom (Ok false) env [ log "already exists" ]
      | None ->
          dom
            (error_msg "a file named '%a' already exists" Fpath.pp path)
            env
            [ log "error" ])
  | Rmdir path ->
      Log.debug (fun l -> l "Rmdir %a" Fpath.pp path);
      let log s = Fmt.str "Rmdir %a (%s)" Fpath.pp path s in
      if Env.is_dir env path || Env.is_file env path then
        dom (Ok ()) (Env.rmdir env path) [ log "removed" ]
      else dom (Ok ()) env [ log "no-op" ]
  | Ls { root; filter } -> (
      Log.debug (fun l -> l "Ls %a" Fpath.pp root);
      let logs fmt = Fmt.kstr (Fmt.str "Ls %a (%s)" Fpath.pp root) fmt in
      match Env.ls env root with
      | None ->
          dom
            (error_msg "%a: no such file or directory" Fpath.pp root)
            env
            [ logs "error" ]
      | Some es -> (
          match List.filter filter es with
          | ([] | [ _ ]) as e ->
              dom (Ok e) env [ logs "%d entry" (List.length e) ]
          | es -> dom (Ok es) env [ logs "%d entries" (List.length es) ]))
  | Rm path -> (
      Log.debug (fun l -> l "Rm %a" Fpath.pp path);
      let log s = Fmt.str "Rm %a (%s)" Fpath.pp path s in
      match Env.rm env path with
      | Some (env, b) ->
          dom (Ok ()) env [ log (if b then "removed" else "no-op") ]
      | None ->
          dom (error_msg "%a is a directory" Fpath.pp path) env [ log "error" ])
  | Is_file path ->
      Log.debug (fun l -> l "Is_file %a" Fpath.pp path);
      let r = Env.is_file env path in
      dom (Ok r) env [ Fmt.str "Is_file? %a -> %b" Fpath.pp path r ]
  | Is_dir path ->
      Log.debug (fun l -> l "Is_dir %a" Fpath.pp path);
      let r = Env.is_dir env path in
      dom (Ok r) env [ Fmt.str "Is_dir? %a -> %b" Fpath.pp path r ]
  | Size_of path ->
      Log.debug (fun l -> l "Size_of %a" Fpath.pp path);
      let r = Env.size_of env path in
      dom (Ok r) env
        [
          Fmt.str "Size_of %a -> %a" Fpath.pp path
            Fmt.(option ~none:(any "error") int)
            r;
        ]
  | Run_cmd cmd -> (
      let domain = interpret_dry_cmd env cmd in
      match domain.result with
      | Ok _ -> { domain with result = Ok () }
      | Error _ as r -> { domain with result = r })
  | Run_cmd_out cmd -> interpret_dry_cmd env cmd
  | Run_cmd_cli cmd -> interpret_dry_cmd_cli env cmd
  | Write_file (path, s) ->
      Log.debug (fun l -> l "Write_file %a" Fpath.pp path);
      dom (Ok ()) (Env.write env path s)
        [ Fmt.str "Write to %a (%d bytes)" Fpath.pp path (String.length s) ]
  | Read_file path -> (
      Log.debug (fun l -> l "Read_file %a" Fpath.pp path);
      match Env.read env path with
      | None ->
          let log = Fmt.str "Read: %a" Fpath.pp path in
          dom (error_msg "read_file: file does not exist") env [ log ]
      | Some r ->
          let log =
            Fmt.str "Read %a (%d bytes)" Fpath.pp path (String.length r)
          in
          dom (Ok r) env [ log ])
  | Tmp_file (_, pat) ->
      Log.debug (fun l -> l "Tmp_file %s" Fmt.(str pat "*"));
      let r = Env.tmp_file env pat in
      dom (Ok r) env [ Fmt.str "Tmp_file -> %a" Fpath.pp r ]
  | Set_var (c, v) ->
      Log.debug (fun l ->
          l "Set_var %s %a" c Fmt.(option ~none:(any "<none>") string) v);
      let env = Env.set_var env c v in
      let log =
        Fmt.str "Set_var %s %a" c Fmt.(option ~none:(any "<unset>") string) v
      in
      dom (Ok ()) env [ log ]
  | Get_var c ->
      Log.debug (fun l -> l "Get_var %s" c);
      let v = Env.get_var env c in
      let log =
        Fmt.str "Get_var %s -> %a" c
          Fmt.(option ~none:(any "<not set>") string)
          v
      in
      dom (Ok v) env [ log ]
  | With_dir (dir, f) ->
      Log.debug (fun l -> l "With_dir %a" Fpath.pp dir);
      let old = Env.pwd env in
      let env = Env.chdir env dir in
      let domain = dry_run ~env (f ()) in
      let env = Env.chdir domain.env old in
      let log =
        Fmt.str "With_dir %a [%a]" Fpath.pp dir
          Fmt.(vbox ~indent:2 (list ~sep:(any "@,") string))
          domain.logs
      in
      { domain with env; logs = [ log ] }
  | Pwd ->
      Log.debug (fun l -> l "Pwd");
      let r = Env.pwd env in
      dom (Ok r) env [ Fmt.str "Pwd -> %a" Fpath.pp r ]
  | With_output { mode; path; purpose; contents; append } ->
      let pp_append ppf () = if append then Fmt.string ppf "[append]" else () in
      Log.debug (fun l ->
          l "With_output%a %a (%s)" pp_append () Fpath.pp path purpose);
      let buf = Buffer.create 0 in
      let fmt = Format.formatter_of_buffer buf in
      let pp_mode fmt = function
        | None -> Format.fprintf fmt "default"
        | Some n -> Format.fprintf fmt "%#o" n
      in
      let r = contents fmt in
      Fmt.pf fmt "%!";
      let f = Buffer.contents buf in
      let log =
        Fmt.str "Write to %a (mode: %a, purpose: %s)" Fpath.pp path pp_mode mode
          purpose
      in
      dom (Ok r) (Env.write env path f) [ log ]

and dry_run : type r. env:Env.t -> r t -> r domain =
 fun ~env t ->
  let rec go t ~env log =
    match t with
    | Done r -> dom (Ok r) env log
    | Fail e -> dom (Error (`Msg e)) env log
    | Run (cmd, k) -> (
        let domain = interpret_dry ~env cmd in
        let new_log = List.rev domain.logs @ log in
        match domain.result with
        | Ok x -> go (k x) ~env:domain.env new_log
        | Error _ as e -> dom e domain.env new_log)
  in
  let domain = go t ~env [] in
  { domain with logs = List.rev domain.logs }

let dry_run ?(env = env ()) t = dry_run ~env t

let dry_run_trace ?env t =
  let domain = dry_run ?env t in
  List.iter print_endline domain.logs

let generated_files ?(env = env ~exec:(fun _ -> None) ()) t =
  let domain = dry_run ~env t in
  Env.diff_files ~old:env domain.env

module Infix = struct
  let ( >>= ) x f = bind ~f x
  let ( >|= ) x f = map ~f x
end

module Syntax = struct
  open Infix

let ( let* ) = ( >>= )
  let ( let+ ) = ( >|= )
end

module List = struct
  open Infix

let iter ~f l = List.fold_left (fun acc e -> acc >>= fun () -> f e) (ok ()) l

let map ~f l =
    List.fold_left
      (fun acc e ->
        acc >>= fun acc ->
        f e >|= fun e -> e :: acc)
      (ok []) l
end
07070100000011000081A400000000000000000000000164916410000017DA000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/action.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 * Copyright (c) 2019-2020 Etienne Millon <etienne@tarides.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Wrapper around [Bos] which provides a "dry run" feature. *)

(** {1 The action type} *)

type 'a t
(** An action that when executed may return a value of type ['a]. *)

val ok : 'a -> 'a t
(** An action that returns a value. *)

val error : string -> 'a t
(** [error e] is the failed action with error message [e]. *)

val errorf : ('a, Format.formatter, unit, 'b t) format4 -> 'a
(** [errorf fmt] is the failed action with error message [fmt]. *)

val map : f:('a -> 'b) -> 'a t -> 'b t
(** Functor instance. *)

val bind : f:('a -> 'b t) -> 'a t -> 'b t
(** Monad instance. *)

val seq : unit t list -> unit t
(** [seq t] runs the elements of [t] in sequence. *)

module List : sig
  val iter : f:('a -> unit t) -> 'a list -> unit t
  val map : f:('a -> 'b t) -> 'a list -> 'b list t
end

module Infix : sig
  val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
  val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
end

module Syntax : sig
  val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
  val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
end

(** {1 Actions} *)

val rm : Fpath.t -> unit t
(** Delete a file. (see [Bos.OS.File.delete]) *)

val mkdir : Fpath.t -> bool t
(** Create a directory. (See [Bos.OS.Dir.create] *)

val rmdir : Fpath.t -> unit t
(** Remove a directory. (see [Bos.OS.Dir.delete]) *)

val with_dir : Fpath.t -> (unit -> 'a t) -> 'a t
(** [with_dir d f] runs [f] with [d] as current working directory. (See
    [Bos.OS.Dir.with_current]). *)

val pwd : unit -> Fpath.t t
(** [pwd ()] is the current working directory. (See [Bos.OS.Dir.current]) *)

val is_file : Fpath.t -> bool t
(** Does a file exist? (see [Bos.OS.File.exists]) *)

val is_dir : Fpath.t -> bool t
(** Does a directory exist? (see [Bos.OS.Dir.exists]) *)

val size_of : Fpath.t -> int option t
(** [size_of f] is [Some i] if [f] exists and is of size [i], and [None] if [f]
    doesn't exist. *)

val set_var : string -> string option -> unit t
(** [set_var v c] sets env variable [c] to [c]. (see [Bos.OS.Env.set_var]) *)

val get_var : string -> string option t
(** [get_var v] gets the value of the variable [c] in the environment. (see
    [Bos.OS.Env.get]) *)

type channel = [ `Null | `Fmt of Format.formatter ]
(** The type for channels. *)

val run_cmd : ?err:channel -> ?out:channel -> Bos.Cmd.t -> unit t
(** Run a command. By default, [err] is [Fmt.stderr] and [out] is [Fmt.stdout].
    (see [Bos.OS.Cmd.run]) *)

val run_cmd_out : ?err:channel -> Bos.Cmd.t -> string t
(** Run a command and return its trimmed stdout. By default [err] is
    [Fmt.stderr]. (See [Bos.OS.Cmd.run_out]) *)

val run_cmd_cli : Bos.Cmd.t -> unit t
(** Run a command as a command line interface, meaning stdout and stderr remain
    untouched. *)

val write_file : Fpath.t -> string -> unit t
(** Write some data to a file. (see [Bos.OS.File.write]) *)

val read_file : Fpath.t -> string t
(** [read_file f] is [f]'s contents. (see [Bos.OS.File.read]) *)

val tmp_file : ?mode:int -> Bos.OS.File.tmp_name_pat -> Fpath.t t
(** [tmp_file pat] is a tempory file built using the pattern [pat]. (See
    [Bos.OS.File.tmp]) *)

val ls : Fpath.t -> (Fpath.t -> bool) -> Fpath.t list t
(** [ls dir] is the list of files in [dir]. *)

val with_output :
  ?mode:int ->
  ?append:bool ->
  path:Fpath.t ->
  purpose:string ->
  (Format.formatter -> 'a) ->
  'a t
(** Open a file with a given mode, and write some data to it through a function.
    (see [Bos.OS.File.with_oc]). [purpose] is used in error messages. If
    [append] is set (by default it is not), the data is appended to [path]. *)

(** {1 Interpreters} *)

val run : 'a t -> ('a, Rresult.R.msg) result
(** Run the command through [Bos]. *)

type env
(** The type for virtual environments. *)

type files = [ `Passtrough of Fpath.t | `Files of (Fpath.t * string) list ]

val default_exec : Bos.Cmd.t -> (string * string) option
(** [default_exec cmd] is [Some ("$(<cmd>)", "")]. *)

val env :
  ?exec:(Bos.Cmd.t -> (string * string) option) ->
  ?env:(string * string) list ->
  ?pwd:Fpath.t ->
  ?files:files ->
  unit ->
  env

type 'a domain = {
  result : ('a, Rresult.R.msg) result;
  env : env;
  logs : string list;
}
(** The type for interpreted values. *)

val eq_domain : ('a -> 'a -> bool) -> 'a domain -> 'a domain -> bool
(** [eq_domain] is the equality function between {!domain}s. *)

val pp_domain : 'a Fmt.t -> 'a domain Fmt.t
(** [pp_domain] is the pretty-printer for {!domain}s. *)

val dry_run : ?env:env -> 'a t -> 'a domain
(** Emulate the action. This will not do IO on the actual files. Some
    approximation is done to determine the result of actions. [files] is a list
    of paths that are supposed to exist at the beginning. Returns:

- the result of the action (which can be an [Bos] error)
    - the list of files after execution
    - a trace (list of log messages) *)

val dry_run_trace : ?env:env -> 'a t -> unit
(** Only output the trace part of [dry_run]. *)

val generated_files : ?env:env -> 'a t -> Fpath.Set.t
(** [generated_files t] is the set of files created by [t]. Note: this might be
    incomplete/incorrect in case of calls to external commands. *)
07070100000012000081A40000000000000000000000016491641000000421000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/argv.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type t = ARGV

let argv = Type.v ARGV

let sys_argv =
  let connect _ _ _ = "return Sys.argv" in
  Impl.v ~connect "Sys" argv
07070100000013000081A400000000000000000000000164916410000004E8000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/argv.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Device representing the command line. *)

type t
(** The type for command-line arguments, similar to the usual [Sys.argv]. *)

val argv : t Type.t
(** [argv] is a value representing {!argv} module types. *)

val sys_argv : t Impl.t
(** [sys_argv] is a device providing command-line arguments by using
    {!Sys.argv}. *)
07070100000014000081A4000000000000000000000001649164100000491B000000000000000000000000000000000000002200000000mirage-4.4.0/lib/functoria/cli.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let setup_log style_renderer level =
  Fmt_tty.setup_std_outputs ?style_renderer ();
  Logs.set_level level;
  Logs.set_reporter (Logs_fmt.reporter ())

open Cmdliner

let common_section = "COMMON OPTIONS"
let configuration_section = "CONFIGURE OPTIONS"
let query_section = "QUERY OPTIONS"
let description_section = "DESCRIBE OPTIONS"

let query_kinds : (string * query_kind) list =
  [
    ("name", `Name);
    ("packages", `Packages);
    ("opam", `Opam);
    ("files", `Files);
    ("Makefile", `Makefile);
    ("dune.config", `Dune `Config);
    ("dune.build", `Dune `Build);
    ("dune-project", `Dune `Project);
    ("dune-workspace", `Dune `Workspace);
    ("dune.dist", `Dune `Dist);
  ]

let setup ~with_setup =
  Term.(
    const (if with_setup then setup_log else fun _ _ -> ())
    $ Fmt_cli.style_renderer ~docs:common_section ()
    $ Logs_cli.level ~docs:common_section ())

let config_file =
  let doc =
    Arg.info ~docs:configuration_section ~docv:"FILE"
      ~doc:"The configuration file to use."
      [ "f"; "file"; "config-file" ]
  in
  Term.(const Fpath.v $ Arg.(value & opt string "config.ml" & doc))

let map_default ~default f x = if x == default then None else Some (f x)

let context_file mname =
  let doc =
    Arg.info ~docs:configuration_section ~docv:"FILE"
      ~doc:"The context file to use." [ "context-file" ]
  in
  let default = mname ^ ".context" in
  Term.(
    const (map_default ~default Fpath.v)
    $ Arg.(value & opt string default & doc))

let extra_repos doc_section =
  let key =
    let parser str =
      match Astring.String.cut ~sep:":" str with
      | Some (name, repository) -> Ok (name, repository)
      | None ->
          Rresult.R.error_msgf
            "Invalid extra repository argument (expected <name>:<repository>)"
    in
    let pp ppf (name, repository) = Fmt.pf ppf "%s:%s" name repository in
    Arg.conv (parser, pp)
  in
  let env = Cmd.Env.info "MIRAGE_EXTRA_REPOS" in
  let doc =
    Arg.info ~docs:doc_section ~docv:"NAME1:URL1,NAME2:URL2,..." ~env
      ~doc:
        "Additional opam-repositories to use when using `opam monorepo lock' \
         to gather local sources. Default: \
         https://github.com/dune-universe/opam-overlays.git & \
         https://github.com/dune-universe/mirage-opam-overlays.git."
      [ "extra-repos" ]
  in
  Arg.(
    value
    & opt (list key)
        [
          ("opam-overlays", "https://github.com/dune-universe/opam-overlays.git");
          ( "mirage-overlays",
            "https://github.com/dune-universe/mirage-opam-overlays.git" );
        ]
    & doc)

let no_extra_repo doc_section =
  let doc =
    Arg.info ~docs:doc_section ~doc:"Disable the use of any overlay repository."
      [ "no-extra-repo" ]
  in
  Arg.(value & flag & doc)

let extra_repos doc_section =
  let ex = extra_repos doc_section in
  let no_ex = no_extra_repo doc_section in
  Term.(const (fun ex no_ex -> if no_ex then [] else ex) $ ex $ no_ex)

let dry_run =
  let doc =
    Arg.info ~docs:configuration_section
      ~doc:"Display I/O actions instead of executing them." [ "dry-run" ]
  in
  Arg.(value & flag doc)

(** * Argument specifications *)

(** Argument specification for --depext *)
let depext section =
  let depext_doc =
    Arg.info ~docs:section [ "depext" ]
      ~doc:"Enable call to `opam depext' in the project Makefile."
  in
  let no_depext_doc =
    Arg.info ~docs:section [ "no-depext" ]
      ~doc:"Disable call to `opam depext' in the project Makefile."
  in
  let eval_opts = [ (true, depext_doc); (false, no_depext_doc) ] in
  Arg.(value & vflag true eval_opts)

(** Argument specification for --eval *)
let full_eval =
  let eval_doc =
    Arg.info ~docs:description_section [ "eval" ]
      ~doc:
        "Fully evaluate the graph before showing it. The default when the \
         unikernel has already been configured."
  in
  let no_eval_doc =
    Arg.info ~docs:description_section [ "no-eval" ]
      ~doc:
        "Do not evaluate the graph before showing it. See $(b,--eval). The \
         default when the unikernel has not been configured."
  in
  let eval_opts = [ (Some true, eval_doc); (Some false, no_eval_doc) ] in
  Arg.(value & vflag None eval_opts)

(** Argument specification for --dot *)
let dot =
  let doc =
    Arg.info ~docs:description_section [ "dot" ]
      ~doc:
        "Output a dot description. If no output file is given, it will display \
         the dot file using the  command  given to $(b,--dot-command)."
  in
  Arg.(value & flag doc)

(** Argument specification for --dot-command=COMMAND *)
let dotcmd =
  let doc =
    Arg.info ~docs:description_section ~docv:"COMMAND" [ "dot-command" ]
      ~doc:
        "Command used to show a dot file. This command should accept a dot \
         file on its standard input."
  in
  Arg.(value & opt string "xdot" & doc)

(** Argument specification for -o FILE or --output=FILE *)
let output =
  let doc =
    Arg.info ~docs:configuration_section ~docv:"FILE" [ "o"; "output" ]
      ~doc:"Name of the output file."
  in
  Arg.(value & opt (some string) None & doc)

let kind =
  let enums = Arg.doc_alts_enum ~quoted:true query_kinds in
  let doc =
    Arg.info ~docs:configuration_section ~docv:"INFO" []
      ~doc:(Fmt.str "The information to query. $(docv) must be %s" enums)
  in
  Arg.(value & pos 0 (enum query_kinds) `Packages & doc)

type 'a args = {
  context : 'a;
  config_file : Fpath.t;
  context_file : Fpath.t option;
  output : string option;
  dry_run : bool;
}

let default_args =
  {
    context = ();
    config_file = Fpath.v "dummy";
    context_file = None;
    output = None;
    dry_run = false;
  }

type 'a configure_args = {
  args : 'a args;
  depext : bool;
  extra_repo : (string * string) list;
}

type 'a build_args = 'a args
type 'a clean_args = 'a args
type 'a help_args = 'a args

type 'a describe_args = {
  args : 'a args;
  dotcmd : string;
  dot : bool;
  eval : bool option;
}

type 'a query_args = {
  args : 'a args;
  kind : query_kind;
  depext : bool;
  extra_repo : (string * string) list;
}

(*
 * Pretty-printing
 *)

let pp_args pp_a =
  let open Fmt.Dump in
  record
    [
      field "context" (fun (t : 'a args) -> t.context) pp_a;
      field "config_file" (fun t -> t.config_file) Fpath.pp;
      field "output" (fun t -> t.output) (option string);
      field "dry_run" (fun t -> t.dry_run) Fmt.bool;
    ]

let pp_configure pp_a =
  let open Fmt.Dump in
  record
    [
      field "args" (fun (t : 'a configure_args) -> t.args) (pp_args pp_a);
      field "depext" (fun (t : 'a configure_args) -> t.depext) Fmt.bool;
    ]

let pp_build = pp_args
let pp_clean = pp_args
let pp_help = pp_args

let pp_query_kind ppf (q : query_kind) =
  let rec aux = function
    | [] -> invalid_arg "missing query kind!"
    | (a, b) :: t -> if b = q then Fmt.string ppf a else aux t
  in
  aux query_kinds

let pp_query pp_a =
  let open Fmt.Dump in
  record
    [
      field "args" (fun (t : 'a query_args) -> t.args) (pp_args pp_a);
      field "kind" (fun t -> t.kind) pp_query_kind;
      field "depext" (fun t -> t.depext) Fmt.bool;
    ]

let pp_describe pp_a =
  let open Fmt.Dump in
  record
    [
      field "args" (fun (t : 'a describe_args) -> t.args) (pp_args pp_a);
      field "dotcmd" (fun t -> t.dotcmd) string;
      field "dot" (fun t -> t.dot) Fmt.bool;
      field "eval" (fun t -> t.eval) (option Fmt.bool);
    ]

let pp_action pp_a ppf = function
  | Configure c -> Fmt.pf ppf "@[configure:@ @[<2>%a@]@]" (pp_configure pp_a) c
  | Query q -> Fmt.pf ppf "@[query:@ @[<2>%a@]@]" (pp_query pp_a) q
  | Describe d -> Fmt.pf ppf "@[describe:@ @[<2>%a@]@]" (pp_describe pp_a) d
  | Build b -> Fmt.pf ppf "@[build:@ @[<2>%a@]@]" (pp_build pp_a) b
  | Clean c -> Fmt.pf ppf "@[clean:@ @[<2>%a@]@]" (pp_clean pp_a) c
  | Help h -> Fmt.pf ppf "@[help:@ @[<2>%a@]@]" (pp_help pp_a) h

(*
 * Subcommand specifications
 *)

module Subcommands = struct
  type 'a t = { with_setup : bool; mname : string; context : 'a Term.t }

module T = struct
    let args { with_setup; context; mname } =
      Term.(
        const (fun () config_file context_file dry_run output context ->
            { config_file; context_file; dry_run; output; context })
        $ setup ~with_setup
        $ config_file
        $ context_file mname
        $ dry_run
        $ output
        $ context)
  end

(** The 'configure' subcommand *)
  let configure t =
    ( Term.(
        const (fun args depext extra_repo ->
            Configure { args; depext; extra_repo })
        $ T.args t
        $ depext configuration_section
        $ extra_repos configuration_section),
      Cmd.info "configure" ~doc:"Configure a $(mname) application."
        ~man:
          [
            `S "DESCRIPTION";
            `P
              "The $(b,configure) command initializes a fresh $(mname) \
               application.";
          ] )

let query t =
    ( Term.(
        const (fun kind args depext extra_repo ->
            Query { kind; args; depext; extra_repo })
        $ kind
        $ T.args t
        $ depext query_section
        $ extra_repos query_section),
      Cmd.info "query" ~doc:"Query information about the $(mname) application."
        ~man:
          [
            `S "DESCRIPTION";
            `P
              "The $(b,query) command queries information about the $(mname) \
               application.";
          ] )

(** The 'describe' subcommand *)
  let describe t =
    ( Term.(
        const (fun args eval dotcmd dot -> Describe { args; eval; dotcmd; dot })
        $ T.args t
        $ full_eval
        $ dotcmd
        $ dot),
      Cmd.info "describe" ~doc:"Describe a $(mname) application."
        ~man:
          [
            `S "DESCRIPTION";
            `P
              "The $(b,describe) command describes the configuration of a \
               $(mname) application.";
            `P "The dot output contains the following elements:";
            `Noblank;
            `I
              ( "If vertices",
                "Represented as circles. Branches are dotted, and the default \
                 branch is in bold." );
            `Noblank;
            `I
              ( "Configurables",
                "Represented as rectangles. The order of the output arrows is \
                 the order of the functor arguments." );
            `Noblank;
            `I ("Data dependencies", "Represented as dashed arrows.");
            `Noblank;
            `I
              ( "App vertices",
                "Represented as diamonds. The bold arrow is the functor part."
              );
          ] )

(** The 'build' subcommand *)
  let build t =
    let doc = "Build a $(mname) application." in
    ( Term.(const (fun args -> Build args) $ T.args t),
      Cmd.info "build" ~doc ~man:[ `S "DESCRIPTION"; `P doc ] )

(** The 'clean' subcommand *)
  let clean t =
    let doc = "Clean the files produced by $(mname) for a given application." in
    ( Term.(const (fun args -> Clean args) $ T.args t),
      Cmd.info "clean" ~doc ~man:[ `S "DESCRIPTION"; `P doc ] )

(** The 'help' subcommand *)
  let help t =
    let topic =
      let doc = Arg.info [] ~docv:"TOPIC" ~doc:"The topic to get help on." in
      Arg.(value & pos 0 (some string) None & doc)
    in
    let help man_format cmds topic =
      match topic with
      | None -> `Help (man_format, None)
      | Some topic -> (
          let parser, _ =
            Arg.enum (List.rev_map (fun s -> (s, s)) ("topics" :: cmds))
          in
          match parser topic with
          | `Error e -> `Error (false, e)
          | `Ok t when t = "topics" ->
              List.iter print_endline cmds;
              `Ok ()
          | `Ok t -> `Help (man_format, Some t))
    in
    ( Term.(
        const (fun args _ _ _ () -> Help args)
        $ T.args t
        $ depext configuration_section
        $ extra_repos configuration_section
        $ full_eval
        $ ret (const help $ Arg.man_format $ Term.choice_names $ topic)),
      Cmd.info "help" ~doc:"Display help about $(mname) commands."
        ~man:
          [
            `S "DESCRIPTION";
            `P "Prints help.";
            `P "Use `$(mname) help topics' to get the full list of help topics.";
          ] )

let default ~with_setup ~name ~version =
    let usage = `Help (`Plain, None) in
    ( Term.(ret (const usage) $ setup ~with_setup),
      Cmd.info name ~version ~doc:"The $(mname) application builder"
        ~man:
          [
            `S "DESCRIPTION";
            `P
              "The $(mname) application builder. It glues together a set of \
               libraries and configuration (e.g. network and storage) into a \
               standalone unikernel or UNIX binary.";
            `P
              "Use $(mname) $(b,help <command>) for more information on a \
               specific command.";
          ] )
end

(*
 * Functions for extracting particular flags from the command line.
 *)

let peek_full_eval argv =
  match Cmd.eval_peek_opts ~argv full_eval with _, Ok (`Ok b) -> b | _ -> None

let peek_output argv =
  match Cmd.eval_peek_opts ~argv output with _, Ok (`Ok b) -> b | _ -> None

let peek_args ?(with_setup = false) ~mname argv =
  let args =
    Subcommands.T.args { with_setup; mname; context = Term.const () }
  in
  match Cmd.eval_peek_opts ~argv args with
  | _, Ok (`Ok b) | Some b, _ -> Some b
  | _ -> None

let eval ?(with_setup = true) ?help_ppf ?err_ppf ~name ~version ~configure
    ~query ~describe ~build ~clean ~help ~mname argv =
  let default, info = Subcommands.default ~with_setup ~name ~version in
  let args context = { Subcommands.with_setup; mname; context } in
  let group =
    Cmd.group ~default info
      (List.map
         (fun (term, info) -> Cmd.v info term)
         [
           Subcommands.configure (args configure);
           Subcommands.describe (args describe);
           Subcommands.query (args query);
           Subcommands.build (args build);
           Subcommands.clean (args clean);
           Subcommands.help (args help);
         ])
  in
  match Cmd.eval_value ?help:help_ppf ?err:err_ppf ~argv ~catch:false group with
  | Ok (#Cmd.eval_ok as v) -> v
  | Error (#Cmd.eval_error as e) -> `Error e

let args = function
  | Configure { args; _ } -> args
  | Build x | Clean x | Help x -> x
  | Query { args; _ } -> args
  | Describe { args; _ } -> args

let choices =
  [
    ("configure", `Configure);
    ("build", `Build);
    ("clean", `Clean);
    ("query", `Query);
    ("describe", `Describe);
    ("help", `Help);
  ]

let find_choices s =
  List.find_all (fun (k, _) -> Astring.String.is_prefix ~affix:s k) choices

let find_kind s =
  List.find_all (fun (k, _) -> Astring.String.is_prefix ~affix:s k) query_kinds

let next_pos_arg argv i =
  let rec aux i =
    if i >= Array.length argv then None
    else if argv.(i) = "" then aux (i + 1)
    else if argv.(i).[0] = '-' then aux (i + 1)
    else Some i
  in
  aux i

let remove_argv argv i =
  let a = Array.sub argv 0 i in
  let b = Array.sub argv (i + 1) (Array.length argv - i - 1) in
  Array.append a b

let rec find_next_kind argv i =
  match next_pos_arg argv i with
  | None -> (None, argv)
  | Some i -> (
      match find_kind argv.(i) with
      | [] -> find_next_kind argv (i + 1)
      | _ :: _ :: _ as cs ->
          Fmt.invalid_arg "ambiguous sub-command: %a\n%!"
            Fmt.Dump.(list string)
            (List.map fst cs)
      | [ (_, k) ] -> (Some k, remove_argv argv i))

let rec find_next_choice argv i =
  match next_pos_arg argv i with
  | None -> (None, argv)
  | Some i -> (
      match find_choices argv.(i) with
      | [] -> find_next_choice argv (i + 1)
      | _ :: _ :: _ as cs ->
          Fmt.invalid_arg "ambiguous sub-command: %a\n%!"
            Fmt.Dump.(list string)
            (List.map fst cs)
      | [ (_, a) ] -> (
          match a with
          | (`Configure | `Build | `Clean | `Describe | `Help) as c ->
              (Some c, remove_argv argv i)
          | `Query ->
              let k, argv = find_next_kind argv (i + 1) in
              (Some (`Query k), remove_argv argv i)))

let peek_choice argv =
  try match find_next_choice argv 1 with Some c, _ -> `Ok c | _ -> `Default
  with Invalid_argument _ -> `Error `Parse

type 'a result =
  [ `Ok of 'a action
  | `Error of 'a args option * [ `Exn | `Parse | `Term ]
  | `Version ]

let peek ?(with_setup = false) ~mname argv : unit result =
  let niet = Term.const () in
  let peek t =
    match Cmd.eval_peek_opts ~argv ~version_opt:true (fst t) with
    | _, Ok `Version -> `Version
    | _, Error e -> `Error (peek_args ~mname argv, e)
    | _, Ok `Help -> (
        let args = peek_args ~with_setup:false ~mname argv in
        match args with
        | Some args -> `Ok (Help args)
        | _ -> `Error (None, `Parse))
    | Some v, _ | _, Ok (`Ok v) -> `Ok v
  in
  let peek_cmd f =
    let args = { Subcommands.with_setup; mname; context = niet } in
    peek (f args)
  in
  match peek_choice argv with
  | `Ok `Configure -> peek_cmd Subcommands.configure
  | `Ok `Build -> peek_cmd Subcommands.build
  | `Ok `Clean -> peek_cmd Subcommands.clean
  | `Ok (`Query _) -> peek_cmd Subcommands.query
  | `Ok `Describe -> peek_cmd Subcommands.describe
  | `Ok `Help -> peek_cmd Subcommands.help
  | `Default ->
      peek (Subcommands.default ~with_setup ~name:"<name>" ~version:"<version>")
  | `Error e -> `Error (peek_args ~mname argv, e)
07070100000015000081A40000000000000000000000016491641000001203000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/cli.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Command-line handling. *)

open Cmdliner

type 'a args = {
  context : 'a;
  config_file : Fpath.t;
  context_file : Fpath.t option;
  output : string option;
  dry_run : bool;
}
(** The type for global arguments. *)

val default_args : unit args

val peek_args :
  ?with_setup:bool -> mname:string -> string array -> unit args option
(** [peek_args ?with_setup argv] parses the global command-line arguments. If
    [with_setup] is set (by default it is), interprets [-v] and [--color] to
    set-up the terminal configuration as a side-effect. Returns None if global
    command-line arguments are invalid. *)

val peek_output : string array -> string option
(** [peek_full_eval argv] reads the [--output] option from [argv]; the return
    value is [None] if option is absent in [argv]. *)

val pp_args : 'a Fmt.t -> 'a args Fmt.t
(** [pp_args] is the pretty-printer for args. *)

(** {1 Sub-commands} *)

type 'a configure_args = {
  args : 'a args;
  depext : bool;
  extra_repo : (string * string) list;
}
(** The type for arguments of the [configure] sub-command. *)

type 'a build_args = 'a args
(** The type for arguments of the [build] sub-command. *)

type 'a clean_args = 'a args
(** The type for arguments of the [clean] sub-command. *)

type 'a help_args = 'a args
(** The type for arguments of the [help] sub-command. *)

val pp_query_kind : query_kind Fmt.t
(** [pp_query_kind] is the pretty-printer for query kinds. *)

type 'a query_args = {
  args : 'a args;
  kind : query_kind;
  depext : bool;
  extra_repo : (string * string) list;
}
(** The type for arguments of the [query] sub-command. *)

type 'a describe_args = {
  args : 'a args;
  dotcmd : string;
  dot : bool;
  eval : bool option;
}
(** The type for arguments of the [describe] sub-command. *)

val peek_full_eval : string array -> bool option
(** [peek_full_eval argv] reads the [--eval] option from [argv]; the return
    value is [None] if option is absent in [argv]. *)

val pp_action : 'a Fmt.t -> 'a action Fmt.t
(** [pp_action] is the pretty-printer for actions. *)

val args : 'a action -> 'a args
(** [args a] are [a]'s global arguments. *)

(** {1 Evalutation} *)

val eval :
  ?with_setup:bool ->
  ?help_ppf:Format.formatter ->
  ?err_ppf:Format.formatter ->
  name:string ->
  version:string ->
  configure:'a Term.t ->
  query:'a Term.t ->
  describe:'a Term.t ->
  build:'a Term.t ->
  clean:'a Term.t ->
  help:'a Term.t ->
  mname:string ->
  string array ->
  'a action Term.result
(** Parse the functoria command line. The arguments to [~configure],
    [~describe], etc., describe extra command-line arguments that should be
    accepted by the corresponding subcommands.

There are no side effects, save for the printing of usage messages and other
    help when either the 'help' subcommand or no subcommand is specified. *)

type 'a result =
  [ `Ok of 'a action
  | `Error of 'a args option * [ `Exn | `Parse | `Term ]
  | `Version ]
(** Similar to [Cmdliner.Term.result] but help is folded into [`Ok] and errors
    also carry global command-line parameters. *)

val peek : ?with_setup:bool -> mname:string -> string array -> unit result
(** [peek] is the same as {!val:eval} but without failing on unknown arguments. *)
07070100000016000081A400000000000000000000000164916410000006EB000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/context.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type 'a key = { name : string; put : 'a -> exn; get : exn -> 'a }

let new_key (type a) name =
  let module M = struct
    exception E of a
  end in
  let put a = M.E a in
  let get = function
    | M.E a -> a
    | _ -> raise @@ Invalid_argument ("duplicate key: " ^ name)
  in
  { name; put; get }

module Map = Map.Make (String)

type t = exn Map.t

let empty = Map.empty
let add k v (t : t) : t = Map.add k.name (k.put v) t
let mem k (t : t) = Map.mem k.name t

let find k (t : t) =
  if Map.mem k.name t then Some (k.get @@ Map.find k.name t) else None

let dump : t Fmt.t =
  let pp_elt ppf (k, v) = Fmt.pf ppf "[%s: %a]" k Fmt.exn v in
  let map_iter f = Map.iter (fun k v -> f (k, v)) in
  Fmt.box ~indent:2 @@ Fmt.(iter ~sep:(any "@ ")) map_iter pp_elt

let merge ~default m =
  let aux _ _ v = Some v in
  Map.union aux default m
07070100000017000081A400000000000000000000000164916410000006E8000000000000000000000000000000000000002700000000mirage-4.4.0/lib/functoria/context.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Universal map of keys *)

type 'a key
(** The type for keys. *)

val new_key : string -> 'a key
(** [new_key n] is a new key with name [k]. *)

type t
(** The type for context maps. *)

val empty : t
(** [empty] is the empty context. *)

val add : 'a key -> 'a -> t -> t
(** [add k v t] is [t] augmented with the binding [(k, v)]. Any previous binding
    of [k] is removed. *)

val mem : 'a key -> t -> bool
(** [mem k t] is true iff [k] has been added to [t]. *)

val find : 'a key -> t -> 'a option
(** [find k t] is [v] is the binding [(k, v)] has been added to [t], otherwise
    it is [None]. *)

val merge : default:t -> t -> t
(** [merge ~default t] merges [t] on top of [default]. If a key appears in both
    [default] and [t], the value present in [t] is kept. *)

val dump : t Fmt.t
(** [dump] dumps the state of [t]. *)
07070100000018000081A40000000000000000000000016491641000000AB5000000000000000000000000000000000000002C00000000mirage-4.4.0/lib/functoria/context_cache.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring
open Action.Syntax

let src = Logs.Src.create "functoria.cache" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)

type t = string array

let empty = [| "" |]
let is_empty t = t = empty

let write file argv =
  Log.info (fun m ->
      m "Preserving arguments in %a:@ %a" Fpath.pp file
        Fmt.Dump.(array string)
        argv);
  (* Only keep args *)
  let args = List.tl (Array.to_list argv) in
  let args = List.map String.Ascii.escape args in
  let args = String.concat ~sep:"\n" args ^ "\n" in
  Action.write_file file args

let read file =
  Log.info (fun l -> l "reading cache %a" Fpath.pp file);
  let* is_file = Action.is_file file in
  if not is_file then Action.ok empty
  else
    let* args = Action.read_file file in
    let args = String.cuts ~sep:"\n" args in
    (* remove trailing '\n' *)
    let args = List.rev (List.tl (List.rev args)) in
    (* Add an empty command *)
    let args = "" :: args in
    let args = Array.of_list args in
    try
      let args =
        Array.map
          (fun x ->
            match String.Ascii.unescape x with
            | Some s -> s
            | None -> Fmt.failwith "%S: cannot parse" x)
          args
      in
      Action.ok args
    with Failure e -> Action.error e

let peek t term =
  match Cmdliner.Cmd.eval_peek_opts ~argv:t term with
  | Some c, _ | _, Ok (`Ok c) -> Some c
  | _ -> None

let merge t term =
  let cache =
    match peek t term with None -> Key.empty_context | Some c -> c
  in
  let f term = Key.merge_context ~default:cache term in
  Cmdliner.Term.(const f $ term)

let peek_output t = Cli.peek_output t

let file ~name args =
  let build_dir = Fpath.parent args.Cli.config_file in
  match args.Cli.context_file with
  | Some f -> f
  | None -> Fpath.(build_dir / name / "context")
07070100000019000081A40000000000000000000000016491641000000838000000000000000000000000000000000000002D00000000mirage-4.4.0/lib/functoria/context_cache.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Manage context caches, via the [--context-file <file>] command-line
    argument. *)

type t
(** The type for cache. *)

val file : name:string -> 'a Cli.args -> Fpath.t
(** [file ~name args] is the filename of the context cache for the tool [name]. *)

val empty : t
(** The empty cache. *)

val is_empty : t -> bool
(** [is_empty t] is empty iff [t] is {!empty}. *)

val write : Fpath.t -> string array -> unit Action.t
(** [write f argv] writes the context cache in the file [f]. *)

val read : Fpath.t -> t Action.t
(** [read f] reads the context cache stored in [f]. The result is
    [Action.ok empty] if [f] does not exists and [Action.error _] if the cache
    contains garbage. *)

val peek : t -> Key.context Cmdliner.Term.t -> Key.context option
(** [peek t term] is the context obtained by evaluating [term] over the cached
    context [t]. *)

val merge : t -> Key.context Cmdliner.Term.t -> Key.context Cmdliner.Term.t
(** [eval_context t term] is the context obtained by evaluating [term] over the
    cached context [t]. *)

val peek_output : t -> string option
(** [peek_output t] is the evaluation of {!Cli.output} over the cached context
    [t]. *)
0707010000001A000081A400000000000000000000000164916410000015FE000000000000000000000000000000000000002500000000mirage-4.4.0/lib/functoria/device.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Action.Syntax
open Astring

type abstract_key = Key.t
type package = Package.t
type info = Info.t
type 'a value = 'a Key.value
type 'a code = string

type ('a, 'impl) t = {
  id : 'a Typeid.t;
  module_name : string;
  module_type : 'a Type.t;
  keys : abstract_key list;
  packages : package list value;
  install : info -> Install.t value;
  connect : info -> string -> string list -> 'a code;
  dune : info -> Dune.stanza list;
  configure : info -> unit Action.t;
  files : (info -> Fpath.t list) option;
  extra_deps : 'impl list;
}

let pp : type a b. b Fmt.t -> (a, b) t Fmt.t =
 fun pp_impl ppf t ->
  let open Fmt.Dump in
  let fields =
    [
      field "id" (fun t -> t.id) Typeid.pp;
      field "module_name" (fun t -> t.module_name) string;
      field "module_type" (fun t -> t.module_type) Type.pp;
      field "keys" (fun t -> t.keys) (list Key.pp);
      field "install" (fun _ -> "<dyn>") Fmt.string;
      field "packages" (fun _ -> "<dyn>") Fmt.string;
      field "extra_deps" (fun t -> t.extra_deps) (list pp_impl);
    ]
  in
  record fields ppf t

let equal x y = Typeid.equal x.id y.id
let witness x y = Typeid.witness x.id y.id
let hash x = Typeid.id x.id

let default_connect _ _ l =
  Printf.sprintf "return (%s)" (String.concat ~sep:", " l)

let niet _ = Action.ok ()
let nil _ = []

let merge empty union a b =
  match (a, b) with
  | None, None -> Key.pure empty
  | Some a, None -> Key.pure a
  | None, Some b -> b
  | Some a, Some b -> Key.(pure union $ pure a $ b)

let merge_packages = merge [] List.append
let merge_install = merge Install.empty Install.union

let v ?packages ?packages_v ?install ?install_v ?(keys = []) ?(extra_deps = [])
    ?(connect = default_connect) ?(dune = nil) ?(configure = niet) ?files
    module_name module_type =
  let id = Typeid.gen () in
  let packages = merge_packages packages packages_v in
  let install i =
    let aux = function None -> None | Some f -> Some (f i) in
    merge_install (aux install) (aux install_v)
  in
  {
    module_type;
    id;
    module_name;
    keys;
    connect;
    packages;
    install;
    dune;
    configure;
    files;
    extra_deps;
  }

let id t = Typeid.id t.id
let module_name t = t.module_name
let module_type t = t.module_type
let packages t = t.packages
let install t = t.install
let connect t = t.connect
let configure t = t.configure

let files t i =
  let gen = Action.generated_files (t.configure i) in
  match t.files with
  | None -> gen
  | Some files -> Fpath.Set.(union gen (of_list (files i)))

let dune t = t.dune
let keys t = t.keys
let extra_deps t = t.extra_deps

let start impl_name args =
  Fmt.str "@[%s.start@ %a@]" impl_name Fmt.(list ~sep:sp string) args

let uniq t = Fpath.Set.(elements (of_list t))
let exec_hook i = function None -> Action.ok () | Some h -> h i

let extend ?packages ?packages_v ?dune ?pre_configure ?post_configure ?files t =
  let files =
    match (files, t.files) with
    | None, None -> None
    | Some f, None | None, Some f -> Some f
    | Some x, Some y -> Some (fun i -> uniq (x i @ y i))
  in
  let packages =
    Key.(pure List.append $ merge_packages packages packages_v $ t.packages)
  in
  let exec pre f post i =
    let* () = exec_hook i pre in
    let* () = f i in
    exec_hook i post
  in
  let configure = exec pre_configure t.configure post_configure in
  let dune =
    Option.map (fun dune i -> t.dune i @ dune i) dune
    |> Option.value ~default:t.dune
  in
  { t with packages; files; configure; dune }

let nice_name d =
  module_name d
  |> String.cuts ~sep:"."
  |> String.concat ~sep:"_"
  |> String.Ascii.lowercase
  |> Misc.Name.ocamlify

type ('a, 'i) device = ('a, 'i) t

module Graph = struct
  type t =
    | D : { dev : ('a, _) device; args : t list; deps : t list; id : int } -> t

type dtree = t

module IdTbl = Hashtbl.Make (struct
    type t = dtree

let hash (D t) = t.id
    let equal (D t1) (D t2) = Int.equal t1.id t2.id
  end)

(* We iter in *reversed* topological order. *)
  let fold f t z =
    let tbl = IdTbl.create 50 in
    let state = ref z in
    let rec aux v =
      if IdTbl.mem tbl v then ()
      else
        let (D { args; deps; _ }) = v in
        IdTbl.add tbl v ();
        List.iter aux deps;
        List.iter aux args;
        state := f v !state
    in
    aux t;
    !state

let impl_name (D { dev; args = _; deps = _; id }) =
    match Type.is_functor (module_type dev) with
    | false -> module_name dev
    | true ->
        let prefix = Astring.String.Ascii.capitalize (nice_name dev) in
        Fmt.str "%s__%d" prefix id

let var_name (D { dev; args = _; deps = _; id }) =
    let prefix = nice_name dev in
    Fmt.str "%s__%i" prefix id
end
0707010000001B000081A40000000000000000000000016491641000001579000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/device.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Signature for functoria devices. A [device] is a module implementation which
    contains a runtime state which can be set either at configuration time (by
    the application builder) or at runtime, using command-line arguments. *)

type ('a, 'b) t
(** The type for devices whose runtime state is of type ['a] and having extra
    data-dependencies of type ['b]. *)

val module_type : ('a, 'b) t -> 'a Type.t
(** [module_type t] is [t]'s module type. *)

val module_name : ('a, 'b) t -> string
(** [module_name t] is [t]'s module name. *)

val packages : ('a, 'b) t -> Package.t list Key.value
(** [packages t] is the list of OPAM packages that are needed by [t].*)

val install : ('a, 'b) t -> Info.t -> Install.t Key.value
(** [install t i] is the list of files installed by [t], using the build
    information [i]. *)

val extra_deps : ('a, 'b) t -> 'b list
(** [extra_deps t] is the list of dependencies that be initialized before
    running the code generated by [connect t]. *)

val id : ('a, 'b) t -> int
(** [id t] is [t]'s unique identifier. Freshly generated for each call to {!v}. *)

val pp : 'b Fmt.t -> ('a, 'b) t Fmt.t
(** [pp pp_dep] is the pretty-printer for devices, using [pp_dep] to
    pretty-print the extra data-dependencies. *)

val equal : ('a, 'b) t -> ('c, 'd) t -> bool
(** [equal] is the equality function for devices. *)

val witness : ('a, _) t -> ('b, _) t -> ('a, 'b) Typeid.witness
(** [witness a b] provides an equality witness. *)

val hash : ('a, 'b) t -> int
(** [hash t] is [t]'s hash. *)

(** {1 Resources} *)

val files : ('a, 'b) t -> Info.t -> Fpath.Set.t
(** [files t info s] is the list of files generated configure-time. *)

val keys : ('a, 'b) t -> Key.t list
(** [keys t] is the list of command-line keys which can be used to configure
    [t]. *)

(** {1 Code Generation} *)

type 'a code = string
(** The type for fragments of code of type ['a]. *)

val connect : ('a, 'b) t -> Info.t -> string -> string list -> 'a code
(** [connect t info impl_name args] is the code to execute in order to create a
    new state (usually calling [<module_name t>.connect]) with the arguments
    [args], in the context of the project information [info]. The freshly
    created state will be made available in [var_name t] *)

val start : string -> string list -> 'a code
(** [start impl_name args] is the code [<impl_name>.start <args>]. *)

val nice_name : _ t -> string
(** [nice_name d] provides a identifier unique to [d] which is a valid OCaml
    identifier. *)

(** {1 Actions} *)
val dune : ('a, 'b) t -> Info.t -> Dune.stanza list
(** [dune t info] are the dune stanza which needs to be generated to build the
    application. *)

(** {1 Configuration} *)

val configure : ('a, 'b) t -> Info.t -> unit Action.t
(** [configure t info] is configure hook for [t] the device and the files it
    generates. During the configure phase, you cannot rely on [packages t] being
    installed.

To run code during the [build] phase, generate a [dune] fragment instead. *)

(** {1 Constructors} *)

val v :
  ?packages:Package.t list ->
  ?packages_v:Package.t list Key.value ->
  ?install:(Info.t -> Install.t) ->
  ?install_v:(Info.t -> Install.t Key.value) ->
  ?keys:Key.t list ->
  ?extra_deps:'b list ->
  ?connect:(Info.t -> string -> string list -> 'a code) ->
  ?dune:(Info.t -> Dune.stanza list) ->
  ?configure:(Info.t -> unit Action.t) ->
  ?files:(Info.t -> Fpath.t list) ->
  string ->
  'a Type.t ->
  ('a, 'b) t

val extend :
  ?packages:Package.t list ->
  ?packages_v:Package.t list Key.value ->
  ?dune:(Info.t -> Dune.stanza list) ->
  ?pre_configure:(Info.t -> unit Action.t) ->
  ?post_configure:(Info.t -> unit Action.t) ->
  ?files:(Info.t -> Fpath.t list) ->
  ('a, 'b) t ->
  ('a, 'b) t

(** {1 Device graphs} *)

module Graph : sig
  type ('a, 'i) device

(** A graph of devices, annotated with their arguments, dependencies, and a
      unique identifier.

Warning: this is truly a DAG: sharing {b must} be preserved. Manual walks
      are discouraged, please use {!fold} instead. *)
  type t =
    | D : { dev : (_, _) device; args : t list; deps : t list; id : int } -> t

val fold : (t -> 'a -> 'a) -> t -> 'a -> 'a
  (** [fold f g z] applies [f] on each device in topological order. *)

val var_name : t -> string
  (** [var_name t] returns the name identifying [t] which is a valid OCaml
      variable identifier. *)

val impl_name : t -> string
  (** [impl_name t] returns the name identifying [t]'s module implementation. *)
end
with type ('a, 'i) device := ('a, 'i) t
0707010000001C000081A400000000000000000000000164916410000000B4000000000000000000000000000000000000002000000000mirage-4.4.0/lib/functoria/dune(library
 (name functoria)
 (public_name functoria)
 (libraries
  uri
  emile
  unix
  cmdliner
  rresult
  fmt
  astring
  fpath
  bos
  fmt.cli
  logs.fmt
  fmt.tty
  logs.cli))
0707010000001D000081A40000000000000000000000016491641000000DF7000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/dune.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring

type stanza = string option
type t = string list

let stanza v = Some (String.trim v)
let stanzaf fmt = Fmt.kstr stanza fmt

let v x : t =
  List.fold_left
    (fun acc -> function None -> acc | Some f -> f :: acc)
    [] (List.rev x)

let pp_list pp = Fmt.(list ~sep:(any "\n\n") pp)
let pp ppf (t : t) = Fmt.pf ppf "%a" (pp_list Fmt.string) t
let to_string t = Fmt.to_to_string pp t ^ "\n"

let headers ~name ~version =
  let module M = Filegen.Make (struct
    let name = name
    let version = version
  end) in
  M.headers `Sexp

(* emulate the dune compact form for lists *)
let compact_list ?(indent = 2) field ppf l =
  let all = Buffer.create 1024 in
  let line = Buffer.create 70 in
  let sep = "\n" ^ String.v ~len:indent (fun _ -> ' ') in
  let first_char = ref true in
  let first_line = ref true in
  let flush () =
    Buffer.add_buffer all line;
    Buffer.clear line;
    Buffer.add_string line sep;
    first_line := false
  in
  List.iter
    (fun w ->
      let max = if !first_line then 75 - indent - String.length field else 75 in
      let wn = String.length w in
      if wn >= 40 || Buffer.length line + wn >= max then flush ();
      if not !first_char then Buffer.add_char line ' ';
      first_char := false;
      Buffer.add_string line w)
    l;
  flush ();
  Fmt.pf ppf "%s" (Buffer.contents all)

let config_rule ~config_ml_file ~packages ~name ~version =
  let headers = headers ~name ~version in
  let pkgs =
    match packages with
    | [] -> ""
    | pkgs ->
        let pkgs =
          List.fold_left
            (fun acc pkg ->
              let pkgs = String.Set.of_list (Package.libraries pkg) in
              String.Set.union pkgs acc)
            String.Set.empty pkgs
          |> String.Set.elements
        in
        String.concat ~sep:" " pkgs
  in
  let rename_config_file =
    let config_ml_file = Fpath.base config_ml_file in
    let ext = Fpath.get_ext config_ml_file in
    let name = Fpath.rem_ext config_ml_file |> Fpath.to_string in
    if name = "config" then ""
    else
      Fmt.str "(rule (copy %s config%s))" (Fpath.to_string config_ml_file) ext
  in
  let contents =
    Fmt.str
      {|%s

%s
(executable
 (name config)
 (modules config)
 (libraries %s))
|}
      headers rename_config_file pkgs
  in
  v [ stanza contents ]

let base ~packages ~name ~version ~config_ml_file =
  let dune_base = config_rule ~config_ml_file ~packages ~name ~version in
  let disable_duniverse = "(data_only_dirs duniverse)" in
  disable_duniverse :: dune_base

let base_project = [ stanza "(lang dune 2.7)" ]
let base_workspace = v [ stanza "(lang dune 2.0)\n(context default)" ]
0707010000001E000081A4000000000000000000000001649164100000060D000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/dune.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Dune files. *)

type stanza

val stanza : string -> stanza
val stanzaf : ('a, Format.formatter, unit, stanza) format4 -> 'a

type t

val v : stanza list -> t
val pp : t Fmt.t
val to_string : t -> string
val compact_list : ?indent:int -> string -> string list Fmt.t

val base :
  packages:Package.t list ->
  name:string ->
  version:string ->
  config_ml_file:Fpath.t ->
  t
(** [base] is a minimal [dune] file able to build [config.ml] *)

val base_project : stanza list
(** the minimal [dune-project] to compile [config.ml]. *)

val base_workspace : t
(** the minimal [dune-workspace] to compile [config.ml]. *)
0707010000001F000081A40000000000000000000000016491641000001502000000000000000000000000000000000000002500000000mirage-4.4.0/lib/functoria/engine.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring
open Action.Syntax

type t = Device.Graph.t

let if_keys x =
  Impl.collect
    (module Key.Set)
    (function If cond -> Key.deps cond | App | Dev _ -> Key.Set.empty)
    x

let all_keys x =
  Impl.collect
    (module Key.Set)
    (function
      | Dev c -> Key.Set.of_list (Device.keys c)
      | If cond -> Key.deps cond
      | App -> Key.Set.empty)
    x

module Packages = struct
  type t = Package.t String.Map.t Key.value

let union x y = Key.(pure (String.Map.union (fun _ -> Package.merge)) $ x $ y)
  let empty = Key.pure String.Map.empty
end

let packages t =
  let open Impl in
  let aux = function
    | Dev c ->
        let pkgs = Device.packages c in
        let aux x =
          String.Map.of_list (List.map (fun p -> (Package.name p, p)) x)
        in
        Key.(pure aux $ pkgs)
    | If _ | App -> Packages.empty
  in
  let return x = List.map snd (String.Map.bindings x) in
  Key.(pure return $ Impl.collect (module Packages) aux t)

module Installs = struct
  type t = Install.t Key.value

let union x y = Key.(pure Install.union $ x $ y)
  let empty = Key.pure Install.empty
end

let install i x =
  Impl.collect
    (module Installs)
    (function Dev c -> Device.install c i | If _ | App -> Installs.empty)
    x

let files info t =
  Impl.collect
    (module Fpath.Set)
    (function Dev c -> Device.files c info | If _ | App -> Fpath.Set.empty)
    t

module Dune = struct
  type t = Dune.stanza list

let union = ( @ )
  let empty = []
end

let dune info =
  Impl.collect (module Dune) @@ function
  | Dev c -> Device.dune c info
  | If _ | App -> Dune.empty

(* [module_expresion tbl c args] returns the module expression of
   the functor [c] applies to [args]. *)
let module_expression fmt (c, args) =
  Fmt.pf fmt "%s%a" (Device.module_name c)
    Fmt.(list (parens @@ of_to_string @@ Device.Graph.impl_name))
    args

let find_all_devices info g i =
  let ctx = Info.context info in
  let id = Impl.with_left_most_device ctx i { f = Device.id } in
  let f x l =
    let (Device.Graph.D { dev; _ }) = x in
    if Device.id dev = id then x :: l else l
  in
  Device.Graph.fold f g []

let iter_actions f t =
  let f v res =
    let* () = res in
    f v
  in
  Device.Graph.fold f t (Action.ok ())

let append_main i msg fmt =
  let path = Info.main i in
  let purpose = Fmt.str "Append to main.ml (%s)" msg in
  Fmt.kstr
    (fun str ->
      Action.with_output ~path ~append:true ~purpose (fun ppf ->
          Fmt.pf ppf "%s@." str))
    fmt

let configure info t =
  let f (v : t) =
    let (D { dev; args; _ }) = v in
    let* () = Device.configure dev info in
    if args = [] then Action.ok ()
    else
      append_main info "configure" "@[<2>module %s =@ %a@]@."
        (Device.Graph.impl_name v) module_expression (dev, args)
  in
  iter_actions f t

let meta_init fmt (connect_name, result_name) =
  Fmt.pf fmt "let _%s =@[@ Lazy.force %s @]in@ " result_name connect_name

let emit_connect fmt (iname, names, connect_string) =
  (* We avoid potential collision between double application
     by prefixing with "_". This also avoid warnings. *)
  let rnames = List.map (fun x -> "_" ^ x) names in
  let bind ppf name = Fmt.pf ppf "_%s >>= fun %s ->@ " name name in
  Fmt.pf fmt "@[<v 2>let %s = lazy (@ %a%a%s@ )@]@." iname
    Fmt.(list ~sep:nop meta_init)
    (List.combine names rnames)
    Fmt.(list ~sep:nop bind)
    rnames (connect_string rnames)

let emit_run info init main =
  (* "exit 1" is ok in this code, since cmdliner will print help. *)
  let force ppf name = Fmt.pf ppf "Lazy.force %s >>= fun _ ->@ " name in
  append_main info "emit_run"
    "@[<v 2>let () =@ let t =@ @[<v 2>%aLazy.force %s@]@ in run t@]"
    Fmt.(list ~sep:nop force)
    init main

let connect ?(init = []) info t =
  let f (v : t) =
    let (D { dev; args; deps; _ }) = v in
    let var_name = Device.Graph.var_name v in
    let impl_name = Device.Graph.impl_name v in
    let arg_names = List.map Device.Graph.var_name (args @ deps) in
    append_main info "connect" "%a" emit_connect
      (var_name, arg_names, Device.connect dev info impl_name)
  in
  let* () = iter_actions f t in
  let main_name = Device.Graph.var_name t in
  let init_names =
    List.fold_left
      (fun acc i ->
        match find_all_devices info t i with
        | [] -> assert false
        | ds -> List.map Device.Graph.var_name ds @ acc)
      [] init
    |> List.rev
  in
  emit_run info init_names main_name
07070100000020000081A400000000000000000000000164916410000008C4000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/engine.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Functoria engine. *)

val if_keys : Impl.abstract -> Key.Set.t
(** [if_keys t] is the set of [if] keys in the graph [t]. *)

val all_keys : Impl.abstract -> Key.Set.t
(** [all_keys t] is the set of keys in the graph [t]. *)

val packages : Impl.abstract -> Package.t list Key.value
(** [packages t] is the set of packages in the graph [t]. *)

val install : Info.t -> Impl.abstract -> Install.t Key.value
(** [install i t] is the set of files installed by the graph [t]. *)

val files : Info.t -> Impl.abstract -> Fpath.Set.t
(** [files i t] is the list of files generated configure-time. *)

val dune : Info.t -> Impl.abstract -> Dune.stanza list
(** [dune i t] is the list of dune stanzas needed to build the project [t] with
    the build information [i]. *)

(** {2 Triggering Hooks} *)

type t = Device.Graph.t
(** The type for key graphs. *)

val configure : Info.t -> t -> unit Action.t
(** [configure i t] calls all the configuration hooks for each of the
    implementations appearing in [t], in topological order. Use the build
    information [i]. *)

val connect : ?init:'a Impl.t list -> Info.t -> t -> unit Action.t
(** [connect ?init i t] generates the [connect] functions in [main.ml], for each
    of the implementations appearing [t], in topological order. Use build
    information [i]. *)
07070100000021000081A40000000000000000000000016491641000000CA0000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/filegen.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring
open Action.Syntax

module type PROJECT = sig
  val name : string
  val version : string
end

let headers lang =
    let line = Fmt.str "Generated by %s.%s" P.name P.version in
    match lang with
    | `Sexp -> Fmt.str ";; %s" line
    | `Opam | `Make -> Fmt.str "# %s" line
    | `OCaml -> Fmt.str "(* %s *)" line

let short_headers lang =
    match lang with
    | `Sexp -> Fmt.str ";; Generated by"
    | `Opam | `Make -> "# Generated by"
    | `OCaml -> "(* Generated by"

let has_headers file contents =
    match Fpath.basename file with
    | "dune-project" | "dune-workspace" -> (
        let lines = String.cuts ~sep:"\n" ~empty:true (String.trim contents) in
        match List.rev lines with
        | x :: _ -> String.is_infix ~affix:(short_headers `Sexp) x
        | _ -> false)
    | _ -> (
        match lang file with
        | None -> false
        | Some lang ->
            let affix = short_headers lang in
            String.is_infix ~affix contents)

let can_overwrite file =
    let* is_file = Action.is_file file in
    if is_file then
      let+ content = Action.read_file file in
      has_headers file content
    else Action.ok true

let rm file =
    let* can_overwrite = can_overwrite file in
    if not can_overwrite then Action.ok () else Action.rm file

let with_headers file contents =
    if has_headers file contents then contents
    else
      match Fpath.basename file with
      | "dune-project" | "dune-workspace" | "dune-workspace.config" ->
          Fmt.str "%s\n%s\n" contents (headers `Sexp)
      | _ -> (
          match lang file with
          | None -> Fmt.invalid_arg "%a: invalide lang" Fpath.pp file
          | Some lang -> Fmt.str "%s\n\n%s" (headers lang) contents)

let write file contents =
    let* can_overwrite = can_overwrite file in
    if not can_overwrite then Action.ok ()
    else Action.write_file file (with_headers file contents)
end
07070100000022000081A400000000000000000000000164916410000004CC000000000000000000000000000000000000002700000000mirage-4.4.0/lib/functoria/filegen.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Basic helpers to generate files. *)

module type PROJECT = sig
  val name : string
  val version : string
end

module Make (P : PROJECT) : sig
  val write : Fpath.t -> string -> unit Action.t
  val headers : [ `OCaml | `Sexp | `Make | `Opam ] -> string
  val rm : Fpath.t -> unit Action.t
end
07070100000023000081A40000000000000000000000016491641000000DFC000000000000000000000000000000000000002800000000mirage-4.4.0/lib/functoria/functoria.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring
module Key = Key
module Package = Package
module Info = Info
module Type = Type
module Impl = Impl
module Device = Device
module Install = Install
module Opam = Opam
module Lib = Lib
module Tool = Tool
module Engine = Engine
module DSL = DSL
module Cli = Cli
module Action = Action
module Dune = Dune

module type DSL = module type of DSL

module type KEY =
  module type of Key
    with type 'a Arg.converter = 'a Key.Arg.converter
     and type 'a Arg.t = 'a Key.Arg.t
     and type Arg.info = Key.Arg.info
     and type 'a value = 'a Key.value
     and type 'a key = 'a Key.key
     and type t = Key.t
     and type Set.t = Key.Set.t
     and type 'a Alias.t = 'a Key.Alias.t
     and type context = Key.context

(** Devices *)

include DSL

let job = Job.t
let noop = Job.noop
let info = Info.t

let keys ?runtime_package ?runtime_modname x =
  Job.keys ?runtime_package ?runtime_modname x

type argv = Argv.t

let sys_argv = Argv.sys_argv
let argv = Argv.argv

(* Info device *)

let src = Logs.Src.create "functoria" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)

let pp_packages fmt l =
  Fmt.pf fmt "[@ %a]"
    Fmt.(
      iter ~sep:(any ";@ ") List.iter @@ fun fmt (n, v) -> pf fmt "%S, %S" n v)
    l

let pp_info modname fmt name =
  Fmt.pf fmt "%s.{@ name = %S;@ libraries@]@ }" modname name

let dune_info_deps =
  {|
open Build_info.V1

let libraries = Statically_linked_libraries.to_list ()
let libraries =
  List.map (fun l ->
    let name = Statically_linked_library.name l in
    let version = match Statically_linked_library.version l with
      | None -> "n/a"
      | Some v -> Version.to_string v
    in
    name, version
  ) libraries
|}

let fixed_deps pkg =
  Fmt.str "@[<v 2>let libraries = %a@]@;" pp_packages (String.Map.bindings pkg)

let app_info ?(runtime_package = "functoria-runtime") ?build_info
    ?(gen_modname = "Info_gen") ?(modname = "Functoria_runtime") () =
  let info_gen = Fpath.(v (String.Ascii.lowercase gen_modname) + "ml") in
  let module_name = gen_modname in
  let connect _ impl_name _ = Fmt.str "return %s.info" impl_name in
  let configure i =
    Log.info (fun m -> m "Generating: %a (info)" Fpath.pp info_gen);
    let libraries =
      match build_info with
      | None -> dune_info_deps
      | Some pkgs -> fixed_deps (String.Map.of_list pkgs)
    in
    Fmt.kstr
      (Action.write_file info_gen)
      "%s@.@[<v 2>let info = %a@]" libraries (pp_info modname) (Info.name i)
  in
  let files _ = [ info_gen ] in
  let packages = Package.[ v runtime_package; v "dune-build-info" ] in
  Impl.v ~files ~packages ~connect ~configure module_name Info.t
07070100000024000081A40000000000000000000000016491641000001BD0000000000000000000000000000000000000002900000000mirage-4.4.0/lib/functoria/functoria.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** {1 The Functoria DSL} *)

(** Functoria is a DSL to describe a set of modules and functors, their types
    and how to apply them in order to produce a complete application.

The main use case is mirage. See the [Mirage] documentation for details.

Functoria is a DSL to write configuration files for functor-heavy
    applications. Such configuration files (imaginatively called [config.ml])
    usually contains three parts: one for defining toplevel modules, one for
    defining configuration kyes and one for defining applications using these
    modules and keys.

{2 Defining toplevel modules}

To define toplevel modules, use the {!main} function. Among its various
    arguments, it takes the module name and its signature. The type is assembled
    with the {!Type} combinators, like the [@->] operator, which represents a
    functor arrow.

{[
      let main = main "Unikernel.Main" (m @-> job)
    ]}

This declares that the functor [Unikernel.Main] takes a module of type [m]
    and returns a module of type {!module-DSL.job}. [job] has a specific meaning
    for functoria: it is a module which defines at least a function [start],
    which should have one argument per functor argument and should return
    [unit].

It is up to the user to ensure that the declaration matches the
    implementation, or be rewarded by a compiler error later on. If the
    declaration is correct, everything that follows will be.

{2 Defining configuration keys}

A configuration key is composed of:

- {i name} : The name of the value in the program.
    - {i description} : How it should be displayed/serialized.
    - {i stage} : Is the key available only at runtime, at configure time or
      both?
    - {i documentation} : It is not optional so you should really write it.

Consider a multilingual application: we want to pass the default language as
    a parameter. We will use a simple string, so we can use the predefined
    description {!Key.Arg.string}. We want to be able to define it both at
    configure and run time, so we use the stage [Both]. This gives us the
    following code:

{[
      let lang_key =
        let doc =
          Key.Arg.info ~doc:"The default language for the application."
            [ "l"; "lang" ]
        in
        Key.create "language" @@ Key.Arg.(opt ~stage:`Both string "en" doc)
    ]}

Here, we defined both a long option ["--lang"] and a short one ["-l"] (the
    format is similar to the one used by
    {{:http://erratique.ch/software/cmdliner} Cmdliner}. In the application
    code, the value is retrieved with [Key_gen.language ()].

The option is also documented in the ["--help"] option for both the
    [configure] subcommand (at configure time) and [./app.exe] (at startup
    time).

{v
      -l VAL, --lang=VAL (absent=en) The default language for the application.
    v}

{2 Defining applications}

To register a new application, use [register]:

{[
      let () = register "app" [ main $ impl ]
    ]}

This function (which should only be called once) takes as argument the name
    of the application and a list of jobs. The jobs are defined using the
    {!Impl} DSL; for instance the operator [$] is used to apply the functor
    [main] (aka [Unikernel.Main]) to the default console.

Once an application is registered, it can be configured and built using
    command-line arguments.

Configuration keys we can use be used to switch implementation at configure
    time. This is done by using the {!Key} DSL, for instance to check whether
    [lang_key] is instanciated with a given string:

{[
      let lang_is "s" = Key.(pure (( = ) s) $ value lang_key)
    ]}

Then by using the {!if_impl} combinator to choose between two
    implementations depending on the value of the key:

{[
      let impl = if_impl (is "fi") finnish_impl not_finnish_implementation
    ]} *)

module type DSL = module type of DSL

include DSL

(** The signature for run-time and configure-time command-line keys. *)
module type KEY =
  module type of Key
    with type 'a Arg.converter = 'a Key.Arg.converter
     and type 'a Arg.t = 'a Key.Arg.t
     and type Arg.info = Key.Arg.info
     and type 'a value = 'a Key.value
     and type 'a key = 'a Key.key
     and type t = Key.t
     and type Set.t = Key.Set.t
     and type 'a Alias.t = 'a Key.Alias.t
     and type context = Key.context

module Package = Package
module Info = Info
module Install = Install
module Device = Device

(** {1 Useful module implementations} *)

val job : job typ
(** [job] is the signature for user's application main module. *)

val noop : job impl
(** [noop] is an implementation of {!type-job} that holds no state, does nothing
    and has no dependency. *)

type argv = Argv.t
(** The type for command-line arguments, similar to the usual [Sys.argv]. *)

val argv : argv typ
(** [argv] is a value representing {!type-argv} module types. *)

val sys_argv : argv impl
(** [sys_argv] is a device providing command-line arguments by using [Sys.argv]. *)

val keys :
  ?runtime_package:string -> ?runtime_modname:string -> argv impl -> job impl
(** [keys a] is an implementation of {!type-job} that holds the parsed
    command-line arguments. By default [runtime_package] is
    ["functoria-runtime"] and [runtime_modname] is ["Functoria_runtime"]. *)

val info : info typ
(** [info] is a value representing {!type-info} module types. *)

val app_info :
  ?runtime_package:string ->
  ?build_info:(string * string) list ->
  ?gen_modname:string ->
  ?modname:string ->
  unit ->
  info impl
(** [app_info] is the module implementation whose state contains all the
    information available at configure-time.

- The value is stored into a generated module name [gen_modname]: if not
      set, it is [Info_gen].
    - [modname] is the name of the runtime module defining values of type
      [info]. By default it's [Functoria_runtime]. *)

module Type = Type
module Impl = Impl
module Key = Key
module Opam = Opam
module Lib = Lib
module Tool = Tool
module Engine = Engine
module DSL = DSL
module Cli = Cli
module Action = Action
module Dune = Dune
07070100000025000081A400000000000000000000000164916410000037A2000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/impl.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let src = Logs.Src.create "functoria" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)

type 'a t =
  | If : {
      cond : 't Key.value;
      branches : ('t * 'a t) list;
      default : 'a t;
    }
      -> 'a t
  | Dev : { dev : 'a device; args : ('a, 'v) tl; deps : abstract list } -> 'v t
  | App : { f : 'a t; args : ('a, 'v) tl } -> 'v t

and abstract = Abstract : _ t -> abstract

and ('a, 'b) tl =
  | Nil : ('a, 'a) tl
  | Cons : 'a t * ('b, 'c) tl -> ('a -> 'b, 'c) tl

and 'a device = ('a, abstract) Device.t

(** Constructors *)

let abstract t = Abstract t

let rec app_has_no_arguments = function
  | App { args = Cons _; _ } | Dev { args = Cons _; _ } -> false
  | App _ | Dev _ -> true
  | If { cond = _; branches; default } ->
      app_has_no_arguments default
      || List.exists (fun (_, branch) -> app_has_no_arguments branch) branches

(* Devices *)

let mk_dev ~args ~deps dev = Dev { dev; args; deps }
let of_device dev = mk_dev ~args:Nil ~deps:(Device.extra_deps dev) dev

let v ?packages ?packages_v ?keys ?extra_deps ?connect ?dune ?configure ?files
    module_name module_type =
  of_device
  @@ Device.v ?packages ?packages_v ?keys ?extra_deps ?connect ?dune ?configure
       ?files module_name module_type

let main ?packages ?packages_v ?keys ?extra_deps module_name ty =
  let connect _ = Device.start in
  v ?packages ?packages_v ?keys ?extra_deps ~connect module_name ty

(* If *)

let mk_switch ~cond ~branches ~default = If { cond; branches; default }

let if_ cond then_ else_ =
  mk_switch ~cond ~branches:[ (true, then_); (false, else_) ] ~default:then_

let match_ cond ~default branches = mk_switch ~cond ~branches ~default

(* App *)

let rec concat_tl : type a b c. (a, b) tl -> (b, c) tl -> (a, c) tl =
 fun t1 t2 -> match t1 with Nil -> t2 | Cons (h, t) -> Cons (h, concat_tl t t2)

let rec mk_app : type a v. f:a t -> args:(a, v) tl -> v t =
 fun ~f ~args:args1 ->
  match f with
  | Dev { dev; args = args2; deps } ->
      mk_dev ~args:(concat_tl args2 args1) ~deps dev
  | App { f; args = args2 } -> mk_app ~f ~args:(concat_tl args2 args1)
  | _ -> App { f; args = args1 }

let ( $ ) f x = mk_app ~f ~args:(Cons (x, Nil))

(** Utilities *)

let rec pp : type a. a t Fmt.t =
 fun ppf -> function
  | Dev { dev; args; deps = _ } ->
      Fmt.pf ppf "@[<v>@[Dev %a@]@,@[<v2>args=[%a]@]@]" (Device.pp pp_abstract)
        dev pp_tl args
  | App { f; args } -> Fmt.pf ppf "App %a(%a)" pp f pp_tl args
  | If { cond = _; branches; default } ->
      Fmt.pf ppf "Switch (_,%a,%a)" (Fmt.list pp) (List.map snd branches) pp
        default

and pp_tl : type a b. (a, b) tl Fmt.t =
 fun ppf -> function
  | Nil -> ()
  | Cons (h, t) -> Fmt.pf ppf "%a,@ %a" pp h pp_tl t

and pp_abstract ppf (Abstract i) = pp ppf i

(** Tables and traversals *)

(* **** WARNING ******

The [impl] type forms a DAG, implemented as terms with sharing.

It is *essential* to preserve sharing while walking the terms.
   Otherwise
   - We risk double initialization of devices
   - The DOT graph is a mess
   - We might collect information twice

As such, the equality, hashing, and tables must be tuned to share
   [impl]s appropriately and the various traversals must use appropriate tables.
*)

let rec hash : type a. a t -> int = function
  | Dev { dev; args; deps } ->
      Hashtbl.hash
        (`Dev, Device.hash dev, hash_tl args, List.map hash_abstract deps)
  | App { f; args } -> Hashtbl.hash (`App, hash f, hash_tl args)
  | If { cond; branches; default } ->
      Hashtbl.hash
        ( `If,
          cond,
          List.map (fun (p, t) -> Hashtbl.hash (p, hash t)) branches,
          hash default )

and hash_abstract (Abstract x) = hash x

and hash_tl : type a v. (a, v) tl -> int =
 fun x ->
  match x with
  | Nil -> Hashtbl.hash `Nil
  | Cons (h, t) -> Hashtbl.hash (`Cons, hash h, hash_tl t)

type ex = Ex : 'a -> ex

let equal_list p l1 l2 =
  List.length l1 = List.length l2 && List.for_all2 p l1 l2

let rec equal : type t1 t2. t1 t -> t2 t -> (t1, t2) Typeid.witness =
 fun x y ->
  match (x, y) with
  | Dev c, Dev c' -> (
      match
        ( equal_list equal_abstract c.deps c'.deps,
          equal_tl c.args c'.args (Device.witness c.dev c'.dev) )
      with
      | true, Eq -> Eq
      | _ -> NotEq)
  | App a, App b -> (
      match equal_tl a.args b.args (equal a.f b.f) with
      | Eq -> Eq
      | NotEq -> NotEq)
  | If x1, If x2 -> (
      match
        ( equal x1.default x2.default,
          Obj.repr x1.cond == Obj.repr x2.cond,
          equal_list
            (fun (p1, t1) (p2, t2) ->
              Ex p1 = Ex p2 && equal_abstract (abstract t1) (abstract t2))
            x1.branches x2.branches )
      with
      | Eq, true, true -> Eq
      | _ -> NotEq)
  | _ -> NotEq

and equal_abstract (Abstract x) (Abstract y) = Typeid.to_bool @@ equal x y

and equal_tl :
    type t1 t2 v1 v2.
    (t1, v1) tl ->
    (t2, v2) tl ->
    (t1, t2) Typeid.witness ->
    (v1, v2) Typeid.witness =
 fun x y eq ->
  match (x, y, eq) with
  | Nil, Nil, Eq -> Eq
  | Cons (h1, t1), Cons (h2, t2), Eq -> (
      match (equal h1 h2, equal_tl t1 t2 Eq) with Eq, Eq -> Eq | _ -> NotEq)
  | _ -> NotEq

module Tbl = Hashtbl.Make (struct
  type t = abstract

let hash = hash_abstract
  let equal = equal_abstract
end)

module Hashcons : sig
  type tbl

val create : unit -> tbl
  val add : tbl -> 'a t -> 'a t -> unit
  val get : tbl -> 'a t -> 'a t option
end = struct
  type tbl = abstract Tbl.t

let create () = Tbl.create 50
  let add tbl a b = Tbl.add tbl (abstract a) (abstract b)

let get (type a) tbl (oldv : a t) : a t option =
    if Tbl.mem tbl @@ abstract oldv then
      let (Abstract newv) = Tbl.find tbl (abstract oldv) in
      match equal oldv newv with Eq -> Some newv | NotEq -> None
    else None
end

let simplify ~full ~context (Abstract t) =
  let tbl = Hashcons.create () in
  let rec aux : type a. a t -> a t =
   fun impl ->
    match Hashcons.get tbl impl with
    | Some impl' -> impl'
    | None ->
        let acc =
          match impl with
          | If { cond; branches; default } ->
              (* Either
                 - A key is present in the context
                 - We are in full mode, and we use its default value
              *)
              if full || Key.mem context cond then
                let path = Key.eval context cond in
                let t =
                  try List.assoc path branches with Not_found -> default
                in
                aux t
              else
                let branches = List.map (fun (p, t) -> (p, aux t)) branches in
                mk_switch ~cond ~branches ~default
          | Dev { dev; args; deps } ->
              let args = aux_tl args in
              let deps = List.map aux_abstract deps in
              mk_dev ~args ~deps dev
          | App { f; args } ->
              let f = aux f in
              let args = aux_tl args in
              mk_app ~f ~args
        in
        Hashcons.add tbl impl acc;
        acc
  and aux_abstract (Abstract a) = Abstract (aux a)
  and aux_tl : type a v. (a, v) tl -> (a, v) tl = function
    | Nil -> Nil
    | Cons (h, t) -> Cons (aux h, aux_tl t)
  in
  Abstract (aux t)

let eval ~context (Abstract t) =
  let new_id =
    let r = ref 0 in
    fun () ->
      incr r;
      !r
  in
  let tbl = Tbl.create 50 in
  let rec aux : type a. a t -> Device.Graph.t =
   fun impl ->
    if Tbl.mem tbl @@ abstract impl then Tbl.find tbl (abstract impl)
    else
      let acc =
        match impl with
        | Dev { dev; args; deps } ->
            let args = aux_tl args in
            let deps = List.map aux_abstract deps in
            Device.Graph.D { dev; args; deps; id = new_id () }
        | App { f; args = extra_args } ->
            let (D { dev; args; deps; id = _ }) = aux f in
            let extra_args = aux_tl extra_args in
            D { dev; args = args @ extra_args; deps; id = new_id () }
        | If { cond; branches; default } ->
            let path = Key.eval context cond in
            let t = try List.assoc path branches with Not_found -> default in
            aux t
      in
      Tbl.add tbl (abstract impl) acc;
      acc
  and aux_abstract (Abstract a) = aux a
  and aux_tl : type a v. (a, v) tl -> _ = function
    | Nil -> []
    | Cons (h, t) ->
        let a = aux h in
        a :: aux_tl t
  in
  aux t

type 'b f_dev = { f : 'a. ('a, abstract) Device.t -> 'b }

let with_left_most_device ctx t (f : _ f_dev) =
  let rec aux : type a. a t -> _ = function
    | Dev d -> f.f d.dev
    | App a -> aux a.f
    | If { cond; branches; default } ->
        let path = Key.eval ctx cond in
        let t = try List.assoc path branches with Not_found -> default in
        aux t
  in
  aux t

type 'b f_dev_full = {
  f : 'a 'v. args:'b list -> deps:'b list -> 'a device -> 'b;
}

type 'a f_switch = {
  if_ : 'r. cond:'r Key.value -> branches:('r * 'a) list -> default:'a -> 'a;
}

type 'a f_app = f:'a -> args:'a list -> 'a

let map (type r) ~(mk_switch : _ f_switch) ~(mk_app : _ f_app)
    ~(mk_dev : _ f_dev_full) t =
  let tbl = Tbl.create 50 in
  let rec aux : type a. a t -> r =
   fun impl ->
    if Tbl.mem tbl @@ abstract impl then Tbl.find tbl (abstract impl)
    else
      let acc =
        match impl with
        | Dev { dev; args; deps } ->
            let deps =
              List.fold_right (fun (Abstract x) l -> aux x :: l) deps []
            in
            let args = aux_tl args in
            mk_dev.f ~args ~deps dev
        | App { f; args } ->
            let f = aux f in
            let args = aux_tl args in
            mk_app ~f ~args
        | If { cond; branches; default } ->
            let branches = List.map (fun (p, t) -> (p, aux t)) branches in
            let default = aux default in
            mk_switch.if_ ~cond ~branches ~default
      in
      Tbl.add tbl (abstract impl) acc;
      acc
  and aux_tl : type a v. (a, v) tl -> r list = function
    | Nil -> []
    | Cons (h, t) -> aux h :: aux_tl t
  in
  aux t

type label = If : _ Key.value -> label | Dev : _ Device.t -> label | App

let collect :
    type ty.
    (module Misc.Monoid with type t = ty) -> (label -> ty) -> abstract -> ty =
 fun (module M) op (Abstract t) ->
  let r = ref M.empty in
  let add x = r := M.union (op x) !r in
  let mk_switch = { if_ = (fun ~cond ~branches:_ ~default:_ -> add @@ If cond) }
  and mk_app ~f:_ ~args:_ = add App
  and mk_dev = { f = (fun ~args:_ ~deps:_ dev -> add @@ Dev dev) } in
  let () = map ~mk_switch ~mk_app ~mk_dev t in
  !r

(* {2 Dot output} *)
module Dot = struct
  type edge_label =
    | Functor
    | Argument
    | Dependency
    | Branch of { default : bool }

let as_dot_graph (Abstract t) =
    let r = ref 0 in
    let new_id () =
      incr r;
      !r
    in
    let vertices = ref [] in
    let edges = ref [] in
    let add r x = r := x :: !r in
    let mk_switch =
      {
        if_ =
          (fun ~cond ~branches ~default ->
            let id = new_id () in
            add vertices (id, If cond);
            List.iter
              (fun (_, id') -> add edges (id, id', Branch { default = false }))
              branches;
            add edges (id, default, Branch { default = true });
            id);
      }
    and mk_app ~f ~args =
      let id = new_id () in
      add vertices (id, App);
      add edges (id, f, Functor);
      List.iter (fun id' -> add edges (id, id', Argument)) args;
      id
    and mk_dev =
      {
        f =
          (fun ~args ~deps dev ->
            let id = new_id () in
            add vertices (id, Dev dev);
            List.iter (fun id' -> add edges (id, id', Argument)) args;
            List.iter (fun id' -> add edges (id, id', Dependency)) deps;
            id);
      }
    in
    let _ = map ~mk_switch ~mk_app ~mk_dev t in
    (List.rev !vertices, List.rev !edges)

let pp_vertice ppf (id, label) =
    let attrs =
      match label with
      | App -> [ ("label", "$"); ("shape", "diamond") ]
      | If cond -> [ ("label", Fmt.str "If\n%a" Key.pp_deps cond) ]
      | Dev dev ->
          let name = Fmt.str "%s__%i" (Device.nice_name dev) id in
          let label =
            Fmt.str "%s\n%s\n%a" name (Device.module_name dev)
              Fmt.(list ~sep:(any ", ") Key.pp)
              (Device.keys dev)
          in
          [ ("label", label); ("shape", "box") ]
    in
    let pp_attr ppf (field, v) = Fmt.pf ppf "%s=%S" field v in
    Fmt.pf ppf "%d [%a];" id (Fmt.list ~sep:(Fmt.any ", ") pp_attr) attrs

let pp_edges ppf (id, id', label) =
    let attrs =
      match label with
      | Functor -> [ ("style", "bold"); ("tailport", "sw") ]
      | Argument -> []
      | Dependency -> [ ("style", "dashed") ]
      | Branch { default } ->
          let l = [ ("style", "dotted"); ("headport", "n") ] in
          if default then ("style", "bold") :: l else l
    in
    let pp_attr ppf (field, v) = Fmt.pf ppf "%s=%S" field v in
    Fmt.pf ppf "%d -> %d [%a];" id id'
      (Fmt.list ~sep:(Fmt.any ", ") pp_attr)
      attrs

let pp ppf t =
    let vertices, edges = as_dot_graph t in
    Fmt.pf ppf {|@[<v2>digraph G {@,ordering=out;@,%a@,@,%a@,}@]|}
      (Fmt.list ~sep:Fmt.cut pp_vertice)
      vertices
      (Fmt.list ~sep:Fmt.cut pp_edges)
      edges
end

let pp_dot = Dot.pp
07070100000026000081A40000000000000000000000016491641000001053000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/impl.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type 'a t
(** The type for values representing module implementations of type ['a]. *)

type abstract
(** The type for untyped {!t}. *)

type 'a device = ('a, abstract) Device.t
(** The type for device whose dependencies have type {!type:abstract}. *)

val abstract : 'a t -> abstract
(** [abstract i] is [i] with its type erased. *)

val app_has_no_arguments : 'a t -> bool
(** [app_has_no_arguments i] is [true] if the argument list is empty and it is
    an application, [false] otherwise. *)

val pp : 'a t Fmt.t
(** [pp] is the pretty-printer for module implementations. *)

val pp_abstract : abstract Fmt.t
(** [pp_abstract] is the pretty-printer for abstract module implementations. *)

val pp_dot : abstract Fmt.t
(** [pp_dot] outputs the dot representation of module implementations. *)

val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t
(** [m $ a] applies the functor [m] to the module [a]. *)

val if_ : bool Key.value -> 'a t -> 'a t -> 'a t
(** [if_t v t1 t2] is [t1] if [v] is resolved to true and [t2] otherwise. *)

val match_ : 'b Key.value -> default:'a t -> ('b * 'a t) list -> 'a t
(** [match_t v cases ~default] chooses the tementation amongst [cases] by
    matching the [v]'s value. [default] is chosen if no value matches. *)

val of_device : 'a device -> 'a t
(** [of_device t] is the tementation device [t]. *)

val v :
  ?packages:Package.t list ->
  ?packages_v:Package.t list Key.value ->
  ?keys:Key.t list ->
  ?extra_deps:abstract list ->
  ?connect:(Info.t -> string -> string list -> string) ->
  ?dune:(Info.t -> Dune.stanza list) ->
  ?configure:(Info.t -> unit Action.t) ->
  ?files:(Info.t -> Fpath.t list) ->
  string ->
  'a Type.t ->
  'a t
(** [v ...] is [of_device @@ Device.v ...] *)

val main :
  ?packages:Package.t list ->
  ?packages_v:Package.t list Key.value ->
  ?keys:Key.t list ->
  ?extra_deps:abstract list ->
  string ->
  'a Type.t ->
  'a t
(** [main ... name ty] is [v ... ~connect name ty] where [connect] is
    [<name>.start <args>] *)

module Tbl : Hashtbl.S with type key = abstract
(** Hashtbl of implementations. *)

(** {1 Applications} *)

type 'b f_dev = { f : 'a. 'a device -> 'b }
(** The type for iterators on devices. *)

val with_left_most_device : Key.context -> _ t -> 'a f_dev -> 'a
(** [with_left_most_device ctx t f] applies [f] on the left-most device in [f].
    [If] node are resolved using [ctx]. *)

val simplify : full:bool -> context:Key.context -> abstract -> abstract
(** [simplify ~full ~context impl] simplifies the implementation [impl]
    according to keys present in the [context].

If [full] is [true], then the default values of keys are used in their
    absence. Otherwise, absent keys are left un-simplified. *)

val eval : context:Key.context -> abstract -> Device.Graph.t
(** [eval ~context impl] fully evaluates the implementation [impl] according to
    keys present in the [context]. It returns a graph composed only of devices. *)

(** Collections *)

(** The description of a vertex *)
type label = If : _ Key.value -> label | Dev : _ Device.t -> label | App

val collect :
  (module Misc.Monoid with type t = 'ty) -> (label -> 'ty) -> abstract -> 'ty
(** [collect (module M) f g] collects the content of [f v] for each vertex [v]
    in [g]. *)
07070100000027000081A40000000000000000000000016491641000000EFE000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/info.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring

type t = {
  config_file : Fpath.t;
  name : string;
  output : string option;
  keys : Key.Set.t;
  context : Key.context;
  packages : Package.t String.Map.t;
  opam :
    extra_repo:(string * string) list ->
    install:Install.t ->
    opam_name:string ->
    Opam.t;
}

let name t = t.name
let config_file t = t.config_file

let main t =
  let main = match t.output with None -> "main" | Some f -> f in
  Fpath.v (main ^ ".ml")

let get t k = Key.get t.context k
let opam t = t.opam
let output t = t.output
let with_output t output = { t with output = Some output }

let libraries ps =
  let libs p =
    if Package.build_dependency p then String.Set.empty
    else String.Set.of_list (Package.libraries p)
  in
  String.Set.elements
    (List.fold_left String.Set.union String.Set.empty (List.map libs ps))

let packages t = List.map snd (String.Map.bindings t.packages)
let libraries t = libraries (packages t)

let pins packages =
  List.fold_left
    (fun acc p -> match Package.pin p with None -> acc | Some u -> u :: acc)
    [] packages

let keys t = Key.Set.elements t.keys
let context t = t.context

let v ?(config_file = Fpath.v "config.ml") ~packages ~keys ~context
    ?configure_cmd ?pre_build_cmd ?lock_location ~build_cmd ~src name =
  let keys = Key.Set.of_list keys in
  let opam ~extra_repo ~install ~opam_name =
    Opam.v ~depends:packages ~install ~pins:(pins packages) ~extra_repo
      ?configure:configure_cmd ?pre_build:pre_build_cmd ?lock_location
      ~build:build_cmd ~src ~opam_name name
  in
  let packages =
    List.fold_left
      (fun m p ->
        let n = Package.name p in
        match String.Map.find n m with
        | None -> String.Map.add n p m
        | Some p' -> (
            match Package.merge p p' with
            | Some p -> String.Map.add n p m
            | None -> m))
      String.Map.empty packages
  in
  { config_file; name; keys; packages; context; output = None; opam }

let pp_packages ?(surround = "") ?sep ppf t =
  let pkgs = packages t in
  Fmt.pf ppf "%a" (Fmt.iter ?sep List.iter (Package.pp ~surround)) pkgs

let pp verbose ppf ({ name; keys; context; output; _ } as t) =
  let show ?(newline = true) name =
    Fmt.pf ppf ("@[<2>%-10s@ %a@]" ^^ if newline then "@," else "") name
  in
  let list = Fmt.iter ~sep:(Fmt.any ",@ ") List.iter Fmt.string in
  show "Name" Fmt.string name;
  show "Keys" ~newline:(verbose && output <> None) (Key.pps context) keys;
  let () =
    match output with
    | None -> ()
    | Some o -> show "Output" ~newline:verbose Fmt.(string) o
  in
  if verbose then show "Libraries " list (libraries t);
  if verbose then
    show "Packages" ~newline:false
      (pp_packages ?surround:None ~sep:(Fmt.any ",@ "))
      t

let t =
  let i =
    v ~config_file:(Fpath.v "config.ml") ~packages:[] ~keys:[]
      ~build_cmd:"dummy" ~context:Key.empty_context ~src:`None "dummy"
  in
  Type.v i
07070100000028000081A40000000000000000000000016491641000000A7D000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/info.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Information about the final application. *)

type t
(** The type for information about the final application. *)

val config_file : t -> Fpath.t
(** [config_file t] is the configuration file of the application. *)

val name : t -> string
(** [name t] is the name of the application. *)

val main : t -> Fpath.t
(** [main t] is the name of the main application file. *)

val output : t -> string option
(** [output t] is the name of [t]'s output. Derived from {!name} if not set. *)

val with_output : t -> string -> t
(** [with_output t o] is similar to [t] but with the output set to [Some o]. *)

val libraries : t -> string list
(** [libraries t] are the direct OCamlfind dependencies. *)

val packages : t -> Package.t list
(** [packages t] are the opam package dependencies by the project. *)

val opam :
  t ->
  extra_repo:(string * string) list ->
  install:Install.t ->
  opam_name:string ->
  Opam.t
(** [opam scope t] is [t]'opam file to install in the [scope] context.*)

val keys : t -> Key.t list
(** [keys t] are the keys declared by the project. *)

val context : t -> Key.context
(** [parsed t] is a value representing the command-line argument being parsed. *)

val get : t -> 'a Key.key -> 'a
(** [get i k] is the value associated with [k] in [context i]. *)

val v :
  ?config_file:Fpath.t ->
  packages:Package.t list ->
  keys:Key.t list ->
  context:Key.context ->
  ?configure_cmd:string ->
  ?pre_build_cmd:(Fpath.t option -> string) ->
  ?lock_location:(Fpath.t option -> string -> string) ->
  build_cmd:string ->
  src:[ `Auto | `None | `Some of string ] ->
  string ->
  t
(** [create context n r] contains information about the application being built. *)

val pp : bool -> t Fmt.t

(** {1 Devices} *)

val t : t Type.t
07070100000029000081A40000000000000000000000016491641000000C81000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/install.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type t = { bin : (Fpath.t * Fpath.t) list; etc : Fpath.t list }

let v ?(bin = []) ?(etc = []) () = { bin; etc }
let empty = v ()

let dump ppf t =
  let bin ppf t = Fmt.Dump.(list (pair Fpath.pp Fpath.pp)) ppf t.bin in
  let etc ppf t = Fmt.Dump.(list Fpath.pp) ppf t.etc in
  Fmt.Dump.record [ bin; etc ] ppf t

let pp ppf t =
  let pp_bin ppf (src, dst) =
    Fmt.pf ppf "\n  \"%a\" {\"%a\"}" Fpath.pp src Fpath.pp dst
  in
  let pp_etc ppf file =
    Fmt.pf ppf "\n  \"%a\" {\"%s\"}" Fpath.pp file Fpath.(basename file)
  in
  let bins = List.map (Fmt.to_to_string pp_bin) t.bin in
  let etcs = List.map (Fmt.to_to_string pp_etc) t.etc in
  Fmt.pf ppf "bin: [%s%s]\n" (String.concat "" bins)
    (match bins with [] -> "" | _ -> "\n");
  Fmt.pf ppf "etc: [%s%s]" (String.concat "" etcs)
    (match etcs with [] -> "" | _ -> "\n")

let pp_opam ?subdir () ppf t =
  let pp_bin ppf (src, dst) =
    Fmt.pf ppf {|"cp" "%adist/%a" "%%{bin}%%/%a"|}
      Fmt.(option ~none:(any "") Fpath.pp)
      subdir Fpath.pp src Fpath.pp dst
  in
  let pp_etc ppf etc =
    Fmt.pf ppf {|"cp" "%adist/%a" "%%{etc}%%"|}
      Fmt.(option ~none:(any "") Fpath.pp)
      subdir Fpath.pp etc
  in
  Fmt.pf ppf "\n%a\n"
    (Fmt.list ~sep:(Fmt.any "\n") (fun ppf -> Fmt.pf ppf "  [ %a ]" pp_bin))
    t.bin;
  match t.etc with
  | [] -> ()
  | _ ->
      Fmt.pf ppf "%a\n"
        (Fmt.list ~sep:(Fmt.any "\n") (fun ppf -> Fmt.pf ppf "  [ %a ]" pp_etc))
        t.etc

let promote_artifact ~context_name ~src ~dst =
  Dune.stanzaf
    {|
(rule
 (mode (promote (until-clean)))
 (target %a)
 (enabled_if (= %%{context_name} "%s"))
 (action
  (copy %a %%{target}))
)
|}
    Fpath.pp dst context_name Fpath.pp
    Fpath.(v ".." // src)

let dune ~context_name_for_bin ~context_name_for_etc t =
  let bin_rules =
    List.map
      (fun (src, dst) ->
        promote_artifact ~context_name:context_name_for_bin ~src ~dst)
      t.bin
  in
  let etc_rules =
    List.map
      (fun etc ->
        promote_artifact ~context_name:context_name_for_etc ~src:etc ~dst:etc)
      t.etc
  in
  Dune.v (bin_rules @ etc_rules)

let union_etc x y = Fpath.Set.(elements (union (of_list x) (of_list y)))
let union_bin x y = x @ y
let union x y = { bin = union_bin x.bin y.bin; etc = union_etc x.etc y.etc }
0707010000002A000081A40000000000000000000000016491641000000868000000000000000000000000000000000000002700000000mirage-4.4.0/lib/functoria/install.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type t

val v : ?bin:(Fpath.t * Fpath.t) list -> ?etc:Fpath.t list -> unit -> t
(** [v ~bin:\[(src,dst),...\] ~etc ()] is the installation of [src] as [dst] as
    binary files, and [etc] as configuration/artifact. *)

val union : t -> t -> t
(** [union a b] merge to sets of installation rules. *)

val empty : t
(** [empty] is the installation of nothing. *)

val pp : t Fmt.t
(** Print the .install rules to install [t] *)

val pp_opam : ?subdir:Fpath.t -> unit -> t Fmt.t
(** Print the opam rules to install [t]. If [~subdir] is provided, this will be
    used as prefix (i.e. if your unikernel is in the "tutorial/hello/"
    subdirectory (which is passed as [~subdir], the install instructions will
    use [cp tutorial/hello/dist/hello.hvt %{bin}%/hello.hvt]). *)

val dune :
  context_name_for_bin:string -> context_name_for_etc:string -> t -> Dune.t
(** [dune ~context_name_for_bin ~context_name_for_etc ()] is the dune rules to
    promote installed files back in the source tree. A context-name is required
    for [bin] and [etc] artifacts. The first one should be the cross-compiler
    context and the second one should be the host's compiler context. *)

val dump : t Fmt.t
(** Dump installation rules. *)
0707010000002B000081A40000000000000000000000016491641000000A3D000000000000000000000000000000000000002200000000mirage-4.4.0/lib/functoria/job.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let src = Logs.Src.create "functoria" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)
open Astring

type t = JOB

let t = Type.v JOB

(* Noop, the job that does nothing. *)
let noop = Impl.v "Unit" t

module Keys = struct
  let configure ~file i =
    Log.info (fun m -> m "Generating: %a (keys)" Fpath.pp file);
    Action.with_output ~path:file ~purpose:"key_gen file" (fun ppf ->
        let keys = Key.Set.of_list @@ Info.keys i in
        let pp_var = Key.serialize (Info.context i) in
        Fmt.pf ppf "@[<v>%a@]@." Fmt.(iter Key.Set.iter pp_var) keys;
        let runvars = Key.Set.elements (Key.filter_stage `Run keys) in
        let pp_runvar ppf v = Fmt.pf ppf "%s_t" (Key.ocaml_name v) in
        let pp_names ppf v = Fmt.pf ppf "%S" (Key.name v) in
        Fmt.pf ppf "let runtime_keys = List.combine %a %a@."
          Fmt.Dump.(list pp_runvar)
          runvars
          Fmt.Dump.(list pp_names)
          runvars)
end

let keys ?(runtime_package = "functoria-runtime")
    ?(runtime_modname = "Functoria_runtime") (argv : Argv.t Impl.t) =
  let packages = [ Package.v runtime_package ] in
  let extra_deps = [ Impl.abstract argv ] in
  let key_gen = Key.module_name in
  let file = Fpath.(v (String.Ascii.lowercase key_gen) + "ml") in
  let configure = Keys.configure ~file in
  let files _ = [ file ] in
  let connect info impl_name = function
    | [ argv ] ->
        Fmt.str "return (%s.with_argv (List.map fst %s.runtime_keys) %S %s)"
          runtime_modname impl_name (Info.name info) argv
    | _ -> failwith "The keys connect should receive exactly one argument."
  in
  Impl.v ~files ~configure ~packages ~extra_deps ~connect key_gen t
0707010000002C000081A4000000000000000000000001649164100000059C000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/job.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** The representation of main tasks. *)

type t
(** Type for job values. *)

val t : t Type.t
(** [job] is the signature for user's application main module. *)

val noop : t Impl.t
(** [noop] is an implementation of {!Functoria.job} that holds no state, does
    nothing and has no dependency. *)

val keys :
  ?runtime_package:string ->
  ?runtime_modname:string ->
  Argv.t Impl.t ->
  t Impl.t
(** [keys a] is an implementation of {!Functoria.job} that holds the parsed
    command-line arguments. *)
0707010000002D000081A40000000000000000000000016491641000003FF2000000000000000000000000000000000000002200000000mirage-4.4.0/lib/functoria/key.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Misc

module Serialize = struct
  let string fmt s = Format.fprintf fmt "%S" s
  let option x = Fmt.(parens @@ Dump.option x)
  let list x = Fmt.Dump.list x
  let pair a b = Fmt.Dump.pair a b
end

module Arg = struct
  (** {1 Converters} *)

type 'a serialize = Format.formatter -> 'a -> unit
  type 'a runtime_conv = string

type 'a converter = {
    conv : 'a Cmdliner.Arg.conv;
    serialize : 'a serialize;
    runtime_conv : 'a runtime_conv;
  }

let conv ~conv ~serialize ~runtime_conv = { conv; serialize; runtime_conv }
  let converter x = x.conv
  let serialize x = x.serialize
  let runtime_conv x = x.runtime_conv

let string =
    conv ~conv:Cmdliner.Arg.string ~runtime_conv:"Cmdliner.Arg.string"
      ~serialize:(fun fmt -> Format.fprintf fmt "%S")

let bool =
    conv ~conv:Cmdliner.Arg.bool ~runtime_conv:"Cmdliner.Arg.bool"
      ~serialize:(fun fmt -> Format.fprintf fmt "%b")

let int =
    conv ~conv:Cmdliner.Arg.int ~runtime_conv:"Cmdliner.Arg.int"
      ~serialize:(fun fmt i -> Format.fprintf fmt "(%i)" i)

let int64 =
    conv ~conv:Cmdliner.Arg.int64 ~runtime_conv:"Cmdliner.Arg.int64"
      ~serialize:(fun fmt i -> Format.fprintf fmt "(%LiL)" i)

let list ?sep d =
    let runtime_conv =
      match sep with
      | None -> Fmt.str {ocaml|(Cmdliner.Arg.list %s)|ocaml} (runtime_conv d)
      | Some sep ->
          Fmt.str {ocaml|(Cmdliner.Arg.list ~sep:'\x%02x' %s)|ocaml}
            (Char.code sep) (runtime_conv d)
    in
    conv
      ~conv:(Cmdliner.Arg.list ?sep (converter d))
      ~runtime_conv
      ~serialize:(Serialize.list (serialize d))

let pair ?sep a b =
    let runtime_conv =
      match sep with
      | None ->
          Fmt.str {ocaml|(Cmdliner.Arg.pair %s %s)|ocaml} (runtime_conv a)
            (runtime_conv b)
      | Some sep ->
          Fmt.str {ocaml|(Cmdliner.Arg.pair ~sep:'\x%02x' %s %s)|ocaml}
            (Char.code sep) (runtime_conv a) (runtime_conv b)
    in
    conv
      ~conv:(Cmdliner.Arg.pair ?sep (converter a) (converter b))
      ~runtime_conv
      ~serialize:(Serialize.pair (serialize a) (serialize b))

let some d =
    conv
      ~conv:(Cmdliner.Arg.some (converter d))
      ~runtime_conv:(Fmt.str "(Cmdliner.Arg.some %s)" (runtime_conv d))
      ~serialize:(Serialize.option (serialize d))

(** {1 Information about arguments} *)

type info = {
    doc : string option;
    docs : string;
    docv : string option;
    names : string list;
    env : string option;
  }

let info ?(docs = "APPLICATION OPTIONS") ?docv ?doc ?env names =
    { doc; docs; docv; names; env }

let cmdliner_of_info { docs; docv; doc; env; names } =
    let env =
      match env with Some s -> Some (Cmdliner.Cmd.Env.info s) | None -> None
    in
    Cmdliner.Arg.info ~docs ?docv ?doc ?env names

let serialize_env fmt =
    Fmt.pf fmt "(Cmdliner.Cmd.Env.info %a)" Serialize.string

let serialize_info fmt { docs; docv; doc; env; names } =
    Format.fprintf fmt
      "(Cmdliner.Arg.info@ ~docs:%a@ ?docv:%a@ ?doc:%a@ ?env:%a@ %a)"
      Serialize.string docs
      Serialize.(option string)
      docv
      Serialize.(option string)
      doc
      Serialize.(option serialize_env)
      env
      Serialize.(list string)
      names

(** {1 Arguments} *)

type 'a kind =
    | Opt : 'a * 'a converter -> 'a kind
    | Opt_all : 'a converter -> 'a list kind
    | Required : 'a converter -> 'a option kind
    | Flag : bool kind

type stage = [ `Configure | `Run | `Both ]

let pp_conv c = snd (converter c)

let pp_kind : type a. a kind -> a Fmt.t = function
    | Opt (_, c) -> pp_conv c
    | Opt_all c -> pp_conv (list c)
    | Required c -> pp_conv (some c)
    | Flag -> Fmt.bool

let hash_of_kind : type a. a kind -> int = function
    | Opt (x, _) -> Hashtbl.hash (`Opt x)
    | Required _ -> Hashtbl.hash `Required
    | Opt_all _ -> Hashtbl.hash `All
    | Flag -> Hashtbl.hash `Flag

type 'a t = { stage : stage; info : info; kind : 'a kind }

let pp t = pp_kind t.kind

let equal x y =
    x.stage = y.stage && x.info = y.info && compare_kind x.kind y.kind = 0

let compare x y =
    match compare x.stage y.stage with
    | 0 -> (
        match compare x.info y.info with
        | 0 -> compare_kind x.kind y.kind
        | i -> i)
    | i -> i

let hash x =
    Hashtbl.hash (Hashtbl.hash x.stage, Hashtbl.hash x.info, hash_of_kind x.kind)

let stage t = t.stage

let opt ?(stage = `Both) conv default info =
    { stage; info; kind = Opt (default, conv) }

let flag ?(stage = `Both) info = { stage; info; kind = Flag }

let required ?(stage = `Both) conv info =
    { stage; info; kind = Required conv }

let opt_all ?(stage = `Both) conv info = { stage; info; kind = Opt_all conv }

let default (type a) (t : a t) =
    match t.kind with
    | Opt (d, _) -> d
    | Flag -> (false : bool)
    | Required _ -> (None : _ option)
    | Opt_all _ -> ([] : _ list)

(* XXX(dinosaure): I don't understand why we wrapped
   * value with ['a option]. *)

let make_opt_cmdliner wrap i default desc =
    let none =
      match default with
      | Some d -> Some (Fmt.str "%a" (pp_conv desc) d)
      | None -> None
    in
    Cmdliner.Arg.(wrap @@ opt (some ?none @@ converter desc) None i)

let make_opt_all_cmdliner wrap i desc =
    Cmdliner.Arg.(wrap @@ opt_all (converter desc) [] i)

let to_cmdliner ~with_required (type a) (t : a t) : a option Cmdliner.Term.t =
    let i = cmdliner_of_info t.info in
    match t.kind with
    | Flag -> Cmdliner.Arg.(value & vflag None [ (Some true, i) ])
    | Opt (default, desc) ->
        make_opt_cmdliner Cmdliner.Arg.value i (Some default) desc
    | Required desc when with_required && t.stage = `Configure ->
        make_opt_cmdliner Cmdliner.Arg.required i None (some (some desc))
    | Required desc -> make_opt_cmdliner Cmdliner.Arg.value i None (some desc)
    | Opt_all desc ->
        let list_to_option = function
          | [] -> None
          | _ :: _ as lst -> Some lst
        in
        let wrap arg =
          let open Cmdliner in
          Term.(const list_to_option $ Arg.value arg)
        in
        make_opt_all_cmdliner wrap i desc

let serialize_value (type a) (v : a) ppf (t : a t) =
    match t.kind with
    | Flag -> (serialize bool) ppf v
    | Opt (_, c) -> (serialize c) ppf v
    | Required c -> (
        match v with Some v -> (serialize c) ppf v | None -> assert false)
    | Opt_all c -> (serialize (list c)) ppf v

(* This is only called by serialize_ro, hence a configure time
           key, so the value is known. *)

let serialize (type a) : a -> a t serialize =
   fun v ppf t ->
    match t.kind with
    | Flag -> Fmt.pf ppf "Functoria_runtime.Arg.flag %a" serialize_info t.info
    | Opt (_, c) ->
        Fmt.pf ppf "Functoria_runtime.Arg.opt %s %a %a" (runtime_conv c)
          (serialize c) v serialize_info t.info
    | Required c ->
        Fmt.pf ppf "Functoria_runtime.Arg.key ?default:(%a) %s %a"
          (serialize @@ some c)
          v (runtime_conv c) serialize_info t.info
    | Opt_all c ->
        Fmt.pf ppf "Functoria_runtime.Arg.opt_all %s %a %a" (runtime_conv c)
          (serialize (list c))
          v serialize_info t.info
end

type 'a key = {
  name : string;
  arg : 'a Arg.t;
  key : 'a Context.key;
  setters : 'a setter list;
}

and -'a setter = Setter : 'b key * ('a -> 'b option) -> 'a setter

type t = Any : 'a key -> t

let rec equal (Any x) (Any y) =
  String.equal x.name y.name
  && Arg.equal x.arg y.arg
  && equal_setters x.setters y.setters

and equal_setters : type a b. a setter list -> b setter list -> bool =
 fun x y ->
  List.length x = List.length y
  && List.for_all2
       (fun (Setter (x, _)) (Setter (y, _)) -> equal (Any x) (Any y))
       x y

let rec hash (Any x) =
  Hashtbl.hash
    (Hashtbl.hash x.name, Arg.hash x.arg, List.map hash_setter x.setters)

and hash_setter : type a. a setter -> int = fun (Setter (x, _)) -> hash (Any x)

let rec compare (Any x) (Any y) =
  match String.compare x.name y.name with
  | 0 -> (
      match Arg.compare x.arg y.arg with
      | 0 -> compare_setters x.setters y.setters
      | i -> i)
  | i -> i

and compare_setters : type a b. a setter list -> b setter list -> int =
 fun x y ->
  match (x, y) with
  | [], [] -> 0
  | [], _ -> -1
  | _, [] -> 1
  | Setter (x, _) :: tx, Setter (y, _) :: ty -> (
      match compare (Any x) (Any y) with 0 -> compare_setters tx ty | i -> i)

(* Set of keys, without runtime name conflicts. This is useful to create a
   valid cmdliner term. *)
module Names = Stdlib.Set.Make (struct
  type nonrec t = t

let compare (Any x) (Any y) = String.compare x.name y.name
end)

(* Set of keys, where keys with the same name but with different
   defaults are distinguished. This is useful to build the graph of
   devices. *)
module Set = struct
  module M = struct
    type nonrec t = t

let compare = compare
  end

include Set.Make (M)

let add k set =
    if mem k set then
      if k != find k set then
        let (Any k') = k in
        invalid_arg ("Duplicate key name: " ^ k'.name)
      else set
    else add k set

let pp_gen = Fmt.iter ~sep:(Fmt.any ",@ ") iter
  let pp_elt fmt (Any k) = Fmt.string fmt k.name
  let pp = pp_gen pp_elt
end

module Alias = struct
  type 'a t = { a_setters : 'a setter list; a_arg : 'a Arg.t }

let setters t = t.a_setters
  let arg t = t.a_arg
  let create a_arg = { a_setters = []; a_arg }
  let flag doc = create (Arg.flag ~stage:`Configure doc)

(* let opt conv d i = create (Arg.opt ~stage:`Configure conv d i) *)
  let add k f t = { t with a_setters = Setter (k, f) :: t.a_setters }

let apply_one v map (Setter (k, f)) =
    match f v with
    | None -> map
    | Some v -> if Context.mem k.key map then map else Context.add k.key v map

let apply v l map = List.fold_left (apply_one v) map l
  let keys l = Set.of_list @@ List.map (fun (Setter (k, _)) -> Any k) l
end

let v x = Any x
let abstract = v
let arg k = k.arg
let aliases (Any k) = Alias.keys k.setters
let name (Any k) = k.name
let stage (Any k) = Arg.stage k.arg

let is_runtime k =
  match stage k with `Run | `Both -> true | `Configure -> false

let is_configure k =
  match stage k with `Configure | `Both -> true | `Run -> false

let filter_stage stage s =
  match stage with
  | `Run -> Set.filter is_runtime s
  | `Configure | `NoEmit -> Set.filter is_configure s
  | `Both -> s

(* Key Map *)

type context = Context.t

let empty_context = Context.empty
let merge_context = Context.merge
let add_to_context t = Context.add t.key
let find (type a) ctx (t : a key) : a option = Context.find t.key ctx
let get ctx t = match find ctx t with Some x -> x | None -> Arg.default t.arg
let mem_u ctx t = Context.mem t.key ctx

(* {2 Values} *)

type +'a value = { deps : Set.t; v : context -> 'a }

let eval p v = v.v p
let pure x = { deps = Set.empty; v = (fun _ -> x) }

let app f x =
  { deps = Set.union f.deps x.deps; v = (fun p -> (eval p f) (eval p x)) }

let map f x = app (pure f) x
let pipe x f = map f x
let if_ c t e = pipe c @@ fun b -> if b then t else e
let match_ v f = map f v
let ( $ ) = app

let value k =
  let v c = get c k in
  { deps = Set.singleton (Any k); v }

let of_deps deps = { (pure ()) with deps }
let deps k = k.deps
let mem p v = Set.for_all (fun (Any x) -> mem_u p x) v.deps
let peek p v = if mem p v then Some (eval p v) else None
let default v = eval Context.empty v

(* {2 Pretty printing} *)

let dump_context = Context.dump
let pp = Set.pp_elt
let pp_deps fmt v = Set.pp fmt v.deps

let pps p =
  let pp' fmt k v =
    let default = if mem_u p k then Fmt.nop else Fmt.any " (default)" in
    Fmt.pf fmt "%a=%a%a"
      Fmt.(styled `Bold string)
      k.name (Arg.pp k.arg) v default ()
  in
  let f fmt (Any k) =
    match (k.arg.Arg.kind, get p k) with
    | Arg.Required _, None -> Fmt.(styled `Bold string) fmt k.name
    | Arg.Opt _, v -> pp' fmt k v
    | Arg.Required _, v -> pp' fmt k v
    | Arg.Flag, v -> pp' fmt k v
    | Arg.Opt_all _, v -> pp' fmt k v
    (* Warning 4 and GADT don't interact well. *)
  in
  Fmt.vbox @@ fun ppf s -> Set.(pp_gen f ppf @@ s)

(* {2 Automatic documentation} *)

let info_alias setters =
  let f fmt k = Fmt.pf fmt "$(b,%s)" (name k) in
  match setters with
  | [] -> ""
  | [ _ ] ->
      Fmt.str "Will automatically set %a." (Set.pp_gen f) (Alias.keys setters)
  | _ ->
      Fmt.str "Will automatically set the following keys: %a." (Set.pp_gen f)
        (Alias.keys setters)

let info_arg (type a) (arg : a Arg.kind) =
  match arg with
  | Arg.Required _ -> "This key is required."
  | Arg.Flag -> ""
  | Arg.Opt _ -> ""
  | Arg.Opt_all _ -> ""

let add_extra_info setters arg =
  match arg.Arg.info.doc with
  | None -> arg
  | Some doc ->
      let doc =
        String.concat " " [ doc; info_alias setters; info_arg arg.kind ]
      in
      { arg with info = { arg.info with doc = Some doc } }

(* {2 Key creation} *)

(* Unexposed smart constructor. *)
let make ~setters ~arg ~name =
  let key = Context.new_key name in
  let arg = add_extra_info setters arg in
  { setters; arg; name; key }

let alias name a =
  let setters = Alias.setters a in
  let arg = Alias.arg a in
  make ~setters ~arg ~name

let create name arg =
  if name = "" then
    invalid_arg "Key.create: key name cannot be the empty string";
  let setters = [] in
  make ~setters ~arg ~name

(* {2 Cmdliner interface} *)

let context ?(stage = `Both) ~with_required l =
  let stage = filter_stage stage l in
  let names = Names.of_list (Set.elements stage) in
  let gather (Any k) rest =
    let f v p =
      match v with
      | None -> p
      | Some v ->
          let p = Context.add k.key v p in
          Alias.apply v k.setters p
    in
    let key = Arg.to_cmdliner k.arg ~with_required in
    match k.arg.Arg.kind with
    | Arg.Opt _ -> Cmdliner.Term.(const f $ key $ rest)
    | Arg.Required _ -> Cmdliner.Term.(const f $ key $ rest)
    | Arg.Flag -> Cmdliner.Term.(const f $ key $ rest)
    | Arg.Opt_all _ -> Cmdliner.Term.(const f $ key $ rest)
  in
  Names.fold gather names (Cmdliner.Term.const empty_context)

(* {2 Code emission} *)

let module_name = "Key_gen"
let ocaml_name k = Name.ocamlify (name k)
let serialize_call fmt k = Fmt.pf fmt "(%s.%s ())" module_name (ocaml_name k)
let serialize ctx ppf (Any k) = Arg.serialize (get ctx k) ppf (arg k)

let serialize_rw ctx fmt t =
  Format.fprintf fmt
    "@[<2>let %s =@ Functoria_runtime.Key.create@ %a@]@,\
     @,\
     @[<2>let %s_t =@ Functoria_runtime.Key.term %s@]@,\
     @,\
     @[<2>let %s () =@ Functoria_runtime.Key.get %s@]@,"
    (ocaml_name t)
    Fmt.(parens (serialize ctx))
    t (ocaml_name t) (ocaml_name t) (ocaml_name t) (ocaml_name t)

let serialize_ro ctx fmt t =
  let (Any k) = t in
  Format.fprintf fmt "@[<2>let %s () =@ %a@]@," (ocaml_name t)
    (Arg.serialize_value (get ctx k))
    (arg k)

let serialize ctx fmt k =
  if is_runtime k then serialize_rw ctx fmt k else serialize_ro ctx fmt k
0707010000002E000081A40000000000000000000000016491641000002ADA000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/key.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Configuration and runtime command-line arguments. *)

(** Cross-stage command-line arguments. *)
module Arg : sig
  (** Terms for cross-stage arguments.

This module extends
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html}
        Cmdliner.Arg} to allow MetaOCaml-style typed cross-stage persistency of
      command-line arguments. *)

(** {1 Argument converters} *)

type 'a serialize = Format.formatter -> 'a -> unit
  (** The type for command-line argument serializers. A value of type
      ['a serialize] generates a syntactically valid OCaml representation which
      evaluates to a value of type ['a]. *)

type 'a runtime_conv = string
  (** The type for command-line argument converters used at runtime. A value of
      type ['a runtime_conv] is a symbol name of type
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner.Arg.html#type-conv}
        Cmdliner.Arg.conv}. *)

type 'a converter
  (** The type for argument converters. *)

val conv :
    conv:'a Cmdliner.Arg.conv ->
    serialize:'a serialize ->
    runtime_conv:'a runtime_conv ->
    'a converter
  (** [conv c s r] is the argument converter using [c] to convert user strings
      into OCaml value, [s] to convert OCaml values into strings interpretable
      as OCaml expressions, and the function named [r] to convert user strings
      into OCaml values at runtime. *)

val string : string converter
  (** [string] converts strings. *)

val bool : bool converter
  (** [bool] converts booleans. *)

val int : int converter
  (** [int] converts integers. *)

val int64 : int64 converter
  (** [int64] converts 64-bits integers. *)

val list : ?sep:char -> 'a converter -> 'a list converter
  (** [list t] converts lists of [t]s. *)

val pair : ?sep:char -> 'a converter -> 'b converter -> ('a * 'b) converter
  (** [pair a b] converts [a] and [b] to a pair of [a, b]. *)

val some : 'a converter -> 'a option converter
  (** [some t] converts [t] options. *)

(** {1 Arguments and their information} *)

type 'a t
  (** The type for arguments holding data of type ['a]. *)

type info
  (** The type for information about cross-stage command-line arguments. See
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html#arginfo}
        Cmdliner's arguments}. *)

val info :
    ?docs:string ->
    ?docv:string ->
    ?doc:string ->
    ?env:string ->
    string list ->
    info
  (** Define cross-stage information for an argument. See
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html#type-info}
        Cmdliner.Arg.info}. If not set, [docs] is ["UNIKERNEL PARAMETERS"]. *)

(** {1 Optional Arguments} *)

type stage = [ `Configure | `Run | `Both ]
  (** The type for specifying at which stage an argument is available.

- [`Configure] means that the argument is read on the command-line at
        configuration-time.
      - [`Run] means that the argument is read on the command-line at runtime.
      - [`Both] means that the argument is read on the command-line both at
        configuration-time and run-time. *)

val opt : ?stage:stage -> 'a converter -> 'a -> info -> 'a t
  (** [opt conv v i] is similar to
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html#val-opt}
        Cmdliner.Arg.opt} but for cross-stage optional command-line arguments.
      If not set, [stage] is [`Both]. *)

val required : ?stage:stage -> 'a converter -> info -> 'a option t
  (** [required conv i] is similar to
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html#val-required}
        Cmdliner.Arg.required} but for cross-stage required command-line
      arguments. If not set, [stage] is [`Both]. *)

val flag : ?stage:stage -> info -> bool t
  (** [flag i] is similar to
      {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html#val-flag}
        Cmdliner.Arg.flag} but for cross-stage command-line flags. If not set,
      [stage] is [`Both]. *)

val opt_all : ?stage:stage -> 'a converter -> info -> 'a list t
end

(** {1 Configuration Keys} *)

type 'a key
(** The type for configuration keys. Keys are used to retrieve the cross-stage
    values they are holding (by indexing contents in the autogenerated
    [Bootgen_var] module) but also to parameterize the choice of
    {{!Functoria.if_impl} module implementation}. *)

val create : string -> 'a Arg.t -> 'a key
(** [create n a] is the key named [n] whose contents is determined by parsing
    the command-line argument [a]. *)

(** {1 Configuration Values} *)

type +'a value
(** The type for configure-time and run-time values. Values are either {!pure}
    or obtained by composing other values. Values might have {{!deps} data
    dependencies}, which form an (implicit) directed and acyclic graph that need
    to be evaluated. *)

val pure : 'a -> 'a value
(** [pure x] is a value without any dependency. *)

val ( $ ) : ('a -> 'b) value -> 'a value -> 'b value
(** [f $ v] is is the value resulting from the application of [f]'value to [v]'s
    value. [$] is the usual {i app} operator for
    {{:http://dx.doi.org/10.1017/S0956796807006326} applicative functor}. *)

val map : ('a -> 'b) -> 'a value -> 'b value
(** [map f v] is [pure f $ v]. *)

val if_ : bool value -> 'a -> 'a -> 'a value
(** [if_ v x y] is [map (fun b -> if b then x else y) v]. *)

val match_ : 'a value -> ('a -> 'b) -> 'b value
(** [match_ v pattern] is [map pattern v]. *)

val default : 'a value -> 'a
(** [default v] returns the default value for [v]. *)

val value : 'a key -> 'a value
(** [value k] is the value parsed by [k]. *)

(** {1 Abstract Keys} *)

type t
(** The type for abstract {{!type:key} keys}. *)

val name : t -> string
(** [name t] is the string given as [t]'s name when [t] was created. *)

val v : 'a key -> t
(** [v k] is the [k] with its type hidden. *)

val abstract : 'a key -> t
  [@@ocaml.deprecated "Use Functoria.Key.v."]
(** Deprecated, use {!v}. *)

val equal : t -> t -> bool
(** [equal] is the equality function of untyped keys. *)

val hash : t -> int
(** [hash] is the hash function for untyped keys. *)

val compare : t -> t -> int
(** [compare] compares untyped keys. *)

val pp : t Fmt.t
(** [pp fmt k] prints the name of [k]. *)

(** [Set] implements sets over [t] elements. *)
module Set : sig
  include Set.S with type elt = t

val pp : t Fmt.t
  (** [pp] pretty-prints sets of keys. *)
end

val of_deps : Set.t -> unit value
(** [of_deps keys] is a value with [keys] as data-dependencies. *)

val deps : 'a value -> Set.t
(** [deps v] are [v]'s data-dependencies. *)

val pp_deps : 'a value Fmt.t
(** [pp_deps fmt v] prints the name of the dependencies of [v]. *)

(** {1 Stages} *)

val is_runtime : t -> bool
(** [is_runtime k] is true if [k]'s stage is [`Run] or [`Both]. *)

val is_configure : t -> bool
(** [is_configure k] is true if [k]'s stage is [`Configure] or [`Both]. *)

val filter_stage : Arg.stage -> Set.t -> Set.t
(** [filter_stage s ks] is [ks] but with only keys available at stage [s]. *)

(** Alias allows to define virtual keys in terms of other keys at configuration
    time only. *)
module Alias : sig
  (** {1 Alias} *)

type 'a t
  (** The type for key alias. *)

val add : 'b key -> ('a -> 'b option) -> 'a t -> 'a t
  (** [add k f a] set [a] as an alias for the key [k]: setting [a] on the
      command-line will set [k] to [f] applied to [a]'s value. If [f] returns
      [None], no value is set. *)

val flag : Arg.info -> bool t
  (** [flag] is similar to {!Arg.flag} but defines configure-only command-line
      flag alias. Set [stage] to [`Configure]. *)

(*
  val opt: 'a Arg.converter -> 'a -> Arg.info -> 'a t
  (** [opt] is similar to {!Arg.opt} but defines configure-only
      optional command-line arguments. Set [stage] to [`Configure]. *)
*)
end

val alias : string -> 'a Alias.t -> 'a key
(** Similar to {!create} but for command-line alias. *)

val aliases : t -> Set.t
(** [aliases t] is the list of [t]'s aliases. *)

(** {1 Parsing context} *)

type context
(** The type for values holding parsing context. *)

val dump_context : context Fmt.t
(** [dump_context] dumps the contents of a context. *)

val empty_context : context
val merge_context : default:context -> context -> context

val add_to_context : 'a key -> 'a -> context -> context
(** Add a binding to a context. *)

val context :
  ?stage:Arg.stage -> with_required:bool -> Set.t -> context Cmdliner.Term.t
(** [context ~with_required ks] is a [Cmdliner]
    {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Term/index.html#type-t}
      term} that evaluates into a parsing context for command-line arguments. If
    [with_required] is false, it will only produce optional keys. *)

val mem : context -> 'a value -> bool
(** [mem c v] is [true] iff all the dependencies of [v] have been evaluated. *)

val peek : context -> 'a value -> 'a option
(** [peek c v] is [Some x] if [mem v] and [None] otherwise. *)

val eval : context -> 'a value -> 'a
(** [eval c v] evaluates [v] in [c]'s context, using default values if
    necessary. *)

val get : context -> 'a key -> 'a
(** [get c k] is [k]'s value in [c]'s context. If [k] is not present in [c], it
    is [k]'s default value.*)

val find : context -> 'a key -> 'a option
(** [find c k] is [k]'s value in [c]'s context or [None] if [k] is not present
    in [c]. *)

val pps : context -> Set.t Fmt.t
(** [pps c fmt ks] prints the keys [ks] using the context [c] to get their
    value. *)

(** {1 Code Serialization} *)

val ocaml_name : t -> string
(** [ocaml_name k] is the ocaml name of [k]. *)

val serialize_call : t Fmt.t
(** [serialize_call fmt k] outputs [Key_gen.n ()] to [fmt], where [n] is [k]'s
    {{!ocaml_name} OCaml name}. *)

val serialize : context -> t Fmt.t
(** [serialize ctx ppf k] outputs the [Cmdliner] runes to parse command-line
    arguments represented by [k] at runtime. *)

(**/**)

val module_name : string
(** Name of the generated module containing the keys. *)
0707010000002F000081A400000000000000000000000164916410000047ED000000000000000000000000000000000000002200000000mirage-4.4.0/lib/functoria/lib.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Action.Syntax
open Astring
open DSL
module Name = Misc.Name

let src = Logs.Src.create "functoria" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)

module Config = struct
  type t = {
    config_file : Fpath.t;
    name : string;
    configure_cmd : string;
    pre_build_cmd : Fpath.t option -> string;
    lock_location : Fpath.t option -> string -> string;
    build_cmd : string;
    packages : package list Key.value;
    keys : Key.Set.t;
    init : job impl list;
    jobs : Impl.abstract;
    src : [ `Auto | `None | `Some of string ];
  }

type out = {
    init : job impl list;
    jobs : Impl.abstract;
    info : Info.t;
    device_graph : Device.Graph.t;
  }

(* In practice, we get all the keys associated to [if] cases, and
     all the keys that have a setter to them. *)
  let get_if_context jobs =
    let all_keys = Engine.all_keys jobs in
    let skeys = Engine.if_keys jobs in
    let f k s =
      if Key.Set.is_empty @@ Key.Set.inter (Key.aliases k) skeys then s
      else Key.Set.add k s
    in
    Key.Set.fold f all_keys skeys

let v ?(config_file = Fpath.v "config.ml") ?(keys = []) ?(packages = [])
      ?(init = []) ~configure_cmd ~pre_build_cmd ~lock_location ~build_cmd ~src
      name jobs =
    let packages = Key.pure @@ packages in
    let jobs = Impl.abstract jobs in
    let keys = Key.Set.(union (of_list keys) (get_if_context jobs)) in
    {
      config_file;
      packages;
      keys;
      name;
      init;
      configure_cmd;
      pre_build_cmd;
      lock_location;
      build_cmd;
      jobs;
      src;
    }

let eval ~full context
      {
        config_file;
        name = n;
        configure_cmd;
        pre_build_cmd;
        lock_location;
        build_cmd;
        packages;
        keys;
        jobs;
        init;
        src;
      } =
    let jobs = Impl.simplify ~full ~context jobs in
    let device_graph = Impl.eval ~context jobs in
    let packages = Key.(pure List.append $ packages $ Engine.packages jobs) in
    let keys = Key.Set.elements (Key.Set.union keys @@ Engine.all_keys jobs) in
    let mk packages _ context =
      let info =
        Info.v ~config_file ~packages ~keys ~context ~configure_cmd
          ~pre_build_cmd ~lock_location ~build_cmd ~src n
      in
      { init; jobs; info; device_graph }
    in
    Key.(pure mk $ packages $ of_deps (Set.of_list keys))

let keys t = t.keys
  let pp_dot = Impl.pp_dot
end

module type S = sig
  val prelude : Info.t -> string
  val packages : Package.t list
  val name : string
  val version : string
  val create : job impl list -> job impl
  val name_of_target : Info.t -> string
  val dune_project : Dune.stanza list
  val dune_workspace : (?build_dir:Fpath.t -> info -> Dune.t) option
  val context_name : Info.t -> string
end

module Make (P : S) = struct
  module Filegen = Filegen.Make (P)

let default_init = [ Job.keys Argv.sys_argv ]
  let build_dir args = Fpath.parent args.Cli.config_file
  let config_file args = args.Cli.config_file
  let mirage_dir args = Fpath.(build_dir args / P.name)
  let artifacts_dir args = Fpath.(build_dir args / "dist")

let exit_err args = function
    | Ok v -> v
    | Error (`Msg m) ->
        flush_all ();
        if m <> "" then Fmt.epr "%a\n%!" Fmt.(styled (`Fg `Red) string) m;
        if not args.Cli.dry_run then exit 1 else Fmt.epr "(exit 1)"

let get_build_cmd _ =
    let command_line_arguments =
      Sys.argv
      |> Array.to_list
      |> List.tl
      |> List.filter (fun arg ->
             arg <> "configure" && arg <> "query" && arg <> "opam")
      |> String.concat ~sep:" "
    in
    let opts =
      if command_line_arguments = "" then None else Some command_line_arguments
    in
    ( Fmt.str {|%s configure%a --no-extra-repo|} P.name
        Fmt.(option ~none:(any "") (any " " ++ string))
        opts,
      (fun sub ->
        Fmt.str {|make %a"lock" "depext-lockfile" "pull"|}
          Fmt.(option ~none:(any "") (any "\"-C" ++ Fpath.pp ++ any "\" "))
          sub),
      (fun sub unikernel ->
        Fmt.str {|%amirage/%s.opam.locked|}
          Fmt.(option ~none:(any "") Fpath.pp)
          sub unikernel),
      Fmt.str {|%s build|} P.name )

(* STAGE 2 *)

let src = Logs.Src.create (P.name ^ "-configure") ~doc:"functoria generated"

module Log = (val Logs.src_log src : Logs.LOG)

let eval_cached ~full ~with_required ~output ~cache context t =
    let info = Config.eval ~full context t in
    let keys = Key.deps info in
    let output =
      match (output, Context_cache.peek_output cache) with
      | Some _, _ -> output
      | _, cache -> cache
    in
    let context = Key.context ~stage:`Configure ~with_required keys in
    let context = Context_cache.merge cache context in
    let f context =
      let config = Key.eval context info context in
      match output with
      | None -> config
      | Some o -> { config with info = Info.with_output config.info o }
    in
    Cmdliner.Term.(const f $ context)

(* FIXME: describe init *)
  let describe (t : _ Cli.describe_args) =
    let { Config.jobs; _ } = t.args.Cli.context in
    let f fmt =
      Fmt.pf fmt "%a\n%!" (if t.dot then Config.pp_dot else Fmt.nop) jobs
    in
    let with_fmt f =
      match t.args.output with
      | None when t.dot ->
          f Format.str_formatter;
          let data = Format.flush_str_formatter () in
          let* tmp = Action.tmp_file ~mode:0o644 "graph%s.dot" in
          let* () = Action.write_file tmp data in
          Action.run_cmd Bos.Cmd.(v t.dotcmd % p tmp)
      | None -> Action.ok (f Fmt.stdout)
      | Some s -> Action.with_output ~path:(Fpath.v s) ~purpose:"dot file" f
    in
    with_fmt f

let configure_main i init jobs =
    let main = Info.main i in
    let purpose = Fmt.str "configure: create %a" Fpath.pp main in
    Log.info (fun m -> m "Generating: %a (main file)" Fpath.pp main);
    let* () =
      Action.with_output ~path:main ~append:false ~purpose (fun ppf ->
          Fmt.pf ppf "%a@.@." Fmt.text (P.prelude i))
    in
    let* () = Engine.configure i jobs in
    Engine.connect i ~init jobs

let files i jobs =
    let main = Info.main i in
    let files = Engine.files i jobs in
    let files = Fpath.Set.add main files in
    Fpath.Set.(elements files)

let build (args : _ Cli.build_args) =
    (* Get application name *)
    let build_dir = build_dir args in
    let* () = Filegen.write Fpath.(build_dir / "dune") "(include dune.build)" in
    let cmd = Bos.Cmd.(v "dune" % "build" % "--root" % ".") in
    Log.info (fun f -> f "dune build --root .");
    Action.run_cmd_cli cmd

let query ({ args; kind; depext; extra_repo } : _ Cli.query_args) =
    let { Config.jobs; info; _ } = args.Cli.context in
    let name = P.name_of_target info in
    let install = Key.eval (Info.context info) (Engine.install info jobs) in
    let build_dir = Fpath.parent args.config_file in
    match kind with
    | `Name -> Fmt.pr "%s\n%!" (Info.name info)
    | `Packages ->
        let pkgs = Info.packages info in
        List.iter (Fmt.pr "%a\n%!" (Package.pp ~surround:"\"")) pkgs
    | `Opam ->
        let opam_name = Misc.Name.(Opam.to_string (opamify name)) in
        let opam = Info.opam ~extra_repo ~install ~opam_name info in
        Fmt.pr "%a\n%!" Opam.pp opam
    | `Files ->
        let files = files info jobs in
        Fmt.pr "%a\n%!" Fmt.(list ~sep:(any " ") Fpath.pp) files
    | `Makefile ->
        let file =
          Makefile.v ~build_dir ~depext ~builder_name:P.name ~extra_repo
            ~config_file:args.config_file (Misc.Name.opamify name)
        in
        Fmt.pr "%a\n%!" Makefile.pp file
    | `Dune `Config ->
        let cwd = Bos.OS.Dir.current () |> Result.get_ok in
        let config_ml_file = Fpath.(cwd // args.Cli.config_file) in
        let dune =
          Dune.base ~config_ml_file ~packages:P.packages ~name:P.name
            ~version:P.version
        in
        Fmt.pr "%a\n%!" Dune.pp dune
    | `Dune `Build ->
        let dune_copy_config = Dune.stanzaf "(copy_files ./config/*)" in
        let dune = Dune.v (dune_copy_config :: Engine.dune info jobs) in
        Fmt.pr "%a\n%!" Dune.pp dune
    | `Dune `Project ->
        let dune =
          Dune.v
            (Dune.base_project
            @ (Dune.stanzaf "(name %s)" name :: P.dune_project))
        in
        Fmt.pr "%a\n%!" Dune.pp dune
    | `Dune `Workspace ->
        let dune =
          match P.dune_workspace with
          | None -> Dune.base_workspace
          | Some f -> f ~build_dir info
        in
        Fmt.pr "%a\n%!" Dune.pp dune
    | `Dune `Dist ->
        let install = Key.eval (Info.context info) (Engine.install info jobs) in
        Fmt.pr "%a\n%!" Dune.pp
          (Install.dune ~context_name_for_bin:(P.context_name info)
             ~context_name_for_etc:"default" install)

(* Configuration step. *)

let generate_opam ~opam_name ~extra_repo (args : _ Cli.args) () =
    let { Config.info; jobs; _ } = args.Cli.context in
    let install = Key.eval (Info.context info) (Engine.install info jobs) in
    let name = Misc.Name.Opam.to_string opam_name in
    let opam = Info.opam ~install ~extra_repo ~opam_name:name info in
    let contents = Fmt.str "%a" Opam.pp opam in
    let file = Fpath.(v (name ^ ".opam")) in
    Log.info (fun m ->
        m "Generating: %a (%a)" Fpath.pp file Cli.pp_query_kind `Opam);
    Filegen.write file contents

let generate_dune alias (args : _ Cli.args) () =
    let { Config.info; jobs; _ } = args.Cli.context in
    let name = P.name_of_target info in
    let build_dir = build_dir args in
    let file =
      match alias with
      | `Dist -> Fpath.(v "dune")
      | `Build -> Fpath.(v "dune.build")
      | `Workspace -> Fpath.(v "dune-workspace")
      | `Project -> Fpath.(v "dune-project")
    in
    Log.info (fun m ->
        m "Generating: %a (%a)" Fpath.pp file Cli.pp_query_kind
          (`Dune alias :> Cli.query_kind));
    let contents =
      match alias with
      | `Build ->
          let import_config = Dune.stanzaf "(copy_files ./%s/*)" P.name in
          let dune = Dune.v (import_config :: Engine.dune info jobs) in
          Fmt.str "%a\n" Dune.pp dune
      | `Project ->
          let dune =
            Dune.v
              (Dune.base_project
              @ (Dune.stanzaf "(name %s)" name :: P.dune_project))
          in
          Fmt.str "%a\n" Dune.pp dune
      | `Workspace ->
          let dune =
            match P.dune_workspace with
            | None -> Dune.base_workspace
            | Some f -> f ~build_dir info
          in
          Fmt.str "%a\n" Dune.pp dune
      | `Dist ->
          let install =
            Key.eval (Info.context info) (Engine.install info jobs)
          in
          Fmt.str "%a\n" Dune.pp
            (Install.dune ~context_name_for_bin:(P.context_name info)
               ~context_name_for_etc:"default" install)
    in
    Filegen.write file contents

let clean (args : _ Cli.clean_args) =
    let* () = Action.rmdir (mirage_dir args) in
    Action.rmdir (artifacts_dir args)

let generate_makefile ~build_dir ~depext ~extra_repo ~config_file opam_name =
    let file = Fpath.(v "Makefile") in
    let contents =
      Fmt.to_to_string Makefile.pp
        (Makefile.v ~build_dir ~depext ~builder_name:P.name ~extra_repo
           ~config_file opam_name)
    in
    Filegen.write file contents

let configure ({ args; depext; extra_repo; _ } : _ Cli.configure_args) =
    let { Config.init; info; device_graph; _ } = args.Cli.context in
    (* Get application name *)
    let build_dir = build_dir args in
    let name = P.name_of_target info in
    let opam_name = Misc.Name.opamify name in
    let config_file = args.config_file in
    let* () =
      generate_makefile ~build_dir ~depext ~extra_repo ~config_file opam_name
    in
    let* _ = Action.mkdir (mirage_dir args) in
    let* () =
      Action.with_dir (mirage_dir args) (fun () ->
          (* OPAM file *)
          let* () = generate_opam ~opam_name ~extra_repo args () in
          (* Generate application specific-files *)
          Log.info (fun m -> m "in dir %a" (Cli.pp_args (fun _ _ -> ())) args);
          configure_main info init device_graph)
    in
    let* () =
      Action.with_dir build_dir (fun () ->
          let* () = generate_dune `Build args () in
          Filegen.write Fpath.(v "dune") "(include dune.build)")
    in
    (* dune-workspace: defines compilation contexts *)
    let* () = generate_dune `Workspace args () in
    (* dune-project *)
    let* () = generate_dune `Project args () in
    (* Get install spec *)
    let* _ = Action.mkdir (artifacts_dir args) in
    Action.with_dir (artifacts_dir args) (generate_dune `Dist args)

let ok () = Action.ok ()
  let exit () = Action.error ""

let with_output args =
    match args.Cli.output with
    | None -> args
    | Some o ->
        let r = args.Cli.context in
        let info = Info.with_output r.Config.info o in
        { args with context = { r with info } }

let pp_info (f : ('a, Format.formatter, unit) format -> 'a) level args =
    let verbose = Logs.level () >= level in
    f "@[<v>%a@]" (Info.pp verbose) args.Cli.context.Config.info

let action_run args a =
    if not args.Cli.dry_run then Action.run a
    else
      let exec cmd =
        match Bos.Cmd.to_list cmd with
        | [ "opam"; "config"; "var"; "prefix" ] -> Some ("$prefix", "")
        | _ -> Action.default_exec cmd
      in
      let env = Action.env ~files:(`Passtrough (Fpath.v ".")) ~exec () in
      let dom = Action.dry_run ~env a in
      List.iter
        (fun line ->
          Fmt.epr "%a %s\n%!" Fmt.(styled (`Fg `Cyan) string) "*" line)
        dom.logs;
      dom.result

let read_context args =
    match args.Cli.context_file with
    | None -> Action.ok Context_cache.empty
    | Some file ->
        let* is_file = Action.is_file file in
        if is_file then Context_cache.read file
        else Action.errorf "cannot find file `%a'" Fpath.pp file

let run_configure_with_argv argv args config =
    (*   whether to fully evaluate the graph *)
    let full_eval = Cli.peek_full_eval argv in

let* cache = read_context args in
    let base_context =
      (* Consider only the non-required keys. *)
      let non_required_term =
        let if_keys = Config.keys config in
        Key.context ~stage:`Configure ~with_required:false if_keys
      in
      let context =
        match Cmdliner.Cmd.eval_peek_opts ~argv non_required_term with
        | _, Ok (`Ok context) -> context
        | _ -> Key.empty_context
      in
      match Context_cache.peek cache non_required_term with
      | None -> context
      | Some default -> Key.merge_context ~default context
    in
    let output = Cli.peek_output argv in

(* 3. Parse the command-line and handle the result. *)
    let configure =
      eval_cached ~with_required:true ~full:true ~output ~cache base_context
        config
    in

let describe =
      let full =
        match full_eval with
        | None -> not (Context_cache.is_empty cache)
        | Some b -> b
      in
      eval_cached ~with_required:false ~full ~output ~cache base_context config
    in

let build =
      eval_cached ~with_required:false ~full:true ~output ~cache base_context
        config
    in
    let clean = build in
    let query = build in
    let help = build in

handle_parse_args_result
      (Cli.eval ~name:P.name ~version:P.version ~configure ~query ~describe
         ~build ~clean ~help ~mname:P.name argv)

let register ?packages ?keys ?(init = default_init) ?(src = `Auto) name jobs =
    (* 1. Pre-parse the arguments set the log level, config file
       and root directory. *)
    let argv = Sys.argv in
    (* TODO: do not are parse the command-line twice *)
    let args =
      (* tool.ml made sure that global arguments are correctly parsed before
         running config.exe*)
      Cli.peek_args ~with_setup:true ~mname:P.name argv |> Option.get
    in
    let config_file = config_file args in
    let run () =
      let configure_cmd, pre_build_cmd, lock_location, build_cmd =
        get_build_cmd args
      in
      let main_dev = P.create (init @ jobs) in
      let c =
        Config.v ~config_file ?keys ?packages ~init ~configure_cmd
          ~pre_build_cmd ~lock_location ~build_cmd ~src name main_dev
      in
      run_configure_with_argv argv args c
    in
    run () |> action_run args |> exit_err args
end
07070100000030000081A40000000000000000000000016491641000000B51000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/lib.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Application builder. API for building libraries to link with [config.ml] *)

(** {1 Builders} *)

(** [S] is the signature that application builders have to provide. *)
module type S = sig
  open DSL

val prelude : Info.t -> string
  (** Prelude printed at the beginning of [main.ml].

It should put in scope:

- a [run] function of type ['a t -> 'a]
      - a [return] function of type ['a -> 'a t]
      - a [>>=] operator of type ['a t -> ('a -> 'b t) -> 'b t] *)

val packages : Package.t list
  (** The packages to load when compiling the configuration file. *)

val name : string
  (** Name of the custom DSL. *)

val version : string
  (** Version of the custom DSL. *)

val create : job impl list -> job impl
  (** [create jobs] is the top-level job in the custom DSL which will execute
      the given list of [job]. *)

val name_of_target : Info.t -> string
  (** [name_of_target i] is the name used to build the project with the build
      info [i]. For simple projects it can be [Info.name]. For more complex
      projects (like [mirage]), the name is suffixed by the value of the target
      key defined in [i]. *)

val dune_project : Dune.stanza list
  val dune_workspace : (?build_dir:Fpath.t -> info -> Dune.t) option
  val context_name : Info.t -> string
end

module Make (P : S) : sig
  open DSL

(** Configuration builder: stage 1 *)

val register :
    ?packages:package list ->
    ?keys:abstract_key list ->
    ?init:job impl list ->
    ?src:[ `Auto | `None | `Some of string ] ->
    string ->
    job impl list ->
    unit
  (** [register name jobs] registers the application named by [name] which will
      execute the given [jobs]. Same optional arguments as {!module-DSL.main}.

[init] is the list of job to execute before anything else (such as
      command-line argument parsing, log reporter setup, etc.). The jobs are
      always executed in the sequence specified by the caller. *)
end
07070100000031000081A4000000000000000000000001649164100000139B000000000000000000000000000000000000002700000000mirage-4.4.0/lib/functoria/makefile.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type t = {
  depext : bool;
  build_dir : Fpath.t;
  builder_name : string;
  unikernel_opam_name : Misc.Name.Opam.t;
  extra_repo : (string * string) list;
  config_file : Fpath.t;
}

let v ?(extra_repo = []) ~build_dir ~builder_name ~depext ~config_file
    unikernel_opam_name =
  {
    depext;
    build_dir;
    builder_name;
    unikernel_opam_name;
    extra_repo;
    config_file;
  }

let depext_rules =
  {|
depext-lockfile: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
	echo " ↳ install external dependencies for monorepo"
	env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo depext -y -l $<
|}

let opam_repo_add_rule extra =
  let buf = Buffer.create 0x100 in
  let ppf = Format.formatter_of_buffer buf in
  Fmt.pf ppf
    {|repo-add:
	@@printf "\e[2musing overlay repository mirage: %a \e[0m\n"
|}
    Fmt.(brackets (list ~sep:(any ", ") (using fst string)))
    extra;
  List.iter
    (fun (name, repo) ->
      Fmt.pf ppf "\t$(OPAM) repo add %s %s || $(OPAM) repo set-url %s %s\n" name
        repo name repo)
    extra;
  Buffer.contents buf

let opam_repo_remove_rule extra =
  let buf = Buffer.create 0x100 in
  let ppf = Format.formatter_of_buffer buf in
  Fmt.pf ppf
    {|repo-rm:
	@@printf "\e[2mremoving overlay repository %a\e[0m\n"
|}
    Fmt.(brackets (list ~sep:(any ", ") (using fst string)))
    extra;
  List.iter
    (fun (name, repo) -> Fmt.pf ppf "\t$(OPAM) repo remove %s %s\n" name repo)
    extra;
  Buffer.contents buf

let pp_extra_rules ppf t =
  let rules, targets =
    match t.depext with
    | true -> ([ depext_rules ], [ "depext-lockfile" ])
    | false -> ([], [])
  in
  let rules, targets =
    match t.extra_repo with
    | _ :: _ as extra ->
        ( opam_repo_add_rule extra :: opam_repo_remove_rule extra :: rules,
          "repo-add" :: "repo-rm" :: targets )
    | [] -> (rules, targets)
  in
  match rules with
  | [] -> ()
  | _ ->
      Fmt.pf ppf " %a\n\n"
        (Fmt.list ~sep:(fun ppf () -> Fmt.pf ppf " ") Fmt.string)
        targets;
      Fmt.pf ppf "%a"
        (Fmt.list ~sep:(fun ppf () -> Fmt.pf ppf "\n\n") Fmt.string)
        rules

let pp ppf t =
  let mirage_dir = Fpath.(t.build_dir / t.builder_name) in
  let pp_depext_lockfile ppf = function
    | true -> Fmt.string ppf "\n\t@$(MAKE) -s depext-lockfile"
    | false -> ()
  and pp_no_depext ppf = function
    | true -> ()
    | false -> Fmt.string ppf " --no-depexts"
  and pp_add_repo ppf = function
    | _ :: _ -> Fmt.string ppf "\n\t@$(MAKE) -s repo-add"
    | [] -> ()
  and pp_or_remove_repo ppf = function
    | _ :: _ -> Fmt.string ppf "; (ret=$$?; $(MAKE) -s repo-rm && exit $$ret)"
    | [] -> ()
  in
  Fmt.pf ppf
    {|-include Makefile.user
BUILD_DIR = %a
MIRAGE_DIR = %a
UNIKERNEL_NAME = %s
OPAM = opam

all::
	@@$(MAKE) --no-print-directory depends
	@@$(MAKE) --no-print-directory build

.PHONY: all lock install-switch pull clean depend depends build%a

$(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam%a
	@@echo " ↳ generate lockfile for monorepo dependencies"
	@@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo lock --require-cross-compile --build-only $(UNIKERNEL_NAME) -l $@@ --ocaml-version $(shell ocamlc --version)%a

lock::
	@@$(MAKE) -B $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked

pull:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
	@@echo " ↳ fetch monorepo dependencies in the duniverse folder"
	@@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo pull -l $< -r $(abspath $(BUILD_DIR))

install-switch:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
	@@echo " ↳ opam install switch dependencies"
	@@$(OPAM) install $< --deps-only --yes%a%a

depends depend::
	@@$(MAKE) --no-print-directory lock
	@@$(MAKE) --no-print-directory install-switch
	@@$(MAKE) --no-print-directory pull

build::
	mirage build -f %a

clean::
	mirage clean
|}
    Fpath.pp t.build_dir Fpath.pp mirage_dir
    (Misc.Name.Opam.to_string t.unikernel_opam_name)
    pp_extra_rules t pp_add_repo t.extra_repo pp_or_remove_repo t.extra_repo
    pp_no_depext t.depext pp_depext_lockfile t.depext Fpath.pp t.config_file
07070100000032000081A40000000000000000000000016491641000000461000000000000000000000000000000000000002800000000mirage-4.4.0/lib/functoria/makefile.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type t

val v :
  ?extra_repo:(string * string) list ->
  build_dir:Fpath.t ->
  builder_name:string ->
  depext:bool ->
  config_file:Fpath.t ->
  Misc.Name.Opam.t ->
  t

val pp : t Fmt.t
07070100000033000081A400000000000000000000000164916410000007FD000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/misc.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Rresult
open Astring

let err_cmdliner ?(usage = false) = function
  | Ok x -> `Ok x
  | Error s -> `Error (usage, s)

module type Monoid = sig
  type t

val empty : t
  val union : t -> t -> t
end

(* {Misc informations} *)

module Name = struct
  module Opam = struct
    type t = string

let to_string = Fun.id
  end

let opamify s =
    let b = Buffer.create (String.length s) in
    String.iter
      (function
        | ('a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-') as c ->
            Buffer.add_char b c
        | '.' -> Buffer.add_char b '_'
        | _ -> ())
      s;
    let s' = Buffer.contents b in
    if String.length s' = 0 then raise (Invalid_argument s);
    s'

let ocamlify s =
    let b = Buffer.create (String.length s) in
    String.iter
      (function
        | ('a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_') as c ->
            Buffer.add_char b c
        | '-' | '.' -> Buffer.add_char b '_'
        | _ -> ())
      s;
    let s' = Buffer.contents b in
    if String.length s' = 0 || ('0' <= s'.[0] && s'.[0] <= '9') then
      raise (Invalid_argument s);
    s'
end
07070100000034000081A4000000000000000000000001649164100000051B000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/misc.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Utility module. *)

(** {2 Misc} *)

open Rresult

val err_cmdliner : ?usage:bool -> ('a, string) result -> 'a Cmdliner.Term.ret

module type Monoid = sig
  type t

val empty : t
  val union : t -> t -> t
end

module Name : sig
  module Opam : sig
    type t

val to_string : t -> string
  end

val opamify : string -> Opam.t
  val ocamlify : string -> string
end
07070100000035000081A40000000000000000000000016491641000001F1D000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/opam.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Action.Syntax

let find_git () =
  let is_git p = Action.is_dir Fpath.(p / ".git") in
  let app_opt p d = match p with None -> d | Some p -> Fpath.(d // p) in
  let rec find p path =
    if Fpath.is_root p then Action.ok None
    else
      let* has_git = is_git p in
      if has_git then Action.ok (Some path)
      else find (Fpath.parent p) (Some (app_opt path (Fpath.base p)))
  in
  let* cwd = Action.pwd () in
  (* this is invoked from within the mirage subdirectory *)
  let* cwd = find (Fpath.parent cwd) None in
  match cwd with
  | None -> Action.ok None
  | Some subdir ->
      let git_branch =
        Bos.Cmd.(v "git" % "rev-parse" % "--abbrev-ref" % "HEAD")
      in
      let* branch = Action.(run_cmd_out ~err:`Null git_branch) in
      let git_remote = Bos.Cmd.(v "git" % "remote" % "get-url" % "origin") in
      let+ git_url = Action.(run_cmd_out ~err:`Null git_remote) in
      Some (subdir, branch, git_url)

module Endpoint = struct
  type t = {
    scheme : [ `SSH of string | `Git | `HTTP | `HTTPS | `Scheme of string ];
    port : int option;
    path : string;
    hostname : string;
  }

let of_string str =
    let open Rresult in
    let parse_ssh str =
      let len = String.length str in
      Emile.of_string_raw ~off:0 ~len str
      |> R.reword_error (R.msgf "%a" Emile.pp_error)
      >>= fun (consumed, m) ->
      match
        Astring.String.cut ~sep:":" (String.sub str consumed (len - consumed))
      with
      | Some ("", path) ->
          let local =
            List.map
              (function `Atom x -> x | `String x -> Fmt.str "%S" x)
              m.Emile.local
          in
          let user = String.concat "." local in
          let hostname =
            match fst m.Emile.domain with
            | `Domain vs -> String.concat "." vs
            | `Literal v -> v
            | `Addr (Emile.IPv4 v) -> Ipaddr.V4.to_string v
            | `Addr (Emile.IPv6 v) -> Ipaddr.V6.to_string v
            | `Addr (Emile.Ext (k, v)) -> Fmt.str "%s:%s" k v
          in
          R.ok { scheme = `SSH user; path; port = None; hostname }
      | _ -> R.error_msg "Invalid SSH pattern"
    in
    let parse_uri str =
      let uri = Uri.of_string str in
      let path = Uri.path uri in
      match (Uri.scheme uri, Uri.host uri, Uri.port uri) with
      | Some "git", Some hostname, port ->
          R.ok { scheme = `Git; path; port; hostname }
      | Some "http", Some hostname, port ->
          R.ok { scheme = `HTTP; path; port; hostname }
      | Some "https", Some hostname, port ->
          R.ok { scheme = `HTTPS; path; port; hostname }
      | Some scheme, Some hostname, port ->
          R.ok { scheme = `Scheme scheme; path; port; hostname }
      | _ -> R.error_msgf "Invalid uri: %a" Uri.pp uri
    in
    match (parse_ssh str, parse_uri str) with
    | Ok v, _ -> Ok v
    | _, Ok v -> Ok v
    | Error _, Error _ -> R.error_msgf "Invalid endpoint: %s" str
end

let guess_src () =
  let git_info =
    match Action.run @@ find_git () with
    | Error _ | Ok None -> None
    | Ok (Some (subdir, branch, git_url)) -> Some (subdir, branch, git_url)
  in
  match git_info with
  | None -> (None, None)
  | Some (subdir, branch, origin) ->
      (* TODO is there a library for git urls anywhere? *)
      let public =
        match Endpoint.of_string origin with
        | Ok
            { Endpoint.scheme = `Scheme scheme; port = None; path; hostname; _ }
          ->
            Fmt.str "%s://%s/%s" scheme hostname path
        | Ok
            {
              Endpoint.scheme = `Scheme scheme;
              port = Some port;
              path;
              hostname;
              _;
            } ->
            Fmt.str "%s://%s:%d/%s" scheme hostname port path
        | Ok { Endpoint.port = None; path; hostname; _ } ->
            Fmt.str "git+https://%s/%s" hostname path
        | Ok { Endpoint.port = Some port; path; hostname; _ } ->
            Fmt.str "git+https://%s:%d/%s" hostname port path
        | _ -> "git+https://invalid/endpoint"
      in
      (subdir, Some (Fmt.str "%s#%s" public branch))

type t = {
  name : string;
  depends : Package.t list;
  configure : string option;
  pre_build : (Fpath.t option -> string) option;
  lock_location : (Fpath.t option -> string -> string) option;
  build : string option;
  install : Install.t;
  extra_repo : (string * string) list;
  pins : (string * string) list;
  src : string option;
  subdir : Fpath.t option;
  opam_name : string;
}

let v ?configure ?pre_build ?lock_location ?build ?(install = Install.empty)
    ?(extra_repo = []) ?(depends = []) ?(pins = []) ?subdir ~src ~opam_name name
    =
  let subdir, src =
    match src with
    | `Auto ->
        let subdir', src = guess_src () in
        ((match subdir with None -> subdir' | Some _ as s -> s), src)
    | `None -> (subdir, None)
    | `Some d -> (subdir, Some d)
  in
  {
    name;
    depends;
    configure;
    pre_build;
    lock_location;
    build;
    install;
    extra_repo;
    pins;
    src;
    subdir;
    opam_name;
  }

let pp_packages ppf packages =
  Fmt.pf ppf "\n  %a\n"
    Fmt.(list ~sep:(any "\n  ") (Package.pp ~surround:"\""))
    packages

let pp_pins ppf = function
  | [] -> ()
  | pins ->
      let pp_pin ppf (package, url) = Fmt.pf ppf "[\"%s\" %S]" package url in
      Fmt.pf ppf "@.pin-depends: [ @[<hv>%a@]@ ]@."
        Fmt.(list ~sep:(any "@ ") pp_pin)
        pins

let pp_src ppf = function
  | None -> ()
  | Some src -> Fmt.pf ppf {|@.url { src: %S }|} src

let pp_switch_package ppf s = Fmt.pf ppf "%S" s

let pp ppf t =
  let pp_build = function
    | None -> ""
    | Some cmd ->
        Fmt.str {|"sh" "-exc" "%a%s"|}
          Fmt.(option ~none:(any "") (any "cd " ++ Fpath.pp ++ any " && "))
          t.subdir cmd
  in
  let pp_pre_build ppf pre_build =
    match pre_build with None -> () | Some f -> Fmt.string ppf (f t.subdir)
  in
  let pp_repo =
    Fmt.(
      list ~sep:(any "\n")
        (brackets (pair ~sep:(any " ") (quote string) (quote string))))
  in
  let switch_packages =
    List.filter_map
      (fun p ->
        match Package.scope p with
        | `Switch -> Some (Package.name p)
        | `Monorepo -> None)
      t.depends
  in
  Fmt.pf ppf
    {|opam-version: "2.0"
maintainer: "dummy"
authors: "dummy"
homepage: "dummy"
bug-reports: "dummy"
dev-repo: "git://dummy"
synopsis: "Unikernel %s - switch dependencies"
description: """
It assumes that local dependencies are already
fetched.
"""

build: [%s]

install: [%a]

depends: [%a]

x-mirage-opam-lock-location: %S

x-mirage-configure: [%s]

x-mirage-pre-build: [%a]

x-mirage-extra-repo: [%a]

x-opam-monorepo-opam-provided: [%a]
%a%a|}
    t.name (pp_build t.build)
    (Install.pp_opam ?subdir:t.subdir ())
    t.install pp_packages t.depends
    (Option.fold ~none:""
       ~some:(fun l -> l t.subdir t.opam_name)
       t.lock_location)
    (pp_build t.configure) pp_pre_build t.pre_build pp_repo t.extra_repo
    (Fmt.list pp_switch_package)
    switch_packages pp_src t.src pp_pins t.pins
07070100000036000081A4000000000000000000000001649164100000053A000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/opam.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type t

val v :
  ?configure:string ->
  ?pre_build:(Fpath.t option -> string) ->
  ?lock_location:(Fpath.t option -> string -> string) ->
  ?build:string ->
  ?install:Install.t ->
  ?extra_repo:(string * string) list ->
  ?depends:Package.t list ->
  ?pins:(string * string) list ->
  ?subdir:Fpath.t ->
  src:[ `Auto | `None | `Some of string ] ->
  opam_name:string ->
  string ->
  t

val pp : t Fmt.t
07070100000037000081A4000000000000000000000001649164100000109C000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/package.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring

type scope = [ `Switch | `Monorepo ]

type t = {
  name : string;
  pin : (string * string) option;  (** [name_version * url] *)
  scope : scope;
  build : bool;
  libs : String.Set.t;
  min : String.Set.t;
  max : String.Set.t;
}

let name t = t.name

let key t =
  match t.scope with
  | `Switch -> "switch-" ^ t.name
  | `Monorepo -> "monorepo-" ^ t.name

let pin t = t.pin
let build_dependency t = t.build
let scope t = t.scope
let libraries t = String.Set.elements t.libs
let min_versions t = String.Set.elements t.min
let max_versions t = String.Set.elements t.max

let merge a b =
  if a.name <> b.name then None
  else if a.scope <> b.scope then None
  else
    let name = a.name in
    let libs = String.Set.union a.libs b.libs
    and min = String.Set.union a.min b.min
    and max = String.Set.union a.max b.max
    and pin =
      match (a.pin, b.pin) with
      | None, None -> None
      | None, Some a | Some a, None -> Some a
      | Some (an, au), Some (bn, bu)
        when String.equal an au && String.equal bn bu ->
          a.pin
      | _ -> invalid_arg ("conflicting pin depends for " ^ name)
    and build = a.build || b.build
    and scope = a.scope in
    match pin with
    | None -> Some { name; build; scope; libs; min; max; pin }
    | Some _ ->
        (* pin wins over min and max *)
        let empty = String.Set.empty in
        Some { name; build; scope; libs; min = empty; max = empty; pin }

let package_name_is_valid name =
  let has_letter = String.exists Char.Ascii.is_letter name in
  let only_allowed_chars =
    String.for_all
      (function
        | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true | _ -> false)
      name
  in
  only_allowed_chars && has_letter

let v ?(scope = `Monorepo) ?(build = false) ?sublibs ?libs ?min ?max ?pin
    ?(pin_version = "dev") name =
  if not (package_name_is_valid name) then
    Fmt.invalid_arg "package name %S is invalid" name;
  let libs =
    match (sublibs, libs) with
    | None, None -> [ name ]
    | Some xs, None -> List.map (fun x -> name ^ "." ^ x) xs
    | None, Some a -> a
    | Some _, Some _ ->
        Fmt.invalid_arg
          "dependent package %s may either specify ~sublibs or ~ocamlfind" name
  in
  let libs = String.Set.of_list libs in
  let to_set = function
    | None -> String.Set.empty
    | Some m -> String.Set.singleton m
  in
  let min = to_set min
  and max = to_set max
  and pin =
    match pin with Some p -> Some (name ^ "." ^ pin_version, p) | None -> None
  in
  { name; build; scope; libs; min; max; pin }

let with_scope ~scope t = { t with scope }

let exts_to_string ppf (min, max, build, scope) =
  let build_strs = if build then [ "build" ] else [] in
  let esc_prefix prefix e = Fmt.str "%s %S" prefix e in
  let min_strs = List.map (esc_prefix ">=") (String.Set.elements min)
  and max_strs = List.map (esc_prefix "<") (String.Set.elements max) in
  let constr_list = build_strs @ min_strs @ max_strs in
  let constr_list =
    match scope with
    | `Monorepo -> "?monorepo" :: constr_list
    | `Switch -> constr_list
  in
  if List.length constr_list > 0 then
    Fmt.pf ppf " { %s }" (String.concat ~sep:" & " constr_list)

let pp ?(surround = "") ppf p =
  Fmt.pf ppf "%s%s%s%a" surround p.name surround exts_to_string
    (p.min, p.max, p.build, p.scope)
07070100000038000081A40000000000000000000000016491641000000D59000000000000000000000000000000000000002700000000mirage-4.4.0/lib/functoria/package.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Representation of opam packages. *)

type scope = [ `Switch | `Monorepo ]
(** The scope of package installation:

- Switch: installed with opam.
    - Monorepo: locally fetched along unikernel sources. *)

type t
(** The type for opam packages. *)

val v :
  ?scope:scope ->
  ?build:bool ->
  ?sublibs:string list ->
  ?libs:string list ->
  ?min:string ->
  ?max:string ->
  ?pin:string ->
  ?pin_version:string ->
  string ->
  t
(** [v ~scope ~build ~sublibs ~libs ~min ~max ~pin opam] is a [package]. [Build]
    indicates a build-time dependency only, defaults to [false]. The library
    name is by default the same as [opam], you can specify [~sublibs] to add
    additional sublibraries (e.g. [~sublibs:\["mirage"\] "foo"] will result in
    the library names [\["foo"; "foo.mirage"\]]. In case the library name is
    disjoint (or empty), use [~libs]. Specifying both [~libs] and [~sublibs]
    leads to an invalid argument. Version constraints are given as [min]
    (inclusive) and [max] (exclusive). If [pin] is provided, a
    {{:https://opam.ocaml.org/doc/Manual.html#opamfield-pin-depends}
      pin-depends} is generated, [pin_version] is ["dev"] by default. [~scope]
    specifies the installation location of the package. *)

val with_scope : scope:scope -> t -> t
(** [with_scope t] returns t with chosen installation location.*)

val name : t -> string
(** [name t] is [t]'s opam name. *)

val key : t -> string
(** [key t] is [t]'s key (concatenation of name and installation scope). *)

val scope : t -> scope
(** [scope t] is [t]'s installation scope. *)

val pin : t -> (string * string) option
(** [pin t] is [Some (name_version, r)] iff [t] is pinned to the repository [r]. *)

val build_dependency : t -> bool
(** [build_dependency t] is [true] iff [t] is a build-time dependency. *)

val libraries : t -> string list
(** [libraries t] is the set of libraries (and sub-libraries) used in the
    package [t]. For most packages, it will only contain one library whose name
    is [name t]. *)

val max_versions : t -> string list
(** [max_versions] is the set of maximum versions of [t] which are required. *)

val min_versions : t -> string list
(** [min_versions] is the set minimum versions of [t] which are required. *)

val merge : t -> t -> t option
(** [merge x y] is merges the information of [x] and [y]. The result is [None]
    if [name x != name y]. *)

val pp : ?surround:string -> t Fmt.t
(** [pp] is the pretty-printer for packages. *)
07070100000039000081A4000000000000000000000001649164100000276D000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/tool.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Action.Syntax
open DSL

let src = Logs.Src.create "functoria.tool" ~doc:"functoria library"

module Log = (val Logs.src_log src : Logs.LOG)

module type S = sig
  val name : string
  val version : string
  val packages : package list
  val create : job impl list -> job impl
end

module Make (P : S) = struct
  module Filegen = Filegen.Make (P)

let build_dir t = Fpath.parent t.Cli.config_file
  let context_file t = Context_cache.file ~name:P.name t

let add_context_file t argv =
    match t.Cli.context_file with
    | Some _ -> Action.ok argv
    | None ->
        let file = context_file t in
        let+ is_file = Action.is_file file in
        if is_file then
          Array.append argv [| "--context"; Fpath.to_string file |]
        else (* should only happen when doing configure --help *) argv

let run_cmd ?ppf ?err_ppf command =
    let err = match err_ppf with None -> None | Some f -> Some (`Fmt f) in
    let out = match ppf with None -> None | Some f -> Some (`Fmt f) in
    Action.run_cmd ?err ?out command

let re_exec_cli t argv =
    let* argv = add_context_file t argv in
    let args = Bos.Cmd.of_list (List.tl (Array.to_list argv)) in
    let config_exe =
      Fpath.(v "_build" / "default" // build_dir t / "config.exe")
    in
    let command = Bos.Cmd.(v (p config_exe) %% args) in
    Action.run_cmd_cli command

(* Generate the base dune and dune-project files *)
  let generate_base_dune t =
    let dune_config_path = Fpath.(build_dir t / "dune.config") in
    Log.info (fun m -> m "Generating: %a (base)" Fpath.pp dune_config_path);
    let dune_config =
      Dune.base ~config_ml_file:t.Cli.config_file ~packages:P.packages
        ~name:P.name ~version:P.version
    in
    let dune_config = Fmt.str "%a\n%!" Dune.pp dune_config in
    let* () = Filegen.write dune_config_path dune_config in
    let dune_path = Fpath.(build_dir t / "dune") in
    let dune = Fmt.str "(include dune.config)" in
    Filegen.write dune_path dune

let dune_workspace_path t =
    Fpath.(build_dir t / P.name / "dune-workspace.config")

let generate_base_dune_workspace t =
    let dune_workspace_path = dune_workspace_path t in
    Log.info (fun m -> m "Generating: %a (base)" Fpath.pp dune_workspace_path);
    let dune = Dune.base_workspace in
    let dune = Fmt.str "%a\n%!" Dune.pp dune in
    Filegen.write dune_workspace_path dune

let generate_base_dune_project () =
    let dune_project_path = Fpath.(v "dune-project") in
    Log.info (fun m -> m "Generating: %a (base)" Fpath.pp dune_project_path);
    let dune = Dune.v Dune.base_project in
    let dune = Fmt.str "%a\n%!" Dune.pp dune in
    Filegen.write dune_project_path dune

let build_config_exe t ?ppf ?err_ppf () =
    let dune_workspace_path = dune_workspace_path t in
    let command =
      Bos.Cmd.(
        v "dune"
        % "build"
        % p Fpath.(build_dir t / "config.exe")
        % "--root"
        % "."
        % "--workspace"
        % p dune_workspace_path)
    in
    run_cmd ?ppf ?err_ppf command

let write_context t argv = Context_cache.write (context_file t) argv
  let remove_context t = Action.rm (context_file t)

(* Generated a project skeleton and try to compile config.exe. *)
  let generate_project_skeleton ~save_args t ?ppf ?err_ppf argv =
    let* _ = Action.mkdir Fpath.(build_dir t / P.name) in
    let* () = generate_base_dune_workspace t in
    let* () = generate_base_dune_project () in
    let* () = generate_base_dune t in
    let* () = if save_args then write_context t argv else Action.ok () in
    (* try to compile config.exe to detect early compilation errors. *)
    build_config_exe t ?ppf ?err_ppf ()

let exit_err t = function
    | Ok v -> v
    | Error (`Msg m) ->
        flush_all ();
        if m <> "" then Fmt.epr "%a\n%!" Fmt.(styled (`Fg `Red) string) m;
        if not t.Cli.dry_run then exit 1 else Fmt.epr "(exit 1)\n%!"

let handle_parse_args_no_config ?help_ppf ?err_ppf (`Msg error) argv =
    let context =
      (* Extract all the keys directly. Useful to pre-resolve the keys
         provided by the specialized DSL. *)
      let base_keys = Engine.all_keys @@ Impl.abstract @@ P.create [] in
      Cmdliner.Term.(
        const (fun _ -> Action.ok ())
        $ Key.context base_keys ~with_required:false ~stage:`Configure)
    in
    let result =
      Cli.eval ?help_ppf ?err_ppf ~name:P.name ~version:P.version
        ~configure:context ~query:context ~describe:context ~build:context
        ~clean:context ~help:context ~mname:P.name argv
    in
    let ok = Action.ok () in
    let error = Action.error error in
    match result with `Version | `Help | `Ok (Cli.Help _) -> ok | _ -> error

let with_project_skeleton ~save_args t ?ppf ?err_ppf argv f =
    let file = t.Cli.config_file in
    let* is_file = Action.is_file file in
    if not is_file then
      let msg = Fmt.str "configuration file %a missing" Fpath.pp file in
      handle_parse_args_no_config ?help_ppf:ppf ?err_ppf (`Msg msg) argv
    else
      let* () = generate_project_skeleton ~save_args t ?ppf ?err_ppf argv in
      f ()

let action_run t a =
    if not t.Cli.dry_run then Action.run a
    else
      let env = Action.env ~files:(`Passtrough (Fpath.v ".")) () in
      let dom = Action.dry_run ~env a in
      List.iter
        (fun line ->
          Fmt.epr "%a %s\n%!" Fmt.(styled (`Fg `Cyan) string) "*" line)
        dom.logs;
      dom.result

let clean_files ?ppf ?err_ppf args =
    let dune_clean () =
      let* var = Action.get_var "INSIDE_FUNCTORIA_TESTS" in
      match var with
      | Some "1" | Some "" -> Action.rm Fpath.(build_dir args / ".merlin")
      | _ -> run_cmd ?ppf ?err_ppf Bos.Cmd.(v "dune" % "clean")
    in
    let rm_gen_files () =
      let* files = Action.ls (Fpath.v ".") (fun _ -> true) in
      let files = List.sort Fpath.compare files in
      let files =
        List.filter_map
          (fun file ->
            if Fpath.parent file <> Fpath.v "./" then None
            else
              let base, ext = Fpath.split_ext file in
              let base = Fpath.basename base in
              match (base, ext) with
              | ("Makefile" | "dune-project" | "dune-workspace"), "" ->
                  Some file
              | _ ->
                  Logs.info (fun f -> f "Skipped %a" Fpath.pp file);
                  None)
          files
      in
      let* () = Action.List.iter ~f:Filegen.rm files in
      let* () = remove_context args in
      let* () = Filegen.rm Fpath.(build_dir args / "dune") in
      let* () = Filegen.rm Fpath.(build_dir args / "dune.build") in
      Filegen.rm Fpath.(build_dir args / "dune.config")
    in
    let* () = dune_clean () in
    rm_gen_files ()

(* App builder configuration *)
  let with_alias ~save_args args ~depext:_ ~extra_repo:_ ?ppf ?err_ppf argv =
    (* Files to build config.ml *)
    with_project_skeleton ~save_args args ?ppf ?err_ppf argv @@ fun () ->
    Log.info (fun f -> f "Set-up config skeleton.");
    (* Launch config.exe: additional generated files for the application. *)
    re_exec_cli args argv

let configure ({ args; depext; extra_repo } : _ Cli.configure_args) ?ppf
      ?err_ppf argv =
    with_alias ~save_args:true args ~depext ~extra_repo ?ppf ?err_ppf argv

let try_to_re_exec args ?ppf ?err_ppf argv =
    with_project_skeleton ~save_args:false args ?ppf ?err_ppf argv @@ fun () ->
    re_exec_cli args argv

let build (t : 'a Cli.build_args) = try_to_re_exec t
  let error t = try_to_re_exec t
  let query (t : 'a Cli.query_args) = try_to_re_exec t.args
  let describe (t : 'a Cli.describe_args) = try_to_re_exec t.args
  let help (t : 'a Cli.help_args) = try_to_re_exec t

let clean args ?ppf ?err_ppf argv =
    let config = args.Cli.config_file in
    let* () =
      let* is_file = Action.is_file config in
      if is_file then try_to_re_exec args ?ppf ?err_ppf argv else Action.ok ()
    in
    clean_files args

let run args action = action |> action_run args |> exit_err args
  let pp_unit _ _ = ()

let run_with_argv ?help_ppf ?err_ppf argv =
    let t = Cli.peek ~with_setup:true ~mname:P.name argv in
    match t with
    | `Version ->
        Log.info (fun l -> l "version");
        Fmt.pr "%s\n%!" P.version
    | `Error (Some t, _) ->
        Log.info (fun l -> l "error: %a" (Cli.pp_args pp_unit) t);
        run t @@ error t ?ppf:help_ppf ?err_ppf argv
    | `Error (None, _) ->
        let action =
          handle_parse_args_no_config ?help_ppf ?err_ppf (`Msg "") argv
        in
        let args = Cli.default_args in
        action_run args action |> exit_err args
    | `Ok t -> (
        Log.info (fun l -> l "run: %a" (Cli.pp_action pp_unit) t);
        let run = run (Cli.args t) in
        let ppf = help_ppf in
        match t with
        | Configure t -> run @@ configure t ?ppf ?err_ppf argv
        | Build t -> run @@ build t ?ppf ?err_ppf argv
        | Clean t -> run @@ clean t ?ppf ?err_ppf argv
        | Query t -> run @@ query t ?ppf ?err_ppf argv
        | Describe t -> run @@ describe t ?ppf ?err_ppf argv
        | Help t -> run @@ help t ?ppf ?err_ppf argv)

let run () = run_with_argv Sys.argv
end
0707010000003A000081A40000000000000000000000016491641000000736000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/tool.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Creation of CLI tools to assemble functors. *)

open DSL

module type S = sig
  val name : string
  (** Name of the tool. *)

val version : string
  (** Version of the tool. *)

val packages : package list
  (** The packages to load when compiling the configuration file. *)

val create : job impl list -> job impl
end

module Make (P : S) : sig
  val run : unit -> unit
  (** Run the configuration builder. This should be called exactly once to run
      the configuration builder: command-line arguments will be parsed, and some
      code will be generated and compiled. *)

val run_with_argv :
    ?help_ppf:Format.formatter ->
    ?err_ppf:Format.formatter ->
    string array ->
    unit
  (** [run_with_argv a] is the same as {!run} but parses [a] instead of the
      process command line arguments. It also allows to set the error and help
      channels using [help_ppf] and [err_ppf]. *)
end
0707010000003B000081A400000000000000000000000164916410000005B6000000000000000000000000000000000000002300000000mirage-4.4.0/lib/functoria/type.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type _ t =
  | Type : 'a -> 'a t (* module type *)
  | Function : 'a t * 'b t -> ('a -> 'b) t

let v x = Type x
let ( @-> ) f x = Function (f, x)

let rec pp : type a. a t Fmt.t =
 fun ppf -> function
  | Type _ -> Fmt.string ppf "_"
  | Function (a, b) -> Fmt.pf ppf "(%a -> %a)" pp a pp b

type job = JOB

let job = Type JOB

(* Default argv *)

type argv = ARGV

let argv = Type ARGV

(* Keys *)

type info = INFO

let info = Type INFO

let is_functor : type a. a t -> bool = function
  | Type _ -> false
  | Function _ -> true
0707010000003C000081A400000000000000000000000164916410000008BF000000000000000000000000000000000000002400000000mirage-4.4.0/lib/functoria/type.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Representation of module signatures. *)

(** The type for values representing module types. *)
type 'a t = Type : 'a -> 'a t | Function : 'a t * 'b t -> ('a -> 'b) t

val v : 'a -> 'a t
(** [type t] is a value representing the module type [t]. *)

val ( @-> ) : 'a t -> 'b t -> ('a -> 'b) t
(** [x @-> y] is the functor type from the module signature [x] to the module
    signature [y]. This corresponds to prepending a parameter to the list of
    functor parameters. For example:

{[
      kv_ro @-> ip @-> kv_ro
    ]}

This describes a functor type that accepts two arguments -- a [kv_ro] and an
    [ip] device -- and returns a [kv_ro]. *)

val is_functor : _ t -> bool
(** [is_functor t] is true if [t] has type [(a -> b) t]. *)

val pp : 'a t Fmt.t
(** [pp] is the pretty printer for module types. *)

(** {1 Useful module types} *)

type job
(** Type for job values. *)

val job : job t
(** [job] is the signature for user's application main module. *)

type argv
(** The type for command-line arguments, similar to the usual [Sys.argv]. *)

val argv : argv t
(** [argv] is a value representing {!type-argv} module types. *)

type info
(** The type for application about the application being built. *)

val info : info t
(** [info] is a value representing {!type-info} module types. *)
0707010000003D000081A40000000000000000000000016491641000000729000000000000000000000000000000000000002500000000mirage-4.4.0/lib/functoria/typeid.ml(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type (_, _) witness = Eq : ('a, 'a) witness | NotEq : ('a, 'b) witness

let to_bool : type a b. (a, b) witness -> bool = function
  | Eq -> true
  | NotEq -> false

module Id = struct
  type _ t = ..
end

module type ID = sig
  type t
  type _ Id.t += Tid : t Id.t

val id : int
end

type 'a t = (module ID with type t = 'a)

let gen_id =
  let r = ref 0 in
  fun () ->
    incr r;
    !r

let gen () (type s) =
  let module M = struct
    type t = s
    type _ Id.t += Tid : t Id.t

let id = gen_id ()
  end in
  (module M : ID with type t = s)

let witness : type r s. r t -> s t -> (r, s) witness =
 fun r s ->
  let module R = (val r : ID with type t = r) in
  let module S = (val s : ID with type t = s) in
  match R.Tid with S.Tid -> Eq | _ -> NotEq

let equal a b = to_bool @@ witness a b
let pp (type a) ppf ((module M) : a t) = Fmt.int ppf M.id
let id (type a) ((module M) : a t) = M.id
0707010000003E000081A400000000000000000000000164916410000006E6000000000000000000000000000000000000002600000000mirage-4.4.0/lib/functoria/typeid.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Typed identifiers and equality witnesses *)

type 'a t
(** A typed unique identifiers *)

val gen : unit -> 'a t
(** [gen ()] creates a new unique identifier. *)

val equal : 'r t -> 's t -> bool
(** [equal tid1 tid2] tests if [tid1] and [tid2] are equal. *)

val id : 'a t -> int
(** [id tid] returns a integer that uniquely identify [tid]. *)

val pp : Format.formatter -> 'a t -> unit
(** [pp ppf tid] prints [id tif]. *)

(** A annotated boolean that also witness the equality between two types. *)
type (_, _) witness = Eq : ('a, 'a) witness | NotEq : ('a, 'b) witness

val witness : 'r t -> 's t -> ('r, 's) witness
(** [witness tid1 tid2] is equivalent to [equal tid1 tid2], but exposes the
    equality between their types. *)

val to_bool : ('a, 'b) witness -> bool
(** [to_bool w] converts the witness into a boolean. *)
0707010000003F000041ED0000000000000000000000046491641000000000000000000000000000000000000000000000001800000000mirage-4.4.0/lib/mirage07070100000040000081A40000000000000000000000016491641000000117000000000000000000000000000000000000001D00000000mirage-4.4.0/lib/mirage/dune(library
 (public_name mirage.key)
 (name mirage_key)
 (wrapped false)
 (libraries ipaddr logs astring functoria mirage-runtime bos)
 (modules mirage_key))

(library
 (public_name mirage)
 (wrapped false)
 (libraries mirage.impl mirage.target)
 (modules :standard \ mirage_key))
07070100000041000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001D00000000mirage-4.4.0/lib/mirage/impl07070100000042000081A40000000000000000000000016491641000000062000000000000000000000000000000000000002200000000mirage-4.4.0/lib/mirage/impl/dune(library
 (name mirage_impl)
 (public_name mirage.impl)
 (libraries mirage.key)
 (wrapped false))
07070100000043000081A400000000000000000000000164916410000003CD000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_argv.mlopen Functoria
module Key = Mirage_key

let ty = Functoria.argv

let argv_unix =
  let packages = [ package ~min:"0.1.0" ~max:"0.2.0" "mirage-bootvar-unix" ] in
  let connect _ _ _ = "Bootvar.argv ()" in
  impl ~packages ~connect "Bootvar" ty

let argv_solo5 =
  let packages = [ package ~min:"0.6.0" ~max:"0.7.0" "mirage-bootvar-solo5" ] in
  let connect _ _ _ = "Bootvar.argv ()" in
  impl ~packages ~connect "Bootvar" ty

let no_argv =
  let connect _ _ _ = "return [|\"\"|]" in
  impl ~connect "Mirage_runtime" ty

let argv_xen =
  let packages = [ package ~min:"0.8.0" ~max:"0.9.0" "mirage-bootvar-xen" ] in
  let connect _ _ _ = "Bootvar.argv ()" in
  impl ~packages ~connect "Bootvar" ty

let default_argv =
  match_impl
    Key.(value target)
    [
      (`Xen, argv_xen);
      (`Qubes, argv_xen);
      (`Virtio, argv_solo5);
      (`Hvt, argv_solo5);
      (`Muen, argv_solo5);
      (`Genode, argv_solo5);
      (`Spt, argv_solo5);
    ]
    ~default:argv_unix
07070100000044000081A4000000000000000000000001649164100000005D000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_argv.mlival default_argv : Functoria.argv Functoria.impl
val no_argv : Functoria.argv Functoria.impl
07070100000045000081A40000000000000000000000016491641000000226000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_arpv4.mlmodule Key = Mirage_key
open Functoria
open Mirage_impl_ethernet
open Mirage_impl_time
open Mirage_impl_misc

type arpv4 = Arpv4

let arpv4 = Type.v Arpv4

let arp_conf =
  let packages =
    [ package ~min:"3.0.0" ~max:"4.0.0" ~sublibs:[ "mirage" ] "arp" ]
  in
  let connect _ modname = function
    | [ eth; _time ] -> Fmt.str "%s.connect %s" modname eth
    | _ -> failwith (connect_err "arp" 3)
  in
  impl ~packages ~connect "Arp.Make" (ethernet @-> time @-> arpv4)

let arp ?(time = default_time) (eth : ethernet impl) = arp_conf $ eth $ time
07070100000046000081A400000000000000000000000164916410000000B0000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_arpv4.mlitype arpv4

val arpv4 : arpv4 Functoria.typ

val arp :
  ?time:Mirage_impl_time.time Functoria.impl ->
  Mirage_impl_ethernet.ethernet Functoria.impl ->
  arpv4 Functoria.impl
07070100000047000081A4000000000000000000000001649164100000298C000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_block.mlopen Functoria
open Mirage_impl_misc
open Mirage_impl_kv
open Mirage_impl_pclock
module Key = Mirage_key

type block = BLOCK

let block = Type.v BLOCK

type block_t = { filename : string; number : int }

let all_blocks = Hashtbl.create 7

let make_block_t =
  (* NB: reserve number 0 for the boot disk *)
  let next_number = ref 1 in
  fun filename ->
    let b =
      if Hashtbl.mem all_blocks filename then Hashtbl.find all_blocks filename
      else
        let number = !next_number in
        incr next_number;
        let b = { filename; number } in
        Hashtbl.add all_blocks filename b;
        b
    in
    b

let xen_block_packages =
  [ package ~min:"2.1.0" ~max:"3.0.0" ~sublibs:[ "front" ] "mirage-block-xen" ]

(* this function takes a string rather than an int as `id` to allow
   the user to pass stuff like "/dev/xvdi1", which mirage-block-xen
   also understands *)
let xenstore_conf id =
  let configure i =
    match get_target i with
    | `Qubes | `Xen -> Action.ok ()
    | _ ->
        failwith
          "XenStore IDs are only valid ways of specifying block devices when \
           the target is Xen or Qubes."
  in
  let connect _ impl_name _ = Fmt.str "%s.connect %S" impl_name id in
  impl ~configure ~connect ~packages:xen_block_packages "Block" block

let block_of_xenstore_id id = xenstore_conf id

(* calculate the XenStore ID for the nth available block device.
   Taken from https://github.com/mirage/mirage-block-xen/blob/
   a64d152586c7ebc1d23c5adaa4ddd440b45a3a83/lib/device_number.ml#L64 . *)
let xenstore_id_of_index number =
  if number < 16 then (202 lsl 8) lor (number lsl 4)
  else (1 lsl 28) lor (number lsl 8)

let block_conf file =
  let connect_name target =
    match target with
    | #Mirage_key.mode_unix -> file (* open the file directly *)
    | #Mirage_key.mode_xen ->
        let b = make_block_t file in
        xenstore_id_of_index b.number |> string_of_int
    | #Mirage_key.mode_solo5 ->
        (* XXX For now, on Solo5, just pass the "file" name through directly as
         * the Solo5 block device name *)
        file
  in
  let packages_v =
    Key.match_ Key.(value target) @@ function
    | #Mirage_key.mode_xen -> xen_block_packages
    | #Mirage_key.mode_solo5 ->
        [ package ~min:"0.8.0" ~max:"0.9.0" "mirage-block-solo5" ]
    | #Mirage_key.mode_unix ->
        [ package ~min:"2.12.0" ~max:"3.0.0" "mirage-block-unix" ]
  in
  let configure _ =
    let (_ : block_t) = make_block_t file in
    Action.ok ()
  in
  let connect i s _ =
    match get_target i with
    | `Muen -> failwith "Block devices not supported on Muen target."
    | _ -> Fmt.str "%s.connect %S" s (connect_name (get_target i))
  in
  Device.v ~configure ~packages_v ~connect "Block" block

let block_of_file file = of_device (block_conf file)

let ramdisk rname =
  let packages = [ package "mirage-block-ramdisk" ] in
  let connect _ m _ = Fmt.str "%s.connect ~name:%S" m rname in
  impl ~connect ~packages "Ramdisk" block

let generic_block ?group ?(key = Key.value @@ Key.block ?group ()) name =
  match_impl key
    [
      (`XenstoreId, block_of_xenstore_id name);
      (`BlockFile, block_of_file name);
      (`Ramdisk, ramdisk name);
    ]
    ~default:(ramdisk name)

let tar_kv_ro_conf =
  let packages = [ package ~min:"1.0.0" ~max:"3.0.0" "tar-mirage" ] in
  let connect _ modname = function
    | [ block ] -> Fmt.str "%s.connect %s" modname block
    | _ -> failwith (connect_err "tar_kv_ro" 1)
  in
  impl ~packages ~connect "Tar_mirage.Make_KV_RO" (block @-> Mirage_impl_kv.ro)

let tar_kv_rw_conf =
  let packages = [ package ~min:"2.2.0" ~max:"3.0.0" "tar-mirage" ] in
  let connect _ modname = function
    | [ _pclock; block ] -> Fmt.str "%s.connect %s" modname block
    | _ -> failwith (connect_err "tar_kv_rw" 2)
  in
  impl ~packages ~connect "Tar_mirage.Make_KV_RW"
    (pclock @-> block @-> Mirage_impl_kv.rw)

let tar_kv_ro block = tar_kv_ro_conf $ block
let tar_kv_rw pclock block = tar_kv_rw_conf $ pclock $ block
let archive = tar_kv_ro

let fat_conf =
  let packages = [ package ~min:"0.15.0" ~max:"0.16.0" "fat-filesystem" ] in
  let connect _ modname = function
    | [ block ] -> Fmt.str "%s.connect %s" modname block
    | _ -> failwith (connect_err "fat" 1)
  in
  impl ~packages ~connect "Fat.KV_RO" (block @-> Mirage_impl_kv.ro)

let fat_ro block = fat_conf $ block

type mode = [ `Fast | `Light ]

let pp_mode ppf = function
  | `Fast -> Fmt.string ppf "Fast"
  | `Light -> Fmt.string ppf "Light"

let pp_branch ppf = function
  | None -> ()
  | Some branch -> Fmt.pf ppf " -b %s" branch

let docteur_unix (mode : mode) extra_deps disk branch analyze remote =
  let dune info =
    let ctx = Info.context info in
    let disk = Key.get ctx disk in
    let source_tree =
      let uri = Uri.of_string remote in
      match Uri.scheme uri with
      | Some "file" ->
          let path = Uri.host_with_default ~default:"" uri ^ Uri.path uri in
          Fmt.str " (source_tree /%s)" path
      | Some "relativize" ->
          let path = Uri.host_with_default ~default:"" uri ^ Uri.path uri in
          Fmt.str " (source_tree %s)" path
      | _ -> ""
    in
    let dune =
      Dune.stanzaf
        {dune|
(rule
 (targets %s)
 (enabled_if (= %%{context_name} "default"))
 (deps (:make %%{bin:docteur.make})%a%s)
 (action (run %%{make} %s%a %s)))
|dune}
        disk
        Fmt.(list ~sep:nop (const string " " ++ string))
        extra_deps source_tree remote pp_branch branch disk
    in
    [ dune ]
  in
  let install info =
    let ctx = Info.context info in
    let disk = Fpath.v (Key.get ctx disk) in
    Install.v ~etc:[ disk ] ()
  in
  let configure info =
    let ctx = Info.context info in
    let disk = Key.get ctx disk in
    let (_ : block_t) = make_block_t disk in
    Action.ok ()
  in
  let connect _info modname _ =
    Fmt.str
      {ocaml|let ( <.> ) f g = fun x -> f (g x) in
             let f = Rresult.R.(failwith_error_msg <.> reword_error (msgf "%%a" %s.pp_error)) in
             Lwt.map f (%s.connect ~analyze:%a %a)|ocaml}
      modname modname Key.serialize_call (Key.v analyze) Key.serialize_call
      (Key.v disk)
  in
  let keys = [ Key.v disk; Key.v analyze ] in
  let packages = [ package "docteur-unix" ~min:"0.0.6" ] in
  impl ~keys ~packages ~dune ~install ~configure ~connect
    (Fmt.str "Docteur_unix.%a" pp_mode mode)
    ro

let docteur_solo5 (mode : mode) extra_deps disk branch analyze remote =
  let dune info =
    let ctx = Info.context info in
    let disk = Key.get ctx disk in
    let source_tree =
      let uri = Uri.of_string remote in
      match Uri.scheme uri with
      | Some "file" ->
          let path = Uri.host_with_default ~default:"" uri ^ Uri.path uri in
          Fmt.str " (source_tree /%s)" path
      | Some "relativize" ->
          let path = Uri.host_with_default ~default:"" uri ^ Uri.path uri in
          Fmt.str " (source_tree %s)" path
      | _ -> ""
    in
    let dune =
      Dune.stanzaf
        {dune|
(rule
 (targets %s)
 (enabled_if (= %%{context_name} "default"))
 (deps (:make %%{bin:docteur.make})%a%s)
 (action (run %%{make} %s%a %s)))
|dune}
        disk
        Fmt.(list ~sep:nop (const string " " ++ string))
        extra_deps source_tree remote pp_branch branch disk
    in
    [ dune ]
  in
  let install info =
    let ctx = Info.context info in
    let disk = Fpath.v (Key.get ctx disk) in
    Install.v ~etc:[ disk ] ()
  in
  let configure info =
    let ctx = Info.context info in
    let disk = Key.get ctx disk in
    let (_ : block_t) = make_block_t disk in
    Action.ok ()
  in
  let connect _info modname _ =
    Fmt.str
      {ocaml|let ( <.> ) f g = fun x -> f (g x) in
             let f = Rresult.R.(failwith_error_msg <.> reword_error (msgf "%%a" %s.pp_error)) in
             Lwt.map f (%s.connect ~analyze:%a %a)|ocaml}
      modname modname Key.serialize_call (Key.v analyze) Key.serialize_call
      (Key.v disk)
  in
  let keys = [ Key.v disk; Key.v analyze ] in
  let packages = [ package "docteur-solo5" ~min:"0.0.6" ] in
  impl ~keys ~packages ~dune ~install ~configure ~connect
    (Fmt.str "Docteur_solo5.%a" pp_mode mode)
    ro

let disk =
  let doc =
    Key.Arg.info
      ~doc:
        "Name of the docteur disk (for Solo5 targets, the name must contains \
         only alpanumeric characters)."
      [ "disk" ]
  in
  Key.(create "disk" Arg.(opt ~stage:`Configure string "disk" doc))

let analyze =
  let doc =
    Key.Arg.info ~doc:"Analyze at the boot time the given docteur disk."
      [ "analyze" ]
  in
  Key.(create "analyze" Arg.(opt bool true doc))

let docteur ?(mode = `Fast) ?(disk = disk) ?(analyze = analyze) ?branch
    ?(extra_deps = []) remote =
  match_impl
    Key.(value target)
    [
      (`Xen, docteur_solo5 mode extra_deps disk branch analyze remote);
      (`Qubes, docteur_solo5 mode extra_deps disk branch analyze remote);
      (`Virtio, docteur_solo5 mode extra_deps disk branch analyze remote);
      (`Hvt, docteur_solo5 mode extra_deps disk branch analyze remote);
      (`Spt, docteur_solo5 mode extra_deps disk branch analyze remote);
      (`Muen, docteur_solo5 mode extra_deps disk branch analyze remote);
      (`Genode, docteur_solo5 mode extra_deps disk branch analyze remote);
    ]
    ~default:(docteur_unix mode extra_deps disk branch analyze remote)

let chamelon ~program_block_size =
  let keys = [ Key.v program_block_size ] in
  let packages = [ package "chamelon" ~sublibs:[ "kv" ] ~min:"0.0.8" ] in
  let connect _ modname = function
    | [ block; _ ] ->
        Fmt.str
          {ocaml|%s.connect ~program_block_size:%a %s
                 >|= Result.map_error (Fmt.str "%%a" %s.pp_error)
                 >|= Result.fold ~ok:Fun.id ~error:failwith|ocaml}
          modname Key.serialize_call (Key.v program_block_size) block modname
    | _ -> assert false
  in
  impl ~packages ~keys ~connect "Kv.Make"
    (block @-> pclock @-> Mirage_impl_kv.rw)

let ccm_block ?nonce_len key =
  let keys = [ Key.v key ] in
  let packages =
    [ package "mirage-block-ccm" ~min:"2.0.0" ~max:"3.0.0"; package "astring" ]
  in
  let connect _ modname = function
    | [ block ] ->
        Fmt.str
          {ocaml|let key = %a in
                 let key = match Astring.String.cut ~sep:"0x" key with
                 | Some ("", key) -> key
                 | _ -> key in
               %s.connect ?nonce_len:%a ~key:(Cstruct.of_hex key) %s|ocaml}
          Key.serialize_call (Key.v key) modname
          Fmt.(parens (Dump.option int))
          nonce_len block
    | _ -> assert false
  in
  impl ~packages ~keys ~connect "Block_ccm.Make" (block @-> block)
07070100000048000081A400000000000000000000000164916410000004FD000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_block.mlitype block

val block : block Functoria.typ

val generic_block :
  ?group:string ->
  ?key:[ `BlockFile | `Ramdisk | `XenstoreId ] Functoria.value ->
  string ->
  block Functoria.impl

val tar_kv_ro : block Functoria.impl -> Mirage_impl_kv.ro Functoria.impl
val archive : block Functoria.impl -> Mirage_impl_kv.ro Functoria.impl
val fat_ro : block Functoria.impl -> Mirage_impl_kv.ro Functoria.impl
val ramdisk : string -> block Functoria.impl
val block_of_xenstore_id : string -> block Functoria.impl
val block_of_file : string -> block Functoria.impl
val block_conf : string -> block Functoria.device

val docteur :
  ?mode:[ `Fast | `Light ] ->
  ?disk:string Functoria.Key.key ->
  ?analyze:bool Functoria.Key.key ->
  ?branch:string ->
  ?extra_deps:string list ->
  string ->
  Mirage_impl_kv.ro Functoria.impl

type block_t = { filename : string; number : int }

val all_blocks : (string, block_t) Hashtbl.t

val chamelon :
  program_block_size:int Functoria.key ->
  (block -> Mirage_impl_pclock.pclock -> Mirage_impl_kv.rw) Functoria.impl

val tar_kv_rw :
  Mirage_impl_pclock.pclock Functoria.impl ->
  block Functoria.impl ->
  Mirage_impl_kv.rw Functoria.impl

val ccm_block :
  ?nonce_len:int ->
  string option Functoria.key ->
  (block -> block) Functoria.impl
07070100000049000081A400000000000000000000000164916410000003A2000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_conduit.mlopen Functoria
open Mirage_impl_stack
open Mirage_impl_misc
open Mirage_impl_random

type conduit = Conduit

let conduit = Type.v Conduit
let pkg = package ~min:"6.0.1" ~max:"7.0.0" "conduit-mirage"

let tcp =
  let packages = [ pkg ] in
  let connect _ _ = function
    | [ stack ] -> Fmt.str "Lwt.return %s@;" stack
    | _ -> failwith (connect_err "tcp_conduit" 1)
  in
  impl ~packages ~connect "Conduit_mirage.TCP" (stackv4v6 @-> conduit)

let tls random =
  let packages = [ pkg; package ~min:"0.13.0" ~max:"0.18.0" "tls-mirage" ] in
  let extra_deps = [ dep random ] in
  let connect _ _ = function
    | [ stack; _random ] -> Fmt.str "Lwt.return %s@;" stack
    | _ -> failwith (connect_err "tls_conduit" 1)
  in
  impl ~packages ~connect ~extra_deps "Conduit_mirage.TLS" (conduit @-> conduit)

let conduit_direct ?tls:(use_tls = false) ?(random = default_random) s =
  if use_tls then tls random $ (tcp $ s) else tcp $ s
0707010000004A000081A400000000000000000000000164916410000000D0000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_conduit.mliopen Functoria

type conduit

val pkg : package
val conduit : conduit typ

val conduit_direct :
  ?tls:bool ->
  ?random:Mirage_impl_random.random impl ->
  Mirage_impl_stack.stackv4v6 impl ->
  conduit impl
0707010000004B000081A40000000000000000000000016491641000000408000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_console.mlopen Functoria
module Key = Mirage_key

type console = CONSOLE

let console = Type.v CONSOLE
let connect str _ m _ = Fmt.str "%s.connect %S" m str

let console_unix str =
  let packages = [ package ~min:"5.1.0" ~max:"6.0.0" "mirage-console-unix" ] in
  impl ~packages ~connect:(connect str) "Console_unix" console

let console_xen str =
  let packages = [ package ~min:"5.1.0" ~max:"6.0.0" "mirage-console-xen" ] in
  impl ~packages ~connect:(connect str) "Console_xen" console

let console_solo5 str =
  let packages = [ package ~min:"0.8.0" ~max:"0.9.0" "mirage-console-solo5" ] in
  impl ~packages ~connect:(connect str) "Console_solo5" console

let custom_console str =
  match_impl
    Key.(value target)
    [
      (`Xen, console_xen str);
      (`Qubes, console_xen str);
      (`Virtio, console_solo5 str);
      (`Hvt, console_solo5 str);
      (`Spt, console_solo5 str);
      (`Muen, console_solo5 str);
      (`Genode, console_solo5 str);
    ]
    ~default:(console_unix str)

let default_console = custom_console "0"
0707010000004C000081A40000000000000000000000016491641000000095000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_console.mlitype console

val console : console Functoria.typ
val default_console : console Functoria.impl
val custom_console : string -> console Functoria.impl
0707010000004D000081A40000000000000000000000016491641000000520000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/impl/mirage_impl_dns.mlopen Functoria
open Mirage_impl_time
open Mirage_impl_mclock
open Mirage_impl_pclock
open Mirage_impl_stack
open Mirage_impl_random

type dns_client = Dns_client

let dns_client = Type.v Dns_client

let generic_dns_client timeout nameservers =
  let packages = [ package "dns-client-mirage" ~min:"7.0.0" ~max:"8.0.0" ] in
  let keys =
    match (nameservers, timeout) with
    | None, None -> []
    | None, Some timeout -> [ Key.v timeout ]
    | Some nameservers, None -> [ Key.v nameservers ]
    | Some nameservers, Some timeout -> [ Key.v nameservers; Key.v timeout ]
  in
  let connect _info modname = function
    | [ _random; _time; _mclock; _pclock; stackv4v6 ] ->
        let pp_nameservers ppf = function
          | None -> Fmt.string ppf "[]"
          | Some nameservers -> Key.serialize_call ppf (Key.v nameservers)
        in
        let pp_timeout ppf = function
          | None -> ()
          | Some timeout ->
              Fmt.pf ppf "?timeout:%a " Key.serialize_call (Key.v timeout)
        in
        Fmt.str {ocaml|%s.connect ~nameservers:%a %a%s|ocaml} modname
          pp_nameservers nameservers pp_timeout timeout stackv4v6
    | _ -> assert false
  in
  impl ~keys ~packages ~connect "Dns_client_mirage.Make"
    (random @-> time @-> mclock @-> pclock @-> stackv4v6 @-> dns_client)
0707010000004E000081A400000000000000000000000164916410000001CF000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_ethernet.mlmodule Key = Mirage_key
open Functoria
open Mirage_impl_misc
open Mirage_impl_network

type ethernet = ETHERNET

let ethernet = Type.v ETHERNET

let etif_conf =
  let packages = [ package ~min:"3.0.0" ~max:"4.0.0" "ethernet" ] in
  let connect _ m = function
    | [ eth ] -> Fmt.str "%s.connect %s" m eth
    | _ -> failwith (connect_err "ethernet" 1)
  in
  impl ~packages ~connect "Ethernet.Make" (network @-> ethernet)

let etif network = etif_conf $ network
0707010000004F000081A40000000000000000000000016491641000000086000000000000000000000000000000000000003600000000mirage-4.4.0/lib/mirage/impl/mirage_impl_ethernet.mlitype ethernet

val ethernet : ethernet Functoria.typ
val etif : Mirage_impl_network.network Functoria.impl -> ethernet Functoria.impl
07070100000050000081A40000000000000000000000016491641000000C68000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/impl/mirage_impl_git.mlopen Functoria
open Mirage_impl_time
open Mirage_impl_mclock
open Mirage_impl_pclock
open Mirage_impl_tcp
open Mirage_impl_mimic

type git_client = Git_client

let git_client = Type.v Git_client

let git_merge_clients =
  let packages = [ package "mimic" ] in
  let connect _ _modname = function
    | [ a; b ] -> Fmt.str "Lwt.return (Mimic.merge %s %s)" a b
    | [ x ] -> Fmt.str "%s.ctx" x
    | _ -> Fmt.str "Lwt.return Mimic.empty"
  in
  impl ~packages ~connect "Mimic.Merge"
    (git_client @-> git_client @-> git_client)

let git_tcp =
  let packages =
    [ package "git-mirage" ~sublibs:[ "tcp" ] ~min:"3.10.0" ~max:"3.14.0" ]
  in
  let connect _ modname = function
    | [ _tcpv4v6; ctx ] -> Fmt.str {ocaml|%s.connect %s|ocaml} modname ctx
    | _ -> assert false
  in
  impl ~packages ~connect "Git_mirage_tcp.Make"
    (tcpv4v6 @-> mimic @-> git_client)

let git_ssh ?authenticator key password =
  let packages =
    [ package "git-mirage" ~sublibs:[ "ssh" ] ~min:"3.13.0" ~max:"3.14.0" ]
  in
  let connect _ modname = function
    | [ _mclock; _tcpv4v6; _time; ctx ] -> (
        match authenticator with
        | None ->
            Fmt.str
              {ocaml|%s.connect %s >>= %s.with_optionnal_key ~key:%a ~password:%a|ocaml}
              modname ctx modname Key.serialize_call (Key.v key)
              Key.serialize_call (Key.v password)
        | Some authenticator ->
            Fmt.str
              {ocaml|%s.connect %s >>= %s.with_optionnal_key ?authenticator:%a ~key:%a ~password:%a|ocaml}
              modname ctx modname Key.serialize_call (Key.v authenticator)
              Key.serialize_call (Key.v key) Key.serialize_call (Key.v password)
        )
    | _ -> assert false
  in
  let keys =
    Key.v key :: Key.v password :: List.map Key.v (Option.to_list authenticator)
  in
  impl ~packages ~connect ~keys "Git_mirage_ssh.Make"
    (mclock @-> tcpv4v6 @-> time @-> mimic @-> git_client)

let git_http ?authenticator headers =
  let packages =
    [ package "git-mirage" ~sublibs:[ "http" ] ~min:"3.10.0" ~max:"3.14.0" ]
  in
  let keys =
    let keys = [] in
    let keys =
      match headers with Some headers -> Key.v headers :: keys | None -> keys
    in
    let keys =
      match authenticator with
      | Some authenticator -> Key.v authenticator :: keys
      | None -> []
    in
    keys
  in
  let connect _ modname = function
    | [ _pclock; _tcpv4v6; ctx ] ->
        let serialize_headers ppf = function
          | None -> ()
          | Some headers ->
              Fmt.pf ppf " ?headers:%a" Key.serialize_call (Key.v headers)
        in
        let serialize_authenticator ppf = function
          | None -> ()
          | Some authenticator ->
              Fmt.pf ppf " ?authenticator:%a" Key.serialize_call
                (Key.v authenticator)
        in
        Fmt.str
          {ocaml|%s.connect %s >>= fun ctx -> %s.with_optional_tls_config_and_headers%a%a ctx|ocaml}
          modname ctx modname serialize_authenticator authenticator
          serialize_headers headers
    | _ -> assert false
  in
  impl ~packages ~connect ~keys "Git_mirage_http.Make"
    (pclock @-> tcpv4v6 @-> mimic @-> git_client)
07070100000051000081A40000000000000000000000016491641000000680000000000000000000000000000000000000003B00000000mirage-4.4.0/lib/mirage/impl/mirage_impl_happy_eyeballs.mlopen Functoria
open Mirage_impl_time
open Mirage_impl_mclock
open Mirage_impl_stack
open Mirage_impl_dns

type happy_eyeballs = Happy_eyeballs

let happy_eyeballs = Type.v Happy_eyeballs

let generic_happy_eyeballs aaaa_timeout connect_delay connect_timeout
    resolve_timeout resolve_retries timer_interval =
  let packages =
    [ package "happy-eyeballs-mirage" ~min:"0.6.0" ~max:"1.0.0" ]
  in
  let keys =
    let cons_if_some v l = match v with Some x -> x :: l | None -> l in
    cons_if_some aaaa_timeout []
    |> cons_if_some connect_delay
    |> cons_if_some resolve_timeout
    |> cons_if_some resolve_retries
    |> cons_if_some timer_interval
    |> List.map Key.v
  in
  let connect _info modname = function
    | [ _time; _mclock; stack; dns ] ->
        let pp_optional_argument ~name ppf = function
          | None -> ()
          | Some key -> Fmt.pf ppf "?%s:%a " name Key.serialize_call (Key.v key)
        in
        Fmt.str {ocaml|%s.connect_device %a%a%a%a%a%a %s %s|ocaml} modname
          (pp_optional_argument ~name:"aaaa_timeout")
          aaaa_timeout
          (pp_optional_argument ~name:"connect_delay")
          connect_delay
          (pp_optional_argument ~name:"connect_timeout")
          connect_timeout
          (pp_optional_argument ~name:"resolve_timeout")
          resolve_timeout
          (pp_optional_argument ~name:"resolve_retries")
          resolve_retries
          (pp_optional_argument ~name:"timer_interval")
          timer_interval dns stack
    | _ -> assert false
  in
  impl ~keys ~packages ~connect "Happy_eyeballs_mirage.Make"
    (time @-> mclock @-> stackv4v6 @-> dns_client @-> happy_eyeballs)
07070100000052000081A400000000000000000000000164916410000008FA000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_http.mlopen Functoria
open Mirage_impl_pclock
open Mirage_impl_misc
open Mirage_impl_conduit
open Mirage_impl_resolver
open Mirage_impl_tcp
open Mirage_impl_mimic

type http = HTTP

let http = Type.v HTTP

type http_client = HTTP_client

let http_client = Type.v HTTP_client

let connect err _i modname = function
  | [ conduit ] -> Fmt.str "Lwt.return (%s.listen %s)" modname conduit
  | _ -> failwith (connect_err err 1)

let cohttp_server =
  let packages = [ package ~min:"4.0.0" ~max:"6.0.0" "cohttp-mirage" ] in
  impl ~packages ~connect:(connect "http") "Cohttp_mirage.Server.Make"
    (conduit @-> http)

let cohttp_server conduit = cohttp_server $ conduit

let cohttp_client =
  let packages = [ package ~min:"4.0.0" ~max:"6.0.0" "cohttp-mirage" ] in
  let connect _i modname = function
    | [ _pclock; resolver; conduit ] ->
        Fmt.str "Lwt.return (%s.ctx %s %s)" modname resolver conduit
    | _ -> failwith (connect_err "http" 2)
  in
  impl ~packages ~connect "Cohttp_mirage.Client.Make"
    (pclock @-> resolver @-> conduit @-> http_client)

let cohttp_client ?(pclock = default_posix_clock) resolver conduit =
  cohttp_client $ pclock $ resolver $ conduit

let httpaf_server conduit =
  let packages = [ package "httpaf-mirage" ] in
  let extra_deps = [ dep conduit ] in
  impl ~packages ~connect:(connect "httpaf") ~extra_deps
    "Httpaf_mirage.Server_with_conduit" http

type http_server = HTTP_server

let http_server = Type.v HTTP_server

let paf_server port =
  let connect _ modname = function
    | [ tcpv4v6 ] ->
        Fmt.str {ocaml|%s.init ~port:%a %s|ocaml} modname Key.serialize_call
          (Key.v port) tcpv4v6
    | _ -> assert false
  in
  let packages =
    [ package "paf" ~sublibs:[ "mirage" ] ~min:"0.3.0" ~max:"0.6.0" ]
  in
  let keys = [ Key.v port ] in
  impl ~connect ~packages ~keys "Paf_mirage.Make" (tcpv4v6 @-> http_server)

type alpn_client = ALPN_client

let alpn_client = Type.v ALPN_client

let paf_client =
  let packages = [ package "http-mirage-client" ~min:"0.0.1" ~max:"0.1.0" ] in
  let connect _ modname = function
    | [ _pclock; _tcpv4v6; ctx ] ->
        Fmt.str {ocaml|%s.connect %s|ocaml} modname ctx
    | _ -> assert false
  in
  impl ~connect ~packages "Http_mirage_client.Make"
    (pclock @-> tcpv4v6 @-> mimic @-> alpn_client)
07070100000053000081A400000000000000000000000164916410000002CE000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_http.mliopen Functoria

type http

val http : http typ
val cohttp_server : Mirage_impl_conduit.conduit impl -> http impl
val httpaf_server : Mirage_impl_conduit.conduit impl -> http impl

type http_client

val http_client : http_client typ

val cohttp_client :
  ?pclock:Mirage_impl_pclock.pclock impl ->
  Mirage_impl_resolver.resolver impl ->
  Mirage_impl_conduit.conduit impl ->
  http_client impl

type http_server

val http_server : http_server typ

val paf_server :
  int Mirage_key.key -> (Mirage_impl_tcp.tcpv4v6 -> http_server) impl

type alpn_client

val alpn_client : alpn_client typ

val paf_client :
  (Mirage_impl_pclock.pclock ->
  Mirage_impl_tcp.tcpv4v6 ->
  Mirage_impl_mimic.mimic ->
  alpn_client)
  impl
07070100000054000081A400000000000000000000000164916410000001E9000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_icmp.mlopen Functoria
open Mirage_impl_ip
open Mirage_impl_misc

type 'a icmp = ICMP
type icmpv4 = v4 icmp

let icmp = Type.v ICMP
let icmpv4 : icmpv4 typ = icmp

let icmpv4_direct () =
  let packages_v = right_tcpip_library ~sublibs:[ "icmpv4" ] "tcpip" in
  let connect _ modname = function
    | [ ip ] -> Fmt.str "%s.connect %s" modname ip
    | _ -> failwith (connect_err "icmpv4" 1)
  in
  impl ~packages_v ~connect "Icmpv4.Make" (ip @-> icmp)

let direct_icmpv4 ip = icmpv4_direct () $ ip
07070100000055000081A4000000000000000000000001649164100000007F000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_icmp.mlitype icmpv4

val icmpv4 : icmpv4 Functoria.typ
val direct_icmpv4 : Mirage_impl_ip.ipv4 Functoria.impl -> icmpv4 Functoria.impl
07070100000056000081A4000000000000000000000001649164100000153F000000000000000000000000000000000000002F00000000mirage-4.4.0/lib/mirage/impl/mirage_impl_ip.mlopen Functoria
open Mirage_impl_arpv4
open Mirage_impl_ethernet
open Mirage_impl_mclock
open Mirage_impl_misc
open Mirage_impl_network
open Mirage_impl_qubesdb
open Mirage_impl_random
open Mirage_impl_time
module Key = Mirage_key

type v4
type v6
type v4v6
type 'a ip = IP
type ipv4 = v4 ip
type ipv6 = v6 ip
type ipv4v6 = v4v6 ip

let ip = Type.Type IP
let ipv4 : ipv4 typ = ip
let ipv6 : ipv6 typ = ip
let ipv4v6 : ipv4v6 typ = ip

type ipv4_config = {
  network : Ipaddr.V4.Prefix.t;
  gateway : Ipaddr.V4.t option;
}
(** Types for IPv4 manual configuration. *)

let opt_opt_key s = Fmt.(option @@ (any ("?" ^^ s ^^ ":") ++ pp_key))
let opt_key s = Fmt.(option @@ (any ("~" ^^ s ^^ ":") ++ pp_key))
let opt_map f = function Some x -> Some (f x) | None -> None
let ( @? ) x l = match x with Some s -> s :: l | None -> l
let ( @?? ) x y = opt_map Key.v x @? y

(* convenience function for linking tcpip.unix for checksums *)
let right_tcpip_library ?libs ~sublibs pkg =
  let min = "7.0.0" and max = "9.0.0" in
  Key.pure [ package ~min ~max ?libs ~sublibs pkg ]

let ipv4_keyed_conf ~ip ?gateway ?no_init () =
  let packages_v = right_tcpip_library ~sublibs:[ "ipv4" ] "tcpip" in
  let keys = no_init @?? gateway @?? [ Key.v ip ] in
  let connect _ modname = function
    | [ _random; _mclock; etif; arp ] ->
        Fmt.str "%s.connect@[@ %a@ %a@ %a@ %s@ %s@]" modname (opt_key "no_init")
          no_init
          Fmt.(any "~cidr:" ++ pp_key)
          ip (opt_opt_key "gateway") gateway etif arp
    | _ -> failwith (connect_err "ipv4 keyed" 4)
  in
  impl ~packages_v ~keys ~connect "Static_ipv4.Make"
    (random @-> mclock @-> ethernet @-> arpv4 @-> ipv4)

let ipv4_dhcp_conf =
  let packages =
    [ package ~min:"1.3.0" ~max:"2.0.0" ~sublibs:[ "mirage" ] "charrua-client" ]
  in
  let connect _ modname = function
    | [ _random; _mclock; _time; network; ethernet; arp ] ->
        Fmt.str "%s.connect@[@ %s@ %s@ %s@]" modname network ethernet arp
    | _ -> failwith (connect_err "ipv4 dhcp" 5)
  in
  impl ~packages ~connect "Dhcp_ipv4.Make"
    (random @-> mclock @-> time @-> network @-> ethernet @-> arpv4 @-> ipv4)

let ipv4_of_dhcp ?(random = default_random) ?(clock = default_monotonic_clock)
    ?(time = default_time) net ethif arp =
  ipv4_dhcp_conf $ random $ clock $ time $ net $ ethif $ arp

let create_ipv4 ?group ?config ?no_init ?(random = default_random)
    ?(clock = default_monotonic_clock) etif arp =
  let network, gateway =
    match config with
    | None -> (Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24", None)
    | Some { network; gateway } -> (network, gateway)
  in
  let ip = Key.V4.network ?group network
  and gateway = Key.V4.gateway ?group gateway in
  ipv4_keyed_conf ~ip ~gateway ?no_init () $ random $ clock $ etif $ arp

type ipv6_config = {
  network : Ipaddr.V6.Prefix.t;
  gateway : Ipaddr.V6.t option;
}
(** Types for IP manual configuration. *)

let ipv4_qubes_conf =
  let packages = [ package ~min:"0.9.0" ~max:"0.10.0" "mirage-qubes-ipv4" ] in
  let connect _ modname = function
    | [ db; _random; _mclock; etif; arp ] ->
        Fmt.str "%s.connect@[@ %s@ %s@ %s@]" modname db etif arp
    | _ -> failwith (connect_err "qubes ipv4" 5)
  in
  impl ~packages ~connect "Qubesdb_ipv4.Make"
    (qubesdb @-> random @-> mclock @-> ethernet @-> arpv4 @-> ipv4)

let ipv4_qubes ?(random = default_random) ?(clock = default_monotonic_clock) db
    ethernet arp =
  ipv4_qubes_conf $ db $ random $ clock $ ethernet $ arp

let ipv6_conf ?ip ?gateway ?handle_ra ?no_init () =
  let packages_v = right_tcpip_library ~sublibs:[ "ipv6" ] "tcpip" in
  let keys = ip @?? gateway @?? handle_ra @?? no_init @?? [] in
  let connect _ modname = function
    | [ netif; etif; _random; _time; _clock ] ->
        Fmt.str "%s.connect@[@ %a@ %a@ %a@ %a@ %s@ %s@]" modname
          (opt_key "no_init") no_init (opt_key "handle_ra") handle_ra
          (opt_opt_key "cidr") ip (opt_opt_key "gateway") gateway netif etif
    | _ -> failwith (connect_err "ipv6" 5)
  in
  impl ~packages_v ~keys ~connect "Ipv6.Make"
    (network @-> ethernet @-> random @-> time @-> mclock @-> ipv6)

let create_ipv6 ?(random = default_random) ?(time = default_time)
    ?(clock = default_monotonic_clock) ?group ?config ?no_init netif etif =
  let network, gateway =
    match config with
    | None -> (None, None)
    | Some { network; gateway } -> (Some network, gateway)
  in
  let ip = Key.V6.network ?group network
  and gateway = Key.V6.gateway ?group gateway
  and handle_ra = Key.V6.accept_router_advertisements ?group () in
  ipv6_conf ~ip ~gateway ~handle_ra ?no_init ()
  $ netif
  $ etif
  $ random
  $ time
  $ clock

let ipv4v6_conf ?ipv4_only ?ipv6_only () =
  let packages_v = right_tcpip_library ~sublibs:[ "stack-direct" ] "tcpip" in
  let keys = ipv4_only @?? ipv6_only @?? [] in
  let connect _ modname = function
    | [ ipv4; ipv6 ] ->
        Fmt.str "%s.connect@[@ %a@ %a@ %s@ %s@]" modname (opt_key "ipv4_only")
          ipv4_only (opt_key "ipv6_only") ipv6_only ipv4 ipv6
    | _ -> failwith (connect_err "ipv4v6" 2)
  in
  impl ~packages_v ~keys ~connect "Tcpip_stack_direct.IPV4V6"
    (ipv4 @-> ipv6 @-> ipv4v6)

let keyed_ipv4v6 ~ipv4_only ~ipv6_only ipv4 ipv6 =
  ipv4v6_conf ~ipv4_only ~ipv6_only () $ ipv4 $ ipv6

let create_ipv4v6 ?group ipv4 ipv6 =
  let ipv4_only = Key.ipv4_only ?group ()
  and ipv6_only = Key.ipv6_only ?group () in
  keyed_ipv4v6 ~ipv4_only ~ipv6_only ipv4 ipv6
07070100000057000081A40000000000000000000000016491641000000640000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/impl/mirage_impl_ip.mliopen Functoria
open Mirage_impl_arpv4
open Mirage_impl_ethernet
open Mirage_impl_mclock
open Mirage_impl_network
open Mirage_impl_qubesdb
open Mirage_impl_random

type v4
type v6
type v4v6
type 'a ip
type ipv4 = v4 ip
type ipv6 = v6 ip
type ipv4v6 = v4v6 ip

val ip : 'a ip Functoria.typ
val ipv4 : ipv4 Functoria.typ
val ipv6 : ipv6 Functoria.typ
val ipv4v6 : ipv4v6 Functoria.typ

type ipv4_config = {
  network : Ipaddr.V4.Prefix.t;
  gateway : Ipaddr.V4.t option;
}

type ipv6_config = {
  network : Ipaddr.V6.Prefix.t;
  gateway : Ipaddr.V6.t option;
}

val create_ipv4 :
  ?group:string ->
  ?config:ipv4_config ->
  ?no_init:bool Mirage_key.key ->
  ?random:random impl ->
  ?clock:mclock impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl

val create_ipv6 :
  ?random:random impl ->
  ?time:Mirage_impl_time.time impl ->
  ?clock:mclock impl ->
  ?group:string ->
  ?config:ipv6_config ->
  ?no_init:bool Mirage_key.key ->
  network impl ->
  ethernet impl ->
  ipv6 impl

val ipv4_of_dhcp :
  ?random:random impl ->
  ?clock:mclock impl ->
  ?time:Mirage_impl_time.time impl ->
  network impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl

val ipv4_qubes :
  ?random:random impl ->
  ?clock:mclock impl ->
  qubesdb impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl

val create_ipv4v6 : ?group:string -> ipv4 impl -> ipv6 impl -> ipv4v6 impl

val keyed_ipv4v6 :
  ipv4_only:bool Mirage_key.key ->
  ipv6_only:bool Mirage_key.key ->
  ipv4 impl ->
  ipv6 impl ->
  ipv4v6 impl

val right_tcpip_library :
  ?libs:string list -> sublibs:string list -> string -> package list value
07070100000058000081A40000000000000000000000016491641000000934000000000000000000000000000000000000002F00000000mirage-4.4.0/lib/mirage/impl/mirage_impl_kv.mlopen Functoria
open Astring
module Key = Mirage_key

type ro = RO

let ro = Type.v RO

let crunch dirname =
  let is_valid = function
    | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' -> true
    | _ -> false
  in
  let modname = String.filter is_valid dirname in
  let name = "Static_" ^ String.Ascii.lowercase modname in
  let packages =
    [
      package ~min:"3.0.0" ~max:"4.0.0" "mirage-kv-mem";
      package ~min:"3.1.0" ~max:"4.0.0" ~build:true "crunch";
    ]
  in
  let connect _ modname _ = Fmt.str "%s.connect ()" modname in
  let dune _i =
    let dir = Fpath.(v dirname) in
    let file ext = Fpath.(v (String.Ascii.lowercase name) + ext) in
    let ml = file "ml" in
    let mli = file "mli" in
    let dune =
      Dune.stanzaf
        {|
(rule
  (targets %a %a)
  (deps (source_tree %a))
  (action
    (run ocaml-crunch -o %a %a)))
|}
        Fpath.pp ml Fpath.pp mli Fpath.pp dir Fpath.pp ml Fpath.pp dir
    in
    [ dune ]
  in
  impl ~packages ~connect ~dune name ro

let direct_kv_ro dirname =
  let packages = [ package ~min:"2.1.0" ~max:"3.0.0" "mirage-kv-unix" ] in
  let connect _ modname _names = Fmt.str "%s.connect \"%s\"" modname dirname in
  impl ~packages ~connect "Mirage_kv_unix" ro

let direct_kv_ro dirname =
  match_impl
    Key.(value target)
    [
      (`Xen, crunch dirname);
      (`Qubes, crunch dirname);
      (`Virtio, crunch dirname);
      (`Hvt, crunch dirname);
      (`Spt, crunch dirname);
      (`Muen, crunch dirname);
      (`Genode, crunch dirname);
    ]
    ~default:(direct_kv_ro dirname)

type rw = RW

let rw = Type.v RW

let direct_kv_rw dirname =
  let packages = [ package ~min:"2.1.0" ~max:"3.0.0" "mirage-kv-unix" ] in
  let connect _ modname _names = Fmt.str "%s.connect \"%s\"" modname dirname in
  impl ~packages ~connect "Mirage_kv_unix" rw

let mem_kv_rw_config =
  let packages = [ package ~min:"3.0.0" ~max:"4.0.0" "mirage-kv-mem" ] in
  let connect _ modname _names = Fmt.str "%s.connect ()" modname in
  impl ~packages ~connect "Mirage_kv_mem.Make" (Mirage_impl_pclock.pclock @-> rw)

let mem_kv_rw ?(clock = Mirage_impl_pclock.default_posix_clock) () =
  mem_kv_rw_config $ clock

(** generic kv_ro. *)

let generic_kv_ro ?group ?(key = Key.value @@ Key.kv_ro ?group ()) dir =
  match_impl key
    [ (`Crunch, crunch dir); (`Direct, direct_kv_ro dir) ]
    ~default:(direct_kv_ro dir)
07070100000059000081A400000000000000000000000164916410000001A6000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/impl/mirage_impl_kv.mlitype ro

val ro : ro Functoria.typ
val direct_kv_ro : string -> ro Functoria.impl
val crunch : string -> ro Functoria.impl

val generic_kv_ro :
  ?group:string ->
  ?key:[ `Crunch | `Direct ] Functoria.value ->
  string ->
  ro Functoria.impl

type rw

val rw : rw Functoria.typ
val direct_kv_rw : string -> rw Functoria.impl

val mem_kv_rw :
  ?clock:Mirage_impl_pclock.pclock Functoria.impl -> unit -> rw Functoria.impl
0707010000005A000081A40000000000000000000000016491641000000139000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_mclock.mlopen Functoria

type mclock = MCLOCK

let mclock = Type.v MCLOCK

let default_monotonic_clock =
  let packages_v =
    Mirage_key.(if_ is_unix)
      [ package ~min:"4.1.0" ~max:"5.0.0" "mirage-clock-unix" ]
      [ package ~min:"4.2.0" ~max:"5.0.0" "mirage-clock-solo5" ]
  in
  impl ~packages_v "Mclock" mclock
0707010000005B000081A40000000000000000000000016491641000000063000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_mclock.mlitype mclock

val mclock : mclock Functoria.typ
val default_monotonic_clock : mclock Functoria.impl
0707010000005C000081A40000000000000000000000016491641000000348000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_mimic.mlopen Functoria
open Mirage_impl_dns
open Mirage_impl_stack
open Mirage_impl_happy_eyeballs

type mimic = Mimic

let mimic = Type.v Mimic

let mimic_merge =
  let packages = [ package "mimic" ] in
  let connect _ _modname = function
    | [ a; b ] -> Fmt.str "Lwt.return (Mimic.merge %s %s)" a b
    | [ x ] -> Fmt.str "%s.ctx" x
    | _ -> Fmt.str "Lwt.return Mimic.empty"
  in
  impl ~packages ~connect "Mimic.Merge" (mimic @-> mimic @-> mimic)

let mimic_happy_eyeballs =
  let packages = [ package "mimic-happy-eyeballs" ~min:"0.0.5" ] in
  let connect _ modname = function
    | [ _stackv4v6; _dns_client; happy_eyeballs ] ->
        Fmt.str {ocaml|%s.connect %s|ocaml} modname happy_eyeballs
    | _ -> assert false
  in
  impl ~packages ~connect "Mimic_happy_eyeballs.Make"
    (stackv4v6 @-> dns_client @-> happy_eyeballs @-> mimic)
0707010000005D000081A400000000000000000000000164916410000009E8000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_misc.mlopen Functoria
open Astring
open Action.Syntax

let src = Logs.Src.create "mirage" ~doc:"mirage cli tool"

module Log = (val Logs.src_log src : Logs.LOG)

let get_target i = Mirage_key.(get (Functoria.Info.context i) target)

let connect_err name number =
  Fmt.str "The %s connect expects exactly %d argument%s" name number
    (if number = 1 then "" else "s")

let pp_key fmt k = Mirage_key.serialize_call fmt (Mirage_key.v k)

let query_ocamlfind ?(recursive = false) ?(format = "%p") ?predicates libs =
  let open Bos in
  let flag = if recursive then Cmd.v "-recursive" else Cmd.empty
  and format = Cmd.of_list [ "-format"; format ]
  and predicate =
    match predicates with None -> [] | Some x -> [ "-predicates"; x ]
  and q = "query" in
  let cmd =
    Cmd.(
      v "ocamlfind" % q %% flag %% format %% of_list predicate %% of_list libs)
  in
  let+ out = Action.run_cmd_out cmd in
  String.cuts ~sep:"\n" ~empty:false out

let opam_prefix =
  let cmd = Bos.Cmd.(v "opam" % "config" % "var" % "prefix") in
  lazy (Action.run_cmd_out cmd)

(* Implement something similar to the @name/file extended names of findlib. *)
let rec expand_name ~lib param =
  match String.cut param ~sep:"@" with
  | None -> param
  | Some (prefix, name) -> (
      match String.cut name ~sep:"/" with
      | None -> prefix ^ Fpath.(to_string (v lib / name))
      | Some (name, rest) ->
          let rest = expand_name ~lib rest in
          prefix ^ Fpath.(to_string (v lib / name / rest)))

(* Get the linker flags for any extra C objects we depend on.
 * This is needed when building a Xen/Solo5 image as we do the link manually. *)
let extra_c_artifacts target pkgs =
  let* prefix = Lazy.force opam_prefix in
  let lib = prefix ^ "/lib" in
  let format = Fmt.str "%%d\t%%(%s_linkopts)" target
  and predicates = "native" in
  let* data = query_ocamlfind ~recursive:true ~format ~predicates pkgs in
  let r =
    List.fold_left
      (fun acc line ->
        match String.cut line ~sep:"\t" with
        | None -> acc
        | Some (dir, ldflags) ->
            if ldflags <> "" then
              let ldflags = String.cuts ldflags ~sep:" " in
              let ldflags = List.map (expand_name ~lib) ldflags in
              acc @ (("-L" ^ dir) :: ldflags)
            else acc)
      [] data
  in
  Action.ok r

let terminal () =
  let dumb = try Sys.getenv "TERM" = "dumb" with Not_found -> true in
  let isatty =
    try Unix.(isatty (descr_of_out_channel Stdlib.stdout))
    with Unix.Unix_error _ -> false
  in
  (not dumb) && isatty
0707010000005E000081A400000000000000000000000164916410000001BB000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_misc.mliopen Functoria
module Log : Logs.LOG

val get_target : Info.t -> Mirage_key.mode
val connect_err : string -> int -> string
val pp_key : Format.formatter -> 'a Key.key -> unit

val query_ocamlfind :
  ?recursive:bool ->
  ?format:string ->
  ?predicates:string ->
  string list ->
  string list Action.t

val opam_prefix : string Action.t Lazy.t
val extra_c_artifacts : string -> string list -> string list Action.t
val terminal : unit -> bool
0707010000005F000081A400000000000000000000000164916410000005FA000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_network.mlopen Functoria
module Key = Mirage_key

type network = NETWORK

let network = Type.v NETWORK
let all_networks = ref []

let network_conf (intf : string Key.key) =
  let key = Key.v intf in
  let keys = [ key ] in
  let packages_v =
    Key.match_ Key.(value target) @@ function
    | `Unix -> [ package ~min:"3.0.0" ~max:"4.0.0" "mirage-net-unix" ]
    | `MacOSX -> [ package ~min:"1.8.0" ~max:"2.0.0" "mirage-net-macosx" ]
    | `Xen -> [ package ~min:"2.1.0" ~max:"3.0.0" "mirage-net-xen" ]
    | `Qubes ->
        [
          package ~min:"2.1.0" ~max:"3.0.0" "mirage-net-xen";
          Mirage_impl_qubesdb.pkg;
        ]
    | #Mirage_key.mode_solo5 ->
        [ package ~min:"0.8.0" ~max:"0.9.0" "mirage-net-solo5" ]
  in
  let connect _ modname _ =
    (* @samoht: why not just use the args paramater? *)
    Fmt.str "%s.connect %a" modname Key.serialize_call key
  in
  let configure i =
    all_networks := Key.get (Info.context i) intf :: !all_networks;
    Action.ok ()
  in
  impl ~keys ~packages_v ~connect ~configure "Netif" network

let netif ?group dev = network_conf @@ Key.interface ?group dev

let default_network =
  match_impl
    Key.(value target)
    [
      (`Unix, netif "tap0");
      (`MacOSX, netif "tap0");
      (* On Solo5 targets, a single default network is customarily
       * named just 'service' *)
      (`Hvt, netif "service");
      (`Spt, netif "service");
      (`Virtio, netif "service");
      (`Muen, netif "service");
      (`Genode, netif "service");
    ]
    ~default:(netif "0")
07070100000060000081A400000000000000000000000164916410000000C0000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_network.mlitype network

val network : network Functoria.typ
val netif : ?group:string -> string -> network Functoria.impl
val default_network : network Functoria.impl
val all_networks : string list ref
07070100000061000081A40000000000000000000000016491641000000135000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_pclock.mlopen Functoria

type pclock = PCLOCK

let pclock = Type.v PCLOCK

let default_posix_clock =
  let packages_v =
    Mirage_key.(if_ is_unix)
      [ package ~min:"3.0.0" ~max:"5.0.0" "mirage-clock-unix" ]
      [ package ~min:"4.2.0" ~max:"5.0.0" "mirage-clock-solo5" ]
  in
  impl ~packages_v "Pclock" pclock
07070100000062000081A4000000000000000000000001649164100000005F000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_pclock.mlitype pclock

val pclock : pclock Functoria.typ
val default_posix_clock : pclock Functoria.impl
07070100000063000081A40000000000000000000000016491641000000242000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_qubesdb.mlopen Functoria
module Key = Mirage_key
open Mirage_impl_misc

type qubesdb = QUBES_DB

let qubesdb = Type.v QUBES_DB
let pkg = package ~min:"0.9.0" ~max:"0.10.0" "mirage-qubes"

let default_qubesdb =
  let packages = [ pkg ] in
  let configure i =
    match get_target i with
    | `Qubes | `Xen -> Action.ok ()
    | _ ->
        Action.error
          "Qubes DB invoked for an unsupported target; qubes and xen are \
           supported"
  in
  let connect _ modname _args = Fmt.str "%s.connect ~domid:0 ()" modname in
  impl ~packages ~configure ~connect "Qubes.DB" qubesdb
07070100000064000081A4000000000000000000000001649164100000007B000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_qubesdb.mlitype qubesdb

val qubesdb : qubesdb Functoria.typ
val default_qubesdb : qubesdb Functoria.impl
val pkg : Functoria.package
07070100000065000081A400000000000000000000000164916410000002BA000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_random.mlopen Functoria
open Mirage_impl_mclock
open Mirage_impl_time

type random = RANDOM

let random = Type.v RANDOM

let rng ?(time = default_time) ?(mclock = default_monotonic_clock) () =
  let packages =
    [
      package ~min:"0.8.0" ~max:"0.12.0" "mirage-crypto-rng-mirage";
      package ~min:"3.0.0" ~max:"4.0.0" "mirage-random";
    ]
  in
  let connect _ modname _ =
    (* here we could use the boot argument (--prng) to select the RNG! *)
    Fmt.str "%s.initialize (module Mirage_crypto_rng.Fortuna)" modname
  in
  impl ~packages ~connect "Mirage_crypto_rng_mirage.Make"
    (Mirage_impl_time.time @-> Mirage_impl_mclock.mclock @-> random)
  $ time
  $ mclock

let default_random = rng ()
07070100000066000081A400000000000000000000000164916410000000CC000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_random.mliopen Functoria
open Mirage_impl_time
open Mirage_impl_mclock

type random

val random : random typ
val rng : ?time:time impl -> ?mclock:mclock impl -> unit -> random impl
val default_random : random impl
07070100000067000081A400000000000000000000000164916410000004EF000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_reporter.mlopen Functoria
module Key = Mirage_key
open Mirage_impl_pclock
open Mirage_impl_misc

type reporter = job

let reporter = job

let pp_level ppf = function
  | Some Logs.Error -> Fmt.string ppf "(Some Logs.Error)"
  | Some Logs.Warning -> Fmt.string ppf "(Some Logs.Warning)"
  | Some Logs.Info -> Fmt.string ppf "(Some Logs.Info)"
  | Some Logs.Debug -> Fmt.string ppf "(Some Logs.Debug)"
  | Some Logs.App -> Fmt.string ppf "(Some Logs.App)"
  | None -> Fmt.string ppf "None"

let mirage_log ~default () =
  let logs = Key.logs in
  let packages = [ package ~min:"1.2.0" ~max:"2.0.0" "mirage-logs" ] in
  let keys = [ Key.v logs ] in
  let connect _ modname = function
    | [ _pclock ] ->
        Fmt.str
          "@[<v 2>let reporter = %s.create () in@ Mirage_runtime.set_level \
           ~default:%a %a;@ %s.set_reporter reporter;@ Lwt.return reporter"
          modname pp_level default pp_key logs modname
    | _ -> failwith (connect_err "log" 1)
  in
  impl ~packages ~keys ~connect "Mirage_logs.Make" (pclock @-> reporter)

let default_reporter ?(clock = default_posix_clock) ?(level = Some Logs.Info) ()
    =
  mirage_log ~default:level () $ clock

let no_reporter =
  let connect _ _ _ = "assert false" in
  impl ~connect "Mirage_runtime" reporter
07070100000068000081A400000000000000000000000164916410000000FF000000000000000000000000000000000000003600000000mirage-4.4.0/lib/mirage/impl/mirage_impl_reporter.mlitype reporter = Functoria.job

val reporter : reporter Functoria.typ

val default_reporter :
  ?clock:Mirage_impl_pclock.pclock Functoria.impl ->
  ?level:Logs.level option ->
  unit ->
  reporter Functoria.impl

val no_reporter : reporter Functoria.impl
07070100000069000081A40000000000000000000000016491641000000611000000000000000000000000000000000000003500000000mirage-4.4.0/lib/mirage/impl/mirage_impl_resolver.mlopen Functoria
module Key = Mirage_key
open Mirage_impl_misc
open Mirage_impl_mclock
open Mirage_impl_pclock
open Mirage_impl_stack
open Mirage_impl_random
open Mirage_impl_time

type resolver = Resolver

let resolver = Type.v Resolver

let resolver_unix_system =
  let packages_v =
    Key.(if_ is_unix)
      [
        Mirage_impl_conduit.pkg;
        package ~min:"4.0.0" ~max:"7.0.0" "conduit-lwt-unix";
      ]
      []
  in
  let configure i =
    match get_target i with
    | `Unix | `MacOSX -> Action.ok ()
    | _ -> Action.error "Unix resolver not supported on non-UNIX targets."
  in
  let connect _ _modname _ = "Lwt.return Resolver_lwt_unix.system" in
  impl ~packages_v ~configure ~connect "Resolver_lwt" resolver

let resolver_dns_conf ~ns =
  let packages = [ Mirage_impl_conduit.pkg ] in
  let keys = Key.[ v ns ] in
  let connect _ modname = function
    | [ _r; _t; _m; _p; stack ] ->
        Fmt.str
          "let nameservers = %a in@;\
           %s.v ?nameservers %s >|= function@;\
           | Ok r -> r@;\
           | Error (`Msg e) -> invalid_arg e@;"
          pp_key ns modname stack
    | _ -> failwith (connect_err "resolver" 3)
  in
  impl ~packages ~keys ~connect "Resolver_mirage.Make"
    (random @-> time @-> mclock @-> pclock @-> stackv4v6 @-> resolver)

let resolver_dns ?ns ?(time = default_time) ?(mclock = default_monotonic_clock)
    ?(pclock = default_posix_clock) ?(random = default_random) stack =
  let ns = Key.resolver ?default:ns () in
  resolver_dns_conf ~ns $ random $ time $ mclock $ pclock $ stack
0707010000006A000081A4000000000000000000000001649164100000018C000000000000000000000000000000000000003600000000mirage-4.4.0/lib/mirage/impl/mirage_impl_resolver.mlitype resolver

open Functoria
open Mirage_impl_random
open Mirage_impl_mclock
open Mirage_impl_pclock
open Mirage_impl_time

val resolver : resolver typ

val resolver_dns :
  ?ns:string list ->
  ?time:time impl ->
  ?mclock:mclock impl ->
  ?pclock:pclock impl ->
  ?random:random impl ->
  Mirage_impl_stack.stackv4v6 impl ->
  resolver impl

val resolver_unix_system : resolver Functoria.impl
0707010000006B000081A40000000000000000000000016491641000000F8E000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_stack.mlopen Functoria
open Mirage_impl_arpv4
open Mirage_impl_ethernet
open Mirage_impl_ip
open Mirage_impl_mclock
open Mirage_impl_misc
open Mirage_impl_network
open Mirage_impl_qubesdb
open Mirage_impl_random
open Mirage_impl_tcp
open Mirage_impl_time
open Mirage_impl_udp
module Key = Mirage_key

let dhcp_ipv4 ?random ?clock ?time tap e a =
  ipv4_of_dhcp ?random ?clock ?time tap e a

let static_ipv4 ?group ?config ?no_init e a =
  create_ipv4 ?group ?config ?no_init e a

let qubes_ipv4 ?(qubesdb = default_qubesdb) e a = ipv4_qubes qubesdb e a

(** dual stack *)

type stackv4v6 = STACKV4V6

let stackv4v6 = Type.v STACKV4V6

let stackv4v6_direct_conf () =
  let packages_v = right_tcpip_library ~sublibs:[ "stack-direct" ] "tcpip" in
  let connect _i modname = function
    | [ _t; _r; interface; ethif; arp; ipv4v6; icmpv4; udp; tcp ] ->
        Fmt.str "%s.connect %s %s %s %s %s %s %s" modname interface ethif arp
          ipv4v6 icmpv4 udp tcp
    | _ -> failwith (connect_err "direct stack" 8)
  in
  impl ~packages_v ~connect "Tcpip_stack_direct.MakeV4V6"
    (time
    @-> random
    @-> network
    @-> ethernet
    @-> arpv4
    @-> ipv4v6
    @-> Mirage_impl_icmp.icmpv4
    @-> udp
    @-> tcp
    @-> stackv4v6)

let direct_stackv4v6 ?(mclock = default_monotonic_clock)
    ?(random = default_random) ?(time = default_time) ~ipv4_only ~ipv6_only
    network eth arp ipv4 ipv6 =
  let ip = keyed_ipv4v6 ~ipv4_only ~ipv6_only ipv4 ipv6 in
  stackv4v6_direct_conf ()
  $ time
  $ random
  $ network
  $ eth
  $ arp
  $ ip
  $ Mirage_impl_icmp.direct_icmpv4 ipv4
  $ direct_udp ~random ip
  $ direct_tcp ~mclock ~random ~time ip

let static_ipv4v6_stack ?group ?ipv6_config ?ipv4_config ?(arp = arp ?time:None)
    tap =
  let ipv4_only = Key.ipv4_only ?group ()
  and ipv6_only = Key.ipv6_only ?group () in
  let e = etif tap in
  let a = arp e in
  let i4 = create_ipv4 ?group ?config:ipv4_config ~no_init:ipv6_only e a in
  let i6 = create_ipv6 ?group ?config:ipv6_config ~no_init:ipv4_only tap e in
  direct_stackv4v6 ~ipv4_only ~ipv6_only tap e a i4 i6

let generic_ipv4v6_stack p ?group ?ipv6_config ?ipv4_config
    ?(arp = arp ?time:None) tap =
  let ipv4_only = Key.ipv4_only ?group ()
  and ipv6_only = Key.ipv6_only ?group () in
  let e = etif tap in
  let a = arp e in
  let i4 =
    match_impl p
      [ (`Qubes, qubes_ipv4 e a); (`Dhcp, dhcp_ipv4 tap e a) ]
      ~default:(static_ipv4 ?group ?config:ipv4_config ~no_init:ipv6_only e a)
  in
  let i6 = create_ipv6 ?group ?config:ipv6_config ~no_init:ipv4_only tap e in
  direct_stackv4v6 ~ipv4_only ~ipv6_only tap e a i4 i6

let socket_stackv4v6 ?(group = "") () =
  let v4key = Key.V4.network ~group Ipaddr.V4.Prefix.global in
  let v6key = Key.V6.network ~group None in
  let ipv4_only = Key.ipv4_only ~group () in
  let ipv6_only = Key.ipv6_only ~group () in
  let packages_v = right_tcpip_library ~sublibs:[ "stack-socket" ] "tcpip" in
  let extra_deps =
    [
      dep (udpv4v6_socket_conf ~ipv4_only ~ipv6_only v4key v6key);
      dep (tcpv4v6_socket_conf ~ipv4_only ~ipv6_only v4key v6key);
    ]
  in
  let connect _i modname = function
    | [ udp; tcp ] -> Fmt.str "%s.connect %s %s" modname udp tcp
    | _ -> failwith (connect_err "socket stack" 2)
  in
  impl ~packages_v ~extra_deps ~connect "Tcpip_stack_socket.V4V6" stackv4v6

(** Generic stack *)
let generic_stackv4v6 ?group ?ipv6_config ?ipv4_config
    ?(dhcp_key = Key.value @@ Key.dhcp ?group ())
    ?(net_key = Key.value @@ Key.net ?group ()) (tap : network impl) :
    stackv4v6 impl =
  let choose target net dhcp =
    match (target, net, dhcp) with
    | `Qubes, _, _ -> `Qubes
    | _, Some `Socket, _ -> `Socket
    | _, _, true -> `Dhcp
    | (`Unix | `MacOSX), None, false -> `Socket
    | _, _, _ -> `Static
  in
  let p = Key.(pure choose $ Key.(value target) $ net_key $ dhcp_key) in
  match_impl p
    [ (`Socket, socket_stackv4v6 ?group ()) ]
    ~default:(generic_ipv4v6_stack p ?group ?ipv6_config ?ipv4_config tap)
0707010000006C000081A400000000000000000000000164916410000004E4000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_stack.mlitype stackv4v6

val stackv4v6 : stackv4v6 Functoria.typ

val direct_stackv4v6 :
  ?mclock:Mirage_impl_mclock.mclock Functoria.impl ->
  ?random:Mirage_impl_random.random Functoria.impl ->
  ?time:Mirage_impl_time.time Functoria.impl ->
  ipv4_only:bool Mirage_key.key ->
  ipv6_only:bool Mirage_key.key ->
  Mirage_impl_network.network Functoria.impl ->
  Mirage_impl_ethernet.ethernet Functoria.impl ->
  Mirage_impl_arpv4.arpv4 Functoria.impl ->
  Mirage_impl_ip.ipv4 Functoria.impl ->
  Mirage_impl_ip.ipv6 Functoria.impl ->
  stackv4v6 Functoria.impl

val socket_stackv4v6 : ?group:string -> unit -> stackv4v6 Functoria.impl

val static_ipv4v6_stack :
  ?group:string ->
  ?ipv6_config:Mirage_impl_ip.ipv6_config ->
  ?ipv4_config:Mirage_impl_ip.ipv4_config ->
  ?arp:
    (Mirage_impl_ethernet.ethernet Functoria.impl ->
    Mirage_impl_arpv4.arpv4 Functoria.impl) ->
  Mirage_impl_network.network Functoria.impl ->
  stackv4v6 Functoria.impl

val generic_stackv4v6 :
  ?group:string ->
  ?ipv6_config:Mirage_impl_ip.ipv6_config ->
  ?ipv4_config:Mirage_impl_ip.ipv4_config ->
  ?dhcp_key:bool Functoria.value ->
  ?net_key:[ `Direct | `Socket ] option Functoria.value ->
  Mirage_impl_network.network Functoria.impl ->
  stackv4v6 Functoria.impl
0707010000006D000081A40000000000000000000000016491641000000F74000000000000000000000000000000000000003300000000mirage-4.4.0/lib/mirage/impl/mirage_impl_syslog.mlopen Functoria
open Mirage_impl_misc
open Mirage_impl_pclock
open Mirage_impl_stack
module Key = Mirage_key

type syslog_config = {
  hostname : string;
  server : Ipaddr.t option;
  port : int option;
  truncate : int option;
}

let syslog_config ?port ?truncate ?server hostname =
  { hostname; server; port; truncate }

let default_syslog_config =
  let hostname = "no_name"
  and server = None
  and port = None
  and truncate = None in
  { hostname; server; port; truncate }

type syslog = SYSLOG

let syslog = Type.v SYSLOG
let opt p s = Fmt.(option @@ (any ("~" ^^ s ^^ ":") ++ p))
let opt_int = opt Fmt.int
let opt_string = opt (fun pp v -> Format.fprintf pp "%S" v)
let pkg sublibs = [ package ~min:"0.4.0" ~max:"0.5.0" ~sublibs "logs-syslog" ]

let syslog_udp_conf config =
  let endpoint = Key.syslog config.server in
  let port = Key.syslog_port config.port in
  let hostname = Key.syslog_hostname config.hostname in
  let packages = pkg [ "mirage" ] in
  let keys = Key.[ v endpoint; v hostname; v port ] in
  let connect _i modname = function
    | [ pclock; stack ] ->
        Fmt.str
          "@[<v 2>match %a with@ | None -> Lwt.return_unit@ | Some server ->@ \
           let port = %a in@ let reporter =@ %s.create %s %s ~hostname:%a \
           ?port server %a ()@ in@ Logs.set_reporter reporter;@ \
           Lwt.return_unit@]"
          pp_key endpoint pp_key port modname pclock stack pp_key hostname
          (opt_int "truncate") config.truncate
    | _ -> failwith (connect_err "syslog udp" 2)
  in
  impl ~packages ~keys ~connect "Logs_syslog_mirage.Udp"
    (pclock @-> stackv4v6 @-> syslog)

let syslog_udp ?(config = default_syslog_config) ?(clock = default_posix_clock)
    stack =
  syslog_udp_conf config $ clock $ stack

let syslog_tcp_conf config =
  let endpoint = Key.syslog config.server in
  let port = Key.syslog_port config.port in
  let hostname = Key.syslog_hostname config.hostname in
  let packages = pkg [ "mirage" ] in
  let keys = Key.[ v endpoint; v hostname; v port ] in
  let connect _i modname = function
    | [ pclock; stack ] ->
        Fmt.str
          "@[<v 2>match %a with@ | None -> Lwt.return_unit@ | Some server ->@ \
           let port = %a in@ %s.create %s %s ~hostname:%a ?port server %a () \
           >>= function@ | Ok reporter -> Logs.set_reporter reporter; \
           Lwt.return_unit@ | Error e -> invalid_arg e@]"
          pp_key endpoint pp_key port modname pclock stack pp_key hostname
          (opt_int "truncate") config.truncate
    | _ -> failwith (connect_err "syslog tcp" 2)
  in
  impl ~packages ~keys ~connect "Logs_syslog_mirage.Tcp"
    (pclock @-> stackv4v6 @-> syslog)

let syslog_tcp ?(config = default_syslog_config) ?(clock = default_posix_clock)
    stack =
  syslog_tcp_conf config $ clock $ stack

let syslog_tls_conf ?keyname config =
  let endpoint = Key.syslog config.server in
  let port = Key.syslog_port config.port in
  let hostname = Key.syslog_hostname config.hostname in
  let packages = pkg [ "mirage"; "mirage.tls" ] in
  let keys = Key.[ v endpoint; v hostname; v port ] in
  let connect _i modname = function
    | [ pclock; stack; kv ] ->
        Fmt.str
          "@[<v 2>match %a with@ | None -> Lwt.return_unit@ | Some server ->@ \
           let port = %a in@ %s.create %s %s %s ~hostname:%a ?port server %a \
           %a () >>= function@ | Ok reporter -> Logs.set_reporter reporter; \
           Lwt.return_unit@ | Error e -> invalid_arg e@]"
          pp_key endpoint pp_key port modname pclock stack kv pp_key hostname
          (opt_int "truncate") config.truncate (opt_string "keyname") keyname
    | _ -> failwith (connect_err "syslog tls" 3)
  in
  impl ~packages ~keys ~connect "Logs_syslog_mirage_tls.Tls"
    (pclock @-> stackv4v6 @-> Mirage_impl_kv.ro @-> syslog)

let syslog_tls ?(config = default_syslog_config) ?keyname
    ?(clock = default_posix_clock) stack kv =
  syslog_tls_conf ?keyname config $ clock $ stack $ kv
0707010000006E000081A40000000000000000000000016491641000000342000000000000000000000000000000000000003400000000mirage-4.4.0/lib/mirage/impl/mirage_impl_syslog.mlitype syslog

val syslog : syslog Functoria.typ

type syslog_config = {
  hostname : string;
  server : Ipaddr.t option;
  port : int option;
  truncate : int option;
}

val syslog_config :
  ?port:int -> ?truncate:int -> ?server:Ipaddr.t -> string -> syslog_config

val syslog_udp :
  ?config:syslog_config ->
  ?clock:Mirage_impl_pclock.pclock Functoria.impl ->
  Mirage_impl_stack.stackv4v6 Functoria.impl ->
  syslog Functoria.impl

val syslog_tcp :
  ?config:syslog_config ->
  ?clock:Mirage_impl_pclock.pclock Functoria.impl ->
  Mirage_impl_stack.stackv4v6 Functoria.impl ->
  syslog Functoria.impl

val syslog_tls :
  ?config:syslog_config ->
  ?keyname:string ->
  ?clock:Mirage_impl_pclock.pclock Functoria.impl ->
  Mirage_impl_stack.stackv4v6 Functoria.impl ->
  Mirage_impl_kv.ro Functoria.impl ->
  syslog Functoria.impl
0707010000006F000081A4000000000000000000000001649164100000078C000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/impl/mirage_impl_tcp.mlopen Functoria
open Mirage_impl_ip
open Mirage_impl_mclock
open Mirage_impl_misc
open Mirage_impl_random
open Mirage_impl_time
module Key = Mirage_key

type 'a tcp = TCP
type tcpv4v6 = v4v6 tcp

let tcp = Type.Type TCP
let tcpv4v6 : tcpv4v6 typ = tcp

(* this needs to be a function due to the value restriction. *)
let tcp_direct_func () =
  let packages_v = right_tcpip_library ~sublibs:[ "tcp" ] "tcpip" in
  let connect _ modname = function
    | [ ip; _time; _clock; _random ] -> Fmt.str "%s.connect %s" modname ip
    | _ -> failwith (connect_err "direct tcp" 4)
  in
  impl ~packages_v ~connect "Tcp.Flow.Make"
    (ip @-> time @-> mclock @-> random @-> tcp)

let direct_tcp ?(mclock = default_monotonic_clock) ?(time = default_time)
    ?(random = default_random) ip =
  tcp_direct_func () $ ip $ time $ mclock $ random

let tcpv4v6_socket_conf ~ipv4_only ~ipv6_only ipv4_key ipv6_key =
  let keys =
    [ Key.v ipv4_only; Key.v ipv6_only; Key.v ipv4_key; Key.v ipv6_key ]
  in
  let packages_v = right_tcpip_library ~sublibs:[ "tcpv4v6-socket" ] "tcpip" in
  let configure i =
    match get_target i with
    | `Unix | `MacOSX -> Action.ok ()
    | _ -> Action.error "TCPv4v6 socket not supported on non-UNIX targets."
  in
  let connect _ modname _ =
    Fmt.str "%s.connect ~ipv4_only:%a ~ipv6_only:%a %a %a" modname pp_key
      ipv4_only pp_key ipv6_only pp_key ipv4_key pp_key ipv6_key
  in
  impl ~packages_v ~configure ~keys ~connect "Tcpv4v6_socket" tcpv4v6

let socket_tcpv4v6 ?group ipv4 ipv6 =
  let ipv4 =
    match ipv4 with
    | None -> Ipaddr.V4.Prefix.global
    | Some ip -> Ipaddr.V4.Prefix.make 32 ip
  and ipv6 =
    match ipv6 with
    | None -> None
    | Some ip -> Some (Ipaddr.V6.Prefix.make 128 ip)
  and ipv4_only = Key.ipv4_only ?group ()
  and ipv6_only = Key.ipv6_only ?group () in
  tcpv4v6_socket_conf ~ipv4_only ~ipv6_only
    (Key.V4.network ?group ipv4)
    (Key.V6.network ?group ipv6)
07070100000070000081A400000000000000000000000164916410000002A9000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_tcp.mlitype 'a tcp

val tcp : 'a tcp Functoria.typ

type tcpv4v6 = Mirage_impl_ip.v4v6 tcp

val tcpv4v6 : tcpv4v6 Functoria.typ

val direct_tcp :
  ?mclock:Mirage_impl_mclock.mclock Functoria.impl ->
  ?time:Mirage_impl_time.time Functoria.impl ->
  ?random:Mirage_impl_random.random Functoria.impl ->
  'a Mirage_impl_ip.ip Functoria.impl ->
  'a tcp Functoria.impl

val socket_tcpv4v6 :
  ?group:string ->
  Ipaddr.V4.t option ->
  Ipaddr.V6.t option ->
  tcpv4v6 Functoria.impl

val tcpv4v6_socket_conf :
  ipv4_only:bool Mirage_key.key ->
  ipv6_only:bool Mirage_key.key ->
  Ipaddr.V4.Prefix.t Mirage_key.key ->
  Ipaddr.V6.Prefix.t option Mirage_key.key ->
  tcpv4v6 Functoria.impl
07070100000071000081A4000000000000000000000001649164100000029F000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_time.mlopen Functoria
module Key = Mirage_key

type time = TIME

let time = Type.v TIME

let default_time =
  let unix_time =
    impl ~packages:[ package "mirage-time" ] "Unix_os.Time" time
  in
  let solo5_time =
    impl ~packages:[ package "mirage-time" ] "Solo5_os.Time" time
  in
  let xen_time = impl ~packages:[ package "mirage-time" ] "Xen_os.Time" time in
  match_impl
    Key.(value target)
    [
      (`Unix, unix_time);
      (`MacOSX, unix_time);
      (`Xen, xen_time);
      (`Qubes, xen_time);
      (`Virtio, solo5_time);
      (`Hvt, solo5_time);
      (`Spt, solo5_time);
      (`Muen, solo5_time);
      (`Genode, solo5_time);
    ]
    ~default:unix_time
07070100000072000081A40000000000000000000000016491641000000050000000000000000000000000000000000000003200000000mirage-4.4.0/lib/mirage/impl/mirage_impl_time.mlitype time

val time : time Functoria.typ
val default_time : time Functoria.impl
07070100000073000081A400000000000000000000000164916410000006B6000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/impl/mirage_impl_udp.mlopen Functoria
open Mirage_impl_ip
open Mirage_impl_misc
open Mirage_impl_random
module Key = Mirage_key

type 'a udp = UDP
type udpv4v6 = v4v6 udp

let udp = Type.Type UDP
let udpv4v6 : udpv4v6 typ = udp

(* Value restriction ... *)
let udp_direct_func () =
  let packages_v = right_tcpip_library ~sublibs:[ "udp" ] "tcpip" in
  let connect _ modname = function
    | [ ip; _random ] -> Fmt.str "%s.connect %s" modname ip
    | _ -> failwith (connect_err "udp" 2)
  in
  impl ~packages_v ~connect "Udp.Make" (ip @-> random @-> udp)

let direct_udp ?(random = default_random) ip = udp_direct_func () $ ip $ random

let udpv4v6_socket_conf ~ipv4_only ~ipv6_only ipv4_key ipv6_key =
  let keys =
    [ Key.v ipv4_only; Key.v ipv6_only; Key.v ipv4_key; Key.v ipv6_key ]
  in
  let packages_v = right_tcpip_library ~sublibs:[ "udpv4v6-socket" ] "tcpip" in
  let configure i =
    match get_target i with
    | `Unix | `MacOSX -> Action.ok ()
    | _ -> Action.error "UDPv4v6 socket not supported on non-UNIX targets."
  in
  let connect _ modname _ =
    Fmt.str "%s.connect ~ipv4_only:%a ~ipv6_only:%a %a %a" modname pp_key
      ipv4_only pp_key ipv6_only pp_key ipv4_key pp_key ipv6_key
  in
  impl ~keys ~packages_v ~configure ~connect "Udpv4v6_socket" udpv4v6

let socket_udpv4v6 ?group ipv4 ipv6 =
  let ipv4 =
    match ipv4 with
    | None -> Ipaddr.V4.Prefix.global
    | Some ip -> Ipaddr.V4.Prefix.make 32 ip
  and ipv6 =
    match ipv6 with
    | None -> None
    | Some ip -> Some (Ipaddr.V6.Prefix.make 128 ip)
  and ipv4_only = Key.ipv4_only ?group ()
  and ipv6_only = Key.ipv6_only ?group () in
  udpv4v6_socket_conf ~ipv4_only ~ipv6_only
    (Key.V4.network ?group ipv4)
    (Key.V6.network ?group ipv6)
07070100000074000081A40000000000000000000000016491641000000243000000000000000000000000000000000000003100000000mirage-4.4.0/lib/mirage/impl/mirage_impl_udp.mlitype 'a udp

val udp : 'a udp Functoria.typ

type udpv4v6 = Mirage_impl_ip.v4v6 udp

val udpv4v6 : udpv4v6 Functoria.typ

val direct_udp :
  ?random:Mirage_impl_random.random Functoria.impl ->
  'a Mirage_impl_ip.ip Functoria.impl ->
  'a udp Functoria.impl

val socket_udpv4v6 :
  ?group:string ->
  Ipaddr.V4.t option ->
  Ipaddr.V6.t option ->
  udpv4v6 Functoria.impl

val udpv4v6_socket_conf :
  ipv4_only:bool Mirage_key.key ->
  ipv6_only:bool Mirage_key.key ->
  Ipaddr.V4.Prefix.t Mirage_key.key ->
  Ipaddr.V6.Prefix.t option Mirage_key.key ->
  udpv4v6 Functoria.impl
07070100000075000081A400000000000000000000000164916410000039BD000000000000000000000000000000000000002200000000mirage-4.4.0/lib/mirage/mirage.ml(*
 * Copyright (c) 2013 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2018 Mindy Preston     <meetup@yomimono.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Functoria
module Type = Type
module Impl = Impl
module Info = Info
module Dune = Dune
module Key = Mirage_key
module Log = Mirage_impl_misc.Log
include Functoria.DSL

(** {2 OCamlfind predicates} *)

(** {2 Devices} *)

type qubesdb = Mirage_impl_qubesdb.qubesdb

let qubesdb = Mirage_impl_qubesdb.qubesdb
let default_qubesdb = Mirage_impl_qubesdb.default_qubesdb

type time = Mirage_impl_time.time

let time = Mirage_impl_time.time
let default_time = Mirage_impl_time.default_time

type pclock = Mirage_impl_pclock.pclock

let pclock = Mirage_impl_pclock.pclock
let default_posix_clock = Mirage_impl_pclock.default_posix_clock

type mclock = Mirage_impl_mclock.mclock

let mclock = Mirage_impl_mclock.mclock
let default_monotonic_clock = Mirage_impl_mclock.default_monotonic_clock

type random = Mirage_impl_random.random

let random = Mirage_impl_random.random
let default_random = Mirage_impl_random.default_random
let rng = Mirage_impl_random.rng

type console = Mirage_impl_console.console

let console = Mirage_impl_console.console
let default_console = Mirage_impl_console.default_console
let custom_console = Mirage_impl_console.custom_console

type kv_ro = Mirage_impl_kv.ro

let kv_ro = Mirage_impl_kv.ro
let direct_kv_ro = Mirage_impl_kv.direct_kv_ro
let crunch = Mirage_impl_kv.crunch
let generic_kv_ro = Mirage_impl_kv.generic_kv_ro

type kv_rw = Mirage_impl_kv.rw

let kv_rw = Mirage_impl_kv.rw
let direct_kv_rw = Mirage_impl_kv.direct_kv_rw
let kv_rw_mem = Mirage_impl_kv.mem_kv_rw

let docteur ?mode ?disk ?analyze ?branch ?extra_deps remote =
  Mirage_impl_block.docteur ?mode ?disk ?analyze ?branch ?extra_deps remote

let chamelon ~program_block_size ?(pclock = default_posix_clock) block =
  Mirage_impl_block.chamelon ~program_block_size $ block $ pclock

let tar_kv_rw ?(pclock = default_posix_clock) block =
  Mirage_impl_block.tar_kv_rw pclock block

type block = Mirage_impl_block.block

let block = Mirage_impl_block.block
let tar_kv_ro = Mirage_impl_block.tar_kv_ro
let archive = Mirage_impl_block.archive
let fat_ro = Mirage_impl_block.fat_ro
let generic_block = Mirage_impl_block.generic_block
let ramdisk = Mirage_impl_block.ramdisk
let block_of_xenstore_id = Mirage_impl_block.block_of_xenstore_id
let block_of_file = Mirage_impl_block.block_of_file

let ccm_block ?nonce_len key block =
  Mirage_impl_block.ccm_block ?nonce_len key $ block

type network = Mirage_impl_network.network

let network = Mirage_impl_network.network
let netif = Mirage_impl_network.netif
let default_network = Mirage_impl_network.default_network

type ethernet = Mirage_impl_ethernet.ethernet

let ethernet = Mirage_impl_ethernet.ethernet
let etif = Mirage_impl_ethernet.etif

type arpv4 = Mirage_impl_arpv4.arpv4

let arpv4 = Mirage_impl_arpv4.arpv4
let arp = Mirage_impl_arpv4.arp

type v4 = Mirage_impl_ip.v4
type v6 = Mirage_impl_ip.v6
type v4v6 = Mirage_impl_ip.v4v6
type 'a ip = 'a Mirage_impl_ip.ip
type ipv4 = Mirage_impl_ip.ipv4
type ipv6 = Mirage_impl_ip.ipv6
type ipv4v6 = Mirage_impl_ip.ipv4v6

let ipv4 = Mirage_impl_ip.ipv4
let ipv6 = Mirage_impl_ip.ipv6
let ipv4_qubes = Mirage_impl_ip.ipv4_qubes
let ipv4v6 = Mirage_impl_ip.ipv4v6
let create_ipv4 = Mirage_impl_ip.create_ipv4
let create_ipv6 = Mirage_impl_ip.create_ipv6
let create_ipv4v6 = Mirage_impl_ip.create_ipv4v6

type ipv4_config = Mirage_impl_ip.ipv4_config = {
  network : Ipaddr.V4.Prefix.t;
  gateway : Ipaddr.V4.t option;
}

type ipv6_config = Mirage_impl_ip.ipv6_config = {
  network : Ipaddr.V6.Prefix.t;
  gateway : Ipaddr.V6.t option;
}

type 'a udp = 'a Mirage_impl_udp.udp

let udp = Mirage_impl_udp.udp

type udpv4v6 = Mirage_impl_udp.udpv4v6

let udpv4v6 = Mirage_impl_udp.udpv4v6
let direct_udp = Mirage_impl_udp.direct_udp
let socket_udpv4v6 = Mirage_impl_udp.socket_udpv4v6

type 'a tcp = 'a Mirage_impl_tcp.tcp

let tcp = Mirage_impl_tcp.tcp

type tcpv4v6 = Mirage_impl_tcp.tcpv4v6

let tcpv4v6 = Mirage_impl_tcp.tcpv4v6
let direct_tcp = Mirage_impl_tcp.direct_tcp
let socket_tcpv4v6 = Mirage_impl_tcp.socket_tcpv4v6

type stackv4v6 = Mirage_impl_stack.stackv4v6

let stackv4v6 = Mirage_impl_stack.stackv4v6
let generic_stackv4v6 = Mirage_impl_stack.generic_stackv4v6
let static_ipv4v6_stack = Mirage_impl_stack.static_ipv4v6_stack
let direct_stackv4v6 = Mirage_impl_stack.direct_stackv4v6
let socket_stackv4v6 = Mirage_impl_stack.socket_stackv4v6

let tcpv4v6_of_stackv4v6 v =
  let impl =
    let packages =
      [ package "tcpip" ~sublibs:[ "stack-direct" ] ~min:"7.1.0" ]
    in
    let connect _ modname = function
      | [ stackv4v6 ] -> Fmt.str {ocaml|%s.connect %s|ocaml} modname stackv4v6
      | _ -> assert false
    in
    impl ~packages ~connect "Tcpip_stack_direct.TCPV4V6" (stackv4v6 @-> tcpv4v6)
  in
  impl $ v

type conduit = Mirage_impl_conduit.conduit

let conduit = Mirage_impl_conduit.conduit
let conduit_direct = Mirage_impl_conduit.conduit_direct

type resolver = Mirage_impl_resolver.resolver

let resolver = Mirage_impl_resolver.resolver
let resolver_unix_system = Mirage_impl_resolver.resolver_unix_system
let resolver_dns = Mirage_impl_resolver.resolver_dns

type dns_client = Mirage_impl_dns.dns_client

let dns_client = Mirage_impl_dns.dns_client

let generic_dns_client ?timeout ?nameservers ?(random = default_random)
    ?(time = default_time) ?(mclock = default_monotonic_clock)
    ?(pclock = default_posix_clock) stackv4v6 =
  Mirage_impl_dns.generic_dns_client timeout nameservers
  $ random
  $ time
  $ mclock
  $ pclock
  $ stackv4v6

type happy_eyeballs = Mirage_impl_happy_eyeballs.happy_eyeballs

let happy_eyeballs = Mirage_impl_happy_eyeballs.happy_eyeballs

let generic_happy_eyeballs ?aaaa_timeout ?connect_delay ?connect_timeout
    ?resolve_timeout ?resolve_retries ?timer_interval ?(time = default_time)
    ?(mclock = default_monotonic_clock) stackv4v6 dns_client =
  Mirage_impl_happy_eyeballs.generic_happy_eyeballs aaaa_timeout connect_delay
    connect_timeout resolve_timeout resolve_retries timer_interval
  $ time
  $ mclock
  $ stackv4v6
  $ dns_client

type syslog = Mirage_impl_syslog.syslog

let syslog = Mirage_impl_syslog.syslog
let syslog_tls = Mirage_impl_syslog.syslog_tls
let syslog_tcp = Mirage_impl_syslog.syslog_tcp
let syslog_udp = Mirage_impl_syslog.syslog_udp

type syslog_config = Mirage_impl_syslog.syslog_config = {
  hostname : string;
  server : Ipaddr.t option;
  port : int option;
  truncate : int option;
}

let syslog_config = Mirage_impl_syslog.syslog_config

type http = Mirage_impl_http.http

let http = Mirage_impl_http.http
let cohttp_server = Mirage_impl_http.cohttp_server
let httpaf_server = Mirage_impl_http.httpaf_server

type http_client = Mirage_impl_http.http_client

let http_client = Mirage_impl_http.http_client
let cohttp_client = Mirage_impl_http.cohttp_client

type http_server = Mirage_impl_http.http_server

let http_server = Mirage_impl_http.http_server
let paf_server ~port tcpv4v6 = Mirage_impl_http.paf_server port $ tcpv4v6

type alpn_client = Mirage_impl_http.alpn_client

let alpn_client = Mirage_impl_http.alpn_client

let paf_client ?(pclock = default_posix_clock) tcpv4v6 mimic =
  Mirage_impl_http.paf_client $ pclock $ tcpv4v6 $ mimic

type argv = Functoria.argv

let argv = Functoria.argv
let default_argv = Mirage_impl_argv.default_argv
let no_argv = Mirage_impl_argv.no_argv

type reporter = Mirage_impl_reporter.reporter

let reporter = Mirage_impl_reporter.reporter
let default_reporter = Mirage_impl_reporter.default_reporter
let no_reporter = Mirage_impl_reporter.no_reporter

type mimic = Mirage_impl_mimic.mimic

let mimic = Mirage_impl_mimic.mimic

let mimic_happy_eyeballs stackv4v6 dns_client happy_eyeballs =
  Mirage_impl_mimic.mimic_happy_eyeballs
  $ stackv4v6
  $ dns_client
  $ happy_eyeballs

type git_client = Mirage_impl_git.git_client

let git_client = Mirage_impl_git.git_client

let merge_git_clients ctx0 ctx1 =
  Mirage_impl_git.git_merge_clients $ ctx0 $ ctx1

let git_tcp tcpv4v6 ctx = Mirage_impl_git.git_tcp $ tcpv4v6 $ ctx

let git_ssh ?authenticator ~key ~password ?(mclock = default_monotonic_clock)
    ?(time = default_time) tcpv4v6 ctx =
  Mirage_impl_git.git_ssh ?authenticator key password
  $ mclock
  $ tcpv4v6
  $ time
  $ ctx

let git_http ?authenticator ?headers ?(pclock = default_posix_clock) tcpv4v6 ctx
    =
  Mirage_impl_git.git_http ?authenticator headers $ pclock $ tcpv4v6 $ ctx

(** Functoria devices *)

type info = Functoria.info

let job = Functoria.job
let noop = Functoria.noop
let info = Functoria.info

let app_info_partial =
  Functoria.app_info ~runtime_package:"mirage-runtime" ~modname:"Mirage_runtime"

let app_info = app_info_partial ()
let app_info_with_opam_deps build_info = app_info_partial ~build_info ()

let os_of_target i =
  match Info.get i Key.target with
  | #Key.mode_solo5 -> "Solo5_os"
  | #Key.mode_unix -> "Unix_os"
  | #Key.mode_xen -> "Xen_os"

module Project = struct
  let name = "mirage"
  let version = "%%VERSION%%"

let prelude info =
    Fmt.str
      {ocaml|open Lwt.Infix
let return = Lwt.return
let run t = %s.Main.run t ; exit 0|ocaml}
      (os_of_target info)

(* The ocamlfind packages to use when compiling config.ml *)
  let packages = [ package "mirage" ]

let name_of_target i =
    match Info.output i with
    | Some o -> o
    | None ->
        let name = Info.name i in
        let target = Info.get i Key.target in
        Fmt.str "%s-%a" name Key.pp_target target

let dune i = Mirage_target.dune i
  let configure i = Mirage_target.configure i

let dune_project =
    [ Dune.stanza {|
    (implicit_transitive_deps true)
    |} ]

let dune_workspace =
    let f ?build_dir i =
      let stanzas = Mirage_target.build_context ?build_dir i in
      let main =
        Dune.stanza {|
(lang dune 2.0)

(context (default))
        |}
      in
      Dune.v (main :: stanzas)
    in
    Some f

let context_name i = Mirage_target.context_name i

let create jobs =
    let keys = Key.[ v target ] in
    let packages_v =
      (* XXX: use %%VERSION_NUM%% here instead of hardcoding a version? *)
      let min = "4.4.0" and max = "4.5.0" in
      let common =
        [
          package ~scope:`Monorepo "lwt";
          package ~scope:`Monorepo ~min ~max "mirage-runtime";
          package ~scope:`Switch ~build:true ~min ~max "mirage";
          package ~scope:`Switch ~build:true ~min:"0.3.2" "opam-monorepo";
        ]
      in
      Key.match_ Key.(value target) @@ fun target ->
      Mirage_target.packages target @ common
    in
    let install = Mirage_target.install in
    let extra_deps = List.map dep jobs in
    let connect _ _ _ = "return ()" in
    impl ~keys ~packages_v ~configure ~dune ~connect ~extra_deps ~install
      "Mirage_runtime" job
end

include Lib.Make (Project)
module Tool = Tool.Make (Project)

let backtrace =
  let keys = [ Key.v Key.backtrace ] in
  let connect _ _ _ =
    Fmt.str "return (Printexc.record_backtrace %a)" Mirage_impl_misc.pp_key
      Key.backtrace
  in
  impl ~keys ~connect "Printexc" job

let randomize_hashtables =
  let keys = [ Key.v Key.randomize_hashtables ] in
  let connect _ _ _ =
    Fmt.str "return (if %a then Hashtbl.randomize ())" Mirage_impl_misc.pp_key
      Key.randomize_hashtables
  in
  impl ~keys ~connect "Hashtbl" job

let gc_control =
  let pp_pol ~name =
    Fmt.(
      any name
      ++ any " = "
      ++ any "(match "
      ++ Mirage_impl_misc.pp_key
      ++ any " with `Next_fit -> 0 | `First_fit -> 1 | `Best_fit -> 2)")
  and pp_k ~name =
    Fmt.(
      any name
      ++ any " = "
      ++ any "(match "
      ++ Mirage_impl_misc.pp_key
      ++ any " with None -> ctrl."
      ++ any name
      ++ any " | Some x -> x)")
  in
  let keys =
    Key.
      [
        v allocation_policy;
        v minor_heap_size;
        v major_heap_increment;
        v space_overhead;
        v max_space_overhead;
        v gc_verbosity;
        v gc_window_size;
        v custom_major_ratio;
        v custom_minor_ratio;
        v custom_minor_max_size;
      ]
  in
  let connect _ _ _ =
    Fmt.str
      "return (@.@[<v 2>let open Gc in@ let ctrl = get () in@ set ({ ctrl with \
       %a;@ %a;@ %a;@ %a;@ %a;@ %a;@ %a;@ %a;@ %a;@ %a })@]@.)"
      (pp_pol ~name:"allocation_policy")
      Key.allocation_policy
      (pp_k ~name:"minor_heap_size")
      Key.minor_heap_size
      (pp_k ~name:"major_heap_increment")
      Key.major_heap_increment
      (pp_k ~name:"space_overhead")
      Key.space_overhead
      (pp_k ~name:"max_overhead")
      Key.max_space_overhead (pp_k ~name:"verbose") Key.gc_verbosity
      (pp_k ~name:"window_size") Key.gc_window_size
      (pp_k ~name:"custom_major_ratio")
      Key.custom_major_ratio
      (pp_k ~name:"custom_minor_ratio")
      Key.custom_minor_ratio
      (pp_k ~name:"custom_minor_max_size")
      Key.custom_minor_max_size
  in
  impl ~keys ~connect "Gc" job

(** Custom registration *)

let keys argv =
  Functoria.keys ~runtime_package:"mirage-runtime"
    ~runtime_modname:"Mirage_runtime" argv

let ( ++ ) acc x =
  match (acc, x) with
  | _, None -> acc
  | None, Some x -> Some [ x ]
  | Some acc, Some x -> Some (acc @ [ x ])

let register ?(argv = default_argv) ?(reporter = default_reporter ())
    ?keys:extra_keys ?packages ?src name jobs =
  if List.exists Functoria.Impl.app_has_no_arguments jobs then
    invalid_arg
      "Your configuration includes a job without arguments. Please add a \
       dependency in your config.ml: use `let main = Mirage.main \
       \"Unikernel.hello\" (job @-> job) register \"hello\" [ main $ noop ]` \
       instead of `.. job .. [ main ]`.";
  let first = [ keys argv; backtrace; randomize_hashtables; gc_control ] in
  let reporter = if reporter == no_reporter then None else Some reporter in
  let init = Some first ++ reporter in
  register ?keys:extra_keys ?packages ?init ?src name jobs

module Action = Functoria.Action
07070100000076000081A40000000000000000000000016491641000009263000000000000000000000000000000000000002300000000mirage-4.4.0/lib/mirage/mirage.mli(*
 * Copyright (c) 2013 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013 Anil Madhavapeddy <anil@recoil.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** {e Release %%VERSION%%} *)

(** {1 What is MirageOS?}

MirageOS is a library operating system that can build standalone unikernels
    on various platforms. More precisely, the architecture can be divided into:

- {e operating system libraries} that implement kernel and protocol
      functionality, ranging from low-level network card drivers to a full
      reimplementation of the TLS protocol, through to a reimplementation of the
      Git protocol to store versioned data.

- A set of {e typed signatures} to make sure these libraries are consistent
      and can interoperate. As all the library are almost all pure OCaml code,
      we have defined {e a set of OCaml module types} that encode these
      conventions in a statically enforcable way. We make no compatibility
      guarantees at the C level, but compile those on a best-effort basis.

- Finally, MirageOS is also a {e metaprogramming compiler} that generates
      OCaml code. It takes as input: the OCaml source code of a program and all
      of its dependencies, the full description of the deployment target,
      including configuration values (like the HTTP port to listen on, or the
      private key or the service being deployed). The `mirage`CLI tool uses all
      of these to {e generate a executable unikernel}: a specialised binary
      artefact containing only the code what is needed to run on the given
      deployment platform and no more.

It is possible to write high-level MirageOS applications, such as HTTPS,
    email or CalDAV servers which can be deployed on very heterogenous and
    embedded platforms by changing only a few compilation parameters. The
    supported platforms range from minimal virtual machines running on cloud
    providers, or processes running inside Docker containers configured with a
    tight security profile. In general, these platform do not have a full POSIX
    environment; MirageOS does not try to emulate POSIX and focuses on providing
    a small, well-defined, typed interface with the system components. The
    nearest equivalent to the MirageOS approach is the WASI (wasi.dev) set of
    interfaces for WebAssembly.

{2 Is everything really written in OCaml?}

While most of the code is written in OCaml, a typed, high-level language
    with many good safety properties, there are pieces of MirageOS which are
    still written in C. These bits can be separated in three categories:

- The OCaml runtime is written in C. It needs to be ported to the platform
      that MirageOS is trying to target, which do not support POSIX. Hence, the
      first component to port to a new platform is the OCaml runtime.

- The low-level device drivers (network, console, clock, etc) also need some
      C bits.

- The base usual C bindings; some libraries are widely used and
      (unfortunately) very hard (but not impossible) to replace them completely
      without taking a big performance hit or having to trust code without much
      real-world usages. This is the case for low-level bit handling for crypto
      code (even if we try to make sure allocation is alway handled by the OCaml
      runtime) as well as arbitrary precision numeric computation (e.g. gmp).
      Ideally we could image rewriting all of these libraries in OCaml if we had
      an infinite amount of time in our hands.

{2 MirageOS as a cross-compilator}

The MirageOS compiler is basically a cross-compiler, where the host and
    target toolchain are identical, but with different flags for the C bindings:
    for instance, it is necessary to pass [-freestanding] to {e all} C bindings
    to not use POSIX headers. The MirageOS compiler also uses a custom linker:
    eg. not only it needs a custom OCaml's runtime [libasmrun.a], but it also
    needs to run a different linker to generate specialised executable images.

Historically, the OCaml ecosystem always had partial support for
    cross-compilation: for instance, the
    {{:https://github.com/ocaml-cross/opam-cross-windows} ocaml-cross} way of
    doing it is to duplicate {e all} existing opam pacakges by adding a
    [-windows] suffix to their names and dependencies; this allows normal
    packages and windows packages can be co-installed in the same opam switch.

{3 MirageOS 3.x}

MirageOS 3.x solves this by duplicating only the packages defining C
    bindings. It relies on every MirageOS backend registering a set of [CFLAGS]
    with [pkg-config]. Then every bindings uses [pkg-config] to configure their
    [CFLAGS] and [ocamlfind] to register
    {{:https://github.com/ocaml/opam-repository/blob/master/packages/zarith-xen/zarith-xen.1.7/files/mirage-install.sh#L20}
      link-time predicates}, e.g. additional link time options like the name of
    the C archives. Finally, the final link step is done by querying ocamlfind
    (using the custom registered predicates) to link the list of dependencies'
    objects files with the result of OCam compiler's [--output-obj] option.

{4 MirageOS 4.x}

MirageOS 4 solves this by relying on [dune]'s built-in support for
    cross-compilation. This is done by gathering all the sources of the
    dependencies locally with [opam-monorepo], and by creating a
    `dune-workspace` file describing the C flags to use in each
    cross-compilation "context". Once this is set-up, only one [dune build] can
    cross-compile the unikernel target with all its local sources.

{1 MirageOS eDSL}

The rest of the document describes Functoria, the embedded domain-specific
    language to be used in [config.ml] files, to described how the typed
    libraries have to be assembled. *)

include Functoria.DSL
(** @inline *)

(** Configuration keys. *)
module Key : module type of struct
  include Mirage_key
  (** @inline *)
end

val abstract : 'a impl -> abstract_impl [@@ocaml.deprecated "Use Mirage.dep."]

(** {2 General mirage devices} *)

type qubesdb

val qubesdb : qubesdb typ
(** For the Qubes target, the Qubes database from which to look up dynamic
    runtime configuration information. *)

val default_qubesdb : qubesdb impl
(** A default qubes database, guessed from the usual valid configurations. *)

(** {2 Time} *)

type time
(** Abstract type for timers. *)

val time : time typ
(** Implementations of the [Mirage_time.S] signature. *)

val default_time : time impl
(** The default timer implementation. *)

(** {2 Clocks} *)

type pclock
(** Abstract type for POSIX clocks. *)

val pclock : pclock typ
(** Implementations of the [Mirage_clock.PCLOCK] signature. *)

val default_posix_clock : pclock impl
(** The default mirage-clock [Mirage_clock.PCLOCK] implementation. *)

type mclock
(** Abstract type for monotonic clocks *)

val mclock : mclock typ
(** Implementations of the [Mirage_clock.MCLOCK] signature. *)

val default_monotonic_clock : mclock impl
(** The default mirage-clock [Mirage_clock.MCLOCK] implementation. *)

(** {2 Log reporters} *)

type reporter
(** The type for log reporters. *)

val reporter : reporter typ
(** Implementation of the log {!type:reporter} type. *)

val default_reporter :
  ?clock:pclock impl -> ?level:Logs.level option -> unit -> reporter impl
(** [default_reporter ?clock ?level ()] is the log reporter that prints log
    messages to the console, timestampted with [clock]. If not provided, the
    default clock is {!default_posix_clock}. [level] is the default log
    threshold. It is [Some Logs.Info] if not specified. *)

val no_reporter : reporter impl
(** [no_reporter] disable log reporting. *)

(** {2 Random} *)

type random
(** Abstract type for random sources. *)

val random : random typ
(** Implementations of the [Mirage_random.S] signature. *)

val default_random : random impl
(** Default PRNG device to be used in unikernels. It uses getrandom/getentropy
    on Unix, and a Fortuna PRNG on other targets. *)

val rng : ?time:time impl -> ?mclock:mclock impl -> unit -> random impl
(** [rng ()] is the device [Mirage_crypto_rng.Make]. *)

(** {2 Consoles} *)

type console
(** Abstract type for consoles. *)

val console : console typ
  [@@ocaml.deprecated "use Logs and Printf instead"]
(** Implementations of the [Mirage_console.S] signature. *)

val default_console : console impl
  [@@ocaml.deprecated "use Logs and Printf instead"]
(** Default console implementation. *)

val custom_console : string -> console impl
  [@@ocaml.deprecated "use Logs and Printf instead"]
(** Custom console implementation. *)

(** {2 Block devices} *)

type block
(** Abstract type for raw block device configurations. *)

val block : block typ
(** Implementations of the [Mirage_block.S] signature. *)

val block_of_file : string -> block impl
(** Use the given file as a raw block device. *)

val block_of_xenstore_id : string -> block impl
(** Use the given XenStore ID (ex: [/dev/xvdi1] or [51760]) as a raw block
    device. *)

val ramdisk : string -> block impl
(** Use a ramdisk with the given name. *)

val generic_block :
  ?group:string ->
  ?key:[ `XenstoreId | `BlockFile | `Ramdisk ] value ->
  string ->
  block impl

(** {2 Static key/value stores} *)

type kv_ro
(** Abstract type for read-only key/value store. *)

val kv_ro : kv_ro typ
(** Implementations of the [Mirage_kv.RO] signature. *)

val crunch : string -> kv_ro impl
(** Crunch a directory. The contents of the directory is transformed into OCaml
    code, which is then compiled as part of the unikernel. *)

val tar_kv_ro : block impl -> kv_ro impl
(** [tar_kv_ro block] is a read-only tar archive. *)

val archive : block impl -> kv_ro impl
  [@@ocaml.deprecated "use Mirage.tar_kv_ro"]
(** @deprecated You should use {!val:tar_kv_ro} (or {!val:tar_kv_rw}). *)

val direct_kv_ro : string -> kv_ro impl
(** Direct access to the underlying filesystem as a key/value store for Unix.
    For other backends, this is equivalent to [crunch]. *)

val fat_ro : block impl -> kv_ro impl
(** Use a FAT formatted block device. *)

val generic_kv_ro :
  ?group:string -> ?key:[ `Crunch | `Direct ] value -> string -> kv_ro impl
(** Generic key/value that will choose dynamically between {!direct_kv_ro} and
    {!crunch}. To use a filesystem implementation, try {!kv_ro_of_fs}.

If no key is provided, it uses {!Key.kv_ro} to create a new one. *)

val docteur :
  ?mode:[ `Fast | `Light ] ->
  ?disk:string Key.key ->
  ?analyze:bool Key.key ->
  ?branch:string ->
  ?extra_deps:string list ->
  string ->
  kv_ro impl
(** [docteur ?mode ?disk ?analyze remote] is a read-only, key-value store
    device. Data is stored on that device using the Git PACK file format,
    version 2. This format has very good compression factors for many similar
    files of relatively small size. For instance, 14Gb of HTML files can be
    compressed into a disk image of 240Mb.

Unlike {!crunch}, [docteur] produces an external image which means that less
    memory is used to keep and get files. The image can be produced from many
    sources:

- A local Git repository (like [file://path/to/the/git/repository/])
    - A simple directory (like [file://path/to/a/simple/directory/])
    - A remote Git repository (via SSH, HTTP(S) or TCP/IP as what [git clone]
      expects)

If you use a Git repository, you can choose a specific branch with the
    [?branch] argument (like [refs/heads/main]). Otherwise, this argument is
    ignored.

If you use a simple directory, it can be a relative from your unikernel
    project ([relativize://directory]) or an absolute path
    ([file://home/user/directory]).

If a required file is produced by a [dune] rule, you must notice it via the
    [extra_deps] argument.

For a Solo5 target, users must {i attach} the image as a block device:

{[
      $ solo5-hvt --block:<name>=<path-to-the-image> -- unikernel.{hvt,...}
    ]}

For the Unix target, the program [open] the image at the beginning of the
    process. An integrity check of the image can be done via the [analyze] value
    (defaults to [true]).

It's possible to use the file-system into 2 modes:

- [`Light]: any access requires that we reconstruct the path to the
      requested file. That means that we will need to extract a few additional
      objects before the extraction of the requested one. [`Light] does not
      cache anything in memory but it can be slower if the requested file is
      deep in the directory structure.
    - [`Fast]: reconstructs and cache the layout of the directory structure when
      the unikernel starts: it might increase boot-time and bigger memory
      requirements. However, [`Fast] allows the device to decode only the
      requested object so it is faster than the [`Light] mode. *)

type kv_rw
(** Abstract type for read-write key/value store. *)

val kv_rw : kv_rw typ
(** Implementations of the [Mirage_kv.RW] signature. *)

val direct_kv_rw : string -> kv_rw impl
(** Direct access to the underlying filesystem as a key/value store. Only
    available on Unix backends. *)

val kv_rw_mem : ?clock:pclock impl -> unit -> kv_rw impl
(** An in-memory key-value store using [mirage-kv-mem]. *)

val chamelon :
  program_block_size:int key -> ?pclock:pclock impl -> block impl -> kv_rw impl
(** [chamelon ~program_block_size] returns a {!kv_rw} filesystem which is an
    implementation of {{:https://github.com/littlefs-project/littlefs} littlefs}
    in OCaml. The [chamelon] device expects a {i block-device}:

{[
      let program_block_size =
        let doc = Key.Arg.info [ "program-block-size" ] in
        Key.(create "program_block_size" Arg.(opt int 16 doc))

let block = block_of_file "db"
      let fs = chamelon ~program_block_size block
    ]}

For Solo5 targets, you finally can launch the unikernel with:

{[
      $ solo5-hvt --block:db=db.img unikernel.hvt
    ]}

The block-device must be well-formed and {i formatted} by the [chamelon]
    tool:

{[
      $ dd if=/dev/zero of=db.img bs=1M count=1
      $ chamelon format db.img 512
    ]} *)

val tar_kv_rw : ?pclock:pclock impl -> block impl -> kv_rw impl
(** [tar_kv_rw block] is a read/write tar archive. Note that the filesystem is
    append-only. That is, files can generally not be removed, [set_partial] only
    works on what is allocated, and there are restrictions on [rename]. *)

val ccm_block : ?nonce_len:int -> string option key -> block impl -> block impl
(** [ccm_block key block] returns a new block which is a AES-CCM encrypted disk.

{b Note} also that the available size of an encrypted block is always
    divided by 2 of its real size: a 512M block will only be able to contain
    256M data if it is encrypted.

You can either use a fresh block device as encrypted storage. This does not
    need any preparation, just using [ccm_block] with the desired [key]. If you
    have an existing disk image that you want to encrypt, you can use the
    [ccmblock] tool given by the [mirage-block-ccm] opam package.

{[
      $ ccmblock enc -i db.img -k 0x10786d3a9c920d0b3ec80dfaaac557a7 -o edb.img
    ]}

Then, into you [config.ml], you just need to compose your block device with
    [ccm_block]:

{[
      let aes_ccm_key =
        let doc =
          Key.Arg.info [ "aes-ccm-key" ]
            ~doc:"The key of the block device (hex formatted)"
        in
        Key.(create "aes-ccm-key" Arg.(required string doc))

let block = block_of_file "edb"
      let encrypted_block = ccm_block aes_ccm_key block
    ]}

Finally, with Solo5, you can launch your unikernel with that:

{[
      $ solo5-hvt --block:edb=edb.img \
        --arg="--aes-ccm-key=0x10786d3a9c920d0b3ec80dfaaac557a7" \
        unikernel.hvt
    ]}

You can finally compose a file-system such as {!chamelon} with this block
    device (and you have a encrypted file-system!):

{[
      let fs = chamelon ~program_block_size encrypted_block
    ]} *)

(** {2 Network interfaces} *)

type network
(** Abstract type for network configurations. *)

val network : network typ
(** Implementations of the [Mirage_net.S] signature. *)

val default_network : network impl
(** [default_network] is a dynamic network implementation which attempts to do
    something reasonable based on the target. *)

val netif : ?group:string -> string -> network impl
(** A custom network interface. Exposes a {!Key.interface} key. *)

(** {2 Ethernet configuration} *)

type ethernet

val ethernet : ethernet typ
(** Implementations of the [Ethernet.S] signature. *)

val etif : network impl -> ethernet impl

(** {2 ARP configuration} *)

type arpv4

val arpv4 : arpv4 typ
(** Implementation of the [Arp.S] signature. *)

val arp : ?time:time impl -> ethernet impl -> arpv4 impl
(** ARP implementation provided by the arp library *)

(** {2 IP configuration}

Implementations of the [Tcpip.Ip.S] signature. *)

type v4
type v6
type v4v6

type 'a ip
(** Abstract type for IP configurations. *)

type ipv4 = v4 ip
type ipv6 = v6 ip
type ipv4v6 = v4v6 ip

val ipv4 : ipv4 typ
(** The [Tcpip.Ip.S] module signature with ipaddr = Ipaddr.V4. *)

val ipv6 : ipv6 typ
(** The [Tcpip.Ip.S] module signature with ipaddr = Ipaddr.V6. *)

val ipv4v6 : ipv4v6 typ
(** The [Tcpip.Ip.S] module signature with ipaddr = Ipaddr.t. *)

type ipv4_config = {
  network : Ipaddr.V4.Prefix.t;
  gateway : Ipaddr.V4.t option;
}
(** Types for manual IPv4 configuration. *)

type ipv6_config = {
  network : Ipaddr.V6.Prefix.t;
  gateway : Ipaddr.V6.t option;
}
(** Types for manual IPv6 configuration. *)

val create_ipv4 :
  ?group:string ->
  ?config:ipv4_config ->
  ?no_init:bool Key.key ->
  ?random:random impl ->
  ?clock:mclock impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl
(** Use an IPv4 address Exposes the keys {!Key.V4.network} and
    {!Key.V4.gateway}. If provided, the values of these keys will override those
    supplied in the ipv4 configuration record, if that has been provided. *)

val ipv4_qubes :
  ?random:random impl ->
  ?clock:mclock impl ->
  qubesdb impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl
(** Use a given initialized QubesDB to look up and configure the appropriate *
    IPv4 interface. *)

val create_ipv6 :
  ?random:random impl ->
  ?time:time impl ->
  ?clock:mclock impl ->
  ?group:string ->
  ?config:ipv6_config ->
  ?no_init:bool Key.key ->
  network impl ->
  ethernet impl ->
  ipv6 impl
(** Use an IPv6 address. Exposes the keys {!Key.V6.network}, {!Key.V6.gateway}. *)

val create_ipv4v6 : ?group:string -> ipv4 impl -> ipv6 impl -> ipv4v6 impl

(** {2 UDP configuration} *)

type 'a udp
type udpv4v6 = v4v6 udp

val udp : 'a udp typ
(** Implementation of the [Tcpip.Udp.S] signature. *)

val udpv4v6 : udpv4v6 typ
val direct_udp : ?random:random impl -> 'a ip impl -> 'a udp impl

val socket_udpv4v6 :
  ?group:string -> Ipaddr.V4.t option -> Ipaddr.V6.t option -> udpv4v6 impl

(** {2 TCP configuration} *)

type 'a tcp
type tcpv4v6 = v4v6 tcp

val tcp : 'a tcp typ
(** Implementation of the [Tcpip.Tcp.S] signature. *)

val tcpv4v6 : tcpv4v6 typ

val direct_tcp :
  ?mclock:mclock impl ->
  ?time:time impl ->
  ?random:random impl ->
  'a ip impl ->
  'a tcp impl

val socket_tcpv4v6 :
  ?group:string -> Ipaddr.V4.t option -> Ipaddr.V6.t option -> tcpv4v6 impl

(** {2 Network stack configuration} *)

(** {3 Dual IPv4 and IPv6} *)

type stackv4v6

val stackv4v6 : stackv4v6 typ
(** Implementation of the [Tcpip.Stack.V4V6] signature. *)

val direct_stackv4v6 :
  ?mclock:mclock impl ->
  ?random:random impl ->
  ?time:time impl ->
  ipv4_only:bool Key.key ->
  ipv6_only:bool Key.key ->
  network impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl ->
  ipv6 impl ->
  stackv4v6 impl
(** Direct network stack with given ip. *)

val socket_stackv4v6 : ?group:string -> unit -> stackv4v6 impl
(** Network stack with sockets. *)

val static_ipv4v6_stack :
  ?group:string ->
  ?ipv6_config:ipv6_config ->
  ?ipv4_config:ipv4_config ->
  ?arp:(ethernet impl -> arpv4 impl) ->
  network impl ->
  stackv4v6 impl
(** Build a stackv4v6 by checking the {!Key.V6.network}, and {!Key.V6.gateway}
    keys for IPv4 and IPv6 configuration information, filling in unspecified
    information from [?config], then building a stack on top of that. *)

val generic_stackv4v6 :
  ?group:string ->
  ?ipv6_config:ipv6_config ->
  ?ipv4_config:ipv4_config ->
  ?dhcp_key:bool value ->
  ?net_key:[ `Direct | `Socket ] option value ->
  network impl ->
  stackv4v6 impl
(** Generic stack using a [net] keys: {!Key.net}.

- If [net] = [socket] then {!socket_stackv4v6} is used
    - Else, if [unix or macosx] then {!socket_stackv4v6} is used
    - Else, {!static_ipv4v6_stack} is used.

If a key is not provided, it uses {!Key.net} (with the [group] argument) to
    create it. *)

val tcpv4v6_of_stackv4v6 : stackv4v6 impl -> tcpv4v6 impl
(** [tcpv4v6 stackv4v6] is an helper to extract the TCP/IP stack regardless the
    UDP/IP stack expected by some {i devices} such as protocols. *)

(** {2 Resolver configuration} *)

type resolver

val resolver : resolver typ

val resolver_dns :
  ?ns:string list ->
  ?time:time impl ->
  ?mclock:mclock impl ->
  ?pclock:pclock impl ->
  ?random:random impl ->
  stackv4v6 impl ->
  resolver impl

val resolver_unix_system : resolver impl

(** {2 DNS client} *)

(** A DNS client is a module which implements:

- [getaddrinfo] to request a [query_type]-dependent response to a nameserver
      regarding a domain-name such as the [MX] record.
    - [gethostbyname] to request the [A] regarding a domain-name
    - [gethostbyname6] to request the [AAAA] record regarding a domain-name *)

type dns_client

val dns_client : dns_client typ

val generic_dns_client :
  ?timeout:int64 option key ->
  ?nameservers:string list key ->
  ?random:random impl ->
  ?time:time impl ->
  ?mclock:mclock impl ->
  ?pclock:pclock impl ->
  stackv4v6 impl ->
  dns_client impl
(** [generic_dns_client stackv4v6] creates a new DNS value which is able to
    resolve domain-name from [nameservers]. It requires a network stack to
    communicate with these nameservers.

The [nameservers] argument is a list of strings. The format of them is:

- [udp:ipaddr(:port)?] if you want to communicate with a DNS resolver
      {i via} UDP
    - [tcp:ipaddr(:port)?] if you want to communicate with a DNS resolver
      {i via} TCP/IP
    - [tls:ipaddr(:port)?(!<authenticator>)] if you to communicate with a DNS
      resolver {i via} TLS. You are able to introduce an [<authenticator>]
      (please, follow the documentation about [X509.Authenticator.of_string] to
      get an explanation of its format). Otherwise, by default, we use trust
      anchors from NSS' [certdata.txt]. *)

(** {2 Happy-eyeballs} *)

(** Happy-eyeballs is an implementation of RFC 8305 which specifies how to
    connect to a remote host using either IP protocol version 4 or IP protocol
    version 6 from a [stackv4v6] network implementation.

The given {i device} is able to resolve a remote host {i via} a
    {!dns_client} device and both must share the same [stackv4v6]
    implementation. *)

type happy_eyeballs

val happy_eyeballs : happy_eyeballs typ

val generic_happy_eyeballs :
  ?aaaa_timeout:int64 option key ->
  ?connect_delay:int64 option key ->
  ?connect_timeout:int64 option key ->
  ?resolve_timeout:int64 option key ->
  ?resolve_retries:int64 option key ->
  ?timer_interval:int64 option key ->
  ?time:time impl ->
  ?mclock:mclock impl ->
  stackv4v6 impl ->
  dns_client impl ->
  happy_eyeballs impl
(** [generic_happy_eyeballs stackv4v6 dns_client] creates a new happy-eyeballs
    value which is able to resolve and connect to a remote host and allocate
    finally a connected {i flow} from the given network implementation
    [stackv4v6].

This device has several optional arguments of keys for timeouts specified in
    nanoseconds. *)

(** {2 Syslog configuration} *)

(** Syslog exfiltrates log messages (generated by libraries using the [logs]
    library) via a network connection. The log level of the log sources is
    controlled via the {!Mirage_key.logs} key. The functionality is provided by
    the [logs-syslog] package. *)

type syslog_config = {
  hostname : string;
  server : Ipaddr.t option;
  port : int option;
  truncate : int option;
}

val syslog_config :
  ?port:int -> ?truncate:int -> ?server:Ipaddr.t -> string -> syslog_config
(** Helper for constructing a {!type:syslog_config}. *)

type syslog
(** The type for syslog *)

val syslog : syslog typ
(** Implementation of the {!type:syslog} type. *)

val syslog_udp :
  ?config:syslog_config -> ?clock:pclock impl -> stackv4v6 impl -> syslog impl
(** Emit log messages via UDP to the configured host. *)

val syslog_tcp :
  ?config:syslog_config -> ?clock:pclock impl -> stackv4v6 impl -> syslog impl
(** Emit log messages via TCP to the configured host. *)

val syslog_tls :
  ?config:syslog_config ->
  ?keyname:string ->
  ?clock:pclock impl ->
  stackv4v6 impl ->
  kv_ro impl ->
  syslog impl
(** Emit log messages via TLS to the configured host, using the credentials
    (private key, certificate, trust anchor) provided in the KV_RO using the
    [keyname]. *)

(** {2 Conduit configuration} *)

type conduit

val conduit : conduit typ

val conduit_direct :
  ?tls:bool -> ?random:random impl -> stackv4v6 impl -> conduit impl

(** {2 Mimic devices}

For some implementations which requires to communicate with an external
    resources (such as a webserver or a git server), we must hide the underlying
    implementations that depend on the {i target} (such as the network stack)
    and are necessary for these implementations.

The aim of [mimic] is to offer first of all the ability to initiate a TCP/IP
    connection independently of the chosen {i target} (see
    {!val:mimic_happy_eyeballs}).

The resulting {i device} can then be composed with other protocols like TLS,
    Git or HTTP and it is through this resulting {i device} that other devices
    can initiate an internet connection to a peer (like a webserver or a Git
    server). *)

type mimic

val mimic : mimic typ

val mimic_happy_eyeballs :
  stackv4v6 impl -> dns_client impl -> happy_eyeballs impl -> mimic impl
(** [mimic_happy_eyeballs stackv4v6 dns happy_eyeballs] creates a device which
    initiate a global {i happy-eyeballs} loop. By this way, an underlying
    instance works to initiate a TCP/IP connection from an IP address or a
    domain-name.

For the domain-name resolution, we ask the {i happy-eyeballs} instance to
    resolve the given domain-name {i via} the DNS instance created by [dns]
    (which includes several arguments like nameservers used - see
    {!val:generic_dns_client} for more informations).

The resulting {i device} can be used {b and} re-used to for any {i clients}
    which need to initiate a connection (like {!val:alpn_client} or
    {!val:git_tcp}). *)

(** {2 HTTP configuration} *)

type http

val http : http typ

val cohttp_server : conduit impl -> http impl
(** [cohttp_server] starts a Cohttp server. *)

val httpaf_server : conduit impl -> http impl
(** [httpaf_server] starts a http/af server. *)

type http_client

val http_client : http_client typ

val cohttp_client :
  ?pclock:pclock impl -> resolver impl -> conduit impl -> http_client impl
(** [cohttp_server] starts a Cohttp server. *)

type http_server

val http_server : http_server typ

val paf_server : port:int key -> tcpv4v6 impl -> http_server impl
(** [paf_server ~port tcpv4v6] creates an instance which will start to
    {i listen} on the given [port]. With this instance and the produced module
    [HTTP_server], the user can initiate:

- a simple HTTP server
    - a simple HTTPS server (with a TLS configuration)
    - a simple ALPN ([http/1.1] & [h2]) server with TLS

This is a simple example of how to launch an HTTP server: {b unikernel.ml}

{[
      module Make (HTTP_server : Paf_mirage.S with type ipaddr = Ipaddr.t) =
      struct
        let error_handler (_ipaddr, _port) ?request:_ _error _send = ()

let request_handler :
            HTTP_server.TCP.flow -> Ipaddr.t * int -> Httpaf.Reqd.t -> unit =
         fun _socket (_ipaddr, _port) reqd ->
          let contents = "Hello World!\n" in
          let headers =
            Httpaf.Headers.of_list
              [
                ("content-length", string_of_int (String.length contents));
                ("content-type", "text/plain");
                ("connection", "close");
              ]
          in
          let response = Httpaf.Response.create ~headers `OK in
          Httpaf.Reqd.respond_with_string reqd response contents

let start http_server =
          let service =
            HTTP_service.http_service ~error_handler request_handler
          in
          let (`Initialized thread) = HTTP_server.serve service http_server in
          thread
      end
    ]}

{b config.ml}

{[
      open Mirage

let port =
        let doc =
          Key.Arg.info ~doc:"Port of the HTTP service." [ "p"; "port" ]
        in
        Key.(create "port" Arg.(opt int 8080 doc))

let main = foreign "Unikernel.Make" (http_server @-> job)
      let stackv4v6 = generic_stackv4v6 default_network
      let http_server = paf_server ~port (tcpv4v6_of_stackv4v6 stackv4v6)
      let () = register "main" [ main $ http_server ]
    ]} *)

type alpn_client
(** Abstract type for ALPN HTTP clients *)

val alpn_client : alpn_client typ

val paf_client :
  ?pclock:pclock impl -> tcpv4v6 impl -> mimic impl -> alpn_client impl
(** [paf_client tcpv4v6 dns] creates an ALPN device which can do HTTP
    ([http/1.1] & [h2]) requests as a HTTP client. The device allocated
    represents values required to initiate a connection to HTTP webservers. The
    user can, then, use the module [Http_mirage_client.request] to communicate
    with HTTP webservers. This is an example of how to use the ALPN devices:

{b unikernel.ml}

{[
      module Make (HTTP_client : Http_mirage_client.S) = struct
        let start http =
          Http_mirage_client.request http "https://google.com"
            (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
            (Buffer.create 0x100) >>= function
          | Ok (response, buf) ->
            let body = Buffer.contents buf in
            ...
          | Error _ -> ...
      end
    ]}

{b config.ml}

{[
      open Mirage

let main = foreign "Unikernel.Make" (alpn_client @-> job)
      let stackv4v6 = generic_stackv4v6 default_network
      let dns = generic_dns_client stack

let alpn_client =
        let dns =
          mimic_happy_eyeballs stackv4v6 dns (generic_happy_eyeballs stack dns)
        in
        paf_client (tcpv4v6_of_stackv4v6 stackv4v6) dns

let () = register "main" [ main $ alpn_client ]
    ]} *)

(** {2 Argv configuration} *)

type argv = Functoria.argv

val argv : argv typ

val default_argv : argv impl
(** [default_argv] is a dynamic argv implementation which attempts to do
    something reasonable based on the target. *)

val no_argv : argv impl
(** [no_argv] Disable command line parsing and set argv to [|""|]. *)

(** {2 Git client configuration} *)

(** Users can connect to a remote Git repository in many ways:

- TCP/IP
    - HTTP
    - HTTP + TLS
    - SSH

The devices defined below define these in composable ways. The
    [git_client impl] returned from them can be passed to Git or Irmin in order
    to be able to {i fetch} and {i push} from/into a Git repository.

The user is able to restrict or enlarge protocol possibilities needed for
    its application. For instance, the user is able to restrict only the SSH
    connection to communicate with a Git repository or the user can handle
    TCP/IP and SSH as possible protocols to communicate with a peer.

For instance, a device which is able to communicate {i via} TCP/IP and SSH
    can be implemented like:

{[
      let dns = generic_dns_client stack

let git_client =
        let dns =
          mimic_happy_eyeballs stackv4v6 dns (generic_happy_eyeballs stack dns)
        in
        let ssh = git_ssh ~key ~password (tcpv4v6_of_stackv4v6 stackv4v6) dns in
        let tcp = git_tcp (tcpv4v6_of_stackv4v6 stackv4v6) dns in
        merge_git_clients ssh tcp
    ]} *)

type git_client
(** The type for devices that implement the Git protocol. *)

val git_client : git_client typ

val merge_git_clients : git_client impl -> git_client impl -> git_client impl
(** [merge_git_clients a b] is a device that can connect to remote Git
    repositories using either the device [a] or the device [b]. *)

val git_tcp : tcpv4v6 impl -> mimic impl -> git_client impl
(** [git_tcp tcpv4v6 dns] is a device able to connect to a remote Git repository
    using TCP/IP. *)

val git_ssh :
  ?authenticator:string option key ->
  key:string option key ->
  password:string option key ->
  ?mclock:mclock impl ->
  ?time:time impl ->
  tcpv4v6 impl ->
  mimic impl ->
  git_client impl
(** [git_ssh ?authenticator ~key ~password tcpv4v6 dns] is a device able to
    connect to a remote Git repository using an SSH connection with the given
    private [key] or [password]. The identity of the remote Git repository can
    be verified using [authenticator].

The format of the private key is: [<type>:<seed or b64 encoded>]. [<type>]
    can be [rsa] or [ed25519] and, if the type is RSA, we expect the {b seed} of
    the private key. Otherwise (if the type is Ed25519), we expect the
    b64-encoded private key.

The format of the authenticator is [SHA256:<b64-encoded-public-key>], the
    output of:

{[
      $ ssh-keygen -lf <(ssh-keyscan -t rsa|ed25519 remote 2>/dev/null)
    ]} *)

val git_http :
  ?authenticator:string option key ->
  ?headers:(string * string) list key ->
  ?pclock:pclock impl ->
  tcpv4v6 impl ->
  mimic impl ->
  git_client impl
(** [git_http ?authenticator ?headers tcpv4v6 dns] is a device able to connect
    to a remote Git repository via an HTTP(S) connection, using the provided
    HTTP [headers]. The identity of the remote Git repository can be verified
    using [authenticator].

The format of it is:

- [none] no authentication
    - key(:<hash>)?:<b64-encoded fingerprint> to authenticate via the key
      fingerprint
    - cert(:<hash>)?:<b64-encoded fingerprint> to authenticate via the cert
      fingerprint
    - trust-anchor(:<der-encoded cert>)+ to authenticate via a list of
      certificates - By default, we use X.509 trust anchors extracted from
      Mozilla's NSS *)

(** {2 Other devices} *)

val job : job typ
(** [job] is the combinator for representing main tasks. *)

val noop : job impl
(** [noop] is a job that does nothing, has no dependency and returns [()] *)

val keys : argv impl -> job impl
(** [keys argv] is a job that loads argv. *)

type info
(** [info] is the type for module implementing {!Mirage_runtime.Info}. *)

val info : info typ
(** [info] is the combinator to generate {!type:info} values to use at runtime. *)

val app_info : info impl
(** [app_info] exports all the information available at configure time into a
    runtime {!type:Mirage.Info.t} value. *)

val app_info_with_opam_deps : (string * string) list -> info impl
(** [app_info_with_opam_deps build_info] exports all the information available
    at configure time into a runtime {!type:Mirage.Info.t} value. The libraries
    are set to [build_info]. Most likely you want to use [app_info] instead. *)

(** {2 Application registering} *)

val register :
  ?argv:argv impl ->
  ?reporter:reporter impl ->
  ?keys:Key.t list ->
  ?packages:Functoria.package list ->
  ?src:[ `Auto | `None | `Some of string ] ->
  string ->
  job impl list ->
  unit
(** [register name jobs] registers the application named by [name] which will
    executes the given [jobs].

@param packages The opam packages needed by this module.
    @param keys The keys related to this module.
    @param reporter
      Configure logging. The default log reporter is {!default_reporter}. To
      disable logging, use {!no_reporter}.
    @param argv
      Configure command-line argument parsing. The default parser is
      {!default_argv}. To disable command-line parsing, use {!no_argv}. *)

module Type = Functoria.Type
module Impl = Functoria.Impl
module Info = Functoria.Info
module Dune = Functoria.Dune
module Action = Functoria.Action

module Project : sig
  val dune : Info.t -> Dune.stanza list
  val configure : Info.t -> unit Action.t
end

module Tool : sig
  val run : unit -> unit
end
07070100000077000081A400000000000000000000000164916410000039A1000000000000000000000000000000000000002600000000mirage-4.4.0/lib/mirage/mirage_key.ml(*
 * Copyright (c) 2015 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Functoria
module Key = Key
module Alias = Key.Alias
open Astring

(** {2 Custom Descriptions} *)

module Arg = struct
  include Key.Arg

let from_run s = "Mirage_runtime.Arg." ^ s

let make d m of_string to_string =
    let parser s =
      match of_string s with
      | Error (`Msg m) -> `Error ("Can't parse ip address: " ^ s ^ ": " ^ m)
      | Ok ip -> `Ok ip
    and serialize ppf t = Fmt.pf ppf "(%s.of_string_exn %S)" m (to_string t)
    and pp ppf t = Fmt.string ppf (to_string t) in
    Key.Arg.conv ~conv:(parser, pp) ~serialize ~runtime_conv:(from_run d)

module type S = sig
    type t

val of_string : string -> (t, [ `Msg of string ]) result
    val to_string : t -> string
  end

let of_module (type t) d m (module M : S with type t = t) =
    make d m M.of_string M.to_string

let ipv4_address = of_module "ipv4_address" "Ipaddr.V4" (module Ipaddr.V4)
  let ipv4 = of_module "ipv4" "Ipaddr.V4.Prefix" (module Ipaddr.V4.Prefix)
  let ipv6_address = of_module "ipv6_address" "Ipaddr.V6" (module Ipaddr.V6)
  let ipv6 = of_module "ipv6" "Ipaddr.V6.Prefix" (module Ipaddr.V6.Prefix)
  let ip_address = of_module "ip_address" "Ipaddr" (module Ipaddr)
end

(** {2 Documentation helper} *)

let mirage_section = "MIRAGE PARAMETERS"
let unikernel_section = "UNIKERNEL PARAMETERS"
let pp_group = Fmt.(option ~none:(any "the unikernel") @@ fmt "the %s group")

(** {2 Special keys} *)

(** {3 Mode} *)

let target_conv : mode Cmdliner.Arg.conv =
  let parser, printer =
    Cmdliner.Arg.enum
      [
        ("unix", `Unix);
        ("macosx", `MacOSX);
        ("xen", `Xen);
        ("virtio", `Virtio);
        ("hvt", `Hvt);
        ("muen", `Muen);
        ("qubes", `Qubes);
        ("genode", `Genode);
        ("spt", `Spt);
      ]
  in
  (parser, printer)

let pp_target fmt m = snd target_conv fmt m

let default_target =
  match Sys.getenv "MIRAGE_DEFAULT_TARGET" with
  | "unix" -> `Unix
  | s -> Fmt.failwith "invalid default target: %S" s
  | exception Not_found -> (
      match Action.run @@ Action.run_cmd_out Bos.Cmd.(v "uname" % "-s") with
      | Ok "Darwin" -> `MacOSX
      | _ -> `Unix)

let target =
  let doc =
    "Target platform to compile the unikernel for. Valid values are: $(i,xen), \
     $(i,qubes), $(i,unix), $(i,macosx), $(i,virtio), $(i,hvt), $(i,spt), \
     $(i,muen), $(i,genode)."
  in
  let conv =
    Arg.conv ~conv:target_conv ~runtime_conv:"target"
      ~serialize:target_serialize
  in
  let doc =
    Arg.info ~docs:mirage_section ~docv:"TARGET" ~doc [ "t"; "target" ]
      ~env:"MODE"
  in
  let key = Arg.opt ~stage:`Configure conv default_target doc in
  Key.create "target" key

let is_unix =
  Key.match_ Key.(value target) @@ function
  | #mode_unix -> true
  | #mode_xen | #mode_solo5 -> false

let is_solo5 =
  Key.match_ Key.(value target) @@ function
  | #mode_solo5 -> true
  | #mode_xen | #mode_unix -> false

let is_xen =
  Key.match_ Key.(value target) @@ function
  | #mode_xen -> true
  | #mode_solo5 | #mode_unix -> false

(** {2 OCaml runtime} *)

let ocaml_section = "OCAML RUNTIME PARAMETERS"

let backtrace =
  let doc =
    "Trigger the printing of a stack backtrace when an uncaught exception \
     aborts the unikernel."
  in
  let doc = Arg.info ~docs:ocaml_section ~docv:"BOOL" ~doc [ "backtrace" ] in
  let key = Arg.opt Arg.bool true doc in
  Key.create "backtrace" key

let randomize_hashtables =
  let doc = "Turn on randomization of all hash tables by default." in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"BOOL" ~doc [ "randomize-hashtables" ]
  in
  let key = Arg.opt Arg.bool true doc in
  Key.create "randomize-hashtables" key

let allocation_policy =
  let doc =
    "The policy used for allocating in the OCaml heap. Possible values are: \
     $(i,next-fit), $(i,first-fit), $(i,best-fit). Best-fit is only supported \
     since OCaml 4.10."
  in
  let serialize ppf = function
    | `Next_fit -> Fmt.pf ppf "`Next_fit"
    | `First_fit -> Fmt.pf ppf "`First_fit"
    | `Best_fit -> Fmt.pf ppf "`Best_fit"
  and conv = Mirage_runtime.Arg.allocation_policy in
  let conv =
    Arg.conv ~conv ~runtime_conv:"Mirage_runtime.Arg.allocation_policy"
      ~serialize
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"ALLOCATION" ~doc [ "allocation-policy" ]
  in
  let key = Arg.opt conv `Next_fit doc in
  Key.create "allocation-policy" key

let minor_heap_size =
  let doc = "The size of the minor heap (in words). Default: 256k." in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"MINOR SIZE" ~doc [ "minor-heap-size" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "minor-heap-size" key

let major_heap_increment =
  let doc =
    "The size increment for the major heap (in words). If less than or equal \
     1000, it is a percentage of the current heap size. If more than 1000, it \
     is a fixed number of words. Default: 15."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"MAJOR INCREMENT" ~doc
      [ "major-heap-increment" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "major-heap-increment" key

let space_overhead =
  let doc =
    "The percentage of live data of wasted memory, due to GC does not \
     immediately collect unreachable blocks. The major GC speed is computed \
     from this parameter, it will work more if smaller. Default: 80."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"SPACE OVERHEAD" ~doc
      [ "space-overhead" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "space-overhead" key

let max_space_overhead =
  let doc =
    "Heap compaction is triggered when the estimated amount of wasted memory \
     exceeds this (percentage of live data). If above 1000000, compaction is \
     never triggered. Default: 500."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"MAX SPACE OVERHEAD" ~doc
      [ "max-space-overhead" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "max-space-overhead" key

let gc_verbosity =
  let doc =
    "GC messages on standard error output. Sum of flags. Check GC module \
     documentation for details."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"VERBOSITY" ~doc [ "gc-verbosity" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "gc-verbosity" key

let gc_window_size =
  let doc =
    "The size of the window used by the major GC for smoothing out variations \
     in its workload. Between 1 adn 50, default: 1."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"WINDOW SIZE" ~doc [ "gc-window-size" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "gc-window-size" key

let custom_major_ratio =
  let doc =
    "Target ratio of floating garbage to major heap size for out-of-heap \
     memory held by custom values. Default: 44."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"CUSTOM MAJOR RATIO" ~doc
      [ "custom-major-ratio" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "custom-major-ratio" key

let custom_minor_ratio =
  let doc =
    "Bound on floating garbage for out-of-heap memory held by custom values in \
     the minor heap. Default: 100."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"CUSTOM MINOR RATIO" ~doc
      [ "custom-minor-ratio" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "custom-minor-ratio" key

let custom_minor_max_size =
  let doc =
    "Maximum amount of out-of-heap memory for each custom value allocated in \
     the minor heap. Default: 8192 bytes."
  in
  let doc =
    Arg.info ~docs:ocaml_section ~docv:"CUSTOM MINOR MAX SIZE" ~doc
      [ "custom-minor-max-size" ]
  in
  let key = Arg.(opt (some int) None doc) in
  Key.create "custom-minor-max-size" key

(** {2 General mirage keys} *)

let create_simple ?(group = "") ?(stage = `Both) ~doc ~default conv name =
  let prefix = if group = "" then group else group ^ "-" in
  let doc =
    Arg.info ~docs:unikernel_section
      ~docv:(String.Ascii.uppercase name)
      ~doc
      [ prefix ^ name ]
  in
  let key = Arg.opt ~stage conv default doc in
  Key.create (prefix ^ name) key

(** {3 File system keys} *)

let kv_ro ?group () =
  let conv = Cmdliner.Arg.enum [ ("crunch", `Crunch); ("direct", `Direct) ] in
  let serialize =
    Fmt.of_to_string @@ function `Crunch -> "`Crunch" | `Direct -> "`Direct"
  in
  let conv = Arg.conv ~conv ~serialize ~runtime_conv:"kv_ro" in
  let doc =
    Fmt.str
      "Use a $(i,crunch) or $(i,direct) pass-through implementation for %a."
      pp_group group
  in
  create_simple ~doc ?group ~stage:`Configure ~default:`Crunch conv "kv_ro"

(** {3 Block device keys} *)
let block ?group () =
  let conv =
    Cmdliner.Arg.enum
      [ ("xenstore", `XenstoreId); ("file", `BlockFile); ("ramdisk", `Ramdisk) ]
  in
  let serialize =
    Fmt.of_to_string @@ function
    | `XenstoreId -> "`XenstoreId"
    | `BlockFile -> "`BlockFile"
    | `Ramdisk -> "`Ramdisk"
  in
  let conv = Arg.conv ~conv ~serialize ~runtime_conv:"block" in
  let doc =
    Fmt.str
      "Use a $(i,ramdisk), $(i,xenstore), or $(i,file) pass-through \
       implementation for %a."
      pp_group group
  in
  create_simple ~doc ?group ~stage:`Configure ~default:`Ramdisk conv "block"

(** {3 Stack keys} *)

let dhcp ?group () =
  let doc = Fmt.str "Enable dhcp for %a." pp_group group in
  create_simple ~doc ?group ~stage:`Configure ~default:false Arg.bool "dhcp"

let net ?group () : [ `Socket | `Direct ] option Key.key =
  let conv = Cmdliner.Arg.enum [ ("socket", `Socket); ("direct", `Direct) ] in
  let serialize fmt = function
    | `Socket -> Fmt.string fmt "`Socket"
    | `Direct -> Fmt.string fmt "`Direct"
  in
  let conv = Arg.conv ~conv ~runtime_conv:"net" ~serialize in
  let doc =
    Fmt.str "Use $(i,socket) or $(i,direct) group for %a." pp_group group
  in
  create_simple ~doc ?group ~stage:`Configure ~default:None (Arg.some conv)
    "net"

(** {3 Network keys} *)

let interface ?group default =
  let doc = Fmt.str "The network interface listened by %a." pp_group group in
  create_simple ~doc ~default ?group Arg.string "interface"

module V4 = struct
  let network ?group default =
    let doc =
      Fmt.str
        "The network of %a specified as an IP address and netmask, e.g. \
         192.168.0.1/16 ."
        pp_group group
    in
    create_simple ~doc ~default ?group Arg.ipv4 "ipv4"

let gateway ?group default =
    let doc = Fmt.str "The gateway of %a." pp_group group in
    create_simple ~doc ~default ?group Arg.(some ipv4_address) "ipv4-gateway"
end

module V6 = struct
  let network ?group default =
    let doc =
      Fmt.str "The network of %a specified as IPv6 address and prefix length."
        pp_group group
    in
    create_simple ~doc ~default ?group Arg.(some ipv6) "ipv6"

let gateway ?group default =
    let doc = Fmt.str "The gateway of %a." pp_group group in
    create_simple ~doc ~default ?group Arg.(some ipv6_address) "ipv6-gateway"

let accept_router_advertisements ?group () =
    let doc = Fmt.str "Accept router advertisements for %a." pp_group group in
    create_simple ~doc ?group ~default:true Arg.bool
      "accept-router-advertisements"
end

let ipv4_only ?group () =
  let doc = Fmt.str "Only use IPv4 for %a." pp_group group in
  create_simple ~doc ?group ~default:false Arg.bool "ipv4-only"

let ipv6_only ?group () =
  let doc = Fmt.str "Only use IPv6 for %a." pp_group group in
  create_simple ~doc ?group ~default:false Arg.bool "ipv6-only"

let resolver ?default () =
  let doc = Fmt.str "DNS resolver (default to anycast.censurfridns.dk)" in
  create_simple ~doc ~default Arg.(some (list string)) "resolver"

let syslog default =
  let doc = Fmt.str "syslog server" in
  create_simple ~doc ~default Arg.(some ip_address) "syslog"

let syslog_port default =
  let doc = Fmt.str "syslog server port" in
  create_simple ~doc ~default Arg.(some int) "syslog-port"

let syslog_hostname default =
  let doc = Fmt.str "hostname to report to syslog" in
  create_simple ~doc ~default Arg.string "syslog-hostname"

let pp_level ppf = function
  | Some Logs.Error -> Fmt.string ppf "Some Logs.Error"
  | Some Logs.Warning -> Fmt.string ppf "Some Logs.Warning"
  | Some Logs.Info -> Fmt.string ppf "Some Logs.Info"
  | Some Logs.Debug -> Fmt.string ppf "Some Logs.Debug"
  | Some Logs.App -> Fmt.string ppf "Some Logs.App"
  | None -> Fmt.string ppf "None"

let pp_pattern ppf = function
  | `All -> Fmt.string ppf "`All"
  | `Src s -> Fmt.pf ppf "`Src %S" s

let pp_threshold ppf (pattern, level) =
  Fmt.pf ppf "(%a,@ %a)" pp_pattern pattern pp_level level

let logs =
  let env = "MIRAGE_LOGS" in
  let docs = unikernel_section in
  let conv = Cmdliner.Arg.list Mirage_runtime.Arg.log_threshold in
  let serialize ppf levels =
    Fmt.(pf ppf "[%a]" (list ~sep:(const string "; ") pp_threshold) levels)
  in
  let runtime_conv = "(Cmdliner.Arg.list Mirage_runtime.Arg.log_threshold)" in
  let doc =
    strf
      "Be more or less verbose. $(docv) must be of the form@ \
       $(b,*:info,foo:debug) means that that the log threshold is set to@ \
       $(b,info) for every log sources but the $(b,foo) which is set to@ \
       $(b,debug)."
  in
  let logs = Key.Arg.conv ~conv ~serialize ~runtime_conv in
  let info = Key.Arg.info ~env ~docv:"LEVEL" ~doc ~docs [ "l"; "logs" ] in
  let arg = Key.Arg.(opt logs []) info in
  Key.create "logs" arg

include (Key : Functoria.KEY with module Arg := Arg and module Alias := Alias)
07070100000078000081A400000000000000000000000164916410000015C8000000000000000000000000000000000000002700000000mirage-4.4.0/lib/mirage/mirage_key.mli(*
 * Copyright (c) 2015 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Mirage keys.

{e Release %%VERSION%%} *)

module Arg : sig
  include module type of struct
    include Functoria.Key.Arg
  end

val ipv4_address : Ipaddr.V4.t converter
  val ipv4 : Ipaddr.V4.Prefix.t converter
  val ipv6_address : Ipaddr.V6.t converter
  val ipv6 : Ipaddr.V6.Prefix.t converter
  val ip_address : Ipaddr.t converter
end

include Functoria.KEY with module Arg := Arg

val abstract : 'a key -> t [@@ocaml.deprecated "Use Mirage.Key.v."]

(** {2 Mirage keys} *)

val target : mode key
(** [-t TARGET]: Key setting the configuration mode for the current project. Is
    one of ["unix"], ["macosx"], ["xen"], ["qubes"], ["virtio"], ["hvt"],
    ["muen"], ["genode"] or ["spt"]. *)

val pp_target : mode Fmt.t
(** Pretty printer for the mode. *)

val is_unix : bool value
(** Is true iff the {!target} key is a UNIXish system (["unix" or "macosx"]). *)

val is_solo5 : bool value
(** Is true iff the {!target} key is a Solo5-based target. *)

val is_xen : bool value
(** Is true iff the {!target} key is a Xen-based system (["xen" or "qubes"]). *)

(** {2 OCaml runtime keys}

The OCaml runtime is usually configurable via the [OCAMLRUNPARAM]
    environment variable. We provide boot parameters covering these options. *)

val backtrace : bool key
(** [--backtrace]: Output a backtrace if an uncaught exception terminated the
    unikernel. *)

val randomize_hashtables : bool key
(** [--randomize-hashtables]: Randomize all hash tables. *)

(** {3 GC control}

The OCaml garbage collector can be configured, as described in detail in
    {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEcontrol} GC
      control}.

The following keys allow boot time configuration. *)

val allocation_policy : [ `Next_fit | `First_fit | `Best_fit ] key
val minor_heap_size : int option key
val major_heap_increment : int option key
val space_overhead : int option key
val max_space_overhead : int option key
val gc_verbosity : int option key
val gc_window_size : int option key
val custom_major_ratio : int option key
val custom_minor_ratio : int option key
val custom_minor_max_size : int option key

(** {2 Generic keys}

Some keys have a [group] optional argument. This group argument allows to
    give several keys a prefix.

For example, if we have two [ip] stacks, one external and one internal, We
    can use the [group] option to name them [in] and [out]. This way, the
    available keys will be [--in-ip] and [--out-ip].

If a key has another, non-optional argument. It is the default value.

Keys are always named the same as their command line option.

{3 File system keys} *)

val kv_ro : ?group:string -> unit -> [ `Crunch | `Direct ] key
(** The type of key value store. Is one of ["crunch"], or ["direct"]. *)

val block : ?group:string -> unit -> [ `XenstoreId | `BlockFile | `Ramdisk ] key
(** {3 Block device keys} *)

(** {3 Stack keys} *)

val dhcp : ?group:string -> unit -> bool key
(** Enable dhcp. Is either [true] or [false]. *)

val net : ?group:string -> unit -> [ `Direct | `Socket ] option key
(** The type of stack. Is either ["direct"] or ["socket"]. *)

(** {3 Network keys} *)

val interface : ?group:string -> string -> string key
(** A network interface. *)

(** Ipv4 keys. *)
module V4 : sig
  open Ipaddr.V4

val network : ?group:string -> Prefix.t -> Prefix.t key
  (** A network defined by an address and netmask. *)

val gateway : ?group:string -> t option -> t option key
  (** A default gateway option. *)
end

(** Ipv6 keys. *)
module V6 : sig
  open Ipaddr.V6

val network : ?group:string -> Prefix.t option -> Prefix.t option key
  (** A network defined by an address and netmask. *)

val gateway : ?group:string -> t option -> t option key
  (** A default gateway option. *)

val accept_router_advertisements : ?group:string -> unit -> bool key
  (** An option whether to accept router advertisements. *)
end

val ipv4_only : ?group:string -> unit -> bool key
(** An option for dual stack to only use IPv4. *)

val ipv6_only : ?group:string -> unit -> bool key
(** An option for dual stack to only use IPv6. *)

val resolver : ?default:string list -> unit -> string list option key
(** The address of the DNS resolver to use. See $REFERENCE for format. *)

val syslog : Ipaddr.t option -> Ipaddr.t option key
(** The address to send syslog frames to. *)

val syslog_port : int option -> int option key
(** The port to send syslog frames to. *)

val syslog_hostname : string -> string key
(** The hostname to use in syslog frames. *)

val logs : Mirage_runtime.log_threshold list key
07070100000079000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001F00000000mirage-4.4.0/lib/mirage/target0707010000007A000081A40000000000000000000000016491641000000066000000000000000000000000000000000000002400000000mirage-4.4.0/lib/mirage/target/dune(library
 (name mirage_target)
 (public_name mirage.target)
 (libraries mirage.key mirage.impl logs))
0707010000007B000081A40000000000000000000000016491641000001422000000000000000000000000000000000000002A00000000mirage-4.4.0/lib/mirage/target/libvirt.mlopen Functoria

let filename ~name = Fpath.(v (name ^ "_libvirt") + "xml")
let append fmt s = Fmt.pf fmt (s ^^ "@.")

let configure_main ~name =
  Action.with_output ~path:(filename ~name) ~purpose:"libvirt.xml" (fun fmt ->
      append fmt "<domain type='xen'>";
      append fmt "    <name>%s</name>" name;
      append fmt "    <memory unit='KiB'>262144</memory>";
      append fmt "    <currentMemory unit='KiB'>262144</currentMemory>";
      append fmt "    <vcpu placement='static'>1</vcpu>";
      append fmt "    <os>";
      append fmt "        <type arch='armv7l' machine='xenpv'>linux</type>";
      append fmt "        <kernel>%s.xen</kernel>" name;
      append fmt "        <cmdline> </cmdline>";
      (* the libxl driver currently needs an empty cmdline to be able to
           start the domain on arm - due to this?
           http://lists.xen.org/archives/html/xen-devel/2014-02/msg02375.html *)
      append fmt "    </os>";
      append fmt "    <clock offset='utc' adjustment='reset'/>";
      append fmt "    <on_crash>preserve</on_crash>";
      append fmt "    ";
      append fmt "    <devices>";
      append fmt "        ";
      append fmt "        ";
      append fmt "        <console type='pty'>";
      append fmt "            <target type='xen' port='0'/>";
      append fmt "        </console>";
      append fmt "    </devices>";
      append fmt "</domain>")

let configure_virtio ~name =
  Action.with_output ~path:(filename ~name) ~purpose:"libvirt.xml" (fun fmt ->
      append fmt "<domain type='kvm'>";
      append fmt "    <name>%s</name>" name;
      append fmt "    <memory unit='KiB'>262144</memory>";
      append fmt "    <currentMemory unit='KiB'>262144</currentMemory>";
      append fmt "    <vcpu placement='static'>1</vcpu>";
      append fmt "    <os>";
      append fmt "        <type arch='x86_64' machine='pc'>hvm</type>";
      append fmt "        <kernel>%s.virtio</kernel>" name;
      append fmt "        ";
      append fmt "    </os>";
      append fmt "    <clock offset='utc' adjustment='reset'/>";
      append fmt "    <devices>";
      append fmt "        <emulator>/usr/bin/qemu-system-x86_64</emulator>";
      append fmt "        ";
      append fmt "        ";
      append fmt "        <serial type='pty'>";
      append fmt "            <target port='0'/>";
      append fmt "        </serial>";
      append fmt "        <console type='pty'>";
      append fmt "            <target type='serial' port='0'/>";
      append fmt "        </console>";
      append fmt "        <memballoon model='none'/>";
      append fmt "    </devices>";
      append fmt "</domain>")
0707010000007C000081A4000000000000000000000001649164100000009C000000000000000000000000000000000000002B00000000mirage-4.4.0/lib/mirage/target/libvirt.mliopen Functoria

val filename : name:string -> Fpath.t
val configure_main : name:string -> unit Action.t
val configure_virtio : name:string -> unit Action.t
0707010000007D000081A400000000000000000000000164916410000000EA000000000000000000000000000000000000002E00000000mirage-4.4.0/lib/mirage/target/mirage_dune.mlopen Mirage_impl_misc

let flags _ =
  (* Disable "70 [missing-mli] Missing interface file." as we are only
     generating .ml files currently. *)
  [ ":standard"; "-w"; "-70" ]
  @ if terminal () then [ "-color"; "always" ] else []
0707010000007E000081A4000000000000000000000001649164100000002C000000000000000000000000000000000000002F00000000mirage-4.4.0/lib/mirage/target/mirage_dune.mlival flags : Functoria.Info.t -> string list
0707010000007F000081A4000000000000000000000001649164100000036F000000000000000000000000000000000000003000000000mirage-4.4.0/lib/mirage/target/mirage_target.mlopen Functoria
module Key = Mirage_key

let choose : Key.mode -> (module S.TARGET) = function
  | #Solo5.t -> (module Solo5)
  | #Unix.t -> (module Unix)

let dune i =
  let target = Info.get i Key.target in
  let (module Target) = choose target in
  Target.dune i

let configure i =
  let target = Info.get i Key.target in
  let (module Target) = choose target in
  Target.configure i

let build_context ?build_dir i =
  let target = Info.get i Key.target in
  let (module Target) = choose target in
  Target.build_context ?build_dir i

let context_name i =
  let target = Info.get i Key.target in
  let (module Target) = choose target in
  Target.context_name i

let packages target =
  let (module Target) = choose target in
  Target.(packages (cast target))

let install i =
  let target = Info.get i Key.target in
  let (module Target) = choose target in
  Target.install i
07070100000080000081A40000000000000000000000016491641000000354000000000000000000000000000000000000002400000000mirage-4.4.0/lib/mirage/target/s.mlopen Functoria
module Key = Mirage_key

(** A Mirage target: target consists in multiple backends grouped together. *)
module type TARGET = sig
  type t
  (** The type representing a specific backend in a target. *)

val cast : Key.mode -> t
  (** Ensures the mode is a backend supported by this target. *)

val dune : Info.t -> Dune.stanza list
  (** Dune rules to build the unikernel *)

val configure : Info.t -> unit Action.t
  (** Configure-time actions. *)

val build_context : ?build_dir:Fpath.t -> Info.t -> Dune.stanza list
  (** Generate build context configuration *)

val context_name : Info.t -> string
  (** Dune context *)

val packages : t -> package list
  (** The required packages to support this backend. *)

val install : Info.t -> Install.t
  (** [install i] returns which files are installed in context [i]. *)
end
07070100000081000081A40000000000000000000000016491641000001304000000000000000000000000000000000000002800000000mirage-4.4.0/lib/mirage/target/solo5.mlopen Functoria
open Action.Syntax
open Astring
module Key = Mirage_key
module Log = Mirage_impl_misc.Log

let solo5_manifest_path = Fpath.v "manifest.json"

let cast = function #t as t -> t | _ -> invalid_arg "not a solo5 target."

let build_packages =
  [
    Functoria.package ~min:"0.8.1" ~max:"0.9.0" ~scope:`Switch ~build:true
      "ocaml-solo5";
    Functoria.package ~min:"0.7.5" ~max:"0.8.0" ~scope:`Switch ~build:true
      "solo5";
  ]

let runtime_packages target =
  match target with
  | #solo5_target ->
      [ Functoria.package ~min:"0.9.0" ~max:"0.10.0" "mirage-solo5" ]
  | #xen_target -> [ Functoria.package ~min:"8.0.0" ~max:"9.0.0" "mirage-xen" ]

let packages target = build_packages @ runtime_packages target
let context_name _i = "solo5"

(* OCaml solo5 build context. *)
let build_context ?build_dir:_ i =
  let profile_release = Dune.stanza "(profile release)" in
  let build_context =
    Dune.stanzaf
      {|
  (context (default
  (name %s)
  (host default)
  (toolchain solo5)
  (merlin)
  (disable_dynamically_linked_foreign_archives true)
  ))
  |}
      (context_name i)
  in
  [ profile_release; build_context ]

(* Configure step *)
let generate_manifest_json with_devices () =
  Log.info (fun m -> m "generating manifest");
  let networks =
    List.map (fun n -> (n, `Network)) !Mirage_impl_network.all_networks
  in
  let blocks =
    Hashtbl.fold
      (fun k _v acc -> (k, `Block) :: acc)
      Mirage_impl_block.all_blocks []
  in
  let to_string (name, typ) =
    Fmt.str {json|{ "name": %S, "type": %S }|json} name
      (match typ with `Network -> "NET_BASIC" | `Block -> "BLOCK_BASIC")
  in
  let devices =
    if with_devices then List.map to_string (networks @ blocks) else []
  in
  let s = String.concat ~sep:", " devices in
  let* () =
    Action.with_output ~path:solo5_manifest_path
      ~purpose:"Solo5 application manifest file" (fun fmt ->
        Fmt.pf fmt
          {|{
  "type": "solo5.manifest",
  "version": 1,
  "devices": [ %s ]
}
|}
          s)
  in
  Action.write_file (Fpath.v "manifest.ml") ""

let configure i =
  let name = Info.name i in
  let target = Info.get i Key.target in
  let* () =
    match target with
    | #solo5_target -> generate_manifest_json true ()
    | #xen_target -> generate_manifest_json false ()
    | _ -> assert false
  in
  match target with
  | `Xen ->
      let* () = Xen.configure_main_xl ~ext:"xl" i in
      let* () = Xen.configure_main_xl ~substitutions:[] ~ext:"xl.in" i in
      Libvirt.configure_main ~name
  | `Virtio -> Libvirt.configure_virtio ~name
  | _ -> Action.ok ()

(* Build *)

let main i = Fpath.(base (rem_ext (Info.main i)))

let out i =
  let target = Info.get i Key.target in
  let public_name =
    match Info.output i with None -> Info.name i | Some o -> o
  in
  public_name ^ ext target

let rename i =
  let out = out i in
  let main = Fpath.to_string (main i) in
  Dune.stanzaf
    {|
(rule
 (target %s)
 (enabled_if (= %%{context_name} "%s"))
 (deps %s.exe)
 (action
  (copy %s.exe %%{target})))
|}
    out (context_name i) main main

let manifest _i =
  Dune.stanzaf
    {|
(rule
 (targets manifest.c)
 (deps manifest.json)
 (action
  (run solo5-elftool gen-manifest manifest.json manifest.c)))
|}

let main i =
  let libraries = Info.libraries i in
  let flags = Mirage_dune.flags i in
  let main = Fpath.to_string (main i) in
  let target = Info.get i Key.target in
  let pp_list f = Dune.compact_list f in
  Dune.stanzaf
    {|
(executable
 (enabled_if (= %%{context_name} "%s"))
 (name %s)
 (modes (native exe))
 (libraries %a)
 (link_flags %a -cclib "-z solo5-abi=%s")
 (modules (:standard \ %a manifest))
 (foreign_stubs (language c) (names manifest))
)
|}
    (context_name i) main (pp_list "libraries") libraries (pp_list "link_flags")
    flags (solo5_abi target) Fpath.pp
    (Fpath.rem_ext (Fpath.base (Info.config_file i)))

let subdir name s = Dune.stanzaf "(subdir %s\n %a)\n" name Dune.pp (Dune.v s)
let dune i = [ main i; manifest i; rename i ]

let install i =
  let target = Info.get i Key.target in
  let name = Info.name i in
  let out = out i in
  let open Fpath in
  let additional_artifacts =
    match target with
    | `Xen -> [ v (name ^ ".xl"); v (name ^ ".xl.in") ]
    | _ -> []
  in
  Install.v ~bin:[ (v out, v out) ] ~etc:additional_artifacts ()
07070100000082000081A4000000000000000000000001649164100000050D000000000000000000000000000000000000002700000000mirage-4.4.0/lib/mirage/target/unix.mlopen Functoria
module Key = Mirage_key

type t = [ `Unix | `MacOSX ]

let cast = function #t as t -> t | _ -> invalid_arg "not a unix target."
let packages _ = [ Functoria.package ~min:"5.0.0" ~max:"6.0.0" "mirage-unix" ]

(*Mirage unix is built on the host build context.*)
let build_context ?build_dir:_ _ = []
let context_name _ = "default"
let configure _ = Action.ok ()
let main i = Fpath.(base (rem_ext (Info.main i)))
let public_name i = match Info.output i with None -> Info.name i | Some o -> o

let dune i =
  let libraries = Info.libraries i in
  let flags = Mirage_dune.flags i in
  let public_name = public_name i in
  let main = Fpath.to_string (main i) in
  let pp_list f = Dune.compact_list f in
  let dune =
    Dune.stanzaf
      {|
(rule
 (target %s)
 (enabled_if (= %%{context_name} "default"))
 (action
  (copy %s.exe %%{target})))

(executable
 (name %s)
 (libraries %a)
 (link_flags (-thread))
 (modules (:standard \ %a))
 (flags %a)
 (enabled_if (= %%{context_name} "default"))
)
|}
      public_name main main (pp_list "libraries") libraries Fpath.pp
      (Fpath.rem_ext (Fpath.base (Info.config_file i)))
      (pp_list "flags") flags
  in
  [ dune ]

let install i =
  let public_name = public_name i in
  Install.v ~bin:[ Fpath.(v public_name, v public_name) ] ()
07070100000083000081A4000000000000000000000001649164100000105E000000000000000000000000000000000000002600000000mirage-4.4.0/lib/mirage/target/xen.mlopen Astring
open Functoria
module Log = Mirage_impl_misc.Log

(* We generate an example .xl with common defaults, and a generic
   .xl.in which has @VARIABLES@ which must be substituted by sed
   according to the preferences of the system administrator.
   The common defaults chosen for the .xl file will be based on values
   detected from the build host. We assume that the .xl file will
   mainly be used by developers where build and deployment are on the
   same host. Production users should use the .xl.in and perform the
   appropriate variable substition.
*)

let detected_bridge_name =
  (* Best-effort guess of a bridge name stem to use. Note this
     inspects the build host and will probably be wrong if the
     deployment host is different. *)
  match
    List.fold_left
      (fun sofar x ->
        match sofar with
        (* This is Linux-specific *)
        | None when Sys.file_exists (Fmt.str "/sys/class/net/%s0" x) -> Some x
        | None -> None
        | Some x -> Some x)
      None [ "xenbr"; "br"; "virbr" ]
  with
  | Some x -> x
  | None -> "br"

type t = (v * string) list

let lookup ts v =
    if List.mem_assoc v ts then List.assoc v ts else string_of_v v

let defaults i =
    let blocks =
      List.map
        (fun b -> (Block b, b.filename))
        (Hashtbl.fold (fun _ v acc -> v :: acc) Mirage_impl_block.all_blocks [])
    and networks =
      List.mapi
        (fun i n -> (Network n, Fmt.str "%s%d" detected_bridge_name i))
        !Mirage_impl_network.all_networks
    in
    [ (Name, Info.name i); (Kernel, Info.name i ^ ".xen"); (Memory, "256") ]
    @ blocks
    @ networks
end

let append fmt s = Fmt.pf fmt (s ^^ "@.")

let configure_main_xl ?substitutions ~ext i =
  let open Substitutions in
  let substitutions =
    match substitutions with Some x -> x | None -> defaults i
  in
  let path = Fpath.(v (Info.name i) + ext) in
  Action.with_output ~path ~purpose:"xl file" (fun fmt ->
      let open Mirage_impl_block in
      append fmt "name = '%s'" (lookup substitutions Name);
      append fmt "kernel = '%s'" (lookup substitutions Kernel);
      append fmt "type = 'pvh'";
      append fmt "memory = %s" (lookup substitutions Memory);
      append fmt "on_crash = 'preserve'";
      append fmt "";
      let blocks =
        List.map
          (fun b ->
            (* We need the Linux version of the block number (this is a
                strange historical artifact) Taken from
                https://github.com/mirage/mirage-block-xen/blob/
                a64d152586c7ebc1d23c5adaa4ddd440b45a3a83/lib/device_number.ml#L128 *)
            let rec string_of_int26 x =
              let high, low = ((x / 26) - 1, (x mod 26) + 1) in
              let high' = if high = -1 then "" else string_of_int26 high in
              let low' =
                String.v ~len:1 (fun _ ->
                    char_of_int (low + int_of_char 'a' - 1))
              in
              high' ^ low'
            in
            let vdev = Fmt.str "xvd%s" (string_of_int26 b.number) in
            let path = lookup substitutions (Block b) in
            Fmt.str "'format=raw, vdev=%s, access=rw, target=%s'" vdev path)
          (Hashtbl.fold (fun _ v acc -> v :: acc) all_blocks [])
      in
      append fmt "disk = [ %s ]" (String.concat ~sep:", " blocks);
      append fmt "";
      let networks =
        List.map
          (fun n -> Fmt.str "'bridge=%s'" (lookup substitutions (Network n)))
          !Mirage_impl_network.all_networks
      in
      append fmt
        "# if your system uses openvswitch then either edit /etc/xen/xl.conf \
         and set";
      append fmt "#     vif.default.script=\"vif-openvswitch\"";
      append fmt
        "# or add \"script=vif-openvswitch,\" before the \"bridge=\" below:";
      append fmt "vif = [ %s ]" (String.concat ~sep:", " networks))
07070100000084000081A40000000000000000000000016491641000000179000000000000000000000000000000000000002700000000mirage-4.4.0/lib/mirage/target/xen.mliopen Functoria

type t = (v * string) list

val lookup : t -> v -> string
  val defaults : Functoria.Info.t -> t
end

val configure_main_xl :
  ?substitutions:Substitutions.t ->
  ext:string ->
  Functoria.Info.t ->
  unit Action.t
07070100000085000041ED0000000000000000000000046491641000000000000000000000000000000000000000000000001900000000mirage-4.4.0/lib_runtime07070100000086000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002300000000mirage-4.4.0/lib_runtime/functoria07070100000087000081A4000000000000000000000001649164100000005B000000000000000000000000000000000000002800000000mirage-4.4.0/lib_runtime/functoria/dune(library
 (name functoria_runtime)
 (public_name functoria-runtime)
 (libraries cmdliner))
07070100000088000081A40000000000000000000000016491641000000C00000000000000000000000000000000000000003800000000mirage-4.4.0/lib_runtime/functoria/functoria_runtime.ml(*
 * Copyright (c) 2015 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

module Arg = struct
  type 'a kind =
    | Opt : 'a * 'a Cmdliner.Arg.conv -> 'a kind
    | Opt_all : 'a list * 'a Cmdliner.Arg.conv -> 'a list kind
    | Flag : bool kind
    | Required : 'a Cmdliner.Arg.conv -> 'a kind

type 'a t = { info : Cmdliner.Arg.info; kind : 'a kind }

let flag info = { info; kind = Flag }
  let opt conv default info = { info; kind = Opt (default, conv) }
  let opt_all conv default info = { info; kind = Opt_all (default, conv) }
  let required conv info = { info; kind = Required conv }

let key ?default c i =
    match default with None -> required c i | Some d -> opt c d i

let default (type a) (t : a t) =
    match t.kind with
    | Opt (d, _) -> Some d
    | Opt_all (d, _) -> Some d
    | Flag -> Some false
    | Required _ -> None

let kind t = t.kind
  let info t = t.info
end

module Key = struct
  type 'a t = { arg : 'a Arg.t; mutable value : 'a option }

let create arg = { arg; value = None }

let get t =
    match t.value with
    | None ->
        invalid_arg
          "Key.get: Called too early. Please delay this call after cmdliner's \
           evaluation."
    | Some v -> v

let default t = Arg.default t.arg

let term (type a) (t : a t) =
    let set w = t.value <- Some w in
    let doc = Arg.info t.arg in
    let term arg = Cmdliner.Term.(const set $ arg) in
    match Arg.kind t.arg with
    | Arg.Flag -> term @@ Cmdliner.Arg.(value & flag doc)
    | Arg.Opt (default, desc) ->
        term @@ Cmdliner.Arg.(value & opt desc default doc)
    | Arg.Opt_all (default, desc) ->
        term @@ Cmdliner.Arg.(value & opt_all desc default doc)
    | Arg.Required desc ->
        term @@ Cmdliner.Arg.(required & opt (some desc) None doc)
end

let initialized = ref false
let help_version = 63
let argument_error = 64

let with_argv keys s argv =
  let open Cmdliner in
  if !initialized then ()
  else
    let gather k rest = Term.(const (fun () () -> ()) $ k $ rest) in
    let t = List.fold_right gather keys (Term.const ()) in
    match Cmd.(eval_value ~argv (Cmd.v (info s) t)) with
    | Ok (`Ok _) ->
        initialized := true;
        ()
    | Error _ -> exit argument_error
    | Ok `Help | Ok `Version -> exit help_version

type info = { name : string; libraries : (string * string) list }
07070100000089000081A40000000000000000000000016491641000000E56000000000000000000000000000000000000003900000000mirage-4.4.0/lib_runtime/functoria/functoria_runtime.mli(*
 * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Functoria runtime. *)

(** [Arg] defines command-line arguments which can be set at runtime. This
    module is the runtime companion of [Functoria.Key]. It exposes a subset of
    {{:http://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html}
      Cmdliner.Arg}. *)
module Arg : sig
  (** {1 Runtime command-line arguments} *)

type 'a t
  (** The type for runtime command-line arguments. Similar to
      [Functoria.Key.Arg.t] but only available at runtime. *)

val opt : 'a Cmdliner.Arg.conv -> 'a -> Cmdliner.Arg.info -> 'a t
  (** [opt] is the runtime companion of [Functoria.Ky.Arg.opt]. *)

val opt_all :
    'a Cmdliner.Arg.conv -> 'a list -> Cmdliner.Arg.info -> 'a list t
  (** [opt_all] is the runtime companion of [Functoria.Key.Arg.opt_all]. *)

val required : 'a Cmdliner.Arg.conv -> Cmdliner.Arg.info -> 'a t
  (** [required] is the runtime companion of [Functoria.Key.Arg.required]. *)

val key : ?default:'a -> 'a Cmdliner.Arg.conv -> Cmdliner.Arg.info -> 'a t
  (** [key] is either {!opt} or {!required}, depending if [~default] is
      provided. *)

val flag : Cmdliner.Arg.info -> bool t
  (** [flag] is the runtime companion of [Functoria.Key.Arg.flag]. *)
end

(** [Key] defines values that can be set by runtime command-line arguments. This
    module is the runtime companion of {!Key}. *)
module Key : sig
  (** {1 Runtime keys} *)

type 'a t
  (** The type for runtime keys containing a value of type ['a]. *)

val create : 'a Arg.t -> 'a t
  (** [create conv] create a new runtime key. *)

val get : 'a t -> 'a
  (** [get k] is the value of the key [k]. Use the default value if no
      command-line argument is provided.

@raise Invalid_argument if called before cmdliner's evaluation. *)

val default : 'a t -> 'a option
  (** [default k] is the default value of [k], if one is available. This
      function can be called before cmdliner's evaluation. *)

val term : 'a t -> unit Cmdliner.Term.t
  (** [term k] is the [Cmdliner] term whose evaluation sets [k]s' value to the
      parsed command-line argument. *)
end

val argument_error : int
(** [argument_error] is the exit code used for argument parsing errors: 64. *)

val with_argv : unit Cmdliner.Term.t list -> string -> string array -> unit
(** [with_argv keys name argv] evaluates the [keys] {{!Key.term} terms} on the
    command-line [argv]. [name] is the executable name. On evaluation error the
    application calls [exit(3)] with status [64]. If [`Help] or [`Version] were
    evaluated, [exit(3)] is called with status [63]. *)

type info = {
  name : string;
  libraries : (string * string) list;  (** the result of [dune-build-info] *)
}
(** The type for build information available at runtime. *)
0707010000008A000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002000000000mirage-4.4.0/lib_runtime/mirage0707010000008B000081A4000000000000000000000001649164100000006E000000000000000000000000000000000000002500000000mirage-4.4.0/lib_runtime/mirage/dune(library
 (name mirage_runtime)
 (public_name mirage-runtime)
 (libraries functoria-runtime lwt ipaddr logs))
0707010000008C000081A40000000000000000000000016491641000000D6D000000000000000000000000000000000000003200000000mirage-4.4.0/lib_runtime/mirage/mirage_runtime.ml(*
 * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

type log_threshold = [ `All | `Src of string ] * Logs.level option

let set_level ~default l =
  let srcs = Logs.Src.list () in
  let default =
    try snd @@ List.find (function `All, _ -> true | _ -> false) l
    with Not_found -> default
  in
  Logs.set_level default;
  List.iter
    (function
      | `All, _ -> ()
      | `Src src, level -> (
          try
            let s = List.find (fun s -> Logs.Src.name s = src) srcs in
            Logs.Src.set_level s level
          with Not_found ->
            Format.printf "WARNING: %s is not a valid log source.\n%!" src))
    l

module Arg = struct
  include Functoria_runtime.Arg

let make of_string to_string : _ Cmdliner.Arg.conv =
    let pp ppf v = Format.pp_print_string ppf (to_string v) in
    Cmdliner.Arg.conv (of_string, pp)

module type S = sig
    type t

val of_string : string -> (t, [ `Msg of string ]) result
    val to_string : t -> string
  end

let of_module (type t) (module M : S with type t = t) =
    make M.of_string M.to_string

let ip_address = of_module (module Ipaddr)
  let ipv4_address = of_module (module Ipaddr.V4)
  let ipv4 = of_module (module Ipaddr.V4.Prefix)
  let ipv6_address = of_module (module Ipaddr.V6)
  let ipv6 = of_module (module Ipaddr.V6.Prefix)

let log_threshold =
    let parser str =
      let level src s =
        Result.bind (Logs.level_of_string s) (fun l -> Ok (src, l))
      in
      match String.split_on_char ':' str with
      | [ _ ] -> level `All str
      | [ "*"; lvl ] -> level `All lvl
      | [ src; lvl ] -> level (`Src src) lvl
      | _ -> Error (`Msg ("Can't parse log threshold: " ^ str))
    in
    let serialize ppf = function
      | `All, l -> Format.pp_print_string ppf (Logs.level_to_string l)
      | `Src s, l -> Format.fprintf ppf "%s:%s" s (Logs.level_to_string l)
    in
    Cmdliner.Arg.conv (parser, serialize)

let allocation_policy =
    Cmdliner.Arg.enum
      [
        ("next-fit", `Next_fit);
        ("first-fit", `First_fit);
        ("best-fit", `Best_fit);
      ]
end

include (
  Functoria_runtime : module type of Functoria_runtime with module Arg := Arg)

let exit_hooks = ref []
let enter_iter_hooks = ref []
let leave_iter_hooks = ref []
let run t = List.iter (fun f -> f ()) !t
let add f t = t := f :: !t

let run_exit_hooks () =
  Lwt_list.iter_s
    (fun hook -> Lwt.catch (fun () -> hook ()) (fun _ -> Lwt.return_unit))
    !exit_hooks

let run_enter_iter_hooks () = run enter_iter_hooks
let run_leave_iter_hooks () = run leave_iter_hooks
let at_exit f = add f exit_hooks
let at_leave_iter f = add f leave_iter_hooks
let at_enter_iter f = add f enter_iter_hooks
0707010000008D000081A4000000000000000000000001649164100000101C000000000000000000000000000000000000003300000000mirage-4.4.0/lib_runtime/mirage/mirage_runtime.mli(*
 * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** Mirage run-time utilities.

{e Release %%VERSION%%} *)

(** {2 Log thresholds} *)

type log_threshold = [ `All | `Src of string ] * Logs.level option
(** The type for log threshold. A log level of [None] disables logging. *)

val set_level : default:Logs.level option -> log_threshold list -> unit
(** [set_level ~default l] set the log levels needed to have all of the log
    sources appearing in [l] be used. *)

module Arg : sig
  (** {2 Mirage command-line arguments} *)

include module type of Functoria_runtime.Arg

val make :
    (string -> ('a, [ `Msg of string ]) result) ->
    ('a -> string) ->
    'a Cmdliner.Arg.conv
  (** [make of_string pp] is the command-line argument converter using on
      [of_string] and [pp]. *)

(** [S] is the signature used by {!of_module} to create a command-line
      argument converter. *)
  module type S = sig
    type t

val of_string : string -> (t, [ `Msg of string ]) result
    val to_string : t -> string
  end

val of_module : (module S with type t = 'a) -> 'a Cmdliner.Arg.conv
  (** [of module (module M)] creates a command-line argyument converter from a
      module satisfying the signature {!S}. *)

(** {2 Mirage command-line argument converters} *)

val ip_address : Ipaddr.t Cmdliner.Arg.conv
  (** [ip] converts IP address. *)

val ipv4_address : Ipaddr.V4.t Cmdliner.Arg.conv
  (** [ipv4_address] converts an IPv4 address. *)

val ipv4 : Ipaddr.V4.Prefix.t Cmdliner.Arg.conv
  (** [ipv4] converts ipv4/netmask to Ipaddr.V4.t * Ipaddr.V4.Prefix.t . *)

val ipv6_address : Ipaddr.V6.t Cmdliner.Arg.conv
  (** [ipv6_address]converts IPv6 address. *)

val ipv6 : Ipaddr.V6.Prefix.t Cmdliner.Arg.conv
  (**[ipv6] converts IPv6 prefixes. *)

val log_threshold : log_threshold Cmdliner.Arg.conv
  (** [log_threshold] converts log reporter threshold. *)

val allocation_policy :
    [ `Next_fit | `First_fit | `Best_fit ] Cmdliner.Arg.conv
  (** [allocation_policy] converts allocation policy. *)
end

include module type of Functoria_runtime with module Arg := Arg

(** {2 Registering scheduler hooks} *)

val at_exit : (unit -> unit Lwt.t) -> unit
(** [at_exit hook] registers [hook], which will be executed before the unikernel
    exits. The first hook registered will be executed last. *)

val at_enter_iter : (unit -> unit) -> unit
(** [at_enter_iter hook] registers [hook] to be executed at the beginning of
    each event loop iteration. The first hook registered will be executed last.

If [hook] calls {!at_enter_iter} recursively, the new hook will run only on
    the next event loop iteration. *)

val at_leave_iter : (unit -> unit) -> unit
(** [at_leave_iter hook] registers [hook] to be executed at the end of each
    event loop iteration. See {!at_enter_iter} for details. *)

(** {2 Running hooks} *)

(** This is mainly for for developers implementing new targets. *)

val run_exit_hooks : unit -> unit Lwt.t
(** [run_exit_hooks ()] calls the sequence of hooks registered with {!at_exit}
    in sequence. *)

val run_enter_iter_hooks : unit -> unit
(** [run_enter_iter_hooks ()] calls the sequence of hooks registered with
    {!at_enter_iter} in sequence. *)

val run_leave_iter_hooks : unit -> unit
(** [run_leave_iter_hooks ()] call the sequence of hooks registered with
    {!at_leave_iter} in sequence. *)
0707010000008E000081A400000000000000000000000164916410000064B8000000000000000000000000000000000000001600000000mirage-4.4.0/logo.svg<svg width="89" height="79" viewBox="0 0 89 79" fill="none" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<rect x="10.5894" y="0.620529" width="67.0836" height="54.4447" fill="url(#pattern0)"/>
<path d="M3.28335 65.3178H1.73135C1.55535 65.3178 1.44335 65.4298 1.44335 65.6058V76.2298C1.44335 76.4058 1.55535 76.5178 1.73135 76.5178H3.17135C3.34735 76.5178 3.45935 76.4058 3.45935 76.2298V69.6378L6.45135 75.5578C6.49935 75.6538 6.59535 75.7178 6.70735 75.7178H7.57135C7.68335 75.7178 7.77935 75.6538 7.82735 75.5578L10.8193 69.6378V76.2298C10.8193 76.4058 10.9313 76.5178 11.1073 76.5178H12.5473C12.7233 76.5178 12.8353 76.4058 12.8353 76.2298V65.6058C12.8353 65.4298 12.7233 65.3178 12.5473 65.3178H10.9953C10.8833 65.3178 10.7873 65.3818 10.7393 65.4778L7.13935 72.6938L3.53935 65.4778C3.49135 65.3818 3.39535 65.3178 3.28335 65.3178ZM17.0151 65.3178H15.5751C15.3991 65.3178 15.2871 65.4298 15.2871 65.6058V76.2298C15.2871 76.4058 15.3991 76.5178 15.5751 76.5178H17.0151C17.1911 76.5178 17.3031 76.4058 17.3031 76.2298V65.6058C17.3031 65.4298 17.1911 65.3178 17.0151 65.3178ZM20.2157 76.5178H21.6557C21.8317 76.5178 21.9437 76.4058 21.9437 76.2298V72.1498H22.6317L25.7037 76.4058C25.7517 76.4698 25.8477 76.5178 25.9277 76.5178H27.6237C27.9597 76.5178 28.0557 76.3258 27.8477 76.0538L24.8077 72.0698C26.3437 71.7498 27.4957 70.4378 27.4957 68.7258C27.4957 66.7418 25.9597 65.3178 24.0717 65.3178H20.2157C20.0397 65.3178 19.9277 65.4298 19.9277 65.6058V76.2298C19.9277 76.4058 20.0397 76.5178 20.2157 76.5178ZM23.8637 67.1418C25.1117 67.1418 25.4957 68.1018 25.4957 68.7258C25.4957 69.3498 25.1117 70.3258 23.8637 70.3258H21.9437V67.1418H23.8637ZM38.0535 76.5178H39.6055C39.8615 76.5178 39.9735 76.3578 39.8775 76.1178L35.5255 65.4938C35.4775 65.3818 35.3655 65.3178 35.2535 65.3178H33.7975C33.6855 65.3178 33.5735 65.3818 33.5255 65.4938L29.1735 76.1178C29.0775 76.3578 29.1895 76.5178 29.4455 76.5178H30.9975C31.1095 76.5178 31.2215 76.4378 31.2535 76.3418L32.3255 73.5898H36.7255L37.7975 76.3418C37.8295 76.4378 37.9415 76.5178 38.0535 76.5178ZM34.5175 67.9098L36.0055 71.7658H33.0295L34.5175 67.9098ZM46.127 67.0458C47.295 67.0458 48.351 67.4938 49.103 68.3258C49.215 68.4698 49.391 68.4858 49.535 68.3578L50.479 67.4938C50.591 67.3978 50.607 67.2378 50.495 67.1098C49.439 65.9098 47.855 65.1738 46.127 65.1738C42.959 65.1738 40.383 67.7018 40.383 70.9178C40.383 74.1338 42.959 76.6618 46.127 76.6618C49.295 76.6618 51.871 74.1338 51.871 70.9178C51.871 70.7098 51.855 70.5018 51.839 70.2938C51.823 70.1338 51.711 70.0378 51.551 70.0378H46.175C45.999 70.0378 45.887 70.1498 45.887 70.3258V71.5738C45.887 71.7498 45.999 71.8618 46.175 71.8618H49.759C49.375 73.6378 47.903 74.7898 46.127 74.7898C44.031 74.7898 42.399 73.2058 42.399 70.9178C42.399 68.6298 44.031 67.0458 46.127 67.0458ZM55.7562 71.8298H60.0282C60.2042 71.8298 60.3162 71.7178 60.3162 71.5418V70.2938C60.3162 70.1178 60.2042 70.0058 60.0282 70.0058H55.7562V67.1418H60.7482C60.9242 67.1418 61.0362 67.0298 61.0362 66.8538V65.6058C61.0362 65.4298 60.9242 65.3178 60.7482 65.3178H54.0282C53.8522 65.3178 53.7402 65.4298 53.7402 65.6058V76.2298C53.7402 76.4058 53.8522 76.5178 54.0282 76.5178H60.7482C60.9242 76.5178 61.0362 76.4058 61.0362 76.2298V74.9818C61.0362 74.8058 60.9242 74.6938 60.7482 74.6938H55.7562V71.8298ZM72.0957 65.1738C68.9277 65.1738 66.3517 67.7018 66.3517 70.9178C66.3517 74.1338 68.9277 76.6618 72.0957 76.6618C75.2637 76.6618 77.8397 74.1338 77.8397 70.9178C77.8397 67.7018 75.2637 65.1738 72.0957 65.1738ZM72.0957 74.8218C69.9997 74.8218 68.3677 73.2058 68.3677 70.9178C68.3677 68.6298 69.9997 67.0138 72.0957 67.0138C74.1757 67.0138 75.8237 68.6298 75.8237 70.9178C75.8237 73.2058 74.1757 74.8218 72.0957 74.8218ZM82.7241 76.6618C84.8041 76.6618 86.6921 75.4458 86.6921 73.3818C86.6921 71.0938 84.4521 70.3418 82.8041 69.7178C82.0361 69.3978 81.3481 68.9978 81.3481 68.3258C81.3481 67.3498 82.2121 67.0938 82.7401 67.0938C83.5881 67.0938 84.3401 67.2378 85.1881 67.8458C85.3321 67.9578 85.4921 67.9418 85.6041 67.7818L86.3561 66.7098C86.4521 66.5818 86.4201 66.4218 86.2921 66.3258C85.0761 65.4778 84.0201 65.1738 82.7401 65.1738C80.7721 65.1738 79.3481 66.3898 79.3481 68.3578C79.3481 70.2138 80.9001 70.9978 82.3561 71.5738C83.5241 72.0218 84.7241 72.4858 84.7241 73.3978C84.7241 74.3258 83.7961 74.8378 82.7401 74.8218C81.9241 74.8218 80.9161 74.4858 80.1161 73.8138C79.9721 73.7018 79.7961 73.7018 79.6841 73.8618L78.9321 74.8218C78.8201 74.9498 78.8361 75.1098 78.9801 75.2218C80.2441 76.1978 81.4921 76.6618 82.7241 76.6618Z" fill="#F3F3F3"/>
<defs>
<pattern id="pattern0" patternContentUnits="objectBoundingBox" width="1" height="1">
<use xlink:href="#image0_207_33679" transform="translate(0 -0.0186584) scale(0.0042735 0.00526557)"/>
</pattern>
<image id="image0_207_33679" width="234" height="197" xlink:href="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAOoAAADFCAYAAABabm6tAAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAABWWlUWHRYTUw6Y29tLmFkb2JlLnhtcAAAAAAAPHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0iWE1QIENvcmUgNS40LjAiPgogICA8cmRmOlJERiB4bWxuczpyZGY9Imh0dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogICAgICA8cmRmOkRlc2NyaXB0aW9uIHJkZjphYm91dD0iIgogICAgICAgICAgICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyI+CiAgICAgICAgIDx0aWZmOk9yaWVudGF0aW9uPjE8L3RpZmY6T3JpZW50YXRpb24+CiAgICAgIDwvcmRmOkRlc2NyaXB0aW9uPgogICA8L3JkZjpSREY+CjwveDp4bXBtZXRhPgpMwidZAAA7YUlEQVR4Ae19CYBcRZl/Vff0XJmck4QkhENCREFAUESQa8VVwAtELlH/Koog5EA8cD0Y8FjXXUQRL3TF9f6DK4eC7iKCuiCrIB4EmElCAgkh5JqZzPQcfby3v19V1/Qx/brf636vr3mV9Lz36lV9VfV99auvjq/qCRG6kAMhB0IOhBwIORByIORAyIGQAyEHQg6EHAg5EHIg5EDIgZADIQdCDoQcaB0OyNYpSliSmciBvnV2+56O8deLtLX3hkN67m1VHoRAbVXJzoByXdm/d2FSRh8Swu5CRR4UUn7tyytnfa0Vix5pxUKFZZoZHEhI+TMh7QOFFEtsIQ4Rtn01fi2pfEKgzow63XKlXDUQf1AKeYKwRRQ/1uM2gHXR6o3jn2+5wqJAIVBbUaotXqbV/aN/lMI+DsUs1J5SWNaHWrH4IVBbUaotXCaA9H8Bz2NKFFGu2TByXon3TfkqBGpTim1mZhog/TVA+ooypZcYpn69TJimex0CtelENjMzvHrDyLUA6amuSm+LuVdsjL/cVdgmCRQCtUkENZOzuWbD2OXCkp/0wINI2rJv9hC+4YOGQG14Ec3sDK7pHznPtqyvOHEBM734X8RZ4pArN02+qMibpvQKgdqUYpsZmV4zMHKSLeRPKiqtFLFkKnVfRXEbMFII1AYUSpglIdY8OXoEQHrftAWYAuYUrs/kvbbtfdZuiJ+e59ekDyFQm1RwrZzty9aNHGZHxF8A0uk4lJjUhfkRyp/b5c29z2WNtCxxS65Hs96HQG1WybVovldvnFgZjcnHUDzYNBQBqk0bQZnCe4u/DEKnA9rwR9rda/rjpdZdTciGvoZAbWjxzKzMrVo/cqhIpwbKlJqgjFLbAqQSD84gJSGYF1rCvrUMzYZ/HQK14UU0MzK4ZmDsWGnLdWVKSx1LJaq0bVmQZogBzfte/mR8WRnaDf06BGpDi2dmZG51/8j5trCwXa2MAzwxOqUGLa1FC8lIEY1E7O8WejfTcwjUZpJWC+Z19frRD6ID+2NXRQNIgVBqVK1VXUVSoRnv5I9utOe6jdJo4UKgNppEZlB+Vg+MrALkrvNQZGrSiEd9qsgD2e3j6dGbPaTVUEFDoDaUOGZOZlatH/039GBv8FhialLqU29d36lE5Cv7ttndU49NdBMCtYmE1SpZXT0w+gNM2V7poTwEKH8VAlSnBAJL9oyOXeEh3YYJGgK1YUQxMzICkH4HJb3QdWn1LC+DVwXSDAHQsC+8+OGHY67Tb5CAIVAbRBAzIRur+kf/A+V8t6ey6s6uAanRrNpXdYK5nOreYfl1RefsQ852H6MxQoZAbQw5tHwu1gyM/ghTr+/0UFDaCSpbQcQxYCRgaVjIV7RMojWhAbEr0ogQw9zxhcrAyVWMxggUArUx5NDSuUB398dA1gWeCgkwalROdXkJVgNY3Mok/3iiqQMzztGrN8WPqCBu3aJE65ZymPCM4ABBioKe76mwMLwHJAEoYlVhUf0hSumJawKm+TAjlJXW3y6ZtsXpCzt+df/99+eA31MuaxpYMaCmKYaJzRgOwOLoxwCTN5BOcScDS6VEp6opPWmQz54gf1MvcO/VPR7tirz2+v26n/UasR7hw65vPbg+A9LkmLRykJJBBoOZKw4CxeCU3d1ckFauDaV8QWo8/YZmEUUI1GaRVBPlkyAFgryNSUuXD6bA2NJmY5eqBipDVw5SRrbtTinlq/ntGhJrdBcCtdEl1GT5W9PvK0gJRo5WsVkNA1cY15Md2rM6xkBPk+qrB2N7j6qOUm1ih0CtDZ9nRCq0OAKY/NKkZmlmahkGyzvKj51h0zGukrHz8UWMt1RJoybRQ6DWhM2tn4gysPdicVSeJdzxQu0ZwR+NTepVjVH9XJ5GuRCs/6+77Im9veUC1vt9CNR6S6AF0sdWtXcAP14N7EuXXEocs6IQSlCynvJqnBmf5vqZd16ujP+iSFvkZV4i1SNsCNR6cL2F0uSRnsDT93wvEiaOjAlSEdrVAnSKJBDfjibhnHdt2tQ55dmANyFQG1AozZKlVevjR0Hn/Ta4/Nrs/voGymL5VPRl5DWzrN79i71vFL8QqI0iiSbLx+oN8ZfBOujPwWY7UIzmZN1eEk1HXpXj0XC3IVAbTiSNnyGCFKuaD9ckp2Y0GmRiOFUf3feT33Vf43Z/Q6AGWQFakLb6SlpVIK0F8rwxHms+PN7l1Hn7LmrYb9WEQPUm0xkdevVA/JJ02v5TdUzw2J31GNzkDc0BWwSuwZZ1mSQWWUK+sU9bP5WNU+sAIVBrzfEmTU8vwdjN84FgtQrrmtnEKvapWvtve0RbP7mOWaOAIVBrxOhmTuaKgaGDkP+bfShDzfq9/Ow48uuqfsesSTEvuVMcMNY/9+PbL+zxoZy+k2jznWJIsKU4cNG64QVp2fZ3GO9Vuvczlx8VdmRzSfhzL3FAxJLJZ8QRIw+KfSc2ivkA6uz00LHz0zvWIIU+f1Lxj0rDMM6/IoWU/OLAqvVjy1Gh+S2YLr9o1ptOm5UQixLbxLHD/y0OG3mI4BTt6UmBfTl21LImsJvueTEWO0a+7f5d9c5rbvqhRs3lRng/xQF+VQ0fbHoUHi0D0sWJrfaxg7+SR44+IOYmdos2m3vQM4bEaW53FbROWia6EjSHfBt+DeNCoDaMKBonI5fRLDCd+jVy1BL1Y3ZqKHXi4M+Hjxq+r3teYldHm0xhqglzvJwYJk5p9m+M/W3RDtP/N8OD01E1G1OXk37Y9S3HoRn2flX/8CukbLsXdbQhJ1W8iKPNTorDRx5Mn7bzh9uWJJ7pxHppN8DZhvE2ZnjxT2HRgaIUx8g3P1Abow6HLOR6t0SLmVug8L5yDuAzE6/FsWJ3A6R+TBzlZ4TqS/cyjb/RYubZ12tvcrs4ec/t6eMGfznWbk0sBHGzRQ6qdGrtpkQe5LcR56W+ZqoKYqFGrYJ5rRR1df/YWVhHvAVlqkHjXQIfVTKVWvTFI38Sp+36obVsclMyYqf1Ek1mKEo9Cke/8nW/fU6nPOOXkypGnf+4Wmeqcx4DSf7ih7d1r90cX4puUHmBBZKDxiG6un/0nwFSHusZNEjVmA+YUVekZ66+MGNWeq943c4fivOfuz6FJRcrYqVow4sRKI8WxZU/fq3cDUiZo8mhS3hpBDcjgbqqf+/7OufM+V8rYX9v9Yaxi2YyWNeuH7kUXUF+OCnIQ74MIFWjiD+mcTTXqrGwbGKTOHP7N8XJu29L9qT2ovVV5/5yJAqAStZz/rylJyOXV50xnwh4y7hPidaTDD8Rj69Pb4LIopj4YwXaISPyU19eOevf65mveqSNRuos7IL5ERRbEJumydvi9UtNt+Jt/pi1YhbsP9Evzt7+DXv5+EAKSy6QKiaLBMDJ1J1z4S69RGSxPPf3O90FDi7UjNKofffZbTJibQU7+TUvCBIzgFIssW3r8+j+nRocmxuPMj7YdKSw2N21O3zPnQZiLkgJF/PTAPUJpC8YWyfO3Xajtf/Yk2mANJoHUhYsNxeVFLTduqOSaH7HmUFAteXuZfE/oi9E0bEq4aqkCB7IBQDtVy5+eE/TfjreS8VQFkdSPoQ4BGm1VXl60hqEBCad0Wma79rPl7/7wATwzB3fTu83sR6GRWqjDMXrd50+zr7vlKDH7mX54XehyiZYrwDQmD8BRJ2m2wnWgzvntH//nFtu8X9pol6FLpLupX8bmg+zwL8Eokl1egagpgEw1yK5qdyrOz0i3rjj5skDxp/E6fk8mFstKQWSlhhOnVt5Tv2JOSOAikOhr0RLS2aXEiQAap+47MjXf7RVJ5euetqe394Z2wE+8HjMUryotnZlu7nVUioSn/a6/7jrJ6MvGXkoJe00J8FQlqm10SBK9oki2aipV5DCqmlBnBJbuz5+NL6F8IjT+1x/1C7MFsptlp2+/MZD5tye+67Z76/stxcmI2Pb0QgF2WMw3Vxz9Z1tBOmr9/zn4Bk7v29JKzU/r6vLAQ0tA4Oo1QlruTz3D3X7oFRLa9QPrLN7ANIiZmCoR2bmMacqsVnGWHVJREY+dgW2d+W8aupbblVLyPiOgEFKHhmImKvvfDt65HfPnfH892BBn8a8QsF4NCiQshTtkV/4XhgPBFsWqH04UqMtFt8LXhSpNNhWzDa/mMM3DtAuH23Fop8855ZAtU+x1H33u7J/78JZ7dGdqhHynXptCb4w/ujTFzx7Hc4QtRboycDc9B0lmhuomvsj7YdfxtWCuriWBeqe9XF2d4uAVPE5a+1ZjO0SO6CkvHjfo8dfWex1s/h95El7dkpGn0Olbno5HzjxxPZLn/4EZ3eXgv+FclVdJPg6Nb9+iEyKrV23+UGoEhpNL8BihV7TH/8q/J1meHWUcut4tt1lWemb1z46OK9YGo3ux3xPROK7YAlf96WFanm1z+TW4cs3fXgoIlI8JLsQpCRPgPJX7B3f840PILZfD73tnIZOKZC/LQfUNU+N7mNL+1IfuMU1uRXpnvZP+0CrpiS4TmrNat+CRIM0C6xJmbrSoyNXbF6zIWYnD0GCxeprGmNv5qXYu2we/QLYnSe8NUu0dnelC1e7fPiS0jmY0bTTgjNz/rR6/HqYZb8bH+ZtqN3+pZjFL5NhnfSvUDBNv580ZiWTa59e+zjAeqSDTIlQY8tbii3+vbOtL/hHzD2llgLqkg3xh9DB8Xf5QYpuzDzdAEP+E92ztT4h+zbZndG2KMfmrTBjbZ+z/Su/XDKxhSAt3n3XWtKfRtm1yOSB9i2vqbkFW8sA9fIn974bm6eC+Hweu8C9Ukb/I3NspmuR1jIgLar2JEfXoRt4QC3TDSgt64TBX/z02OH/Ohb0nTcM1BiiU2VtH6/5Gnu9ijpVZj9uuASRlJFgdzjwkB2cfmDL5976lZUrG2IzseHdxQ/bsc45o0+ix3+Q8Wviq/2C8SfuXfPUFQdIaR+MchSro+zyFvOvTbGxi0Oc+UAblg7U4LgWiTa9RkW3VAKk2wJnll7iOE1aS64KPC0PCVwxMHFQ15w4yt8SIMXRnYm/XL75wym0iyvAhulg1NCY7u+BZ1UHpaHF7a96S9V0PBBoeqCuGYjfg/LWaiEa2+Lk2lVPjJzsgceBBV2zcfwES6T+jLrLM4Ga3uHE+h2f3nBeP45TOXWa1RFLR5DWF6JZHkvxmexD8HdNDdTL+0euhkBPCp5NeSnMRXt60+rHh1fm+db4YfVG7J9Np29D3a35xEYgRYW50Tu2/dutnenxs0C/eMPbKCBVDJAvsv/z+AMC4UURok0L1LVPjrw6IiV2NXA3f00dDveQK2Qs+g2uV9Y0ZSR2MU4vWD0w+m5hyTtbRZOSh8cO3TNw5N7fYRksgI3sQQmpTfwsKNKFdJsSqJc+PTTfikTuhjb1dymmkDtOz1gCwhr7SWjgP3fFli01O0n+nHXr2jvXxz+A/t8NmN3tdspes/mviP91/Pyt1/WiW9tcVmC2PMq+5ZyaGJU0HVA5edQ+GdsCobajsvrXGfJu042DnK23puPzPnTFFjtwsBKkS9sP6ANIPwut0/TGDKYxwRfUrEu2fnIHLEsWYgzqnzxNAsFe8a3ybdcFm4Sm3nRAXTsQ/yPsV2f5ClLUfBjhp8ESTld4cV2oWh9Jj8cvW7V+vf9nD2VyokDatv8/YTEA2hRlbxF34NgTyUufuWoXPtK0H4rkJ0gpR6+yrIyrUry9sojeYjUVUFf3j/wWOvTlLopIIWU+LqIEVk5oPB4gogJ5Nd6WEtrN/pSw9nnn6Xf7D9b3PLlz9tKOAz+Bbv4a5K81Jo4gnBVjf7Peu7VvuMsa44y1n/WQhyeNo+ktJ3ME88XNtu847ihfKJUg4ieDSiRT/avVAyMXo7KWN+PTQIOwZBqisjLSctNaE6xeYZopmOyRkci1Kw9e6qtNMO12e6Jd/4RSXI6Emmv8VkLkK8f+ar392et2zE4NzkEwP+sgxZ2CGJOoK7UCKvYvRz9dori+vHJTgX1JqBoiq9aPLJK2fB403OaXox22qeYgHbfxKs4magUHzNtQ6z78pRf2/LhiQpmI6ugUOfZZdPPfCbrOZnTVJlTD+PzcxMuGf2OfseP7g/NSO9k78HsyECCFNhUigR8bNif6BLGfdWJIJJYtlOfeyuFTIM7P1iyQDKrRoy13gLgXxlIzmo8CeYlXcRmQCNNZAlV+9Zr1o6+rmBAismFKivjngf13g2jLgPTUnbek37r9awmAtBSIKmWd/giVrQz4OblXE7lnMjtbdGw/rdKMu4nX8EBdPRBn61hzRw2JRPnz4tiCHwxNfv3qJ/Ye7yWiCfuBdTt6ZFp+BNWM3eharxGbbPh65YFkb37+2+nX7fqRhS+rcTnDv3qnJQSQsv8EefHHv6WB6jeI0f21Puor0wqI+cewAsJ+POqPFzlscfIjgRI0MpKE9CsC6yEiGr1u7cDoS0skMe0VjRmisa61qMaX4WXgSz7TMhCAR1c6Li7Y9sX08XvuSkRFitvVfAYJDOSFSGOQw6v+cQMFHUFb3NHf/IqH8O57tP3zlwW2tu0z07yXzikGNOnF4OXX8T6vMeE4h27pxGbRkxoSC1LPC37FC1P8OOgoKVKRdpGUMbEntkTs7FgqdrYvF2ORHgwg88goGi7+KEHzDxjllVfcYXNvpF2+90sHznquXFpcglnWdsAqnE5xNZKaXS58M7xfmNxuv+n5b04cPvKQjc8fogtfmRAcy6oPB8UJDwghMYnEg0JtwQpCH641Txd6VuPidSYm76p3aXwi5AL5lj/cWj2p6RS8Vr7pFALw4VGd6Vh0tyEdBQCX4PMFOBVdvGj0EYFPvQt+qJbAhCE3Zgz01544m6PXWLTkErJdDLUvsjd1vlg+Ovdke1PXYXYy0j5deCYh5yunpfjxIfLL8MxcnWIxE+PokX1JRHqu/cpK6bw1DnTXbIhfaFtomNRyjxPJ5vCnXFbE/26fueOmsaWTm9tw5iO7u+X45a1wGnDUnKara7QogcpJnW6kiE8u+pyuUy619n4AXykvvzLhRKOEv7/MK5GQl1ewZWUlF3NTu9VHaY8ceUDge5fQnMMAYmZ51MznZoYmTvTZd8W0kp0EaLd1rhC/mX+2WDf7FUrz4o2X8itSBREKHovlwh4SkchHbzh41k3F3tJv1UD89ahv3wGxxU5hyvjr6lirSlkiMx3WmHgtxqIn7rlrDPfsvrNhdMGnEkSdXxGQ+qttDKPWTlUXWLfUOu3pDbMGldan/uZtQuwWi+VFD4w4Z7myN0ExsLLcIBZAmpyTGmw7cuT34hWD94ilk09jkIpGUo0WqdgqJo3GNSKS0Xb7mc4Xil8sfg807IsNNXN1Q1w1IgjoNg4zvQUbCN72pYO7HyhMYM3A2LHowdG4e1nhO3fPqk5Sm0yvkO4I+BbqoPHH7dN3fG8C5+/yK3kwsXTNo8rywA3chYdwa/gZfujOsFM+8rvBleUhPxZSirxRvvn3d+V7V//ktrJVn5ILClcM7Lnz5UP3n/Gqwbui+Ky74GwhnWkAXZBwFYRym4x0ift732Lds+h8OyXbwQd0a50EWpyqabWLv8311adD3JuanLzoa4f3bjGvCFJLWHci8Yo0KTLAvjgW9zEKQN5xj/+1d5TTMXt/Y71hx3dGe5LDMeSC5pRBNRymodSlnS4zsgU/1aQ78SNLw1Dxj3ePyTMfONxvKTgVxO90ytL74rotC8569ppHl44/vTxmT2IN1FgAlo1acQALo9uN3S8R313+cTHaNpfCC44ftkjBWOZb81f2rN7VP7FfRCZXCRml7S4rtWfH2ojMDuE3C/c12cFRLJNL0OM5becP7MNG/5jE0guXp8jDoEBK6hyTUlZOaZA1+E0BlWGLyVX7a3oIUjQM/b26cTE3Nkf+w/00vvDNFSuAb8S9ELJvf1U/5lRW4NsvNFSgc5c3zWjTxdGxsq2sk5B0CvjL7vCe2CLxg+VX2U91HeouzanY7m+QEQKLYxf04+UczO5iksVlGaclo4rF7gYqKw/YDizb01I2Hm12Qrx07//gq2o/FosTW/X3SQ2AynLdUPF8NZTNtRgBvuPYlUwxYC7GIIbLdcXC5L53e89u9/uhVb/tNoKbcH5lzk1ajmHsnx3/HUz4vAOo4dimnDMMZkjc8xG3maepyHpiAetrCGDzy+JTLexUkNybeHSOuGXpavsvc04sn4PciDPsnt3cZZObxcl7bhdHAKgxDk/AY/V/Shi+MoUyxg9LO6ZRJvnce50cKwIdgZJCFHTBIXNdL5xkmqk8phKp+H782QOg8tOWvjmnAviWQDlC9m3HwwpHXotwtMIxLWA2mmGl8dHPhb7mbeFVd5MisP3keb9lJjgmMG69p/cCjF3PMrPChfRm7DMBinVR2OreJ44d/m8xO7kHnR8OjAki5YKoS7rPYTR1lvtMU08YaSDqN8xKBMtgSuqZIYVzAx1svm17pTzrwY3ZLFd3FwRzXedIWXKkOji5Mg8Snw5S15RcBywrHI5b/zz3FHHr0svFRCQwQxPXGa53QAJ0+eQGcfTwb8XhI38Q3dYIjEsm0KISJ4CEBkoQ9ahQVuwZsWVguhj/8TXrDHrdHFQo3Qk/DWoCVk9zcCVV55LxnJwi5vSyQv+N0Ko87tQXR5Ou+rlU54/AYL+3OpUqT9kKFcHwBjs8aPFkf2v5NXIs2jKHKZTiy7R3NFpYPr5enLLnNrH/+ICYn9ypwmQm+XTFJjfLg2AabRcepD/daTNB+mPSSm1jI0Kz66hsNXRnN4NjhOScpLPUg2xoVqhmhV10H5xzEXwgXoqE/dPjzxZtkgPuhtxnSSOkwY7F9nf3/bh8uuuQUkVpqXcE6OLJreKIkf9R3dze5PMwMuHcjHY+1TtDLv9qxp3mquHGip7tbel3Jl419dcAqBoaJh9O16uhVa91eunFP8hMOubD/tkrekUk9hgCcP0wKwTHGIG90N2iElwYi86x/nvh+ZHfz39jy49baaZ53NDd4oWjj2Im91mc4KZXGDLgZMWmdnLTlQxMYD4SdgfUKssLoJaoXe5L4wsR98npkFiKeRYCXxpQt8lrdqguuP7n6CwZsTfDiumOfd4rNncd6hiuli9Qy/TIrMpEOQbF/lBx1DAswTBJ1JvcAQ1K+3Zdj9mzyEwYaa+61JgqC+kc3YCVIYqVjO9N/Sh8n2EQ4hW+yU2vPTVXnvG/e3O9KrkvlUQl9MrGAUjvRKDT8fN7fFzdeINsL8ONsehs+97ec6SaFYbtcDM7dnFpP33C7p+LFeOPAay7FUBZJqVENED56IIzDNaCTkNRzZqBKYU9P77lr9A/nxG2uEee9cBr8z29P5Wpmt4Jloph33bCKZgDuBdhSheuFBHnd35UqLI00rLN3tR9qPh173lyffcRTdcdpqECu7jHDN8LLfpbMQcAJTS5ykJTk+xqi/JmNzfX1bS+5CbcxPdpdH+rVko1YzwOKo6K9m0TYHjVmS4qtCrHEjk0y4KVfcEJOct+cP5p4r6Fb5V7o/NrxsecfHq6pQbdD7O3rxz6L3FI/M8A6ODUGHQaoSwHNExZumBmd6cl3VIe3NNupUYwsDpMnvknLkNW7IIBTbHstD/7J7Tc/qen+2kcsbFSsTrRpxRwstWwWD6pXso5DNw67VF5yu7brBVj69K/WvS26MCso2DMGysftxxtn993p0fFfhMD4vjBu8TK0b/hq8wjAl9RL13KbCn0nYarzzlrcXI4yECMb7fF5NCoSKUPQGmrAmpWJAHyzb7jpJOEnb4PSfjc5WWTJTnzkQQ4MegnWNUp8nptrTRg/SqxnYh0Jh6bfVwKM8Ndz3SujPCUiXo6bqzn+JNLLCvij4kea8jutuIAqAUrgBB1gcuGZpV7nxJichA7GC2asf5GXiJeV026gQPV7gM4X/qqzcjkcvz8To+1Tp+8gO4o7rmeQK3NBsHvtEDSwaH225ZMT0a7kv09R7U9sOBNbRs7D5W1Aixnbuek94jlExusQ0cfkTjcWsxP7JBtFtowtY/aId+ht/8c4Jrz8HohJgZBG3pEuyHUxsXy/dyQUZkLvDJjlvceZO1ENOQdNYAOJj8y9iC1BGoO79FaWIlIt/3UrEMjGzsPl5tmHabObBqO9YpJqU/+9APABCfXOrnmefD438ULxh+zu5Mj+DKH6kZQroHLNqfY4S05YAGHo08DpLDisqZAqt6g/n9WXio+VSmjAhWmfedxbxBW5HZkruQ6ZaWZd4ynxq2qj1e3CgvEoM2QIh2JYZN6p8CEk4i3zRVY4hGj0bliEFvrdrTvh32w8wR37ozDrpjXPAcaNGnkIW7tOBuKE0ALYBiPDyuJfSc3ioWJ5wRP+aPWzJutzSMSPlTAATM+cMIH3+e/S+Hc75FN6O4O4ZWJnpfyHnR/K95Rk59YHt3qHuxbTukR7clhUCk+LuXwkg7dM4xfM1e0SGn2DvCchj8qqogA41EcvdPWif0vHPtF3eY5yy3GqM14FQkVd1rP6axD52PuC0eyoXyYgBLJSAdKHFWg5UYAGr2z7DTd42+WtVeddhHFPQFL8NKF483ivK7Ql/VF1xRDYHq9YaWlrxYkw6UxHp3YIcTYdn1fHKQMaWFQtki+V+zhg1fn/ywscsDOp7gj+TBu80FKcKbGsHV6FL84so6ZMbZErLkizTU73CAMZ3CllWFI5hKNQW2026J9Fjar4YdN9CKKwxGk2Wc+reiGmSRed6dApcqZkTJ4EUXO2vCZlM40eAI3L7krm0/mnjnHTw+/s6/COx84oHtdhsskSBCauQ1yXh9tqaXAlpFYyfYM2c2dAObGAVLWZxUdF2eHA7vErXh9qnMQ5zeBAFXcfvzlgKq2ZFfgBCgTUK4JWFIRmCwkK61iFvmjHCeCyAiNTLJKOVW7MaebBuMmoIJGOUOCRZhoVLR1RUTHAlt04oNgeqZVL84wHuNrMTS04nHsspryswyh85sD/HwYlAG7bBmAZmwl8UzO8zeG+jOBu1m452mKGUngVRL1OP6crs/sEarguJRzUry6XBCn975XA/uOVy0DCLdiSoUFkWIcli8EKPmhwIk/SnOqvq9pwXRrxtyYCsocm2eG1znVPjgRDM9YguHgjH3EDim6FuH0oGUEMGPS6Rj6PvwbFAcoRhrvswvIIYx6pjghyKjqM+CW99AJEr0inJ2qXpr9x3obspF6LWTGtJhBpsUf75knnWke4K2bdmpRAjSrzNgbnECvh3U6DYWjVgMRwouLioPk+8QmL1EYNpsJrzGLhLf7TsHJnkO/U12CBKanU+NoudjiTDkFUTxpJhn9R9DRaXEZxjGsvtfiM4xFl1exEs88qgeRLKQzusUWYzsx87IcGrY3grGtpqnTUuRVLAN57RP+9coBApFj6CSOf0qi4rLC8pn+We0CoWhhqgslR1lqOWZOtue6ERvaaEq0dQ+JaGcEw5oO0Ta3U7R1QHYYvBswe81jqfA6L/xrjnbB1nKlXRmLmSYmDC50juk9ifrMbi6VjilnpoiM6NqlxVMIm6HrOpb3CE6k7euxr3TB0gdFYs8haF1ZeGaHRdFwNIXSjCIZ887c6Svf6OM1eUfn1nhBp0AtG+1Mi+590R4uwllJmRZc0zIMys2NftPqfzW3KyslNWYC47AUKukkrhxTc9KPGkVJDVfNUcNf7+moYRCiSX7bNJYQ7bPbROeimGifg0Y3Y/Glw1SeRvFc6Zxn62k+fYJy/Hnd1YUZpmqQitNx7YvZ3/w0XMT0HKEYTXyI4UBosB+iqTkWAJ3qe04La4TBF0y5Mu1GxpbLN8cfmEjtFmLOQRERm43GQo1HmDKdEQ7vy9FimJnnqCFVVw+aJDmMw04xz8AODhtg/oLmm64rmOnvmBTt8yOYh2gDeCFHNLz+ADa/DhSjyQnP+DY0UuAB51X8c4cBrI97IVd1JbX70E1YKn6Jqn8KEjZdBqc8aGhWBlBNk+ylxtUVpXT+yXwRtUT3YnyJZHkEyzu54TUlUi0mJPrPRMcKyYrJGc0EwZnEJB7GFzaGGUGDsxi/tWxwqmskCc2aRqMLLbsAk4g4GCQSM8MbxsyVbTFK7vxMF55alD/OteiGyV18N6Fs8UsYP5zhJqgJUw5YJpzzdbF4F16ehJ8bWgo6zsRcvNEUOPA16TkLSDUI6Shm6GAcDa0w+wAcVQ0B6yUdE8/MANJmmNQNXReZaaEg7OJN7sQ4H+Mwzsxr7cnGjBCoD0iZtm7U0TRbHXo5b9LGZA40Lca27Tg0PYZZf3aPo/j4l56YMkOt7JV0ijoUjw0TJ8I4zmb3Ht/OEZNooNjNZTsfhJNqP7YnyqayeopkAttfFQdDhA9AkFBZNXOcjNiKNJcgRUw44B/5yZKU0tQMxRnh9oW26NkXa7Fdpuy50jDSoWWFeY/baU7HKZfmtGgN6MGZ2skhS4w9x6Uv8DDTvS1d/voXRMscmh4D5Qh6TdE2TDJiuS7WA9l2w48GMjiBFpZhcNk6wkaak0epMXzXBDO4tCRK8UN7nOSFo+lfKcnrUNX/TYvZ8jIBhrtzFWfJ/lesL/WIv6BQB7tLypdQ7PI+i8b+M0j3vfgdhWeWgS0+YaoFUorVtB6AJZCYvb8QHb3QFfhQYxbgpG+A66RF2A1EDIyBdbpO4fC6kR26s5zBHHkWlZYATeXWhdx7b4WgBLL89Ba32tCUHL7cp8lALNSwnEvk7koCVk1ToGgWyqrW8ylCBsePJc7E1PED/muLb6P7+z63qVTezZstvotEggcpBW9h4TkiNiO9m3GU9k/lKrEJE1i3g7ln4+0X4Q/kTTmCzRk8XNhOoZszvAHaFcbTs5ejE90DESkLJ4qLcelY3bTo8isemgNIXDcKTuLVMXRshmkslxqz1IL95C7wNmXK60c+KSsOIUjTeVIxKG4oaUC+ygGE7C2wNphP06p7PFMuhaXVslIxa/JHihO8pFOYXVdxAZIrUdB/ReCK4rtKRAci+2BEKa7CLNn3isVDXvg9F70tBSMVFUYznWAh1ErkEa9o0dQFW+nupegqKTImvAGbEavxz89GvgZhWJqecc2Q1UI3GtDheGbeSEPnCjel88YAPjuOQ8e2o5u7DV/HTppGuni5vCatGzUOHR5DuVbgOtcriRkXfgEsSM81fe7SpTetaelQOW/tb4rXoqp9AV7+CDiHduaWlZ0CR60SNwKgy5xAqsL3qnOBaU2iz0Q3IOXLkiDVAdQEBc3BBp+AwRg0LMdo2hmQ63LqJ03dhOA1Pw2GpTmGBqVeqsK9WrIiQLVjnPx4mRcBXVimBCbTBh9LidFnYNeV5MCNuTE5qj5hdnht8RJxsXg5iP2ueoIzgMLj7vnvSVD2DWgp28UjYKG/rSWrLbWQBiim4MTHAM6vuRUVGo9fI/7JmfAsE0FebkIon7yqtlAyHQtgigjrJjPZpPNm+GSAqp/z3xXSY5mMM/HNc42u2OgwiQ7H+PMJGKIgt1YMeQoiLxjvii65WnBWRtjfEO/E5Tv4scGaSY51mPwtz2MJBfR+AQ3hzpUnmKFj/7uYDT23Do/7uSNdJpSu5KzKrDoj+DuI678g898sE3PaaxCR4hswotbajAAhULsUu7xUTHKDQxxup+vaBx1qzBBHYUesp/1Nusyz4ZuBonk2YepzJU8tTBKlx5MwebNg8mYJnDsBgLLR8tx7clsINKp55UfDORc5YYPOLvBMcVyNYG0zQwrnckfEP8qLoVw8uPJEDbEkxh4Sx6mYqmn8vV9JQRcKHU7Q3AJd+iHMgN3vnZSOgVrCedj/B1o/QP5MK240Wl4lKpmGKhv+cPtdfCvHcxJrdADtYq7VAbA0Ms9zpF3olxcg8Afd4CEXOJsnMToJ7TkMkMYwSYRdH/iimemGB5SRQpAyGTS2wwDrV8GZ6/gYUNKNRdbtWrMtrvEKUhbUFRPRlfkEwl7rNjwJF3Gs0Owa0NyFK+pPIPW3eVH/iFPSIZ/cXs8ZYP4MgFhGV+VEuOlOTelDGcVQ72ks0dnLSadCLTs9XrA+2looNQmYTk7CmAMg3ZvAMgsAarEnwfJSg1Ze7vL5z+vuFga3/wOnGYyLzfDvKXxX9Fk3OEHmt2iyNfW0xY+gkC6sJM2yjMG4tAOjPYLLaKpK0uHkEMcv7JP/f/Fnca28SU0YVULLMY7qcnGd1VbbkxiOC2VM111lYYxijlxSsMcNt2u1Qct2L4KWnYd2NEfL6qahLE+LJVHGD70DtnFwaZj0pUaSsM6ZxDWKZ0xeWW3IHwNgE4KaVAsiDyr5zB8uwiyWlwvs93J2mJH/IfLzNucQM+rNA+h9nFBpicsKFMx+Fsxe5ikB0x3LatC/If5HxCXiISRoNJ0nkm4DQ6t+Eym8B3nmeEGPGvRHkp1JZPPLMGV5oglBYbVBcbdjXq19PlLABoAITqAwzvnkCROiyFVFxxgzCdilkPckTl2ZgLaMYzklkUCXPAkrGpQr1Yntfew10GnNaXLNUgfrePxlL7u35ZJBw7k/JPAUwlXTyJdLpvHfS4zX3y+OqabulxQqKv3bwYXv4Vcy3BSndIXnOmICMbDWIb4sFmCJ5Vw818ihqnNiiaZZrBwcgzPvrMxuHPNpli7chM+EQRIRJEULGCZFrassYZAFfVwMrlij5aSU2UytWcrJHzRdSJZ7d9NxTINhVMAurYUZW5yNpto6K2MQr6XAshh5MAy5Tmf81ENgf7bj0Ko+pb1dJYE69HMEfIOrwK0ZaBcsAfYFz6rCgKNw7ftQyfthEYSqVYZ/ug1HNUO4nag0d6Fb9DlaD5WJF9hr+ybxUlSlB5EALRjYJSxXBpMXamCjk8gbR/6YCFNXhtSAyXgVROVYl0DlTgxzCBLv6cHzWGgioZ5x1VELCEylVL8bjyBlRgFUrqv+AT+2YjPN7YKi2h+KinMyVTln5vUri6ByFZwg4Lky/4Prx6HeH0F9zKuuVeWuwsiYVfsLKsgvEP1s/LxUeILES/hsDqeVusCDIDTjTNMU6NhZjlWWcjYPQd69HzaW2Zy6T0mKv6JGcCniNPeRWiLkbpT7MD9ASm4UrRrQSK9BC39PUXZRWFp79iP2VzHRdLN8t9K8RYPX0xNgnUAe25HfouWsZ94CTZtthJ8lvkQZQhe0PO5LgPp0OurTHYjBYUWljkqBedBdf10P/SxlpfkqFm8QJX2JvEhsK/ayEj8WOs+xIwam/leep35g13YQ776ITu5BmBg6HBMKX29UkKosp2HSxmZlpjk/qy81qQZI5Vx8GBpVYjmuckcZEqh0vNdSJVhztXzhswpe8z9jyNVpfoKUJZgGVEzEnIOEOO1OxhCc+PyX+D6eTsWyyj5YB/oQ9tFtqVp4IBy0Qz43oCxsyUPnlQOs9ByT5gLBK41M+MxS3E14NGDzSolND+sqNzdkBycaptlmqfDZayrVhqdFnC0uAkb+WC2pwvjZQmbe2F/E8LdLvAmPLwFLHgFrfyU/AE3axA5dYDY40xulJi5TwFlnle9Bj4lmmb44+1tiH9Slh1GRl/tCsBZE2Ejp/tg0nBRJnnXsp1grPb/Iu6q93GSg6kTqTQDreZeB4TfWOx9Nkz6+PwUDey6v+erQYK4Bwevxa/R6p7vX1N1sshycnqRXhUkhyN2wxXoLJo8IWN+dYyZ8T6nOBEOt6koAFvodL8as+YCr0B4DofZzjZvWaft4jFrL4OyeExeO2IBVtRjHggu299o4PTrR3iHuaWsTF3g5WsVrgWZOdzCm9q165c9MCk8t8qKgQEpGouazK3lVgzKVhjr6gDsHkKYB0BFYkw+hrzGO3YPJSexNmhT9bePi7UGClPyaMUDFLNwIxkh3NWglqXe28Nk4gPQSsT7wjDyvLN24eaL+LneiTE9S0WZ6mibl8vcYjpfay7PQoElhM0aXgPej8/8mjpZXlTenrLaw0zJVLcFGjq+Wnr5Z8cxjIxetmrzh2E1sYn6P/2NSp0xhzoBa9XPFQOEUx4W/ho+DNnQRf1oQjkFT2E4SB0j5FVAzJkW++SGVvy+6VhylegnTYvrvMWM0Klmnlhoi4gL/2dikFCXsTxMwsK8hSBWn5uO8LVvtyKqOcbkaMUvJADbr4/GO5tcTMJ4dwbaD4T0arESmcbAE3Tk5TxxXK5Ay3RkFVBYYY7CfoHNTzeI7ybSC24tpnVmY3YW+qK3LzIz+qOpU87up7B2aX0WkqTET2BQ5gsXIOECaRDfXaFESzrixVFr8434frN5+1xB0c51xQFVM6RQnlmMOBcQfZ/jY7TE/trZN7yQ22C8QC7Cjg8sK9XFj4mNImPuUG8JRvtSgowApNhTic7zaOsMAlAoVp/RMYPfxW5d8Wvy91pk2+ah1unVPD8s1f0YmjirMCIGYhKAwo6fHJQigPvuJK7rO6sddbJiSFzH8eL5zUzkbE0aXYOJIH2da16xDBv3IwAuryYTReIYGZVTOqUaYgSDrFJZYJuJC8uN0wKYycFB7JzL2T4ocuti4jqYs8b4l1+Lggzo4590zdchMTZPcju1XS7KL0wToJOxwEhibsDU1wqSgcisDKwJbX4bDN8/V3vEObKaLtXvMPZtoOlUT9G0N/g43CkhVWdPiPGxApLldSWN9Aoc8B6jU5A57OcqBd0o+5jHDS+4mZAPKeLxyfMlXlDH9+KyuWJAhXYSx+YxAmgL+ZkjxhuLfA1CfA5Del0mq5pep/NQ85QZIEKdXnA0h/DR3Zk/JC550vACYFGL+Rxtz3jEcrdahZW1o2Ag1bVvJascYZRwnSfLHX2UiuHqNkyLUmBR9hcZx0KpbkZtl+OXXRTCfwJxkw4keDu/hpU36GBL8UfLBHYCn4k4R4I0GHm6UDBU42flhHMzM8Is1ygGFU9G0T85fygEHwCPpM5f2+W+/m5NS2VvnTJaN2hoBrK+KJyfGxSHj0KaqpaZoeJQ3N3Jn5Ip+j3OPClWHYGYrzcYbBztIaNdIZzfOe/AC2Cw4M1WoRAXyznocGyrmBr0o7z1bYPC38VmUlBrzcZO/cmw4IRORBEiVFqQcADxoStVoqkBEnXGlwGbCZK6KufyTka6jYLU8nsVXal4HkD5eQKbmj7nFrXnijZAgTk85miDTTS0uWoCSV3ahiD4C0TGvADFeclN1BAemRNFtjkxgoxMsWGxqg9xuswONXNo5nTqH0N69eTDO/EYEKYsi36t2OD2I2xR4ZWNIQd6JBIAKufAYWJzsT5jiPf6w0VT/CE7zg79bR/ESnLzqP9NjMh/w3RZrE6c0AkiZwxCo2CGCMcodCqw5MqMgITDd4LKauHGm4qAqcXJidFjYo1j8mBpTFaOhagwqhjZf46c5aMrmj7OxDBWDJq3DEoynAqTEO1Dk3ZgjSMVx2hW0KAGqQIorecJ/POWfo4zKnG5s1YE3hkAxWkgPSYlncATWcfM+KTaasPW+FstrvfNUl/R39YkUwBr1xBBWJlShYnGINaham1oZXWA5CyeMlukKszngcgWnpYqRhLcn9ySq9iuU6aSnaPUJPH6duAmG7uehgetB6cm+JJgQBXB4HqsjQBWfHbJsZAAZsSFkD0lr4RLhkdAgpHD4ws/i9M0GcjNeoxpZ4CPzxwFxlK17R5DqSsCGOM8ppOE9Xkgu9ajuXOlpHMoCU1G+gBQzMDiekvbNTeJGR8QAPv7N7m9SdXTx9R/yDvwt2Z9RfCYMFRTRC8qW1wLo1FACDSbpcOahZAMIAaQ6E+LFjQZSFikEakawcz8l/gTB3pKVs8u7TDViDcipJHmROd7lMgBtRmn5Mg3VeaF9eJBiXqOOSZ1Khx7vjeBfOwCF/ofSfPhmjmJp2V6OmUsgbYXETIOL2XpzIkRJgKo8IQ7S7u35nHjeKY/19A+BmsP9BTZOdc+0wjnepW9ZqcBFgtSpNhh/LjFwkgmTTcGB1cZxOS4Oxy5dqNq/fUGfOoju10hZjyPJV4CWWtVVbnLD6XsNUleRhVgoxILevtqbU7rMXqhRcxkl+9Ry2wfZkjtpx9zwU/e5lQSeTnFZ40h4DBvuMMlk0wLKW0JTKRa7YS6OwHk9O4q9bAY/gOUclGEcDHQHzkyhXIO5CBOQ0PaF42IOZN8YW++K5JFeoUYtYMziPnEDqgmOqvfmVPhMlwtdKCesEsUct0Yww8lliDRnhtVShFmYcZMsqeOXSYQXxu6DJq25Daqb7LoNA7DwcLAf4+eFG27JTw+HLwn2HiaWyy80/ljea32cXtgW9NnWJxbGbPE8EOA421iy2AaopTRDZvIDTaXFiQ4c6SGjMW2WGIFpIs0TOfaiCRz1CwXFxX+OcTnepSbu6BLJWEzsRfw10KQ/LJmnJnlJ7bjrGqVVwY3gFAnYt3mRFCvQOJScrGoUtoVAdZDEzj7xE0xGnAsQBMYjqkLQTyMBjssiAKKaOIEf/TVAeQ+wSlQnrvUSrLzCK4Hlnr91dYnPd1wp/tOhGE3pDd5/CFr1n5H5QGzRwdLNC68RL2gm5rA6hM6BA6gw2wGhxQBRoHwCcUuNs6iJqYWNLSpTVWhWOJUEa8Yx1G47Js5e/AnxO+PZStedn8LEjhT4KK3PWlWKpxf1iQObjVfsWIXOgQOxqDgOSyulVz8L4xJsputb+M7hGfiLmOrI77ZxEwCBC+0Z4ZVYVR00Ahc/lSdbrG1VkCo2RcWFKDsNQPxzTQpSMiAEaolqABOyTYAdx35ZXVYivHpFmHp0GfwxViSzOK8WJzLdXw39DFX2fuF/Ds7raYkxqROrFl0tfo5y/tXpvWf/JgYpyxoCtYzEF0XEJcDIXqXVyoSd9tqDZlVd32kEsh7EKcIITDqdhq7bL7JvWvcOG7Xfg9K5bySdWNHkIGWxQqA6CTfjj1lBLhl8FUBxX2GMVuW1gq6wU5baouKM3qsdvrLnFKmJ/Zd+WqxD9h+rpgiQ2+ZmHJMWljkEaiFHijwvvFZ8AoDbUuSVs5eeFtJ/nUO5fyPFPyy4WvzSfYTWCJnqEK8B2GAa4t2hA7K59xpxkPeYjRcjBKpLmYBRFyvt6DK80qVuw5YIx+4uaB0CrXB/iWAt+2rpP6nzhu9Er8br6OOpRQApQO41XkPyMgSqS7Es6BP3YDZ2s8vgOlhuF9hTxGzgRETsB5AOZH1m3l0qLt6FiSXuS3UNuoVSrGwVkFLiIVBd1nsKPWmJ010GV8Fc1yoHotiQuWh5nzpTyCHEzPBe8m8iDl7ejVkCV/MEAGlHs1gcuZVgCFS3nEK4fT+jjrf8gdsoAHdlDrUyHRc9y/oEvnYSOnIA4DsPWjWttCo0KxvBwoaQz20Sx870VTamZTqN6kKgepQMKsxFiBIcgDAWW7hQdFKLeMxaSwdX4JM4U5cG+9CrbASnNYRSvH5+g++CqVRIIVA9co4VBra2F3uM5i44QLojIjpxxpE3ayh31Js+VK8Q70IhEoVjVaVZbfFB7Hy6u+kL6VCAEKgOjCnlvc+14jZYEP2hVBiv79CtsxduFx2HtWC3zSsvnMJnxp1f4/uCbu+NsNS63ileK/hP6z20QqFqUYaRz4lFE5M+bdLGkZgLI2oCBBvYQleKAwCo3PUpkYS9cxR7EHlS4a1YhjmvVJxWeBdq1AqlOJvre7L6TxxwggQg7YK2CEHqQhbQLFSmH0aPZhxDkH+ZCSAlW0KN6qJyOAXZcoXo6porhtCq84jPSpyFJZjZmN3FKUqh88KB3X3ilTjj6CEvcZo5bAjUKqWH84BvRMt+mWdGors7MSJ69ru+tt/ZrLK4YfQ6ccBz/apTPhs2WWhTuetqgA2L7G4zCaanElLMDTWpW46F4cIxapV1gLO1AOslbskQpL09Yl4IUrccC8ORA6FG9aEecCZyD4zm0QU+qQy5BHTvwkVNcOpdmXKEr2vMgVCj+sBwtHaciXwj/g4WLvDlkE90SLFvCNIcjoS3rjkQAtU1q0oH5CnrMooDpCM4Ixbd4anQekfqYFtKvHBOaLs7xZbwxhsHQqB641fJ0Dh94TewQ6XRPr4yA1M3rPXh+jgOSTtm/mfF0yUjhy9DDpTgQCDnppZIr6VfsQu8Z1J8DIdc2vjODM53Fn/o7BQ/UMYRLV3ysHBBcwB1KXR+c+DJj4jZi7qF/Aq+ZdzX524Ppd95COmFHAg5EHIg5EDIgZADIQdCDoQcCDkQciDkQMiBkAMhB0IOhBwIORByIORAyIGQAyEHQg6EHAg5EHIg5EDIgZADIQdCDoQcCDkQciDkQMiBkAMhB0IOhBwIORByIORAyIGQAyEHQg6EHAg5EHIg5EDIgZADIQdCDoQcCDkQciDkQMiBkAMNxIH/A5Ki8DRKFc4FAAAAAElFTkSuQmCC"/>
</defs>
</svg>
0707010000008F000081A40000000000000000000000016491641000000493000000000000000000000000000000000000002100000000mirage-4.4.0/mirage-runtime.opamopam-version: "2.0"
maintainer:   ["anil@recoil.org" "thomas@gazagnaire.org"]
authors:      ["Thomas Gazagnaire" "Anil Madhavapeddy" "Gabriel Radanne"
               "Mindy Preston" "Thomas Leonard" "Nicolas Ojeda Bar"
               "Dave Scott" "David Kaloper" "Hannes Mehnert" "Richard Mortier"]
homepage:     "https://github.com/mirage/mirage"
bug-reports:  "https://github.com/mirage/mirage/issues/"
dev-repo:     "git+https://github.com/mirage/mirage.git"
license:      "ISC"
tags:         ["org:mirage" "org:xapi-project"]
doc:          "https://mirage.github.io/mirage/"

build: [
  ["dune" "subst"] {dev}
  ["dune" "build" "-p" name "-j" jobs]
  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
]

depends: [
  "ocaml" {>= "4.08.0"}
  "dune" {>= "2.9.0"}
  "ipaddr"             {>= "5.0.0"}
  "functoria-runtime"  {= version}
  "logs"
  "lwt" {>= "4.0.0"}
  "alcotest" {with-test}
]
conflicts: [
  "result" {< "1.5"}
  "ppxlib" {= "0.29.0"} #0.29.0 provides a vendored ppx_sexp_conv
]
synopsis: "The base MirageOS runtime library, part of every MirageOS unikernel"
description: """
A bundle of useful runtime functions for applications built with MirageOS
"""
07070100000090000081A4000000000000000000000001649164100000066D000000000000000000000000000000000000001900000000mirage-4.4.0/mirage.opamopam-version: "2.0"
maintainer:   ["anil@recoil.org" "thomas@gazagnaire.org"]
authors:      ["Thomas Gazagnaire" "Anil Madhavapeddy" "Gabriel Radanne"
               "Mindy Preston" "Thomas Leonard" "Nicolas Ojeda Bar"
               "Dave Scott" "David Kaloper" "Hannes Mehnert" "Richard Mortier"]
homepage:     "https://github.com/mirage/mirage"
bug-reports:  "https://github.com/mirage/mirage/issues/"
dev-repo:     "git+https://github.com/mirage/mirage.git"
license:      "ISC"
tags:         ["org:mirage" "org:xapi-project"]
doc:          "https://mirage.github.io/mirage/"
available: opam-version >= "2.1.0"

build: [
  ["dune" "subst"] {dev}
  ["dune" "build" "-p" name "-j" jobs]
  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
]

depends: [
  "ocaml" {>= "4.08.0"}
  "dune" {>= "2.9.0"}
  "dune" {with-test & >= "3.0.0"}
  "ipaddr" {>= "5.0.0"}
  "functoria" {= version}
  "bos"
  "astring"
  "logs"
  "mirage-runtime" {= version}
  "opam-monorepo" {>= "0.3.2"}
  "alcotest" {with-test}
  "fmt" {>= "0.8.7" & with-test}
]
synopsis: "The MirageOS library operating system"
description: """
MirageOS is a library operating system that constructs unikernels for
secure, high-performance network applications across a variety of
cloud computing and mobile platforms. Code can be developed on a
normal OS such as Linux or MacOS X, and then compiled into a
fully-standalone, specialised unikernel that runs under the Xen
hypervisor.

Since Xen powers most public cloud computing infrastructure such as
Amazon EC2 or Rackspace, this lets your servers run more cheaply,
securely and with finer control than with a full software stack.
"""
07070100000091000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001500000000mirage-4.4.0/scripts07070100000092000081ED0000000000000000000000016491641000000A32000000000000000000000000000000000000001C00000000mirage-4.4.0/scripts/ec2.sh#!/usr/bin/env bash
# Build an EC2 bundle and upload/register it to Amazon.

NAME=mirage
BUCKET=mirage-deployment
REGION=us-west-2
while getopts "hn:b:r:k:" arg; do
 case $arg in
 h)
   echo "usage: $0 [-h] [-n <name>] [-b <bucket>] [-r <region>] -k <unikernel> " 
   echo ""
   echo "<unikernel>: Name of the kernel file (e.g. mir-www.xen)"
   echo "<name>: the application name to use (default: ${NAME})"
   echo "<bucket>: the S3 bucket to upload to (default: ${BUCKET})"
   echo "<region>: the EC2 region to register AMI in (default: ${REGION})"
  
   echo Remember to set each of the following environment variables in your
   echo environment before running this script:
   echo EC2_ACCESS, EC2_ACCESS_SECRET, EC2_CERT, EC2_PRIVATE_KEY
   exit 1 ;;
 n) NAME=$OPTARG ;;
 b) BUCKET=$OPTARG ;;
 r) REGION=$OPTARG ;;
 k) APP=$OPTARG ;;
 esac
done

if [ ! -e "$APP" ]; then
  echo "Must specify a unikernel file with the [-k] flag."
  echo "Run '$0 -h' for full option list."
  exit 1
fi

# Make name unique to avoid registration clashes
NAME=${NAME}-`date +%s`
MNT=/tmp/mirage-ec2
SUDO=sudo
IMG=${NAME}.img

echo Name  : ${NAME}
echo Bucket: ${BUCKET}
echo Region: ${REGION}

set -e
# KERNEL is ec2-describe-images -o amazon --region ${REGION} -F "manifest-location=*pv-grub-hd0*" -F "architecture=x86_64" | tail -1 | cut -f2
# Also obtained from http://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html
KERNEL=aki-fc8f11cc  #us-west-2

${SUDO} mkdir -p ${MNT}
rm -f ${IMG}
dd if=/dev/zero of=${IMG} bs=1M count=5
${SUDO} mke2fs -F -j ${IMG}
${SUDO} mount -o loop ${IMG} ${MNT}

${SUDO} mkdir -p ${MNT}/boot/grub
echo default 0 > menu.lst
echo timeout 1 >> menu.lst
echo title Mirage >> menu.lst
echo " root (hd0)" >> menu.lst
echo " kernel /boot/mirage-os.gz" >> menu.lst
${SUDO} mv menu.lst ${MNT}/boot/grub/menu.lst
${SUDO} sh -c "gzip -c $APP > ${MNT}/boot/mirage-os.gz"
${SUDO} umount -d ${MNT}

rm -rf ec2_tmp
mkdir ec2_tmp

echo Bundling image...
ec2-bundle-image -i ${IMG} -k ${EC2_PRIVATE_KEY} -c ${EC2_CERT} -u ${EC2_USER} -d ec2_tmp -r x86_64 --kernel ${KERNEL}
echo Uploading image...
ec2-upload-bundle -b ${BUCKET} -m ec2_tmp/${IMG}.manifest.xml -a ${EC2_ACCESS} -s ${EC2_ACCESS_SECRET} --location ${REGION}
echo Registering image...
id=`ec2-register ${BUCKET}/${IMG}.manifest.xml -n ${NAME} --region ${REGION} | awk '{print $2}'`
rm -rf ec2_tmp
rm -f ${IMG}

echo You can now start this instance via:
echo ec2-run-instances --region ${REGION} $id
echo ""
echo Don\'t forget to customise this with a security group, as the
echo default one won\'t let any inbound traffic in.
07070100000093000041ED0000000000000000000000096491641000000000000000000000000000000000000000000000001200000000mirage-4.4.0/test07070100000094000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001500000000mirage-4.4.0/test/f007070100000095000081A40000000000000000000000016491641000000041000000000000000000000000000000000000001A00000000mirage-4.4.0/test/f0/dune(library
 (name f0)
 (package functoria)
 (libraries functoria))
07070100000096000081A400000000000000000000000164916410000006F5000000000000000000000000000000000000001B00000000mirage-4.4.0/test/f0/f0.ml(* A very simple engine *)

open Functoria
module Key = Key

let warn_error =
  let doc = "Enable -warn-error when compiling OCaml sources." in
  let doc = Key.Arg.info ~docv:"BOOL" ~doc [ "warn-error" ] in
  let key = Key.Arg.(opt ~stage:`Configure bool false doc) in
  Key.create "warn_error" key

let vote =
  let doc = "Vote." in
  let doc = Key.Arg.info ~docv:"VOTE" ~doc [ "vote" ] in
  let key = Key.Arg.(opt ~stage:`Configure string "cat" doc) in
  Key.create "vote" key

let file_of_key k = Fpath.v Key.(name @@ v k)

let write_key i k f =
  let context = Info.context i in
  let file = file_of_key k in
  let contents = f (Key.get context k) in
  Action.write_file file contents

module C = struct
  open Action.Syntax

let prelude _ = ""
  let name = "test"
  let version = "1.0~test"
  let packages = [ package "functoria"; package "f0" ]
  let keys = Key.[ v vote; v warn_error ]
  let connect _ _ _ = "()"

let dune i =
    let dune =
      Dune.stanzaf
        {|
(executable
  (public_name f0)
  (package   functoria)
  (name      %s)
  (modules   (:standard \ config))
  (promote   (until-clean))
  (libraries cmdliner fmt functoria-runtime))
|}
        Fpath.(basename @@ rem_ext @@ Info.main i)
    in
    [ dune ]

let configure i =
    let* () = write_key i vote (fun x -> x) in
    write_key i warn_error string_of_bool

let create jobs =
    let packages = [ package "fmt" ] in
    let extra_deps = List.map dep jobs in
    impl ~keys ~packages ~connect ~dune ~configure ~extra_deps
      ~install:(fun _ -> Install.v ~bin:[ Fpath.(v "f0.exe", v "f0") ] ())
      "F0" job

let name_of_target i = Info.name i
  let dune_project = []
  let dune_workspace = None
  let context_name _ = "default"
end

include Lib.Make (C)
module Tool = Tool.Make (C)
07070100000097000081A40000000000000000000000016491641000000156000000000000000000000000000000000000001C00000000mirage-4.4.0/test/f0/f0.mliopen Functoria.DSL

val register :
  ?packages:package list ->
  ?keys:abstract_key list ->
  ?init:job impl list ->
  ?src:[ `Auto | `None | `Some of string ] ->
  string ->
  job impl list ->
  unit

module Tool : sig
  val run_with_argv :
    ?help_ppf:Format.formatter ->
    ?err_ppf:Format.formatter ->
    string array ->
    unit
end
07070100000098000041ED00000000000000000000000B6491641000000000000000000000000000000000000000000000001C00000000mirage-4.4.0/test/functoria07070100000099000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002400000000mirage-4.4.0/test/functoria-runtime0707010000009A000081A4000000000000000000000001649164100000000F000000000000000000000000000000000000003100000000mirage-4.4.0/test/functoria-runtime/.ocamlformatdisable = true
0707010000009B000081A400000000000000000000000164916410000000CE000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria-runtime/app.mlmodule type K = sig
  val runtime_keys : (unit Cmdliner.Term.t * string) list
end

module type I = sig
  val info : Functoria_runtime.info
end

module Make (K : K) (I : I) = struct
  let start _ _ = ()
end
0707010000009C000081A40000000000000000000000016491641000000050000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria-runtime/dune(test
 (name main)
 (package functoria-runtime)
 (libraries functoria-runtime))
0707010000009D0000A1FF00000000000000000000000164EB1A6500000027000000000000000000000000000000000000003000000000mirage-4.4.0/test/functoria-runtime/info_gen.ml../functoria/gen-1/info_gen.ml.expected0707010000009E0000A1FF00000000000000000000000164EB1A6500000026000000000000000000000000000000000000002F00000000mirage-4.4.0/test/functoria-runtime/key_gen.ml../functoria/gen-1/key_gen.ml.expected0707010000009F0000A1FF00000000000000000000000164EB1A6500000023000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria-runtime/main.ml../functoria/gen-1/main.ml.expected070701000000A0000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002100000000mirage-4.4.0/test/functoria-test070701000000A1000081A40000000000000000000000016491641000000056000000000000000000000000000000000000002600000000mirage-4.4.0/test/functoria-test/dune(library
 (name functoria_test)
 (public_name functoria.test)
 (libraries functoria))
070701000000A2000081A400000000000000000000000164916410000002A0000000000000000000000000000000000000003300000000mirage-4.4.0/test/functoria-test/functoria_test.mlopen Functoria
open Action.Syntax

let prelude i =
  Action.with_output ~path:(Info.main i) ~purpose:"init tests" @@ fun ppf ->
  Fmt.pf ppf
    {|(* Geneated by functoria_test *)

let (>>=) x f = f x
let return x = x
let run x = x

let run ?(keys = []) ?init context device =
  let t = Impl.abstract device in
  let keys = keys @ Key.Set.elements (Engine.all_keys t) in
  let packages = Key.eval context (Engine.packages t) in
  let info =
    Functoria.Info.v ~packages ~context ~keys ~build_cmd:"build me" ~src:`None
      "foo"
  in
  let t = Impl.eval ~context t in
  let* () = prelude info in
  let* () = Engine.configure info t in
  Engine.connect ?init info t
070701000000A3000081A4000000000000000000000001649164100000008C000000000000000000000000000000000000003400000000mirage-4.4.0/test/functoria-test/functoria_test.mliopen Functoria
open Functoria.DSL

val run :
  ?keys:Key.Set.elt list ->
  ?init:job impl list ->
  context ->
  'a impl ->
  unit Action.t
070701000000A4000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002400000000mirage-4.4.0/test/functoria/context070701000000A5000081A400000000000000000000000164916410000002A3000000000000000000000000000000000000002E00000000mirage-4.4.0/test/functoria/context/config.mlopen F0
open Functoria

let x = Impl.v ~packages:[ package "x" ] "X" job
let y = Impl.v ~packages:[ package "y" ] "Y" job

let target_conv : _ Cmdliner.Arg.conv =
  let parser, printer = Cmdliner.Arg.enum [ ("y", `Y); ("x", `X) ] in
  (parser, printer)

let target_serialize ppf = function
  | `Y -> Fmt.pf ppf "`Y"
  | `X -> Fmt.pf ppf "`X"

let target =
  let conv' =
    Key.Arg.conv ~conv:target_conv ~runtime_conv:"target"
      ~serialize:target_serialize
  in
  let doc = Key.Arg.info ~doc:"Target." [ "t" ] in
  Key.(create "target" Arg.(opt conv' `X doc))

let main = match_impl (Key.value target) ~default:y [ (`X, x) ]
let () = register ~src:`None "noop" [ main ]
070701000000A6000081A4000000000000000000000001649164100000007C000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/context/dune(executable
 (name config)
 (libraries f0))

(cram
 (package functoria)
 (deps ./config.exe x.context y.context z.context))
070701000000A7000081A400000000000000000000000164916410000006F5000000000000000000000000000000000000002A00000000mirage-4.4.0/test/functoria/context/run.tQuery package - no target - x.context
  $ ./config.exe query package --context-file=x.context
  "fmt" { ?monorepo }
  "functoria-runtime" { ?monorepo }
  "x" { ?monorepo }

Query package - no target - y.context
  $ ./config.exe query package --context-file=y.context
  "fmt" { ?monorepo }
  "functoria-runtime" { ?monorepo }
  "y" { ?monorepo }

Query package - x target  - y.context
  $ ./config.exe query package -t x --context-file=y.context
  "fmt" { ?monorepo }
  "functoria-runtime" { ?monorepo }
  "x" { ?monorepo }

Query package - y target  - x.context
  $ ./config.exe query package -t y --context-file=x.context
  "fmt" { ?monorepo }
  "functoria-runtime" { ?monorepo }
  "y" { ?monorepo }

Describe - no target - x.context
  $ ./config.exe describe --context-file=x.context
  Name       noop
  Keys       target=x,
             vote=cat (default),
             warn_error=false (default)

Describe - no target - y.context
  $ ./config.exe describe --context-file=y.context
  Name       noop
  Keys       target=y,
             vote=cat (default),
             warn_error=false (default)

Describe - x target  - y.context
  $ ./config.exe describe -t x --context-file=y.context
  Name       noop
  Keys       target=x,
             vote=cat (default),
             warn_error=false (default)

Describe - y target  - x.context
  $ ./config.exe describe -t y --context-file=x.context
  Name       noop
  Keys       target=y,
             vote=cat (default),
             warn_error=false (default)

Bad context cache
  $ ./config.exe configure -t nonexistent --context-file=z.context
  test: option '-t': invalid value 'nonexistent', expected either 'y' or 'x'
  Usage: test configure [OPTION]…
  Try 'test configure --help' or 'test --help' for more information.
  [1]
070701000000A8000081A40000000000000000000000016491641000000005000000000000000000000000000000000000002E00000000mirage-4.4.0/test/functoria/context/x.context-t
x
070701000000A9000081A40000000000000000000000016491641000000005000000000000000000000000000000000000002E00000000mirage-4.4.0/test/functoria/context/y.context-t
y
070701000000AA000081A4000000000000000000000001649164100000000F000000000000000000000000000000000000002E00000000mirage-4.4.0/test/functoria/context/z.context-t
nonexistent
070701000000AB000081A4000000000000000000000001649164100000005B000000000000000000000000000000000000002100000000mirage-4.4.0/test/functoria/dune(test
 (name test)
 (package functoria)
 (libraries f0 alcotest cmdliner rresult astring))
070701000000AC000041ED0000000000000000000000046491641000000000000000000000000000000000000000000000002000000000mirage-4.4.0/test/functoria/e2e070701000000AD000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002400000000mirage-4.4.0/test/functoria/e2e/app070701000000AE000081A40000000000000000000000016491641000000088000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/e2e/app/app.mlmodule Make (_ : sig end) = struct
  let start () =
    Fmt.pr "Success: vote=%s hello=%s\n%!" Key_gen.(vote ()) Key_gen.(hello ())
end
070701000000AF000081A40000000000000000000000016491641000000107000000000000000000000000000000000000002E00000000mirage-4.4.0/test/functoria/e2e/app/config.mlopen Functoria
open E2e

let main = main "App.Make" (job @-> job)

let key =
  let doc = Key.Arg.info ~doc:"How to say hello." [ "hello" ] in
  Key.(create "hello" Arg.(opt string "Hello World!" doc))

let () = register ~keys:[ Key.v key ] "noop" [ main $ noop ]
070701000000B0000081A40000000000000000000000016491641000000949000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/e2e/build.tBuild an application.

$ ./test.exe configure --file app/config.ml
  $ ./test.exe build -v --file app/config.ml
  test.exe: [INFO] run: build:
                        { "context" = ;
                          "config_file" = app/config.ml;
                          "output" = None;
                          "dry_run" = false }
  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
  test.exe: [INFO] Generating: dune-project (base)
  test.exe: [INFO] Generating: app/dune.config (base)
  config.exe: [INFO] reading cache app/test/context
  config.exe: [INFO] Name       noop
                     Keys      
                       hello=Hello World! (default),
                       vote=cat (default),
                       warn_error=false (default)
  config.exe: [INFO] dune build --root .
  $ ls -a app/
  .
  ..
  app.ml
  config.ml
  dist
  dune
  dune.build
  dune.config
  main.exe
  test
  $ ls -a app/test
  .
  ..
  context
  dune-workspace.config
  key_gen.ml
  main.ml
  noop.opam
  vote
  warn_error
  $ ./app/main.exe
  Success: vote=cat hello=Hello World!
  $ ./test.exe clean --file app/config.ml
  $ ls -a app/
  .
  ..
  app.ml
  config.ml

Test `--output`:

$ ./test.exe configure --file app/config.ml -o toto
  $ ./test.exe build -v --file app/config.ml
  test.exe: [INFO] run: build:
                        { "context" = ;
                          "config_file" = app/config.ml;
                          "output" = None;
                          "dry_run" = false }
  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
  test.exe: [INFO] Generating: dune-project (base)
  test.exe: [INFO] Generating: app/dune.config (base)
  config.exe: [INFO] reading cache app/test/context
  config.exe: [INFO] Name       noop
                     Keys      
                       hello=Hello World! (default),
                       vote=cat (default),
                       warn_error=false (default)Output     toto
  config.exe: [INFO] dune build --root .
  $ ls -a app/
  .
  ..
  app.ml
  config.ml
  dist
  dune
  dune.build
  dune.config
  test
  toto.exe
  $ ls -a app/test
  .
  ..
  context
  dune-workspace.config
  key_gen.ml
  noop.opam
  toto.ml
  vote
  warn_error
  $ ./app/toto.exe
  Success: vote=cat hello=Hello World!
  $ ./test.exe clean --file app/config.ml
  $ ls -a app/
  .
  ..
  app.ml
  config.ml
070701000000B1000081A400000000000000000000000164916410000000F7000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/e2e/cache.tTest that the cache is escaping entries correctly:

$ ./test.exe configure --file app/config.ml --vote="foo;;bar;;;\n\nllll;;;sdaads;;\n\t\0"
  $ ./test.exe build --file app/config.ml
  $ cat app/test/vote
  foo;;bar;;;\n\nllll;;;sdaads;;\n\t\0
070701000000B2000081A40000000000000000000000016491641000000960000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/e2e/clean.tMake sure that clean remove everything:

$ ./test.exe configure --file app/config.ml
  $ ls -a app
  .
  ..
  app.ml
  config.ml
  dist
  dune
  dune.build
  dune.config
  test
  $ ls -a app/test
  .
  ..
  context
  dune-workspace.config
  key_gen.ml
  main.ml
  noop.opam
  vote
  warn_error
  $ ./test.exe clean -v --file app/config.ml
  test.exe: [INFO] run: clean:
                        { "context" = ;
                          "config_file" = app/config.ml;
                          "output" = None;
                          "dry_run" = false }
  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
  test.exe: [INFO] Generating: dune-project (base)
  test.exe: [INFO] Generating: app/dune.config (base)
  config.exe: [INFO] reading cache app/test/context
  config.exe: [INFO] Name       noop
                     Keys      
                       hello=Hello World! (default),
                       vote=cat (default),
                       warn_error=false (default)
  test.exe: [INFO] Skipped ./app
  test.exe: [INFO] Skipped ./help.exe
  test.exe: [INFO] Skipped ./lib
  test.exe: [INFO] Skipped ./test.exe
  $ ls -a app
  .
  ..
  app.ml
  config.ml

Check that clean works with `--output`:

$ ./test.exe configure --file app/config.ml --output=toto
  $ ls -a app
  .
  ..
  app.ml
  config.ml
  dist
  dune
  dune.build
  dune.config
  test
  $ ls -a app/test
  .
  ..
  context
  dune-workspace.config
  key_gen.ml
  noop.opam
  toto.ml
  vote
  warn_error
  $ ./test.exe clean -v --file app/config.ml
  test.exe: [INFO] run: clean:
                        { "context" = ;
                          "config_file" = app/config.ml;
                          "output" = None;
                          "dry_run" = false }
  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
  test.exe: [INFO] Generating: dune-project (base)
  test.exe: [INFO] Generating: app/dune.config (base)
  config.exe: [INFO] reading cache app/test/context
  config.exe: [INFO] Name       noop
                     Keys      
                       hello=Hello World! (default),
                       vote=cat (default),
                       warn_error=false (default)Output     toto
  test.exe: [INFO] Skipped ./app
  test.exe: [INFO] Skipped ./help.exe
  test.exe: [INFO] Skipped ./lib
  test.exe: [INFO] Skipped ./test.exe
  $ ls -a app
  .
  ..
  app.ml
  config.ml
070701000000B3000081A40000000000000000000000016491641000000A8D000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/e2e/configure.tCheck that configure generates the file in the right dir when `--file`
is passed:

$ ./test.exe configure -v --file app/config.ml
  test.exe: [INFO] run: configure:
                        { "args" =
                           { "context" = ;
                             "config_file" = app/config.ml;
                             "output" = None;
                             "dry_run" = false };
                          "depext" = true }
  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
  test.exe: [INFO] Generating: dune-project (base)
  test.exe: [INFO] Generating: app/dune.config (base)
  test.exe: [INFO] Preserving arguments in app/test/context:
                   [|"./test.exe"; "configure"; "-v"; "--file";
                     "app/config.ml"|]
  test.exe: [INFO] Set-up config skeleton.
  config.exe: [INFO] reading cache app/test/context
  config.exe: [INFO] Name       noop
                     Keys      
                       hello=Hello World! (default),
                       vote=cat (default),
                       warn_error=false (default)
  config.exe: [INFO] Generating: noop.opam (opam)
  config.exe: [INFO] in dir { "context" = ;
                              "config_file" = app/config.ml;
                              "output" = None;
                              "dry_run" = false }
  config.exe: [INFO] Generating: main.ml (main file)
  config.exe: [INFO] Generating: key_gen.ml (keys)
  config.exe: [INFO] Generating: dune.build (dune.build)
  config.exe: [INFO] Generating: dune-workspace (dune-workspace)
  config.exe: [INFO] Generating: dune-project (dune-project)
  config.exe: [INFO] Generating: dune (dune.dist)
  $ ls -a app/
  .
  ..
  app.ml
  config.ml
  dist
  dune
  dune.build
  dune.config
  test
  $ ls -a app/test
  .
  ..
  context
  dune-workspace.config
  key_gen.ml
  main.ml
  noop.opam
  vote
  warn_error
  $ ./test.exe clean --file app/config.ml

Check that configure create the correctcontext file:

$ ./test.exe configure --file=app/config.ml
  $ cat app/test/context
  configure
  --file=app/config.ml
  $ rm -rf custom_build_

$ ./test.exe configure --file=app/config.ml
  $ cat app/test/context
  configure
  --file=app/config.ml
  $ ./test.exe clean --file=app/config.ml

Check that `test help configure` and `test configure --help` have the
same output.

$ ./test.exe help configure --file=app/config.ml --help=plain > h1
  $ ./test.exe configure --help=plain --file=app/config.ml > h2
  $ ./help.exe diff h1 h2

Check that `test help configure` works when no config.ml file is present.

$ ./test.exe configure --help=plain > h0
  $ ./help.exe show h0 SYNOPSIS | xargs
  test configure [OPTION]…
070701000000B4000081A40000000000000000000000016491641000000411000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/e2e/describe.tTest that `describe` works as expected:

$ ./test.exe describe --file app/config.ml
  Name       noop
  Keys      
    hello=Hello World! (default),
    vote=cat (default),
    warn_error=false (default)
  $ ./test.exe describe -v --file app/config.ml
  test.exe: [INFO] run: describe:
                        { "args" =
                           { "context" = ;
                             "config_file" = app/config.ml;
                             "output" = None;
                             "dry_run" = false };
                          "dotcmd" = "xdot";
                          "dot" = false;
                          "eval" = None }
  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
  test.exe: [INFO] Generating: dune-project (base)
  test.exe: [INFO] Generating: app/dune.config (base)
  Name       noop
  Keys      
    hello=Hello World! (default),
    vote=cat (default),
    warn_error=false (default)Libraries  fmt, functoria-runtime
  Packages   fmt { ?monorepo }, functoria-runtime { ?monorepo }
070701000000B5000081A40000000000000000000000016491641000000164000000000000000000000000000000000000002500000000mirage-4.4.0/test/functoria/e2e/dune(executable
 (name test)
 (modules test)
 (libraries e2e alcotest cmdliner rresult astring))

(executable
 (name help)
 (modules help)
 (libraries astring fmt))

(cram
 (deps
  test.exe
  help.exe
  (source_tree app)
  (source_tree lib)
  (package functoria)
  (package functoria-runtime))
 (enabled_if
  (<> %{architecture} "i386"))
 (package functoria))
070701000000B6000081A40000000000000000000000016491641000000AA4000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/e2e/help.ml(*
 * Copyright (c) 2015 Jeremy Yallop
 * Copyright (c) 2021 Thomas Gazagnaire <thomas@gazagnaire.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Astring

(* cut a man page into sections *)
let by_sections s =
  let lines = String.cuts ~sep:"\n" s in
  let return l =
    match List.rev l with [] -> assert false | h :: t -> (h, t)
  in
  let rec aux current sections = function
    | [] -> List.rev (return current :: sections)
    | h :: t ->
        if
          String.length h > 1
          && String.for_all (fun x -> Char.Ascii.(is_upper x || is_white x)) h
        then aux [ h ] (return current :: sections) t
        else aux (h :: current) sections t
  in
  aux [ "INIT" ] [] lines

let sections = [ "CONFIGURE OPTIONS"; "APPLICATION OPTIONS"; "COMMON OPTIONS" ]

let read file =
  let ic = open_in_bin file in
  let str = really_input_string ic (in_channel_length ic) in
  close_in ic;
  by_sections str

let err_usage () =
  Fmt.pr "[usage]: ./help.exe [diff|show] PARAMS\n";
  exit 1

let () =
  if Array.length Sys.argv <> 4 then err_usage ()
  else
    match Sys.argv.(1) with
    | "diff" ->
        let s1 = read Sys.argv.(2) in
        let s2 = read Sys.argv.(3) in
        List.iter
          (fun name ->
            match (List.assoc_opt name s1, List.assoc_opt name s2) with
            | Some s1, Some s2 ->
                if List.length s1 <> List.length s2 then
                  Fmt.failwith "Number of lines in %S differs" name
                else
                  List.iter2
                    (fun s1 s2 ->
                      if s1 <> s2 then
                        Fmt.failwith "Lines in section %S differ:\n  %S\n  %S\n"
                          name s1 s2)
                    s1 s2
            | _ -> Fmt.failwith "Section %S differs" name)
          sections
    | "show" -> (
        let s1 = read Sys.argv.(2) in
        let name = Sys.argv.(3) in
        match List.assoc_opt name s1 with
        | None -> ()
        | Some s -> List.iter print_endline s)
    | _ -> err_usage ()
070701000000B7000081A400000000000000000000000164916410000016D3000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/e2e/help.tTest that the help command works without config file:

$ ./test.exe help -v --help=plain
  test.exe: [INFO] run: help:
                        { "context" = ;
                          "config_file" = config.ml;
                          "output" = None;
                          "dry_run" = false }
  NAME
         test-help - Display help about test commands.
  
  SYNOPSIS
         test help [--man-format=FMT] [OPTION]… [TOPIC]
  
  DESCRIPTION
         Prints help.
  
         Use `test help topics' to get the full list of help topics.
  
  DESCRIBE OPTIONS
         --eval
             Fully evaluate the graph before showing it. The default when the
             unikernel has already been configured.
  
         --no-eval
             Do not evaluate the graph before showing it. See --eval. The
             default when the unikernel has not been configured.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  ARGUMENTS
         TOPIC
             The topic to get help on.
  
  OPTIONS
         --man-format=FMT (absent=pager)
             Show output in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test help exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of help:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

As well as the default command:

$ ./test.exe -v
  NAME
         test - The test application builder
  
  SYNOPSIS
         test [COMMAND] …
  
  DESCRIPTION
         The test application builder. It glues together a set of libraries and
         configuration (e.g. network and storage) into a standalone unikernel
         or UNIX binary.
  
         Use test help <command> for more information on a specific command.
  
  COMMANDS
         build [OPTION]…
             Build a test application.
  
         clean [OPTION]…
             Clean the files produced by test for a given application.
  
         configure [OPTION]…
             Configure a test application.
  
         describe [OPTION]…
             Describe a test application.
  
         help [--man-format=FMT] [OPTION]… [TOPIC]
             Display help about test commands.
  
         query [OPTION]… [INFO]
             Query information about the test application.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
070701000000B8000081A4000000000000000000000001649164100000014D000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/e2e/keys.tTest keys.

$ ./test.exe configure --file app/config.ml
  $ ./test.exe build --file app/config.ml
  $ cat app/test/vote
  cat
  $ ./test.exe clean --file app/config.ml

Change the key at configure time:

$ ./test.exe configure --file app/config.ml --vote=dog
  $ ./test.exe build --file app/config.ml
  $ cat app/test/vote
  dog
070701000000B9000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002400000000mirage-4.4.0/test/functoria/e2e/lib070701000000BA000081A4000000000000000000000001649164100000002D000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/e2e/lib/dune(library
 (name e2e)
 (libraries functoria))
070701000000BB000081A40000000000000000000000016491641000000705000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/e2e/lib/e2e.mlopen Functoria
module Key = Key

let vote =
  let doc = "Vote." in
  let doc = Key.Arg.info ~docv:"VOTE" ~doc [ "vote" ] in
  let key = Key.Arg.(opt ~stage:`Configure string "cat" doc) in
  Key.create "vote" key

let file_of_key k = Fpath.v Key.(name @@ v k)

let write_key i k f =
  let context = Info.context i in
  let file = file_of_key k in
  let contents = f (Key.get context k) in
  Action.write_file file contents

module C = struct
  open Action.Syntax

let prelude _ = "let (>>=) x f = f x\nlet return x = x\nlet run x = x"
  let name = "test"
  let version = "1.0~test"
  let packages = [ package "functoria"; package "e2e" ]
  let keys = Key.[ v vote; v warn_error ]
  let connect _ _ _ = "()"
  let main i = Fpath.(basename @@ rem_ext @@ Info.main i)

let dune i =
    let dune =
      Dune.stanzaf
        {|
(executable
  (name      %s)
  (modules   (:standard \ config))
  (promote   (until-clean))
  (libraries cmdliner fmt functoria-runtime))
|}
        (main i)
    in
    [ dune ]

let configure i =
    let* () = write_key i vote (fun x -> x) in
    write_key i warn_error string_of_bool

let create jobs =
    let packages = [ package "fmt" ] in
    let extra_deps = List.map dep jobs in
    let install i = Install.v ~bin:[ Fpath.(v (main i) + "exe", v "e2e") ] () in
    impl ~keys ~packages ~connect ~dune ~configure ~extra_deps ~install "E2e"
      job

let name_of_target i = Info.name i
  let dune_project = []
  let dune_workspace = None
  let context_name _ = "default"
end

include Lib.Make (C)
include Tool.Make (C)
070701000000BC000081A400000000000000000000000164916410000000E1000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/e2e/lib/e2e.mliopen Functoria.DSL

val register :
  ?packages:package list ->
  ?keys:abstract_key list ->
  ?init:job impl list ->
  ?src:[ `Auto | `None | `Some of string ] ->
  string ->
  job impl list ->
  unit

val run : unit -> unit
070701000000BD000081A40000000000000000000000016491641000000359000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/e2e/test.ml(*
 * Copyright (c) 2015 Jeremy Yallop
 * Copyright (c) 2021 Thomas Gazagnaire <thomas@gazagnaire.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let () = E2e.run ()
070701000000BE000081A4000000000000000000000001649164100000000C000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/e2e/test.mli(* empty *)
070701000000BF000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002300000000mirage-4.4.0/test/functoria/errors070701000000C0000081A4000000000000000000000001649164100000005A000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/errors/dune(executable
 (name test)
 (libraries f0))

(cram
 (package functoria)
 (deps ./test.exe))
070701000000C1000081A400000000000000000000000164916410000009A6000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/errors/run.tConfigure failure
  $ ./test.exe configure --vote=dog
  configuration file config.ml missing
  [1]

Build failure
  $ ./test.exe build --vote=dog
  configuration file config.ml missing
  [1]

Query failure
  $ ./test.exe query --vote=dog
  configuration file config.ml missing
  [1]

Describe failure
  $ ./test.exe describe --vote=dog
  configuration file config.ml missing
  [1]

Clean does not fail
  $ ./test.exe clean --vote=dog

Help does not fail
  $ ./test.exe help --man-format=plain
  NAME
         test - The test application builder
  
  SYNOPSIS
         test [COMMAND] …
  
  DESCRIPTION
         The test application builder. It glues together a set of libraries and
         configuration (e.g. network and storage) into a standalone unikernel
         or UNIX binary.
  
         Use test help <command> for more information on a specific command.
  
  COMMANDS
         build [OPTION]…
             Build a test application.
  
         clean [OPTION]…
             Clean the files produced by test for a given application.
  
         configure [OPTION]…
             Configure a test application.
  
         describe [OPTION]…
             Describe a test application.
  
         help [--man-format=FMT] [OPTION]… [TOPIC]
             Display help about test commands.
  
         query [OPTION]… [INFO]
             Query information about the test application.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
070701000000C2000081A40000000000000000000000016491641000000028000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/errors/test.mllet () = F0.Tool.run_with_argv Sys.argv
070701000000C3000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002200000000mirage-4.4.0/test/functoria/gen-1070701000000C4000081A400000000000000000000000164916410000001BF000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/gen-1/dune(executable
 (name test)
 (modules test)
 (libraries functoria_test fmt functoria))

(rule
 (targets key_gen.ml info_gen.ml main.ml)
 (action
  (run ./test.exe)))

(rule
 (alias runtest)
 (package functoria)
 (action
  (diff key_gen.ml.expected key_gen.ml)))

(rule
 (alias runtest)
 (package functoria)
 (action
  (diff info_gen.ml.expected info_gen.ml)))

(rule
 (alias runtest)
 (package functoria)
 (action
  (diff main.ml.expected main.ml)))
070701000000C5000081A400000000000000000000000164916410000001AA000000000000000000000000000000000000003700000000mirage-4.4.0/test/functoria/gen-1/info_gen.ml.expectedlet libraries = [
  "base-bigarray", "base";
  "base-threads", "base";
  "base-unix", "base";
  "cmdliner", "1.0.4";
  "conf-m4", "1";
  "dune", "2.0.0";
  "fmt", "0.8.8";
  "ocaml", "4.08.1";
  "ocaml-base-compiler", "4.08.1";
  "ocaml-config", "1";
  "ocamlbuild", "0.14.0";
  "ocamlfind", "1.8.1";
  "seq", "base";
  "stdlib-shims", "0.1.0";
  "topkg", "1.0.1"]

let info = Functoria_runtime.{
  name = "foo";
  libraries
}070701000000C6000081A40000000000000000000000016491641000000027000000000000000000000000000000000000003600000000mirage-4.4.0/test/functoria/gen-1/key_gen.ml.expected
let runtime_keys = List.combine [] []
070701000000C7000081A400000000000000000000000164916410000002D0000000000000000000000000000000000000003300000000mirage-4.4.0/test/functoria/gen-1/main.ml.expected(* Geneated by functoria_test *)

let (>>=) x f = f x
let return x = x
let run x = x

module App_make__4 = App.Make(Key_gen)(Info_gen)

let sys__1 = lazy (
  return Sys.argv
  )

let key_gen__2 = lazy (
  let __sys__1 = Lazy.force sys__1 in
  __sys__1 >>= fun _sys__1 ->
  return (Functoria_runtime.with_argv (List.map fst Key_gen.runtime_keys) "foo" _sys__1)
  )

let info_gen__3 = lazy (
  return Info_gen.info
  )

let app_make__4 = lazy (
  let __key_gen__2 = Lazy.force key_gen__2 in
  let __info_gen__3 = Lazy.force info_gen__3 in
  __key_gen__2 >>= fun _key_gen__2 ->
  __info_gen__3 >>= fun _info_gen__3 ->
  App_make__4.start _key_gen__2 _info_gen__3
  )

let () =
  let t =
  Lazy.force app_make__4
  in run t
070701000000C8000081A400000000000000000000000164916410000002DF000000000000000000000000000000000000002A00000000mirage-4.4.0/test/functoria/gen-1/test.mlopen Functoria

let build_info =
  [
    ("base-bigarray", "base");
    ("base-threads", "base");
    ("base-unix", "base");
    ("cmdliner", "1.0.4");
    ("conf-m4", "1");
    ("dune", "2.0.0");
    ("fmt", "0.8.8");
    ("ocaml", "4.08.1");
    ("ocaml-base-compiler", "4.08.1");
    ("ocaml-config", "1");
    ("ocamlbuild", "0.14.0");
    ("ocamlfind", "1.8.1");
    ("seq", "base");
    ("stdlib-shims", "0.1.0");
    ("topkg", "1.0.1");
  ]

let test () =
  let context = Key.empty_context in
  let sigs = job @-> info @-> job in
  let job = main "App.Make" sigs $ keys sys_argv $ app_info ~build_info () in
  Functoria_test.run context job

let () =
  match Action.run (test ()) with Ok () -> () | Error (`Msg e) -> failwith e
070701000000C9000081A4000000000000000000000001649164100000000C000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/gen-1/test.mli(* empty *)
070701000000CA000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002200000000mirage-4.4.0/test/functoria/gen-2070701000000CB000081A400000000000000000000000164916410000001BF000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/gen-2/dune(executable
 (name test)
 (modules test)
 (libraries functoria_test fmt functoria))

(rule
 (targets key_gen.ml info_gen.ml main.ml)
 (action
  (run ./test.exe)))

(rule
 (alias runtest)
 (package functoria)
 (action
  (diff key_gen.ml.expected key_gen.ml)))

(rule
 (alias runtest)
 (package functoria)
 (action
  (diff info_gen.ml.expected info_gen.ml)))

(rule
 (alias runtest)
 (package functoria)
 (action
  (diff main.ml.expected main.ml)))
070701000000CC000081A400000000000000000000000164916410000001AA000000000000000000000000000000000000003700000000mirage-4.4.0/test/functoria/gen-2/info_gen.ml.expectedlet libraries = [
  "base-bigarray", "base";
  "base-threads", "base";
  "base-unix", "base";
  "cmdliner", "1.0.4";
  "conf-m4", "1";
  "dune", "2.0.0";
  "fmt", "0.8.8";
  "ocaml", "4.08.1";
  "ocaml-base-compiler", "4.08.1";
  "ocaml-config", "1";
  "ocamlbuild", "0.14.0";
  "ocamlfind", "1.8.1";
  "seq", "base";
  "stdlib-shims", "0.1.0";
  "topkg", "1.0.1"]

let info = Functoria_runtime.{
  name = "foo";
  libraries
}070701000000CD000081A4000000000000000000000001649164100000017A000000000000000000000000000000000000003600000000mirage-4.4.0/test/functoria/gen-2/key_gen.ml.expectedlet hello = Functoria_runtime.Key.create
  (Functoria_runtime.Arg.opt Cmdliner.Arg.string "Hello World!" (Cmdliner.Arg.info
   ~docs:"APPLICATION OPTIONS" ?docv:(None) ?doc:(Some "How to say hello.  ")
   ?env:(None) ["hello"]))

let hello_t = Functoria_runtime.Key.term hello

let hello () = Functoria_runtime.Key.get hello

let runtime_keys = List.combine [hello_t] ["hello"]
070701000000CE000081A40000000000000000000000016491641000000398000000000000000000000000000000000000003300000000mirage-4.4.0/test/functoria/gen-2/main.ml.expected(* Geneated by functoria_test *)

let (>>=) x f = f x
let return x = x
let run x = x

module App_make__5 = App.Make(Key_gen)(Unit)(Info_gen)

let sys__1 = lazy (
  return Sys.argv
  )

let key_gen__2 = lazy (
  let __sys__1 = Lazy.force sys__1 in
  __sys__1 >>= fun _sys__1 ->
  return (Functoria_runtime.with_argv (List.map fst Key_gen.runtime_keys) "foo" _sys__1)
  )

let unit__3 = lazy (
  return ()
  )

let info_gen__4 = lazy (
  return Info_gen.info
  )

let app_make__5 = lazy (
  let __key_gen__2 = Lazy.force key_gen__2 in
  let __unit__3 = Lazy.force unit__3 in
  let __info_gen__4 = Lazy.force info_gen__4 in
  __key_gen__2 >>= fun _key_gen__2 ->
  __unit__3 >>= fun _unit__3 ->
  __info_gen__4 >>= fun _info_gen__4 ->
  App_make__5.start _key_gen__2 _unit__3 _info_gen__4
  )

let () =
  let t =
  Lazy.force key_gen__2 >>= fun _ ->
    Lazy.force unit__3 >>= fun _ ->
    Lazy.force app_make__5
  in run t
070701000000CF000081A400000000000000000000000164916410000003C2000000000000000000000000000000000000002A00000000mirage-4.4.0/test/functoria/gen-2/test.mlopen Functoria

let key =
  let doc = Key.Arg.info ~doc:"How to say hello." [ "hello" ] in
  Key.(create "hello" Arg.(opt string "Hello World!" doc))

let test () =
  let i1 = keys sys_argv in
  let i2 = noop in
  let context = Key.empty_context in
  let sigs = job @-> job @-> info @-> job in
  let job =
    main ~keys:[ Key.v key ] "App.Make" sigs $ i1 $ i2 $ app_info ~build_info ()
  in
  Functoria_test.run ~init:[ i1; i2 ] context job

let () =
  match Action.run (test ()) with Ok () -> () | Error (`Msg e) -> failwith e
070701000000D0000081A4000000000000000000000001649164100000000C000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/gen-2/test.mli(* empty *)
070701000000D1000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002100000000mirage-4.4.0/test/functoria/help070701000000D2000081A40000000000000000000000016491641000000FA0000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/help/build.tHelp build --man-format=plain
  $ ./config.exe help build --man-format=plain | tee d1
  NAME
         test-build - Build a test application.
  
  SYNOPSIS
         test build [OPTION]…
  
  DESCRIPTION
         Build a test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test build exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)

Help build --help=plain
  $ ./config.exe build --help=plain | tee d2
  NAME
         test-build - Build a test application.
  
  SYNOPSIS
         test build [OPTION]…
  
  DESCRIPTION
         Build a test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test build exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)

No difference
  $ diff d1 d2
070701000000D3000081A40000000000000000000000016491641000001020000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/help/clean.tHelp clean --man-format=plain
  $ ./config.exe help clean --man-format=plain | tee d1
  NAME
         test-clean - Clean the files produced by test for a given application.
  
  SYNOPSIS
         test clean [OPTION]…
  
  DESCRIPTION
         Clean the files produced by test for a given application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test clean exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)

Help clean --help=plain
  $ ./config.exe clean --help=plain | tee d2
  NAME
         test-clean - Clean the files produced by test for a given application.
  
  SYNOPSIS
         test clean [OPTION]…
  
  DESCRIPTION
         Clean the files produced by test for a given application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test clean exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)

No difference
  $ diff d1 d2
070701000000D4000081A40000000000000000000000016491641000000107000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/help/config.mlopen F0
open Functoria

let main = Functoria.(main "App" job)

let key =
  let doc = Key.Arg.info ~doc:"How to say hello." [ "hello" ] in
  Key.(create "hello" Arg.(opt string "Hello World!" doc))

let () = register ~keys:[ Key.v key ] ~src:`None "noop" [ main ]
070701000000D5000081A40000000000000000000000016491641000001772000000000000000000000000000000000000002F00000000mirage-4.4.0/test/functoria/help/configure-o.tHelp configure -o --man-format=plain
  $ ./config.exe help configure -o foo --man-format=plain | tee d1
  NAME
         test-configure - Configure a test application.
  
  SYNOPSIS
         test configure [OPTION]…
  
  DESCRIPTION
         The configure command initializes a fresh test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test configure exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of configure:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

Help configure -o --help=plain
  $ ./config.exe configure -o foo --help=plain | tee d2
  NAME
         test-configure - Configure a test application.
  
  SYNOPSIS
         test configure [OPTION]…
  
  DESCRIPTION
         The configure command initializes a fresh test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test configure exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of configure:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

No difference
  $ diff d1 d2
070701000000D6000081A4000000000000000000000001649164100000175E000000000000000000000000000000000000002D00000000mirage-4.4.0/test/functoria/help/configure.tHelp configure --man-format=plain
  $ ./config.exe help configure --man-format=plain | tee d1
  NAME
         test-configure - Configure a test application.
  
  SYNOPSIS
         test configure [OPTION]…
  
  DESCRIPTION
         The configure command initializes a fresh test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test configure exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of configure:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

Configure help --help=plain
  $ ./config.exe configure --help=plain | tee d2
  NAME
         test-configure - Configure a test application.
  
  SYNOPSIS
         test configure [OPTION]…
  
  DESCRIPTION
         The configure command initializes a fresh test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test configure exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of configure:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

No difference
  $ diff d1 d2
070701000000D7000081A4000000000000000000000001649164100000194C000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/help/describe.tHelp describe --man-format=plain
  $ ./config.exe help describe --man-format=plain | tee d1
  NAME
         test-describe - Describe a test application.
  
  SYNOPSIS
         test describe [OPTION]…
  
  DESCRIPTION
         The describe command describes the configuration of a test
         application.
  
         The dot output contains the following elements:
         If vertices
             Represented as circles. Branches are dotted, and the default
             branch is in bold.
         Configurables
             Represented as rectangles. The order of the output arrows is the
             order of the functor arguments.
         Data dependencies
             Represented as dashed arrows.
         App vertices
             Represented as diamonds. The bold arrow is the functor part.
  
  DESCRIBE OPTIONS
         --dot
             Output a dot description. If no output file is given, it will
             display the dot file using the command given to --dot-command.
  
         --dot-command=COMMAND (absent=xdot)
             Command used to show a dot file. This command should accept a dot
             file on its standard input.
  
         --eval
             Fully evaluate the graph before showing it. The default when the
             unikernel has already been configured.
  
         --no-eval
             Do not evaluate the graph before showing it. See --eval. The
             default when the unikernel has not been configured.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test describe exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)

Help describe --help=plain
  $ ./config.exe describe --help=plain | tee d2
  NAME
         test-describe - Describe a test application.
  
  SYNOPSIS
         test describe [OPTION]…
  
  DESCRIPTION
         The describe command describes the configuration of a test
         application.
  
         The dot output contains the following elements:
         If vertices
             Represented as circles. Branches are dotted, and the default
             branch is in bold.
         Configurables
             Represented as rectangles. The order of the output arrows is the
             order of the functor arguments.
         Data dependencies
             Represented as dashed arrows.
         App vertices
             Represented as diamonds. The bold arrow is the functor part.
  
  DESCRIBE OPTIONS
         --dot
             Output a dot description. If no output file is given, it will
             display the dot file using the command given to --dot-command.
  
         --dot-command=COMMAND (absent=xdot)
             Command used to show a dot file. This command should accept a dot
             file on its standard input.
  
         --eval
             Fully evaluate the graph before showing it. The default when the
             unikernel has already been configured.
  
         --no-eval
             Do not evaluate the graph before showing it. See --eval. The
             default when the unikernel has not been configured.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test describe exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)

No difference
  $ diff d1 d2
070701000000D8000081A4000000000000000000000001649164100000005C000000000000000000000000000000000000002600000000mirage-4.4.0/test/functoria/help/dune(executable
 (name config)
 (libraries f0))

(cram
 (package functoria)
 (deps config.exe))
070701000000D9000081A40000000000000000000000016491641000001974000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/help/query.tHelp query --man-format=plain
  $ ./config.exe help query --man-format=plain | tee d1
  NAME
         test-query - Query information about the test application.
  
  SYNOPSIS
         test query [OPTION]… [INFO]
  
  DESCRIPTION
         The query command queries information about the test application.
  
  QUERY OPTIONS
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
         INFO (absent=packages)
             The information to query. INFO must be one of 'name', 'packages',
             'opam', 'files', 'Makefile', 'dune.config', 'dune.build',
             'dune-project', 'dune-workspace' or 'dune.dist'
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test query exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of query:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

Help query --help=plain
  $ ./config.exe query --help=plain | tee d2
  NAME
         test-query - Query information about the test application.
  
  SYNOPSIS
         test query [OPTION]… [INFO]
  
  DESCRIPTION
         The query command queries information about the test application.
  
  QUERY OPTIONS
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
         INFO (absent=packages)
             The information to query. INFO must be one of 'name', 'packages',
             'opam', 'files', 'Makefile', 'dune.config', 'dune.build',
             'dune-project', 'dune-workspace' or 'dune.dist'
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test query exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of query:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

No difference
  $ diff d1 d2
070701000000DA000041ED0000000000000000000000036491641000000000000000000000000000000000000000000000002000000000mirage-4.4.0/test/functoria/lib070701000000DB000081A40000000000000000000000016491641000000021000000000000000000000000000000000000002A00000000mirage-4.4.0/test/functoria/lib/config.mllet () = F0.register "my-app" []
070701000000DC000081A40000000000000000000000016491641000000068000000000000000000000000000000000000002500000000mirage-4.4.0/test/functoria/lib/dune(executable
 (name config)
 (libraries f0))

(cram
 (package functoria)
 (deps config.exe empty/empty))
070701000000DD000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002600000000mirage-4.4.0/test/functoria/lib/empty070701000000DE000081A40000000000000000000000016491641000000000000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/lib/empty/empty070701000000DF000081A400000000000000000000000164916410000034E9000000000000000000000000000000000000002600000000mirage-4.4.0/test/functoria/lib/run.tConfigure
  $ ./config.exe configure a b c 2> configure.err
  [1]

$ cat configure.err
  test: too many arguments, don't know what to do with 'a', 'b', 'c'
  Usage: test configure [OPTION]…
  Try 'test configure --help' or 'test --help' for more information.

Build
  $ ./config.exe build a b c 2> build.err
  [1]

$ cat build.err
  test: too many arguments, don't know what to do with 'a', 'b', 'c'
  Usage: test build [OPTION]…
  Try 'test build --help' or 'test --help' for more information.

Clean
  $ ./config.exe clean a b c 2> clean.err
  [1]

$ cat clean.err
  test: too many arguments, don't know what to do with 'a', 'b', 'c'
  Usage: test clean [OPTION]…
  Try 'test clean --help' or 'test --help' for more information.

Query
  $ ./config.exe query a b c 2> query.err
  [1]

$ cat query.err
  test: too many arguments, don't know what to do with 'b', 'c'
  Usage: test query [OPTION]… [INFO]
  Try 'test query --help' or 'test --help' for more information.

Describe
  $ ./config.exe describe a b c 2> describe.err
  [1]

$ cat describe.err
  test: too many arguments, don't know what to do with 'a', 'b', 'c'
  Usage: test describe [OPTION]…
  Try 'test describe --help' or 'test --help' for more information.

Help
  $ ./config.exe help a b c 2> help.err
  [1]

$ cat help.err
  test: too many arguments, don't know what to do with 'b', 'c'
  Usage: test help [--man-format=FMT] [OPTION]… [TOPIC]
  Try 'test help --help' or 'test --help' for more information.

Simple help
  $ ./config.exe help --man-format=plain 2> simple-help.err
  NAME
         test - The test application builder
  
  SYNOPSIS
         test [COMMAND] …
  
  DESCRIPTION
         The test application builder. It glues together a set of libraries and
         configuration (e.g. network and storage) into a standalone unikernel
         or UNIX binary.
  
         Use test help <command> for more information on a specific command.
  
  COMMANDS
         build [OPTION]…
             Build a test application.
  
         clean [OPTION]…
             Clean the files produced by test for a given application.
  
         configure [OPTION]…
             Configure a test application.
  
         describe [OPTION]…
             Describe a test application.
  
         help [--man-format=FMT] [OPTION]… [TOPIC]
             Display help about test commands.
  
         query [OPTION]… [INFO]
             Query information about the test application.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).

$ cat simple-help.err

Help configure
  $ ./config.exe help configure --man-format=plain 2> configure.err
  NAME
         test-configure - Configure a test application.
  
  SYNOPSIS
         test configure [OPTION]…
  
  DESCRIPTION
         The configure command initializes a fresh test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --depext
             Enable call to `opam depext' in the project Makefile.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         --extra-repos=NAME1:URL1,NAME2:URL2,...
         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
         or MIRAGE_EXTRA_REPOS env)
             Additional opam-repositories to use when using `opam monorepo
             lock' to gather local sources. Default:
             https://github.com/dune-universe/opam-overlays.git &
             https://github.com/dune-universe/mirage-opam-overlays.git.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         --no-depext
             Disable call to `opam depext' in the project Makefile.
  
         --no-extra-repo
             Disable the use of any overlay repository.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test configure exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of configure:
  
         MIRAGE_EXTRA_REPOS
             See option --extra-repos.
  
  SEE ALSO
         test(1)

$ cat configure.err

Configure help
  $ ./config.exe configure help 2> configure-help.err
  [1]

$ cat configure-help.err
  test: too many arguments, don't know what to do with 'help'
  Usage: test configure [OPTION]…
  Try 'test configure --help' or 'test --help' for more information.

Help no config
  $ ./config.exe help --file=empty/config.ml --man-format=plain 2> help-no-config.err
  NAME
         test - The test application builder
  
  SYNOPSIS
         test [COMMAND] …
  
  DESCRIPTION
         The test application builder. It glues together a set of libraries and
         configuration (e.g. network and storage) into a standalone unikernel
         or UNIX binary.
  
         Use test help <command> for more information on a specific command.
  
  COMMANDS
         build [OPTION]…
             Build a test application.
  
         clean [OPTION]…
             Clean the files produced by test for a given application.
  
         configure [OPTION]…
             Configure a test application.
  
         describe [OPTION]…
             Describe a test application.
  
         help [--man-format=FMT] [OPTION]… [TOPIC]
             Display help about test commands.
  
         query [OPTION]… [INFO]
             Query information about the test application.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  $ cat help-no-config.err

Help no config with bad arguments
  $ ./config.exe help --file=empty/config.ml a b c 2> help-no-config-args.err
  [1]

Build help no config with bad arguments
  $ ./config.exe build --help=plain --file=empty/config.ml a b c 2> build-help-no-config-args.err
  NAME
         test-build - Build a test application.
  
  SYNOPSIS
         test build [OPTION]…
  
  DESCRIPTION
         Build a test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test build exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)
  
  $ cat build-help-no-config-args.err

Version configure
  $ ./config.exe configure --version a b c
  1.0~test

Ambiguous
  $ ./config.exe c a b c 2> ambiguous.err
  [1]

$ cat ambiguous.err
  test: command 'c' ambiguous and could be either 'clean' or 'configure'
  Usage: test [COMMAND] …
  Try 'test --help' for more information.

Default
  $ ./config.exe 2> default.err
  NAME
         test - The test application builder
  
  SYNOPSIS
         test [COMMAND] …
  
  DESCRIPTION
         The test application builder. It glues together a set of libraries and
         configuration (e.g. network and storage) into a standalone unikernel
         or UNIX binary.
  
         Use test help <command> for more information on a specific command.
  
  COMMANDS
         build [OPTION]…
             Build a test application.
  
         clean [OPTION]…
             Clean the files produced by test for a given application.
  
         configure [OPTION]…
             Configure a test application.
  
         describe [OPTION]…
             Describe a test application.
  
         help [--man-format=FMT] [OPTION]… [TOPIC]
             Display help about test commands.
  
         query [OPTION]… [INFO]
             Query information about the test application.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).

$ cat default.err
070701000000E0000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002200000000mirage-4.4.0/test/functoria/query070701000000E1000081A40000000000000000000000016491641000000129000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/query/config.mlopen F0
open Functoria

let main = Functoria.(main ~extra_deps:[ dep (app_info ()) ] "App" job)

let key =
  let doc = Key.Arg.info ~doc:"How to say hello." [ "hello" ] in
  Key.(create "hello" Arg.(opt string "Hello World!" doc))

let () = register ~keys:[ Key.v key ] ~src:`None "noop" [ main ]
070701000000E2000081A4000000000000000000000001649164100000007C000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/query/dune(executable
 (name config)
 (libraries f0))

(cram
 (package functoria)
 (deps config.exe ../../../functoria-runtime.opam))
070701000000E3000081A400000000000000000000000164916410000022E8000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/query/run.tQuery name
  $ ./config.exe query name
  noop

Query opam file
  $ ./config.exe query opam
  opam-version: "2.0"
  maintainer: "dummy"
  authors: "dummy"
  homepage: "dummy"
  bug-reports: "dummy"
  dev-repo: "git://dummy"
  synopsis: "Unikernel noop - switch dependencies"
  description: """
  It assumes that local dependencies are already
  fetched.
  """
  
  build: ["sh" "-exc" "test build"]
  
  install: [
    [ "cp" "dist/f0.exe" "%{bin}%/f0" ]
  ]
  
  depends: [
    "dune-build-info" { ?monorepo }
    "fmt" { ?monorepo }
    "functoria-runtime" { ?monorepo }
  ]
  
  x-mirage-opam-lock-location: "mirage/noop.opam.locked"
  
  x-mirage-configure: ["sh" "-exc" "test configure --no-extra-repo"]
  
  x-mirage-pre-build: [make "lock" "depext-lockfile" "pull"]
  
  x-mirage-extra-repo: [
  ["opam-overlays" "https://github.com/dune-universe/opam-overlays.git"]
  
  ["mirage-overlays" "https://github.com/dune-universe/mirage-opam-overlays.git"]]
  
  x-opam-monorepo-opam-provided: []

Query packages
  $ ./config.exe query packages
  "dune-build-info" { ?monorepo }
  "fmt" { ?monorepo }
  "functoria-runtime" { ?monorepo }

Query files
  $ ./config.exe query files
  info_gen.ml key_gen.ml main.ml vote warn_error

Query Makefile
  $ ./config.exe query Makefile
  -include Makefile.user
  BUILD_DIR = ./
  MIRAGE_DIR = ./test
  UNIKERNEL_NAME = noop
  OPAM = opam
  
  all::
  	@$(MAKE) --no-print-directory depends
  	@$(MAKE) --no-print-directory build
  
  .PHONY: all lock install-switch pull clean depend depends build repo-add repo-rm depext-lockfile
  
  repo-add:
  	@printf "\e[2musing overlay repository mirage: [opam-overlays, mirage-overlays] \e[0m\n"
  	$(OPAM) repo add opam-overlays https://github.com/dune-universe/opam-overlays.git || $(OPAM) repo set-url opam-overlays https://github.com/dune-universe/opam-overlays.git
  	$(OPAM) repo add mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git || $(OPAM) repo set-url mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
  
  
  repo-rm:
  	@printf "\e[2mremoving overlay repository [opam-overlays, mirage-overlays]\e[0m\n"
  	$(OPAM) repo remove opam-overlays https://github.com/dune-universe/opam-overlays.git
  	$(OPAM) repo remove mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
  
  
  
  depext-lockfile: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  	echo " ↳ install external dependencies for monorepo"
  	env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo depext -y -l $<
  
  
  $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
  	@$(MAKE) -s repo-add
  	@echo " ↳ generate lockfile for monorepo dependencies"
  	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo lock --require-cross-compile --build-only $(UNIKERNEL_NAME) -l $@ --ocaml-version $(shell ocamlc --version); (ret=$$?; $(MAKE) -s repo-rm && exit $$ret)
  
  lock::
  	@$(MAKE) -B $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  
  pull:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  	@echo " ↳ fetch monorepo dependencies in the duniverse folder"
  	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo pull -l $< -r $(abspath $(BUILD_DIR))
  
  install-switch:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
  	@echo " ↳ opam install switch dependencies"
  	@$(OPAM) install $< --deps-only --yes
  	@$(MAKE) -s depext-lockfile
  
  depends depend::
  	@$(MAKE) --no-print-directory lock
  	@$(MAKE) --no-print-directory install-switch
  	@$(MAKE) --no-print-directory pull
  
  build::
  	mirage build -f config.ml
  
  clean::
  	mirage clean

Query Makefile without depexts
  $ ./config.exe query Makefile --no-depext
  -include Makefile.user
  BUILD_DIR = ./
  MIRAGE_DIR = ./test
  UNIKERNEL_NAME = noop
  OPAM = opam
  
  all::
  	@$(MAKE) --no-print-directory depends
  	@$(MAKE) --no-print-directory build
  
  .PHONY: all lock install-switch pull clean depend depends build repo-add repo-rm
  
  repo-add:
  	@printf "\e[2musing overlay repository mirage: [opam-overlays, mirage-overlays] \e[0m\n"
  	$(OPAM) repo add opam-overlays https://github.com/dune-universe/opam-overlays.git || $(OPAM) repo set-url opam-overlays https://github.com/dune-universe/opam-overlays.git
  	$(OPAM) repo add mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git || $(OPAM) repo set-url mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
  
  
  repo-rm:
  	@printf "\e[2mremoving overlay repository [opam-overlays, mirage-overlays]\e[0m\n"
  	$(OPAM) repo remove opam-overlays https://github.com/dune-universe/opam-overlays.git
  	$(OPAM) repo remove mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
  
  
  $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
  	@$(MAKE) -s repo-add
  	@echo " ↳ generate lockfile for monorepo dependencies"
  	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo lock --require-cross-compile --build-only $(UNIKERNEL_NAME) -l $@ --ocaml-version $(shell ocamlc --version); (ret=$$?; $(MAKE) -s repo-rm && exit $$ret)
  
  lock::
  	@$(MAKE) -B $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  
  pull:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  	@echo " ↳ fetch monorepo dependencies in the duniverse folder"
  	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo pull -l $< -r $(abspath $(BUILD_DIR))
  
  install-switch:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
  	@echo " ↳ opam install switch dependencies"
  	@$(OPAM) install $< --deps-only --yes --no-depexts
  
  depends depend::
  	@$(MAKE) --no-print-directory lock
  	@$(MAKE) --no-print-directory install-switch
  	@$(MAKE) --no-print-directory pull
  
  build::
  	mirage build -f config.ml
  
  clean::
  	mirage clean

Query Makefile with depext
  $ ./config.exe query Makefile --depext
  -include Makefile.user
  BUILD_DIR = ./
  MIRAGE_DIR = ./test
  UNIKERNEL_NAME = noop
  OPAM = opam
  
  all::
  	@$(MAKE) --no-print-directory depends
  	@$(MAKE) --no-print-directory build
  
  .PHONY: all lock install-switch pull clean depend depends build repo-add repo-rm depext-lockfile
  
  repo-add:
  	@printf "\e[2musing overlay repository mirage: [opam-overlays, mirage-overlays] \e[0m\n"
  	$(OPAM) repo add opam-overlays https://github.com/dune-universe/opam-overlays.git || $(OPAM) repo set-url opam-overlays https://github.com/dune-universe/opam-overlays.git
  	$(OPAM) repo add mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git || $(OPAM) repo set-url mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
  
  
  repo-rm:
  	@printf "\e[2mremoving overlay repository [opam-overlays, mirage-overlays]\e[0m\n"
  	$(OPAM) repo remove opam-overlays https://github.com/dune-universe/opam-overlays.git
  	$(OPAM) repo remove mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git
  
  
  
  depext-lockfile: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  	echo " ↳ install external dependencies for monorepo"
  	env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo depext -y -l $<
  
  
  $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
  	@$(MAKE) -s repo-add
  	@echo " ↳ generate lockfile for monorepo dependencies"
  	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo lock --require-cross-compile --build-only $(UNIKERNEL_NAME) -l $@ --ocaml-version $(shell ocamlc --version); (ret=$$?; $(MAKE) -s repo-rm && exit $$ret)
  
  lock::
  	@$(MAKE) -B $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  
  pull:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked
  	@echo " ↳ fetch monorepo dependencies in the duniverse folder"
  	@env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo pull -l $< -r $(abspath $(BUILD_DIR))
  
  install-switch:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam
  	@echo " ↳ opam install switch dependencies"
  	@$(OPAM) install $< --deps-only --yes
  	@$(MAKE) -s depext-lockfile
  
  depends depend::
  	@$(MAKE) --no-print-directory lock
  	@$(MAKE) --no-print-directory install-switch
  	@$(MAKE) --no-print-directory pull
  
  build::
  	mirage build -f config.ml
  
  clean::
  	mirage clean

Query version
  $ ./config.exe query --version
  1.0~test

Query unikernel dune
  $ ./config.exe query dune.build
  (copy_files ./config/*)
  
  (executable
    (public_name f0)
    (package   functoria)
    (name      main)
    (modules   (:standard \ config))
    (promote   (until-clean))
    (libraries cmdliner fmt functoria-runtime))

Query configuration dune
  $ ./config.exe query dune.config
  (data_only_dirs duniverse)
  
  ;; Generated by test.1.0~test
  
  
  (executable
   (name config)
   (modules config)
   (libraries f0 functoria))

Query dune-project
  $ ./config.exe query dune-project
  (lang dune 2.7)
  
  (name noop)

Query dune-workspace
  $ ./config.exe query dune-workspace
  (lang dune 2.0)
  (context default)
070701000000E4000081A400000000000000000000000164916410000000DD000000000000000000000000000000000000002400000000mirage-4.4.0/test/functoria/test.mllet () =
  Alcotest.run "functoria"
    [
      ("cli", Test_cli.suite);
      ("package", Test_package.suite);
      ("graph", Test_graph.suite);
      ("action", Test_action.suite);
      ("key", Test_key.suite);
    ]
070701000000E5000081A4000000000000000000000001649164100000000C000000000000000000000000000000000000002500000000mirage-4.4.0/test/functoria/test.mli(* empty *)
070701000000E6000081A40000000000000000000000016491641000003178000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/test_action.mlopen Functoria
open Action.Syntax

let pp_unit ppf () = Fmt.string ppf "()"
let domain pp = Alcotest.testable (Action.pp_domain pp) (Action.eq_domain ( = ))
let file = "<file>"
let dir = "<DIR>"
let error e = Error (`Msg e)
let ( ! ) files = Action.env ~files:(`Files files) ()
let path = Fpath.v "path"
let other_path = Fpath.v "other_path"
let dom result env logs = { Action.result; env; logs }

let test_bind () =
  let got =
    Action.dry_run
      ~env:![ (path, file); (other_path, file) ]
      (let* () = Action.rm path in
       Action.rm other_path)
  in
  Alcotest.check (domain pp_unit) "sequence"
    (dom (Ok ()) ![] [ "Rm path (removed)"; "Rm other_path (removed)" ])
    got;

let got =
    Action.dry_run
      ~env:![ (other_path, dir) ]
      (let* () = Action.rm path in
       Action.rm other_path)
  in
  Alcotest.check (domain pp_unit) "sequence after error"
    (dom
       (error "other_path is a directory")
       ![ (other_path, dir) ]
       [ "Rm path (no-op)"; "Rm other_path (error)" ])
    got;

let got =
    let value = 5 in
    Action.dry_run ~env:![]
      (let* got_value = Action.ok value in
       Alcotest.check Alcotest.int "value matches" value got_value;
       Action.ok ())
  in
  Alcotest.check (domain pp_unit) "bind passes the correct value to caller code"
    (dom (Ok ()) ![] []) got

let mk_test ~env ~expected name a ty =
  let got = Action.dry_run ~env a in
  Alcotest.check (domain ty) name expected got

let test_seq () =
  let test msg seq = mk_test msg (Action.seq seq) pp_unit in
  let test_file b x = Alcotest.(check bool) "file exists" b x in
  test "simple sequence" ~env:![]
    ~expected:
      (dom (Ok ()) ![]
         [
           "Write to path (0 bytes)";
           "Is_file? path -> true";
           "Rm path (removed)";
           "Is_file? path -> false";
         ])
    Action.
      [
        write_file path "";
        (let+ is_file = is_file path in
         test_file true is_file);
        rm path;
        (let+ is_file = is_file path in
         test_file false is_file);
      ]

let test_rm () =
  let test msg ~path = mk_test msg (Action.rm path) pp_unit in

test "delete (file)" ~path
    ~env:![ (path, file); (other_path, file) ]
    ~expected:(dom (Ok ()) ![ (other_path, file) ] [ "Rm path (removed)" ]);

let env = ![ (path, dir); (other_path, file) ] in
  test "delete (dir)" ~path ~env
    ~expected:(dom (error "path is a directory") env [ "Rm path (error)" ]);

let env = ![ (other_path, file) ] in
  test "delete (file does not exist)" ~path ~env
    ~expected:(dom (Ok ()) env [ "Rm path (no-op)" ])

let test_mkdir () =
  let test msg ~path = mk_test msg (Action.mkdir path) Fmt.bool in

test "mkdir (new dir)" ~path
    ~env:![ (other_path, file) ]
    ~expected:
      (dom (Ok true)
         ![ (other_path, file); (path, dir) ]
         [ "Mkdir path (created)" ]);

let env = ![ (other_path, file); (path, dir) ] in
  test "mdkir (existing dir)" ~path ~env
    ~expected:(dom (Ok false) env [ "Mkdir path (already exists)" ]);

let env = ![ (path, file) ] in
  test "mdkir (existing file)" ~path ~env
    ~expected:
      (dom
         (error "a file named 'path' already exists")
         env [ "Mkdir path (error)" ])

let test_rmdir () =
  let test msg ~path = mk_test msg (Action.rmdir path) pp_unit in

let env = ![ (other_path, dir) ] in
  test "rmdir (non-existing dir)" ~path ~env
    ~expected:(dom (Ok ()) env [ "Rmdir path (no-op)" ]);

test "rmdir (existing dir)" ~path
    ~env:![ (path, file); (other_path, dir) ]
    ~expected:(dom (Ok ()) ![ (other_path, dir) ] [ "Rmdir path (removed)" ]);

let env =
    ![
       (other_path, file); (Fpath.(path / "1"), dir); (Fpath.(path / "2"), file);
     ]
  in
  test "rmdir (dir with contents)" ~path ~env
    ~expected:(dom (Ok ()) ![ (other_path, file) ] [ "Rmdir path (removed)" ])

let test_with_dir () =
  let test msg ~path op = mk_test msg (Action.with_dir path op) pp_unit in

test "with_dir (create file)" ~path ~env:![]
    ~expected:
      (dom (Ok ())
         ![ (Fpath.(path // other_path), file) ]
         [ "With_dir path [Write to other_path (6 bytes)]" ])
    (fun () -> Action.write_file other_path file)

let test_pwd () =
  let test msg = mk_test msg (Action.pwd ()) Fpath.pp in

test "pwd (root)" ~env:![]
    ~expected:(dom (Ok (Fpath.v "/")) ![] [ "Pwd -> /" ]);

let env = Action.env ~pwd:(Fpath.v "/foo/bar") () in
  test "pwd (env)" ~env
    ~expected:(dom (Ok (Fpath.v "/foo/bar")) env [ "Pwd -> /foo/bar" ])

let test_is_file () =
  let test msg ~path = mk_test msg (Action.is_file path) Fmt.bool in

let env = ![ (path, file) ] in
  test "file exists (true)" ~path ~env
    ~expected:(dom (Ok true) env [ "Is_file? path -> true" ]);

let env = ![ (other_path, file) ] in
  test "file exists (false)" ~path ~env
    ~expected:(dom (Ok false) env [ "Is_file? path -> false" ])

let test_is_dir () =
  let test msg ~path = mk_test msg (Action.is_dir path) Fmt.bool in

let env = ![ (path, dir) ] in
  test "dir exists (exact dir)" ~path ~env
    ~expected:(dom (Ok true) env [ "Is_dir? path -> true" ]);

let env = ![ (path, file) ] in
  test "dir exists (file)" ~path ~env
    ~expected:(dom (Ok false) env [ "Is_dir? path -> false" ]);

let env = ![ (other_path, file) ] in
  test "dir exists (false)" ~path ~env
    ~expected:(dom (Ok false) env [ "Is_dir? path -> false" ]);

let env = ![ (Fpath.(path / "1"), file) ] in
  test "dir exists (with a file in it)" ~path ~env
    ~expected:(dom (Ok true) env [ "Is_dir? path -> true" ])

let test_size_of () =
  let test msg ~path =
    mk_test msg (Action.size_of path) Fmt.(Dump.option int)
  in

let env = ![ (path, "") ] in
  test "size_of (empty)" ~path ~env
    ~expected:(dom (Ok (Some 0)) env [ "Size_of path -> 0" ]);

let env = ![] in
  test "size_of (error)" ~path ~env
    ~expected:(dom (Ok None) env [ "Size_of path -> error" ]);

let env = ![ (path, String.make 10_000 'a') ] in
  test "size_of (large)" ~path ~env
    ~expected:(dom (Ok (Some 10_000)) env [ "Size_of path -> 10000" ])

let test_set_var () =
  let test msg ~key ~value = mk_test msg (Action.set_var key value) pp_unit in

let env = Action.env ~env:[ ("var", "v") ] () in
  test "set_var (unset)" ~key:"var" ~value:None ~env
    ~expected:(dom (Ok ()) ![] [ "Set_var var <unset>" ]);

let new_v = "new_v" in
  let env = Action.env ~env:[ ("var", new_v) ] () in
  test "set_var (new)" ~key:"var" ~value:(Some new_v) ~env:![]
    ~expected:(dom (Ok ()) env [ "Set_var var new_v" ]);

let new_v = "new_v" in
  let env v = Action.env ~env:[ ("var", v) ] () in
  test "set_var (overwrite)" ~key:"var" ~value:(Some new_v) ~env:(env "v")
    ~expected:(dom (Ok ()) (env new_v) [ "Set_var var new_v" ])

let test_get_var () =
  let test msg ~key =
    mk_test msg (Action.get_var key) Fmt.(Dump.option string)
  in

let v = "v" in
  let env = Action.env ~env:[ ("var", v) ] () in
  test "get_var (existing)" ~key:"var" ~env
    ~expected:(dom (Ok (Some v)) env [ "Get_var var -> v" ]);

let env = ![] in
  test "get_var (not set)" ~key:"var" ~env
    ~expected:(dom (Ok None) env [ "Get_var var -> <not set>" ])

let none _ = None
let yay _ = Some ("yay", "")
let yay_err _ = Some ("yay", "err")

let test_run_cmd () =
  let test msg ?err ?out ~exec ~cmd ~expected ~expected_log () =
    let env = Action.env ~exec () in
    let got = Action.dry_run ~env (Action.run_cmd ?err ?out cmd) in
    Alcotest.check (domain pp_unit) msg (dom expected env expected_log) got
  in
  test "run_cmd fails if the command doesn't exist" ~exec:none
    ~cmd:(Bos.Cmd.v "some-command")
    ~expected:(error "'some-command' not found")
    ~expected_log:[ "Run_cmd 'some-command' (error)" ]
    ();

let cmd = Bos.Cmd.v "some-command" in
  test "run_cmd succeeds if the command exists" ~exec:yay ~cmd ~expected:(Ok ())
    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
    ();

let err_b = Buffer.create 10 in
  let err = `Fmt (Fmt.with_buffer err_b) in
  let out_b = Buffer.create 10 in
  let out = `Fmt (Fmt.with_buffer out_b) in
  test "run_cmd succeeds if the command exists" ~exec:yay_err ~cmd ~out ~err
    ~expected:(Ok ())
    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
    ();
  Alcotest.(check string) "cmd out" "yay" (Buffer.contents out_b);
  Alcotest.(check string) "cmd err" "err" (Buffer.contents err_b)

let test_run_cmd_out () =
  let test msg ?err ~exec ~cmd ~expected ~expected_log () =
    let env = Action.env ~exec () in
    let got = Action.dry_run ~env (Action.run_cmd_out ?err cmd) in
    Alcotest.check (domain Fmt.string) msg (dom expected env expected_log) got
  in
  test "run_cmd_out fails if the command doesn't exist" ~exec:none
    ~cmd:(Bos.Cmd.v "some-command")
    ~expected:(error "'some-command' not found")
    ~expected_log:[ "Run_cmd 'some-command' (error)" ]
    ();

let cmd = Bos.Cmd.v "some-command" in
  test "run_cmd_out succeeds if the command exists" ~exec:yay ~cmd
    ~expected:(Ok "yay")
    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
    ();

let err_b = Buffer.create 10 in
  let err = `Fmt (Fmt.with_buffer err_b) in
  test "run_cmd_out succeeds if the command exists" ~exec:yay_err ~cmd ~err
    ~expected:(Ok "yay")
    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
    ();
  Alcotest.(check string) "cmd_out err" "err" (Buffer.contents err_b)

let test_write_file () =
  let test msg ~path ~contents =
    mk_test msg (Action.write_file path contents) pp_unit
  in

let contents = "contents" in
  test "write to nonexisting file" ~path ~env:![] ~contents
    ~expected:(dom (Ok ()) ![ (path, contents) ] [ "Write to path (8 bytes)" ]);

let contents = "new contents" in
  test "write to existing file" ~path
    ~env:![ (path, contents) ]
    ~contents
    ~expected:(dom (Ok ()) ![ (path, contents) ] [ "Write to path (12 bytes)" ])

let test_tmp_file () =
  let test msg ~pat = mk_test msg (Action.tmp_file pat) Fpath.pp in
  let pat : Bos.OS.File.tmp_name_pat = "path-%s" in
  let path0 = Fpath.(v "/tmp" / Fmt.str pat "0") in
  let env = ![] in
  test "create a temp file (no conflicts)" ~env ~pat
    ~expected:(dom (Ok path0) env [ "Tmp_file -> /tmp/path-0" ]);

let pat : Bos.OS.File.tmp_name_pat = "path-%s" in
  let pathn n = Fpath.(v "/tmp" / Fmt.str pat (string_of_int n)) in
  let env = ![ (pathn 0, file); (pathn 1, file); (pathn 3, file) ] in
  test "create a temp file (with conflicts)" ~env ~pat
    ~expected:(dom (Ok (pathn 2)) env [ "Tmp_file -> /tmp/path-2" ])

let test_ls () =
  let all _ = true in
  let test msg ~path =
    mk_test msg (Action.ls path all) (Fmt.Dump.list Fpath.pp)
  in

let env = ![] in
  test "list a non-existig path (error)" ~env ~path
    ~expected:
      (dom (error "path: no such file or directory") env [ "Ls path (error)" ]);

let root = Fpath.v "root" in
  let pathn n = Fpath.(root / string_of_int n) in
  let env = ![ (pathn 0, file); (pathn 1, file); (pathn 2, file) ] in
  test "list a directory" ~env ~path:root
    ~expected:
      (dom (Ok Fpath.[ v "0"; v "1"; v "2" ]) env [ "Ls root (3 entries)" ]);

let env = ![ (path, dir) ] in
  test "list an empty directory" ~env ~path
    ~expected:(dom (Ok []) env [ "Ls path (0 entry)" ]);

let env = ![ (path, file) ] in
  test "list a file" ~env ~path
    ~expected:(dom (Ok [ path ]) env [ "Ls path (1 entry)" ])

let test_with_output () =
  let test msg ~contents ~expected =
    let env = ![] in
    let mode = 0o755 in
    let purpose = "PURPOSE" in
    let called = ref false in
    let got =
      Action.dry_run ~env
      @@ Action.with_output ~mode ~path ~purpose (fun fmt ->
             called := true;
             Fmt.pf fmt "%s" contents)
    in
    Alcotest.check (domain pp_unit) msg
      (dom expected
         ![ (path, contents) ]
         [ "Write to path (mode: 0755, purpose: PURPOSE)" ])
      got;
    Alcotest.check Alcotest.bool "k was called" true called.contents
  in
  let contents = "contents" in
  test "write" ~contents ~expected:(Ok ())

let suite =
  List.map
    (fun (n, f) -> (n, `Quick, f))
    [
      ("bind", test_bind);
      ("seq", test_seq);
      ("rm", test_rm);
      ("mkdir", test_mkdir);
      ("rmdir", test_rmdir);
      ("with_dir", test_with_dir);
      ("pwd", test_pwd);
      ("is_file", test_is_file);
      ("is_dir", test_is_dir);
      ("size_of", test_size_of);
      ("set_var", test_set_var);
      ("get_var", test_get_var);
      ("run_cmd", test_run_cmd);
      ("run_cmd_out", test_run_cmd_out);
      ("write_file", test_write_file);
      ("tmp_file", test_tmp_file);
      ("ls", test_ls);
      ("with_output", test_with_output);
    ]
070701000000E7000081A40000000000000000000000016491641000000029000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/test_action.mlival suite : unit Alcotest.test_case list
070701000000E8000081A40000000000000000000000016491641000001808000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/test_cli.mlopen Functoria

let result_t pp_a =
  let pp ppf = function
    | `Error `Exn -> Fmt.string ppf "error exn"
    | `Error `Parse -> Fmt.string ppf "error parse"
    | `Error `Term -> Fmt.string ppf "error term"
    | `Help -> Fmt.string ppf "help"
    | `Version -> Fmt.string ppf "version"
    | `Ok action ->
        let pp = Cli.pp_action pp_a in
        Fmt.pf ppf "ok %a" pp action
  in
  Alcotest.testable pp ( = )

let result_b = result_t Fmt.(Dump.pair bool bool)
let eval = Cli.eval ~with_setup:false ~name:"name" ~version:"0.2"

let test_configure () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~build:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
      [| "name"; "configure"; "--xyz"; "--verbose" |]
  in
  Alcotest.(check result_b)
    "configure"
    (`Ok
      (Cli.Configure
         {
           depext = true;
           extra_repo =
             [
               ( "opam-overlays",
                 "https://github.com/dune-universe/opam-overlays.git" );
               ( "mirage-overlays",
                 "https://github.com/dune-universe/mirage-opam-overlays.git" );
             ];
           args =
             {
               context = (true, false);
               output = None;
               config_file = Fpath.v "config.ml";
               context_file = None;
               dry_run = false;
             };
         }))
    result

let test_describe () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~build:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
      [|
        "name";
        "describe";
        "--context=config.json";
        "--cde";
        "--color=always";
        "--dot-command=dot";
        "--eval";
      |]
  in
  Alcotest.(check result_b)
    "describe"
    (`Ok
      (Cli.Describe
         {
           args =
             {
               context = (false, true);
               output = None;
               config_file = Fpath.v "config.ml";
               context_file = Some (Fpath.v "config.json");
               dry_run = false;
             };
           dotcmd = "dot";
           dot = false;
           eval = Some true;
         }))
    result

let test_build () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~build:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
      [| "name"; "build"; "--cde"; "-x"; "--color=never"; "-v"; "-v" |]
  in
  Alcotest.(check result_b)
    "build"
    (`Ok
      (Cli.Build
         {
           context = (true, true);
           output = None;
           config_file = Fpath.v "config.ml";
           context_file = None;
           dry_run = false;
         }))
    result

let test_clean () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~build:extra_term ~clean:extra_term ~help:extra_term [| "name"; "clean" |]
      ~mname:"test"
  in
  Alcotest.(check result_b)
    "clean"
    (`Ok
      (Cli.Clean
         {
           context = (false, false);
           output = None;
           config_file = Fpath.v "config.ml";
           context_file = None;
           dry_run = false;
         }))
    result

let test_help () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let null = Fmt.with_buffer (Buffer.create 10) in
  let result =
    eval ~help_ppf:null ~configure:extra_term ~query:extra_term
      ~describe:extra_term ~build:extra_term ~clean:extra_term ~help:extra_term
      ~mname:"test"
      [| "name"; "help"; "--help"; "plain" |]
  in
  Alcotest.(check result_b) "help" `Help result

let test_default () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let null = Fmt.with_buffer (Buffer.create 10) in
  let result =
    eval ~help_ppf:null ~configure:extra_term ~query:extra_term
      ~describe:extra_term ~build:extra_term ~clean:extra_term ~help:extra_term
      ~mname:"test" [| "name" |]
  in
  Alcotest.(check result_b) "default" `Help result

let test_read_full_eval () =
  let check = Alcotest.(check @@ option bool) in
  check "test" None (Cli.peek_full_eval [| "test" |]);

check "test --eval" (Some true) (Cli.peek_full_eval [| "test"; "--eval" |]);

check "test blah --eval blah" (Some true)
    (Cli.peek_full_eval [| "test"; "blah"; "--eval"; "blah" |]);

check "test --no-eval" (Some false)
    (Cli.peek_full_eval [| "test"; "--no-eval" |]);

check "test blah --no-eval blah" (Some false)
    (Cli.peek_full_eval [| "test"; "blah"; "--no-eval"; "blah" |]);

check "--no-eval test --eval" (Some true)
    (Cli.peek_full_eval [| "--no-eval"; "test"; "--eval" |]);

check "--eval test --no-eval" (Some false)
    (Cli.peek_full_eval [| "--eval"; "test"; "--no-eval" |])

let suite =
  [
    ("read_full_eval", `Quick, test_read_full_eval);
    ("configure", `Quick, test_configure);
    ("describe", `Quick, test_describe);
    ("build", `Quick, test_build);
    ("clean", `Quick, test_clean);
    ("help", `Quick, test_help);
    ("default", `Quick, test_default);
  ]
070701000000E9000081A40000000000000000000000016491641000000029000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/test_cli.mlival suite : unit Alcotest.test_case list
070701000000EA000081A40000000000000000000000016491641000000B3F000000000000000000000000000000000000002A00000000mirage-4.4.0/test/functoria/test_graph.mlopen Functoria

let x = Impl.v "Foo.Bar" Functoria.job
let y = Impl.v "X.Y" Functoria.(job @-> job) ~extra_deps:[ Impl.abstract x ]
let z = Impl.v "Bar" job ~extra_deps:[ Impl.abstract y ]

let z, y, x =
  let g = Impl.abstract z in
  let g = Impl.eval ~context:Key.empty_context g in
  match Device.Graph.fold List.cons g [] with
  | [ x; y; z ] -> (x, y, z)
  | _ -> assert false

let var_name x = Device.Graph.var_name x
let impl_name x = Device.Graph.impl_name x
let ident s i = Fmt.str "%s__%d" s i

let test_var_name () =
  Alcotest.(check string) "x" (ident "foo_bar" 1) (var_name x);
  Alcotest.(check string) "y" (ident "x_y" 2) (var_name y);
  Alcotest.(check string) "z" (ident "bar" 3) (var_name z)

let test_impl_name () =
  Alcotest.(check string) "x" "Foo.Bar" (impl_name x);
  Alcotest.(check string) "y" (ident "X_y" 2) (impl_name y);
  Alcotest.(check string) "z" "Bar" (impl_name z)

let d1 = Device.v ~packages:[ package "a" ] "Foo.Bar" job
let d2 = Device.v ~packages:[ package "b" ] "Foo.Bar" job
let i1 = of_device d1
let i2 = of_device d2
let if1 = if_impl (Key.pure true) i1 i2
let if2 = if_impl (Key.pure true) i2 i1

let normalise_lines str =
  let open Astring in
  let lines = String.cuts ~empty:true ~sep:"\n" str in
  let lines =
    List.map
      (fun line -> if String.for_all Char.Ascii.is_blank line then "" else line)
      lines
  in
  String.concat ~sep:"\n" lines

let graph_str g = normalise_lines (Fmt.to_to_string Impl.pp_dot g)

let digraph i =
  let j = i + 1 and k = i + 2 in
  Fmt.str
    {|digraph G {
  ordering=out;
  %d [label="foo_bar__%d\nFoo.Bar\n", shape="box"];
  %d [label="foo_bar__%d\nFoo.Bar\n", shape="box"];
  %d [label="If\n"];

%d -> %d [style="dotted", headport="n"];
  %d -> %d [style="dotted", headport="n"];
  %d -> %d [style="bold", style="dotted", headport="n"];
  }|}
    i i j j k k i k j k i

let test_graph () =
  let t1 = Impl.abstract if1 in
  Alcotest.(check string) "t1.dot" (digraph 1) (graph_str t1);
  let t2 = Impl.abstract if2 in
  Alcotest.(check string) "t2.dot" (digraph 1) (graph_str t2);
  let module M = struct
    type t = (string * string list) list

let empty = []
    let union = List.append
  end in
  let packages t =
    let ctx = Key.empty_context in
    Impl.collect
      (module M)
      (function
        | If _ | App -> []
        | Dev d ->
            let pkgs = Key.(eval ctx (Device.packages d)) in
            List.map (fun pkg -> (Package.name pkg, Package.libraries pkg)) pkgs)
      (Impl.simplify ~full:true ~context:ctx t)
  in
  let label = Alcotest.(list (pair string (list string))) in
  Alcotest.(check label) "t1" [ ("a", [ "a" ]) ] (packages t1);
  Alcotest.(check label) "t2" [ ("b", [ "b" ]) ] (packages t2)

let suite =
  [
    ("var_name", `Quick, test_var_name);
    ("impl_name", `Quick, test_impl_name);
    ("test_graph", `Quick, test_graph);
  ]
070701000000EB000081A40000000000000000000000016491641000000029000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/test_graph.mlival suite : unit Alcotest.test_case list
070701000000EC000081A40000000000000000000000016491641000001137000000000000000000000000000000000000002800000000mirage-4.4.0/test/functoria/test_key.mlopen Functoria

let key_a = Key.create "a" Key.Arg.(flag @@ info [ "a" ])
let key_b = Key.create "b" Key.Arg.(opt int 0 @@ info [ "b" ])

let key_c =
  Key.create "c" Key.Arg.(required ~stage:`Configure string @@ info [ "c" ])

let key_d = Key.create "d" Key.Arg.(opt_all int @@ info [ "d" ])
let empty = Key.empty_context
let ( & ) (k, v) c = Key.add_to_context k v c
let ( && ) x y = x & y & empty

let test_eval () =
  let context = (key_a, true) & (key_b, 0) && (key_c, Some "foo") in

let if_ = Key.if_ Key.(value key_a) "hello" "world" in
  let r = Key.eval context if_ in
  Alcotest.(check string) "if" "hello" r;

let match_1 =
    Key.match_ Key.(value key_b) (function 0 -> "hello" | _ -> "world")
  in
  let r = Key.eval context match_1 in
  Alcotest.(check string) "match 1" "hello" r;

let match_2 =
    Key.match_
      Key.(value key_c)
      (function Some "foo" -> "hello" | _ -> "world")
  in
  let r = Key.eval context match_2 in
  Alcotest.(check string) "match 1" "hello" r

let keys = Key.Set.of_list Key.[ v key_a; v key_b; v key_c; v key_d ]

let eval f keys argv =
  let argv = Array.of_list ("" :: argv) in
  match
    Cmdliner.Cmd.eval_value ~argv
      (Cmdliner.Cmd.v (Cmdliner.Cmd.info "keys") (f keys))
  with
  | Error _ -> Alcotest.fail "Error"
  | Ok (`Ok x) -> x
  | Ok `Version -> Alcotest.fail "version"
  | Ok `Help -> Alcotest.fail "help"

exception Error

let test_get () =
  let context =
    eval (Key.context ~with_required:false) keys [ "-a"; "-c"; "foo" ]
  in
  Alcotest.(check bool) "get a" true (Key.get context key_a);
  Alcotest.(check int) "get b" 0 (Key.get context key_b);
  Alcotest.(check (option string)) "get c" (Some "foo") (Key.get context key_c);

let context = eval (Key.context ~with_required:false) keys [ "-a" ] in
  Alcotest.(check (option string))
    "get c with_required:false" None (Key.get context key_c);

Alcotest.check_raises "get c with_required:true" Error (fun () ->
      try ignore (eval (Key.context ~with_required:true) keys [ "-a" ])
      with _ -> raise Error)

let test_find () =
  let context = eval (Key.context ~with_required:false) keys [] in
  Alcotest.(check (option bool)) "find a" None (Key.find context key_a);
  Alcotest.(check (option int)) "find b" None (Key.find context key_b);
  Alcotest.(check (option (option string)))
    "find c" None (Key.find context key_c)

let test_merge () =
  let cache = (key_a, true) && (key_c, Some "foo") in
  let cli = (key_a, false) && (key_b, 2) in
  let context = Key.merge_context ~default:cache cli in
  Alcotest.(check bool) "merge a" false (Key.get context key_a);
  Alcotest.(check int) "merge b" 2 (Key.get context key_b);
  Alcotest.(check (option string))
    "merge c" (Some "foo") (Key.get context key_c)

let key = Alcotest.testable Key.pp Key.equal

let test_equal () =
  let k1 = Key.(v @@ create "foo" Arg.(opt int 1 (info [ "foo" ]))) in
  let k2 = Key.(v @@ create "foo" Arg.(opt int 2 (info [ "foo" ]))) in
  let k3 = Key.(v @@ create "foo" Arg.(opt int 1 (info [ "foo" ]))) in
  Alcotest.(check @@ neg key) "different defaults" k1 k2;
  Alcotest.(check @@ key) "same defaults" k1 k3

let test_cmdliner () =
  let k1 = Key.(v @@ create "foo" Arg.(opt int 1 (info [ "foo" ]))) in
  let k2 = Key.(v @@ create "foo" Arg.(opt int 2 (info [ "foo" ]))) in
  let keys = Key.Set.of_list [ k1; k2 ] in
  let context = Key.context ~with_required:true keys in
  let _ = eval (fun x -> x) context [] in
  ()

let test_opt_all () =
  let context =
    eval
      (Key.context ~with_required:false)
      keys
      [ "-d"; "1"; "-d"; "2"; "-d"; "3" ]
  in
  Alcotest.(check (list int)) "get d" [ 1; 2; 3 ] (Key.get context key_d);
  let context = eval (Key.context ~with_required:false) keys [] in
  Alcotest.(check (list int)) "get d" [] (Key.get context key_d);
  match
    Cmdliner.Cmd.eval_value ~argv:[| ""; "-d" |]
      Cmdliner.(Cmd.v (Cmd.info "keys") (Key.context ~with_required:false keys))
  with
  | Ok (`Ok _ | `Help | `Version) ->
      Alcotest.failf "Invalid given command-line, eval must fail."
  | Error _ -> Alcotest.(check pass) "invalid opt-all argument" () ()

let suite =
  List.map
    (fun (n, f) -> (n, `Quick, f))
    [
      ("equal", test_equal);
      ("eval", test_eval);
      ("get", test_get);
      ("find", test_find);
      ("merge", test_merge);
      ("cmdliner", test_cmdliner);
      ("opt-all", test_opt_all);
    ]
070701000000ED000081A40000000000000000000000016491641000000029000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/test_key.mlival suite : unit Alcotest.test_case list
070701000000EE000081A4000000000000000000000001649164100000073E000000000000000000000000000000000000002C00000000mirage-4.4.0/test/functoria/test_package.mlopen Functoria

let w = Package.v ~min:"1.0" ~max:"2.0" "foo" ~scope:`Switch
let x = Package.v ~min:"1.0" ~max:"2.0" "foo"
let y = Package.v ~min:"0.9" ~max:"1.9" ~sublibs:[ "bar" ] "foo"
let z = Package.v "bar" ~sublibs:[ "foo" ] ~min:"42"

let xy =
  match Package.merge x y with
  | Some x -> x
  | None -> Alcotest.fail "xy should not be None"

let test_package_merge () =
  let () =
    match Package.merge x z with
    | Some _ -> Alcotest.fail "xz should be None"
    | None -> ()
  in
  Alcotest.(check (list string))
    "min" (Package.min_versions xy) [ "0.9"; "1.0" ];
  Alcotest.(check (list string))
    "max" (Package.max_versions xy) [ "1.9"; "2.0" ]

let test_package_pp () =
  let str = Fmt.to_to_string Package.pp in
  let str' = Fmt.to_to_string (Package.pp ~surround:"x") in
  Alcotest.(check string)
    "pp(x)" (str x) {|foo { ?monorepo & >= "1.0" & < "2.0" }|};
  Alcotest.(check string)
    "pp(xy)" (str xy)
    {|foo { ?monorepo & >= "0.9" & >= "1.0" & < "1.9" & < "2.0" }|};
  Alcotest.(check string) "pp(z)" (str z) {|bar { ?monorepo & >= "42" }|};
  Alcotest.(check string)
    "pp'(x)" (str' x) {|xfoox { ?monorepo & >= "1.0" & < "2.0" }|};
  Alcotest.(check string) "pp(w)" (str w) {|foo { >= "1.0" & < "2.0" }|};
  Alcotest.(check string) "key(x)" (Package.key x) "monorepo-foo";
  Alcotest.(check string) "key(w)" (Package.key w) "switch-foo"

let test_invalid_package_names () =
  let check_name_is_invalid name =
    Alcotest.check_raises name
      (Invalid_argument (Fmt.str "package name %S is invalid" name))
      (fun () -> Package.v name |> ignore)
  in
  check_name_is_invalid "bar.subfoo";
  check_name_is_invalid "000";
  check_name_is_invalid "é"

let suite =
  [
    ("merge", `Quick, test_package_merge);
    ("pp", `Quick, test_package_pp);
    ("invalid names", `Quick, test_invalid_package_names);
  ]
070701000000EF000081A40000000000000000000000016491641000000029000000000000000000000000000000000000002D00000000mirage-4.4.0/test/functoria/test_package.mlival suite : unit Alcotest.test_case list
070701000000F0000041ED0000000000000000000000036491641000000000000000000000000000000000000000000000002100000000mirage-4.4.0/test/functoria/tool070701000000F1000081A40000000000000000000000016491641000000021000000000000000000000000000000000000002B00000000mirage-4.4.0/test/functoria/tool/config.mllet () = F0.register "my-app" []
070701000000F2000081A4000000000000000000000001649164100000006E000000000000000000000000000000000000002600000000mirage-4.4.0/test/functoria/tool/dune(executable
 (name test)
 (libraries f0))

(cram
 (package functoria)
 (deps test.exe config.ml empty/empty))
070701000000F3000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/tool/empty070701000000F4000081A40000000000000000000000016491641000000000000000000000000000000000000000000000002D00000000mirage-4.4.0/test/functoria/tool/empty/empty070701000000F5000081A40000000000000000000000016491641000003575000000000000000000000000000000000000002700000000mirage-4.4.0/test/functoria/tool/run.tConfigure
  $ ./test.exe configure a b c 2> configure.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat configure.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Write to test/context (26 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> true
  * Run_cmd_cli '_build/default/./config.exe configure a b c --dry-run --context
                 ./test/context' (ok)

Build
  $ ./test.exe build a b c 2> build.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat build.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe build a b c --dry-run' (ok)

Clean
  $ ./test.exe clean a b c 2> clean.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)
  $(dune clean)

$ cat clean.err
  * Is_file? config.ml -> true
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe clean a b c --dry-run' (ok)
  * Get_var INSIDE_FUNCTORIA_TESTS -> <not set>
  * Run_cmd 'dune clean' (ok)
  * Ls ./ (11 entries)
  * Is_file? dune-project -> true
  * Read dune-project (47 bytes)
  * Rm dune-project (removed)
  * Rm test/context (no-op)
  * Is_file? dune -> true
  * Read dune (52 bytes)
  * Rm dune (removed)
  * Is_file? dune.build -> false
  * Rm dune.build (no-op)
  * Is_file? dune.config -> true
  * Read dune.config (132 bytes)
  * Rm dune.config (removed)

Query
  $ ./test.exe query a b c 2> query.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat query.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe query a b c --dry-run' (ok)

Describe
  $ ./test.exe describe a b c 2> describe.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat describe.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe describe a b c --dry-run' (ok)

Help
  $ ./test.exe help a b c 2> help.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat help.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe help a b c --dry-run' (ok)

Simple help
  $ ./test.exe help 2> simple-help.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat simple-help.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe help --dry-run' (ok)

Help configure
  $ ./test.exe help configure 2> configure.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat configure.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe help configure --dry-run' (ok)

Configure help
  $ ./test.exe configure help 2> configure-help.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat configure-help.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Write to test/context (25 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> true
  * Run_cmd_cli '_build/default/./config.exe configure help --dry-run --context
                 ./test/context' (ok)

Help no config
  $ ./test.exe help --file=empty/config.ml --man-format=plain 2> help-no-config.err
  NAME
         test - The test application builder
  
  SYNOPSIS
         test [COMMAND] …
  
  DESCRIPTION
         The test application builder. It glues together a set of libraries and
         configuration (e.g. network and storage) into a standalone unikernel
         or UNIX binary.
  
         Use test help <command> for more information on a specific command.
  
  COMMANDS
         build [OPTION]…
             Build a test application.
  
         clean [OPTION]…
             Clean the files produced by test for a given application.
  
         configure [OPTION]…
             Configure a test application.
  
         describe [OPTION]…
             Describe a test application.
  
         help [--man-format=FMT] [OPTION]… [TOPIC]
             Display help about test commands.
  
         query [OPTION]… [INFO]
             Query information about the test application.
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  $ cat help-no-config.err
  * Is_file? empty/config.ml -> false

Help no config with bad arguments
  $ ./test.exe help --file=empty/config.ml a b c 2> help-no-config-args.err

$ cat help-no-config-args.err
  test: too many arguments, don't know what to do with 'b', 'c'
  Usage: test help [--man-format=FMT] [OPTION]… [TOPIC]
  Try 'test help --help' or 'test --help' for more information.
  * Is_file? empty/config.ml -> false
  configuration file empty/config.ml missing
  (exit 1)

Build help no config with bad arguments
  $ ./test.exe build --help=plain --file=empty/config.ml a b c 2> build-help-no-config-args.err
  NAME
         test-build - Build a test application.
  
  SYNOPSIS
         test build [OPTION]…
  
  DESCRIPTION
         Build a test application.
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=test.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --vote=VOTE (absent=cat)
             Vote. 
  
         --warn-error=BOOL (absent=false)
             Enable -warn-error when compiling OCaml sources. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         test build exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  SEE ALSO
         test(1)
  
  $ cat build-help-no-config-args.err
  * Is_file? empty/config.ml -> false

Version configure
  $ ./test.exe configure --version a b c
  1.0~test

Ambiguous
  $ ./test.exe c a b c 2> ambiguous.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat ambiguous.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe c a b c --dry-run' (ok)

Default
  $ ./test.exe 2> default.err
  $(dune build ./config.exe --root . --workspace ./test/dune-workspace.config)

$ cat default.err
  * Is_file? config.ml -> true
  * Mkdir test (created)
  * Is_file? test/dune-workspace.config -> false
  * Write to test/dune-workspace.config (65 bytes)
  * Is_file? dune-project -> false
  * Write to dune-project (47 bytes)
  * Is_file? dune.config -> false
  * Write to dune.config (132 bytes)
  * Is_file? dune -> false
  * Write to dune (52 bytes)
  * Run_cmd 'dune build ./config.exe --root . --workspace
             ./test/dune-workspace.config' (ok)
  * Is_file? test/context -> false
  * Run_cmd_cli '_build/default/./config.exe --dry-run' (ok)

Parsing error in global arguments
  $ ./test.exe -o
  test: unknown option '-o'.
        unknown option '--dry-run'.
  Usage: test [COMMAND] …
  Try 'test --help' for more information.
  [1]

Parsing error in global arguments, with subcommand
  $ ./test.exe configure -o
  test: option '-o' needs an argument
  Usage: test configure [OPTION]…
  Try 'test configure --help' or 'test --help' for more information.
  [1]
070701000000F6000081A4000000000000000000000001649164100000005E000000000000000000000000000000000000002900000000mirage-4.4.0/test/functoria/tool/test.mllet () =
  let argv = Array.append Sys.argv [| "--dry-run" |] in
  F0.Tool.run_with_argv argv
070701000000F7000041ED00000000000000000000000A6491641000000000000000000000000000000000000000000000001900000000mirage-4.4.0/test/mirage070701000000F8000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002100000000mirage-4.4.0/test/mirage-runtime070701000000F9000081A40000000000000000000000016491641000000053000000000000000000000000000000000000002600000000mirage-4.4.0/test/mirage-runtime/dune(test
 (name test)
 (package mirage-runtime)
 (libraries mirage-runtime alcotest))
070701000000FA000081A400000000000000000000000164916410000000D5000000000000000000000000000000000000002900000000mirage-4.4.0/test/mirage-runtime/test.mllet t = { Mirage_runtime.name = "foo"; libraries = [ ("bar", "n/a") ] }
let test_info () = Alcotest.(check string) "name" t.name "foo"
let () = Alcotest.run "mirage" [ ("basic", [ ("info", `Quick, test_info) ]) ]
070701000000FB000081A4000000000000000000000001649164100000000C000000000000000000000000000000000000002A00000000mirage-4.4.0/test/mirage-runtime/test.mli(* empty *)
070701000000FC000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000002000000000mirage-4.4.0/test/mirage/action070701000000FD000081A40000000000000000000000016491641000000043000000000000000000000000000000000000002500000000mirage-4.4.0/test/mirage/action/dune(test
 (name test)
 (package mirage)
 (libraries alcotest mirage))
070701000000FE000081A40000000000000000000000016491641000000086000000000000000000000000000000000000002E00000000mirage-4.4.0/test/mirage/action/test.expectedunix
====

hvt
===

Write to manifest.json (mode: default, purpose: Solo5 application manifest file)
Write to manifest.ml (0 bytes)

070701000000FF000081A4000000000000000000000001649164100000033D000000000000000000000000000000000000002800000000mirage-4.4.0/test/mirage/action/test.mlopen Mirage

let context_singleton key value =
  let info = Cmdliner.Cmd.info "" in
  let term =
    Key.context ~with_required:false (Key.Set.singleton @@ Key.v key)
  in
  let argv = [| "mirage"; "--target"; value |] in
  match Cmdliner.Cmd.eval_value ~argv (Cmdliner.Cmd.v info term) with
  | Ok (`Ok x) -> x
  | _ -> assert false

let print_banner s =
  print_endline s;
  print_endline @@ String.make (String.length s) '=';
  print_newline ()

let info context =
  Info.v ~packages:[] ~keys:[] ~build_cmd:"mirage build" ~context ~src:`None
    "NAME"

let test target =
  print_banner target;
  let context = context_singleton Key.target target in
  let env = Action.env ~files:(`Files []) () in
  Action.dry_run_trace ~env @@ Project.configure @@ info context;
  print_newline ()

let () = List.iter test [ "unix"; "hvt" ]
07070100000100000081A40000000000000000000000016491641000000043000000000000000000000000000000000000001E00000000mirage-4.4.0/test/mirage/dune(test
 (name test)
 (package mirage)
 (libraries mirage alcotest))
07070100000101000041ED0000000000000000000000026491641000000000000000000000000000000000000000000000001E00000000mirage-4.4.0/test/mirage/help07070100000102000081A40000000000000000000000016491641000002729000000000000000000000000000000000000002600000000mirage-4.4.0/test/mirage/help/build.t  $ export MIRAGE_DEFAULT_TARGET=unix

Help build --man-format=plain
  $ ./config.exe help build --man-format=plain | tee d1
  NAME
         mirage-build - Build a mirage application.
  
  SYNOPSIS
         mirage build [OPTION]…
  
  DESCRIPTION
         Build a mirage application.
  
  UNIKERNEL PARAMETERS
         -l LEVEL, --logs=LEVEL (absent MIRAGE_LOGS env)
             Be more or less verbose. LEVEL must be of the form
             *:info,foo:debug means that that the log threshold is set to info
             for every log sources but the foo which is set to debug. 
  
  OCAML RUNTIME PARAMETERS
         --allocation-policy=ALLOCATION (absent=next-fit)
             The policy used for allocating in the OCaml heap. Possible values
             are: next-fit, first-fit, best-fit. Best-fit is only supported
             since OCaml 4.10. 
  
         --backtrace=BOOL (absent=true)
             Trigger the printing of a stack backtrace when an uncaught
             exception aborts the unikernel. 
  
         --custom-major-ratio=CUSTOM MAJOR RATIO
             Target ratio of floating garbage to major heap size for
             out-of-heap memory held by custom values. Default: 44. 
  
         --custom-minor-max-size=CUSTOM MINOR MAX SIZE
             Maximum amount of out-of-heap memory for each custom value
             allocated in the minor heap. Default: 8192 bytes. 
  
         --custom-minor-ratio=CUSTOM MINOR RATIO
             Bound on floating garbage for out-of-heap memory held by custom
             values in the minor heap. Default: 100. 
  
         --gc-verbosity=VERBOSITY
             GC messages on standard error output. Sum of flags. Check GC
             module documentation for details. 
  
         --gc-window-size=WINDOW SIZE
             The size of the window used by the major GC for smoothing out
             variations in its workload. Between 1 adn 50, default: 1. 
  
         --major-heap-increment=MAJOR INCREMENT
             The size increment for the major heap (in words). If less than or
             equal 1000, it is a percentage of the current heap size. If more
             than 1000, it is a fixed number of words. Default: 15. 
  
         --max-space-overhead=MAX SPACE OVERHEAD
             Heap compaction is triggered when the estimated amount of wasted
             memory exceeds this (percentage of live data). If above 1000000,
             compaction is never triggered. Default: 500. 
  
         --minor-heap-size=MINOR SIZE
             The size of the minor heap (in words). Default: 256k. 
  
         --randomize-hashtables=BOOL (absent=true)
             Turn on randomization of all hash tables by default. 
  
         --space-overhead=SPACE OVERHEAD
             The percentage of live data of wasted memory, due to GC does not
             immediately collect unreachable blocks. The major GC speed is
             computed from this parameter, it will work more if smaller.
             Default: 80. 
  
  MIRAGE PARAMETERS
         -t TARGET, --target=TARGET (absent=unix or MODE env)
             Target platform to compile the unikernel for. Valid values are:
             xen, qubes, unix, macosx, virtio, hvt, spt, muen, genode. 
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=mirage.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         mirage build exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of build:
  
         MIRAGE_LOGS
             See option --logs.
  
         MODE
             See option --target.
  
  SEE ALSO
         mirage(1)

Help build --help=plain
  $ ./config.exe build --help=plain | tee d2
  NAME
         mirage-build - Build a mirage application.
  
  SYNOPSIS
         mirage build [OPTION]…
  
  DESCRIPTION
         Build a mirage application.
  
  UNIKERNEL PARAMETERS
         -l LEVEL, --logs=LEVEL (absent MIRAGE_LOGS env)
             Be more or less verbose. LEVEL must be of the form
             *:info,foo:debug means that that the log threshold is set to info
             for every log sources but the foo which is set to debug. 
  
  OCAML RUNTIME PARAMETERS
         --allocation-policy=ALLOCATION (absent=next-fit)
             The policy used for allocating in the OCaml heap. Possible values
             are: next-fit, first-fit, best-fit. Best-fit is only supported
             since OCaml 4.10. 
  
         --backtrace=BOOL (absent=true)
             Trigger the printing of a stack backtrace when an uncaught
             exception aborts the unikernel. 
  
         --custom-major-ratio=CUSTOM MAJOR RATIO
             Target ratio of floating garbage to major heap size for
             out-of-heap memory held by custom values. Default: 44. 
  
         --custom-minor-max-size=CUSTOM MINOR MAX SIZE
             Maximum amount of out-of-heap memory for each custom value
             allocated in the minor heap. Default: 8192 bytes. 
  
         --custom-minor-ratio=CUSTOM MINOR RATIO
             Bound on floating garbage for out-of-heap memory held by custom
             values in the minor heap. Default: 100. 
  
         --gc-verbosity=VERBOSITY
             GC messages on standard error output. Sum of flags. Check GC
             module documentation for details. 
  
         --gc-window-size=WINDOW SIZE
             The size of the window used by the major GC for smoothing out
             variations in its workload. Between 1 adn 50, default: 1. 
  
         --major-heap-increment=MAJOR INCREMENT
             The size increment for the major heap (in words). If less than or
             equal 1000, it is a percentage of the current heap size. If more
             than 1000, it is a fixed number of words. Default: 15. 
  
         --max-space-overhead=MAX SPACE OVERHEAD
             Heap compaction is triggered when the estimated amount of wasted
             memory exceeds this (percentage of live data). If above 1000000,
             compaction is never triggered. Default: 500. 
  
         --minor-heap-size=MINOR SIZE
             The size of the minor heap (in words). Default: 256k. 
  
         --randomize-hashtables=BOOL (absent=true)
             Turn on randomization of all hash tables by default. 
  
         --space-overhead=SPACE OVERHEAD
             The percentage of live data of wasted memory, due to GC does not
             immediately collect unreachable blocks. The major GC speed is
             computed from this parameter, it will work more if smaller.
             Default: 80. 
  
  MIRAGE PARAMETERS
         -t TARGET, --target=TARGET (absent=unix or MODE env)
             Target platform to compile the unikernel for. Valid values are:
             xen, qubes, unix, macosx, virtio, hvt, spt, muen, genode. 
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=mirage.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         mirage build exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of build:
  
         MIRAGE_LOGS
             See option --logs.
  
         MODE
             See option --target.
  
  SEE ALSO
         mirage(1)

No difference
  $ diff d1 d2
07070100000103000081A400000000000000000000000164916410000027BB000000000000000000000000000000000000002600000000mirage-4.4.0/test/mirage/help/clean.t  $ export MIRAGE_DEFAULT_TARGET=unix

Help clean --man-format=plain
  $ ./config.exe help clean --man-format=plain | tee d1
  NAME
         mirage-clean - Clean the files produced by mirage for a given
         application.
  
  SYNOPSIS
         mirage clean [OPTION]…
  
  DESCRIPTION
         Clean the files produced by mirage for a given application.
  
  UNIKERNEL PARAMETERS
         -l LEVEL, --logs=LEVEL (absent MIRAGE_LOGS env)
             Be more or less verbose. LEVEL must be of the form
             *:info,foo:debug means that that the log threshold is set to info
             for every log sources but the foo which is set to debug. 
  
  OCAML RUNTIME PARAMETERS
         --allocation-policy=ALLOCATION (absent=next-fit)
             The policy used for allocating in the OCaml heap. Possible values
             are: next-fit, first-fit, best-fit. Best-fit is only supported
             since OCaml 4.10. 
  
         --backtrace=BOOL (absent=true)
             Trigger the printing of a stack backtrace when an uncaught
             exception aborts the unikernel. 
  
         --custom-major-ratio=CUSTOM MAJOR RATIO
             Target ratio of floating garbage to major heap size for
             out-of-heap memory held by custom values. Default: 44. 
  
         --custom-minor-max-size=CUSTOM MINOR MAX SIZE
             Maximum amount of out-of-heap memory for each custom value
             allocated in the minor heap. Default: 8192 bytes. 
  
         --custom-minor-ratio=CUSTOM MINOR RATIO
             Bound on floating garbage for out-of-heap memory held by custom
             values in the minor heap. Default: 100. 
  
         --gc-verbosity=VERBOSITY
             GC messages on standard error output. Sum of flags. Check GC
             module documentation for details. 
  
         --gc-window-size=WINDOW SIZE
             The size of the window used by the major GC for smoothing out
             variations in its workload. Between 1 adn 50, default: 1. 
  
         --major-heap-increment=MAJOR INCREMENT
             The size increment for the major heap (in words). If less than or
             equal 1000, it is a percentage of the current heap size. If more
             than 1000, it is a fixed number of words. Default: 15. 
  
         --max-space-overhead=MAX SPACE OVERHEAD
             Heap compaction is triggered when the estimated amount of wasted
             memory exceeds this (percentage of live data). If above 1000000,
             compaction is never triggered. Default: 500. 
  
         --minor-heap-size=MINOR SIZE
             The size of the minor heap (in words). Default: 256k. 
  
         --randomize-hashtables=BOOL (absent=true)
             Turn on randomization of all hash tables by default. 
  
         --space-overhead=SPACE OVERHEAD
             The percentage of live data of wasted memory, due to GC does not
             immediately collect unreachable blocks. The major GC speed is
             computed from this parameter, it will work more if smaller.
             Default: 80. 
  
  MIRAGE PARAMETERS
         -t TARGET, --target=TARGET (absent=unix or MODE env)
             Target platform to compile the unikernel for. Valid values are:
             xen, qubes, unix, macosx, virtio, hvt, spt, muen, genode. 
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=mirage.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         mirage clean exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of clean:
  
         MIRAGE_LOGS
             See option --logs.
  
         MODE
             See option --target.
  
  SEE ALSO
         mirage(1)

Help clean --help=plain
  $ ./config.exe clean --help=plain | tee d2
  NAME
         mirage-clean - Clean the files produced by mirage for a given
         application.
  
  SYNOPSIS
         mirage clean [OPTION]…
  
  DESCRIPTION
         Clean the files produced by mirage for a given application.
  
  UNIKERNEL PARAMETERS
         -l LEVEL, --logs=LEVEL (absent MIRAGE_LOGS env)
             Be more or less verbose. LEVEL must be of the form
             *:info,foo:debug means that that the log threshold is set to info
             for every log sources but the foo which is set to debug. 
  
  OCAML RUNTIME PARAMETERS
         --allocation-policy=ALLOCATION (absent=next-fit)
             The policy used for allocating in the OCaml heap. Possible values
             are: next-fit, first-fit, best-fit. Best-fit is only supported
             since OCaml 4.10. 
  
         --backtrace=BOOL (absent=true)
             Trigger the printing of a stack backtrace when an uncaught
             exception aborts the unikernel. 
  
         --custom-major-ratio=CUSTOM MAJOR RATIO
             Target ratio of floating garbage to major heap size for
             out-of-heap memory held by custom values. Default: 44. 
  
         --custom-minor-max-size=CUSTOM MINOR MAX SIZE
             Maximum amount of out-of-heap memory for each custom value
             allocated in the minor heap. Default: 8192 bytes. 
  
         --custom-minor-ratio=CUSTOM MINOR RATIO
             Bound on floating garbage for out-of-heap memory held by custom
             values in the minor heap. Default: 100. 
  
         --gc-verbosity=VERBOSITY
             GC messages on standard error output. Sum of flags. Check GC
             module documentation for details. 
  
         --gc-window-size=WINDOW SIZE
             The size of the window used by the major GC for smoothing out
             variations in its workload. Between 1 adn 50, default: 1. 
  
         --major-heap-increment=MAJOR INCREMENT
             The size increment for the major heap (in words). If less than or
             equal 1000, it is a percentage of the current heap size. If more
             than 1000, it is a fixed number of words. Default: 15. 
  
         --max-space-overhead=MAX SPACE OVERHEAD
             Heap compaction is triggered when the estimated amount of wasted
             memory exceeds this (percentage of live data). If above 1000000,
             compaction is never triggered. Default: 500. 
  
         --minor-heap-size=MINOR SIZE
             The size of the minor heap (in words). Default: 256k. 
  
         --randomize-hashtables=BOOL (absent=true)
             Turn on randomization of all hash tables by default. 
  
         --space-overhead=SPACE OVERHEAD
             The percentage of live data of wasted memory, due to GC does not
             immediately collect unreachable blocks. The major GC speed is
             computed from this parameter, it will work more if smaller.
             Default: 80. 
  
  MIRAGE PARAMETERS
         -t TARGET, --target=TARGET (absent=unix or MODE env)
             Target platform to compile the unikernel for. Valid values are:
             xen, qubes, unix, macosx, virtio, hvt, spt, muen, genode. 
  
  CONFIGURE OPTIONS
         --context-file=FILE (absent=mirage.context)
             The context file to use.
  
         --dry-run
             Display I/O actions instead of executing them.
  
         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
             The configuration file to use.
  
         -o FILE, --output=FILE
             Name of the output file.
  
  APPLICATION OPTIONS
         --hello=VAL (absent=Hello World!)
             How to say hello. 
  
  COMMON OPTIONS
         --color=WHEN (absent=auto)
             Colorize the output. WHEN must be one of auto, always or never.
  
         --help[=FMT] (default=auto)
             Show this help in format FMT. The value FMT must be one of auto,
             pager, groff or plain. With auto, the format is pager or plain
             whenever the TERM env var is dumb or undefined.
  
         -q, --quiet
             Be quiet. Takes over -v and --verbosity.
  
         -v, --verbose
             Increase verbosity. Repeatable, but more than twice does not bring
             more.
  
         --verbosity=LEVEL (absent=warning)
             Be more or less verbose. LEVEL must be one of quiet, error,
             warning, info or debug. Takes over -v.
  
         --version
             Show version information.
  
  EXIT STATUS
         mirage clean exits with:
  
         0   on success.
  
         123 on indiscriminate errors reported on standard error.
  
         124 on command line parsing errors.
  
         125 on unexpected internal errors (bugs).
  
  ENVIRONMENT
         These environment variables affect the execution of clean:
  
         MIRAGE_LOGS
             See option --logs.
  
         MODE
             See option --target.
  
  SEE ALSO
         mirage(1)

No difference
  $ diff d1 d2
07070100000104000081A400000000000000000000000164916410000000F6000000000000000000000000000000000000002800000000mirage-4.4.0/test/mirage/help/config.mlopen Mirage

let main = main "App" (job @-> job)

let key =
  let doc = Key.Arg.info ~doc:"How to say hello." [ "hello" ] in
  Key.(create "hello" Arg.(opt string "Hello World!" doc))

let () = register ~keys:[ Key.v key ] "noop" [ main $ noop ]
07070100000105000081A400000000000000000000000164916410000014B1000000000000000000000000000000000000003600000000mirage-4.4.0/test/mirage/help/configure-help.expectedNAME
       mirage-configure - Configure a mirage application.

SYNOPSIS
       mirage configure [OPTION]...

DESCRIPTION
       The configure command initializes a fresh mirage application.

UNIKERNEL PARAMETERS
       -l LEVEL, --logs=LEVEL (absent MIRAGE_LOGS env)
           Be more or less verbose. LEVEL must be of the form
           *:info,foo:debug means that that the log threshold is set to info
           for every log sources but the foo which is set to debug.

OCAML RUNTIME PARAMETERS
       --allocation-policy=ALLOCATION (absent=next-fit)
           The policy used for allocating in the OCaml heap. Possible values
           are: next-fit, first-fit, best-fit. Best-fit is only supported
           since OCaml 4.10.

--backtrace=BOOL (absent=true)
           Trigger the printing of a stack backtrace when an uncaught
           exception aborts the unikernel.

--custom-major-ratio=CUSTOM MAJOR RATIO
           Target ratio of floating garbage to major heap size for
           out-of-heap memory held by custom values. Default: 44.

--custom-minor-max-size=CUSTOM MINOR MAX SIZE
           Maximum amount of out-of-heap memory for each custom value
           allocated in the minor heap. Default: 8192 bytes.

--custom-minor-ratio=CUSTOM MINOR RATIO
           Bound on floating garbage for out-of-heap memory held by custom
           values in the minor heap. Default: 100.

--gc-verbosity=VERBOSITY
           GC messages on standard error output. Sum of flags. Check GC
           module documentation for details.

--gc-window-size=WINDOW SIZE
           The size of the window used by the major GC for smoothing out
           variations in its workload. Between 1 adn 50, default: 1.

--major-heap-increment=MAJOR INCREMENT
           The size increment for the major heap (in words). If less than or
           equal 1000, it is a percentage of the current heap size. If more
           than 1000, it is a fixed number of words. Default: 15.

--max-space-overhead=MAX SPACE OVERHEAD
           Heap compaction is triggered when the estimated amount of wasted
           memory exceeds this (percentage of live data). If above 1000000,
           compaction is never triggered. Default: 500.

--minor-heap-size=MINOR SIZE
           The size of the minor heap (in words). Default: 256k.

--randomize-hashtables=BOOL (absent=true)
           Turn on randomization of all hash tables by default.

--space-overhead=SPACE OVERHEAD
           The percentage of live data of wasted memory, due to GC does not
           immediately collect unreachable blocks. The major GC speed is
           computed from this parameter, it will work more if smaller.
           Default: 80.

MIRAGE PARAMETERS
       -g  Enables target-specific support for debugging. Supported targets:
           hvt (compiles solo5-hvt with GDB server support).

-t TARGET, --target=TARGET (absent=unix or MODE env)
           Target platform to compile the unikernel for. Valid values are:
           xen, qubes, unix, macosx, virtio, hvt, spt, muen, genode.

--warn-error
           Enable -warn-error when compiling OCaml sources.

CONFIGURE OPTIONS
       --context-file=FILE (absent=mirage.context)
           The context file to use.

--depext
           Enable call to `opam depext' in the project Makefile.

--dry-run
           Display I/O actions instead of executing them.

--extra-repo[=URL] (default=)
       (absent=https://github.com/mirage/opam-overlays.git or
       MIRAGE_EXTRA_REPO env)
           Additional opam-repository to use when using `opam monorepo lock'
           to gather local sources. Default:
           https://github.com/mirage/opam-overlays.git.Use the option without
           any content to disable it.

-f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
           The configuration file to use.

--no-depext
           Disable call to `opam depext' in the project Makefile.

-o FILE, --output=FILE
           Name of the output file.

APPLICATION OPTIONS
       --hello=VAL (absent=Hello World!)
           How to say hello.

OPTIONS
       --help[=FMT] (default=auto)
           Show this help in format FMT. The value FMT must be one of `auto',
           `pager', `groff' or `plain'. With `auto', the format is `pager` or
           `plain' whenever the TERM env var is `dumb' or undefined.

--version
           Show version information.

COMMON OPTIONS
       --color=WHEN (absent=auto)
           Colorize the output. WHEN must be one of `auto', `always' or
           `never'.

-q, --quiet
           Be quiet. Takes over -v and --verbosity.

-v, --verbose
           Increase verbosity. Repeatable, but more than twice does not bring
           more.

--verbosity=LEVEL (absent=warning)
           Be more or less verbose. LEVEL must be one of `quiet', `error',
           `warning', `info' or `debug'. Takes over -v.

ENVIRONMENT
       These environment variables affect the execution of configure:

MIRAGE_EXTRA_REPO
           See option --extra-repo.

MIRAGE_LOGS
           See option --logs.

MODE
           See option --target.

07070100000106000081A400000000000000000000000164916410000014B1000000000000000000000000000000000000003800000000mirage-4.4.0/test/mirage/help/configure-o-help.expectedNAME
       mirage-configure - Configure a mirage application.