(*
 * XmlRpcBase64 - Base64 codec for XmlRpc
 * Copyright (C) 2007-2009 Dave Benjamin
 * 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
 *
 * This module is based on the ExtLib Base64 codec, written by
 * Nicolas Cannasse, with the following modifications to enable
 * compatibility with various XmlRpc implementations:
 *
 *  - For encoding, output is padded with '=' to a multiple of four characters.
 *  - For decoding, the input characters '\r', '\n', and '=' are ignored.
 *
 * To avoid a dependency on ExtLib, this version uses OCaml's built-in Stream
 * type instead of ExtLib's IO type.
 *
 * Original copyright:
 *
 * Base64 - Base64 codec
 * Copyright (C) 2003 Nicolas Cannasse
 *)

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) strm =
  if Array.length tbl <> 64 then raise Invalid_table;
  let data = ref 0 in
  let count = ref 0 in
  let pad = ref None in
  let rec next i =
    if !count >= 6
    then
      begin
        count := !count - 6;
        let d = (!data asr !count) land 63 in
        Some (Array.unsafe_get tbl d)
      end
    else
      begin
        try
          let c = int_of_char (Stream.next strm) in
          data := (!data lsl 8) lor c;
          count := !count + 2;
          let d = (!data asr !count) land 63 in
          Some (Array.unsafe_get tbl d)
        with Stream.Failure ->
          match !pad with
            | Some 0 ->
                None
            | Some n ->
                pad := Some (n - 1);
                Some '='
            | None ->
                if !count > 0
                then (pad := Some (3 - (i mod 4));
                      let d = (!data lsl (6 - !count)) land 63 in
                      Some (Array.unsafe_get tbl d))
                else None
      end in
  Stream.from next

let decode ?(tbl=inv_chars) strm =
  if Array.length tbl <> 256 then raise Invalid_table;
  let data = ref 0 in
  let count = ref 0 in
  let rec next i =
    if !count >= 8
    then
      begin
        count := !count - 8;
        let d = (!data asr !count) land 0xFF in
        Some (unsafe_char_of_int d)
      end
    else
      begin
        try
          match Stream.next strm with
            | '\r' | '\n' | '=' ->
                next i
            | c ->
                let c = int_of_char c 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;
                next i
        with Stream.Failure ->
          None
      end in
  Stream.from next

let string_of_stream stream =
  let buffer = Buffer.create 16 in
  Stream.iter (Buffer.add_char buffer) stream;
  Buffer.contents buffer

let str_encode ?(tbl=chars) s =
  string_of_stream (encode ~tbl (Stream.of_string s))

let str_decode ?(tbl=inv_chars) s =
  string_of_stream (decode ~tbl (Stream.of_string s))
