1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
module T = struct
include Bin_prot.Md5
let sexp_of_t t = t |> to_hex |> String.sexp_of_t
let t_of_sexp s = s |> String.t_of_sexp |> of_hex_exn
let t_sexp_grammar = Sexplib.Sexp_grammar.coerce String.t_sexp_grammar
end
let hash_fold_t accum t = String.hash_fold_t accum (T.to_binary t)
let hash t = String.hash (T.to_binary t)
module As_binary_string = struct
module Stable = struct
module V1 = struct
type t = T.t [@@deriving compare]
let hash_fold_t = hash_fold_t
let hash = hash
let sexp_of_t x = String.sexp_of_t (T.to_binary x)
let t_of_sexp x = T.of_binary_exn (String.t_of_sexp x)
let t_sexp_grammar = Sexplib.Sexp_grammar.coerce String.t_sexp_grammar
let to_binable = T.to_binary
let of_binable = T.of_binary_exn
include Bin_prot.Utils.Make_binable_without_uuid [@alert "-legacy"] (struct
module Binable = String.Stable.V1
type t = Bin_prot.Md5.t
let to_binable = to_binable
let of_binable = of_binable
end)
let stable_witness : t Stable_witness.t =
Stable_witness.of_serializable
String.Stable.V1.stable_witness
of_binable
to_binable
;;
end
end
include Stable.V1
include Comparable.Make (Stable.V1)
include Hashable.Make (Stable.V1)
end
module Stable = struct
module V1 = struct
type t = T.t [@@deriving compare, sexp, sexp_grammar]
let hash_fold_t = hash_fold_t
let hash = hash
let to_binable = Fn.id
let of_binable = Fn.id
include Bin_prot.Utils.Make_binable_without_uuid [@alert "-legacy"] (struct
module Binable = Bin_prot.Md5.Stable.V1
type t = Bin_prot.Md5.t
let to_binable = to_binable
let of_binable = of_binable
end)
let stable_witness : t Stable_witness.t =
Stable_witness.of_serializable
Bin_prot.Md5.Stable.V1.stable_witness
of_binable
to_binable
;;
end
let digest_string s = Md5_lib.string s
end
include Stable.V1
include Comparable.Make (Stable.V1)
include Hashable.Make (Stable.V1)
let digest_num_bytes = 16
let to_hex = T.to_hex
let from_hex = T.of_hex_exn
let of_hex_exn = T.of_hex_exn
let of_binary_exn = T.of_binary_exn
let to_binary = T.to_binary
let digest_string = Stable.digest_string
let digest_bytes = Md5_lib.bytes
external caml_sys_open
: string
-> Stdlib.open_flag list
-> perm:int
-> int
= "caml_sys_open"
external caml_sys_close : int -> unit = "caml_sys_close"
external digest_fd_blocking : int -> string = "core_md5_fd"
let digest_file_blocking path =
of_binary_exn
(Base.Exn.protectx
(caml_sys_open path [ Open_rdonly; Open_binary ] ~perm:0o000)
~f:digest_fd_blocking
~finally:caml_sys_close)
;;
let file = digest_file_blocking
let digest_channel_blocking_without_releasing_runtime_lock channel ~len =
of_binary_exn (Stdlib.Digest.channel channel len)
;;
let channel channel len =
digest_channel_blocking_without_releasing_runtime_lock channel ~len
;;
let output_blocking t oc = Stdlib.Digest.output oc (to_binary t)
let output oc t = output_blocking t oc
let input_blocking ic = of_binary_exn (Stdlib.Digest.input ic)
let input = input_blocking
let digest_subbytes = Md5_lib.subbytes
let string = digest_string
let bytes = digest_bytes
let subbytes s pos len = digest_subbytes s ~pos ~len
let digest_bin_prot writer value =
digest_string (Core_bin_prot.Writer.to_string writer value)
;;
external c_digest_subbigstring
: Bigstring.t
-> pos:int
-> len:int
-> res:Bytes.t
-> unit
= "core_md5_digest_subbigstring"
let unsafe_digest_subbigstring buf ~pos ~len =
let res = Bytes.create 16 in
c_digest_subbigstring buf ~pos ~len ~res;
Md5_lib.unsafe_of_binary
(Bytes.unsafe_to_string ~no_mutation_while_string_reachable:res)
;;
let digest_subbigstring buf ~pos ~len =
Ordered_collection_common.check_pos_len_exn
~pos
~len
~total_length:(Bigstring.length buf);
unsafe_digest_subbigstring buf ~pos ~len
;;
let digest_bigstring buf =
unsafe_digest_subbigstring buf ~pos:0 ~len:(Bigstring.length buf)
;;