unikernel/duniverse/ocaml-base64/.gitignore

@@ -0,0 +1,10 @@
+_build
+_tests
+tmp
+*~
+\.\#*
+\#*#
+*.install
+*.native
+*.byte
+.merlin

unikernel/duniverse/ocaml-base64/.ocamlformat

@@ -0,0 +1,8 @@
+version = 0.16.0
+break-infix = fit-or-vertical
+parse-docstrings = true
+indicate-multiline-delimiters=no
+nested-match=align
+sequence-style=separator
+break-before-in=auto
+if-then-else=keyword-first

unikernel/duniverse/ocaml-base64/.ocp-indent

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

unikernel/duniverse/ocaml-base64/.travis-ci.sh

@@ -0,0 +1,27 @@
+case "$OCAML_VERSION,$OPAM_VERSION" in
+4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;;
+4.00.1,1.2.0) ppa=avsm/ocaml40+opam12 ;;
+4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;;
+4.01.0,1.2.0) ppa=avsm/ocaml41+opam12 ;;
+4.02.1,1.1.0) ppa=avsm/ocaml42+opam11 ;;
+4.02.1,1.2.0) ppa=avsm/ocaml42+opam12 ;;
+*) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;;
+esac
+
+echo "yes" | sudo add-apt-repository ppa:$ppa
+sudo apt-get update -qq
+sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam time
+
+export OPAMYES=1
+export OPAMVERBOSE=1
+echo OCaml version
+ocaml -version
+echo OPAM versions
+opam --version
+opam --git-version
+
+opam init git://github.com/ocaml/opam-repository >/dev/null 2>&1
+opam install ocamlfind
+eval `opam config env`
+make
+make install

unikernel/duniverse/ocaml-base64/CHANGES.md

@@ -0,0 +1,104 @@
+### v3.5.2 (2025-09-19)
+
+- Add `x-maintenance-intent` into the OPAM file (@hannesm, #54)
+- Remove the support of OCaml 4.07 (@copy, #55)
+
+### v3.5.1 (2023-01-24)
+
+- Few fixes about benchmarks and tests (#51, @tbrk, @dinosaure)
+- Add missing dependency about `fmt` and fix the compilation for OCaml 5.0 (#52, @kit-ty-kate)
+
+### v3.5.0 (2021-02-08)
+
+- Fix support for `x-compilation` (@samoht, #44)
+- Update to `dune.2.0` and apply `ocamlformat` (@samoht, #45)
+- Select `unsafe.ml` only with `dune` (@emillon, #46)
+- Remove indirect dependecy to `ocamlfind` (@kit-ty-kate, #49)
+- Hide internals of `base64` and return a `string` as the alphabet (@reynir, #48)
+  **breaking chnages** `Base64.alphabet` is updated and return a simple `string` now
+
+### v3.4.0 (2020-03-13)
+
+- Fix tests about `alcotest.1.0.0` (@dinosaure, #40)
+- Be more strict about padding when we decode a base64 input (@dinosaure, @hannesm, @cfcs, #43)
+- Remove `fmt` dependency (#43)
+
+### v3.3.0 (2019-01-30)
+
+- Remove `build` directive on dune dependency (@CraigFe, #35)
+- Make error poly-variant open (@copy, #39)
+- Use `unsafe_bytes_set16u` instead `unsafe_string_set16u` (@dinosaure, @hhugo, @avsm, #37)
+
+### v3.2.0 (2019-04-04)
+
+* `Base64_rfc2045.decode` can now progress on many input errors, allowing
+  clients to make forward progress by discarding a single character and
+  trying to continue.  This allows, for example, newlines and other invalid
+  characters to be discarded. (#34 @tiash, review by @dinosaure @avsm)
+* Add more test cases for RFC2045 (#34 @dinosaure)
+* Improve README toplevel output example (#28 @djs55)
+
+### v3.1.0 (2019-02-03)
+
+* Add `Base64.encode_string` that doesn't raise or return an error.
+  This makes it easier to port pre-3.0 code to the new interface (#26 @avsm)
+
+### v3.0.0 (2018-01-21)
+
+* Implementation of Base64 according to RFC 2045 (available on base64.rfc2045)
+* New implementation of Base64 according to RFC 4648 from nocrypto's implementation
+* Fix bad access with `String.iter` on the old implementation of Base64 (@dinosaure, #23)
+* Check isomorphism between `encode` & `decode` function (@hannesm, @dinosaure, #20)
+* Add tests from RFC 3548 and from PHP impl. (@hannesm, @dinosaure, #24)
+* Add fuzzer on both implementations
+ - check isomorphism
+ - check bijection
+ - check if `decode` does not raise any exception
+* __break-api__, `B64` was renamed to `Base64` (@copy, @avsm, @dinosaure, #17)
+* __break-api__, `Base64.decode` and `Base64.encode` returns a result type instead to raise an exception (@hannesm, @dinosaure, #21)
+* __break-api__, Add `sub` type to avoid allocation to the end-user (@avsm, @dinosaure, #24)
+* __break-api__, Add `pad` argument on `decode` function to check if input is well-padded or not (@hannesm, @dinosaure, #24)
+* __break-api__, Add `off` and `len` optional arguments on `encode` & `decode` functions to compute a part of input (@cfcs, @dinosaure, #24)
+* Better performance (see #24) (@dinosaure)
+* Review of code by @cfcs (see #24)
+
+### v2.3.0 (2018-11-23)
+
+* Add a `decode_opt` function that is a non-raising variant of `decode`.
+* Reformat the code with ocamlformat (@dinosaure)
+* Port build to dune from jbuilder (@dinosaure
+
+### v2.2.0 (2017-06-20)
+
+* Switch to jbuilder (#13, @rgrinberg)
+
+### v2.1.2 (2016-10-18)
+
+* Fix version number (#11, @hannesm)
+
+### v2.1.1 (2016-10-03)
+
+* Switch build to `topkg` and obey the `odig` conventions
+  for installing metadata files.
+* Add a test suite based on RFC4648 test vectors.
+* Improve Travis CI tests to be multidistro.
+
+### v2.0.0 (2014-12-24)
+
+* Switch the top-level `Base64` module to `B64` to avoid
+  clashing with various other similarly named modules in
+  `extlib` and some other libraries.  This is obviously
+  backwards compatibility breaking with all current users
+  of this library. (#3).
+
+### 1.1.0 (2014-12-16)
+
+* Allow specifying a different alphabet during encoding or
+  decoding, and supply a URI-safe alphabet along with the
+  default Base64 standard.
+* Add OCaml 4.02 `safe-string` compatibility.
+* Optionally support encoding without padding.
+
+### 1.0.0 (2014-08-03)
+
+* Initial public release.

unikernel/duniverse/ocaml-base64/LICENSE.md

@@ -0,0 +1,14 @@
+Copyright (c) 2006-2009 Citrix Systems Inc.
+Copyright (c) 2010 Thomas Gazagnaire <thomas@gazagnaire.com>
+
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

unikernel/duniverse/ocaml-base64/Makefile

@@ -0,0 +1,10 @@
+.PHONY: all test clean
+
+all:
+	dune build
+
+test:
+	dune runtest
+
+clean:
+	dune clean

unikernel/duniverse/ocaml-base64/README.md

@@ -0,0 +1,27 @@
+Base64 for OCaml
+================
+
+Base64 is a group of similar binary-to-text encoding schemes that represent
+binary data in an ASCII string format by translating it into a radix-64
+representation.  It is specified in [RFC 4648][rfc4648].
+
+See also [documentation][docs].
+
+[rfc4648]: https://tools.ietf.org/html/rfc4648
+[docs]: http://mirage.github.io/ocaml-base64/base64/
+
+## Example
+
+Simple encoding and decoding.
+
+```shell
+utop # #require "base64";;
+utop # let enc = Base64.encode_exn "OCaml rocks!";;
+val enc : string = "T0NhbWwgcm9ja3Mh"
+utop # let plain = Base64.decode_exn enc;;
+val plain : string = "OCaml rocks!"
+```
+
+## License
+
+[ISC](https://www.isc.org/downloads/software-support-policy/isc-license/)

unikernel/duniverse/ocaml-base64/base64.opam

@@ -0,0 +1,31 @@
+version: "3.5.2"
+opam-version: "2.0"
+maintainer: "mirageos-devel@lists.xenproject.org"
+authors: [ "Thomas Gazagnaire"
+           "Anil Madhavapeddy" "Calascibetta Romain"
+           "Peter Zotov" ]
+license: "ISC"
+homepage: "https://github.com/mirage/ocaml-base64"
+doc: "https://mirage.github.io/ocaml-base64/"
+bug-reports: "https://github.com/mirage/ocaml-base64/issues"
+dev-repo: "git+https://github.com/mirage/ocaml-base64.git"
+synopsis: "Base64 encoding for OCaml"
+description: """
+Base64 is a group of similar binary-to-text encoding schemes that represent
+binary data in an ASCII string format by translating it into a radix-64
+representation.  It is specified in RFC 4648.
+"""
+depends: [
+  "ocaml" {>= "4.07.0"}
+  "dune" {>= "2.3"}
+  "fmt" {with-test & >= "0.8.7"}
+  "bos" {with-test}
+  "rresult" {with-test}
+  "alcotest" {with-test}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+x-maintenance-intent: [ "(latest)" ]

unikernel/duniverse/ocaml-base64/bench/benchmarks.ml

@@ -0,0 +1,111 @@
+module Old_version = struct
+  let default_alphabet =
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+
+  let uri_safe_alphabet =
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
+
+  let padding = '='
+
+  let of_char ?(alphabet = default_alphabet) x =
+    if x = padding then 0 else String.index alphabet x
+
+  let to_char ?(alphabet = default_alphabet) x = alphabet.[x]
+
+  let decode ?alphabet input =
+    let length = String.length input in
+    let input =
+      if length mod 4 = 0
+      then input
+      else input ^ String.make (4 - (length mod 4)) padding in
+    let length = String.length input in
+    let words = length / 4 in
+    let padding =
+      match length with
+      | 0 -> 0
+      | _ when input.[length - 2] = padding -> 2
+      | _ when input.[length - 1] = padding -> 1
+      | _ -> 0 in
+    let output = Bytes.make ((words * 3) - padding) '\000' in
+    for i = 0 to words - 1 do
+      let a = of_char ?alphabet input.[(4 * i) + 0]
+      and b = of_char ?alphabet input.[(4 * i) + 1]
+      and c = of_char ?alphabet input.[(4 * i) + 2]
+      and d = of_char ?alphabet input.[(4 * i) + 3] in
+      let n = (a lsl 18) lor (b lsl 12) lor (c lsl 6) lor d in
+      let x = (n lsr 16) land 255
+      and y = (n lsr 8) land 255
+      and z = n land 255 in
+      Bytes.set output ((3 * i) + 0) (char_of_int x) ;
+      if i <> words - 1 || padding < 2
+      then Bytes.set output ((3 * i) + 1) (char_of_int y) ;
+      if i <> words - 1 || padding < 1
+      then Bytes.set output ((3 * i) + 2) (char_of_int z)
+    done ;
+    Bytes.unsafe_to_string output
+
+  let decode_opt ?alphabet input =
+    try Some (decode ?alphabet input) with Not_found -> None
+
+  let encode ?(pad = true) ?alphabet input =
+    let length = String.length input in
+    let words = (length + 2) / 3 (* rounded up *) in
+    let padding_len = if length mod 3 = 0 then 0 else 3 - (length mod 3) in
+    let output = Bytes.make (words * 4) '\000' in
+    let get i = if i >= length then 0 else int_of_char input.[i] in
+    for i = 0 to words - 1 do
+      let x = get ((3 * i) + 0)
+      and y = get ((3 * i) + 1)
+      and z = get ((3 * i) + 2) in
+      let n = (x lsl 16) lor (y lsl 8) lor z in
+      let a = (n lsr 18) land 63
+      and b = (n lsr 12) land 63
+      and c = (n lsr 6) land 63
+      and d = n land 63 in
+      Bytes.set output ((4 * i) + 0) (to_char ?alphabet a) ;
+      Bytes.set output ((4 * i) + 1) (to_char ?alphabet b) ;
+      Bytes.set output ((4 * i) + 2) (to_char ?alphabet c) ;
+      Bytes.set output ((4 * i) + 3) (to_char ?alphabet d)
+    done ;
+    for i = 1 to padding_len do
+      Bytes.set output (Bytes.length output - i) padding
+    done ;
+    if pad
+    then Bytes.unsafe_to_string output
+    else Bytes.sub_string output 0 (Bytes.length output - padding_len)
+end
+
+let random len =
+  let ic = open_in "/dev/urandom" in
+  let rs = Bytes.create len in
+  really_input ic rs 0 len ;
+  close_in ic ;
+  Bytes.unsafe_to_string rs
+
+open Core
+open Core_bench
+
+let b64_encode_and_decode len =
+  let input = random len in
+  Staged.stage @@ fun () ->
+  let encoded = Base64.encode_exn input in
+  let _decoded = Base64.decode_exn encoded in
+  ()
+
+let old_encode_and_decode len =
+  let input = random len in
+  Staged.stage @@ fun () ->
+  let encoded = Old_version.encode input in
+  let _decoded = Old_version.decode encoded in
+  ()
+
+let args = [ 0; 10; 50; 100; 500; 1000; 2500; 5000 ]
+
+let test_b64 =
+  Bench.Test.create_indexed ~name:"Base64" ~args b64_encode_and_decode
+
+let test_old = Bench.Test.create_indexed ~name:"Old" ~args old_encode_and_decode
+
+let command = Bench.make_command [ test_b64; test_old ]
+
+let () = Command.run command

unikernel/duniverse/ocaml-base64/bench/dune

@@ -0,0 +1,5 @@
+(executable
+ (name benchmarks)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries base64 core_bench))

unikernel/duniverse/ocaml-base64/config/config.ml

@@ -0,0 +1,7 @@
+let parse s = Scanf.sscanf s "%d.%d" (fun major minor -> (major, minor))
+
+let () =
+  let version = parse Sys.ocaml_version in
+  if version >= (4, 7)
+  then print_string "unsafe_stable.ml"
+  else print_string "unsafe_pre407.ml"

unikernel/duniverse/ocaml-base64/config/dune

@@ -0,0 +1,7 @@
+(executable
+ (name config))
+
+(rule
+ (with-stdout-to
+  which-unsafe-file
+  (run ./config.exe)))

unikernel/duniverse/ocaml-base64/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.3)
+(name base64)
+(version v3.5.2)

unikernel/duniverse/ocaml-base64/fuzz/dune

@@ -0,0 +1,13 @@
+(executable
+ (name fuzz_rfc2045)
+ (enabled_if
+  (= %{profile} fuzz))
+ (modules fuzz_rfc2045)
+ (libraries astring crowbar fmt base64.rfc2045))
+
+(executable
+ (name fuzz_rfc4648)
+ (enabled_if
+  (= %{profile} fuzz))
+ (modules fuzz_rfc4648)
+ (libraries astring crowbar fmt base64))

unikernel/duniverse/ocaml-base64/fuzz/fuzz_rfc2045.ml

@@ -0,0 +1,155 @@
+open Crowbar
+
+exception Encode_error of string
+
+exception Decode_error of string
+
+(** Pretty printers *)
+
+let register_printer () =
+  Printexc.register_printer (function
+    | Encode_error err -> Some (Fmt.str "(Encoding error: %s)" err)
+    | Decode_error err -> Some (Fmt.str "(Decoding error: %s)" err)
+    | _ -> None)
+
+let pp_chr =
+  let escaped = function ' ' .. '~' as c -> String.make 1 c | _ -> "." in
+  Fmt.using escaped Fmt.string
+
+let pp_scalar :
+    type buffer.
+    get:(buffer -> int -> char) -> length:(buffer -> int) -> buffer Fmt.t =
+ fun ~get ~length ppf b ->
+  let l = length b in
+  for i = 0 to l / 16 do
+    Fmt.pf ppf "%08x: " (i * 16) ;
+    let j = ref 0 in
+    while !j < 16 do
+      if (i * 16) + !j < l
+      then Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j))
+      else Fmt.pf ppf "  " ;
+      if !j mod 2 <> 0 then Fmt.pf ppf " " ;
+      incr j
+    done ;
+    Fmt.pf ppf "  " ;
+    j := 0 ;
+    while !j < 16 do
+      if (i * 16) + !j < l
+      then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j))
+      else Fmt.pf ppf " " ;
+      incr j
+    done ;
+    Fmt.pf ppf "@\n"
+  done
+
+let pp = pp_scalar ~get:String.get ~length:String.length
+
+(** Encoding and decoding *)
+
+let check_encode str =
+  let subs = Astring.String.cuts ~sep:"\r\n" str in
+  let check str =
+    if String.length str > 78
+    then raise (Encode_error "too long string returned") in
+  List.iter check subs ;
+  str
+
+let encode input =
+  let buf = Buffer.create 80 in
+  let encoder = Base64_rfc2045.encoder (`Buffer buf) in
+  String.iter
+    (fun c ->
+      let ret = Base64_rfc2045.encode encoder (`Char c) in
+      match ret with `Ok -> () | _ -> assert false)
+    (* XXX(dinosaure): [`Partial] can never occur. *)
+    input ;
+  let encode = Base64_rfc2045.encode encoder `End in
+  match encode with
+  | `Ok -> Buffer.contents buf |> check_encode
+  | _ -> (* XXX(dinosaure): [`Partial] can never occur. *) assert false
+
+let decode input =
+  let decoder = Base64_rfc2045.decoder (`String input) in
+  let rec go acc =
+    if Base64_rfc2045.decoder_dangerous decoder
+    then raise (Decode_error "Dangerous input") ;
+    match Base64_rfc2045.decode decoder with
+    | `End -> List.rev acc
+    | `Flush output -> go (output :: acc)
+    | `Malformed _ -> raise (Decode_error "Malformed")
+    | `Wrong_padding -> raise (Decode_error "Wrong padding")
+    | _ -> (* XXX(dinosaure): [`Await] can never occur. *) assert false in
+  String.concat "" (go [])
+
+(** String generators *)
+
+let bytes_fixed_range : string gen = dynamic_bind (range 78) bytes_fixed
+
+let char_from_alpha alpha : string gen =
+  map [ range (String.length alpha) ] (fun i -> alpha.[i] |> String.make 1)
+
+let string_from_alpha n =
+  let acc = const "" in
+  let alpha = Base64_rfc2045.default_alphabet in
+  let rec add_char_from_alpha alpha acc = function
+    | 0 -> acc
+    | n ->
+        add_char_from_alpha alpha
+          (concat_gen_list (const "") [ acc; char_from_alpha alpha ])
+          (n - 1) in
+  add_char_from_alpha alpha acc n
+
+let random_string_from_alpha n = dynamic_bind (range n) string_from_alpha
+
+let bytes_fixed_range_from_alpha : string gen =
+  dynamic_bind (range 78) bytes_fixed
+
+let set_canonic str =
+  let l = String.length str in
+  let to_drop = l * 6 mod 8 in
+  if to_drop = 6
+     (* XXX(clecat): Case when we need to drop 6 bits which means a whole letter *)
+  then String.sub str 0 (l - 1)
+  else if to_drop <> 0
+          (* XXX(clecat): Case when we need to drop 2 or 4 bits: we apply a mask droping the bits *)
+  then (
+    let buf = Bytes.of_string str in
+    let value =
+      String.index Base64_rfc2045.default_alphabet (Bytes.get buf (l - 1)) in
+    let canonic =
+      Base64_rfc2045.default_alphabet.[value land lnot ((1 lsl to_drop) - 1)]
+    in
+    Bytes.set buf (l - 1) canonic ;
+    Bytes.unsafe_to_string buf)
+  else str
+
+let add_padding str =
+  let str = set_canonic str in
+  let str = str ^ "===" in
+  String.sub str 0 (String.length str / 4 * 4)
+
+(** Tests *)
+
+let e2d inputs =
+  let input = String.concat "\r\n" inputs in
+  let encode = encode input in
+  let decode = decode encode in
+  check_eq ~pp ~cmp:String.compare ~eq:String.equal input decode
+
+let d2e inputs end_input =
+  let end_input = add_padding end_input in
+  let inputs = inputs @ [ end_input ] in
+  let input =
+    List.fold_left
+      (fun acc s -> if String.length s <> 0 then acc ^ "\r\n" ^ s else acc)
+      (List.hd inputs) (List.tl inputs) in
+  let decode = decode input in
+  let encode = encode decode in
+  check_eq ~pp ~cmp:String.compare ~eq:String.equal input encode
+
+let () =
+  register_printer () ;
+  add_test ~name:"rfc2045: encode -> decode" [ list bytes_fixed_range ] e2d ;
+  add_test ~name:"rfc2045: decode -> encode"
+    [ list (string_from_alpha 76); random_string_from_alpha 76 ]
+    d2e

unikernel/duniverse/ocaml-base64/fuzz/fuzz_rfc4648.ml

@@ -0,0 +1,169 @@
+open Crowbar
+
+let pp_chr =
+  let escaped = function ' ' .. '~' as c -> String.make 1 c | _ -> "." in
+  Fmt.using escaped Fmt.string
+
+let pp_scalar :
+    type buffer.
+    get:(buffer -> int -> char) -> length:(buffer -> int) -> buffer Fmt.t =
+ fun ~get ~length ppf b ->
+  let l = length b in
+  for i = 0 to l / 16 do
+    Fmt.pf ppf "%08x: " (i * 16) ;
+    let j = ref 0 in
+    while !j < 16 do
+      if (i * 16) + !j < l
+      then Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j))
+      else Fmt.pf ppf "  " ;
+      if !j mod 2 <> 0 then Fmt.pf ppf " " ;
+      incr j
+    done ;
+    Fmt.pf ppf "  " ;
+    j := 0 ;
+    while !j < 16 do
+      if (i * 16) + !j < l
+      then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j))
+      else Fmt.pf ppf " " ;
+      incr j
+    done ;
+    Fmt.pf ppf "@\n"
+  done
+
+let pp = pp_scalar ~get:String.get ~length:String.length
+
+let ( <.> ) f g x = f (g x)
+
+let char_from_alphabet alphabet : string gen =
+  map [ range 64 ] (String.make 1 <.> String.get (Base64.alphabet alphabet))
+
+let random_string_from_alphabet alphabet len : string gen =
+  let rec add_char_from_alphabet acc = function
+    | 0 -> acc
+    | n ->
+        add_char_from_alphabet
+          (concat_gen_list (const "") [ acc; char_from_alphabet alphabet ])
+          (n - 1) in
+  add_char_from_alphabet (const "") len
+
+let random_string_from_alphabet ~max alphabet =
+  dynamic_bind (range max) @@ fun real_len ->
+  dynamic_bind (random_string_from_alphabet alphabet real_len) @@ fun input ->
+  if real_len <= 1
+  then const (input, 0, real_len)
+  else
+    dynamic_bind (range (real_len / 2)) @@ fun off ->
+    map [ range (real_len - off) ] (fun len -> (input, off, len))
+
+let encode_and_decode (input, off, len) =
+  match Base64.encode ~pad:true ~off ~len input with
+  | Error (`Msg err) -> fail err
+  | Ok result ->
+  match Base64.decode ~pad:true result with
+  | Error (`Msg err) -> fail err
+  | Ok result ->
+      check_eq ~pp ~cmp:String.compare ~eq:String.equal result
+        (String.sub input off len)
+
+let decode_and_encode (input, off, len) =
+  match Base64.decode ~pad:true ~off ~len input with
+  | Error (`Msg err) -> fail err
+  | Ok result ->
+  match Base64.encode ~pad:true result with
+  | Error (`Msg err) -> fail err
+  | Ok result ->
+      check_eq ~pp:Fmt.string ~cmp:String.compare ~eq:String.equal result
+        (String.sub input off len)
+
+let ( // ) x y =
+  if y < 1 then raise Division_by_zero ;
+  if x > 0 then 1 + ((x - 1) / y) else 0
+  [@@inline]
+
+let canonic alphabet =
+  let dmap = Array.make 256 (-1) in
+  String.iteri (fun i x -> dmap.(Char.code x) <- i) (Base64.alphabet alphabet) ;
+  fun (input, off, len) ->
+    let real_len = String.length input in
+    let input_len = len in
+    let normalized_len = input_len // 4 * 4 in
+    if normalized_len = input_len
+    then (input, off, input_len)
+    else if normalized_len - input_len = 3
+    then (input, off, input_len - 1)
+    else
+      let remainder_len = normalized_len - input_len in
+      let last = input.[off + input_len - 1] in
+      let output = Bytes.make (max real_len (off + normalized_len)) '=' in
+
+      Bytes.blit_string input 0 output 0 (off + input_len) ;
+      if off + normalized_len < real_len
+      then
+        Bytes.blit_string input (off + normalized_len) output
+          (off + normalized_len)
+          (real_len - (off + normalized_len)) ;
+
+      let mask =
+        match remainder_len with 1 -> 0x3c | 2 -> 0x30 | _ -> assert false in
+      let decoded = dmap.(Char.code last) in
+      let canonic = decoded land mask in
+      let encoded = (Base64.alphabet alphabet).[canonic] in
+      Bytes.set output (off + input_len - 1) encoded ;
+      (Bytes.unsafe_to_string output, off, normalized_len)
+
+let isomorphism0 (input, off, len) =
+  (* x0 = decode(input) && x1 = decode(encode(x0)) && x0 = x1 *)
+  match Base64.decode ~pad:false ~off ~len input with
+  | Error (`Msg err) -> fail err
+  | Ok result0 -> (
+      let result1 = Base64.encode_exn result0 in
+      match Base64.decode ~pad:true result1 with
+      | Error (`Msg err) -> fail err
+      | Ok result2 ->
+          check_eq ~pp ~cmp:String.compare ~eq:String.equal result0 result2)
+
+let isomorphism1 (input, off, len) =
+  let result0 = Base64.encode_exn ~off ~len input in
+  match Base64.decode ~pad:true result0 with
+  | Error (`Msg err) -> fail err
+  | Ok result1 ->
+      let result2 = Base64.encode_exn result1 in
+      check_eq ~pp:Fmt.string ~cmp:String.compare ~eq:String.equal result0
+        result2
+
+let bytes_and_range : (string * int * int) gen =
+  dynamic_bind bytes @@ fun t ->
+  let real_length = String.length t in
+  if real_length <= 1
+  then const (t, 0, real_length)
+  else
+    dynamic_bind (range (real_length / 2)) @@ fun off ->
+    map [ range (real_length - off) ] (fun len -> (t, off, len))
+
+let range_of_max max : (int * int) gen =
+  dynamic_bind (range (max / 2)) @@ fun off ->
+  map [ range (max - off) ] (fun len -> (off, len))
+
+let failf fmt = Fmt.kstr fail fmt
+
+let no_exception pad off len input =
+  try
+    let _ =
+      Base64.decode ?pad ?off ?len ~alphabet:Base64.default_alphabet input in
+    ()
+  with exn -> failf "decode fails with: %s." (Printexc.to_string exn)
+
+let () =
+  add_test ~name:"rfc4648: encode -> decode" [ bytes_and_range ]
+    encode_and_decode ;
+  add_test ~name:"rfc4648: decode -> encode"
+    [ random_string_from_alphabet ~max:1000 Base64.default_alphabet ]
+    (decode_and_encode <.> canonic Base64.default_alphabet) ;
+  add_test ~name:"rfc4648: x = decode(encode(x))"
+    [ random_string_from_alphabet ~max:1000 Base64.default_alphabet ]
+    isomorphism0 ;
+  add_test ~name:"rfc4648: x = encode(decode(x))" [ bytes_and_range ]
+    isomorphism1 ;
+  add_test ~name:"rfc4648: no exception leak"
+    [ option bool; option int; option int; bytes ]
+    no_exception

unikernel/duniverse/ocaml-base64/src/base64.ml

@@ -0,0 +1,310 @@
+(*
+ * Copyright (c) 2006-2009 Citrix Systems Inc.
+ * Copyright (c) 2010 Thomas Gazagnaire <thomas@gazagnaire.com>
+ * Copyright (c) 2014-2016 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2016 David Kaloper Meršinjak
+ * Copyright (c) 2018 Romain Calascibetta <romain.calascibetta@gmail.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+type alphabet = { emap : int array; dmap : int array }
+
+type sub = string * int * int
+
+let ( // ) x y =
+  if y < 1 then raise Division_by_zero ;
+  if x > 0 then 1 + ((x - 1) / y) else 0
+  [@@inline]
+
+let unsafe_get_uint8 t off = Char.code (String.unsafe_get t off)
+
+let unsafe_set_uint8 t off v = Bytes.unsafe_set t off (Char.chr v)
+
+external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u"
+  [@@noalloc]
+
+external unsafe_get_uint16 : string -> int -> int = "%caml_string_get16u"
+  [@@noalloc]
+
+external swap16 : int -> int = "%bswap16" [@@noalloc]
+
+let none = -1
+
+(* We mostly want to have an optional array for [dmap] (e.g. [int option
+   array]). So we consider the [none] value as [-1]. *)
+
+let make_alphabet alphabet =
+  if String.length alphabet <> 64
+  then invalid_arg "Length of alphabet must be 64" ;
+  if String.contains alphabet '='
+  then invalid_arg "Alphabet can not contain padding character" ;
+  let emap =
+    Array.init (String.length alphabet) (fun i -> Char.code alphabet.[i]) in
+  let dmap = Array.make 256 none in
+  String.iteri (fun idx chr -> dmap.(Char.code chr) <- idx) alphabet ;
+  { emap; dmap }
+
+let length_alphabet { emap; _ } = Array.length emap
+
+let alphabet { emap; _ } =
+  String.init (Array.length emap) (fun i -> Char.chr emap.(i))
+
+let default_alphabet =
+  make_alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+
+let uri_safe_alphabet =
+  make_alphabet
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
+
+let unsafe_set_be_uint16 =
+  if Sys.big_endian
+  then fun t off v -> unsafe_set_uint16 t off v
+  else fun t off v -> unsafe_set_uint16 t off (swap16 v)
+
+(* We make this exception to ensure to keep a control about which exception we
+   can raise and avoid appearance of unknown exceptions like an ex-nihilo
+   magic rabbit (or magic money?). *)
+exception Out_of_bounds
+
+exception Too_much_input
+
+let get_uint8 t off =
+  if off < 0 || off >= String.length t then raise Out_of_bounds ;
+  unsafe_get_uint8 t off
+
+let padding = int_of_char '='
+
+let error_msgf fmt = Format.ksprintf (fun err -> Error (`Msg err)) fmt
+
+let encode_sub pad { emap; _ } ?(off = 0) ?len input =
+  let len =
+    match len with Some len -> len | None -> String.length input - off in
+
+  if len < 0 || off < 0 || off > String.length input - len
+  then error_msgf "Invalid bounds"
+  else
+    let n = len in
+    let n' = n // 3 * 4 in
+    let res = Bytes.create n' in
+
+    let emap i = Array.unsafe_get emap i in
+
+    let emit b1 b2 b3 i =
+      unsafe_set_be_uint16 res i
+        ((emap ((b1 lsr 2) land 0x3f) lsl 8)
+        lor emap ((b1 lsl 4) lor (b2 lsr 4) land 0x3f)) ;
+      unsafe_set_be_uint16 res (i + 2)
+        ((emap ((b2 lsl 2) lor (b3 lsr 6) land 0x3f) lsl 8)
+        lor emap (b3 land 0x3f)) in
+
+    let rec enc j i =
+      if i = n
+      then ()
+      else if i = n - 1
+      then emit (unsafe_get_uint8 input (off + i)) 0 0 j
+      else if i = n - 2
+      then
+        emit
+          (unsafe_get_uint8 input (off + i))
+          (unsafe_get_uint8 input (off + i + 1))
+          0 j
+      else (
+        emit
+          (unsafe_get_uint8 input (off + i))
+          (unsafe_get_uint8 input (off + i + 1))
+          (unsafe_get_uint8 input (off + i + 2))
+          j ;
+        enc (j + 4) (i + 3)) in
+
+    let rec unsafe_fix = function
+      | 0 -> ()
+      | i ->
+          unsafe_set_uint8 res (n' - i) padding ;
+          unsafe_fix (i - 1) in
+
+    enc 0 0 ;
+
+    let pad_to_write = (3 - (n mod 3)) mod 3 in
+
+    if pad
+    then (
+      unsafe_fix pad_to_write ;
+      Ok (Bytes.unsafe_to_string res, 0, n'))
+    else Ok (Bytes.unsafe_to_string res, 0, n' - pad_to_write)
+
+(* [pad = false], we don't want to write them. *)
+
+let encode ?(pad = true) ?(alphabet = default_alphabet) ?off ?len input =
+  match encode_sub pad alphabet ?off ?len input with
+  | Ok (res, off, len) -> Ok (String.sub res off len)
+  | Error _ as err -> err
+
+let encode_string ?pad ?alphabet input =
+  match encode ?pad ?alphabet input with
+  | Ok res -> res
+  | Error _ -> assert false
+
+let encode_sub ?(pad = true) ?(alphabet = default_alphabet) ?off ?len input =
+  encode_sub pad alphabet ?off ?len input
+
+let encode_exn ?pad ?alphabet ?off ?len input =
+  match encode ?pad ?alphabet ?off ?len input with
+  | Ok v -> v
+  | Error (`Msg err) -> invalid_arg err
+
+let decode_sub ?(pad = true) { dmap; _ } ?(off = 0) ?len input =
+  let len =
+    match len with Some len -> len | None -> String.length input - off in
+
+  if len < 0 || off < 0 || off > String.length input - len
+  then error_msgf "Invalid bounds"
+  else
+    let n = len // 4 * 4 in
+    let n' = n // 4 * 3 in
+    let res = Bytes.create n' in
+    let invalid_pad_overflow = pad in
+
+    let get_uint8_or_padding =
+      if pad
+      then (fun t i ->
+        if i >= len then raise Out_of_bounds ;
+        get_uint8 t (off + i))
+      else
+        fun t i ->
+        try if i < len then get_uint8 t (off + i) else padding
+        with Out_of_bounds -> padding in
+
+    let set_be_uint16 t off v =
+      (* can not write 2 bytes. *)
+      if off < 0 || off + 1 > Bytes.length t
+      then () (* can not write 1 byte but can write 1 byte *)
+      else if off < 0 || off + 2 > Bytes.length t
+      then unsafe_set_uint8 t off (v lsr 8) (* can write 2 bytes. *)
+      else unsafe_set_be_uint16 t off v in
+
+    let set_uint8 t off v =
+      if off < 0 || off >= Bytes.length t then () else unsafe_set_uint8 t off v
+    in
+
+    let emit a b c d j =
+      let x = (a lsl 18) lor (b lsl 12) lor (c lsl 6) lor d in
+      set_be_uint16 res j (x lsr 8) ;
+      set_uint8 res (j + 2) (x land 0xff) in
+
+    let dmap i =
+      let x = Array.unsafe_get dmap i in
+      if x = none then raise Not_found ;
+      x in
+
+    let only_padding pad idx =
+      (* because we round length of [res] to the upper bound of how many
+         characters we should have from [input], we got at this stage only padding
+         characters and we need to delete them, so for each [====], we delete 3
+         bytes. *)
+      let pad = ref (pad + 3) in
+      let idx = ref idx in
+
+      while !idx + 4 < len do
+        (* use [unsafe_get_uint16] instead [unsafe_get_uint32] to avoid allocation
+           of [int32]. Of course, [3d3d3d3d] is [====]. *)
+        if unsafe_get_uint16 input (off + !idx) <> 0x3d3d
+           || unsafe_get_uint16 input (off + !idx + 2) <> 0x3d3d
+        then raise Not_found ;
+
+        (* We got something bad, should be a valid character according to
+           [alphabet] but outside the scope. *)
+        idx := !idx + 4 ;
+        pad := !pad + 3
+      done ;
+      while !idx < len do
+        if unsafe_get_uint8 input (off + !idx) <> padding then raise Not_found ;
+
+        incr idx
+      done ;
+      !pad in
+
+    let rec dec j i =
+      if i = n
+      then 0
+      else
+        let d, pad =
+          let x = get_uint8_or_padding input (i + 3) in
+          try (dmap x, 0) with Not_found when x = padding -> (0, 1) in
+        (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *)
+        let c, pad =
+          let x = get_uint8_or_padding input (i + 2) in
+          try (dmap x, pad)
+          with Not_found when x = padding && pad = 1 -> (0, 2) in
+        (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *)
+        let b, pad =
+          let x = get_uint8_or_padding input (i + 1) in
+          try (dmap x, pad)
+          with Not_found when x = padding && pad = 2 -> (0, 3) in
+        (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *)
+        let a, pad =
+          let x = get_uint8_or_padding input i in
+          try (dmap x, pad)
+          with Not_found when x = padding && pad = 3 -> (0, 4) in
+
+        (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *)
+        emit a b c d j ;
+
+        if i + 4 = n (* end of input in anyway *)
+        then
+          match pad with
+          | 0 -> 0
+          | 4 ->
+              (* assert (invalid_pad_overflow = false) ; *)
+              3
+          (* [get_uint8] lies and if we get [4], that mean we got one or more (at
+             most 4) padding character. In this situation, because we round length
+             of [res] (see [n // 4]), we need to delete 3 bytes. *)
+          | pad -> pad
+        else
+          match pad with
+          | 0 -> dec (j + 3) (i + 4)
+          | 4 ->
+              (* assert (invalid_pad_overflow = false) ; *)
+              only_padding 3 (i + 4)
+          (* Same situation than above but we should get only more padding
+             characters then. *)
+          | pad ->
+              if invalid_pad_overflow = true then raise Too_much_input ;
+              only_padding pad (i + 4) in
+
+    match dec 0 0 with
+    | 0 -> Ok (Bytes.unsafe_to_string res, 0, n')
+    | pad -> Ok (Bytes.unsafe_to_string res, 0, n' - pad)
+    | exception Out_of_bounds ->
+        error_msgf "Wrong padding"
+        (* appear only when [pad = true] and when length of input is not a multiple of 4. *)
+    | exception Not_found ->
+        (* appear when one character of [input] ∉ [alphabet] and this character <> '=' *)
+        error_msgf "Malformed input"
+    | exception Too_much_input -> error_msgf "Too much input"
+
+let decode ?pad ?(alphabet = default_alphabet) ?off ?len input =
+  match decode_sub ?pad alphabet ?off ?len input with
+  | Ok (res, off, len) -> Ok (String.sub res off len)
+  | Error _ as err -> err
+
+let decode_sub ?pad ?(alphabet = default_alphabet) ?off ?len input =
+  decode_sub ?pad alphabet ?off ?len input
+
+let decode_exn ?pad ?alphabet ?off ?len input =
+  match decode ?pad ?alphabet ?off ?len input with
+  | Ok res -> res
+  | Error (`Msg err) -> invalid_arg err

unikernel/duniverse/ocaml-base64/src/base64.mli

@@ -0,0 +1,119 @@
+(*
+ * Copyright (c) 2006-2009 Citrix Systems Inc.
+ * Copyright (c) 2010 Thomas Gazagnaire <thomas@gazagnaire.com>
+ * Copyright (c) 2014-2016 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2018 Romain Calascibetta <romain.calascibetta@gmail.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+(** Base64 RFC4648 implementation.
+
+    Base64 is a group of similar binary-to-text encoding schemes that represent
+    binary data in an ASCII string format by translating it into a radix-64
+    representation. It is specified in RFC 4648.
+
+    {e Release v3.5.2 - https://github.com/mirage/ocaml-base64} *)
+
+type alphabet
+(** Type of alphabet. *)
+
+type sub = string * int * int
+(** Type of sub-string: [str, off, len]. *)
+
+val default_alphabet : alphabet
+(** A 64-character alphabet specifying the regular Base64 alphabet. *)
+
+val uri_safe_alphabet : alphabet
+(** A 64-character alphabet specifying the URI- and filename-safe Base64
+    alphabet. *)
+
+val make_alphabet : string -> alphabet
+(** Make a new alphabet. *)
+
+val length_alphabet : alphabet -> int
+(** Returns length of the alphabet, should be 64. *)
+
+val alphabet : alphabet -> string
+(** Returns the alphabet. *)
+
+val decode_exn :
+  ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> string
+(** [decode_exn ?off ?len s] decodes [len] bytes (defaults to
+    [String.length s - off]) of the string [s] starting from [off] (defaults to
+    [0]) that is encoded in Base64 format. Will leave trailing NULLs on the
+    string, padding it out to a multiple of 3 characters. [alphabet] defaults to
+    {!default_alphabet}. [pad = true] specifies to check if [s] is padded or
+    not, otherwise, it raises an exception.
+
+    Decoder can fail when character of [s] is not a part of [alphabet] or is not
+    [padding] character. If input is not padded correctly, decoder does the
+    best-effort but it does not ensure [decode_exn (encode ~pad:false x) = x].
+
+    @raise if Invalid_argument [s] is not a valid Base64 string. *)
+
+val decode_sub :
+  ?pad:bool ->
+  ?alphabet:alphabet ->
+  ?off:int ->
+  ?len:int ->
+  string ->
+  (sub, [> `Msg of string ]) result
+(** Same as {!decode_exn} but it returns a result type instead to raise an
+    exception. Then, it returns a {!sub} string. Decoded input [(str, off, len)]
+    will starting to [off] and will have [len] bytes - by this way, we ensure to
+    allocate only one time result. *)
+
+val decode :
+  ?pad:bool ->
+  ?alphabet:alphabet ->
+  ?off:int ->
+  ?len:int ->
+  string ->
+  (string, [> `Msg of string ]) result
+(** Same as {!decode_exn}, but returns an explicit error message {!result} if it
+    fails. *)
+
+val encode :
+  ?pad:bool ->
+  ?alphabet:alphabet ->
+  ?off:int ->
+  ?len:int ->
+  string ->
+  (string, [> `Msg of string ]) result
+(** [encode s] encodes the string [s] into base64. If [pad] is false, no
+    trailing padding is added. [pad] defaults to [true], and [alphabet] to
+    {!default_alphabet}.
+
+    [encode] fails when [off] and [len] do not designate a valid range of [s]. *)
+
+val encode_string : ?pad:bool -> ?alphabet:alphabet -> string -> string
+(** [encode_string s] encodes the string [s] into base64. If [pad] is false, no
+    trailing padding is added. [pad] defaults to [true], and [alphabet] to
+    {!default_alphabet}. *)
+
+val encode_sub :
+  ?pad:bool ->
+  ?alphabet:alphabet ->
+  ?off:int ->
+  ?len:int ->
+  string ->
+  (sub, [> `Msg of string ]) result
+(** Same as {!encode} but return a {!sub}-string instead a plain result. By this
+    way, we ensure to allocate only one time result. *)
+
+val encode_exn :
+  ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> string
+(** Same as {!encode} but raises an invalid argument exception if we retrieve an
+    error. *)

unikernel/duniverse/ocaml-base64/src/base64_rfc2045.ml

@@ -0,0 +1,495 @@
+(*
+ * Copyright (c) 2018 Romain Calascibetta <romain.calascibetta@gmail.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+let default_alphabet =
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+
+let io_buffer_size = 65536
+
+let invalid_arg fmt = Format.ksprintf (fun s -> invalid_arg s) fmt
+
+let invalid_bounds off len =
+  invalid_arg "Invalid bounds (off: %d, len: %d)" off len
+
+let malformed chr = `Malformed (String.make 1 chr)
+
+let unsafe_byte source off pos = Bytes.unsafe_get source (off + pos)
+
+let unsafe_blit = Bytes.unsafe_blit
+
+let unsafe_chr = Char.unsafe_chr
+
+let unsafe_set_chr source off chr = Bytes.unsafe_set source off chr
+
+type state = { quantum : int; size : int; buffer : Bytes.t }
+
+let continue state (quantum, size) = `Continue { state with quantum; size }
+
+let flush state = `Flush { state with quantum = 0; size = 0 }
+
+let table =
+  "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\062\255\255\255\063\052\053\054\055\056\057\058\059\060\061\255\255\255\255\255\255\255\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015\016\017\018\019\020\021\022\023\024\025\255\255\255\255\255\255\026\027\028\029\030\031\032\033\034\035\036\037\038\039\040\041\042\043\044\045\046\047\048\049\050\051\255\255\255\255\255"
+
+let r_repr ({ quantum; size; _ } as state) chr =
+  (* assert (0 <= off && 0 <= len && off + len <= String.length source); *)
+  (* assert (len >= 1); *)
+  let code = Char.code table.[Char.code chr] in
+  match size with
+  | 0 -> continue state (code, 1)
+  | 1 -> continue state ((quantum lsl 6) lor code, 2)
+  | 2 -> continue state ((quantum lsl 6) lor code, 3)
+  | 3 ->
+      unsafe_set_chr state.buffer 0 (unsafe_chr ((quantum lsr 10) land 255)) ;
+      unsafe_set_chr state.buffer 1 (unsafe_chr ((quantum lsr 2) land 255)) ;
+      unsafe_set_chr state.buffer 2
+        (unsafe_chr ((quantum lsl 6) lor code land 255)) ;
+      flush state
+  | _ -> malformed chr
+
+type src = [ `Channel of in_channel | `String of string | `Manual ]
+
+type decode =
+  [ `Await | `End | `Wrong_padding | `Malformed of string | `Flush of string ]
+
+type input =
+  [ `Line_break | `Wsp | `Padding | `Malformed of string | `Flush of state ]
+
+type decoder = {
+  src : src;
+  mutable i : Bytes.t;
+  mutable i_off : int;
+  mutable i_pos : int;
+  mutable i_len : int;
+  mutable s : state;
+  mutable padding : int;
+  mutable unsafe : bool;
+  mutable byte_count : int;
+  mutable limit_count : int;
+  mutable pp : decoder -> input -> decode;
+  mutable k : decoder -> decode;
+}
+
+let i_rem decoder = decoder.i_len - decoder.i_pos + 1
+
+let end_of_input decoder =
+  decoder.i <- Bytes.empty ;
+  decoder.i_off <- 0 ;
+  decoder.i_pos <- 0 ;
+  decoder.i_len <- min_int
+
+let src decoder source off len =
+  if off < 0 || len < 0 || off + len > Bytes.length source
+  then invalid_bounds off len
+  else if len = 0
+  then end_of_input decoder
+  else (
+    decoder.i <- source ;
+    decoder.i_off <- off ;
+    decoder.i_pos <- 0 ;
+    decoder.i_len <- len - 1)
+
+let refill k decoder =
+  match decoder.src with
+  | `Manual ->
+      decoder.k <- k ;
+      `Await
+  | `String _ ->
+      end_of_input decoder ;
+      k decoder
+  | `Channel ic ->
+      let len = input ic decoder.i 0 (Bytes.length decoder.i) in
+      src decoder decoder.i 0 len ;
+      k decoder
+
+let dangerous decoder v = decoder.unsafe <- v
+
+let reset decoder = decoder.limit_count <- 0
+
+let ret k v byte_count decoder =
+  decoder.k <- k ;
+  decoder.byte_count <- decoder.byte_count + byte_count ;
+  decoder.limit_count <- decoder.limit_count + byte_count ;
+  if decoder.limit_count > 78 then dangerous decoder true ;
+  decoder.pp decoder v
+
+type flush_and_malformed = [ `Flush of state | `Malformed of string ]
+
+let padding { size; _ } padding =
+  match (size, padding) with
+  | 0, 0 -> true
+  | 1, _ -> false
+  | 2, 2 -> true
+  | 3, 1 -> true
+  | _ -> false
+
+let t_flush { quantum; size; buffer } =
+  match size with
+  | 0 | 1 -> `Flush { quantum; size; buffer = Bytes.empty }
+  | 2 ->
+      let quantum = quantum lsr 4 in
+      `Flush
+        { quantum; size; buffer = Bytes.make 1 (unsafe_chr (quantum land 255)) }
+  | 3 ->
+      let quantum = quantum lsr 2 in
+      unsafe_set_chr buffer 0 (unsafe_chr ((quantum lsr 8) land 255)) ;
+      unsafe_set_chr buffer 1 (unsafe_chr (quantum land 255)) ;
+      `Flush { quantum; size; buffer = Bytes.sub buffer 0 2 }
+  | _ -> assert false
+
+(* this branch is impossible, size can only ever be in the range [0..3]. *)
+
+let wrong_padding decoder =
+  let k _ = `End in
+  decoder.k <- k ;
+  `Wrong_padding
+
+let rec t_decode_base64 chr decoder =
+  if decoder.padding = 0
+  then
+    let rec go pos = function
+      | `Continue state ->
+          if decoder.i_len - (decoder.i_pos + pos) + 1 > 0
+          then (
+            match unsafe_byte decoder.i decoder.i_off (decoder.i_pos + pos) with
+            | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '+' | '/') as chr ->
+                go (succ pos) (r_repr state chr)
+            | '=' ->
+                decoder.padding <- decoder.padding + 1 ;
+                decoder.i_pos <- decoder.i_pos + pos + 1 ;
+                decoder.s <- state ;
+                ret decode_base64 `Padding (pos + 1) decoder
+            | ' ' | '\t' ->
+                decoder.i_pos <- decoder.i_pos + pos + 1 ;
+                decoder.s <- state ;
+                ret decode_base64 `Wsp (pos + 1) decoder
+            | '\r' ->
+                decoder.i_pos <- decoder.i_pos + pos + 1 ;
+                decoder.s <- state ;
+                decode_base64_lf_after_cr decoder
+            | chr ->
+                decoder.i_pos <- decoder.i_pos + pos + 1 ;
+                decoder.s <- state ;
+                ret decode_base64 (malformed chr) (pos + 1) decoder)
+          else (
+            decoder.i_pos <- decoder.i_pos + pos ;
+            decoder.byte_count <- decoder.byte_count + pos ;
+            decoder.limit_count <- decoder.limit_count + pos ;
+            decoder.s <- state ;
+            refill decode_base64 decoder)
+      | #flush_and_malformed as v ->
+          decoder.i_pos <- decoder.i_pos + pos ;
+          ret decode_base64 v pos decoder in
+    go 1 (r_repr decoder.s chr)
+  else (
+    decoder.i_pos <- decoder.i_pos + 1 ;
+    ret decode_base64 (malformed chr) 1 decoder)
+
+and decode_base64_lf_after_cr decoder =
+  let rem = i_rem decoder in
+  if rem < 0
+  then ret decode_base64 (malformed '\r') 1 decoder
+  else if rem = 0
+  then refill decode_base64_lf_after_cr decoder
+  else
+    match unsafe_byte decoder.i decoder.i_off decoder.i_pos with
+    | '\n' ->
+        decoder.i_pos <- decoder.i_pos + 1 ;
+        ret decode_base64 `Line_break 2 decoder
+    | _ -> ret decode_base64 (malformed '\r') 1 decoder
+
+and decode_base64 decoder =
+  let rem = i_rem decoder in
+  if rem <= 0
+  then
+    if rem < 0
+    then
+      ret
+        (fun decoder ->
+          if padding decoder.s decoder.padding
+          then `End
+          else wrong_padding decoder)
+        (t_flush decoder.s) 0 decoder
+    else refill decode_base64 decoder
+  else
+    match unsafe_byte decoder.i decoder.i_off decoder.i_pos with
+    | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '+' | '/') as chr ->
+        t_decode_base64 chr decoder
+    | '=' ->
+        decoder.padding <- decoder.padding + 1 ;
+        decoder.i_pos <- decoder.i_pos + 1 ;
+        ret decode_base64 `Padding 1 decoder
+    | ' ' | '\t' ->
+        decoder.i_pos <- decoder.i_pos + 1 ;
+        ret decode_base64 `Wsp 1 decoder
+    | '\r' ->
+        decoder.i_pos <- decoder.i_pos + 1 ;
+        decode_base64_lf_after_cr decoder
+    | chr ->
+        decoder.i_pos <- decoder.i_pos + 1 ;
+        ret decode_base64 (malformed chr) 1 decoder
+
+let pp_base64 decoder = function
+  | `Line_break ->
+      reset decoder ;
+      decoder.k decoder
+  | `Wsp | `Padding -> decoder.k decoder
+  | `Flush state ->
+      decoder.s <- state ;
+      `Flush (Bytes.to_string state.buffer)
+  | `Malformed _ as v -> v
+
+let decoder src =
+  let pp = pp_base64 in
+  let k = decode_base64 in
+  let i, i_off, i_pos, i_len =
+    match src with
+    | `Manual -> (Bytes.empty, 0, 1, 0)
+    | `Channel _ -> (Bytes.create io_buffer_size, 0, 1, 0)
+    | `String s -> (Bytes.unsafe_of_string s, 0, 0, String.length s - 1) in
+  {
+    src;
+    i_off;
+    i_pos;
+    i_len;
+    i;
+    s = { quantum = 0; size = 0; buffer = Bytes.create 3 };
+    padding = 0;
+    unsafe = false;
+    byte_count = 0;
+    limit_count = 0;
+    pp;
+    k;
+  }
+
+let decode decoder = decoder.k decoder
+
+let decoder_byte_count decoder = decoder.byte_count
+
+let decoder_src decoder = decoder.src
+
+let decoder_dangerous decoder = decoder.unsafe
+
+(* / *)
+
+let invalid_encode () = invalid_arg "Expected `Await encode"
+
+type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ]
+
+type encode = [ `Await | `End | `Char of char ]
+
+type encoder = {
+  dst : dst;
+  mutable o : Bytes.t;
+  mutable o_off : int;
+  mutable o_pos : int;
+  mutable o_len : int;
+  mutable c_col : int;
+  i : Bytes.t;
+  mutable s : int;
+  t : Bytes.t;
+  mutable t_pos : int;
+  mutable t_len : int;
+  mutable k : encoder -> encode -> [ `Ok | `Partial ];
+}
+
+let o_rem encoder = encoder.o_len - encoder.o_pos + 1
+
+let dst encoder source off len =
+  if off < 0 || len < 0 || off + len > Bytes.length source
+  then invalid_bounds off len ;
+  encoder.o <- source ;
+  encoder.o_off <- off ;
+  encoder.o_pos <- 0 ;
+  encoder.o_len <- len - 1
+
+let dst_rem = o_rem
+
+let partial k encoder = function
+  | `Await -> k encoder
+  | `Char _ | `End -> invalid_encode ()
+
+let flush k encoder =
+  match encoder.dst with
+  | `Manual ->
+      encoder.k <- partial k ;
+      `Partial
+  | `Channel oc ->
+      output oc encoder.o encoder.o_off encoder.o_pos ;
+      encoder.o_pos <- 0 ;
+      k encoder
+  | `Buffer b ->
+      let o = Bytes.unsafe_to_string encoder.o in
+      Buffer.add_substring b o encoder.o_off encoder.o_pos ;
+      encoder.o_pos <- 0 ;
+      k encoder
+
+let t_range encoder len =
+  encoder.t_pos <- 0 ;
+  encoder.t_len <- len
+
+let rec t_flush k encoder =
+  let blit encoder len =
+    unsafe_blit encoder.t encoder.t_pos encoder.o encoder.o_pos len ;
+    encoder.o_pos <- encoder.o_pos + len ;
+    encoder.t_pos <- encoder.t_pos + len in
+  let rem = o_rem encoder in
+  let len = encoder.t_len - encoder.t_pos + 1 in
+  if rem < len
+  then (
+    blit encoder rem ;
+    flush (t_flush k) encoder)
+  else (
+    blit encoder len ;
+    k encoder)
+
+let rec encode_line_break k encoder =
+  let rem = o_rem encoder in
+  let s, j, k =
+    if rem < 2
+    then (
+      t_range encoder 2 ;
+      (encoder.t, 0, t_flush k))
+    else
+      let j = encoder.o_pos in
+      encoder.o_pos <- encoder.o_pos + 2 ;
+      (encoder.o, encoder.o_off + j, k) in
+  unsafe_set_chr s j '\r' ;
+  unsafe_set_chr s (j + 1) '\n' ;
+  encoder.c_col <- 0 ;
+  k encoder
+
+and encode_char chr k (encoder : encoder) =
+  if encoder.s >= 2
+  then (
+    let a, b, c = (unsafe_byte encoder.i 0 0, unsafe_byte encoder.i 0 1, chr) in
+    encoder.s <- 0 ;
+    let quantum = (Char.code a lsl 16) + (Char.code b lsl 8) + Char.code c in
+    let a = quantum lsr 18 in
+    let b = (quantum lsr 12) land 63 in
+    let c = (quantum lsr 6) land 63 in
+    let d = quantum land 63 in
+    let rem = o_rem encoder in
+    let s, j, k =
+      if rem < 4
+      then (
+        t_range encoder 4 ;
+        (encoder.t, 0, t_flush (k 4)))
+      else
+        let j = encoder.o_pos in
+        encoder.o_pos <- encoder.o_pos + 4 ;
+        (encoder.o, encoder.o_off + j, k 4) in
+    unsafe_set_chr s j default_alphabet.[a] ;
+    unsafe_set_chr s (j + 1) default_alphabet.[b] ;
+    unsafe_set_chr s (j + 2) default_alphabet.[c] ;
+    unsafe_set_chr s (j + 3) default_alphabet.[d] ;
+    flush k encoder)
+  else (
+    unsafe_set_chr encoder.i encoder.s chr ;
+    encoder.s <- encoder.s + 1 ;
+    k 0 encoder)
+
+and encode_trailing k encoder =
+  match encoder.s with
+  | 2 ->
+      let b, c = (unsafe_byte encoder.i 0 0, unsafe_byte encoder.i 0 1) in
+      encoder.s <- 0 ;
+      let quantum = (Char.code b lsl 10) + (Char.code c lsl 2) in
+      let b = (quantum lsr 12) land 63 in
+      let c = (quantum lsr 6) land 63 in
+      let d = quantum land 63 in
+      let rem = o_rem encoder in
+      let s, j, k =
+        if rem < 4
+        then (
+          t_range encoder 4 ;
+          (encoder.t, 0, t_flush (k 4)))
+        else
+          let j = encoder.o_pos in
+          encoder.o_pos <- encoder.o_pos + 4 ;
+          (encoder.o, encoder.o_off + j, k 4) in
+      unsafe_set_chr s j default_alphabet.[b] ;
+      unsafe_set_chr s (j + 1) default_alphabet.[c] ;
+      unsafe_set_chr s (j + 2) default_alphabet.[d] ;
+      unsafe_set_chr s (j + 3) '=' ;
+      flush k encoder
+  | 1 ->
+      let c = unsafe_byte encoder.i 0 0 in
+      encoder.s <- 0 ;
+      let quantum = Char.code c lsl 4 in
+      let c = (quantum lsr 6) land 63 in
+      let d = quantum land 63 in
+      let rem = o_rem encoder in
+      let s, j, k =
+        if rem < 4
+        then (
+          t_range encoder 4 ;
+          (encoder.t, 0, t_flush (k 4)))
+        else
+          let j = encoder.o_pos in
+          encoder.o_pos <- encoder.o_pos + 4 ;
+          (encoder.o, encoder.o_off + j, k 4) in
+      unsafe_set_chr s j default_alphabet.[c] ;
+      unsafe_set_chr s (j + 1) default_alphabet.[d] ;
+      unsafe_set_chr s (j + 2) '=' ;
+      unsafe_set_chr s (j + 3) '=' ;
+      flush k encoder
+  | 0 -> k 0 encoder
+  | _ -> assert false
+
+and encode_base64 encoder v =
+  let k col_count encoder =
+    encoder.c_col <- encoder.c_col + col_count ;
+    encoder.k <- encode_base64 ;
+    `Ok in
+  match v with
+  | `Await -> k 0 encoder
+  | `End ->
+      if encoder.c_col = 76
+      then encode_line_break (fun encoder -> encode_base64 encoder v) encoder
+      else encode_trailing k encoder
+  | `Char chr ->
+      let rem = o_rem encoder in
+      if rem < 1
+      then flush (fun encoder -> encode_base64 encoder v) encoder
+      else if encoder.c_col = 76
+      then encode_line_break (fun encoder -> encode_base64 encoder v) encoder
+      else encode_char chr k encoder
+
+let encoder dst =
+  let o, o_off, o_pos, o_len =
+    match dst with
+    | `Manual -> (Bytes.empty, 1, 0, 0)
+    | `Buffer _ | `Channel _ ->
+        (Bytes.create io_buffer_size, 0, 0, io_buffer_size - 1) in
+  {
+    dst;
+    o_off;
+    o_pos;
+    o_len;
+    o;
+    t = Bytes.create 4;
+    t_pos = 1;
+    t_len = 0;
+    c_col = 0;
+    i = Bytes.create 3;
+    s = 0;
+    k = encode_base64;
+  }
+
+let encode encoder = encoder.k encoder
+
+let encoder_dst encoder = encoder.dst

unikernel/duniverse/ocaml-base64/src/base64_rfc2045.mli

@@ -0,0 +1,111 @@
+(*
+ * Copyright (c) 2014-2016 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+(** Decode *)
+
+val default_alphabet : string
+(** A 64-character string specifying the regular Base64 alphabet. *)
+
+type decoder
+(** The type for decoders. *)
+
+type src = [ `Manual | `Channel of in_channel | `String of string ]
+(** The type for input sources. With a [`Manual] source the client must provide
+    input with {!src}. *)
+
+type decode =
+  [ `Await | `End | `Flush of string | `Malformed of string | `Wrong_padding ]
+
+val src : decoder -> Bytes.t -> int -> int -> unit
+(** [src d s j l] provides [d] with [l] bytes to read, starting at [j] in [s].
+    This byte range is read by calls to {!decode} with [d] until [`Await] is
+    returned. To signal the end of input, call the function with [l = 0]. *)
+
+val decoder : src -> decoder
+(** [decoder src] is a decoder that inputs from [src]. *)
+
+val decode : decoder -> decode
+(** [decode d] is:
+
+    - [`Await] if [d] has a [`Manual] input source and awaits for more input.
+      The client must use {!src} to provide it.
+    - [`End] if the end of input was reached
+    - [`Malformed bytes] if the [bytes] sequence is malformed according to the
+      decoded base64 encoding scheme. If you are interested in a best-effort
+      decoding, you can still continue to decode after an error until the decode
+      synchronizes again on valid bytes.
+    - [`Flush data] if a [data] sequence value was decoded.
+    - [`Wrong_padding] if decoder retrieve a wrong padding at the end of the
+      input.
+
+    {b Note}. Repeated invocation always eventually returns [`End], even in case
+    of errors. *)
+
+val decoder_byte_count : decoder -> int
+(** [decoder_byte_count d] is the number of characters already decoded on [d]
+    (included malformed ones). This is the last {!decode}'s end output offset
+    counting from beginning of the stream. *)
+
+val decoder_src : decoder -> src
+(** [decoder_src d] is [d]'s input source. *)
+
+val decoder_dangerous : decoder -> bool
+(** [decoder_dangerous d] returns [true] if encoded input does not respect the
+    80-columns rule. If your are interested in a best-effort decoding you can
+    still continue to decode even if [decoder_dangerous d] returns [true].
+    Nothing grow automatically internally in this state. *)
+
+type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ]
+(** The type for output destinations. With a [`Manual] destination the client
+    must provide output storage with {!dst}. *)
+
+type encode = [ `Await | `End | `Char of char ]
+
+type encoder
+(** The type for Base64 (RFC2045) encoder. *)
+
+val encoder : dst -> encoder
+(** [encoder dst] is an encoder for Base64 (RFC2045) that outputs to [dst]. *)
+
+val encode : encoder -> encode -> [ `Ok | `Partial ]
+(** [encode e v]: is
+
+    - [`Partial] iff [e] has a [`Manual] destination and needs more output
+      storage. The client must use {!dst} to provide a new buffer and then call
+      {!encode} with [`Await] until [`Ok] is returned.
+    - [`Ok] when the encoder is ready to encode a new [`Char] or [`End]
+
+    For [`Manual] destination, encoding [`End] always return [`Partial], the
+    client should continue as usual with [`Await] until [`Ok] is returned at
+    which point {!dst_rem} [encoder] is guaranteed to be the size of the last
+    provided buffer (i.e. nothing was written).
+
+    {b Raises.} [Invalid_argument] if a [`Char] or [`End] is encoded after a
+    [`Partial] encode. *)
+
+val encoder_dst : encoder -> dst
+(** [encoder_dst encoder] is [encoder]'s output destination. *)
+
+val dst : encoder -> Bytes.t -> int -> int -> unit
+(** [dst e s j l] provides [e] with [l] bytes to write, starting at [j] in [s].
+    This byte range is written by calls to {!encode} with [e] until [`Partial]
+    is returned. Use {!dst_rem} to know the remaining number of non-written free
+    bytes in [s]. *)
+
+val dst_rem : encoder -> int
+(** [dst_rem e] is the remaining number of non-written, free bytes in the last
+    buffer provided with {!dst}. *)

unikernel/duniverse/ocaml-base64/src/dune

@@ -0,0 +1,9 @@
+(library
+ (name base64)
+ (modules base64)
+ (public_name base64))
+
+(library
+ (name base64_rfc2045)
+ (modules base64_rfc2045)
+ (public_name base64.rfc2045))

unikernel/duniverse/ocaml-base64/test/dune

@@ -0,0 +1,11 @@
+(executable
+ (modes byte exe)
+ (name test)
+ (libraries base64 base64.rfc2045 rresult alcotest bos))
+
+(rule
+ (alias runtest)
+ (deps
+  (:exe test.exe))
+ (action
+  (run %{exe} --color=always)))

unikernel/duniverse/ocaml-base64/test/test.ml

@@ -0,0 +1,320 @@
+(*
+ * Copyright (c) 2016 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+open Printf
+open Rresult
+
+(* Test vectors from RFC4648
+   BASE64("") = ""
+   BASE64("f") = "Zg=="
+   BASE64("fo") = "Zm8="
+   BASE64("foo") = "Zm9v"
+   BASE64("foob") = "Zm9vYg=="
+   BASE64("fooba") = "Zm9vYmE="
+   BASE64("foobar") = "Zm9vYmFy"
+*)
+
+let rfc4648_tests =
+  [
+    ("", "");
+    ("f", "Zg==");
+    ("fo", "Zm8=");
+    ("foo", "Zm9v");
+    ("foob", "Zm9vYg==");
+    ("fooba", "Zm9vYmE=");
+    ("foobar", "Zm9vYmFy");
+  ]
+
+let hannes_tests =
+  [
+    ("dummy", "ZHVtbXk=");
+    ("dummy", "ZHVtbXk");
+    ("dummy", "ZHVtbXk==");
+    ("dummy", "ZHVtbXk===");
+    ("dummy", "ZHVtbXk====");
+    ("dummy", "ZHVtbXk=====");
+    ("dummy", "ZHVtbXk======");
+  ]
+
+let php_tests =
+  [
+    ( "πάντα χωρεῖ καὶ οὐδὲν μένει …",
+      "z4DOrM69z4TOsSDPh8-Jz4HOteG_liDOus6x4b22IM6_4b2QzrThvbLOvSDOvM6tzr3Otc65IOKApg"
+    );
+  ]
+
+let rfc3548_tests =
+  [
+    ("\x14\xfb\x9c\x03\xd9\x7e", "FPucA9l+");
+    ("\x14\xfb\x9c\x03\xd9", "FPucA9k=");
+    ("\x14\xfb\x9c\x03", "FPucAw==");
+  ]
+
+let cfcs_tests =
+  [
+    (0, 2, "\004", "BB");
+    (1, 2, "\004", "ABB");
+    (1, 2, "\004", "ABBA");
+    (2, 2, "\004", "AABBA");
+    (2, 2, "\004", "AABBAA");
+    (0, 0, "", "BB");
+    (1, 0, "", "BB");
+    (2, 0, "", "BB");
+  ]
+
+let nocrypto_tests =
+  [
+    ("\x00\x5a\x6d\x39\x76", None);
+    ("\x5a\x6d\x39\x76", Some "\x66\x6f\x6f");
+    ("\x5a\x6d\x39\x76\x76", None);
+    ("\x5a\x6d\x39\x76\x76\x76", None);
+    ("\x5a\x6d\x39\x76\x76\x76\x76", None);
+    ("\x5a\x6d\x39\x76\x00", None);
+    ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d", Some "\x66\x6f\x6f\x6f");
+    ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00", None);
+    ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00\x01", None);
+    ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00\x01\x02", None);
+    ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00\x01\x02\x03", None);
+    ("\x5a\x6d\x39\x76\x62\x32\x38\x3d", Some "\x66\x6f\x6f\x6f\x6f");
+    ("\x5a\x6d\x39\x76\x62\x32\x39\x76", Some "\x66\x6f\x6f\x6f\x6f\x6f");
+    ("YWE=", Some "aa");
+    ("YWE==", None);
+    ("YWE===", None);
+    ("YWE=====", None);
+    ("YWE======", None);
+  ]
+
+let alphabet_size () =
+  List.iter
+    (fun (name, alphabet) ->
+      Alcotest.(check int)
+        (sprintf "Alphabet size %s = 64" name)
+        64
+        (Base64.length_alphabet alphabet))
+    [
+      ("default", Base64.default_alphabet);
+      ("uri_safe", Base64.uri_safe_alphabet);
+    ]
+
+(* Encode using OpenSSL `base64` utility *)
+let openssl_encode buf =
+  Bos.(
+    OS.Cmd.in_string buf
+    |> OS.Cmd.run_io (Cmd.v "base64")
+    |> OS.Cmd.to_string ~trim:true)
+  |> function
+  | Ok r ->
+      prerr_endline r ;
+      r
+  | Error (`Msg e) -> raise (Failure (sprintf "OpenSSL decode: %s" e))
+
+(* Encode using this library *)
+let lib_encode buf = Base64.encode_exn ~pad:true buf
+
+let test_rfc4648 () =
+  List.iter
+    (fun (c, r) ->
+      (* Base64 vs openssl *)
+      Alcotest.(check string)
+        (sprintf "encode %s" c) (openssl_encode c) (lib_encode c) ;
+      (* Base64 vs test cases above *)
+      Alcotest.(check string) (sprintf "encode rfc4648 %s" c) r (lib_encode c) ;
+      (* Base64 decode vs library *)
+      Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn r))
+    rfc4648_tests
+
+let test_rfc3548 () =
+  List.iter
+    (fun (c, r) ->
+      (* Base64 vs openssl *)
+      Alcotest.(check string)
+        (sprintf "encode %s" c) (openssl_encode c) (lib_encode c) ;
+      (* Base64 vs test cases above *)
+      Alcotest.(check string) (sprintf "encode rfc3548 %s" c) r (lib_encode c) ;
+      (* Base64 decode vs library *)
+      Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn r))
+    rfc3548_tests
+
+let test_hannes () =
+  List.iter
+    (fun (c, r) ->
+      (* Base64 vs test cases above *)
+      Alcotest.(check string)
+        (sprintf "decode %s" r) c
+        (Base64.decode_exn ~pad:false r))
+    hannes_tests
+
+let test_php () =
+  List.iter
+    (fun (c, r) ->
+      Alcotest.(check string)
+        (sprintf "decode %s" r) c
+        (Base64.decode_exn ~pad:false ~alphabet:Base64.uri_safe_alphabet r))
+    php_tests
+
+let test_cfcs () =
+  List.iter
+    (fun (off, len, c, r) ->
+      Alcotest.(check string)
+        (sprintf "decode %s" r) c
+        (Base64.decode_exn ~pad:false ~off ~len r))
+    cfcs_tests
+
+let test_nocrypto () =
+  List.iter
+    (fun (input, res) ->
+      let res' =
+        match Base64.decode ~pad:true input with
+        | Ok v -> Some v
+        | Error _ -> None in
+      Alcotest.(check (option string)) (sprintf "decode %S" input) res' res)
+    nocrypto_tests
+
+exception Malformed
+
+exception Wrong_padding
+
+let strict_base64_rfc2045_of_string x =
+  let decoder = Base64_rfc2045.decoder (`String x) in
+  let res = Buffer.create 16 in
+
+  let rec go () =
+    match Base64_rfc2045.decode decoder with
+    | `End -> ()
+    | `Wrong_padding -> raise Wrong_padding
+    | `Malformed _ -> raise Malformed
+    | `Flush x ->
+        Buffer.add_string res x ;
+        go ()
+    | `Await -> Alcotest.failf "Retrieve impossible case: `Await" in
+
+  Base64_rfc2045.src decoder (Bytes.unsafe_of_string x) 0 (String.length x) ;
+  go () ;
+  Buffer.contents res
+
+let relaxed_base64_rfc2045_of_string x =
+  let decoder = Base64_rfc2045.decoder (`String x) in
+  let res = Buffer.create 16 in
+
+  let rec go () =
+    match Base64_rfc2045.decode decoder with
+    | `End -> ()
+    | `Wrong_padding -> go ()
+    | `Malformed _ -> go ()
+    | `Flush x ->
+        Buffer.add_string res x ;
+        go ()
+    | `Await -> Alcotest.failf "Retrieve impossible case: `Await" in
+
+  Base64_rfc2045.src decoder (Bytes.unsafe_of_string x) 0 (String.length x) ;
+  go () ;
+  Buffer.contents res
+
+let test_strict_rfc2045 =
+  [
+    ( "c2FsdXQgbGVzIGNvcGFpbnMgZmF1dCBhYnNvbHVtZW50IHF1ZSBqZSBkw6lwYXNzZSBsZXMgODAg\r\n\
+       Y2hhcmFjdGVycyBwb3VyIHZvaXIgc2kgbW9uIGVuY29kZXIgZml0cyBiaWVuIGRhbnMgbGVzIGxp\r\n\
+       bWl0ZXMgZGUgbGEgUkZDIDIwNDUgLi4u",
+      "salut les copains faut absolument que je dépasse les 80 characters \
+       pour voir si mon encoder fits bien dans les limites de la RFC 2045 ..."
+    );
+    ("", "");
+    ("Zg==", "f");
+    ("Zm8=", "fo");
+    ("Zm9v", "foo");
+    ("Zm9vYg==", "foob");
+    ("Zm9vYmE=", "fooba");
+    ("Zm9vYmFy", "foobar");
+  ]
+
+let test_relaxed_rfc2045 =
+  [
+    ("Zg", "f");
+    ("Zm\n8", "fo");
+    ("Zm\r9v", "foo");
+    ("Zm9 vYg", "foob");
+    ("Zm9\r\n vYmE", "fooba");
+    ("Zm9évYmFy", "foobar");
+  ]
+
+let strict_base64_rfc2045_to_string x =
+  let res = Buffer.create 16 in
+  let encoder = Base64_rfc2045.encoder (`Buffer res) in
+  String.iter
+    (fun chr ->
+      match Base64_rfc2045.encode encoder (`Char chr) with
+      | `Ok -> ()
+      | `Partial ->
+          Alcotest.failf "Retrieve impossible case for (`Char %02x): `Partial"
+            (Char.code chr))
+    x ;
+  match Base64_rfc2045.encode encoder `End with
+  | `Ok -> Buffer.contents res
+  | `Partial -> Alcotest.fail "Retrieve impossible case for `End: `Partial"
+
+let test_strict_with_malformed_input_rfc2045 =
+  List.mapi
+    (fun i (has, _) ->
+      Alcotest.test_case (Fmt.str "strict rfc2045 - %02d" i) `Quick @@ fun () ->
+      try
+        let _ = strict_base64_rfc2045_of_string has in
+        Alcotest.failf "Strict parser valids malformed input: %S" has
+      with Malformed | Wrong_padding -> ())
+    test_relaxed_rfc2045
+
+let test_strict_rfc2045 =
+  List.mapi
+    (fun i (has, expect) ->
+      Alcotest.test_case (Fmt.str "strict rfc2045 - %02d" i) `Quick @@ fun () ->
+      try
+        let res0 = strict_base64_rfc2045_of_string has in
+        let res1 = strict_base64_rfc2045_to_string res0 in
+        Alcotest.(check string) "encode(decode(x)) = x" res1 has ;
+        Alcotest.(check string) "decode(x)" res0 expect
+      with Malformed | Wrong_padding -> Alcotest.failf "Invalid input %S" has)
+    test_strict_rfc2045
+
+let test_relaxed_rfc2045 =
+  List.mapi
+    (fun i (has, expect) ->
+      Alcotest.test_case (Fmt.str "relaxed rfc2045 - %02d" i) `Quick
+      @@ fun () ->
+      let res0 = relaxed_base64_rfc2045_of_string has in
+      Alcotest.(check string) "decode(x)" res0 expect)
+    test_relaxed_rfc2045
+
+let test_invariants = [ ("Alphabet size", `Quick, alphabet_size) ]
+
+let test_codec =
+  [
+    ("RFC4648 test vectors", `Quick, test_rfc4648);
+    ("RFC3548 test vectors", `Quick, test_rfc3548);
+    ("Hannes test vectors", `Quick, test_hannes);
+    ("Cfcs test vectors", `Quick, test_cfcs);
+    ("PHP test vectors", `Quick, test_php);
+    ("Nocrypto test vectors", `Quick, test_nocrypto);
+  ]
+
+let () =
+  Alcotest.run "Base64"
+    [
+      ("invariants", test_invariants);
+      ("codec", test_codec);
+      ("rfc2045 (0)", test_strict_rfc2045);
+      ("rfc2045 (1)", test_strict_with_malformed_input_rfc2045);
+      ("rfc2045 (2)", test_relaxed_rfc2045);
+    ]