This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
25
unikernel/duniverse/uuidm/test/examples.ml
Normal file
25
unikernel/duniverse/uuidm/test/examples.ml
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2024 The uuidm programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Code from the quick start *)
|
||||
|
||||
let uuid = Uuidm.v4_gen (Random.State.make_self_init ())
|
||||
let () = print_endline (Uuidm.to_string (uuid ()))
|
||||
let () = print_endline (Uuidm.to_string (uuid ()))
|
||||
|
||||
let feed_id ~feed_id = "urn:uuid:" ^ (Uuidm.to_string feed_id)
|
||||
let entry_id ~feed_id ~rfc3339_stamp =
|
||||
"urn:uuid:" ^ (Uuidm.to_string @@ Uuidm.v5 feed_id rfc3339_stamp)
|
||||
|
||||
let uuid_monotonic =
|
||||
let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in
|
||||
Uuidm.v7_monotonic_gen ~now_ms (Random.State.make_self_init ())
|
||||
|
||||
let rec uuid () = match uuid_monotonic () with
|
||||
| None -> (* Too many UUIDs generated in a ms *) Unix.sleepf 1e-3; uuid ()
|
||||
| Some uuid -> uuid
|
||||
|
||||
let () = print_endline (Uuidm.to_string (uuid ()))
|
||||
let () = print_endline (Uuidm.to_string (uuid ()))
|
||||
39
unikernel/duniverse/uuidm/test/perf.ml
Normal file
39
unikernel/duniverse/uuidm/test/perf.ml
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
(* This code is in the public domain *)
|
||||
|
||||
let str = Printf.sprintf
|
||||
let exec = Filename.basename Sys.executable_name
|
||||
|
||||
let main () =
|
||||
let usage =
|
||||
str "Usage: %s [OPTION]...\n\
|
||||
\ UUID performance tests.\n\
|
||||
Options:" exec
|
||||
in
|
||||
let n = ref 10_000_000 in
|
||||
let v = ref `V4 in
|
||||
let cstr = ref false in
|
||||
let options = [
|
||||
"-n", Arg.Set_int n,
|
||||
"<int> Number of ids to generate";
|
||||
"-str", Arg.Set cstr,
|
||||
" Also convert UUIDs to strings";
|
||||
"-r", Arg.Unit (fun () -> v := `V4),
|
||||
" Random based UUID version 4 (default)";
|
||||
"-md5", Arg.Unit (fun () -> v := `V3 (Uuidm.ns_dns,"www.example.org")),
|
||||
" MD5 name based UUID version 3";
|
||||
"-sha1", Arg.Unit (fun () -> v := `V5 (Uuidm.ns_dns,"www.example.org")),
|
||||
" SHA-1 name based UUID version 5"; ]
|
||||
in
|
||||
Arg.parse (Arg.align options) (fun _ -> ()) usage;
|
||||
let uuid = match !v with
|
||||
| `V4 -> Uuidm.v4_gen (Random.State.make_self_init ())
|
||||
| `V3 (ns, n) -> fun () -> Uuidm.v3 ns n
|
||||
| `V5 (ns, n) -> fun () -> Uuidm.v5 ns n
|
||||
in
|
||||
let f = match !cstr with
|
||||
| true -> fun version -> ignore (Uuidm.to_string (uuid ()))
|
||||
| false -> fun version -> ignore (uuid ())
|
||||
in
|
||||
for i = 1 to !n do f v done
|
||||
|
||||
let () = main ()
|
||||
90
unikernel/duniverse/uuidm/test/test_uuidm.ml
Normal file
90
unikernel/duniverse/uuidm/test/test_uuidm.ml
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2024 The uuidm programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
|
||||
let test_uuid ?__POS__:pos version ?time_ms u us =
|
||||
Test.block ?__POS__:pos @@ fun () ->
|
||||
let us = Test.noraise ~__POS__ @@ fun () -> Option.get (Uuidm.of_string us) in
|
||||
let trip =
|
||||
Test.noraise ~__POS__ @@ fun () ->
|
||||
Option.get (Uuidm.of_string (Uuidm.to_string u))
|
||||
in
|
||||
let variant = Uuidm.variant u in
|
||||
Test.eq (module Uuidm) u trip ~__POS__;
|
||||
Test.eq (module Uuidm) u us ~__POS__ ;
|
||||
if Uuidm.equal u Uuidm.nil then Test.int variant 0x0 ~__POS__ else
|
||||
if Uuidm.equal u Uuidm.max then Test.int variant 0xF ~__POS__ else
|
||||
Test.holds (8 <= variant && variant <= 0xB) ~__POS__;
|
||||
Test.int (Uuidm.version u) version ~__POS__;
|
||||
Test.(option T.int64) (Uuidm.time_ms u) time_ms ~__POS__;
|
||||
()
|
||||
|
||||
let test_constructors =
|
||||
Test.test "Uuid.v* constructors" @@ fun () ->
|
||||
test_uuid ~__POS__ 3
|
||||
(Uuidm.v3 Uuidm.ns_dns "www.widgets.com")
|
||||
"3D813CBB-47FB-32BA-91DF-831E1593AC29";
|
||||
test_uuid ~__POS__ 3
|
||||
(Uuidm.v3 Uuidm.ns_dns "www.example.org")
|
||||
"0012416f-9eec-3ed4-a8b0-3bceecde1cd9";
|
||||
test_uuid ~__POS__ 3
|
||||
(Uuidm.v3 Uuidm.ns_dns "www.example.com")
|
||||
"5df41881-3aed-3515-88a7-2f4a814cf09e";
|
||||
test_uuid ~__POS__ 4
|
||||
(Uuidm.v4
|
||||
(Bytes.of_string
|
||||
"\x91\x91\x08\xF7\x52\xD1\x33\x20\x5B\xAC\xF8\x47\xDB\x41\x48\xA8"))
|
||||
"919108f7-52d1-4320-9bac-f847db4148a8";
|
||||
test_uuid ~__POS__ 5
|
||||
(Uuidm.v5 Uuidm.ns_dns "www.widgets.com")
|
||||
"21F7F8DE-8051-5B89-8680-0195EF798B6A";
|
||||
test_uuid ~__POS__ 5
|
||||
(Uuidm.v5 Uuidm.ns_dns "www.example.org")
|
||||
"74738ff5-5367-5958-9aee-98fffdcd1876";
|
||||
test_uuid ~__POS__ 5
|
||||
(Uuidm.v5 Uuidm.ns_dns "www.example.com")
|
||||
"2ed6657d-e927-568b-95e1-2665a8aea6a2";
|
||||
test_uuid ~__POS__ 7 ~time_ms:0x1020_3040_5060L
|
||||
(Uuidm.v7_ns ~time_ns:Int64.(add (mul 1_000_000L 0x1020_3040_5060L) 213135L)
|
||||
~rand_b:0x123456789abcdef0L)
|
||||
"10203040-5060-7369-9234-56789abcdef0";
|
||||
test_uuid ~__POS__ 7 ~time_ms:0x017F22E279B0L
|
||||
(Uuidm.v7
|
||||
~time_ms:0x017F22E279B0L ~rand_a:0xCC3 ~rand_b:0x18C4DC0C0C07398FL)
|
||||
"017F22E2-79B0-7CC3-98C4-DC0C0C07398F";
|
||||
test_uuid ~__POS__ 8
|
||||
(Uuidm.v8
|
||||
"\x24\x89\xE9\xAD\x2E\xE2\x0E\x00\x0E\xC9\x32\xD5\xF6\x91\x81\xC0")
|
||||
"2489E9AD-2EE2-8E00-8EC9-32D5F69181C0";
|
||||
Test.invalid_arg ~__POS__ @@ fun () -> ignore (Uuidm.v8 "");
|
||||
()
|
||||
|
||||
let test_constants =
|
||||
Test.test "Uuidm UUID constants" @@ fun () ->
|
||||
test_uuid ~__POS__ 0 Uuidm.nil "00000000-0000-0000-0000-000000000000";
|
||||
test_uuid ~__POS__ 0xF Uuidm.max "ffffffff-ffff-ffff-ffff-ffffffffffff";
|
||||
test_uuid ~__POS__ 1 Uuidm.ns_dns "6ba7b810-9dad-11d1-80b4-00c04fd430c8";
|
||||
test_uuid ~__POS__ 1 Uuidm.ns_url "6ba7b811-9dad-11d1-80b4-00c04fd430c8";
|
||||
test_uuid ~__POS__ 1 Uuidm.ns_oid "6ba7b812-9dad-11d1-80b4-00c04fd430c8";
|
||||
test_uuid ~__POS__ 1 Uuidm.ns_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8";
|
||||
()
|
||||
|
||||
let test_mixed_endian =
|
||||
Test.test "Uuidm.{of,to}_mixed_endian_binary_string" @@ fun () ->
|
||||
test_uuid ~__POS__ 13
|
||||
(Uuidm.unsafe_of_binary_string
|
||||
(Uuidm.to_mixed_endian_binary_string Uuidm.ns_X500))
|
||||
"14B8a76b-ad9d-d111-80b4-00c04fd430c8";
|
||||
test_uuid ~__POS__ 13
|
||||
(Test.noraise ~__POS__ @@ fun () ->
|
||||
Option.get @@
|
||||
Uuidm.of_mixed_endian_binary_string
|
||||
(Uuidm.to_binary_string Uuidm.ns_X500))
|
||||
"14B8a76b-ad9d-d111-80b4-00c04fd430c8";
|
||||
()
|
||||
|
||||
let main () = Test.main @@ fun () -> Test.autorun ()
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
99
unikernel/duniverse/uuidm/test/uuidtrip.ml
Normal file
99
unikernel/duniverse/uuidm/test/uuidtrip.ml
Normal file
|
|
@ -0,0 +1,99 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2008 The uuidm programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let strf = Printf.sprintf
|
||||
|
||||
let gen ~version ~ns ~name ~upper ~binary =
|
||||
let u = match version with
|
||||
| `V3 -> Uuidm.v3 ns name
|
||||
| `V4 -> Uuidm.v4_gen (Random.State.make_self_init ()) ()
|
||||
| `V5 -> Uuidm.v5 ns name
|
||||
| `V7 ->
|
||||
let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in
|
||||
Uuidm.v7_non_monotonic_gen ~now_ms (Random.State.make_self_init ()) ()
|
||||
in
|
||||
let s = match binary with
|
||||
| true -> Uuidm.to_binary_string u
|
||||
| false -> strf "%s\n" (Uuidm.to_string ~upper u)
|
||||
in
|
||||
let () = Out_channel.set_binary_mode stdout binary in
|
||||
print_string s; flush stdout
|
||||
|
||||
(* Command line interface *)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let version =
|
||||
let v3 =
|
||||
let doc =
|
||||
"Generate a MD5 name based UUID version 3, see option $(b,--name)." in
|
||||
`V3, Arg.info ["v3"; "md5"] ~doc
|
||||
in
|
||||
let v4 =
|
||||
let doc = "Generate a random based UUID version 4 (default)." in
|
||||
`V4, Arg.info ["v4"; "r"; "random"] ~doc
|
||||
in
|
||||
let v5 =
|
||||
let doc =
|
||||
"Generate a SHA-1 name based UUID version 5, see option $(b,--name)."
|
||||
in
|
||||
`V5, Arg.info ["v5"; "sha1"] ~doc
|
||||
in
|
||||
let v7 =
|
||||
let doc = "Generate a time and random based UUID version 7." in
|
||||
`V7, Arg.info ["v7"] ~doc
|
||||
in
|
||||
Arg.(value & vflag `V4 [v3; v4; v5; v7])
|
||||
|
||||
let ns =
|
||||
let ns_arg =
|
||||
let parse s = match Uuidm.of_string s with
|
||||
| None -> Error (strf "%S: could not parse namespace UUID" s)
|
||||
| Some ns -> Ok ns
|
||||
in
|
||||
Arg.conv' ~docv:"UUID" (parse, Uuidm.pp)
|
||||
in
|
||||
let doc = "Namespace UUID for name based UUIDs (version 4 or 5).
|
||||
Defaults to the DNS namespace UUID."
|
||||
in
|
||||
Arg.(value & opt ns_arg Uuidm.ns_dns & info ["ns"; "namespace"] ~doc)
|
||||
|
||||
let name =
|
||||
let doc = "Name for name based UUIDs (version 4 or 5)." in
|
||||
Arg.(value & opt string "www.example.org" & info ["name"] ~doc)
|
||||
|
||||
let upper =
|
||||
let doc = "Output hexadecimal letters in uppercase" in
|
||||
Arg.(value & flag & info ["u"; "uppercase"] ~doc)
|
||||
|
||||
let binary =
|
||||
let doc = "Output the UUID as its 16 bytes binary representation." in
|
||||
Arg.(value & flag & info ["b"; "binary"] ~doc)
|
||||
|
||||
let cmd =
|
||||
let doc = "Generates universally unique identifiers (UUIDs)" in
|
||||
let man = [
|
||||
`S "DESCRIPTION";
|
||||
`P "$(tname) generates 128 bits universally unique identifiers version
|
||||
3, 5 (name based with MD5, SHA-1 hashing), 4 (random based) and
|
||||
7 (time and random based) according to RFC 9562.";
|
||||
`P "Invoked without any option, a random based version 4 UUID is \
|
||||
generated and written on stdout.";
|
||||
`S "SEE ALSO";
|
||||
`P "P. Leach et al. Universally Unique IDentifiers (UUIDs),
|
||||
2024. $(i,https://www.rfc-editor.org/rfc/rfc9562)";
|
||||
`S "BUGS";
|
||||
`P "This program is distributed with the Uuidm OCaml library. \
|
||||
See $(i,https://erratique.ch/software/uuidm) for contact \
|
||||
information."; ]
|
||||
in
|
||||
Cmd.v (Cmd.info "uuidtrip" ~version:"v0.9.10+dune" ~doc ~man) @@
|
||||
let+ version and+ ns and+ name and+ upper and+ binary in
|
||||
gen ~version ~ns ~name ~upper ~binary
|
||||
|
||||
let main () = Cmd.eval cmd
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
Loading…
Add table
Add a link
Reference in a new issue