File: base64.ml

package info (click to toggle)
extlib 1.7.7-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 632 kB
  • sloc: ml: 6,980; makefile: 128; sh: 42; ansic: 31
file content (130 lines) | stat: -rw-r--r-- 3,726 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
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)