[extlib] Add base64 to leftovers

Copied from:
https://github.com/ygrek/ocaml-extlib/blob/f30acba5bb1e092faf22f777cef1b72a7b109097/src/base64.ml
https://github.com/ygrek/ocaml-extlib/blob/f30acba5bb1e092faf22f777cef1b72a7b109097/src/base64.mli

See conflict introduced by this change in ocaml-base64:
mirage/ocaml-base64#25

libs/extlib-leftovers/base64.ml

@@ -0,0 +1,130 @@
+(*
+ * Base64 - Base64 codec
+ * Copyright (C) 2003 Nicolas Cannasse
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version,
+ * with the special exception on linking described in file LICENSE.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+
+open ExtBytes
+
+exception Invalid_char
+exception Invalid_table
+
+external unsafe_char_of_int : int -> char = "%identity"
+
+type encoding_table = char array
+type decoding_table = int array
+
+let chars = [|
+  'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';
+  'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f';
+  'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v';
+  'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/'
+|]
+
+let make_decoding_table tbl =
+  if Array.length tbl <> 64 then raise Invalid_table;
+  let d = Array.make 256 (-1) in
+  for i = 0 to 63 do
+    Array.unsafe_set d (int_of_char (Array.unsafe_get tbl i)) i;
+  done;
+  d
+
+let inv_chars = make_decoding_table chars
+
+let encode ?(tbl=chars) ch =
+  if Array.length tbl <> 64 then raise Invalid_table;
+  let data = ref 0 in
+  let count = ref 0 in
+  let flush() =
+    if !count > 0 then begin
+      let d = (!data lsl (6 - !count)) land 63 in
+      IO.write ch (Array.unsafe_get tbl d);
+    end;    
+  in
+  let write c =
+    let c = int_of_char c in
+    data := (!data lsl 8) lor c;
+    count := !count + 8;
+    while !count >= 6 do
+      count := !count - 6;
+      let d = (!data asr !count) land 63 in
+      IO.write ch (Array.unsafe_get tbl d)
+    done;
+  in
+  let output s p l =
+    for i = p to p + l - 1 do
+      write (Bytes.unsafe_get s i)
+    done;
+    l
+  in
+  IO.create_out ~write ~output
+    ~flush:(fun () -> flush(); IO.flush ch)
+    ~close:(fun() -> flush(); IO.close_out ch)
+
+let decode ?(tbl=inv_chars) ch =
+  if Array.length tbl <> 256 then raise Invalid_table;
+  let data = ref 0 in
+  let count = ref 0 in
+  let rec fetch() =
+    if !count >= 8 then begin
+      count := !count - 8;
+      let d = (!data asr !count) land 0xFF in
+      unsafe_char_of_int d
+    end else
+      let c = int_of_char (IO.read ch) in
+      let c = Array.unsafe_get tbl c in
+      if c = -1 then raise Invalid_char;
+      data := (!data lsl 6) lor c;
+      count := !count + 6;
+      fetch()
+  in
+  let read = fetch in
+  let input s p l =
+    let i = ref 0 in
+    try
+      while !i < l do
+        Bytes.unsafe_set s (p + !i) (fetch());
+        incr i;
+      done;
+      l
+    with
+      IO.No_more_input when !i > 0 ->
+        !i
+  in
+  let close() =
+    count := 0;
+    IO.close_in ch
+  in
+  IO.create_in ~read ~input ~close
+
+let str_encode ?(tbl=chars) s =
+  let ch = encode ~tbl (IO.output_bytes()) in
+  IO.nwrite_string ch s;
+  IO.close_out ch
+
+let str_decode ?(tbl=inv_chars) s =
+  let ch = decode ~tbl (IO.input_bytes s) in
+  IO.nread_string ch ((Bytes.length s * 6) / 8)
+
+let encode_string ?(tbl=chars) s =
+  let ch = encode ~tbl (IO.output_string ()) in
+  IO.nwrite_string ch s;
+  IO.close_out ch
+
+let decode_string ?(tbl=inv_chars) s =
+  let ch = decode ~tbl (IO.input_string s) in
+  IO.nread_string ch ((String.length s * 6) / 8)

libs/extlib-leftovers/base64.mli

@@ -0,0 +1,65 @@
+(*
+ * Base64 - Base64 codec
+ * Copyright (C) 2003 Nicolas Cannasse
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version,
+ * with the special exception on linking described in file LICENSE.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+
+(** Base64 codec.
+
+  8-bit characters are encoded into 6-bit ones using ASCII lookup tables.
+  Default tables maps 0..63 values on characters A-Z, a-z, 0-9, '+' and '/'
+  (in that order). 
+*)
+
+open ExtBytes
+
+(** This exception is raised when reading an invalid character
+  from a base64 input. *)
+exception Invalid_char
+
+(** This exception is raised if the encoding or decoding table
+  size is not correct. *)
+exception Invalid_table
+
+(** An encoding table maps integers 0..63 to the corresponding char. *)
+type encoding_table = char array
+
+(** A decoding table maps chars 0..255 to the corresponding 0..63 value
+ or -1 if the char is not accepted. *)
+type decoding_table = int array
+
+(** erroneous interface, kept for compatibility use [encode_string] instead *)
+val str_encode : ?tbl:encoding_table -> string -> Bytes.t
+
+(** erroneous interface, kept for compatibility use [decode_string] instead *)
+val str_decode : ?tbl:decoding_table -> Bytes.t -> string
+
+(** Encode a string into Base64. *)
+val encode_string : ?tbl:encoding_table -> string -> string
+
+(** Decode a string encoded into Base64, raise [Invalid_char] if a
+  character in the input string is not a valid one. *)
+val decode_string : ?tbl:decoding_table -> string -> string
+
+(** Generic base64 encoding over an output. *)
+val encode : ?tbl:encoding_table -> 'a IO.output -> 'a IO.output
+
+(** Generic base64 decoding over an input. *)
+val decode : ?tbl:decoding_table -> IO.input -> IO.input
+
+(** Create a valid decoding table from an encoding one. *)
+val make_decoding_table : encoding_table -> decoding_table

src/codegen/codegen.ml

@@ -22,6 +22,7 @@ open Type
 open Common
 open Error
 open Globals
+open Extlib_leftovers
 
 (* -------------------------------------------------------------------------- *)
 (* TOOLS *)

src/macro/eval/evalMain.ml

@@ -33,6 +33,7 @@ open EvalHash
 open EvalEncode
 open EvalField
 open MacroApi
+open Extlib_leftovers
 
 (* Create *)
 
@@ -585,4 +586,4 @@ let get_api_call_pos () =
 		| None -> env
 		| Some env -> env
 	in
-	{ pfile = rev_hash env.env_info.pfile; pmin = env.env_leave_pmin; pmax = env.env_leave_pmax }
+	{ pfile = rev_hash env.env_info.pfile; pmin = env.env_leave_pmin; pmax = env.env_leave_pmax }