|
@@ -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)
|