Blame src/base64.ml

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