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
type writer = Buffer.t
let to_bytes (write : writer -> unit) : string =
let b = Buffer.create 64 in
write b;
Buffer.contents b
let check (what : string) (lo : int) (hi : int) (n : int) : unit =
if n < lo || n > hi then invalid_arg (Printf.sprintf "Wire.put_%s: %d not in [%d, %d]" what n lo hi)
let put_u8 (w : writer) (n : int) : unit =
check "u8" 0 255 n;
Buffer.add_char w (Char.chr n)
let put_u16 (w : writer) (n : int) : unit =
check "u16" 0 65535 n;
Buffer.add_char w (Char.chr (n lsr 8));
Buffer.add_char w (Char.chr (n land 255))
let max_varint = (1 lsl 28) - 1
let put_varint (w : writer) (n : int) : unit =
check "varint" 0 max_varint n;
let rec groups n acc = if n < 128 then n :: acc else groups (n lsr 7) ((n land 127) :: acc) in
let gs = groups n [] in
let last = List.length gs - 1 in
List.iteri (fun i g -> Buffer.add_char w (Char.chr (if i < last then g lor 128 else g))) gs
let zigzag (n : int) : int = if n >= 0 then 2 * n else (-2 * n) - 1
let unzigzag (z : int) : int = if z land 1 = 0 then z lsr 1 else -((z + 1) lsr 1)
let put_signed (w : writer) (n : int) : unit =
check "signed" (-(1 lsl 27)) ((1 lsl 27) - 1) n;
put_varint w (zigzag n)
let put_string (w : writer) (s : string) : unit =
put_varint w (String.length s);
Buffer.add_string w s
type reader = { bytes : string; mutable pos : int }
exception Refused of string
let fail (r : reader) (why : string) : 'a = raise (Refused (Printf.sprintf "%s, at byte %d" why r.pos))
let byte (r : reader) : int =
if r.pos >= String.length r.bytes then fail r "bytes missing"
else
let b = Char.code r.bytes.[r.pos] in
r.pos <- r.pos + 1;
b
let parse (read : reader -> 'a) (bytes : string) : ('a, string) result =
let r = { bytes; pos = 0 } in
match read r with
| v when r.pos = String.length bytes -> Ok v
| _ -> Error (Printf.sprintf "%d bytes left over, at byte %d" (String.length bytes - r.pos) r.pos)
| exception Refused why -> Error why
let get_u8 (r : reader) : int = byte r
let get_u16 (r : reader) : int =
let hi = byte r in
let lo = byte r in
(hi lsl 8) lor lo
let get_varint (r : reader) : int =
let rec go n acc =
if n = 4 then fail r "a varint longer than 4 bytes"
else
let b = byte r in
if n = 0 && b = 0x80 then fail r "a varint with a useless leading byte"
else
let acc = (acc lsl 7) lor (b land 127) in
if b land 128 <> 0 then go (n + 1) acc else acc
in
go 0 0
let get_signed (r : reader) : int = unzigzag (get_varint r)
let get_string (r : reader) : string =
let n = get_varint r in
if r.pos + n > String.length r.bytes then fail r (Printf.sprintf "a string of %d bytes, past the end" n)
else
let s = String.sub r.bytes r.pos n in
r.pos <- r.pos + n;
s