1(* $Id: base64.ml,v 5.2 2007-01-19 01:53:16 ddr Exp $ *)
2(* Copyright (c) 1998-2007 INRIA *)
3
4(* For basic credentials only *)
5(* Encoding is [A-Z][a-z][0-9]+/= *)
6(* 3 chars = 24 bits = 4 * 6-bit groups -> 4 chars *)
7
8value index64 = Array.make 128 0;
9(* Init the index *)
10do {
11  for i = 0 to 25 do { index64.(i + Char.code 'A') := i };
12  for i = 0 to 25 do { index64.(i + Char.code 'a') := i + 26 };
13  for i = 0 to 9 do { index64.(i + Char.code '0') := i + 52 };
14  index64.(Char.code '+') := 62;
15  index64.(Char.code '/') := 63
16};
17
18value decode s =
19  let rpos = ref 0
20  and wpos = ref 0
21  and len = String.length s in
22  let res = Bytes.create (len / 4 * 3) in
23  do {
24    while rpos.val < len do {
25      let v1 = index64.(Char.code s.[rpos.val]) in
26      let v2 = index64.(Char.code s.[rpos.val + 1]) in
27      let v3 = index64.(Char.code s.[rpos.val + 2]) in
28      let v4 = index64.(Char.code s.[rpos.val + 3]) in
29      let i = v1 lsl 18 lor v2 lsl 12 lor v3 lsl 6 lor v4 in
30      Bytes.set res wpos.val (Char.chr (i lsr 16));
31      Bytes.set res (wpos.val + 1) (Char.chr (i lsr 8 land 0xFF));
32      Bytes.set res (wpos.val + 2) (Char.chr (i land 0xFF));
33      rpos.val := rpos.val + 4;
34      wpos.val := wpos.val + 3
35    };
36    let cut =
37      if s.[len - 1] = '=' then if s.[len - 2] = '=' then 2 else 1 else 0
38    in
39    String.sub res 0 (String.length res - cut)
40  }
41;
42
43
44value char64 = Array.make 64 'a';
45do {
46  for i = 0 to 25 do { char64.(i) := Char.chr (Char.code 'A' + i) };
47  for i = 0 to 25 do { char64.(i + 26) := Char.chr (Char.code 'a' + i) };
48  for i = 0 to 9 do { char64.(i + 52) := Char.chr (Char.code '0' + i) };
49  char64.(62) := '+';
50  char64.(63) := '/'
51};
52
53(* Encoding *)
54value encode s =
55  let rpos = ref 0
56  and wpos = ref 0 in
57  let origlen = String.length s in
58  let (s, len) =
59    match origlen mod 3 with
60    [ 0 -> (s, origlen)
61    | 1 -> (s ^ "\000\000", origlen + 2)
62    | 2 -> (s ^ "\000", origlen + 1)
63    | _ -> match () with [] ]
64  in
65  let res = Bytes.create (len / 3 * 4) in
66  do {
67    while rpos.val < len do {
68      let i1 = Char.code s.[rpos.val] in
69      let i2 = Char.code s.[rpos.val + 1] in
70      let i3 = Char.code s.[rpos.val + 2] in
71      let i = i1 lsl 16 lor i2 lsl 8 lor i3 in
72      Bytes.set res wpos.val char64.(i lsr 18 land 0x3f);
73      Bytes.set res (wpos.val + 1) char64.(i lsr 12 land 0x3f);
74      Bytes.set res (wpos.val + 2) char64.(i lsr 6 land 0x3f);
75      Bytes.set res (wpos.val + 3) char64.(i land 0x3f);
76      rpos.val := rpos.val + 3;
77      wpos.val := wpos.val + 4
78    };
79    for i = 1 to len - origlen do { Bytes.set res (String.length res - i) '=' };
80    res
81  }
82;
83