├── .gitignore ├── .merlin ├── .ocp-indent ├── B0.ml ├── BRZO ├── CHANGES.md ├── DEVEL.md ├── LICENSE.md ├── README.md ├── _tags ├── doc └── index.mld ├── opam ├── pkg ├── META └── pkg.ml ├── src ├── uuidm.ml ├── uuidm.mli └── uuidm.mllib └── test ├── examples.ml ├── perf.ml ├── test_uuidm.ml └── uuidtrip.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _b0 3 | tmp 4 | *.install -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG b0.kit cmdliner 2 | S src/** 3 | S test/** 4 | B _b0/** -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never -------------------------------------------------------------------------------- /B0.ml: -------------------------------------------------------------------------------- 1 | open B0_kit.V000 2 | 3 | (* OCaml library names *) 4 | 5 | let b0_std = B0_ocaml.libname "b0.std" 6 | let cmdliner = B0_ocaml.libname "cmdliner" 7 | let unix = B0_ocaml.libname "unix" 8 | let uuidm = B0_ocaml.libname "uuidm" 9 | 10 | (* Libraries *) 11 | 12 | let uuidm_lib = B0_ocaml.lib uuidm ~srcs:[`Dir ~/"src"] 13 | 14 | (* Tests *) 15 | 16 | let test ?(requires = []) = B0_ocaml.test ~requires:(uuidm :: requires) 17 | let perf = test ~/"test/perf.ml" ~run:false ~doc:"Test Uuidm performance" 18 | let examples = 19 | test ~/"test/examples.ml" ~run:false ~requires:[unix] ~doc:"Sample code" 20 | let test_uuidm = 21 | test ~/"test/test_uuidm.ml" ~requires:[b0_std] ~doc:"Test Uuidm" 22 | 23 | (* Tools *) 24 | 25 | let uuidtrip = 26 | let doc = "Generates universally unique identifiers (UUIDs)" in 27 | let srcs = [`File ~/"test/uuidtrip.ml"] in 28 | let requires = [uuidm; unix; cmdliner] in 29 | B0_ocaml.exe "uuidtrip" ~public:true ~doc ~srcs ~requires 30 | 31 | (* Packs *) 32 | 33 | let default = 34 | let meta = 35 | B0_meta.empty 36 | |> ~~ B0_meta.authors ["The uuidm programmers"] 37 | |> ~~ B0_meta.maintainers ["Daniel Bünzli "] 38 | |> ~~ B0_meta.homepage "https://erratique.ch/software/uuidm" 39 | |> ~~ B0_meta.online_doc "https://erratique.ch/software/uuidm/doc/" 40 | |> ~~ B0_meta.licenses ["ISC"] 41 | |> ~~ B0_meta.repo "git+https://erratique.ch/repos/uuidm.git" 42 | |> ~~ B0_meta.issues "https://github.com/dbuenzli/uuidm/issues" 43 | |> ~~ B0_meta.description_tags ["uuid"; "codec"; "org:erratique"] 44 | |> B0_meta.tag B0_opam.tag 45 | |> ~~ B0_opam.depopts ["cmdliner", ""] 46 | |> ~~ B0_opam.conflicts [ "cmdliner", {|< "1.3.0"|}] 47 | |> ~~ B0_opam.depends 48 | [ "ocaml", {|>= "4.14.0"|}; 49 | "ocamlfind", {|build|}; 50 | "ocamlbuild", {|build|}; 51 | "topkg", {|build & >= "1.0.3"|}; 52 | ] 53 | |> B0_meta.add B0_opam.build 54 | {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" 55 | "--with-cmdliner" "%{cmdliner:installed}%"]]|} 56 | in 57 | B0_pack.make "default" ~doc:"uuidm package" ~meta ~locked:true @@ 58 | B0_unit.list () 59 | -------------------------------------------------------------------------------- /BRZO: -------------------------------------------------------------------------------- 1 | (srcs-x pkg) -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v0.9.10 2025-03-10 La Forclaz (VS) 2 | ---------------------------------- 3 | 4 | - Install forgotten `index.mld` file. 5 | - `uuidtrip`: handle `cmdliner` deprecations. 6 | 7 | v0.9.9 2024-09-26 Zagreb 8 | ------------------------ 9 | 10 | - Add `Uuidm.{v7,v7_ns}` to create time and random based V7 UUIDs. 11 | Thanks to Robin Newton for the patch (#14) and Christian Linding 12 | and Pau Ruiz Safont for the help. 13 | - Add `Uuidm.v7_[non_]monotonic_gen` V7 UUID generators. 14 | - Add `Uuidm.v8` to create V8 custom UUIDs. 15 | - Add `Uuidm.max` the RFC 9569 Max UUID. 16 | - Add `Uuidm.{variant,version,time_ms}` UUID property accessors. 17 | - Change `Uuidm.v4_gen` generation strategy. 18 | - Call `Random.State.make_self_init` lazily rather than during module 19 | initialisation. 20 | - Documentation: clarified that `Random` based UUID generators are not stable 21 | accross OCaml and Uuidm versions. 22 | - Deprecate `Uuidm.v`, use individual version constructors instead. 23 | - Deprecate type `Uuidm.version`. 24 | - Deprecate `Uuidm.pp_string` to `Uuidm.pp'`. 25 | - Deprecate `Uuidm.{to,of}_[mixed_endian_]bytes` to 26 | `Uuidm.{to,of}_[mixed_endian_]binary_string` (follow `Stdlib` terminology). 27 | - Require OCaml 4.14. 28 | - `uuidtrip` set standard output to binary when outputing binary uuids. 29 | - `uuidtrip` add options `--v3`, `--v4`, `--v5`, `--v7`. 30 | - `uuidtrip` add support for time and random based v7 UUIDs generation. 31 | 32 | v0.9.8 2022-02-09 La Forclaz (VS) 33 | --------------------------------- 34 | 35 | - Add deprecation warnings on what is already deprecated. 36 | - Require OCaml 4.08 and support 5.00 (Thanks to Kate @ki-ty-kate 37 | for the patch). 38 | 39 | 40 | v0.9.7 2019-03-08 La Forclaz (VS) 41 | --------------------------------- 42 | 43 | - Add `Uuidm.v4`, creates random based V4 UUID using client provided 44 | random bytes (#8). Thanks to François-René Rideau for suggesting and 45 | David Kaloper Meršinjak for additional comments. 46 | - Add `Uuidm.{to,of}_mixed_endian_bytes`. Support for UEFI and 47 | Microsoft's binary serialization of UUIDs. 48 | 49 | 50 | v0.9.6 2016-08-12 Zagreb 51 | ------------------------ 52 | 53 | - Safe-string support. Thanks to Josh Allmann for the help. 54 | - Deprecate `Uuidm.create` in favor of `Uuidm.v`. 55 | - Deprecate `Uuidm.print` in favor of `Uuidm.pp_string` 56 | - Add `Uuidm.pp`. 57 | - Relicensed from BSD3 to ISC. 58 | - Build depend on topkg. 59 | - `uuidtrip` uses `Cmdliner` which becomes an optional dependency of 60 | the package. The command line interface is unchanged except for long 61 | options which have to be written with a double dash. Binary output 62 | no longer adds an ending newline. 63 | 64 | 65 | v0.9.5 2012-08-05 Lausanne 66 | -------------------------- 67 | 68 | - OASIS 0.3.0 support. 69 | 70 | 71 | v0.9.4 2012-03-15 La Forclaz (VS) 72 | --------------------------------- 73 | 74 | - OASIS support. 75 | - New functions `Uuidm.v3` and `Uuidm.v5` that generate directly these 76 | kinds of UUIDs. 77 | - New function `Uuidm.v4_gen` returns a function that generates 78 | version 4 UUIDs with a client provided random state. Thanks to Lauri 79 | Alanko for suggesting that `Random.make_self_init` may be too weak 80 | for certain usages. 81 | 82 | 83 | v0.9.3 2008-08-01 Lausanne 84 | -------------------------- 85 | 86 | - POSIX compliant build shell script. 87 | 88 | 89 | v0.9.2 2008-07-30 Lausanne 90 | -------------------------- 91 | 92 | - Support for debian packaging. Thanks to Sylvain Le Gall. 93 | 94 | 95 | v0.9.1 2008-06-18 Lausanne 96 | -------------------------- 97 | 98 | - Minor internal cleanings. 99 | 100 | 101 | v0.9.0 2008-06-11 Lausanne 102 | -------------------------- 103 | 104 | - First release. 105 | -------------------------------------------------------------------------------- /DEVEL.md: -------------------------------------------------------------------------------- 1 | This project uses (perhaps the development version of) [`b0`] for 2 | development. Consult [b0 occasionally] for quick hints on how to 3 | perform common development tasks. 4 | 5 | [`b0`]: https://erratique.ch/software/b0 6 | [b0 occasionally]: https://erratique.ch/software/b0/doc/occasionally.html 7 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2008 The uuidm programmers 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Uuidm — Universally unique identifiers (UUIDs) for OCaml 2 | ======================================================== 3 | 4 | Uuidm is an OCaml library implementing 128 bits universally unique 5 | identifiers version 3, 5 (named based with MD5, SHA-1 hashing), 4 6 | (random based), 7 (time and random based) and 8 (custom) according to 7 | [RFC 9562]. 8 | 9 | Uuidm has no dependency. It is distributed under the ISC license. 10 | 11 | [RFC 9562]: https://www.rfc-editor.org/rfc/rfc9562 12 | 13 | Homepage: 14 | 15 | ## Installation 16 | 17 | Uuidm can be installed with `opam`: 18 | 19 | opam install uuidm 20 | 21 | If you don't use `opam` consult the [`opam`](opam) file for build 22 | instructions. 23 | 24 | ## Documentation 25 | 26 | The documentation can be consulted [online] or via `odig doc uuidm`. 27 | 28 | Questions are welcome but better asked on the [OCaml forum][ocaml-forum] 29 | than on the issue tracker. 30 | 31 | [online]: https://erratique.ch/software/uuidm/doc/ 32 | [ocaml-forum]: https://discuss.ocaml.org/ 33 | 34 | ## Sample programs 35 | 36 | The [`uuidtrip`] tool generates UUIDs and outputs them on stdout. 37 | 38 | See also code in the [`test`] directory. 39 | 40 | [`uuidtrip`]: test/uuidtrip.ml 41 | [`test`]: test/ 42 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | <_b0> : -traverse 3 | : include 4 | : package(cmdliner unix) -------------------------------------------------------------------------------- /doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Uuidm {%html: %%VERSION%%%}} 2 | 3 | {!Uuidm} implements 128 bits universally unique identifiers version 3, 4 | 5 (named based with MD5, SHA-1 hashing), 4 (random based), 7 (time and 5 | random based) and 8 (custom) according according to 6 | {{:https://www.rfc-editor.org/rfc/rfc9562} RFC 9562}. 7 | 8 | See the {{!quick}quick start}. 9 | 10 | {1:uuidm_lib Library [uuidm]} 11 | 12 | {!modules: Uuidm} 13 | 14 | {1:quick Quick start} 15 | 16 | {2:random_based Random V4 UUIDs} 17 | 18 | The following [uuid] function generates V4 random UUIDs. 19 | 20 | {[ 21 | let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) 22 | let () = print_endline (Uuidm.to_string (uuid ())) 23 | let () = print_endline (Uuidm.to_string (uuid ())) 24 | ]} 25 | 26 | Make sure to read the {{!Uuidm.gen}warnings} about random generators. 27 | 28 | {2:name_based Name based V5 UUIDs} 29 | 30 | Name based V5 UUIDs can be used to generate [urn:uuid] URIs for atom 31 | feed {{:https://www.rfc-editor.org/rfc/rfc4287#section-4.2.6}entry 32 | IDs} to minimize the chances of feed replays. 33 | 34 | First generate a random V4 UUID for the feed. For example with 35 | the code of the previous section or with: 36 | {@shell[ 37 | > uuidtrip 38 | 6228c5f9-7069-4519-9bf4-0b6e865f4c42 39 | ]} 40 | 41 | Store this UUID preciously and use it as your feed ID: 42 | 43 | {[ 44 | let feed_id ~feed_id = "urn:uuid:" ^ (Uuid.to_string feed_id) 45 | ]} 46 | 47 | For feed entry IDs, use the feed UUID as a V5 namespace and the immutable 48 | {{:https://www.rfc-editor.org/rfc/rfc4287#section-4.2.9}[atom:published]} 49 | value of the entry as the data to hash: 50 | 51 | {[ 52 | let entry_id ~feed_id ~rfc3339_stamp = 53 | "urn:uuid:" ^ (Uuidm.to_string @@ Uuidm.v5 feed_id rfc3339_stamp) 54 | ]} 55 | 56 | This assumes that 57 | 58 | {ol 59 | {- You do not publish two entries at exactly the same time. 60 | {{:https://www.rfc-editor.org/rfc/rfc3339}RFC 3339} has 61 | enough time granularity to ensure that.} 62 | {- You do not change your publication dates. In atom they must in fact 63 | not change, updates to entries must be specified 64 | in {{:https://www.rfc-editor.org/rfc/rfc4287#section-4.2.15}[atom:updated]}.} 65 | {- If you store publication dates as a raw POSIX timestamp be careful 66 | to render them to RFC 3339 with a fixed time zone. Alternatively 67 | you can directly use the decimal representation of the timestamp 68 | as the data to hash.}} 69 | 70 | {2:time_based Monotonic time based V7 UUIDs} 71 | 72 | In order to generate monotonic time based V7 UUIDs we need to: 73 | 74 | {ul 75 | {- Provide a millisecond precision monotonic POSIX clock. {!Unix.gettimeofday} 76 | can provide a reasonable one but if your monotonicity requirements are 77 | paramount, remember that it can go back in time.} 78 | {- Do something if the clock doesn't move between two UUID 79 | generations. The {!Uuidm.v7_monotonic_gen} generator uses a counter which 80 | allows to generate up to 4096 UUID per millisecond and returns [None] in case 81 | of rollover during the millisecond. In the code below we {!Unix.sleepf} 82 | for a millisecond if we reach the limit.}} 83 | 84 | {[ 85 | let uuid_monotonic = 86 | let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in 87 | Uuidm.v7_monotonic_gen ~now_ms (Random.State.make_self_init ()) 88 | 89 | let rec uuid () = match uuid_monotonic () with 90 | | None -> (* Too many UUIDs generated in a ms *) Unix.sleepf 1e-3; uuid () 91 | | Some uuid -> uuid 92 | 93 | let () = print_endline (Uuidm.to_string (uuid ())) 94 | let () = print_endline (Uuidm.to_string (uuid ())) 95 | ]} 96 | 97 | Depending on your application {!Uuidm.v7_monotonic_gen} may be a bit 98 | too simplistic, you can easily implement all sorts of other 99 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-monotonicity-and-counters} 100 | generation schemes} by using {!Uuidm.v7} or {!Uuidm.v7_ns} directly. Also, make 101 | sure to read the {{!Uuidm.gen}warnings} about generators. 102 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "uuidm" 3 | synopsis: "Universally unique identifiers (UUIDs) for OCaml" 4 | description: """\ 5 | Uuidm is an OCaml library implementing 128 bits universally unique 6 | identifiers version 3, 5 (named based with MD5, SHA-1 hashing), 4 7 | (random based), 7 (time and random based) and 8 (custom) according to 8 | [RFC 9562]. 9 | 10 | Uuidm has no dependency. It is distributed under the ISC license. 11 | 12 | [RFC 9562]: https://www.rfc-editor.org/rfc/rfc9562 13 | 14 | Homepage: """ 15 | maintainer: "Daniel Bünzli " 16 | authors: "The uuidm programmers" 17 | license: "ISC" 18 | tags: ["uuid" "codec" "org:erratique"] 19 | homepage: "https://erratique.ch/software/uuidm" 20 | doc: "https://erratique.ch/software/uuidm/doc/" 21 | bug-reports: "https://github.com/dbuenzli/uuidm/issues" 22 | depends: [ 23 | "ocaml" {>= "4.14.0"} 24 | "ocamlfind" {build} 25 | "ocamlbuild" {build} 26 | "topkg" {build & >= "1.0.3"} 27 | ] 28 | depopts: ["cmdliner"] 29 | conflicts: [ 30 | "cmdliner" {< "1.3.0"} 31 | ] 32 | build: [ 33 | "ocaml" 34 | "pkg/pkg.ml" 35 | "build" 36 | "--dev-pkg" 37 | "%{dev}%" 38 | "--with-cmdliner" 39 | "%{cmdliner:installed}%" 40 | ] 41 | dev-repo: "git+https://erratique.ch/repos/uuidm.git" 42 | x-maintenance-intent: ["(latest)"] 43 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "Universally unique identifiers (UUIDs) for OCaml" 2 | version = "%%VERSION_NUM%%" 3 | requires = "" 4 | archive(byte) = "uuidm.cma" 5 | archive(native) = "uuidm.cmxa" 6 | plugin(byte) = "uuidm.cma" 7 | plugin(native) = "uuidm.cmxs" 8 | exists_if = "uuidm.cma uuidm.cmxa" 9 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind";; 3 | #require "topkg" 4 | open Topkg 5 | 6 | let cmdliner = Conf.with_pkg "cmdliner" 7 | let () = 8 | Pkg.describe "uuidm" @@ fun c -> 9 | let cmdliner = Conf.value c cmdliner in 10 | Ok [ Pkg.mllib "src/uuidm.mllib"; 11 | Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; 12 | Pkg.bin ~cond:cmdliner "test/uuidtrip" ] 13 | -------------------------------------------------------------------------------- /src/uuidm.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2008 The uuidm programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Bits *) 7 | 8 | type bits62 = int64 9 | type bits4 = int 10 | type bits12 = int 11 | 12 | (* Hashing *) 13 | 14 | let md5 = Digest.string 15 | let sha_1 s = 16 | (* Based on pseudo-code of RFC 3174. Slow and ugly but does the job. *) 17 | let sha_1_pad s = 18 | let len = String.length s in 19 | let blen = 8 * len in 20 | let rem = len mod 64 in 21 | let mlen = if rem > 55 then len + 128 - rem else len + 64 - rem in 22 | let m = Bytes.create mlen in 23 | Bytes.blit_string s 0 m 0 len; 24 | Bytes.fill m len (mlen - len) '\x00'; 25 | Bytes.set m len '\x80'; 26 | if Sys.word_size > 32 then begin 27 | Bytes.set_uint8 m (mlen - 8) (blen lsr 56 land 0xFF); 28 | Bytes.set_uint8 m (mlen - 7) (blen lsr 48 land 0xFF); 29 | Bytes.set_uint8 m (mlen - 6) (blen lsr 40 land 0xFF); 30 | Bytes.set_uint8 m (mlen - 5) (blen lsr 32 land 0xFF); 31 | end; 32 | Bytes.set_uint8 m (mlen - 4) (blen lsr 24 land 0xFF); 33 | Bytes.set_uint8 m (mlen - 3) (blen lsr 16 land 0xFF); 34 | Bytes.set_uint8 m (mlen - 2) (blen lsr 8 land 0xFF); 35 | Bytes.set_uint8 m (mlen - 1) (blen land 0xFF); 36 | m 37 | in 38 | (* Operations on int32 *) 39 | let ( &&& ) = ( land ) in 40 | let ( lor ) = Int32.logor in 41 | let ( lxor ) = Int32.logxor in 42 | let ( land ) = Int32.logand in 43 | let ( ++ ) = Int32.add in 44 | let lnot = Int32.lognot in 45 | let sl = Int32.shift_left in 46 | let cls n x = (sl x n) lor (Int32.shift_right_logical x (32 - n)) in 47 | (* Start *) 48 | let m = sha_1_pad s in 49 | let w = Array.make 16 0l in 50 | let h0 = ref 0x67452301l in 51 | let h1 = ref 0xEFCDAB89l in 52 | let h2 = ref 0x98BADCFEl in 53 | let h3 = ref 0x10325476l in 54 | let h4 = ref 0xC3D2E1F0l in 55 | let a = ref 0l in 56 | let b = ref 0l in 57 | let c = ref 0l in 58 | let d = ref 0l in 59 | let e = ref 0l in 60 | for i = 0 to ((Bytes.length m) / 64) - 1 do (* For each block *) 61 | (* Fill w *) 62 | let base = i * 64 in 63 | for j = 0 to 15 do w.(j) <- Bytes.get_int32_be m (base + (j * 4)); done; 64 | (* Loop *) 65 | a := !h0; b := !h1; c := !h2; d := !h3; e := !h4; 66 | for t = 0 to 79 do 67 | let f, k = 68 | if t <= 19 then (!b land !c) lor ((lnot !b) land !d), 0x5A827999l else 69 | if t <= 39 then !b lxor !c lxor !d, 0x6ED9EBA1l else 70 | if t <= 59 then 71 | (!b land !c) lor (!b land !d) lor (!c land !d), 0x8F1BBCDCl 72 | else 73 | !b lxor !c lxor !d, 0xCA62C1D6l 74 | in 75 | let s = t &&& 0xF in 76 | if (t >= 16) then begin 77 | w.(s) <- cls 1 begin 78 | w.((s + 13) &&& 0xF) lxor 79 | w.((s + 8) &&& 0xF) lxor 80 | w.((s + 2) &&& 0xF) lxor 81 | w.(s) 82 | end 83 | end; 84 | let temp = (cls 5 !a) ++ f ++ !e ++ w.(s) ++ k in 85 | e := !d; 86 | d := !c; 87 | c := cls 30 !b; 88 | b := !a; 89 | a := temp; 90 | done; 91 | (* Update *) 92 | h0 := !h0 ++ !a; 93 | h1 := !h1 ++ !b; 94 | h2 := !h2 ++ !c; 95 | h3 := !h3 ++ !d; 96 | h4 := !h4 ++ !e 97 | done; 98 | let h = Bytes.create 20 in 99 | let i2s h k i = Bytes.set_int32_be h k i in 100 | i2s h 0 !h0; 101 | i2s h 4 !h1; 102 | i2s h 8 !h2; 103 | i2s h 12 !h3; 104 | i2s h 16 !h4; 105 | Bytes.unsafe_to_string h 106 | 107 | (* Uuids *) 108 | 109 | type t = string (* 16 bytes *) 110 | 111 | let make u ~version = 112 | let b6 = (version lsl 4) lor ((Bytes.get_uint8 u 6) land 0b0000_1111) in 113 | let b8 = 0b1000_0000 lor ((Bytes.get_uint8 u 8) land 0b0011_1111) in 114 | Bytes.set_uint8 u 6 b6; 115 | Bytes.set_uint8 u 8 b8; 116 | Bytes.unsafe_to_string u 117 | 118 | let make_named ~version digest ns n = 119 | let hash = Bytes.unsafe_of_string (digest (ns ^ n)) in 120 | make (Bytes.sub hash 0 16) ~version 121 | 122 | let v3 ns n = make_named ~version:3 md5 ns n 123 | let v5 ns n = make_named ~version:5 sha_1 ns n 124 | let v4 b = make (Bytes.sub b 0 16) ~version:4 125 | let v7 ~time_ms ~rand_a ~rand_b = 126 | let u = Bytes.create 16 in 127 | Bytes.set_int64_be u 0 (Int64.shift_left time_ms 16); 128 | Bytes.set_int16_be u 6 rand_a; 129 | Bytes.set_int64_be u 8 rand_b; 130 | make u ~version:7 131 | 132 | let v7_ns ~time_ns ~rand_b = 133 | let ns_in_ms = 1_000_000L in 134 | let sub_ms_frac_multiplier = Int64.unsigned_div Int64.minus_one ns_in_ms in 135 | let u = Bytes.create 16 in 136 | (* RFC 9562 requires we use 48 bits for a timestamp in milliseconds, and 137 | allows for 12 bits to store a sub-millisecond fraction. We get the 138 | latter by multiplying to put the fraction in a 64-bit range, then 139 | shifting into 12 bits. *) 140 | let ms = Int64.unsigned_div time_ns ns_in_ms in 141 | let ns = Int64.unsigned_rem time_ns ns_in_ms in 142 | let sub_ms_frac = 143 | Int64.shift_right_logical (Int64.mul ns sub_ms_frac_multiplier) 52 144 | in 145 | Bytes.set_int64_be u 0 (Int64.shift_left ms 16); 146 | Bytes.set_int16_be u 6 (Int64.to_int sub_ms_frac); 147 | Bytes.set_int64_be u 8 rand_b; 148 | make u ~version:7 149 | 150 | let v8 s = 151 | let l = String.length s in 152 | if l = 16 then make (Bytes.of_string s) ~version:8 else 153 | invalid_arg (Printf.sprintf "expected 16 bytes but found: %d" l) 154 | 155 | (* Generators *) 156 | 157 | type posix_ms_clock = unit -> int64 158 | 159 | let v4_random rstate = 160 | let r0 = Random.State.bits64 rstate in 161 | let r1 = Random.State.bits64 rstate in 162 | let u = Bytes.create 16 in 163 | Bytes.set_int64_be u 0 r0; 164 | Bytes.set_int64_be u 8 r1; 165 | make u ~version:4 166 | 167 | let v4_gen rstate = function () -> v4_random rstate 168 | 169 | let v7_non_monotonic_gen ~now_ms rstate = 170 | fun () -> 171 | let time_ms = now_ms () in 172 | let rand_a = Random.State.bits (* 30 bits *) rstate in 173 | let rand_b = Random.State.bits64 rstate in 174 | v7 ~time_ms ~rand_a ~rand_b 175 | 176 | let v7_monotonic_gen ~now_ms rstate = 177 | let last_ms = ref 0L in 178 | let count = ref 0 in 179 | fun () -> 180 | let time_ms = now_ms () in 181 | let rand_b = Random.State.bits64 rstate in 182 | if Int64.equal time_ms !last_ms then 183 | let rand_a = incr count; !count in 184 | if rand_a >= 4096 then None else Some (v7 ~time_ms ~rand_a ~rand_b) 185 | else 186 | (count := 0; last_ms := time_ms; Some (v7 ~time_ms ~rand_a:0 ~rand_b)) 187 | 188 | (* Constants *) 189 | 190 | let nil = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" 191 | let max = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff" 192 | let ns_dns = "\x6b\xa7\xb8\x10\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8" 193 | let ns_url = "\x6b\xa7\xb8\x11\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8" 194 | let ns_oid = "\x6b\xa7\xb8\x12\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8" 195 | let ns_X500 ="\x6b\xa7\xb8\x14\x9d\xad\x11\xd1\x80\xb4\x00\xc0\x4f\xd4\x30\xc8" 196 | 197 | (* Properties *) 198 | 199 | let variant u = (String.get_uint8 u 8) lsr 4 200 | let version u = (String.get_uint8 u 6) lsr 4 201 | let time_ms u = 202 | let variant = variant u in 203 | if not (0x8 <= variant && variant <= 0xB && version u = 7) then None else 204 | Some (Int64.shift_right_logical (String.get_int64_be u 0) 16) 205 | 206 | (* Predicates and comparisons *) 207 | 208 | let equal = String.equal 209 | let compare = String.compare 210 | 211 | (* Standard binary format *) 212 | 213 | let to_binary_string s = s 214 | let of_binary_string ?(pos = 0) s = 215 | let len = String.length s in 216 | if pos + 16 > len then None else 217 | if pos = 0 && len = 16 then Some s else 218 | Some (String.sub s pos 16) 219 | 220 | (* Mixed endian binary format *) 221 | 222 | let mixed_swaps s = 223 | let swap b i j = 224 | let t = Bytes.get b i in 225 | Bytes.set b i (Bytes.get b j); 226 | Bytes.set b j t 227 | in 228 | let b = Bytes.of_string s in 229 | swap b 0 3; swap b 1 2; 230 | swap b 4 5; swap b 6 7; 231 | Bytes.unsafe_to_string b 232 | 233 | let to_mixed_endian_binary_string s = mixed_swaps s 234 | let of_mixed_endian_binary_string ?pos s = 235 | Option.map mixed_swaps (of_binary_string ?pos s) 236 | 237 | (* Unsafe conversions *) 238 | 239 | let unsafe_of_binary_string u = u 240 | let unsafe_to_binary_string u = u 241 | 242 | (* US-ASCII format *) 243 | 244 | let of_string ?(pos = 0) s = 245 | let len = String.length s in 246 | if 247 | pos + 36 > len || s.[pos + 8] <> '-' || s.[pos + 13] <> '-' || 248 | s.[pos + 18] <> '-' || s.[pos + 23] <> '-' 249 | then 250 | None 251 | else try 252 | let u = Bytes.create 16 in 253 | let i = ref 0 in 254 | let j = ref pos in 255 | let ihex c = 256 | let i = Char.code c in 257 | if i < 0x30 then raise Exit else 258 | if i <= 0x39 then i - 0x30 else 259 | if i < 0x41 then raise Exit else 260 | if i <= 0x46 then i - 0x37 else 261 | if i < 0x61 then raise Exit else 262 | if i <= 0x66 then i - 0x57 else 263 | raise Exit 264 | in 265 | let byte s j = Char.unsafe_chr (ihex s.[j] lsl 4 lor ihex s.[j + 1]) in 266 | while (!i < 4) do Bytes.set u !i (byte s !j); j := !j + 2; incr i done; 267 | incr j; 268 | while (!i < 6) do Bytes.set u !i (byte s !j); j := !j + 2; incr i done; 269 | incr j; 270 | while (!i < 8) do Bytes.set u !i (byte s !j); j := !j + 2; incr i done; 271 | incr j; 272 | while (!i < 10) do Bytes.set u !i (byte s !j); j := !j + 2; incr i done; 273 | incr j; 274 | while (!i < 16) do Bytes.set u !i (byte s !j); j := !j + 2; incr i done; 275 | Some (Bytes.unsafe_to_string u) 276 | with Exit -> None 277 | 278 | let to_string ?(upper = false) u = 279 | let hbase = if upper then 0x37 else 0x57 in 280 | let hex hbase i = Char.unsafe_chr (if i < 10 then 0x30 + i else hbase + i) in 281 | let s = Bytes.of_string "XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX" in 282 | let i = ref 0 in 283 | let j = ref 0 in 284 | let byte s i c = 285 | Bytes.set s i @@ hex hbase (c lsr 4); 286 | Bytes.set s (i + 1) @@ hex hbase (c land 0x0F) 287 | in 288 | while (!j < 4) do byte s !i (Char.code u.[!j]); i := !i + 2; incr j; done; 289 | incr i; 290 | while (!j < 6) do byte s !i (Char.code u.[!j]); i := !i + 2; incr j; done; 291 | incr i; 292 | while (!j < 8) do byte s !i (Char.code u.[!j]); i := !i + 2; incr j; done; 293 | incr i; 294 | while (!j < 10) do byte s !i (Char.code u.[!j]); i := !i + 2; incr j; done; 295 | incr i; 296 | while (!j < 16) do byte s !i (Char.code u.[!j]); i := !i + 2; incr j; done; 297 | Bytes.unsafe_to_string s 298 | 299 | (* Pretty-printing *) 300 | 301 | let pp ppf u = Format.pp_print_string ppf (to_string u) 302 | let pp' ~upper ppf u = Format.pp_print_string ppf (to_string ~upper u) 303 | 304 | (* Deprecated *) 305 | 306 | let default_seed = lazy (Random.State.make_self_init ()) 307 | 308 | type version = [ `V3 of t * string | `V4 | `V5 of t * string ] 309 | let v = function 310 | | `V4 -> v4_random (Lazy.force default_seed) 311 | | `V3 (ns, n) -> v3 ns n 312 | | `V5 (ns, n) -> v5 ns n 313 | 314 | let create = v (* deprecated *) 315 | let pp_string ?upper ppf u = Format.pp_print_string ppf (to_string ?upper u) 316 | let print = pp_string (* deprecated *) 317 | let to_bytes = to_binary_string 318 | let of_bytes = of_binary_string 319 | let to_mixed_endian_bytes = to_mixed_endian_binary_string 320 | let of_mixed_endian_bytes = of_mixed_endian_binary_string 321 | let unsafe_of_bytes = unsafe_of_binary_string 322 | let unsafe_to_bytes = unsafe_to_binary_string 323 | -------------------------------------------------------------------------------- /src/uuidm.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2008 The uuidm programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Universally unique identifiers (UUIDs). 7 | 8 | [Uuidm] implements 128 bits universally unique identifiers version 9 | 3, 5 (name based with MD5, SHA-1 hashing), 4 (random based), 7 10 | (random and timestamp based) and 8 (custom) according to 11 | {{:https://www.rfc-editor.org/rfc/rfc9562}RFC 9562}. 12 | 13 | See the {{!page-index.quick}quick start}. *) 14 | 15 | (** {1:bits Bits} *) 16 | 17 | type bits4 = int 18 | (** The type for 4 bits stored in the 4 lower bits of an [int] value. 19 | The higher bits are either set to zero or ignored on use. *) 20 | 21 | type bits12 = int 22 | (** The type for 12 bits stored in the 12 lower bits of an [int] value. 23 | The higher bits are either set to zero or ignored on use. *) 24 | 25 | type bits62 = int64 26 | (** The type for 62 bits stored in the 62 lower bits of an [int64] value. 27 | The higher bits are either set to zero or ignored on use. *) 28 | 29 | (** {1:uuids UUIDs} *) 30 | 31 | type t 32 | (** The type for UUIDs. *) 33 | 34 | val v3 : t -> string -> t 35 | (** [v3 ns n] is a 36 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-3}V3 UUID} 37 | (name based with MD5 hashing) named by [n] and namespaced by [ns]. *) 38 | 39 | val v4 : bytes -> t 40 | (** [v4 b] is a {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-4} 41 | V4 UUID} (random based) that uses the first 16 bytes of 42 | [b] for randomness. See also {!v4_gen}. 43 | 44 | {b Warning.} The randomness is seen literally in the result. *) 45 | 46 | val v5 : t -> string -> t 47 | (** [v5 ns n] is a 48 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-5}V5 UUID} 49 | (name based with SHA-1 hashing) named by [n] and 50 | namespaced by [ns]. See {{!page-index.name_based}this example}. *) 51 | 52 | val v7 : time_ms:int64 -> rand_a:bits12 -> rand_b:bits62 -> t 53 | (** [v7 ~time_ms ~rand_a ~rand_b] is a 54 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-7}V7 UUID} 55 | (time and random based) using the 64-bit millisecond POSIX timestamp 56 | [time_ms] and random bits [rand_a] and [rand_b]. See also {!v7_ns}, 57 | {!v7_non_monotonic_gen} and {!v7_monotonic_gen}. 58 | 59 | {b Warning.} The timestamp and the randomness are seen literally 60 | in the result. *) 61 | 62 | val v7_ns : time_ns:int64 -> rand_b:bits62 -> t 63 | (** [v7_ns ~time_ns ~rand_b] is a 64 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-7}V7 65 | UUID} (time and random based) using the {e unsigned} 64-bit 66 | nanosecond POSIX timestamp [time_ns] and random bits [rand_b]. The 67 | [rand_a] field is used with the timestamp's submillisecond precision 68 | with about 244 nanoseconds resolution. See also {!v7}. 69 | 70 | {b Warning.} The timestamp and the randomness are seen literally in 71 | the result. *) 72 | 73 | val v8 : string -> t 74 | (** [v8 s] is a {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-8} 75 | V8 UUID} (custom) that uses the 16 bytes of [s] but overwrites the 76 | {!version} and {!variant} bits to make it a propert V8 UUID. Raises 77 | [Invalid_argument] if the length of [s] is not [16]. *) 78 | 79 | (** {1:gen Generators} 80 | 81 | {b Warning.} If you use the generators take into account the following 82 | points: 83 | 84 | {ul 85 | {- Sequences of UUIDs are generated with {!Random}. This is 86 | suitably random but {e predictable} by an observer. Use the 87 | base constuctors with random bytes generated by a 88 | cryptographically secure pseudorandom number generator (CSPRNG) if that 89 | is an issue.} 90 | {- Sequences of UUIDs generated from a given {!Random.State.t} 91 | value are not guaranteed to be stable across OCaml or Uuidm versions. 92 | Use the base constructors with your own 93 | pseudorandom number generator if that is an issue.} 94 | {- Sequences of UUIDs generated using a {!posix_ms_clock} assume 95 | the clock is monotonic in order to generate monotonic UUIDs. 96 | If you derive it from {!Unix.gettimeofday} this may not be the case.}} *) 97 | 98 | type posix_ms_clock = unit -> int64 99 | (** The type for millisecond precision POSIX time clocks. *) 100 | 101 | val v4_gen : Random.State.t -> (unit -> t) 102 | (** [v4_gen state] is a function generating {!v4} UUIDs using 103 | random [state]. See {{!page-index.random_based}this example}. *) 104 | 105 | val v7_non_monotonic_gen : 106 | now_ms:posix_ms_clock -> Random.State.t -> (unit -> t) 107 | (** [v7_non_monotonic_gen ~now_ms state] is a function generating 108 | {!v7} UUIDs using [now_ms] for the timestamp [time_ms] and random [state] 109 | for [rand_a] and [rand_b]. UUIDs generated in the same millisecond 110 | may not be be monotonic. Use {!v7_monotonic_gen} for that. *) 111 | 112 | val v7_monotonic_gen : 113 | now_ms:posix_ms_clock -> Random.State.t -> (unit -> t option) 114 | (** [v7_monotonic_gen ~posix_now_ms state] is a function that 115 | generates monotonic {!v7} UUIDs using [now_ms] for the timestamp 116 | [time_ms], [rand_a] as a counter if the clock did not move between 117 | two UUID generations and [random] state for [rand_b]. This allows 118 | to generate up to 4096 monotonic UUIDs per millisecond. [None] is 119 | returned if the counter rolls over before the millisecond 120 | increments. See {{!page-index.time_based}this example}.*) 121 | 122 | (** {1:constants Constants} *) 123 | 124 | val nil : t 125 | (** [nil] is the 126 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-nil-uuid}nil} UUID. *) 127 | 128 | val max : t 129 | (** [max] is the {{:https://www.rfc-editor.org/rfc/rfc9562#name-max-uuid}max} 130 | UUID. *) 131 | 132 | val ns_dns : t 133 | (** [ns_dns] is the DNS namespace UUID. *) 134 | 135 | val ns_url : t 136 | (** [ns_url] is the URL namespace UUID. *) 137 | 138 | val ns_oid : t 139 | (** [ns_oid] is the ISO OID namespace UUID. *) 140 | 141 | val ns_X500 : t 142 | (** [ns_dn] is the X.500 DN namespace UUID. *) 143 | 144 | (** {1:properties Properties} *) 145 | 146 | val variant : t -> bits4 147 | (** [variant u] is the 148 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-variant-field}variant field} 149 | of [u], including the "don't-care" values. *) 150 | 151 | val version : t -> bits4 152 | (** [version u] is the 153 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-version-field}version field} 154 | of [u]. *) 155 | 156 | val time_ms : t -> int64 option 157 | (** [time_ms u] is the 158 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-7} 159 | [unit_ts_ms]} millisecond POSIX timestamp of [u] as a 64-bit 160 | integer. This is [None] if [u] is not a V7 UUID. *) 161 | 162 | (** {1:preds Predicates and comparisons} *) 163 | 164 | val equal : t -> t -> bool 165 | (** [equal u u'] is [true] iff [u] and [u'] are equal. *) 166 | 167 | val compare : t -> t -> int 168 | (** [compare] is the binary order on UUIDs. *) 169 | 170 | (** {1:fmt_binary Standard binary format} 171 | 172 | This is the binary format mandated by 173 | {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-format}RFC 9562}. *) 174 | 175 | val of_binary_string : ?pos:int -> string -> t option 176 | (** [of_binary_string pos s] is the UUID represented by the 16 bytes starting 177 | at [pos] (defaults to [0]) in [s]. No particular checks are 178 | performed on the bytes. The result is [None] if the string is not 179 | long enough. *) 180 | 181 | val to_binary_string : t -> string 182 | (** [to_binary_string u] is [u] as a 16 bytes long string. *) 183 | 184 | (** {1:fmt_binary_mixed Mixed-endian binary format} 185 | 186 | This is the binary format in which the three first fields of UUIDs 187 | (which are oblivious to this module) are read and written in 188 | little-endian. This corresponds to how UEFI or Microsoft formats 189 | UUIDs. *) 190 | 191 | val of_mixed_endian_binary_string : ?pos:int -> string -> t option 192 | (** [of_mixed_endian_binary_string] is like {!of_bytes} but decodes 193 | the mixed endian serialization. *) 194 | 195 | val to_mixed_endian_binary_string : t -> string 196 | (** [to_mixed_endian_binary_string] is like {!to_bytes} but encodes 197 | the mixed endian serialization. *) 198 | 199 | (**/**) 200 | val unsafe_of_binary_string : string -> t 201 | val unsafe_to_binary_string : t -> string 202 | (**/**) 203 | 204 | (** {1:fmt_ascii US-ASCII format} *) 205 | 206 | val of_string : ?pos:int -> string -> t option 207 | (** [of_string pos s] converts the substring of [s] starting at [pos] 208 | (defaults to [0]) of the form ["XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX"] 209 | where X is a lower or upper case hexadecimal number to an 210 | UUID. The result is [None] if a parse error occurs. Any extra 211 | characters after are ignored. *) 212 | 213 | val to_string : ?upper:bool -> t -> string 214 | (** [to_string u] is [u] as a string of the form 215 | ["XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX"] where X is a lower 216 | (or upper if [upper] is [true]) case hexadecimal number. *) 217 | 218 | val pp : Format.formatter -> t -> unit 219 | (** [pp ppf u] formats [u] with {!to_string} on [ppf]. *) 220 | 221 | val pp' : upper:bool -> Format.formatter -> t -> unit 222 | (** [pp' ~upper ppf u] formats [u] with {!to_string}[ ~upper] on [ppf]. *) 223 | 224 | (** {1:deprecated Deprecated} *) 225 | 226 | type[@ocaml.deprecated "Use the version specific Uuidm.v* functions."] version = 227 | [ `V3 of t * string (** Name based with MD5 hashing *) 228 | | `V4 (** Random based *) 229 | | `V5 of t * string (** Name based with SHA-1 hasing *) ] 230 | (** The type for UUID versions and generation parameters. 231 | {ul 232 | {- [`V3] and [`V5] specify a namespace and a name for the generation.} 233 | {- [`V4] is random based with a private state seeded with 234 | {!Stdlib.Random.State.make_self_init}. Use {!v4_gen} to specify 235 | your own seed. Use {!v4} to specify your own randomness. 236 | 237 | {b Warning.} The sequence resulting from repeatedly calling 238 | [v `V4] is random but predictable see {!v4_gen}.}} *) 239 | 240 | [@@@alert "-deprecated"] 241 | 242 | val v : version -> t 243 | [@@ocaml.deprecated "Use the version specific Uuidm.v* functions."] 244 | 245 | val pp_string : ?upper:bool -> Format.formatter -> t -> unit 246 | [@@ocaml.deprecated "Use Uuidm.pp' instead"] 247 | 248 | val of_bytes : ?pos:int -> string -> t option 249 | [@@ocaml.deprecated "Use Uuidm.of_binary_string instead"] 250 | 251 | val to_bytes : t -> string 252 | [@@ocaml.deprecated "Use Uuidm.to_binary_string instead"] 253 | 254 | val of_mixed_endian_bytes : ?pos:int -> string -> t option 255 | [@@ocaml.deprecated "Use Uuidm.of_mixed_endian_binary_string instead"] 256 | 257 | val to_mixed_endian_bytes : t -> string 258 | [@@ocaml.deprecated "Use Uuidm.to_mixed_endian_binary_string instead"] 259 | 260 | (**/**) 261 | val print : ?upper:bool -> Format.formatter -> t -> unit (* deprecated *) 262 | [@@ocaml.deprecated "Use Uuidm.pp_string instead"] 263 | 264 | val create : version -> t (* deprecated *) 265 | [@@ocaml.deprecated "Use Uuidm.v instead"] 266 | 267 | val unsafe_of_bytes : string -> t 268 | [@@ocaml.deprecated "Use Uuidm.unsafe_of_binary_string instead"] 269 | 270 | val unsafe_to_bytes : t -> string 271 | [@@ocaml.deprecated "Use Uuidm.unsafe_to_binary_string instead"] 272 | (**/**) 273 | -------------------------------------------------------------------------------- /src/uuidm.mllib: -------------------------------------------------------------------------------- 1 | Uuidm -------------------------------------------------------------------------------- /test/examples.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2024 The uuidm programmers. All rights reserved. 3 | SPDX-License-Identifier: CC0-1.0 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Code from the quick start *) 7 | 8 | let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) 9 | let () = print_endline (Uuidm.to_string (uuid ())) 10 | let () = print_endline (Uuidm.to_string (uuid ())) 11 | 12 | let feed_id ~feed_id = "urn:uuid:" ^ (Uuidm.to_string feed_id) 13 | let entry_id ~feed_id ~rfc3339_stamp = 14 | "urn:uuid:" ^ (Uuidm.to_string @@ Uuidm.v5 feed_id rfc3339_stamp) 15 | 16 | let uuid_monotonic = 17 | let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in 18 | Uuidm.v7_monotonic_gen ~now_ms (Random.State.make_self_init ()) 19 | 20 | let rec uuid () = match uuid_monotonic () with 21 | | None -> (* Too many UUIDs generated in a ms *) Unix.sleepf 1e-3; uuid () 22 | | Some uuid -> uuid 23 | 24 | let () = print_endline (Uuidm.to_string (uuid ())) 25 | let () = print_endline (Uuidm.to_string (uuid ())) 26 | -------------------------------------------------------------------------------- /test/perf.ml: -------------------------------------------------------------------------------- 1 | (* This code is in the public domain *) 2 | 3 | let str = Printf.sprintf 4 | let exec = Filename.basename Sys.executable_name 5 | 6 | let main () = 7 | let usage = 8 | str "Usage: %s [OPTION]...\n\ 9 | \ UUID performance tests.\n\ 10 | Options:" exec 11 | in 12 | let n = ref 10_000_000 in 13 | let v = ref `V4 in 14 | let cstr = ref false in 15 | let options = [ 16 | "-n", Arg.Set_int n, 17 | " Number of ids to generate"; 18 | "-str", Arg.Set cstr, 19 | " Also convert UUIDs to strings"; 20 | "-r", Arg.Unit (fun () -> v := `V4), 21 | " Random based UUID version 4 (default)"; 22 | "-md5", Arg.Unit (fun () -> v := `V3 (Uuidm.ns_dns,"www.example.org")), 23 | " MD5 name based UUID version 3"; 24 | "-sha1", Arg.Unit (fun () -> v := `V5 (Uuidm.ns_dns,"www.example.org")), 25 | " SHA-1 name based UUID version 5"; ] 26 | in 27 | Arg.parse (Arg.align options) (fun _ -> ()) usage; 28 | let uuid = match !v with 29 | | `V4 -> Uuidm.v4_gen (Random.State.make_self_init ()) 30 | | `V3 (ns, n) -> fun () -> Uuidm.v3 ns n 31 | | `V5 (ns, n) -> fun () -> Uuidm.v5 ns n 32 | in 33 | let f = match !cstr with 34 | | true -> fun version -> ignore (Uuidm.to_string (uuid ())) 35 | | false -> fun version -> ignore (uuid ()) 36 | in 37 | for i = 1 to !n do f v done 38 | 39 | let () = main () 40 | -------------------------------------------------------------------------------- /test/test_uuidm.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2024 The uuidm programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_testing 7 | 8 | let test_uuid ?__POS__:pos version ?time_ms u us = 9 | Test.block ?__POS__:pos @@ fun () -> 10 | let us = Test.noraise ~__POS__ @@ fun () -> Option.get (Uuidm.of_string us) in 11 | let trip = 12 | Test.noraise ~__POS__ @@ fun () -> 13 | Option.get (Uuidm.of_string (Uuidm.to_string u)) 14 | in 15 | let variant = Uuidm.variant u in 16 | Test.eq (module Uuidm) u trip ~__POS__; 17 | Test.eq (module Uuidm) u us ~__POS__ ; 18 | if Uuidm.equal u Uuidm.nil then Test.int variant 0x0 ~__POS__ else 19 | if Uuidm.equal u Uuidm.max then Test.int variant 0xF ~__POS__ else 20 | Test.holds (8 <= variant && variant <= 0xB) ~__POS__; 21 | Test.int (Uuidm.version u) version ~__POS__; 22 | Test.(option T.int64) (Uuidm.time_ms u) time_ms ~__POS__; 23 | () 24 | 25 | let test_constructors = 26 | Test.test "Uuid.v* constructors" @@ fun () -> 27 | test_uuid ~__POS__ 3 28 | (Uuidm.v3 Uuidm.ns_dns "www.widgets.com") 29 | "3D813CBB-47FB-32BA-91DF-831E1593AC29"; 30 | test_uuid ~__POS__ 3 31 | (Uuidm.v3 Uuidm.ns_dns "www.example.org") 32 | "0012416f-9eec-3ed4-a8b0-3bceecde1cd9"; 33 | test_uuid ~__POS__ 3 34 | (Uuidm.v3 Uuidm.ns_dns "www.example.com") 35 | "5df41881-3aed-3515-88a7-2f4a814cf09e"; 36 | test_uuid ~__POS__ 4 37 | (Uuidm.v4 38 | (Bytes.of_string 39 | "\x91\x91\x08\xF7\x52\xD1\x33\x20\x5B\xAC\xF8\x47\xDB\x41\x48\xA8")) 40 | "919108f7-52d1-4320-9bac-f847db4148a8"; 41 | test_uuid ~__POS__ 5 42 | (Uuidm.v5 Uuidm.ns_dns "www.widgets.com") 43 | "21F7F8DE-8051-5B89-8680-0195EF798B6A"; 44 | test_uuid ~__POS__ 5 45 | (Uuidm.v5 Uuidm.ns_dns "www.example.org") 46 | "74738ff5-5367-5958-9aee-98fffdcd1876"; 47 | test_uuid ~__POS__ 5 48 | (Uuidm.v5 Uuidm.ns_dns "www.example.com") 49 | "2ed6657d-e927-568b-95e1-2665a8aea6a2"; 50 | test_uuid ~__POS__ 7 ~time_ms:0x1020_3040_5060L 51 | (Uuidm.v7_ns ~time_ns:Int64.(add (mul 1_000_000L 0x1020_3040_5060L) 213135L) 52 | ~rand_b:0x123456789abcdef0L) 53 | "10203040-5060-7369-9234-56789abcdef0"; 54 | test_uuid ~__POS__ 7 ~time_ms:0x017F22E279B0L 55 | (Uuidm.v7 56 | ~time_ms:0x017F22E279B0L ~rand_a:0xCC3 ~rand_b:0x18C4DC0C0C07398FL) 57 | "017F22E2-79B0-7CC3-98C4-DC0C0C07398F"; 58 | test_uuid ~__POS__ 8 59 | (Uuidm.v8 60 | "\x24\x89\xE9\xAD\x2E\xE2\x0E\x00\x0E\xC9\x32\xD5\xF6\x91\x81\xC0") 61 | "2489E9AD-2EE2-8E00-8EC9-32D5F69181C0"; 62 | Test.invalid_arg ~__POS__ @@ fun () -> ignore (Uuidm.v8 ""); 63 | () 64 | 65 | let test_constants = 66 | Test.test "Uuidm UUID constants" @@ fun () -> 67 | test_uuid ~__POS__ 0 Uuidm.nil "00000000-0000-0000-0000-000000000000"; 68 | test_uuid ~__POS__ 0xF Uuidm.max "ffffffff-ffff-ffff-ffff-ffffffffffff"; 69 | test_uuid ~__POS__ 1 Uuidm.ns_dns "6ba7b810-9dad-11d1-80b4-00c04fd430c8"; 70 | test_uuid ~__POS__ 1 Uuidm.ns_url "6ba7b811-9dad-11d1-80b4-00c04fd430c8"; 71 | test_uuid ~__POS__ 1 Uuidm.ns_oid "6ba7b812-9dad-11d1-80b4-00c04fd430c8"; 72 | test_uuid ~__POS__ 1 Uuidm.ns_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8"; 73 | () 74 | 75 | let test_mixed_endian = 76 | Test.test "Uuidm.{of,to}_mixed_endian_binary_string" @@ fun () -> 77 | test_uuid ~__POS__ 13 78 | (Uuidm.unsafe_of_binary_string 79 | (Uuidm.to_mixed_endian_binary_string Uuidm.ns_X500)) 80 | "14B8a76b-ad9d-d111-80b4-00c04fd430c8"; 81 | test_uuid ~__POS__ 13 82 | (Test.noraise ~__POS__ @@ fun () -> 83 | Option.get @@ 84 | Uuidm.of_mixed_endian_binary_string 85 | (Uuidm.to_binary_string Uuidm.ns_X500)) 86 | "14B8a76b-ad9d-d111-80b4-00c04fd430c8"; 87 | () 88 | 89 | let main () = Test.main @@ fun () -> Test.autorun () 90 | let () = if !Sys.interactive then () else exit (main ()) 91 | -------------------------------------------------------------------------------- /test/uuidtrip.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2008 The uuidm programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let strf = Printf.sprintf 7 | 8 | let gen ~version ~ns ~name ~upper ~binary = 9 | let u = match version with 10 | | `V3 -> Uuidm.v3 ns name 11 | | `V4 -> Uuidm.v4_gen (Random.State.make_self_init ()) () 12 | | `V5 -> Uuidm.v5 ns name 13 | | `V7 -> 14 | let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in 15 | Uuidm.v7_non_monotonic_gen ~now_ms (Random.State.make_self_init ()) () 16 | in 17 | let s = match binary with 18 | | true -> Uuidm.to_binary_string u 19 | | false -> strf "%s\n" (Uuidm.to_string ~upper u) 20 | in 21 | let () = Out_channel.set_binary_mode stdout binary in 22 | print_string s; flush stdout 23 | 24 | (* Command line interface *) 25 | 26 | open Cmdliner 27 | open Cmdliner.Term.Syntax 28 | 29 | let version = 30 | let v3 = 31 | let doc = 32 | "Generate a MD5 name based UUID version 3, see option $(b,--name)." in 33 | `V3, Arg.info ["v3"; "md5"] ~doc 34 | in 35 | let v4 = 36 | let doc = "Generate a random based UUID version 4 (default)." in 37 | `V4, Arg.info ["v4"; "r"; "random"] ~doc 38 | in 39 | let v5 = 40 | let doc = 41 | "Generate a SHA-1 name based UUID version 5, see option $(b,--name)." 42 | in 43 | `V5, Arg.info ["v5"; "sha1"] ~doc 44 | in 45 | let v7 = 46 | let doc = "Generate a time and random based UUID version 7." in 47 | `V7, Arg.info ["v7"] ~doc 48 | in 49 | Arg.(value & vflag `V4 [v3; v4; v5; v7]) 50 | 51 | let ns = 52 | let ns_arg = 53 | let parse s = match Uuidm.of_string s with 54 | | None -> Error (strf "%S: could not parse namespace UUID" s) 55 | | Some ns -> Ok ns 56 | in 57 | Arg.conv' ~docv:"UUID" (parse, Uuidm.pp) 58 | in 59 | let doc = "Namespace UUID for name based UUIDs (version 4 or 5). 60 | Defaults to the DNS namespace UUID." 61 | in 62 | Arg.(value & opt ns_arg Uuidm.ns_dns & info ["ns"; "namespace"] ~doc) 63 | 64 | let name = 65 | let doc = "Name for name based UUIDs (version 4 or 5)." in 66 | Arg.(value & opt string "www.example.org" & info ["name"] ~doc) 67 | 68 | let upper = 69 | let doc = "Output hexadecimal letters in uppercase" in 70 | Arg.(value & flag & info ["u"; "uppercase"] ~doc) 71 | 72 | let binary = 73 | let doc = "Output the UUID as its 16 bytes binary representation." in 74 | Arg.(value & flag & info ["b"; "binary"] ~doc) 75 | 76 | let cmd = 77 | let doc = "Generates universally unique identifiers (UUIDs)" in 78 | let man = [ 79 | `S "DESCRIPTION"; 80 | `P "$(tname) generates 128 bits universally unique identifiers version 81 | 3, 5 (name based with MD5, SHA-1 hashing), 4 (random based) and 82 | 7 (time and random based) according to RFC 9562."; 83 | `P "Invoked without any option, a random based version 4 UUID is \ 84 | generated and written on stdout."; 85 | `S "SEE ALSO"; 86 | `P "P. Leach et al. Universally Unique IDentifiers (UUIDs), 87 | 2024. $(i,https://www.rfc-editor.org/rfc/rfc9562)"; 88 | `S "BUGS"; 89 | `P "This program is distributed with the Uuidm OCaml library. \ 90 | See $(i,https://erratique.ch/software/uuidm) for contact \ 91 | information."; ] 92 | in 93 | Cmd.v (Cmd.info "uuidtrip" ~version:"%%VERSION%%" ~doc ~man) @@ 94 | let+ version and+ ns and+ name and+ upper and+ binary in 95 | gen ~version ~ns ~name ~upper ~binary 96 | 97 | let main () = Cmd.eval cmd 98 | 99 | let () = if !Sys.interactive then () else exit (main ()) 100 | --------------------------------------------------------------------------------