unikernel/duniverse/bos/.gitignore

@@ -0,0 +1,6 @@
+_b0
+_build
+tmp
+*.native
+*.byte
+*.install

unikernel/duniverse/bos/.merlin

@@ -0,0 +1,5 @@
+PKG b0.kit unix result rresult astring fpath fmt fmt.tty logs logs.fmt mtime mtime.clock.os
+S src
+S test
+B _b0/b/**
+B _build/**

unikernel/duniverse/bos/.ocp-indent

@@ -0,0 +1 @@
+strict_with=always,match_clause=4,strict_else=never,strict_comments=true

unikernel/duniverse/bos/B0.ml

@@ -0,0 +1,129 @@
+open B0_kit.V000
+open B00_std
+open Result.Syntax
+
+(* OCaml library names *)
+
+let unix = B0_ocaml.libname "unix"
+let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
+let rresult = B0_ocaml.libname "rresult"
+let rresult_top = B0_ocaml.libname "rresult.top"
+let astring = B0_ocaml.libname "astring"
+let astring_top = B0_ocaml.libname "astring.top"
+let fpath = B0_ocaml.libname "fpath"
+let fpath_top = B0_ocaml.libname "fpath.top"
+let fmt = B0_ocaml.libname "fmt"
+let fmt_top = B0_ocaml.libname "fmt.tty"
+let fmt_tty = B0_ocaml.libname "fmt.tty"
+let logs = B0_ocaml.libname "logs"
+let logs_fmt = B0_ocaml.libname "logs.fmt"
+let logs_top = B0_ocaml.libname "logs.top"
+let mtime = B0_ocaml.libname "mtime"
+let mtime_clock_os = B0_ocaml.libname "mtime.clock.os"
+
+let bos = B0_ocaml.libname "bos"
+let bos_setup = B0_ocaml.libname "bos.setup"
+let bos_top = B0_ocaml.libname "bos.top"
+
+(* Libraries *)
+
+let bos_lib =
+  let srcs =
+    Fpath.[ `Dir (v "src");
+            `X (v "src/bos_setup.ml");
+            `X (v "src/bos_setup.mli");
+            `X (v "src/bos_top.ml");
+            `X (v "src/bos_top_init.ml") ]
+  in
+  let requires = [rresult; astring; fpath; fmt; unix; logs]
+  in
+  B0_ocaml.lib bos ~doc:"The bos library" ~srcs ~requires
+
+let bos_setup_lib =
+  let srcs = Fpath.[ `File (v "src/bos_setup.ml");
+                     `File (v "src/bos_setup.mli") ]
+  in
+  let requires = [rresult; fmt_tty; logs_fmt; astring; fpath; logs; fmt; bos]
+  in
+  B0_ocaml.lib bos_setup ~doc:"The bos.setup library" ~srcs ~requires
+
+let bos_top_lib =
+  let srcs = Fpath.[ `File (v "src/bos_top.ml") ] in
+  let requires =
+    [ rresult_top; astring_top; fpath_top; fmt_top; logs_top;
+      compiler_libs_toplevel]
+  in
+  B0_ocaml.lib bos_top ~doc:"The bos.top library" ~srcs ~requires
+
+(* Tools *)
+
+(* Tests *)
+
+let test =
+  let srcs =
+    Fpath.[ `File (v "test/testing.mli");
+            `File (v "test/testing.ml");
+            `File (v "test/test.ml");
+            `File (v "test/test_cmd.ml");
+            `File (v "test/test_os_cmd.ml");
+            `File (v "test/test_pat.ml"); ]
+  in
+  let meta = B0_meta.(empty |> tag test) in
+  let requires = [ rresult; astring; fpath; logs_fmt; bos] in
+  B0_ocaml.exe "test" ~doc:"Test suite" ~srcs ~meta ~requires
+
+let test_arg =
+  let srcs = Fpath.[ `File (v "test/test_arg.ml")] in
+  let meta = B0_meta.(empty |> tag test) in
+  let requires = [ astring; fmt; fpath; logs_fmt; bos ] in
+  B0_ocaml.exe "test-arg" ~doc:"Test argument parsing" ~srcs ~meta ~requires
+
+let test_arg_pos =
+  let srcs = Fpath.[ `File (v "test/test_arg_pos.ml")] in
+  let meta = B0_meta.(empty |> tag test) in
+  let requires = [ fmt; logs_fmt; bos ] in
+  B0_ocaml.exe "test-arg-pos" ~doc:"Test argument parsing" ~srcs ~meta ~requires
+
+let watch =
+  let srcs = Fpath.[`File (v "test/watch.ml")] in
+  let meta = B0_meta.(empty |> tag test) in
+  let requires =
+    [ logs_fmt; fmt_tty; mtime; mtime_clock_os; rresult; fpath; bos; bos_setup ]
+  in
+  B0_ocaml.exe "watch" ~doc:"Watch files for changes." ~srcs ~meta ~requires
+
+(* Packs *)
+
+let default =
+  let meta =
+    let open B0_meta in
+    empty
+    |> add authors ["The bos programmers"]
+    |> add maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
+    |> add homepage "https://erratique.ch/software/bos"
+    |> add online_doc "https://erratique.ch/software/bos/doc"
+    |> add licenses ["ISC"]
+    |> add repo "git+https://erratique.ch/repos/bos.git"
+    |> add issues "https://github.com/dbuenzli/bos/issues"
+    |> add description_tags
+      ["os"; "system"; "cli"; "command"; "file"; "path"; "log"; "unix";
+       "org:erratique"]
+    |> tag B0_opam.tag
+    |> add B0_opam.Meta.depends
+      [ "ocaml", {|>= "4.08.0"|};
+        "ocamlfind", {|build|};
+        "ocamlbuild", {|build|};
+        "topkg", {|build & >= "1.0.3"|};
+        "base-unix", "";
+        "rresult", {|>= "0.7.0"|};
+        "astring", "";
+        "fpath", "";
+        "fmt", {|>= "0.8.10"|};
+        "logs", "";
+        "mtime", {|test|};
+      ]
+    |> add B0_opam.Meta.build
+      {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|}
+  in
+  B0_pack.v "default" ~doc:"bos package" ~meta ~locked:true @@
+  B0_unit.list ()

unikernel/duniverse/bos/CHANGES.md

@@ -0,0 +1,87 @@
+v0.2.1 2021-10-04 Zagreb
+------------------------
+
+- Require OCaml >= 4.08.
+- `OS.Dir.create` fix function result on existing files. It returned
+  non-sensical results. The function now errors as it should
+  be. Thanks to Léo Andrès for the report.
+- `OS.Dir.create` fix function returning `false` instead of 
+  `true` when the directory is created with `~path:false`.
+  Thanks to Léo Andrès for the report and patch.
+- `OS.File.read` support for reading character devices and named
+  pipes. Thanks to Rizo Isrof for the patch.
+
+v0.2.0 2017-12-27 La Forclaz (VS)
+---------------------------------
+
+- Built-in support for tool search. No longer relies on `which` (unix)
+  or `where` (Windows).
+- `OS.Cmd.{exist,must_exist}` get an optional `?search` argument. This can
+  break existing programs.
+- Add `OS.Cmd.{find_tool,get_tool,resolve,search_path_dirs}`.
+- Add `OS.File.is_executable`.
+- Deprecate `Cmd.[get_]line_exec` in favor of `Cmd.[get_]line_tool`.
+- Fix `OS.Path.symlink ~force:true` when the forced file is a symbolic
+  link, the operation errored before. Thanks to Anil Madhavapeddy for
+  the report.
+
+v0.1.6 2017-05-04 La Forclaz (VS)
+---------------------------------
+
+- Fix `OS.Dir.create`. The documentation says it returns `true` if the
+  directory was created and `false` otherwise. The implementation did
+  the converse, the latter was adjusted to match the doc
+  specification.
+
+v0.1.5 2017-03-18 La Forclaz (VS)
+---------------------------------
+
+- Fix `OS.Cmd.{err_file,out_file,to_file}`. Files were not truncated
+  on `append = false`.
+- `OS.File.with_input`, allow to specify the input buffer as an
+  optional argument.
+
+v0.1.4 2016-08-30 Zagreb
+------------------------
+
+- Fix `OS.Path.fold` on root and relative paths (#61).
+  Thanks to Hezekiah M. Carty for the report and the help.
+- Fix `OS.File.write` on Windows (#59). Thanks
+  to Hezekiah M. Carty for the report and the fix.
+
+v0.1.3 2016-07-12 Cambridge (UK)
+--------------------------------
+
+- `Cmd.dump`, make representation cut and paste friendly. This
+  affects logging made by the library.
+- Add `Cmd.of_values`, converts arbitrary list of values to
+  a corresponding argument list.
+- Fix `OS.Path.exists`. Existing file path traversals returned
+  and error rather than `false`.
+  
+v0.1.2 2016-06-17 Cambridge (UK)
+--------------------------------
+
+- Fix `OS.File` creation mode from `0o622` to `0o644` (#55).
+- Fix semantics of dotfile handling in `OS.Path.{matches,query}`.
+  `~dotfile:false` (default) used to not return any path that had a
+  dot segment, even if this was a constant segment without pattern
+  variables. This is no longer the case, `~dotfile:false` now only
+  prevents segments starting with a pattern variable to match against
+  dot files, i.e. it controls the exploration of the file system made
+  by the function. Thanks to David Kaloper for the discussion.
+  
+v0.1.1 2016-06-08 Cambridge (UK)
+--------------------------------
+
+- Fix `OS.Cmd` combinators on Linux. Thanks to Andreas Hauptmann for
+  the help (#51)
+- Fix `OS.Dir.delete` on Linux and Windows. Thanks to Andreas Hauptmann
+  for the help (#50).
+- Fix `OS.Cmd.exists` on Linux. Thanks to Andreas Hauptmann and
+  Petter Urkedal for the help (#52).
+
+v0.1.0 2016-05-23 La Forclaz (VS)
+---------------------------------
+
+First release.

unikernel/duniverse/bos/LICENSE.md

@@ -0,0 +1,13 @@
+Copyright (c) 2016 The bos programmers
+
+Permission to use, copy, modify, and/or 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.

unikernel/duniverse/bos/README.md

@@ -0,0 +1,40 @@
+Bos — Basic OS interaction for OCaml
+-------------------------------------------------------------------------------
+v0.2.1+dune
+
+Bos provides support for basic and robust interaction with the
+operating system in OCaml. It has functions to access the process
+environment, parse command line arguments, interact with the file
+system and run command line programs.
+
+Bos works equally well on POSIX and Windows operating systems.
+
+Bos depends on [Rresult][rresult], [Astring][astring], [Fmt][fmt],
+[Fpath][fpath] and [Logs][logs] and the OCaml Unix library. It is
+distributed under the ISC license.
+
+[rresult]: http://erratique.ch/software/rresult
+[astring]: http://erratique.ch/software/astring
+[fmt]: http://erratique.ch/software/fmt
+[fpath]: http://erratique.ch/software/fpath
+[logs]: http://erratique.ch/software/logs
+
+Home page: http://erratique.ch/software/bos  
+Contact: Daniel Bünzli `<daniel.buenzl i@erratique.ch>`
+
+## Installation
+
+Bos can be installed with `opam`:
+
+    opam install bos
+    
+If you don't use `opam` consult the [`opam`](opam) file for build
+instructions.
+
+## Documentation
+
+The documentation and API reference is automatically generated by from
+the interfaces. It can be consulted [online][doc] or via `odig doc bos`.
+
+[doc]: http://erratique.ch/software/bos/doc/
+

unikernel/duniverse/bos/_tags

@@ -0,0 +1,12 @@
+true : bin_annot, safe_string, package(rresult), \
+       package(astring), package(fpath), package(fmt), package(logs), \
+       package(unix)
+
+<_b0> : -traverse
+<src> : include
+<src/bos_top*> : package(compiler-libs.toplevel)
+<src/bos_setup*> : package(fmt.tty), package(logs.fmt)
+
+<test> : include
+<test/*> : package(logs.fmt)
+<test/watch*> : package(fmt.tty), package(mtime), package(mtime.clock.os)

unikernel/duniverse/bos/bos.opam

@@ -0,0 +1,40 @@
+version: "0.2.1+dune"
+opam-version: "2.0"
+maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
+authors: ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
+dev-repo: "git+https://github.com/dune-universe/bos.git"
+tags: [ "os" "system" "cli" "command" "file" "path" "log" "unix" "org:erratique" ]
+license: "ISC"
+build: [[ "dune" "build" "-p" name ]]
+depends: [
+  "dune"
+  "ocaml" {>= "4.01.0"}
+  "base-unix"
+  "rresult" {>= "0.4.0"}
+  "astring"
+  "fpath"
+  "fmt" {>= "0.8.0"}
+  "logs"
+  "mtime" {with-test}
+]
+synopsis: "Basic OS interaction for OCaml"
+description: """
+Bos provides support for basic and robust interaction with the
+operating system in OCaml. It has functions to access the process
+environment, parse command line arguments, interact with the file
+system and run command line programs.
+
+Bos works equally well on POSIX and Windows operating systems.
+
+Bos depends on [Rresult][rresult], [Astring][astring], [Fmt][fmt],
+[Fpath][fpath] and [Logs][logs] and the OCaml Unix library. It is
+distributed under the ISC license.
+
+[rresult]: http://erratique.ch/software/rresult
+[astring]: http://erratique.ch/software/astring
+[fmt]: http://erratique.ch/software/fmt
+[fpath]: http://erratique.ch/software/fpath
+[logs]: http://erratique.ch/software/logs
+
+Home page: http://erratique.ch/software/bos  
+Contact: Daniel Bünzli `<daniel.buenzl i@erratique.ch>`"""

unikernel/duniverse/bos/doc/index.mld

@@ -0,0 +1,15 @@
+{0 Bos {%html: <span class="version">v0.2.1+dune</span>%}}
+
+Bos provides support for basic and robust interaction with the
+operating system in OCaml. It has functions to access the process
+environment, parse command line arguments, interact with the file
+system and run command line programs.
+
+Bos works equally well on POSIX and Windows operating systems.
+
+{1:api API}
+
+{!modules:
+Bos
+Bos_setup
+}

unikernel/duniverse/bos/dune-project

@@ -0,0 +1,3 @@
+(lang dune 1.0)
+(name bos)
+(version v0.2.1+dune)

unikernel/duniverse/bos/pkg/META

@@ -0,0 +1,27 @@
+description = "Basic OS interaction for OCaml"
+version = "0.2.1+dune"
+requires = "rresult astring fpath fmt unix logs"
+archive(byte) = "bos.cma"
+archive(native) = "bos.cmxa"
+plugin(byte) = "bos.cma"
+plugin(native) = "bos.cmxs"
+
+package "top" (
+  description = "Bos toplevel support"
+  version = "0.2.1+dune"
+  requires = "rresult.top astring.top fpath.top fmt.top logs.top bos"
+  archive(byte) = "bos_top.cma"
+  archive(native) = "bos_top.cmxa"
+  plugin(byte) = "bos_top.cma"
+  plugin(native) = "bos_top.cmxs"
+)
+
+package "setup" (
+  description = "Bos quick setup for simple programs"
+  version = "0.2.1+dune"
+  requires = "fmt.tty logs.fmt bos"
+  archive(byte) = "bos_setup.cma"
+  archive(native) = "bos_setup.cmxa"
+  plugin(byte) = "bos_setup.cma"
+  plugin(native) = "bos_setup.cmxs"
+)

unikernel/duniverse/bos/pkg/pkg.ml

@@ -0,0 +1,15 @@
+#!/usr/bin/env ocaml
+#use "topfind"
+#require "topkg"
+open Topkg
+
+let () =
+  Pkg.describe "bos" @@ fun c ->
+  Ok [ Pkg.mllib ~api:["Bos"] "src/bos.mllib";
+       Pkg.mllib "src/bos_setup.mllib";
+       Pkg.mllib ~api:[] "src/bos_top.mllib";
+       Pkg.lib "src/bos_top_init.ml";
+       Pkg.test "test/test";
+       Pkg.test ~run:false "test/test_arg";
+       Pkg.test ~run:false "test/test_arg_pos";
+       Pkg.test ~run:false "test/watch"; ]

unikernel/duniverse/bos/src/bos.ml

@@ -0,0 +1,40 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2014 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+
+(* Basic types *)
+
+module Pat = Bos_pat
+module Cmd = Bos_cmd
+
+(* OS interaction *)
+
+module OS = struct
+  type ('a, 'b) result = ('a, [> R.msg] as 'b) R.t
+  module Env = Bos_os_env
+  module Arg = Bos_os_arg
+  module Path = Bos_os_path
+  module File = Bos_os_file
+  module Dir = Bos_os_dir
+  module Cmd = Bos_os_cmd
+  module U = Bos_os_u
+end
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2014 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos.mllib

@@ -0,0 +1,13 @@
+Bos_base
+Bos_pat
+Bos_log
+Bos_cmd
+Bos_os_u
+Bos_os_tmp
+Bos_os_path
+Bos_os_file
+Bos_os_dir
+Bos_os_cmd
+Bos_os_env
+Bos_os_arg
+Bos

unikernel/duniverse/bos/src/bos_base.ml

@@ -0,0 +1,29 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+
+let apply f x ~finally y =
+  let result = try f x with
+  | e -> try finally y; raise e with _ -> raise e
+  in
+  finally y;
+  result
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_cmd.ml

@@ -0,0 +1,148 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+open Rresult
+
+(* Command line fragments *)
+
+type t = string list
+
+let empty = []
+let is_empty = function [] -> true | _ -> false
+let v a = [a]
+let ( % ) l a = a :: l
+let ( %% ) l0 l1 = List.rev_append (List.rev l1) l0
+let add_arg l a = l % a
+let add_args l a = l %% a
+let on bool l = if bool then l else []
+let p = Fpath.to_string
+
+(* Command lines *)
+
+let line_tool l = match List.rev l with [] -> None | t :: _ -> Some t
+let get_line_tool l = match List.rev l with
+| t :: _ -> t
+| [] -> invalid_arg "the command is empty"
+
+let line_args l = match List.rev l with
+| _ :: args -> args
+| [] -> []
+
+(* Deprecated *)
+
+let line_exec = line_tool
+let get_line_exec = get_line_tool
+
+(* Predicates and comparison *)
+
+let equal l l' = l = l'
+let compare l l' = Stdlib.compare l l'
+
+(* Conversions and pretty printing *)
+
+(* Parsing is loosely based on
+   http://pubs.opengroup.org/onlinepubs/009695399/utilities/\
+   xcu_chap02.html#tag_02_03 *)
+
+let parse_cmdline s =
+  try
+    let err_unclosed kind s =
+      failwith @@
+      strf "%d: unclosed %s quote delimited string"
+        (String.Sub.start_pos s) kind
+    in
+    let skip_white s = String.Sub.drop ~sat:Char.Ascii.is_white s in
+    let tok_sep c = c = '\'' || c = '\"' || Char.Ascii.is_white c in
+    let tok_char c = not (tok_sep c) in
+    let not_squote c = c <> '\'' in
+    let parse_squoted s =
+      let tok, rem = String.Sub.span ~sat:not_squote (String.Sub.tail s) in
+      if not (String.Sub.is_empty rem) then tok, String.Sub.tail rem else
+      err_unclosed "single" s
+    in
+    let parse_dquoted acc s =
+      let is_data = function '\\' | '"' -> false | _ -> true in
+      let rec loop acc s =
+        let data, rem = String.Sub.span ~sat:is_data s in
+        match String.Sub.head rem with
+        | Some '"' -> (data :: acc), (String.Sub.tail rem)
+        | Some '\\' ->
+            let rem = String.Sub.tail rem in
+            begin match String.Sub.head rem with
+            | Some ('"' | '\\' | '$' | '`' as c) ->
+                let acc = String.(sub (of_char c)) :: data :: acc in
+                loop acc (String.Sub.tail rem)
+            | Some ('\n') -> loop (data :: acc) (String.Sub.tail rem)
+            | Some c ->
+                let acc = String.Sub.extend ~max:2 data :: acc in
+                loop acc (String.Sub.tail rem)
+            | None ->
+                err_unclosed "double" s
+            end
+        | None -> err_unclosed "double" s
+        | Some _ -> assert false
+      in
+      loop acc (String.Sub.tail s)
+    in
+    let parse_token s =
+      let ret acc s = String.Sub.(to_string @@ concat (List.rev acc)), s in
+      let rec loop acc s = match String.Sub.head s with
+      | None -> ret acc s
+      | Some c when Char.Ascii.is_white c -> ret acc s
+      | Some '\'' ->
+          let tok, rem = parse_squoted s in loop (tok :: acc) rem
+      | Some '\"' ->
+          let acc, rem = parse_dquoted acc s in loop acc rem
+      | Some c ->
+          let sat = tok_char in
+          let tok, rem = String.Sub.span ~sat s in loop (tok :: acc) rem
+      in
+      loop [] s
+    in
+    let rec loop acc s =
+      if String.Sub.is_empty s then acc else
+      let token, s = parse_token s in
+      loop (token :: acc) (skip_white s)
+    in
+    Ok (loop [] (skip_white (String.sub s)))
+  with Failure err -> R.error_msgf "command line %a:%s" String.dump s err
+
+let of_string s = parse_cmdline s
+let to_string l = String.concat ~sep:" " (List.rev_map Filename.quote l)
+
+let to_list line = List.rev line
+let of_list ?slip line = match slip with
+| None -> List.rev line
+| Some slip -> List.fold_left (fun acc v -> v :: slip :: acc) [] line
+
+let of_values ?slip conv vs = match slip with
+| None -> List.rev_map conv vs
+| Some slip -> List.fold_left (fun acc v -> conv v :: slip :: acc) [] vs
+
+let pp ppf cmd = match List.rev cmd with
+| [] -> ()
+| cmd :: [] -> Fmt.(pf ppf "%s" cmd)
+| cmd :: args -> Fmt.(pf ppf "@[<2>%s@ %a@]" cmd (list ~sep:sp string) args)
+
+let dump ppf cmd =
+  let pp_arg ppf a = Fmt.pf ppf "%s" (Filename.quote a) in
+  Fmt.pf ppf "@[<1>[%a]@]" Fmt.(list ~sep:sp pp_arg) (List.rev cmd)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_log.ml

@@ -0,0 +1,25 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2014 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+(* Log level and output *)
+
+let src = Logs.Src.create "bos" ~doc:"bos library"
+include (val Logs.src_log src : Logs.LOG)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2014 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_arg.ml

@@ -0,0 +1,517 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+open Rresult
+
+(* Errors *)
+
+let quote pp ppf v = Fmt.pf ppf "`%a'" pp v
+
+let err_done = "Bos.OS.Arg.parse_opts or Bos.OS.Arg.parse already called"
+let err_no_name = "names list cannot be empty"
+let err_env v msg = R.msgf "environment variable %s: %s" v msg
+let err_repeat n = R.msgf "option %a cannot be repeated" (quote Fmt.string) n
+let err_need_argument n =
+  R.msgf "option %a needs an argument" (quote Fmt.string) n
+
+let err_dupe n n' =
+  R.msgf "options %a and %a cannot be present at the same time"
+    (quote Fmt.string) n (quote Fmt.string) n'
+
+let err_unknown_opt ppf l =
+  Fmt.pf ppf "unknown option %a." (quote Fmt.string) l
+
+let err_too_many ppf l =
+  Fmt.pf ppf "too many arguments, don't know what to do with %a"
+    Fmt.(list ~sep:(Fmt.any ",@ ") (quote Fmt.string)) l
+
+(* Executable name. *)
+
+let exec = match Array.length Sys.argv with
+| 0 -> Sys.executable_name
+| n -> Sys.argv.(0)
+
+(* Argument converters *)
+
+type 'a conv =
+  { parse : string -> ('a, Rresult.R.msg) Rresult.result;
+    print : Format.formatter -> 'a -> unit;
+    docv : string }
+
+let conv ?(docv = "VALUE") parse print = { parse; print; docv }
+let conv_parser c = c.parse
+let conv_printer c = c.print
+let conv_docv c = c.docv
+let conv_with_docv conv ~docv = { conv with docv }
+
+let err_invalid s kind =
+  R.msgf "invalid value %a, expected %s" (quote Fmt.string) s kind
+
+let parser_of_kind_of_string ~kind k_of_string =
+  fun s -> match k_of_string s with
+  | None -> Error (err_invalid s kind)
+  | Some v -> Ok v
+
+let some ?(none = "") c =
+  let parse s = match c.parse s with
+  | Ok v -> Ok (Some v)
+  | Error _ as e -> e
+  in
+  let print = Fmt.option ~none:Fmt.(const string none) c.print in
+  { c with parse; print }
+
+(* Parsing *)
+
+type parse = Done | Perror of R.msg | Line of string list
+
+let raw_args = match Array.to_list Sys.argv with
+| [] -> []
+| cmd :: args -> args
+
+let get_parse, set_parse =
+  let parse = ref (Line raw_args) in
+  (fun () -> !parse),
+  (fun p -> parse := p)
+
+(* Option names and values *)
+
+let make_opt_names names =
+  if names = [] then invalid_arg err_no_name else
+  let opt n = if String.length n = 1 then strf "-%s" n else strf "--%s" n in
+  List.map opt names
+
+let is_short_opt n =
+  if String.length n < 2 then false else
+  n.[0] = '-' && n.[1] <> '-'
+
+let is_long_opt n =
+  if String.length n < 3 then false else
+  n.[0] = '-' && n.[1] = '-' && n.[2] <> '-'
+
+let is_opt n = is_short_opt n || is_long_opt n
+
+let short_opt_arg n =
+  if String.length n <= 2 then None else
+  Some (String.with_index_range ~last:1 n,
+        String.with_index_range ~first:2 n)
+
+let long_opt_arg n = String.cut ~sep:"=" n
+
+let opt_arg n = if is_short_opt n then short_opt_arg n else long_opt_arg n
+
+let opt_name_compare n0 n1 =
+  let name n =
+    if is_short_opt n then String.sub ~start:1 n else String.sub ~start:2 n
+  in
+  String.Sub.compare_bytes (name n0) (name n1)
+
+let partition_opt_pos l =
+  let rec loop opts poss = function
+  | "--" :: l -> List.rev opts, List.rev_append poss l
+  | [] -> List.rev opts, List.rev poss
+  | a :: l ->
+      if is_opt a then loop (a :: opts) poss l else loop opts (a :: poss) l
+  in
+  loop [] [] l
+
+(* Documentation *)
+
+let undocumented = "Undocumented."
+
+type doc_opt_kind =
+| Flag of string
+| Opt of string * string * unit Fmt.t (* pretty prints the absent value. *)
+
+type opt_doc =
+  { names : string list;
+    env : string option;
+    repeat : bool;
+    kind : doc_opt_kind; }
+
+let get_opt_docs, add_opt_doc =
+  let docs = ref [] in
+  (fun () -> !docs),
+  (fun doc -> docs := doc :: !docs)
+
+let pp_opt_doc ppf = function
+| Flag d -> Fmt.text ppf d
+| Opt (d, docv, _) ->
+    let b = Buffer.create 244 in
+    let bppf = Fmt.with_buffer ~like:ppf b in
+    let d =
+      try
+        let subst = function
+        | "docv" -> Fmt.pf bppf "%a@?" Fmt.(styled `Underline string) docv; ""
+        | s -> strf "$(%s)" s
+        in
+        Buffer.add_substitute b subst d;
+        Buffer.contents b
+      with Not_found -> d
+    in
+    Fmt.text ppf d
+
+let pp_opt_docs ppf opt_docs =
+  let is_flag o = match o.kind with Flag _ -> true | _ -> false in
+  let sort_opts o o' = opt_name_compare (List.hd o.names) (List.hd o'.names) in
+  let opt_docs = List.sort sort_opts opt_docs in
+  let pp_name = Fmt.(styled `Bold string) in
+  let pp_var = Fmt.(styled `Underline string) in
+  let pp_short var ppf name = Fmt.pf ppf "%a %a" pp_name name pp_var var in
+  let pp_long var ppf name = Fmt.pf ppf "%a=%a" pp_name name pp_var var in
+  let pp_env = Fmt.(styled `Underline string) in
+  let pp_absent ppf absent env = match absent, env with
+  | "", None -> ()
+  | "", Some v -> Fmt.pf ppf "@ (or %a env)" pp_env v
+  | absent, None -> Fmt.pf ppf "@ (absent=%s)" absent
+  | absent, Some v -> Fmt.pf ppf "@ (absent=%s or %a env)" absent pp_env v
+  in
+  let pp_opt var ppf n =
+    if is_short_opt n then pp_short var ppf n else pp_long var ppf n
+  in
+  let pp_opts ppf o =
+    let compare n n' = match compare (String.length n) (String.length n') with
+    | 0 -> compare n n'
+    | c -> c
+    in
+    let names = List.sort compare o.names in
+    match o.kind with
+    | Flag _ ->
+        Fmt.(list ~sep:(any ",@ ") pp_name) ppf names;
+        pp_absent ppf "" o.env
+    | Opt (_, var, absent) ->
+        Fmt.(list ~sep:(any ",@ ") (pp_opt var)) ppf names;
+        let absent = strf "@[<h>%a@]" absent () in
+        pp_absent ppf absent o.env;
+  in
+  let pp_opt_doc ppf o = match o.names with
+  | [n] when is_short_opt n && o.env = None && is_flag o ->
+      Fmt.pf ppf "@[@[%a@]  @[%a@]@]" pp_opts o pp_opt_doc o.kind
+  | _ ->
+      Fmt.pf ppf "@[<v4>@[%a@]@,@[%a@]@]"
+        pp_opts o pp_opt_doc o.kind
+  in
+  if opt_docs = [] then () else
+  Fmt.pf ppf "@[<v>Options:@,@,  @[<v>%a@]@]"
+    Fmt.(list ~sep:cut pp_opt_doc) opt_docs
+
+(* Environment default parsing *)
+
+let env_default var parser = match var with
+| None -> Ok None
+| Some var ->
+    match Bos_os_env.var var with
+    | None -> Ok None
+    | Some s ->
+        match parser s with
+        | Ok v -> Ok (Some v)
+        | Error (`Msg e) -> Error (err_env var e)
+
+(* Flag queries *)
+
+let rec rem_flag names rleft = function
+| "--" :: _ -> None
+| s :: ss when List.mem s names -> Some (s, List.rev_append rleft ss)
+| s :: ss -> rem_flag names (s :: rleft) ss
+| [] -> None
+
+let flag ?(doc = undocumented) ?env names =
+  let names = make_opt_names names in
+  add_opt_doc { names; env; repeat = false; kind = Flag doc };
+  match get_parse () with
+  | Done -> invalid_arg err_done
+  | Perror _ -> false
+  | Line line ->
+      match rem_flag names [] line with
+      | None ->
+          begin match env_default env Bos_os_env.bool with
+          | Ok (Some v) -> v
+          | Ok None -> false
+          | Error e -> set_parse (Perror e); false
+          end
+      | Some (flag, rest) ->
+          match rem_flag names [] rest with
+          | None -> set_parse (Line rest); true
+          | Some (flag', _) ->
+              if flag = flag'
+              then (set_parse @@ Perror (err_repeat flag); false)
+              else (set_parse @@ Perror (err_dupe flag flag'); false)
+
+let flag_all ?(doc = undocumented) ?env names =
+  let names = make_opt_names names in
+  add_opt_doc { names; env; repeat = true; kind = Flag doc };
+  match get_parse () with
+  | Done -> invalid_arg err_done
+  | Perror _ -> 0
+  | Line line ->
+      let rec find acc line = match rem_flag names [] line with
+      | Some (flag, rest) -> find (acc + 1) rest
+      | None ->
+          if acc <> 0 then (set_parse (Line line); acc) else
+          match env_default env Bos_os_env.bool with
+          | Ok (Some v) -> if v then 1 else 0
+          | Ok None -> 0
+          | Error e -> set_parse (Perror e); 0
+      in
+      find 0 line
+
+(* Option queries *)
+
+let rec rem_option names rleft = function
+| "--" :: _ -> Ok None
+| s :: ss ->
+    begin match opt_arg s with
+    | None ->
+        if not (List.mem s names)
+        then rem_option names (s :: rleft) ss
+        else begin match ss with
+        | [] -> Error (err_need_argument s)
+        | "--" :: _ -> Error (err_need_argument s)
+        | s' :: _ when is_opt s' -> Error (err_need_argument s)
+        | arg :: ss -> Ok (Some (s, arg, List.rev_append rleft ss))
+        end
+    | Some (opt, arg) ->
+        if not (List.mem opt names)
+        then rem_option names (s :: rleft) ss
+        else Ok (Some (opt, arg, List.rev_append rleft ss))
+    end
+| [] -> Ok None
+
+let opt ?docv ?(doc = undocumented) ?env names c ~absent =
+  let names = make_opt_names names in
+  let docv = match docv with None -> c.docv | Some docv -> docv in
+  let opt = Opt (doc, docv, fun ppf () -> c.print ppf absent) in
+  add_opt_doc { names; env; repeat = false; kind = opt };
+  match get_parse () with
+  | Done -> invalid_arg err_done
+  | Perror _ -> absent
+  | Line line ->
+      match rem_option names [] line with
+      | Error e -> set_parse (Perror e); absent
+      | Ok None ->
+          begin match env_default env c.parse with
+          | Ok (Some v) -> v
+          | Ok None -> absent
+          | Error e -> set_parse (Perror e); absent
+          end
+      | Ok (Some (opt, arg, rest)) ->
+          match rem_option names [] rest with
+          | Ok None -> set_parse (Line rest);
+              begin match c.parse arg with
+              | Ok v -> v
+              | Error e -> set_parse (Perror e); absent
+              end
+          | Ok (Some (opt', _, _)) ->
+              if opt = opt'
+              then (set_parse @@ Perror (err_repeat opt); absent)
+              else (set_parse @@ Perror (err_dupe opt opt'); absent)
+          | Error e -> (* well... *) set_parse (Perror e); absent
+
+let opt_all ?docv ?(doc = undocumented) ?env names c ~absent =
+  let names = make_opt_names names in
+  let docv = match docv with None -> c.docv | Some docv -> docv in
+  let opt =
+    Opt (doc, docv, fun ppf () -> Fmt.(list ~sep:sp c.print) ppf absent)
+  in
+  add_opt_doc { names; env; repeat = false; kind = opt };
+  match get_parse () with
+  | Done -> invalid_arg err_done
+  | Perror _ -> absent
+  | Line line ->
+      let rec find acc line = match rem_option names [] line with
+      | Error e -> set_parse (Perror e); absent
+      | Ok (Some (_, arg, rest)) ->
+          begin match c.parse arg with
+          | Error e -> set_parse (Perror e); absent
+          | Ok arg ->  find (arg :: acc) rest
+          end
+      | Ok None ->
+          if acc <> [] then (set_parse (Line line); acc) else
+          match env_default env c.parse with
+          | Ok (Some v) -> [v]
+          | Ok None -> absent
+          | Error e -> set_parse (Perror e); absent
+      in
+      find [] line
+
+(* Parsing *)
+
+let get_pp_usage ~pos = function
+| Some u -> Fmt.(const string) u
+| None ->
+    fun ppf () ->
+      Fmt.pf ppf "[%a]..." Fmt.(styled `Underline (any "OPTION")) ();
+      if pos then Fmt.pf ppf " %a..." Fmt.(styled `Underline (any "ARG")) ()
+
+let pp_usage ppf usage = Fmt.pf ppf "Usage: %s %a@." exec usage ()
+let pp_usage_try_help ppf usage =
+  pp_usage ppf usage;
+  Fmt.pf ppf "Try %a for more information@."
+    (quote Fmt.(string ++ (any " --help"))) exec;
+  ()
+
+let parse_error ~usage msg =
+  Fmt.epr "%s: %s@." exec msg;
+  Fmt.epr "%a" pp_usage_try_help usage;
+  exit 1
+
+let maybe_help ~doc ~usage =
+  let help_opts = ["-h"; "-help"; "--help" ] in
+  let rec find_help = function
+  | "--" :: _ | [] -> false
+  | s :: ss -> List.mem s help_opts || find_help ss
+  in
+  if not (find_help raw_args) then () else
+  begin
+    add_opt_doc { names = help_opts; env = None; repeat = false;
+                  kind = Flag "Show this help." };
+    Fmt.(pf stdout "%a - @[%a@]@." Fpath.pp Fpath.(base @@ v exec) text doc);
+    Fmt.(pf stdout "%a" pp_usage usage);
+    Fmt.(pf stdout "%a@." pp_opt_docs (get_opt_docs ()));
+    exit 0
+  end
+
+let parse_opts ?(doc = undocumented) ?usage () =
+  let usage = get_pp_usage ~pos:false usage in
+  maybe_help ~doc ~usage;
+  match get_parse () with
+  | Line [] -> ()
+  | Line l ->
+      let opts, poss = partition_opt_pos l in
+      List.iter (fun o -> Fmt.epr "%s: @[%a@]@." exec err_unknown_opt o) opts;
+      if poss <> [] then (Fmt.epr "%s: @[%a@]@." exec err_too_many poss);
+      pp_usage_try_help Fmt.stderr usage;
+      exit 1
+  | Done -> invalid_arg err_done
+  | Perror (`Msg e) -> parse_error ~usage e
+
+let parse_pos_args parse ps =
+  let rec loop acc = function
+  | p :: ps -> parse p >>= fun p -> loop (p :: acc) ps
+  | [] -> Ok (List.rev acc)
+  in
+  loop [] ps
+
+let parse ?(doc = undocumented) ?usage ~pos:c () =
+  let usage = get_pp_usage ~pos:true usage in
+  maybe_help ~doc ~usage;
+  match get_parse () with
+  | Done -> invalid_arg err_done
+  | Perror (`Msg e) -> parse_error ~usage e
+  | Line l ->
+      let opts, poss = partition_opt_pos l in
+      if opts <> [] then begin
+        List.iter (fun o -> Fmt.epr "%s: @[%a@]@." exec err_unknown_opt o) opts;
+        pp_usage_try_help Fmt.stderr usage;
+        exit 1
+      end;
+      match parse_pos_args c.parse poss with
+      | Error (`Msg e) -> parse_error ~usage e
+      | Ok poss -> poss
+
+(* Predefined argument converters *)
+
+let kconv ?docv ~kind k_of_string print =
+  let parse = parser_of_kind_of_string ~kind k_of_string in
+  conv ?docv parse print
+
+let string = conv ~docv:"STRING" (fun s -> Ok s) Fmt.string
+let path =
+  let parse s = R.to_option (Fpath.of_string s) in
+  kconv ~docv:"PATH" ~kind:"a path" parse Fpath.pp
+
+let bin = conv ~docv:"EXEC" (fun s -> Ok (Bos_cmd.v s)) Bos_cmd.pp
+let cmd =
+  let parse s = match Bos_cmd.of_string s with
+  | Error _ -> None
+  | Ok cmd when Bos_cmd.is_empty cmd -> None
+  | Ok cmd -> Some cmd
+  in
+  kconv ~docv:"CMD" ~kind:"a command line" parse Bos_cmd.pp
+
+let char =
+  kconv ~docv:"CHAR" ~kind:"a character" String.to_char Fmt.char
+
+let bool =
+  kconv ~docv:"BOOL" ~kind:"`true' or `false'" String.to_bool Fmt.bool
+
+let int =
+  kconv ~docv:"INT" ~kind:"an integer" String.to_int Fmt.int
+
+let nativeint =
+  kconv ~docv:"INT" ~kind:"a native integer" String.to_nativeint Fmt.nativeint
+
+let int32 =
+  kconv ~docv:"INT32" ~kind:"a 32-bit integer" String.to_int32 Fmt.int32
+
+let int64 =
+  kconv ~docv:"INT64" ~kind:"a 64-bit integer" String.to_int64 Fmt.int64
+
+let float =
+  kconv ~docv:"FLOAT" ~kind:"a float" String.to_float Fmt.float
+
+let enum enum =
+  if enum = [] then invalid_arg "empty enumeration" else
+  let parse s = try Ok (List.assoc s enum) with
+  | Not_found ->
+      let alts = List.map (fun (a, _) -> strf "%a" (quote Fmt.string) a) enum in
+      Error (err_invalid s (strf "one of %s" (String.concat ~sep:", " alts)))
+  in
+  let print ppf v =
+    let enum_inv = List.rev_map (fun (s, v) -> (v, s)) enum in
+    let to_string v = try List.assoc v enum_inv with
+    | Not_found ->
+        invalid_arg "Bos.Arg.enum: incomplete enumeration for the type"
+    in
+    Fmt.(using to_string string) ppf v
+  in
+  conv ~docv:"ENUM" parse print
+
+let parse_split ?(sep = ",") s parse =
+  let rec loop acc = function
+  | s :: ss -> parse s >>= fun v -> loop (v :: acc) ss
+  | [] -> Ok (List.rev acc)
+  in
+  loop [] (String.cuts ~sep:"," s)
+
+let list ?sep c =
+  let parse s = parse_split ?sep s c.parse in
+  let print = Fmt.list ~sep:(Fmt.any ",") c.print in
+  conv ~docv:(strf "LIST %s" c.docv) parse print
+
+let array ?sep c =
+  let parse s = match parse_split ?sep s c.parse with
+  | Error _ as e -> e
+  | Ok l -> Ok (Array.of_list l)
+  in
+  let print = Fmt.array ~sep:(Fmt.any ",") c.print in
+  conv ~docv:(strf "ARRAY %s" c.docv) parse print
+
+let pair ?(sep = ",") l r =
+  let parse s = match String.cut ~sep s with
+  | None -> Error (err_invalid s (strf "a separator `%s' in the string" sep))
+  | Some (ls, rs) ->
+      l.parse ls >>= fun l ->
+      r.parse rs >>= fun r ->
+      Ok (l, r)
+  in
+  let print = Fmt.pair ~sep:Fmt.(const string sep) l.print r.print in
+  conv ~docv:(strf "%s%s%s" l.docv sep r.docv) parse print
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_cmd.ml

@@ -0,0 +1,611 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+open Rresult
+
+let unix_buffer_size = 65536                      (* UNIX_BUFFER_SIZE 4.0.0 *)
+
+(* Unix pretty printers *)
+
+let pp_unix_error ppf e = Fmt.string ppf (Unix.error_message e)
+let pp_process_status ppf = function
+| Unix.WEXITED c -> Fmt.pf ppf "exited with %d" c
+| Unix.WSIGNALED s -> Fmt.pf ppf "killed by signal %a" Fmt.Dump.signal s
+| Unix.WSTOPPED s -> Fmt.pf ppf "stopped by signal %a" Fmt.Dump.signal s
+
+(* Error messages *)
+
+let err_empty_line = "no command, empty command line"
+let err_file f e = R.error_msgf "%a: %a" Fpath.pp f pp_unix_error e
+let err_run cmd pp e = R.error_msgf "run %a: %a" Bos_cmd.dump cmd pp e
+
+(* Primitives from Unix *)
+
+let rec waitpid flags pid = try Unix.waitpid flags pid with
+| Unix.Unix_error (Unix.EINTR, _, _) -> waitpid flags pid
+
+let rec create_process prog args stdin stdout stderr =
+  try Unix.create_process prog args stdin stdout stderr with
+  | Unix.Unix_error (Unix.EINTR, _, _) ->
+      create_process prog args stdin stdout stderr
+
+let rec create_process_env prog args env stdin stdout stderr =
+  try Unix.create_process_env prog args env stdin stdout stderr with
+  | Unix.Unix_error (Unix.EINTR, _, _) ->
+      create_process_env prog args env stdin stdout stderr
+
+let rec pipe () = try Unix.pipe () with
+| Unix.Unix_error (Unix.EINTR, _, _) -> pipe ()
+
+let rec set_close_on_exec fd = try Unix.set_close_on_exec fd with
+| Unix.Unix_error (Unix.EINTR, _, _) -> set_close_on_exec fd
+
+let rec clear_close_on_exec fd = try Unix.clear_close_on_exec fd with
+| Unix.Unix_error (Unix.EINTR, _, _) -> clear_close_on_exec fd
+
+let rec openfile fn mode perm = try Unix.openfile fn mode perm with
+| Unix.Unix_error (Unix.EINTR, _, _) -> openfile fn mode perm
+
+let rec close fd = try Unix.close fd with
+| Unix.Unix_error (Unix.EINTR, _, _) -> close fd
+
+let close_no_err fd = try close fd with e -> ()
+
+let rec select r w e t = try Unix.select r w e t with
+| Unix.Unix_error (Unix.EINTR, _, _) -> select r w e t
+
+(* Process creation primitive. *)
+
+let create_process cmd env ~stdin ~stdout ~stderr =
+  let log_header pid = "EXEC:" ^ String.of_int pid in
+  let line = Bos_cmd.to_list cmd in
+  let prog = try List.hd line with Failure _ -> failwith err_empty_line in
+  let line = Array.of_list line in
+  match env with
+  | None ->
+      let pid = create_process prog line stdin stdout stderr in
+      Bos_log.debug
+        (fun m -> m ~header:(log_header pid) "@[<1>%a@]" Bos_cmd.dump cmd);
+      pid
+  | Some env ->
+      let env = Bos_os_env.to_array env in
+      let pid = create_process_env prog line env stdin stdout stderr in
+      Bos_log.debug
+        (fun m -> m ~header:(log_header pid) "@[<v>%a@,%a@]"
+            Fmt.Dump.(array String.dump) env Bos_cmd.dump cmd);
+      pid
+
+(* Tool existence and search *)
+
+let default_path_sep = if Sys.win32 then ";" else ":"
+let dir_sep = Fpath.dir_sep.[0]
+let exe_is_path t = String.exists (Char.equal dir_sep) t
+
+let tool_file ~dir tool = match dir.[String.length dir - 1] with
+| c when c = dir_sep -> dir ^ tool
+| _ -> String.concat ~sep:Fpath.dir_sep [dir; tool]
+
+let search_in_path tool =
+  let rec loop tool = function
+  | "" -> None
+  | p ->
+      let dir, p = match String.cut ~sep:default_path_sep p with
+      | None -> p, ""
+      | Some (dir, p) -> dir, p
+      in
+      if dir = "" then loop tool p else
+      let tool_file = tool_file ~dir tool in
+      match Bos_os_file._is_executable tool_file with
+      | false -> loop tool p
+      | true -> Some (Fpath.v tool_file)
+  in
+  try loop tool (Unix.getenv "PATH") with
+  | Not_found -> None
+
+let search_in_dirs ~dirs tool =
+  let rec loop tool = function
+  | [] -> None
+  | d :: dirs ->
+      let tool_file = tool_file ~dir:(Fpath.to_string d) tool in
+      match Bos_os_file._is_executable tool_file with
+      | false -> loop tool dirs
+      | true -> Some (Fpath.v tool_file)
+  in
+  loop tool dirs
+
+let ensure_exe_suffix_if_win32 = match Sys.win32 with
+| false -> fun t -> t
+| true ->
+    fun t -> match String.is_suffix ~affix:".exe" t with
+    | true -> t
+    | false -> t ^ ".exe"
+
+let _find_tool ?search tool = match tool with
+| "" -> Ok None
+| tool ->
+    let tool = ensure_exe_suffix_if_win32 tool in
+    match exe_is_path tool with
+    | true ->
+        begin match Fpath.of_string tool with
+        | Ok t -> Ok (Some t)
+        | Error (`Msg _) as e -> e
+        end
+    | false ->
+        match search with
+        | None -> Ok (search_in_path tool)
+        | Some dirs -> Ok (search_in_dirs ~dirs tool)
+
+let find_tool ?search cmd = match Bos_cmd.to_list cmd with
+| [] -> Ok None
+| c :: _ -> _find_tool ?search c
+
+let err_not_found ?search cmd = match Bos_cmd.is_empty cmd with
+| true -> R.error_msg err_empty_line
+| false ->
+    let pp_search ppf = function
+    | None -> Fmt.string ppf "PATH"
+    | Some dirs ->
+        let pp_dir ppf d = Fmt.string ppf (Filename.quote @@ Fpath.to_string d)
+        in
+        Fmt.(list ~sep:(Fmt.any ",@ ") pp_dir) ppf dirs
+    in
+    let tool = List.hd @@ Bos_cmd.to_list cmd in
+    R.error_msgf "%s: no such command in %a" tool pp_search search
+
+let get_tool ?search cmd = match find_tool ?search cmd with
+| Ok (Some t) -> Ok t
+| Ok None -> err_not_found ?search cmd
+| Error _ as e -> e
+
+let exists ?search cmd = match find_tool ?search cmd with
+| Ok (Some _) -> Ok true
+| Ok None -> Ok false
+| Error _ as e -> e
+
+let must_exist ?search cmd = match find_tool ?search cmd with
+| Ok (Some _) -> Ok cmd
+| Ok None -> err_not_found ?search cmd
+| Error _ as e -> e
+
+let resolve ?search cmd = match find_tool ?search cmd with
+| Ok (Some t) ->
+    let t = Fpath.to_string t in
+    Ok (Bos_cmd.of_list (t :: List.tl (Bos_cmd.to_list cmd)))
+| Ok None -> err_not_found ?search cmd
+| Error _ as e -> e
+
+let search_path_dirs ?(sep = default_path_sep) path =
+  let rec loop acc = function
+  | ""  -> Ok (List.rev acc)
+  | p ->
+      let dir, p = match String.cut ~sep p with
+      | None -> p, ""
+      | Some (dir, p) -> dir, p
+      in
+      if dir = "" then loop acc p else
+      match Fpath.of_string dir with
+      | Error (`Msg m) -> R.error_msgf "search path value %S: %s" path m
+      | Ok d -> loop (d :: acc) p
+  in
+  loop [] path
+
+(* Fd utils *)
+
+module Fds = struct
+
+  (* Maintains a set of fds to close, standard fds are never in the set. *)
+
+  module Fd = struct
+    type t = Unix.file_descr
+    let compare : t -> t -> int = compare
+  end
+  module S = Set.Make (Fd)
+
+  type t = S.t ref
+  let empty () = ref S.empty
+  let rem fd s = s := S.remove fd !s
+  let add fd s =
+    if fd = Unix.stdin || fd = Unix.stdout || fd = Unix.stderr then () else
+    (s := S.add fd !s)
+
+  let close_all s = S.iter close_no_err !s; s := S.empty
+  let close fd s = if S.mem fd !s then (close_no_err fd; s := S.remove fd !s)
+end
+
+let write_fd_for_file ~append f =
+  try
+    let flags = Unix.([O_WRONLY; O_CREAT]) in
+    let flags = (if append then Unix.O_APPEND else Unix.O_TRUNC) :: flags in
+    Ok (openfile (Fpath.to_string f) flags 0o644)
+  with Unix.Unix_error (e, _, _) -> err_file f e
+
+let read_fd_for_file f =
+  try Ok (openfile (Fpath.to_string f) [Unix.O_RDONLY] 0o644)
+  with Unix.Unix_error (e, _, _) -> err_file f e
+
+let string_of_fd_async fd =
+  let len = unix_buffer_size in
+  let buf = Buffer.create len in
+  let b = Bytes.create len in
+  let rec step fd store b () =
+    try match Unix.read fd b 0 len with
+    | 0 -> `Ok (Buffer.contents buf)
+    | n ->
+        (* FIXME After 4.01 Buffer.add_subbytes buf b 0 n; step fd store b () *)
+        Buffer.add_substring buf (Bytes.unsafe_to_string b) 0 n;
+        step fd store b ()
+    with
+    | Unix.Unix_error (Unix.EPIPE, _, _) when Sys.win32 ->
+        (* That's the Windows way to say end, see
+           https://msdn.microsoft.com/en-us/library/windows/\
+           desktop/aa365467(v=vs.85).aspx *)
+        `Ok (Buffer.contents buf)
+    | Unix.Unix_error (Unix.EINTR, _, _) -> step fd buf b ()
+    | Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.EAGAIN), _, _) ->
+      `Await (step fd buf b)
+  in
+  step fd buf b
+
+let string_of_fd fd =
+  let rec loop = function `Ok s -> s | `Await step -> loop (step ()) in
+  loop (string_of_fd_async fd ())
+
+let string_to_fd_async s fd =
+  let rec step fd s first len () =
+(* FIXME After 4.01 try match Unix.single_write_substring fd s first len with *)
+    let b = Bytes.unsafe_of_string s in
+    try match Unix.single_write fd b first len with
+    | c when c = len -> `Ok ()
+    | c -> step fd s (first + c) (len - c) ()
+    with
+    | Unix.Unix_error (Unix.EINTR, _, _) -> step fd s first len ()
+    | Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.EAGAIN), _, _) ->
+        `Await (step fd s first len)
+  in
+  step fd s 0 (String.length s)
+
+let string_to_fd s fd =
+  let rec loop = function `Ok () -> () | `Await step -> loop (step ()) in
+  loop (string_to_fd_async s fd ())
+
+let string_to_of_fd s ~to_fd ~of_fd =
+  let never () = assert false in
+  let wset, write = [to_fd], string_to_fd_async s to_fd in
+  let rset, read = [of_fd], string_of_fd_async of_fd in
+  let ret = ref "" in
+  let rec loop rset read wset write =
+    let rable, wable, _ = select rset wset [] (-1.) in
+    let rset, read = match rable with
+    | [] -> rset, read
+    | _ ->
+        match read () with
+        | `Ok s -> ret := s; [], never
+        | `Await step -> rset, step
+    in
+    let wset, write = match wable with
+    | [] -> wset, write
+    | _ ->
+        match write () with
+        | `Ok () -> close_no_err to_fd; [], never
+        | `Await step -> wset, step
+    in
+    if rset = [] && wset = [] then !ret else
+    loop rset read wset write
+  in
+  let sigpipe =
+    if Sys.win32 then None else
+    Some (Sys.signal Sys.sigpipe Sys.Signal_ignore)
+  in
+  let restore () = match sigpipe with
+  | None -> ()
+  | Some sigpipe -> Sys.set_signal Sys.sigpipe sigpipe
+  in
+  try let ret = loop rset read wset write in restore (); ret
+  with e -> restore (); raise e
+
+(* Command runs *)
+
+(* Run statuses *)
+
+type status = [ `Exited of int | `Signaled of int ]
+
+type run_info = Bos_cmd.t
+let run_info_cmd ri = ri
+
+let pp_status ppf = function
+| `Exited c -> Fmt.pf ppf "exited with %d" c
+| `Signaled s -> Fmt.pf ppf "killed by signal %a" Fmt.Dump.signal s
+
+type run_status = run_info * status
+
+let success = function
+| Ok (v, (_, `Exited 0)) -> Ok v
+| Ok (_, (cmd, s)) -> err_run cmd pp_status s
+| Error _ as e -> e
+
+(* Run standard errors *)
+
+type run_err =
+| Err_file of Fpath.t * bool
+| Err_fd of Unix.file_descr
+| Err_run_out
+| Err_stderr
+
+let err_file ?(append = false) f = Err_file (f, append)
+let err_null = err_file Bos_os_file.null
+let err_run_out = Err_run_out
+let err_stderr = Err_stderr
+
+let fd_for_run_err out_fd = function
+| Err_file (f, append) -> write_fd_for_file ~append f
+| Err_fd fd -> Ok fd
+| Err_run_out -> Ok out_fd
+| Err_stderr -> Ok Unix.stderr
+
+(* Run standard inputs *)
+
+type pipeline =
+  { write : (string * Unix.file_descr) option;
+    read : Unix.file_descr;
+    pids : (Bos_cmd.t * int) list }
+
+type run_in =
+| In_string of string
+| In_file of Fpath.t
+| In_run_out of pipeline
+| In_fd of Unix.file_descr
+
+let in_string s = In_string s
+let in_file f = In_file f
+let in_null = in_file Bos_os_file.null
+let in_stdin = In_fd Unix.stdin
+
+(* Run standard outputs *)
+
+type _ _run_out =
+| To_string : (string * run_status) _run_out
+| To_file : Fpath.t * bool -> (unit * run_status)  _run_out
+| To_run_in : run_in _run_out
+| To_fd : Unix.file_descr -> (unit * run_status) _run_out
+
+type run_out =
+  { env : Bos_os_env.t option;
+    cmd : Bos_cmd.t;
+    run_err : run_err;
+    run_in : run_in; }
+
+(* Waiting for processes *)
+
+let rec wait_pids rev_pids = (* On failure returns the first failure *)
+  let rec loop ret = function
+  | (cmd, pid) :: pids ->
+      let s = snd (waitpid [] pid) in
+      if ret <> None then loop ret pids else
+      begin match s with
+      | Unix.WEXITED 0 -> loop ret pids
+      | Unix.WEXITED c -> loop (Some (cmd, `Exited c)) pids
+      | Unix.WSIGNALED s -> loop (Some (cmd, `Signaled s)) pids
+      | Unix.WSTOPPED _ -> assert false
+      end
+  | [] ->
+      match ret with
+      | None -> (fst (List.hd rev_pids), `Exited 0)
+      | Some s -> s
+  in
+  loop None (List.rev rev_pids)
+
+(* Running *)
+
+let do_in_fd_read_stdout stdin o pids do_read =
+  let fds = Fds.empty () in
+  try
+    Fds.add stdin fds;
+    let read_stdout, stdout = pipe () in
+    Fds.add read_stdout fds;
+    Fds.add stdout fds;
+    match fd_for_run_err stdout o.run_err with
+    | Error _ as e -> Fds.close_all fds; e
+    | Ok stderr ->
+        Fds.add stderr fds;
+        set_close_on_exec read_stdout; (* child close *)
+        let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in
+        clear_close_on_exec read_stdout; (* not in further childs (pipes) *)
+        Fds.close stdin fds;
+        Fds.close stdout fds;
+        do_read fds read_stdout ((o.cmd, pid) :: pids)
+  with
+  | Failure msg -> Error (`Msg msg)
+  | Unix.Unix_error (e, _, _) ->
+      Fds.close_all fds; err_run o.cmd pp_unix_error e
+
+let do_in_fd_out_string stdin o pids =
+  do_in_fd_read_stdout stdin o pids
+    begin fun fds read_stdout pids ->
+      let res = string_of_fd read_stdout in
+      let ret = wait_pids pids in
+      Fds.close_all fds;
+      Ok (res, ret)
+    end
+
+let do_in_fd_out_run_in stdin o pids =
+  do_in_fd_read_stdout stdin o pids
+    begin fun fds read_stdout pids ->
+      Fds.rem read_stdout fds;
+      Fds.close_all fds;
+      Ok (In_run_out { write = None; read = read_stdout; pids })
+    end
+
+let do_in_fd_out_fd stdin stdout o pids =
+  let fds = Fds.empty () in
+  try
+    Fds.add stdin fds;
+    Fds.add stdout fds;
+    match fd_for_run_err stdout o.run_err with
+    | Error _ as e -> Fds.close_all fds; e
+    | Ok stderr ->
+        Fds.add stderr fds;
+        let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in
+        let ret = wait_pids ((o.cmd, pid) :: pids) in
+        Fds.close_all fds;
+        Ok ((), ret)
+  with
+  | Failure msg -> Error (`Msg msg)
+  | Unix.Unix_error (e, _, _) ->
+      Fds.close_all fds; err_run o.cmd pp_unix_error e
+
+let do_in_run_out_string p o = do_in_fd_out_string p.read o p.pids
+let do_in_run_out_run_in p o = do_in_fd_out_run_in p.read o p.pids
+let do_in_run_out_fd p out_fd o = do_in_fd_out_fd p.read out_fd o p.pids
+
+let do_in_string_read_stdout s o do_read =
+  let fds = Fds.empty () in
+  try
+    let stdin, write_stdin = pipe () in
+    Fds.add stdin fds;
+    Fds.add write_stdin fds;
+    let read_stdout, stdout = pipe () in
+    Fds.add read_stdout fds;
+    Fds.add stdout fds;
+    match fd_for_run_err stdout o.run_err with
+    | Error _ as e -> Fds.close_all fds; e
+    | Ok stderr ->
+        Fds.add stderr fds;
+        set_close_on_exec read_stdout; (* child close *)
+        set_close_on_exec write_stdin; (* child close *)
+        let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in
+        Fds.close stdin fds;
+        Fds.close stdout fds;
+        do_read fds write_stdin read_stdout pid
+  with
+  | Failure msg -> Error (`Msg msg)
+  | Unix.Unix_error (e, _, _) ->
+      Fds.close_all fds; err_run o.cmd pp_unix_error e
+
+let do_in_string_out_string s o =
+  do_in_string_read_stdout s o
+    begin fun fds write_stdin read_stdout pid ->
+      let res = string_to_of_fd s ~to_fd:write_stdin ~of_fd:read_stdout in
+      Fds.close write_stdin fds; (* signal EOF *)
+      let ret = wait_pids [(o.cmd, pid)] in
+      Fds.close_all fds;
+      Ok (res, ret)
+    end
+
+let do_in_string_out_run_in s o =
+  do_in_string_read_stdout s o
+    begin fun fds write_stdin read_stdout pid ->
+      Fds.rem read_stdout fds;
+      Fds.close_all fds;
+      Ok (In_run_out { write = Some (s, write_stdin);
+                       read = read_stdout; pids = [o.cmd, pid] })
+    end
+
+let do_in_string_out_fd s stdout o =
+  let fds = Fds.empty () in
+  try
+    Fds.add stdout fds;
+    let stdin, write_stdin = pipe () in
+    Fds.add stdin fds;
+    Fds.add write_stdin fds;
+    match fd_for_run_err stdout o.run_err with
+    | Error _ as e -> Fds.close_all fds; e
+    | Ok stderr ->
+        Fds.add stderr fds;
+        set_close_on_exec write_stdin; (* child close *)
+        let pid = create_process o.cmd o.env ~stdin ~stdout ~stderr in
+        string_to_fd s write_stdin;
+        Fds.close write_stdin fds; (* signal EOF *)
+        let ret = wait_pids [(o.cmd, pid)] in
+        Fds.close_all fds;
+        Ok ((), ret)
+  with
+  | Failure msg -> Error (`Msg msg)
+  | Unix.Unix_error (e, _, _) ->
+      Fds.close_all fds; err_run o.cmd pp_unix_error e
+
+let do_in_fd :
+  type a. Unix.file_descr -> run_out -> a _run_out -> (a, [> R.msg]) result =
+fun in_fd o ret -> match ret with
+| To_string -> do_in_fd_out_string in_fd o []
+| To_run_in -> do_in_fd_out_run_in in_fd o []
+| To_fd out_fd -> do_in_fd_out_fd in_fd out_fd o []
+| To_file (f, append) ->
+    write_fd_for_file ~append f >>= fun fd -> do_in_fd_out_fd in_fd fd o []
+
+let run_cmd : type a. run_out -> a _run_out -> (a, [> R.msg]) result =
+fun o ret -> match o.run_in with
+| In_string s ->
+    begin match ret with
+    | To_string -> do_in_string_out_string s o
+    | To_run_in -> do_in_string_out_run_in s o
+    | To_fd out_fd -> do_in_string_out_fd s out_fd o
+    | To_file (f, append) ->
+        write_fd_for_file ~append f >>= fun fd -> do_in_string_out_fd s fd o
+    end
+| In_run_out p ->
+    begin match ret with
+    | To_string -> do_in_run_out_string p o
+    | To_run_in -> do_in_run_out_run_in p o
+    | To_fd out_fd -> do_in_run_out_fd p out_fd o
+    | To_file (f, append) ->
+        write_fd_for_file ~append f >>= fun fd -> do_in_run_out_fd p fd o
+    end
+| In_fd fd -> do_in_fd fd o ret
+| In_file f -> read_fd_for_file f >>= fun fd -> do_in_fd fd o ret
+
+let out_string ?(trim = true) o = match run_cmd o To_string with
+| Ok (s, st) when trim -> Ok (String.trim s, st)
+| r -> r
+
+let out_lines ?trim o =
+  out_string ?trim o  >>= fun (s, st) ->
+  Ok ((if s = "" then [] else String.cuts ~sep:"\n" s), st)
+
+let out_file ?(append = false) f o = run_cmd o (To_file (f, append))
+let out_run_in o = run_cmd o To_run_in
+let out_null o = out_file Bos_os_file.null o
+let out_stdout o = run_cmd o (To_fd Unix.stdout)
+
+let to_string ?trim o = out_string ?trim o |> success
+let to_lines ?trim o = out_lines ?trim o |> success
+let to_file ?append f o = out_file ?append f o |> success
+let to_null o = out_null o |> success
+let to_stdout o = out_stdout o |> success
+
+let run_io ?env ?err:(run_err = Err_stderr) cmd run_in =
+  { env; cmd; run_err; run_in }
+
+let run_out ?env ?err cmd = run_io ?env ?err cmd in_stdin
+let run_in ?env ?err cmd i = run_io ?env ?err cmd i |> to_stdout
+let run ?env ?err cmd = run_io  ?env ?err cmd in_stdin |> to_stdout
+let run_status ?env ?err ?(quiet = false) cmd =
+  let err = match err with
+  | None -> if quiet then err_null else err_stderr
+  | Some err -> err
+  in
+  let ret = match quiet with
+  | true -> in_null |> run_io ?env ~err cmd |> out_null
+  | false -> in_stdin |> run_io ?env ~err cmd |> out_stdout
+  in
+  match ret with
+  | Ok ((), (_, status)) -> Ok status
+  | Error _ as e -> e
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_dir.ml

@@ -0,0 +1,189 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+open Rresult
+
+let uerror = Unix.error_message
+
+(* Existence, creation, deletion, contents *)
+
+let exists = Bos_os_path.dir_exists
+let must_exist = Bos_os_path.dir_must_exist
+let delete = Bos_os_path.delete_dir
+
+let create ?(path = true) ?(mode = 0o755) dir =
+  let rec mkdir d mode = try Ok (Unix.mkdir (Fpath.to_string d) mode) with
+  | Unix.Unix_error (Unix.EEXIST, _, _) -> Ok ()
+  | Unix.Unix_error (e, _, _) ->
+      if d = dir
+      then R.error_msgf "create directory %a: %s" Fpath.pp d (uerror e)
+      else R.error_msgf "create directory %a: %a: %s"
+             Fpath.pp dir Fpath.pp d (uerror e)
+  in
+  Bos_os_path.exists dir >>= function
+  | true -> must_exist dir >>= fun _ -> Ok false
+  | false ->
+      match path with
+      | false -> mkdir dir mode >>= fun () -> Ok true
+      | true ->
+          let rec dirs_to_create p acc = exists p >>= function
+          | true -> Ok acc
+          | false -> dirs_to_create (Fpath.parent p) (p :: acc)
+          in
+          let rec create_them dirs () = match dirs with
+          | dir :: dirs -> mkdir dir mode >>= create_them dirs
+          | [] -> Ok ()
+          in
+          dirs_to_create dir []
+          >>= fun dirs -> create_them dirs ()
+          >>= fun () -> Ok true
+
+let rec contents ?(dotfiles = false) ?(rel = false) dir =
+  let rec readdir dh acc =
+    match (try Some (Unix.readdir dh) with End_of_file -> None) with
+    | None -> Ok acc
+    | Some (".." | ".") -> readdir dh acc
+    | Some f when dotfiles || not (String.is_prefix "." f) ->
+        begin match Fpath.of_string f with
+        | Ok f ->
+            readdir dh ((if rel then f else Fpath.(dir // f)) :: acc)
+        | Error (`Msg m) ->
+            R.error_msgf
+              "directory contents %a: cannot parse element to a path (%a)"
+              Fpath.pp dir String.dump f
+        end
+    | Some _ -> readdir dh acc
+  in
+  try
+    let dh = Unix.opendir (Fpath.to_string dir) in
+    Bos_base.apply (readdir dh) [] ~finally:Unix.closedir dh
+  with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> contents ~rel dir
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "directory contents %a: %s" Fpath.pp dir (uerror e)
+
+let fold_contents ?err ?dotfiles ?elements ?traverse f acc d =
+  contents d >>= Bos_os_path.fold ?err ?dotfiles ?elements ?traverse f acc
+
+(* User and current working directory *)
+
+let user () =
+  let debug err = Bos_log.debug (fun m -> m "OS.Dir.user: %s" err) in
+  let env_var_fallback () =
+    Bos_os_env.(parse "HOME" (some path) ~absent:None) >>= function
+    | Some p -> Ok p
+    | None -> R.error_msgf "cannot determine user home directory: \
+                            HOME environment variable is undefined"
+  in
+  if Sys.os_type = "Win32" then env_var_fallback () else
+  try
+    let uid = Unix.getuid () in
+    let home = (Unix.getpwuid uid).Unix.pw_dir in
+    match Fpath.of_string home with
+    | Ok p -> Ok p
+    | Error _ ->
+        debug (strf "could not parse path (%a) from passwd entry"
+                 String.dump home);
+        env_var_fallback ()
+  with
+  | Unix.Unix_error (e, _, _) -> (* should not happen *)
+      debug (uerror e); env_var_fallback ()
+  | Not_found ->
+      env_var_fallback ()
+
+let rec current () =
+  try
+    let p = Unix.getcwd () in
+    match Fpath.of_string p with
+    | Ok dir ->
+        if Fpath.is_abs dir then Ok dir else
+        R.error_msgf "getcwd(3) returned a relative path: (%a)" Fpath.pp dir
+    | Error _ ->
+        R.error_msgf
+          "get current working directory: cannot parse it to a path (%a)"
+          String.dump p
+  with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> current ()
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "get current working directory: %s" (uerror e)
+
+let rec set_current dir = try Ok (Unix.chdir (Fpath.to_string dir)) with
+| Unix.Unix_error (Unix.EINTR, _, _) -> set_current dir
+| Unix.Unix_error (e, _, _) ->
+    R.error_msgf "set current working directory to %a: %s"
+      Fpath.pp dir (uerror e)
+
+let with_current dir f v =
+  current () >>= fun old ->
+  try
+    set_current dir >>= fun () ->
+    let ret = f v in
+    set_current old >>= fun () -> Ok ret
+  with
+  | exn -> ignore (set_current old); raise exn
+
+(* Temporary directories *)
+
+type tmp_name_pat = (string -> string, Format.formatter, unit, string) format4
+
+let delete_tmp dir = ignore (delete ~recurse:true dir)
+let tmps = ref Fpath.Set.empty
+let tmps_add file = tmps := Fpath.Set.add file !tmps
+let tmps_rem file = delete_tmp file; tmps := Fpath.Set.remove file !tmps
+let delete_tmps () = Fpath.Set.iter delete_tmp !tmps
+let () = at_exit delete_tmps
+
+let default_tmp_mode = 0o700
+
+let tmp ?(mode = default_tmp_mode) ?dir pat =
+  let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in
+  let err () =
+    R.error_msgf "create temporary directory %s in %a: \
+                  too many failing attempts"
+      (strf pat "XXXXXX") Fpath.pp dir
+  in
+  let rec loop count =
+    if count < 0 then err () else
+    let dir = Bos_os_tmp.rand_path dir pat in
+    try Ok (Unix.mkdir (Fpath.to_string dir) mode; dir) with
+    | Unix.Unix_error (Unix.EEXIST, _, _) -> loop (count - 1)
+    | Unix.Unix_error (Unix.EINTR, _, _) -> loop count
+    | Unix.Unix_error (e, _, _) ->
+        R.error_msgf "create temporary directory %s in %a: %s"
+          (strf pat "XXXXXX") Fpath.pp dir (uerror e)
+  in
+  match loop 10000 with
+  | Ok dir as r -> tmps_add dir; r
+  | Error _ as e -> e
+
+let with_tmp ?mode ?dir pat f v =
+  tmp ?mode ?dir pat >>= fun dir ->
+  try
+    let ret = f dir v in
+    tmps_rem dir;
+    Ok ret
+  with e -> tmps_rem dir; raise e
+
+(* Default temporary directory *)
+
+let default_tmp = Bos_os_tmp.default_dir
+let set_default_tmp = Bos_os_tmp.set_default_dir
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_env.ml

@@ -0,0 +1,98 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+open Astring
+
+(* Process environment *)
+
+type t = string String.map
+
+let current () =
+  try
+    let env = Unix.environment () in
+    let add acc assign = match acc with
+    | Error _ as e -> e
+    | Ok m ->
+        match String.cut ~sep:"=" assign with
+        | Some (var, value) -> R.ok (String.Map.add var value m)
+        | None ->
+            R.error_msgf
+              "could not parse process environment variable (%S)" assign
+    in
+    Array.fold_left add (R.ok String.Map.empty) env
+  with
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf
+        "could not get process environment: %s" (Unix.error_message e)
+
+let to_array env =
+  let add_var name value acc = String.concat [name; "="; value] :: acc in
+  Array.of_list (String.Map.fold add_var env [])
+
+(* Variables *)
+
+let var name = try Some (Unix.getenv name) with Not_found -> None
+let set_var name v =
+  let v = match v with None -> "" | Some v -> v in
+  try R.ok (Unix.putenv name v) with
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "set environment variable %s: %s" name (Unix.error_message e)
+
+let opt_var name ~absent = try Unix.getenv name with Not_found -> absent
+let req_var name = try Ok (Unix.getenv name) with
+| Not_found -> R.error_msgf "environment variable %s: undefined" name
+
+(* Typed lookup *)
+
+type 'a parser = string -> ('a, R.msg) result
+
+let parser kind k_of_string =
+  fun s -> match k_of_string s with
+  | None -> R.error_msgf "could not parse %s value from %a" kind String.dump s
+  | Some v -> Ok v
+
+let bool =
+  let of_string s = match String.Ascii.lowercase s with
+  | "" | "false" | "no" | "n" | "0" -> Some false
+  | "true" | "yes" | "y" | "1" -> Some true
+  | _ -> None
+  in
+  parser "bool" of_string
+
+let string = fun s -> Ok s
+let path = Fpath.of_string
+let cmd = fun s -> match Bos_cmd.of_string s with
+| Error _ as err -> err
+| Ok cmd when Bos_cmd.is_empty cmd -> R.error_msgf "command line is empty"
+| Ok _ as cmd -> cmd
+
+let some p = fun s -> match p s with Ok v -> Ok (Some v) | Error _ as e -> e
+
+let parse name p ~absent = match var name with
+| None -> Ok absent
+| Some s ->
+    p s
+    |> R.reword_error_msg ~replace:true
+      (fun err -> R.msgf "environment variable %s: %s" name err)
+
+let value ?(log = Logs.Error) name p ~absent =
+  Bos_log.on_error_msg ~level:log ~use:(fun () -> absent) (parse name p ~absent)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_file.ml

@@ -0,0 +1,293 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+open Rresult
+
+(* Error messages *)
+
+let err_empty_buf = "buffer size can't be 0"
+let err_invalid_input = "input no longer valid, did it escape its scope ?"
+let err_invalid_output = "output no longer valid, did it escape its scope ?"
+let uerror = Unix.error_message
+
+(* Famous file paths *)
+
+let null = Fpath.v (if Sys.os_type = "Win32" then "NUL" else "/dev/null")
+let dash = Fpath.v "-"
+let is_dash = Fpath.equal dash
+
+(* Existence and deletion *)
+
+let exists = Bos_os_path.file_exists
+let must_exist = Bos_os_path.file_must_exist
+let delete = Bos_os_path.delete_file
+
+let rec truncate p size =
+  try Ok (Unix.truncate (Fpath.to_string p) size) with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> truncate p size
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "truncate file %a: %s" Fpath.pp p (uerror e)
+
+(* Executability *)
+
+let _is_executable file = try Unix.access file [Unix.X_OK]; true with
+| Unix.Unix_error _ -> false
+
+let is_executable file = _is_executable (Fpath.to_string file)
+
+(* Bytes buffers *)
+
+let io_buffer_size = 65536                          (* IO_BUFFER_SIZE 4.0.0 *)
+let bytes_buf = function
+| None -> Bytes.create io_buffer_size
+| Some bytes ->
+    if Bytes.length bytes <> 0 then bytes else
+    invalid_arg err_empty_buf
+
+(* Input *)
+
+type input = unit -> (Bytes.t * int * int) option
+
+let with_input ?bytes file f v =
+  try
+    let ic = if is_dash file then stdin else open_in_bin (Fpath.to_string file)
+    in
+    let ic_valid = ref true in
+    let close ic =
+      ic_valid := false; if is_dash file then () else close_in ic
+    in
+    let b = bytes_buf bytes in
+    let bsize = Bytes.length b in
+    let input () =
+      if not !ic_valid then invalid_arg err_invalid_input else
+      let rc = input ic b 0 bsize in
+      if rc = 0 then None else Some (b, 0, rc)
+    in
+    try Ok (Bos_base.apply (f input) v ~finally:close ic) with
+    | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e
+  with
+  | Sys_error e -> R.error_msg e
+
+let with_ic file f v =
+  try
+    let ic = if is_dash file then stdin else open_in_bin (Fpath.to_string file)
+    in
+    let close ic = if is_dash file then () else close_in ic in
+    try Ok (Bos_base.apply (f ic) v ~finally:close ic) with
+    | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e
+  with
+  | End_of_file -> R.error_msgf "%a: unexpected end of file" Fpath.pp file
+  | Sys_error e -> R.error_msg e
+
+let read file =
+  let is_stream ic =
+    let fd = Unix.descr_of_in_channel ic in
+    try Unix.lseek fd 0 Unix.SEEK_END = 0 with
+    | Unix.Unix_error (Unix.ESPIPE, _, _) -> true
+  in
+  let input_stream ic =
+    let bsize = 65536 (* IO_BUFFER_SIZE *) in
+    let buf = Buffer.create bsize in
+    let b = Bytes.create bsize in
+    let rec loop () =
+      let rc = input ic b 0 bsize in
+      if rc = 0 then Ok (Buffer.contents buf) else
+(* FIXME After 4.01  (Buffer.add_subbytes buf b 0 rc; loop ()) *)
+      (Buffer.add_substring buf (Bytes.unsafe_to_string b) 0 rc; loop ())
+    in
+    loop ()
+  in
+  let input ic () =
+    if is_stream ic then input_stream ic else
+    let len = in_channel_length ic in
+    if len <= Sys.max_string_length then begin
+      let s = Bytes.create len in
+      really_input ic s 0 len;
+      Ok (Bytes.unsafe_to_string s)
+    end else begin
+      R.error_msgf "read %a: file too large (%a, max supported size: %a)"
+        Fpath.pp file Fmt.byte_size len Fmt.byte_size Sys.max_string_length
+    end
+  in
+  match with_ic file input () with
+  | Ok (Ok _ as v) -> v
+  | Ok (Error _ as e) -> e
+  | Error _ as e -> e
+
+let fold_lines f acc file =
+  let input ic acc =
+    let rec loop acc =
+      match try Some (input_line ic) with End_of_file -> None with
+      | None -> acc
+      | Some line -> loop (f acc line)
+    in
+    loop acc
+  in
+  with_ic file input acc
+
+let read_lines file = fold_lines (fun acc l -> l :: acc) [] file >>| List.rev
+
+(* Temporary files *)
+
+type tmp_name_pat = (string -> string, Format.formatter, unit, string) format4
+
+let rec unlink_tmp file = try Unix.unlink (Fpath.to_string file) with
+| Unix.Unix_error (Unix.EINTR, _, _) -> unlink_tmp file
+| Unix.Unix_error (e, _, _) -> ()
+
+let tmps = ref Fpath.Set.empty
+let tmps_add file = tmps := Fpath.Set.add file !tmps
+let tmps_rem file = unlink_tmp file; tmps := Fpath.Set.remove file !tmps
+let unlink_tmps () = Fpath.Set.iter unlink_tmp !tmps
+
+let () = at_exit unlink_tmps
+
+let create_tmp_path mode dir pat =
+  let err () =
+    R.error_msgf "create temporary file %s in %a: too many failing attempts"
+      (strf pat "XXXXXX") Fpath.pp dir
+  in
+  let rec loop count =
+    if count < 0 then err () else
+    let file = Bos_os_tmp.rand_path dir pat in
+    let sfile = Fpath.to_string file in
+    let open_flags = Unix.([O_WRONLY; O_CREAT; O_EXCL; O_SHARE_DELETE]) in
+    try Ok (file, Unix.(openfile sfile open_flags mode)) with
+    | Unix.Unix_error (Unix.EEXIST, _, _) -> loop (count - 1)
+    | Unix.Unix_error (Unix.EINTR, _, _) -> loop count
+    | Unix.Unix_error (e, _, _) ->
+        R.error_msgf "create temporary file %a: %s" Fpath.pp file (uerror e)
+  in
+  loop 10000
+
+let default_tmp_mode = 0o600
+
+let tmp ?(mode = default_tmp_mode) ?dir pat =
+  let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in
+  create_tmp_path mode dir pat >>= fun (file, fd) ->
+  let rec close fd = try Unix.close fd with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> close fd
+  | Unix.Unix_error (e, _, _) -> ()
+  in
+  close fd; tmps_add file; Ok file
+
+let with_tmp_oc ?(mode = default_tmp_mode) ?dir pat f v =
+  try
+    let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in
+    create_tmp_path mode dir pat >>= fun (file, fd) ->
+    let oc = Unix.out_channel_of_descr fd in
+    let delete_close oc = tmps_rem file; close_out oc in
+    tmps_add file;
+    try Ok (Bos_base.apply (f file oc) v ~finally:delete_close oc) with
+    | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e
+  with Sys_error e -> R.error_msg e
+
+let with_tmp_output ?(mode = default_tmp_mode) ?dir pat f v =
+  try
+    let dir = match dir with None -> Bos_os_tmp.default_dir () | Some d -> d in
+    create_tmp_path mode dir pat >>= fun (file, fd) ->
+    let oc = Unix.out_channel_of_descr fd in
+    let oc_valid = ref true in
+    let delete_close oc = oc_valid := false; tmps_rem file; close_out oc in
+    let output b =
+      if not !oc_valid then invalid_arg err_invalid_output else
+      match b with
+      | Some (b, pos, len) -> output oc b pos len
+      | None -> flush oc
+    in
+    tmps_add file;
+    try Ok (Bos_base.apply (f file output) v ~finally:delete_close oc) with
+    | Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e
+  with Sys_error e -> R.error_msg e
+
+(* Output *)
+
+type output = (Bytes.t * int * int) option -> unit
+
+let default_mode = 0o644
+
+let rec rename src dst =
+  try Unix.rename (Fpath.to_string src) (Fpath.to_string dst); Ok () with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> rename src dst
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "rename %a to %a: %s"
+        Fpath.pp src Fpath.pp dst (uerror e)
+
+let stdout_with_output f v =
+  try
+    let output_valid = ref true in
+    let close () = output_valid := false in
+    let output b =
+      if not !output_valid then invalid_arg err_invalid_output else
+      match b with
+      | Some (b, pos, len) -> output stdout b pos len
+      | None -> flush stdout
+    in
+    Ok (Bos_base.apply (f output) v ~finally:close ())
+  with Sys_error e -> R.error_msg e
+
+let with_output ?(mode = default_mode) file f v =
+  if is_dash file then stdout_with_output f v else
+  let do_write tmp tmp_out v = match f tmp_out v with
+  | Error _ as v -> Ok v
+  | Ok _ as v ->
+      match rename tmp file with
+      | Error _ as e -> e
+      | Ok () -> Ok v
+  in
+  match with_tmp_output ~mode ~dir:(Fpath.parent file) "bos-%s.tmp" do_write v
+  with
+  | Ok (Ok _ as r) -> r
+  | Ok (Error _ as e) -> e
+  | Error _ as e -> e
+
+let with_oc ?(mode = default_mode) file f v =
+  if is_dash file
+  then Ok (Bos_base.apply (f stdout) v ~finally:(fun () -> ()) ())
+  else
+  let do_write tmp tmp_oc v = match f tmp_oc v with
+  | Error _ as v -> Ok v
+  | Ok _ as v ->
+      match rename tmp file with
+      | Error _ as e -> e
+      | Ok () -> Ok v
+  in
+  match with_tmp_oc ~mode ~dir:(Fpath.parent file) "bos-%s.tmp" do_write v with
+  | Ok (Ok _ as r) -> r
+  | Ok (Error _ as e) -> e
+  | Error _ as e -> e
+
+let write ?mode file contents =
+  let write oc contents = output_string oc contents; Ok () in
+  R.join @@ with_oc ?mode file write contents
+
+let writef ?mode file fmt = (* FIXME avoid the kstrf  *)
+  Fmt.kstr (fun content -> write ?mode file content) fmt
+
+let write_lines ?mode file lines =
+  let rec write oc = function
+  | [] -> Ok ()
+  | l :: ls ->
+      output_string oc l;
+      if ls <> [] then (output_char oc '\n'; write oc ls) else Ok ()
+  in
+  R.join @@ with_oc ?mode file write lines
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_path.ml

@@ -0,0 +1,467 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+open Rresult
+
+let uerror = Unix.error_message
+
+(* Existence *)
+
+let rec file_exists file =
+  try Ok (Unix.((stat @@ Fpath.to_string file).st_kind = S_REG)) with
+  | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok false
+  | Unix.Unix_error (Unix.EINTR, _, _) -> file_exists file
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "file %a exists: %s" Fpath.pp file (uerror e)
+
+let rec dir_exists dir =
+  try Ok (Unix.((stat @@ Fpath.to_string dir).st_kind = S_DIR)) with
+  | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok false
+  | Unix.Unix_error (Unix.EINTR, _, _) -> dir_exists dir
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "directory %a exists: %s" Fpath.pp dir (uerror e)
+
+let rec exists path =
+  try Ok (ignore @@ Unix.stat (Fpath.to_string path); true) with
+  | Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> Ok false
+  | Unix.Unix_error (Unix.EINTR, _, _) -> exists path
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "path %a exists: %s" Fpath.pp path (uerror e)
+
+let rec file_must_exist file =
+  try match Unix.((stat @@ Fpath.to_string file).st_kind) with
+  | Unix.S_REG -> Ok file
+  | _ -> R.error_msgf "%a: Not a file" Fpath.pp file
+  with
+  | Unix.Unix_error (Unix.ENOENT, _, _) ->
+      R.error_msgf "%a: No such file" Fpath.pp file
+  | Unix.Unix_error (Unix.EINTR, _, _) -> file_must_exist file
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "file %a must exist: %s" Fpath.pp file (uerror e)
+
+let rec dir_must_exist dir =
+  try match Unix.((stat @@ Fpath.to_string dir).st_kind) with
+  | Unix.S_DIR -> Ok dir
+  | _ -> R.error_msgf "%a: Not a directory" Fpath.pp dir
+  with
+  | Unix.Unix_error (Unix.ENOENT, _, _) ->
+      R.error_msgf "%a: No such directory" Fpath.pp dir
+  | Unix.Unix_error (Unix.EINTR, _, _) -> dir_must_exist dir
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "directory  %a must exist: %s" Fpath.pp dir (uerror e)
+
+let rec must_exist path =
+  try ignore @@ Unix.stat (Fpath.to_string path); Ok path with
+  | Unix.Unix_error (Unix.ENOENT, _, _) ->
+      R.error_msgf "%a: No such path" Fpath.pp path
+  | Unix.Unix_error (Unix.EINTR, _, _) -> must_exist path
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "path %a must exist: %s" Fpath.pp path (uerror e)
+
+(* Delete *)
+
+let delete_file ?(must_exist = false) file =
+  let rec unlink file = try Ok (Unix.unlink @@ Fpath.to_string file) with
+  | Unix.Unix_error (Unix.ENOENT, _, _) ->
+      if not must_exist then Ok () else
+      R.error_msgf "delete file %a: No such file" Fpath.pp file
+  | Unix.Unix_error (Unix.EINTR, _, _) -> unlink file
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "delete file %a: %s" Fpath.pp file (uerror e)
+  in
+  unlink file
+
+let delete_dir ?must_exist:(must = false) ?(recurse = false) dir =
+  let rec delete_files to_rmdir dirs = match dirs with
+  | [] -> Ok to_rmdir
+  | dir :: todo ->
+      let rec delete_dir_files dh dirs =
+        match (try Some (Unix.readdir dh) with End_of_file -> None) with
+        | None -> Ok dirs
+        | Some (".." | ".") -> delete_dir_files dh dirs
+        | Some file ->
+            let rec try_unlink file =
+              try (Unix.unlink (Fpath.to_string file); Ok dirs) with
+              | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok dirs
+              | Unix.Unix_error ((Unix.EISDIR (* Linux *)
+                                 |Unix.EPERM), _, _) -> Ok (file :: dirs)
+              | Unix.Unix_error ((Unix.EACCES, _, _)) when Sys.win32 ->
+                  (* That's what Unix uses on Windows
+                     https://msdn.microsoft.com/en-us/library/1c3tczd6.aspx
+                     and it's rather unhelpful w.r.t. error codes. *)
+                  Ok (file :: dirs)
+              | Unix.Unix_error (Unix.EINTR, _, _) -> try_unlink file
+              | Unix.Unix_error (e, _, _) ->
+                  R.error_msgf "%a: %s" Fpath.pp file (uerror e)
+            in
+            match try_unlink Fpath.(dir / file) with
+            | Ok dirs -> delete_dir_files dh dirs
+            | Error _ as e -> e
+      in
+      try
+        let dh = Unix.opendir (Fpath.to_string dir) in
+        match Bos_base.apply (delete_dir_files dh) [] ~finally:Unix.closedir dh
+        with
+        | Ok dirs -> delete_files (dir :: to_rmdir) (List.rev_append dirs todo)
+        | Error _ as e -> e
+      with
+      | Unix.Unix_error (Unix.ENOENT, _, _) -> delete_files to_rmdir todo
+      | Unix.Unix_error (Unix.EINTR, _, _) -> delete_files to_rmdir dirs
+      | Unix.Unix_error (e, _, _) ->
+          R.error_msgf "%a: %s" Fpath.pp dir (uerror e)
+  in
+  let rec delete_dirs = function
+  | [] -> Ok ()
+  | dir :: dirs ->
+      let rec rmdir dir = try Ok (Unix.rmdir (Fpath.to_string dir)) with
+      | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok ()
+      | Unix.Unix_error (Unix.EINTR, _, _) -> rmdir dir
+      | Unix.Unix_error (e, _, _) ->
+          R.error_msgf "%a: %s" Fpath.pp dir (uerror e)
+      in
+      match rmdir dir with
+      | Ok () -> delete_dirs dirs
+      | Error _ as e -> e
+  in
+  let delete recurse dir =
+    if not recurse then
+      let rec rmdir dir = try Ok (Unix.rmdir (Fpath.to_string dir)) with
+      | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok ()
+      | Unix.Unix_error (Unix.EINTR, _, _) -> rmdir dir
+      | Unix.Unix_error (e, _, _) -> R.error_msgf "%s" (uerror e)
+      in
+      rmdir dir
+    else
+    delete_files [] [dir] >>= fun rmdirs ->
+    delete_dirs rmdirs
+  in
+  begin
+    (if must then dir_must_exist dir else Ok dir)
+    >>= fun dir -> delete recurse dir
+  end
+  |> R.reword_error_msg ~replace:true
+    (fun msg -> R.msgf "delete directory %a: %s" Fpath.pp dir msg)
+
+let rec delete ?(must_exist = false) ?(recurse = false) path =
+  try match Unix.((stat (Fpath.to_string path)).st_kind) with
+  | Unix.S_DIR -> delete_dir ~must_exist ~recurse path
+  | _ -> delete_file ~must_exist path
+  with
+  | Unix.Unix_error (Unix.ENOENT, _, _) ->
+      if not must_exist then Ok () else
+      R.error_msgf "delete path %a: No such path" Fpath.pp path
+  | Unix.Unix_error (Unix.EINTR, _, _) -> delete ~must_exist ~recurse path
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "delete path %a: %s" Fpath.pp path (uerror e)
+
+(* Move, stat and mode *)
+
+let move ?(force = false) src dst =
+  let rename src dst =
+    try Ok (Unix.rename (Fpath.to_string src) (Fpath.to_string dst)) with
+    | Unix.Unix_error (e, _, _) ->
+        R.error_msgf "move %a to %a: %s"
+          Fpath.pp src Fpath.pp dst (uerror e)
+  in
+  if force then rename src dst else
+  exists dst >>= function
+  | false -> rename src dst
+  | true ->
+      R.error_msgf "move %a to %a: Destination exists"
+        Fpath.pp src Fpath.pp dst
+
+let rec stat p = try Ok (Unix.stat (Fpath.to_string p)) with
+| Unix.Unix_error (Unix.EINTR, _, _) -> stat p
+| Unix.Unix_error (e, _, _) ->
+    R.error_msgf "stat %a: %s" Fpath.pp p (uerror e)
+
+module Mode = struct
+  type t = int
+
+  let rec get p = try Ok (Unix.((stat (Fpath.to_string p)).st_perm)) with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> get p
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "get mode %a: %s" Fpath.pp p (uerror e)
+
+  let rec set p m = try Ok (Unix.chmod (Fpath.to_string p) m) with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> set p m
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "set mode %a: %s" Fpath.pp p (uerror e)
+end
+
+(* Path links *)
+
+let rec force_remove op target p =
+  let sp = Fpath.to_string p in
+  try match Unix.((lstat sp).st_kind) with
+  | Unix.S_DIR -> Ok (Unix.rmdir sp)
+  | _ -> Ok (Unix.unlink sp)
+  with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> force_remove op target p
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "force %s %a to %a: %s" op Fpath.pp target Fpath.pp p
+        (uerror e)
+
+let rec link ?(force = false) ~target p =
+  try Ok (Unix.link (Fpath.to_string target) (Fpath.to_string p)) with
+  | Unix.Unix_error (Unix.EEXIST, _, _) when force ->
+      force_remove "link" target p >>= fun () -> link ~force ~target p
+  | Unix.Unix_error (Unix.EINTR, _, _) -> link ~force ~target p
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "link %a to %a: %s"
+        Fpath.pp target Fpath.pp p (uerror e)
+
+let rec symlink ?(force = false) ~target p =
+  try Ok (Unix.symlink (Fpath.to_string target) (Fpath.to_string p)) with
+  | Unix.Unix_error (Unix.EEXIST, _, _) when force ->
+      force_remove "symlink" target p >>= fun () -> symlink ~force ~target p
+  | Unix.Unix_error (Unix.EINTR, _, _) -> symlink ~force ~target p
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "symlink %a to %a: %s"
+        Fpath.pp target Fpath.pp p (uerror e)
+
+let rec symlink_target p =
+  try
+    let l = Unix.readlink (Fpath.to_string p) in
+    match Fpath.of_string l with
+    | Ok l -> Ok l
+    | Error _ ->
+        R.error_msgf "target of %a: could not read a path from %a"
+          Fpath.pp p String.dump l
+  with
+  | Unix.Unix_error (Unix.EINVAL, _, _) ->
+      R.error_msgf "target of %a: Not a symbolic link" Fpath.pp p
+  | Unix.Unix_error (Unix.EINTR, _, _) -> symlink_target p
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "target of %a: %s" Fpath.pp p (uerror e)
+
+let rec symlink_stat p = try Ok (Unix.lstat (Fpath.to_string p)) with
+| Unix.Unix_error (Unix.EINTR, _, _) -> symlink_stat p
+| Unix.Unix_error (e, _, _) ->
+    R.error_msgf "symlink stat %a: %s" Fpath.pp p (uerror e)
+
+(* Matching paths. *)
+
+(* The following code is horribly messy mainly due to volume
+   handling. Could certainly be improved. *)
+
+let rec match_segment dotfiles ~env acc path seg =
+  (* N.B. path can be empty, usually for relative patterns without volume. *)
+  let var_start = match seg with Bos_pat.Var _ :: _ -> true | _ -> false in
+  let rec readdir dh acc =
+    match (try Some (Unix.readdir dh) with End_of_file -> None) with
+    | None -> Ok acc
+    | Some (".." | ".") -> readdir dh acc
+    | Some e when String.length e > 1 && e.[0] = '.' && not dotfiles &&
+                  var_start ->
+        readdir dh acc
+    | Some e ->
+        match Fpath.is_seg e with
+        | true ->
+            begin match Bos_pat.match_pat ~env 0 e seg with
+            | None -> readdir dh acc
+            | Some _ as m ->
+                let p =
+                  if path = "" then e else
+                  Fpath.(to_string (add_seg (Fpath.v path) e))
+                in
+                readdir dh ((p, m) :: acc)
+            end
+        | false ->
+            R.error_msgf
+              "directory %a: cannot parse element to a path (%a)"
+              Fpath.pp (Fpath.v path) String.dump e
+  in
+  try
+    let path = if path = "" then "." else path in
+    let dh = Unix.opendir path in
+    Bos_base.apply (readdir dh) acc ~finally:Unix.closedir dh
+  with
+  | Unix.Unix_error (Unix.ENOTDIR, _, _) -> Ok acc
+  | Unix.Unix_error (Unix.ENOENT, _, _) -> Ok acc
+  | Unix.Unix_error (Unix.EINTR, _, _) ->
+      match_segment dotfiles ~env acc path seg
+  | Unix.Unix_error (e, _, _) ->
+      R.error_msgf "directory %a: %s" Fpath.pp (Fpath.v path) (uerror e)
+
+let match_path ?(dotfiles = false) ~env p =
+  let err _ =
+    R.msgf "Unexpected error while matching `%a'" Fpath.pp p
+  in
+  let vol, start, segs =
+    let vol, segs = Fpath.split_volume p in
+    match Fpath.segs segs with
+    | "" :: "" :: [] (* root *) ->  vol, Fpath.dir_sep, []
+    | "" :: ss -> vol, Fpath.dir_sep, ss
+    | ss -> vol, "", ss (* N.B. ss is non empty. *)
+  in
+  let rec match_segs acc = function
+  | [] -> Ok acc
+  | "" :: [] -> (* final empty segment "", keep only directories. *)
+      let rec loop acc = function
+      | [] -> Ok acc
+      | (p, env) :: matches ->
+          let r = try Ok (Unix.((stat p).st_kind = Unix.S_DIR)) with
+          | Unix.Unix_error (e, _, _) -> R.error_msgf "%s: %s" p (uerror e)
+          in
+          match r with
+          | Error _ as e -> e
+          | Ok false -> loop acc matches
+          | Ok true ->
+              let acc' = Fpath.(to_string (add_seg (v p) ""), env) :: acc in
+              loop acc' matches
+      in
+      loop [] acc
+  | (".." | "." as e) :: segs ->
+      (* We simply add the segment to current matches. No need
+         to test if the resulting path exists. We can always go up (root
+         absorbs) or stay at the same level. *)
+      let rec loop acc = function
+      | [] -> acc
+      | (p, env) :: matches ->
+          let p =
+            if p = vol then p ^ e (* C:.. *) else
+            Fpath.(to_string (add_seg (v p) e))
+          in
+          loop ((p, env) :: acc) matches
+      in
+      match_segs (loop [] acc) segs
+  | seg :: segs ->
+      match Bos_pat.of_string seg with
+      | Error _ as e -> e
+      | Ok seg ->
+          let rec loop acc = function
+          | [] -> Ok acc
+          | (p, env) :: matches ->
+              match match_segment dotfiles ~env acc p seg with
+              | Error _ as e -> e
+              | Ok acc -> loop acc matches
+          in
+          match loop [] acc with
+          | Error _ as e -> e
+          | Ok acc -> match_segs acc segs
+  in
+  let start_exists vol start =
+    let start = if start = "" then "." else start in
+    exists (Fpath.v (vol ^ start))
+  in
+  start_exists vol start >>= function
+  | false -> Ok []
+  | true ->
+      let start = if start = "" then vol else vol ^ start in
+      R.reword_error_msg err @@ match_segs [start, env] segs
+
+let matches ?dotfiles p =
+  let get_path acc (p, _) = (Fpath.v p) :: acc in
+  match_path ?dotfiles ~env:None p >>| List.fold_left get_path []
+
+let query ?dotfiles ?(init = String.Map.empty) p =
+  let env = Some init in
+  let unopt_map acc (p, map) = match map with
+  | None -> assert false
+  | Some map -> (Fpath.v p, map) :: acc
+  in
+  match_path ?dotfiles ~env p >>| List.fold_left unopt_map []
+
+(* Folding over file system hierarchies *)
+
+type 'a res = ('a, R.msg) result
+type traverse = [ `Any | `None | `Sat of Fpath.t -> bool res ]
+type elements = [ `Any | `Files | `Dirs | `Sat of Fpath.t -> bool res ]
+type 'a fold_error = Fpath.t -> 'a res -> unit res
+
+let log_fold_error ~level =
+  fun p -> function
+  | Error (`Msg e) -> Bos_log.msg level (fun m -> m "%s" e); Ok ()
+  | Ok _ -> assert false
+
+exception Fold_stop of R.msg
+
+let err_fun err f ~backup_value = (* handles path function errors in folds *)
+  fun p -> match f p with
+  | Ok v -> v
+  | Error _ as e ->
+      match err p e with
+      | Ok () -> backup_value   (* use backup value and continue the fold. *)
+      | Error m -> raise (Fold_stop m)                  (* the fold stops. *)
+
+let err_predicate_fun err p = err_fun err p ~backup_value:false
+
+let do_traverse_fun err = function
+| `Any -> fun _ -> true
+| `None -> fun _ -> false
+| `Sat sat -> err_predicate_fun err sat
+
+let is_element_fun err = function
+| `Any -> err_predicate_fun err exists
+| `Files -> err_predicate_fun err file_exists
+| `Dirs -> err_predicate_fun err dir_exists
+| `Sat sat -> err_predicate_fun err sat
+
+let is_dir_fun err =
+  let is_dir p = try Ok (Sys.is_directory (Fpath.to_string p)) with
+  | Sys_error e -> R.error_msg e
+  in
+  err_predicate_fun err is_dir
+
+let readdir_fun err =
+  let readdir d = try Ok (Sys.readdir (Fpath.to_string d)) with
+  | Sys_error e -> R.error_msg e
+  in
+  err_fun err readdir ~backup_value:[||]
+
+let fold
+    ?(err = log_fold_error ~level:Logs.Error)
+    ?(dotfiles = false)
+    ?(elements = `Any) ?(traverse = `Any)
+    f acc paths
+  =
+  try
+    let do_traverse = do_traverse_fun err traverse in
+    let is_element = is_element_fun err elements in
+    let is_dir = is_dir_fun err in
+    let readdir =  readdir_fun err in
+    let process_path p (acc, to_traverse) =
+      (if is_element p then (f p acc) else acc),
+      (if is_dir p && do_traverse p then p :: to_traverse else to_traverse)
+    in
+    let dir_child d acc bname =
+      if not dotfiles && String.is_prefix "." bname then acc else
+      process_path Fpath.(d / bname) acc
+    in
+    let rec loop acc = function
+    | (d :: ds) :: up ->
+        let childs = readdir d in
+        let acc, to_traverse = Array.fold_left (dir_child d) (acc, []) childs in
+        loop acc (to_traverse :: ds :: up)
+    | [] :: [] -> acc
+    | [] :: up -> loop acc up
+    | _ -> assert false
+    in
+    let init acc p =
+      let base = Fpath.(basename @@ normalize p) in
+      if not dotfiles && String.is_prefix "." base then acc else
+      process_path p acc
+    in
+    let acc, to_traverse = List.fold_left init (acc, []) paths in
+    (Ok (loop acc (to_traverse :: [])))
+  with Fold_stop (`Msg _ as e) -> Error e
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_tmp.ml

@@ -0,0 +1,46 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring
+
+(* Base functions for handling temporary file and directories. *)
+
+let default_dir_init =
+  let from_env var ~absent =
+    match try Some (Sys.getenv var) with Not_found -> None with
+    | None -> absent
+    | Some v ->
+        match Fpath.of_string v with
+        | Error _ -> absent (* FIXME log something ? *)
+        | Ok v -> v
+  in
+  if Sys.os_type = "Win32" then from_env "TEMP" ~absent:Fpath.(v "./") else
+  from_env "TMPDIR" ~absent:(Fpath.v "/tmp")
+
+let default_dir = ref default_dir_init
+let set_default_dir p = default_dir := p
+let default_dir () = !default_dir
+
+let rand_gen = lazy (Random.State.make_self_init ())
+
+let rand_path dir pat =
+  let rand = Random.State.bits (Lazy.force rand_gen) land 0xFFFFFF in
+  Fpath.(dir / strf pat (strf "%06x" rand))
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_os_u.ml

@@ -0,0 +1,55 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+
+type 'a result = ('a, [`Unix of Unix.error]) Rresult.result
+let pp_error ppf (`Unix e ) = Fmt.string ppf (Unix.error_message e)
+let open_error = function Ok _ as r -> r | Error (`Unix _) as r -> r
+let error_to_msg r = R.error_to_msg ~pp_error r
+
+let rec call f v = try Ok (f v) with
+| Unix.Unix_error (Unix.EINTR, _, _) -> call f v
+| Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let mkdir p m = try Ok (Unix.mkdir (Fpath.to_string p) m) with
+| Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let link p p' =
+  try Ok (Unix.link (Fpath.to_string p) (Fpath.to_string p')) with
+  | Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let unlink p = try Ok (Unix.unlink (Fpath.to_string p)) with
+| Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let rename p p' =
+  try Ok (Unix.rename (Fpath.to_string p) (Fpath.to_string p')) with
+  | Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let stat p = try Ok (Unix.stat (Fpath.to_string p)) with
+| Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let lstat p = try Ok (Unix.lstat (Fpath.to_string p)) with
+| Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+let rec truncate p size = try Ok (Unix.truncate (Fpath.to_string p) size) with
+| Unix.Unix_error (Unix.EINTR, _, _) -> truncate p size
+| Unix.Unix_error (e, _, _) -> Error (`Unix e)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_pat.ml

@@ -0,0 +1,206 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+open Astring
+
+(* Errors *)
+
+let err_malformed_pat s =
+  strf "malformed named string pattern: %a" String.dump s
+
+(* Patterns *)
+
+type lexeme = Lit of string | Var of string
+type t = lexeme list
+
+let empty = []
+let dom p =
+  let add acc = function Lit _ -> acc | Var v -> String.Set.add v acc in
+  List.fold_left add String.Set.empty p
+
+let equal p p' = p = p'
+let compare p p' = Stdlib.compare p p'
+
+type parse_state = S_lit | S_dollar | S_var
+
+let of_string s =
+  let b = Buffer.create 255 in
+  let flush b = let s = Buffer.contents b in (Buffer.clear b; s) in
+  let err () = R.error_msg (err_malformed_pat s) in
+  let push_lit b acc =
+    if Buffer.length b <> 0 then Lit (flush b) :: acc else acc
+  in
+  let max_i = String.length s - 1 in
+  let rec loop acc state i =
+    if i > max_i then
+      if state <> S_lit then err () else (Ok (List.rev (push_lit b acc)))
+    else match state with
+    | S_lit ->
+        begin match s.[i] with
+        | '$' -> loop acc S_dollar (i + 1)
+        | c -> Buffer.add_char b c; loop acc S_lit (i + 1)
+        end
+    | S_dollar ->
+        begin match s.[i] with
+        | '$' -> Buffer.add_char b '$'; loop acc S_lit (i + 1)
+        | '(' -> loop (push_lit b acc) S_var (i + 1)
+        | _ -> err ()
+        end
+    | S_var ->
+        begin match s.[i] with
+        | ')' -> loop (Var (flush b) :: acc) S_lit (i + 1);
+        | ',' -> err ()
+        | c -> Buffer.add_char b c; loop acc S_var (i + 1)
+        end
+  in
+  loop [] S_lit 0
+
+let v s = R.error_msg_to_invalid_arg (of_string s)
+
+let to_string p =
+  let b = Buffer.create 255 in
+  let add = function
+  | Lit l ->
+      let max_i = String.length l - 1 in
+      let rec loop start i =
+        if i > max_i then Buffer.add_substring b l start (i - start) else
+        if l.[i] <> '$' then loop start (i + 1) else
+        begin
+          Buffer.add_substring b l start (i - start + 1);
+          Buffer.add_char b '$';
+          let next = i + 1 in loop next next
+        end
+      in
+      loop 0 0
+  | Var v -> Buffer.(add_string b "$("; add_string b v; add_char b ')')
+  in
+  List.iter add p;
+  Buffer.contents b
+
+let escape_dollar s =
+  let len = String.length s in
+  let max_idx = len - 1 in
+  let rec escaped_len i l =
+    if i > max_idx then l else
+    match String.unsafe_get s i with
+    | '$' -> escaped_len (i + 1) (l + 2)
+    | _ -> escaped_len (i + 1) (l + 1)
+  in
+  let escaped_len = escaped_len 0 0 in
+  if escaped_len = len then s else
+  let b = Bytes.create escaped_len in
+  let rec loop i k =
+    if i > max_idx then Bytes.unsafe_to_string b else
+    match String.unsafe_get s i with
+    | '$' ->
+        Bytes.unsafe_set b k '$'; Bytes.unsafe_set b (k + 1) '$';
+        loop (i + 1) (k + 2)
+    | c ->
+        Bytes.unsafe_set b k c;
+        loop (i + 1) (k + 1)
+  in
+  loop 0 0
+
+let rec pp ppf = function
+| [] -> ()
+| Lit l :: p -> Fmt.string ppf (escape_dollar l); pp ppf p
+| Var v :: p -> Fmt.pf ppf "$(%s)" v; pp ppf p
+
+let dump ppf p =
+  let rec dump ppf = function
+  | [] -> ()
+  | Lit l :: p ->
+      Fmt.string ppf (String.Ascii.escape_string (escape_dollar l)); pp ppf p
+  | Var v :: p ->
+      Fmt.pf ppf "$(%s)" v; pp ppf p
+  in
+  Fmt.pf ppf "\"%a\"" dump p
+
+(* Substitution *)
+
+type defs = string String.map
+
+let subst ?(undef = fun _ -> None) defs p =
+  let subst acc = function
+  | Lit _ as l -> l :: acc
+  | Var v as var ->
+      match String.Map.find v defs with
+      | Some lit -> (Lit lit) :: acc
+      | None ->
+          match undef v with
+          | Some lit -> (Lit lit) :: acc
+          | None -> var :: acc
+  in
+  List.(rev (fold_left subst [] p))
+
+let format ?(undef = fun _ -> "") defs p =
+  let b = Buffer.create 255 in
+  let add = function
+  | Lit l -> Buffer.add_string b l
+  | Var v ->
+      match String.Map.find v defs with
+      | Some s -> Buffer.add_string b s
+      | None -> Buffer.add_string b (undef v)
+  in
+  List.iter add p;
+  Buffer.contents b
+
+(* Matching
+   N.B. matching is not t.r. but stack is bounded by number of variables. *)
+
+let match_literal pos s lit =              (* matches [lit] at [pos] in [s]. *)
+  let l_len = String.length lit in
+  let s_len = String.length s - pos in
+  if l_len > s_len then None else
+  try
+    for i = 0 to l_len - 1 do if lit.[i] <> s.[pos + i] then raise Exit done;
+    Some (pos + l_len)
+  with Exit -> None
+
+let match_pat ~env pos s pat =
+  let init, no_env = match env with
+  | None -> Some String.Map.empty, true
+  | Some m as init -> init, false
+  in
+  let rec loop pos = function
+  | [] -> if pos = String.length s then init else None
+  | Lit lit :: p ->
+      begin match (match_literal pos s lit) with
+      | None -> None
+      | Some pos -> loop pos p
+      end
+  | Var n :: p ->
+      let rec try_match next_pos =
+        if next_pos < pos then None else
+        match loop next_pos p with
+        | None -> try_match (next_pos - 1)
+        | Some m as r ->
+            if no_env then r else
+            Some (String.Map.add n
+                  (String.with_index_range s ~first:pos ~last:(next_pos - 1)) m)
+      in
+      try_match (String.length s) (* Longest match first. *)
+  in
+  loop pos pat
+
+let matches p s = (match_pat ~env:None 0 s p) <> None
+let query ?(init = String.Map.empty) p s = match_pat ~env:(Some init) 0 s p
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_setup.ml

@@ -0,0 +1,44 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2016 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+module R = Rresult.R
+include R.Infix
+type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b
+
+let strf = Astring.strf
+let (^) = Astring.(^)
+
+module Char = Astring.Char
+module String = Astring.String
+
+module Pat = Bos.Pat
+module Cmd = Bos.Cmd
+module OS = Bos.OS
+
+module Fmt = Fmt
+module Logs = Logs
+
+let setup () =
+  Fmt_tty.setup_std_outputs ();
+  Logs.set_reporter (Logs_fmt.reporter ());
+  ()
+
+let () = setup ()
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2016 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_setup.mli

@@ -0,0 +1,103 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2016 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+(** Quick setup for simple programs.
+
+    Linking against this module setups {!Logs} and issuing:
+{[
+open Bos_setup
+]}
+    in a module is sufficient to bring {!Rresult}, {!Astring} and
+    {!Bos} in scope. See also how to use this for
+    {{!interpreted}interpreted programs}. *)
+
+(** {1:interpreted Interpreted programs}
+
+To use {!Bos} and this setup in an interpreted program, start the
+file with:
+{[
+#!/usr/bin/env ocaml
+#use "topfind"
+#require "bos.setup"
+open Bos_setup
+]}
+To allow {{:https://github.com/the-lambda-church/merlin}merlin} to function
+correctly issue [M-x merlin-use bos.setup] in [emacs] or
+[:MerlinUse bos.setup] in [vim]. *)
+
+(** {1 Results} *)
+
+(** The type for results. *)
+type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b
+
+val ( >>= ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result
+(** [(>>=)] is {!R.(>>=)}. *)
+
+val ( >>| ) : ('a, 'b) result -> ('a -> 'c) -> ('c, 'b) result
+(** [(>>|)] is {!R.(>>|)}. *)
+
+module R : sig
+  include module type of struct include Rresult.R end
+end
+
+(** {1 Astring} *)
+
+val strf : ('a, Format.formatter, unit, string) Stdlib.format4 -> 'a
+(** [strf] is {!Astring.strf}. *)
+
+val (^) : string -> string -> string
+(** [^] is {!Astring.(^)}. *)
+
+module Char : sig
+  include module type of struct include Astring.Char end
+end
+
+module String : sig
+  include module type of struct include Astring.String end
+end
+
+(** {1 Bos} *)
+
+module Pat : sig
+  include module type of struct include Bos.Pat end
+end
+
+module Cmd : sig
+  include module type of struct include Bos.Cmd end
+end
+
+module OS : sig
+  include module type of struct include Bos.OS end
+end
+
+(** {1 Fmt & Logs}
+
+    {b Note.} The following aliases are strictly speaking not needed but they
+    allow to end-users to use them by expressing a single dependency towards
+    [bos.setup]. *)
+
+module Fmt : sig
+  include module type of struct include Fmt end
+end
+
+module Logs : sig
+  include module type of struct include Logs end
+end
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2016 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_setup.mllib

@@ -0,0 +1 @@
+Bos_setup

unikernel/duniverse/bos/src/bos_top.ml

@@ -0,0 +1,22 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+let () = ignore (Toploop.use_file Format.err_formatter "bos_top_init.ml")
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/bos_top.mllib

@@ -0,0 +1 @@
+Bos_top

unikernel/duniverse/bos/src/bos_top_init.ml

@@ -0,0 +1,24 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Bos;;
+
+#install_printer Pat.dump;;
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/src/dune

@@ -0,0 +1,23 @@
+(library
+ (name bos)
+ (public_name bos)
+ (libraries rresult astring fpath fmt unix logs)
+ (modules bos bos_base bos_cmd bos_log bos_os_arg bos_os_cmd bos_os_dir
+   bos_os_env bos_os_file bos_os_path bos_os_tmp bos_os_u bos_pat)
+ (flags :standard -w -6-27-33-39)
+ (wrapped false))
+
+(library
+ (name bos_top)
+ (public_name bos.top)
+ (libraries compiler-libs.toplevel rresult.top astring.top fpath.top fmt.top
+   logs.top bos)
+ (modules bos_top)
+ (wrapped false))
+
+(library
+ (name bos_setup)
+ (public_name bos.setup)
+ (libraries fmt.tty logs.fmt bos)
+ (modules bos_setup)
+ (wrapped false))

unikernel/duniverse/bos/test/test.ml

@@ -0,0 +1,29 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+let tests () = Testing.run
+    [ Test_pat.suite;
+      Test_cmd.suite;
+      Test_os_cmd.suite; ]
+
+let run () = tests (); Testing.log_results ()
+
+let () = if run () then exit 0 else exit 1
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/test_arg.ml

@@ -0,0 +1,39 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Bos
+
+let debug = OS.Arg.(flag ["g"; "debug"] ~env:"DEBUG" ~doc:"Debug mode.")
+let count = OS.Arg.(flag_all ["c"] ~doc:"Count me.")
+
+let print_parse () =
+  Logs.app (fun m -> m "debug: %b" debug);
+  Logs.app (fun m -> m "count: %d" count);
+  ()
+
+let main () =
+  Logs.set_reporter (Logs_fmt.reporter ());
+  OS.Arg.parse_opts ();
+  print_parse ();
+  ()
+
+let () = main ()
+
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/test_arg_pos.ml

@@ -0,0 +1,44 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Bos
+
+let debug = OS.Arg.(flag ["g"; "debug"] ~env:"DEBUG" ~doc:"Debug mode.")
+
+let () = Fmt.(set_style_renderer stdout `Ansi_tty)
+
+let print_parse depth ints =
+  Logs.app (fun m -> m "debug: %b" debug);
+  Logs.app (fun m -> m "depth: %d" depth);
+  Logs.app (fun m -> m "pos: @[%a@]" Fmt.(list ~sep:sp int) ints);
+  ()
+
+let main () =
+  Logs.set_reporter (Logs_fmt.reporter ());
+  let depth =
+    OS.Arg.(opt ["d"; "depth"] int ~absent:2
+              ~doc:"Specifies depth of $(docv) iterations.")
+  in
+  let doc = "Testing the OS.Arg module." in
+  print_parse depth (OS.Arg.(parse ~doc ~pos:int ()))
+
+let () = main ()
+
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/test_cmd.ml

@@ -0,0 +1,47 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Testing
+open Rresult
+open Astring
+open Bos
+
+let of_string = test "Cmd.of_string" @@ fun () ->
+  let eq cmd l = match Cmd.of_string cmd with
+  | Error (`Msg msg) -> fail "%s" msg
+  | Ok l' -> eq_list ~eq:(=) ~pp:pp_str (Cmd.to_list l') l
+  in
+  eq "" [];
+  eq "bla" ["bla"];
+  eq " bla bli" ["bla"; "bli"];
+  eq " bla bli  " ["bla"; "bli"];
+  eq " bla b\\li  " ["bla"; "b\\li"];
+  eq " b'haha'la bli  " ["bhahala"; "bli"];
+  eq " b\"haha\"la bli  " ["bhahala"; "bli"];
+  eq " b\"'\"la bli  " ["b'la"; "bli"];
+  eq " b''''la bli  " ["bla"; "bli"];
+  eq " b'u'\"'\"'i'la bli  " ["bu'ila"; "bli"];
+  eq " b\"\\\"\"ila bli  " ["b\"ila"; "bli"];
+  eq " b\"\\\n\"ila bli  " ["bila"; "bli"];
+  ()
+
+let suite = suite "Cmd module"
+    [ of_string; ]
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/test_os_cmd.ml

@@ -0,0 +1,76 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Testing
+open Astring
+open Rresult
+open Bos
+
+let eqb = eq_result_msg ~eq_ok:(=) ~pp_ok:pp_bool
+let eqs = eq_result_msg ~eq_ok:(=) ~pp_ok:pp_str
+let equ = eq_result_msg ~eq_ok:(=) ~pp_ok:pp_unit
+let eql = eq_result_msg ~eq_ok:(=) ~pp_ok:(pp_list pp_str)
+
+let cat = Cmd.(v "cat")
+let cat_stdin = Cmd.(cat % "-")
+let unlikely = Cmd.v "6AC0E501-4E30-4CBC-AD03-F880F885BC18"
+
+let exists = test "OS.Cmd.exists" @@ fun () ->
+  eqb (OS.Cmd.exists cat) (Ok true);
+  eqb (OS.Cmd.exists unlikely) (Ok false);
+  ()
+
+let must_exist = test "OS.Cmd.must_exist" @@ fun () ->
+  begin match (OS.Cmd.must_exist cat) with
+  | Error (`Msg err) -> fail "%s" err
+  | Ok _ -> ()
+  end;
+  begin match (OS.Cmd.must_exist unlikely) with
+  | Ok _ -> fail "%a exists" Cmd.dump unlikely
+  | Error _ -> ()
+  end;
+  ()
+
+let run_io = test "OS.Cmd.run_io" @@ fun () ->
+  let in_hey = OS.Cmd.in_string "hey" in
+  let tmp () = OS.File.tmp "bos_test_%s" in
+  eqs OS.Cmd.(in_hey |> run_io cat_stdin |> to_string) (Ok "hey");
+  eql OS.Cmd.(in_string "hey\nho\n" |> run_io cat_stdin |> to_lines)
+    (Ok ["hey";"ho"]);
+  equ OS.Cmd.(in_hey |> run_io cat_stdin |> to_null) (Ok ());
+  eqs (tmp ()
+       >>= fun tmp -> OS.Cmd.(in_hey |> run_io cat_stdin |> to_file tmp)
+       >>= fun () -> OS.Cmd.(in_hey |> run_io cat |> to_file tmp ~append:true)
+       >>= fun () -> OS.Cmd.(in_file tmp |> run_io Cmd.(cat_stdin % p tmp) |>
+                             to_string))
+    (Ok "heyheyheyhey");
+  eqs (tmp ()
+       >>= fun tmp1 -> tmp()
+       >>= fun tmp2 -> OS.Cmd.(in_hey |> run_io cat_stdin |> to_file tmp1)
+       >>= fun () -> OS.Cmd.(in_file tmp1 |> run_io cat_stdin |> out_run_in)
+       >>= fun pipe ->  OS.Cmd.(pipe |> run_io cat_stdin |> to_file tmp2)
+       >>= fun () -> OS.Cmd.(in_file tmp2 |> run_io cat_stdin |> to_string))
+  (Ok "hey");
+  ()
+
+let suite = suite "OS command run functions"
+    [ exists;
+      run_io; ]
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/test_pat.ml

@@ -0,0 +1,116 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Testing
+open Astring
+open Bos
+
+let eqp = eq ~eq:Pat.equal ~pp:Pat.pp
+let v = Fpath.v
+
+let string_conv = test "Pat.{v,of_string,to_string}" @@ fun () ->
+  let trip p = eq_str p Pat.(to_string (v p)) in
+  app_invalid ~pp:Pat.pp Pat.v "$(";
+  app_invalid ~pp:Pat.pp Pat.v "$(a";
+  app_invalid ~pp:Pat.pp Pat.v "$$$(";
+  app_invalid ~pp:Pat.pp Pat.v "$$$";
+  app_invalid ~pp:Pat.pp Pat.v "$(bla,)";
+  app_invalid ~pp:Pat.pp Pat.v "$(b,la)";
+  trip "Hey $(ho)";
+  trip "Hey $(ho) $(hu)";
+  trip "Hey $(ho) $(h$u)";
+  trip "Hey mo $$(hu)";
+  trip "Hey mo $$30";
+  trip "Hey mo $$$$";
+  ()
+
+let dom = test "Pat.dom" @@ fun () ->
+  let eq s l =
+    eq ~eq:String.Set.equal ~pp:String.Set.dump
+      (Pat.(dom @@ v s)) (String.Set.of_list l)
+  in
+  eq "bla" [];
+  eq "bla ha $$" [];
+  eq "hey $(bla)" ["bla"];
+  eq "hey $(bla) $()" ["bla"; ""];
+  eq "hey $(bla) $$(ha) $()" ["bla"; ""];
+  eq "hey $(bla) $(bli) $()" ["bla"; "bli"; ""];
+  ()
+
+let subst = test "Pat.subst" @@ fun () ->
+  let eq ?undef defs p s =
+    eq_str Pat.(to_string @@ subst ?undef defs (v p)) s
+  in
+  let defs = String.Map.of_list ["bli", "bla"] in
+  let undef = function "blu" -> Some "bla$" | _ -> None in
+  eq ~undef defs "hey $$ $(bli) $(bla) $(blu)" "hey $$ bla $(bla) bla$$";
+  eq defs "hey $(blo) $(bla) $(blu)" "hey $(blo) $(bla) $(blu)";
+  ()
+
+let format = test "Pat.format" @@ fun () ->
+  let eq ?undef defs p s = eq_str (Pat.(format ?undef defs (v p))) s in
+  let defs = String.Map.of_list ["hey", "ho"; "hi", "ha$"] in
+  let undef = fun _ -> "undef" in
+  eq ~undef defs "a $$ $(hu)" "a $ undef";
+  eq ~undef defs "a $(hey) $(hi)" "a ho ha$";
+  eq defs "a $$(hey) $$(hi) $(ha)" "a $(hey) $(hi) ";
+  ()
+
+let matches = test "Pat.matches" @@ fun () ->
+  let m p s = Pat.(matches (v p) s) in
+  eq_bool (m "$(mod).mli" "string.mli") true;
+  eq_bool (m "$(mod).mli" "string.mli ") false;
+  eq_bool (m "$(mod).mli" ".mli") true;
+  eq_bool (m "$(mod).mli" ".mli ") false;
+  eq_bool (m "$(mod).$(suff)" "string.mli") true;
+  eq_bool (m "$(mod).$(suff)" "string.mli ") true;
+  eq_bool (m "$()aaa" "aaa") true;
+  eq_bool (m "aaa$()" "aaa") true;
+  eq_bool (m "$()a$()aa$()" "aaa") true;
+  ()
+
+let query = test "Pat.query" @@ fun () ->
+  let u ?init p s = Pat.(query ?init (v p) s) in
+  let eq = eq_option
+      ~eq:(String.Map.equal String.equal) ~pp:(String.Map.dump String.dump)
+  in
+  let eq ?init p s = function
+  | None -> eq (u ?init p s) None
+  | Some l -> eq (u ?init p s) (Some (String.Map.of_list l))
+  in
+  let init = String.Map.of_list ["hey", "ho"] in
+  eq "$(mod).mli" "string.mli" (Some ["mod", "string"]);
+  eq ~init "$(mod).mli" "string.mli" (Some ["mod", "string"; "hey", "ho"]);
+  eq "$(mod).mli" "string.mli " None;
+  eq ~init "$(mod).mli" "string.mli " None;
+  eq "$(mod).mli" "string.mli " None;
+  eq "$(mod).$(suff)" "string.mli" (Some ["mod", "string"; "suff", "mli"]);
+  eq "$(mod).$(suff)" "string.mli" (Some ["mod", "string"; "suff", "mli"]);
+  eq "$(m).$(m)" "string.mli" (Some ["m", "string"]);
+  ()
+
+let suite = suite "Pat module"
+    [ string_conv;
+      dom;
+      subst;
+      format;
+      matches;
+      query; ]
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/testing.ml

@@ -0,0 +1,285 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+
+(* Value equality and pretty printing *)
+
+type 'a eq = 'a -> 'a -> bool
+type 'a pp = Format.formatter -> 'a -> unit
+
+(* Pretty printers *)
+
+let pp = Format.fprintf
+let pp_unit ppf v = pp ppf "()"
+let pp_exn ppf v = pp ppf "%s" (Printexc.to_string v)
+let pp_bool ppf v = pp ppf "%b" v
+let pp_char ppf v = pp ppf "%C" v
+let pp_str ppf v = pp ppf "%S" v
+let pp_int = Format.pp_print_int
+let pp_float ppf v = pp ppf "%.10f" (* bof... *) v
+let pp_int32 ppf v = pp ppf "%ld" v
+let pp_int64 ppf v = pp ppf "%Ld" v
+let pp_text = Format.pp_print_text
+let pp_list pp_v ppf l =
+  let pp_sep ppf () = pp ppf ";@," in
+  pp ppf "@[<1>[%a]@]" (Format.pp_print_list ~pp_sep pp_v) l
+
+let pp_option pp_v ppf = function
+| None -> Format.fprintf ppf "None"
+| Some v -> Format.fprintf ppf "Some %a" pp_v v
+
+let pp_slot_loc ppf l =
+  pp ppf "%s:%d.%d-%d:"
+    l.Printexc.filename l.Printexc.line_number
+    l.Printexc.start_char l.Printexc.end_char
+
+let pp_bt ppf bt = match Printexc.backtrace_slots bt with
+| None -> pp ppf "@,@[%a@]" pp_text "No backtrace. Did you compile with -g ?"
+| Some slots ->
+    let rec loop = function
+    | [] -> assert false
+    | s :: ss ->
+        begin match Printexc.Slot.location s with
+        | None -> ()
+        | Some l when l.Printexc.filename = "test/testing.ml" ||
+                      l.Printexc.filename = "test/test.ml" -> ()
+        | Some l -> pp ppf "@,%a" pp_slot_loc l
+        end;
+        if ss <> [] then (loop ss) else ()
+    in
+    loop (Array.to_list slots)
+
+(* Assertion counters *)
+
+let fail_count = ref 0
+let pass_count = ref 0
+
+(* Logging *)
+
+let log_part fmt = Format.printf fmt
+let log ?header fmt = match header with
+| Some h -> Format.printf ("[%s] " ^^ fmt ^^ "@.") h
+| None -> Format.printf (fmt ^^ "@.")
+
+let log_results () =
+  let total = !pass_count + !fail_count in
+  match !fail_count with
+  | 0 -> log ~header:"OK" "All %d assertions succeeded !@." total; true
+  | 1 -> log ~header:"FAIL" "1 failure out of %d assertions" total; false
+  | n -> log ~header:"FAIL" "%d failures out of %d assertions"
+           !fail_count total; false
+
+let log_fail msg bt =
+  log ~header:"FAIL" "@[<v>@[%a@]%a@]" pp_text msg pp_bt bt
+
+let log_unexpected_exn ~header exn bt =
+  log ~header:"SUITE" "@[<v>@[ABORTED: unexpected exception:@]@,%a%a@]"
+    pp_exn exn pp_bt bt
+
+(* Testing scopes *)
+
+exception Fail
+exception Fail_handled
+
+let block f = try f () with
+| Fail | Fail_handled -> ()
+| exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    incr fail_count;
+    log_unexpected_exn ~header:"BLOCK" exn bt
+
+type test = string * (unit -> unit)
+
+let test n f = n, f
+let run_test (n, f) =
+  log "* %s" n;
+  try f () with
+  | Fail | Fail_handled ->
+      log ~header:"TEST" "ABORTED: a test failure blew the test scope"
+  | exn ->
+      let bt = Printexc.get_raw_backtrace () in
+      incr fail_count;
+      log_unexpected_exn ~header:"TEST" exn bt
+
+type suite = string * test list
+let suite n ts = n, ts
+let run_suite (n, ts) = try log "%s" n; List.iter run_test ts with
+| exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    incr fail_count;
+    log_unexpected_exn ~header:"SUITE" exn bt
+
+let run suites = List.iter run_suite suites
+
+(* Passing and failing tests *)
+
+let pass () = incr pass_count
+let fail fmt =
+  let bt = Printexc.get_callstack 10 in
+  let fail _ = log_fail (Format.flush_str_formatter ()) bt in
+  (incr fail_count; Format.kfprintf fail Format.str_formatter fmt)
+
+(* Checking values *)
+
+let pp_neq pp_v ppf (v, v') = pp ppf "@[%a@]@ <>@ @[%a@]@]" pp_v v pp_v v'
+
+let fail_eq pp v v' = fail "%a" (pp_neq pp) (v, v')
+
+let eq ~eq ~pp v v' = if eq v v' then pass () else fail_eq pp v v'
+let eq_char = eq ~eq:(=) ~pp:pp_char
+let eq_str = eq ~eq:(=) ~pp:pp_str
+let eq_bool = eq ~eq:(=) ~pp:Format.pp_print_bool
+let eq_int = eq ~eq:(=) ~pp:Format.pp_print_int
+let eq_int32 = eq ~eq:(=) ~pp:pp_int32
+let eq_int64 = eq ~eq:(=) ~pp:pp_int64
+let eq_float = eq ~eq:(=) ~pp:pp_float
+let eq_nan f =
+  if f <> f then pass () else fail "@[%a@]@ is@ not a NaN" pp_float f
+
+let eq_option ~eq:eq_v ~pp =
+  let eq_opt v v' = match v, v' with
+  | Some v, Some v' -> eq_v v v'
+  | None, None -> true
+  | _ -> false
+  in
+  let pp = pp_option pp in
+  fun v v' -> eq ~eq:eq_opt ~pp v v'
+
+let eq_some = function
+| Some _ -> pass ()
+| None -> fail "None <> Some _"
+
+let eq_none ~pp = function
+| None -> pass ()
+| Some v -> fail "@[%a <>@ None@]" pp v
+
+let eq_list ~eq:eq_v ~pp:pp_v =
+  let eql l l' = try List.for_all2 eq_v l l' with Invalid_argument _ -> false in
+  fun l l' -> eq ~eq:eql ~pp:(pp_list pp_v) l l'
+
+let eq_result ~eq_ok ~pp_ok ~eq_error ~pp_error =
+  let eqr v v' = match v, v' with
+  | Ok v, Ok v' -> eq_ok v v'
+  | Error e, Error e' -> eq_error e e'
+  | _ -> false
+  in
+  let pp ppf r = Rresult.R.pp ~ok:pp_ok ~error:pp_error ppf r in
+  fun v v' -> eq ~eq:eqr ~pp v v'
+
+let eq_result_msg ~eq_ok ~pp_ok =
+  let eq_error (`Msg e) (`Msg e') = (e = e') in
+  eq_result ~eq_ok ~pp_ok ~eq_error:eq_error ~pp_error:R.pp_msg
+
+let eq_ok ~eq:eq_v ~pp:pp_v =
+  let eq_ok v v' = match v, v' with
+  | Ok v, Ok v' -> eq_v v v'
+  | Error _, _-> false
+  | _ -> assert false
+  in
+  let pp ppf = function
+  | Ok v -> Format.fprintf ppf "@[Ok %a@]" pp_v v
+  | Error _ -> Format.fprintf ppf "@[Error _@]"
+  in
+  fun v v' -> eq ~eq:eq_ok ~pp v (Ok v')
+
+(* Tracing and checking function applications. *)
+
+type app = (* Gathers information about the application *)
+  { fail_count : int; (* fail_count checkpoint when the app starts *)
+    pp_args : Format.formatter -> unit -> unit; }
+
+let ctx () = { fail_count = -1; pp_args = fun ppf () -> (); }
+
+let log_app_raised app exn =
+  log "@[<2>@[%a@]==> raised %a" app.pp_args () pp_exn exn
+
+let pp_app app pp_v ppf v =
+  pp ppf "@[<2>@[%a@]==>@ @[%a@]@]" app.pp_args () pp_v v
+
+let log_app app pp_v v = log "%a" (pp_app app pp_v) v
+
+let ( $ ) f k = k (ctx ()) f
+
+let ( @-> ) (pp_v : 'a pp) k app f v =
+  let pp_args ppf () = app.pp_args ppf (); pp ppf "%a@ " pp_v v in
+  let fc = if app.fail_count = -1 then !fail_count else app.fail_count in
+  let app = { fail_count = fc; pp_args } in
+  try k app (f v) with
+  | Fail ->
+      log_app app pp_v v;
+      raise Fail_handled
+  | Fail_handled as e -> raise e
+  | exn ->
+      log_app_raised app exn;
+      fail "unexpected exception %a raised" pp_exn exn;
+      raise Fail_handled
+
+let ret pp app v =
+  if !fail_count <> app.fail_count then log_app app pp v;
+  v
+
+let ret_eq ~eq pp r app v =
+  if eq r v then (pass (); ret pp app v) else
+  (fail "@[<v>%a@,%a@]" (pp_neq pp) (r, v) (pp_app app pp) v;
+   raise Fail_handled)
+
+let ret_none pp app v = match v with
+| None -> pass (); ret (pp_option pp) app v
+| Some _ -> ret_eq ~eq:(=) (pp_option pp) None app v
+
+let ret_some pp app v = match v with
+| Some _ as v -> pass (); ret (pp_option pp) app v
+| None as v ->
+    fail "@[<v>Some _ <> None@,%a@]" (pp_app app (pp_option pp)) v;
+    raise Fail_handled
+
+let ret_get_option pp app v = match ret_some pp app v with
+| Some v -> v
+| None -> assert false
+
+(* I think we could handle the following functions on app traced ones
+   by enriching the app type and have alternate functions to $ for
+   handling these cases. Note that the only place were we can check
+   for these things are in the @-> combinator *)
+
+let app_invalid ~pp f v =
+  try
+    let r = f v in
+    fail "%a <> exception Invalid_arg _" pp r
+  with
+  | Invalid_argument _ -> pass ()
+  | exn -> fail "exception %a <> exception Invalid_arg _" pp_exn exn
+
+let app_exn ~pp e f v =
+  try
+    let r = f v in
+    fail "%a <> exception %a" pp r pp_exn e
+  with
+  | exn when exn = e -> pass ()
+  | exn -> fail "exception %a <> exception %a_" pp_exn exn pp_exn e
+
+let app_raises ~pp f v =
+  try
+    let r = f v in
+    fail "%a <> exception _ " pp r
+  with
+  | exn -> pass ()
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/testing.mli

@@ -0,0 +1,104 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+
+(* {1 Value equality and pretty printing} *)
+
+type 'a eq = 'a -> 'a -> bool
+type 'a pp = Format.formatter -> 'a -> unit
+
+(* {1 Pretty printers} *)
+
+val pp_unit : unit pp
+val pp_int : int pp
+val pp_bool : bool pp
+val pp_float : float pp
+val pp_char : char pp
+val pp_str : string pp
+val pp_list : 'a pp -> 'a list pp
+val pp_option : 'a pp -> 'a option pp
+
+(* {1 Logging} *)
+
+val log_part : ('a, Format.formatter, unit) format -> 'a
+val log : ?header:string -> ('a, Format.formatter, unit) format -> 'a
+val log_results : unit -> bool
+
+(* {1 Testing scopes} *)
+
+type test
+type suite
+
+val block : (unit -> unit) -> unit
+val test : string -> (unit -> unit) -> test
+val suite : string -> test list -> suite
+
+val run : suite list -> unit
+
+(* {1 Passing and failing tests} *)
+
+val pass : unit -> unit
+val fail : ('a, Format.formatter, unit, unit) format4 -> 'a
+
+(* {1 Checking values} *)
+
+val eq : eq:'a eq -> pp:'a pp -> 'a -> 'a -> unit
+val eq_char : char -> char -> unit
+val eq_str : string -> string -> unit
+val eq_bool : bool -> bool -> unit
+val eq_int : int -> int -> unit
+val eq_int32 : int32 -> int32 -> unit
+val eq_int64 : int64 -> int64 -> unit
+val eq_float : float -> float -> unit
+val eq_nan : float -> unit
+
+val eq_option : eq:'a eq -> pp:'a pp -> 'a option -> 'a option -> unit
+val eq_some : 'a option -> unit
+val eq_none : pp:'a pp -> 'a option -> unit
+val eq_list : eq:'a eq -> pp:'a pp -> 'a list -> 'a list -> unit
+
+val eq_result : eq_ok:'a eq -> pp_ok:'a pp -> eq_error:'b eq ->
+  pp_error:'b pp -> ('a, 'b) result -> ('a, 'b) result -> unit
+
+val eq_result_msg : eq_ok:'a eq -> pp_ok:'a pp ->
+  ('a, [`Msg of string]) result -> ('a, [`Msg of string]) result -> unit
+
+
+val eq_ok : eq:'a eq -> pp:'a pp -> ('a, 'b) result -> 'a -> unit
+
+
+(* {1 Tracing and checking function applications} *)
+
+type app (* holds information about the application *)
+
+val ( $ ) : 'a -> (app -> 'a -> 'b) -> 'b
+val ( @-> ) : 'a pp -> (app -> 'b -> 'c) -> app -> ('a -> 'b) -> 'a -> 'c
+
+val ret : 'a pp -> app -> 'a -> 'a
+val ret_eq : eq:'a eq -> 'a pp -> 'a -> app -> 'a -> 'a
+val ret_some : 'a pp -> app -> 'a option -> 'a option
+val ret_none : 'a pp -> app -> 'a option -> 'a option
+val ret_get_option : 'a pp -> app -> 'a option -> 'a
+
+val app_invalid : pp:'b pp -> ('a -> 'b) -> 'a -> unit
+val app_exn : pp:'b pp -> exn -> ('a -> 'b) -> 'a -> unit
+val app_raises : pp:'b pp -> ('a -> 'b) -> 'a -> unit
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/bos/test/watch.ml

@@ -0,0 +1,78 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Bos_setup
+
+(* Watch a directory for changes. First run will create a database
+   watchdb in the directory with modification times. Subsquent runs
+   will check files against that database. *)
+
+module Db = struct
+  let db_file = Fpath.v "watchdb"
+  let exists () = OS.File.exists db_file
+  let scan () =             (* returns list of (path, modification time) *)
+    let add p acc =
+      (OS.Path.stat p >>= fun stats ->
+       if stats.Unix.st_kind <> Unix.S_REG then Ok acc else
+       Ok ((p, stats.Unix.st_mtime) :: acc))
+      |> Logs.on_error_msg ~use:(fun _ -> acc)
+    in
+    Logs.app (fun m -> m "Scanning files");
+    OS.Dir.current () >>= fun dir ->
+    OS.Dir.fold_contents ~dotfiles:true ~elements:`Files add [] dir
+
+  let dump oc db = Ok (Marshal.(to_channel oc db [No_sharing; Compat_32]))
+  let slurp ic () = (Marshal.from_channel ic : float Fpath.Map.t)
+
+  let create files =
+    Logs.app (fun m -> m "Writing modification time database %a"
+                 Fpath.pp db_file);
+    let count = ref 0 in
+    let add acc (f, time) = incr count; Fpath.Map.add f time acc in
+    let db = List.fold_left add Fpath.Map.empty files in
+    R.join @@ OS.File.with_oc db_file dump db >>= fun () -> Ok !count
+
+  let check files =
+    let count = ref 0 in
+    let changes db (f, time) = match (incr count; Fpath.Map.find f db) with
+    | None ->
+        Logs.app (fun m -> m "New file: %a" Fpath.pp f)
+    | Some stamp when stamp <> time ->
+        Logs.app (fun m -> m "File changed: %a" Fpath.pp f)
+    | _ -> ()
+    in
+    Logs.app (fun m -> m "Checking against %a" Fpath.pp db_file);
+    OS.File.with_ic db_file slurp ()
+    >>= fun db -> List.iter (changes db) files; Ok !count
+end
+
+let watch () =
+  Db.scan ()
+  >>= fun files -> Db.exists ()
+  >>= fun exists -> if exists then Db.check files else Db.create files
+
+let main () =
+  let c = Mtime_clock.counter () in
+  let count = watch () |> Logs.on_error_msg ~use:(fun _ -> 0) in
+  Logs.app (fun m -> m "Watch completed for %d files in %a"
+               count Mtime.Span.pp (Mtime_clock.count c))
+
+let () = main ()
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+
+   Permission to use, copy, modify, and/or 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.
+  ---------------------------------------------------------------------------*)