1052 lines
36 KiB
OCaml
1052 lines
36 KiB
OCaml
|
|
(*
|
||
|
|
* 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 v4.10.3} *)
|
||
|
|
|
||
|
|
(** {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 Devices.Key
|
||
|
|
(** @inline *)
|
||
|
|
end
|
||
|
|
|
||
|
|
(** Configuration keys. *)
|
||
|
|
module Runtime_arg : module type of struct
|
||
|
|
include Devices.Runtime_arg
|
||
|
|
(** @inline *)
|
||
|
|
end
|
||
|
|
|
||
|
|
(** {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 Sleep} *)
|
||
|
|
|
||
|
|
type sleep
|
||
|
|
(** Abstract type for sleep. *)
|
||
|
|
|
||
|
|
val sleep : sleep typ
|
||
|
|
(** Implementations of the [Mirage_sleep] signature. *)
|
||
|
|
|
||
|
|
val default_sleep : sleep impl
|
||
|
|
(** The default sleep implementation. *)
|
||
|
|
|
||
|
|
val no_sleep : sleep impl
|
||
|
|
(** Disables the sleep implementation. *)
|
||
|
|
|
||
|
|
(** {2 Posix time} *)
|
||
|
|
|
||
|
|
type ptime
|
||
|
|
(** Abstract type for POSIX time. *)
|
||
|
|
|
||
|
|
val ptime : ptime typ
|
||
|
|
(** Implementations of the [Mirage_ptime] signature. *)
|
||
|
|
|
||
|
|
val default_ptime : ptime impl
|
||
|
|
(** The default mirage-ptime implementation. *)
|
||
|
|
|
||
|
|
val no_ptime : ptime impl
|
||
|
|
(** Disables the mirage-ptime implementation. *)
|
||
|
|
|
||
|
|
val mock_ptime : ptime impl
|
||
|
|
(** A ptime mock implementation where you can manually set the clock via
|
||
|
|
[Mirage_ptime_set]. *)
|
||
|
|
|
||
|
|
(** {2 Monotonic time} *)
|
||
|
|
|
||
|
|
type mtime
|
||
|
|
(** Abstract type for monotonic time *)
|
||
|
|
|
||
|
|
val mtime : mtime typ
|
||
|
|
(** Implementations of the [Mirage_mtime] signature. *)
|
||
|
|
|
||
|
|
val default_mtime : mtime impl
|
||
|
|
(** The default mirage-mtime implementation. *)
|
||
|
|
|
||
|
|
val no_mtime : mtime impl
|
||
|
|
(** Disables the mirage-mtime implementation. *)
|
||
|
|
|
||
|
|
val mock_mtime : mtime impl
|
||
|
|
(** A mtime mock implementation where you can manually set the clock via
|
||
|
|
[Mirage_mtime_set]. *)
|
||
|
|
|
||
|
|
(** {2 Log reporters} *)
|
||
|
|
|
||
|
|
type reporter
|
||
|
|
(** The type for log reporters. *)
|
||
|
|
|
||
|
|
val reporter : reporter typ
|
||
|
|
(** Implementation of the log {!type:reporter} type. *)
|
||
|
|
|
||
|
|
val default_reporter : ?level:Logs.level option -> unit -> reporter impl
|
||
|
|
(** [default_reporter ?level ()] is the log reporter that prints log messages to
|
||
|
|
the console, with a timestamp as prefix. [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_crypto_rng_mirage2] 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 no_random : random impl
|
||
|
|
(** Disables the random device. *)
|
||
|
|
|
||
|
|
(** {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 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, a new {!Key.kv_ro} is created with the [group]
|
||
|
|
argument. *)
|
||
|
|
|
||
|
|
val docteur :
|
||
|
|
?mode:[ `Fast | `Light ] ->
|
||
|
|
?name:string key ->
|
||
|
|
?output:string key ->
|
||
|
|
?analyze:bool runtime_arg ->
|
||
|
|
?branch:string ->
|
||
|
|
?extra_deps:string list ->
|
||
|
|
string ->
|
||
|
|
kv_ro impl
|
||
|
|
(** [docteur ?mode ?name ?output ?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,...}
|
||
|
|
]}
|
||
|
|
|
||
|
|
The user is able to specify the name of the block device (default to
|
||
|
|
["docteur"]). The user can also specify the output of [docteur.make], the
|
||
|
|
tool which generate the image (default to ["disk.img"]).
|
||
|
|
|
||
|
|
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 : unit -> kv_rw impl
|
||
|
|
(** An in-memory key-value store using [mirage-kv-mem]. *)
|
||
|
|
|
||
|
|
val chamelon : program_block_size:int runtime_arg -> 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}.
|
||
|
|
|
||
|
|
[unikernel.ml]:
|
||
|
|
{[
|
||
|
|
open Cmdliner
|
||
|
|
|
||
|
|
let program_block_size =
|
||
|
|
Arg.(value & opt int 16 & info [ "program-block-size" ])
|
||
|
|
]}
|
||
|
|
[config.ml]:
|
||
|
|
{[
|
||
|
|
let db =
|
||
|
|
let program_block_size =
|
||
|
|
Runtime_arg.create ~pos:__POS__ "Unikernel.program_block_size"
|
||
|
|
in
|
||
|
|
let block = block_of_file "db" in
|
||
|
|
chamelon ~program_block_size block
|
||
|
|
in
|
||
|
|
]}
|
||
|
|
|
||
|
|
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 : 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 runtime_arg -> 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
|
||
|
|
]}
|
||
|
|
|
||
|
|
Accept the key as a runtime argument, in [unikernel.ml]:
|
||
|
|
{[
|
||
|
|
open Cmdliner
|
||
|
|
|
||
|
|
let aes_ccm_key =
|
||
|
|
let doc = "The key of the block device (hex formatted)" in
|
||
|
|
Arg.(required & opt (some string) None & info ~doc [ "aes-ccm-key" ])
|
||
|
|
]}
|
||
|
|
|
||
|
|
Then, into you [config.ml], you just need to compose your block device with
|
||
|
|
[ccm_block]:
|
||
|
|
|
||
|
|
{[
|
||
|
|
let encrypted_block =
|
||
|
|
let aes_ccm_key =
|
||
|
|
Runtime_arg.create ~pos:__POS__ "Unikernel.aes_ccm_key"
|
||
|
|
in
|
||
|
|
let block = block_of_file "edb"
|
||
|
|
ccm_block aes_ccm_key block
|
||
|
|
in
|
||
|
|
]}
|
||
|
|
|
||
|
|
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 {!Runtime_arg.interface} key. *)
|
||
|
|
|
||
|
|
(** {2 Ethernet configuration} *)
|
||
|
|
|
||
|
|
type ethernet
|
||
|
|
|
||
|
|
val ethernet : ethernet typ
|
||
|
|
(** Implementations of the [Ethernet.S] signature. *)
|
||
|
|
|
||
|
|
val etif : network impl -> ethernet impl
|
||
|
|
[@@ocaml.deprecated "Deprecated. Use [ethif] instead."]
|
||
|
|
(** [etif net] is the ethernet layer on [net]. *)
|
||
|
|
|
||
|
|
val ethif : network impl -> ethernet impl
|
||
|
|
(** [ethif net] is the ethernet layer on [net]. *)
|
||
|
|
|
||
|
|
(** {2 ARP configuration} *)
|
||
|
|
|
||
|
|
type arpv4
|
||
|
|
|
||
|
|
val arpv4 : arpv4 typ
|
||
|
|
(** Implementation of the [Arp.S] signature. *)
|
||
|
|
|
||
|
|
val arp : 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. *)
|
||
|
|
|
||
|
|
val ipv4_of_dhcp : network impl -> ethernet impl -> arpv4 impl -> ipv4 impl
|
||
|
|
(** Configure the interface via DHCP *)
|
||
|
|
|
||
|
|
val create_ipv4 : ?group:string -> ethernet impl -> arpv4 impl -> ipv4 impl
|
||
|
|
(** Use an IPv4 address Exposes the keys {!Runtime_arg.V4.network} and
|
||
|
|
{!Runtime_arg.V4.gateway}. *)
|
||
|
|
|
||
|
|
val ipv4_qubes : 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 : ?group:string -> network impl -> ethernet impl -> ipv6 impl
|
||
|
|
(** Use an IPv6 address. Exposes the keys {!Runtime_arg.V6.network},
|
||
|
|
{!Runtime_arg.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 : 'a ip impl -> 'a udp 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 : 'a ip impl -> 'a tcp 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 :
|
||
|
|
?group:string ->
|
||
|
|
?tcp:tcpv4v6 impl ->
|
||
|
|
network impl ->
|
||
|
|
ethernet impl ->
|
||
|
|
arpv4 impl ->
|
||
|
|
ipv4 impl ->
|
||
|
|
ipv6 impl ->
|
||
|
|
stackv4v6 impl
|
||
|
|
(** Direct network stack with given ip. *)
|
||
|
|
|
||
|
|
val generic_stackv4v6 :
|
||
|
|
?group:string ->
|
||
|
|
?dhcp_key:bool value ->
|
||
|
|
?net_key:[ `OCaml | `Host ] option value ->
|
||
|
|
?ipv4_network:Ipaddr.V4.Prefix.t ->
|
||
|
|
?ipv4_gateway:Ipaddr.V4.t ->
|
||
|
|
?ipv6_network:Ipaddr.V6.Prefix.t ->
|
||
|
|
?ipv6_gateway:Ipaddr.V6.t ->
|
||
|
|
?tcp:tcpv4v6 impl ->
|
||
|
|
network impl ->
|
||
|
|
stackv4v6 impl
|
||
|
|
(** Generic stack using a [net] keys: {!Key.net}.
|
||
|
|
|
||
|
|
- If [net] = [host] then the Unix sockets API is used;
|
||
|
|
- Else, if [qubes], a special IPv4 stack using the QubesDB is used;
|
||
|
|
- Else, if [dhcp] is true, a DHCP client is used for the IPv4 address;
|
||
|
|
- Else, an IP stack with a static IP address 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 -> stackv4v6 impl -> resolver impl
|
||
|
|
val resolver_unix_system : resolver impl
|
||
|
|
|
||
|
|
(** {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 :
|
||
|
|
?group:string ->
|
||
|
|
?aaaa_timeout:int64 ->
|
||
|
|
?connect_delay:int64 ->
|
||
|
|
?connect_timeout:int64 ->
|
||
|
|
?resolve_timeout:int64 ->
|
||
|
|
?resolve_retries:int ->
|
||
|
|
?timer_interval:int64 ->
|
||
|
|
stackv4v6 impl ->
|
||
|
|
happy_eyeballs impl
|
||
|
|
(** [generic_happy_eyeballs stackv4v6] creates a new happy-eyeballs value which
|
||
|
|
is able to connect to a remote host and allocate finally a connected
|
||
|
|
{i flow} from the given network implementation [stackv4v6]. However, if you
|
||
|
|
want to resolve (DNS resolution) & connect to a remote host, you must
|
||
|
|
complete your unikernel with a {!val:generic_dns_client} which upgrade the
|
||
|
|
happy-eyeballs stack with a DNS resolution stack.
|
||
|
|
|
||
|
|
This device has several optional arguments of keys for timeouts specified in
|
||
|
|
nanoseconds. *)
|
||
|
|
|
||
|
|
(** {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 :
|
||
|
|
?group:string ->
|
||
|
|
?timeout:int64 ->
|
||
|
|
?nameservers:string list ->
|
||
|
|
?cache_size:int ->
|
||
|
|
stackv4v6 impl ->
|
||
|
|
happy_eyeballs impl ->
|
||
|
|
dns_client impl
|
||
|
|
(** [generic_dns_client stackv4v6 happy_eyeballs] creates a new DNS value which
|
||
|
|
is able to resolve domain-name from [nameservers]. It requires a network and
|
||
|
|
happy-eyeballs 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 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_runtime.logs} key. The functionality is provided
|
||
|
|
by the [logs-syslog] package. *)
|
||
|
|
|
||
|
|
type syslog
|
||
|
|
(** The type for syslog *)
|
||
|
|
|
||
|
|
val syslog : syslog typ
|
||
|
|
(** Implementation of the {!type:syslog} type. *)
|
||
|
|
|
||
|
|
val syslog_udp : ?group:string -> stackv4v6 impl -> syslog impl
|
||
|
|
(** Emit log messages via UDP. *)
|
||
|
|
|
||
|
|
val syslog_tcp : ?group:string -> stackv4v6 impl -> syslog impl
|
||
|
|
(** Emit log messages via TCP. *)
|
||
|
|
|
||
|
|
val syslog_tls : ?group:string -> stackv4v6 impl -> kv_ro impl -> syslog impl
|
||
|
|
(** Emit log messages via TLS, using the credentials (private key, certificate,
|
||
|
|
trust anchor) provided in the KV_RO. *)
|
||
|
|
|
||
|
|
(** {2 Monitoring} *)
|
||
|
|
val monitoring : ?group:string -> stackv4v6 impl -> job impl
|
||
|
|
(** Monitor metrics to a remote Influx host, also allow adjustments to log
|
||
|
|
sources and levels. The provided [stack] should not be publicly reachable.
|
||
|
|
*)
|
||
|
|
|
||
|
|
(** {2 Conduit configuration} *)
|
||
|
|
|
||
|
|
type conduit
|
||
|
|
|
||
|
|
val conduit : conduit typ
|
||
|
|
val conduit_direct : ?tls:bool -> 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 -> happy_eyeballs impl -> dns_client impl -> mimic impl
|
||
|
|
(** [mimic_happy_eyeballs stackv4v6 happy_eyeballs dns_client] 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} its DNS client.
|
||
|
|
|
||
|
|
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 : 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 runtime_arg -> 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}
|
||
|
|
|
||
|
|
{[
|
||
|
|
open Cmdliner
|
||
|
|
|
||
|
|
let port =
|
||
|
|
let doc = "Port of the HTTP service." in
|
||
|
|
Arg.(value & opt int 8080 & info [ "p"; "port" ])
|
||
|
|
|
||
|
|
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 port =
|
||
|
|
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 = Runtime_arg.create ~pos:__POS__ "Unikernel.port"
|
||
|
|
let main = main "Unikernel.Make" (http_server @-> job)
|
||
|
|
let stackv4v6 = generic_stackv4v6 default_network
|
||
|
|
let http_server = paf_server ~port (tcpv4v6_of_stackv4v6 stackv4v6)
|
||
|
|
|
||
|
|
let () =
|
||
|
|
register "main"
|
||
|
|
~runtime_args:[ Runtime_arg.v port ]
|
||
|
|
[ main $ http_server ]
|
||
|
|
]} *)
|
||
|
|
|
||
|
|
type alpn_client
|
||
|
|
(** Abstract type for ALPN HTTP clients *)
|
||
|
|
|
||
|
|
val alpn_client : alpn_client typ
|
||
|
|
|
||
|
|
val paf_client : 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 = main "Unikernel.Make" (alpn_client @-> job)
|
||
|
|
let stackv4v6 = generic_stackv4v6 default_network
|
||
|
|
let he = generic_happy_eyeballs stack
|
||
|
|
let dns = generic_dns_client stack he
|
||
|
|
|
||
|
|
let alpn_client =
|
||
|
|
let mimic = mimic_happy_eyeballs stackv4v6 he dns in
|
||
|
|
paf_client (tcpv4v6_of_stackv4v6 stackv4v6) mimic
|
||
|
|
|
||
|
|
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 he = generic_happy_eyeballs stack
|
||
|
|
let dns = generic_dns_client stack he
|
||
|
|
|
||
|
|
let git_client =
|
||
|
|
let mimic = mimic_happy_eyeballs stackv4v6 he dns in
|
||
|
|
let ssh =
|
||
|
|
git_ssh ~key ~password (tcpv4v6_of_stackv4v6 stackv4v6) mimic
|
||
|
|
in
|
||
|
|
let tcp = git_tcp (tcpv4v6_of_stackv4v6 stackv4v6) mimic 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 :
|
||
|
|
?group:string ->
|
||
|
|
?authenticator:string ->
|
||
|
|
?key:string ->
|
||
|
|
?password:string ->
|
||
|
|
tcpv4v6 impl ->
|
||
|
|
mimic impl ->
|
||
|
|
git_client impl
|
||
|
|
(** [git_ssh ?group ?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 :
|
||
|
|
?group:string ->
|
||
|
|
?authenticator:string ->
|
||
|
|
?headers:(string * string) list ->
|
||
|
|
tcpv4v6 impl ->
|
||
|
|
mimic impl ->
|
||
|
|
git_client impl
|
||
|
|
(** [git_http ?group ?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 runtime_args : argv impl -> job impl
|
||
|
|
(** [runtime_args argv] is a job that loads argv. *)
|
||
|
|
|
||
|
|
(** {2 Application registering} *)
|
||
|
|
|
||
|
|
val register :
|
||
|
|
?argv:argv impl ->
|
||
|
|
?reporter:reporter impl ->
|
||
|
|
?sleep:sleep impl ->
|
||
|
|
?ptime:ptime impl ->
|
||
|
|
?mtime:mtime impl ->
|
||
|
|
?random:random impl ->
|
||
|
|
?src:[ `Auto | `None | `Some of string ] ->
|
||
|
|
string ->
|
||
|
|
job impl list ->
|
||
|
|
unit
|
||
|
|
(** [register ~argv ~reporter ~src name jobs] registers the application named by
|
||
|
|
[name] which will executes the given [jobs].
|
||
|
|
|
||
|
|
@param argv
|
||
|
|
Configure command-line argument parsing. The default parser is
|
||
|
|
{!default_argv}. To disable command-line parsing, use {!no_argv}.
|
||
|
|
@param reporter
|
||
|
|
Configure logging. The default log reporter is {!default_reporter}. To
|
||
|
|
disable logging, use {!no_reporter}.
|
||
|
|
@param sleep
|
||
|
|
Configure the sleep. The default is {!default_sleep}. To disable the
|
||
|
|
timer, use {!no_sleep}.
|
||
|
|
@param ptime
|
||
|
|
Configure the POSIX clock. The default is {!default_ptime}. To disable the
|
||
|
|
POSIX clock, use {!no_ptime}.
|
||
|
|
@param mtime
|
||
|
|
Configure the monotonic clock. The default is {!default_mtime}. To disable
|
||
|
|
the monotonic clock, use {!no_mtime}.
|
||
|
|
@param random
|
||
|
|
Configure the random number generator. The default is {!default_random}.
|
||
|
|
To disable the random device, use {!no_random}.
|
||
|
|
@param src
|
||
|
|
The source to use in the generated opam file. If [`None] no source is
|
||
|
|
output. If [`Some mysource] the string [mysource] is used as the source.
|
||
|
|
If [`Auto] (default) the is guessed from the VCS information. *)
|
||
|
|
|
||
|
|
module Type = Functoria.Type
|
||
|
|
module Impl = Functoria.Impl
|
||
|
|
module Info = Functoria.Info
|
||
|
|
module Dune = Functoria.Dune
|
||
|
|
module Action = Functoria.Action
|
||
|
|
module Context = Functoria.Context
|
||
|
|
|
||
|
|
val connect_err : string -> int -> 'a
|
||
|
|
|
||
|
|
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
|