summaryrefslogtreecommitdiff
path: root/xxd.ml
blob: 50e0072c39899ad9c7be966a7723b345b226a0fc (plain)
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
(* SPDX-License-Identifier: LGPL-3.0-only WITH OCaml-LGPL-linking-exception *)

let (!!) = Bytes.unsafe_of_string
let (??) = Bytes.unsafe_to_string

module U64 = Stdint.Uint64
module U32 = Stdint.Uint32

module type Xtract = sig
  type t
  val nth_byte : t -> int -> int
end

module MkExtract (INTTYPE : Stdint.Int) = struct
  type t = INTTYPE.t

  let ilsr  = INTTYPE.shift_left
  let iland = INTTYPE.logand
  let ixff  = INTTYPE.of_string "255"

  let nth_byte n i =
    (ilsr n i) |> iland ixff |> INTTYPE.to_int
end

module U32Extract = MkExtract (U32)
module U64Extract = MkExtract (U64)

let string_of_sid s =
  let b = Buffer.create 16 in
  let pushbuf = Buffer.add_string b in
  let ia_nth = U64Extract.nth_byte (Sid.get_ident_auth s) in
  pushbuf
    (Printf.sprintf "01%0.2x %0.2x%0.2x %0.2x%0.2x %0.2x%0.2x"
       (Array.length (Sid.get_sub_auths s))
       (ia_nth 0) (ia_nth 1) (ia_nth 2) (ia_nth 3) (ia_nth 4) (ia_nth 5));
  Array.iter
    (fun sa ->
       let sa_nth = U32Extract.nth_byte sa in
       pushbuf
         (Printf.sprintf "%0.2x%0.2x %0.2x%0.2x"
            (sa_nth 0) (sa_nth 1) (sa_nth 2) (sa_nth 3)))
    (Sid.get_sub_auths s);
  Buffer.contents b

let xdigit_table =
  let t = Array.make 256 !!"\x00\x00" in
  let xd n = Printf.sprintf "%0.2x" (n land 0xff) |> (!!) in
  for i = 0 to 255 do t.(i) <- xd i done;
  t

let xdigit n = xdigit_table.(n land 0xff)

let nope _ = false
let every n i = i > 0 && i mod n = 0

(* result length can be calculated in advance so we can do
   this without realloc() *)
let xxd_of_bytes ?(blocklen=0) src =
  let ls = Bytes.length src in
  if ls = 0 then "" else
  let ld = 2 * ls + if blocklen = 0 then 0 else (ls - 1) / blocklen in
  let dst = Bytes.create ld in
  let spacep = if blocklen = 0 then nope else every blocklen in
  let rec aux is id =
    if is = ls then ??dst else
    let id' =
      if not (spacep is) then id
      else (Bytes.set dst id ' '; id + 1)
    in
    assert (id' < ld - 1);
    Bytes.blit (Bytes.get src is |> int_of_char |> xdigit) 0 dst id' 2;
    aux (is+1) (id'+2)
  in
  aux 0 0

let bufsiz = 4096

let base_decimal = int_of_char '0'
let base_lower   = int_of_char 'a' - 10
let base_upper   = int_of_char 'A' - 10

let int_of_nibble c =
  if '0' <= c && c <= '9' then Some (int_of_char c - base_decimal) else
  if 'a' <= c && c <= 'f' then Some (int_of_char c - base_lower  ) else
  if 'A' <= c && c <= 'F' then Some (int_of_char c - base_upper  ) else
  None

let bytes_of_xxd src =
  let ls = String.length src in
  if ls = 0 then Bytes.empty else
  let buf = Buffer.create bufsiz in
  let rec aux hi is =
    if is = ls then
      if hi = None then (Buffer.contents buf |> (!!)) else
      raise (Invalid_argument
               "bytes_of_xxd: odd number of hex digits in input")
    else
      match String.get src is |> int_of_nibble with
        | None -> aux hi (is+1)
        | Some c -> begin
            match hi with
              | None -> aux (Some (c lsl 4)) (is+1)
              | Some hi ->
                Buffer.add_char buf (hi lor c |> char_of_int);
                aux None (is+1)
          end
  in
  aux None 0