bundles/extlib/extlib-1.5.2/base64.ml

   1 (*
   2  * Base64 - Base64 codec
   3  * Copyright (C) 2003 Nicolas Cannasse
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public
   7  * License as published by the Free Software Foundation; either
   8  * version 2.1 of the License, or (at your option) any later version,
   9  * with the special exception on linking described in file LICENSE.
  10  *
  11  * This library is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public
  17  * License along with this library; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19  *)
  20
  21 exception Invalid_char
  22 exception Invalid_table
  23
  24 external unsafe_char_of_int : int -> char = "%identity"
  25
  26 type encoding_table = char array
  27 type decoding_table = int array
  28
  29 let chars = [|
  30         'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';
  31         'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f';
  32         'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v';
  33         'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/'
  34 |]
  35
  36 let make_decoding_table tbl =
  37         if Array.length tbl <> 64 then raise Invalid_table;
  38         let d = Array.make 256 (-1) in
  39         for i = 0 to 63 do
  40                 Array.unsafe_set d (int_of_char (Array.unsafe_get tbl i)) i;
  41         done;
  42         d
  43
  44 let inv_chars = make_decoding_table chars
  45
  46 let encode ?(tbl=chars) ch =
  47         if Array.length tbl <> 64 then raise Invalid_table;
  48         let data = ref 0 in
  49         let count = ref 0 in
  50         let flush() =
  51                 if !count > 0 then begin
  52                         let d = (!data lsl (6 - !count)) land 63 in
  53                         IO.write ch (Array.unsafe_get tbl d);
  54                 end;
  55         in
  56         let write c =
  57                 let c = int_of_char c in
  58                 data := (!data lsl 8) lor c;
  59                 count := !count + 8;
  60                 while !count >= 6 do
  61                         count := !count - 6;
  62                         let d = (!data asr !count) land 63 in
  63                         IO.write ch (Array.unsafe_get tbl d)
  64                 done;
  65         in
  66         let output s p l =
  67                 for i = p to p + l - 1 do
  68                         write (String.unsafe_get s i)
  69                 done;
  70                 l
  71         in
  72         IO.create_out ~write ~output
  73                 ~flush:(fun () -> flush(); IO.flush ch)
  74                 ~close:(fun() -> flush(); IO.close_out ch)
  75
  76 let decode ?(tbl=inv_chars) ch =
  77         if Array.length tbl <> 256 then raise Invalid_table;
  78         let data = ref 0 in
  79         let count = ref 0 in
  80         let rec fetch() =
  81                 if !count >= 8 then begin
  82                         count := !count - 8;
  83                         let d = (!data asr !count) land 0xFF in
  84                         unsafe_char_of_int d
  85                 end else
  86                         let c = int_of_char (IO.read ch) in
  87                         let c = Array.unsafe_get tbl c in
  88                         if c = -1 then raise Invalid_char;
  89                         data := (!data lsl 6) lor c;
  90                         count := !count + 6;
  91                         fetch()
  92         in
  93         let read = fetch in
  94         let input s p l =
  95                 let i = ref 0 in
  96                 try
  97                         while !i < l do
  98                                 String.unsafe_set s (p + !i) (fetch());
  99                                 incr i;
 100                         done;
 101                         l
 102                 with
 103                         IO.No_more_input when !i > 0 ->
 104                                 !i
 105         in
 106         let close() =
 107                 count := 0;
 108                 IO.close_in ch
 109         in
 110         IO.create_in ~read ~input ~close
 111
 112 let str_encode ?(tbl=chars) s =
 113         let ch = encode ~tbl (IO.output_string()) in
 114         IO.nwrite ch s;
 115         IO.close_out ch
 116
 117 let str_decode ?(tbl=inv_chars) s =
 118         let ch = decode ~tbl (IO.input_string s) in
 119         IO.nread ch ((String.length s * 6) / 8)