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
131
132
133
134
135
136
137
138
|
(*
* 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))
|
