File: XmlRpcBase64.ml

package info (click to toggle)
xmlrpc-light 0.6.1-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 1,308 kB
  • sloc: ml: 3,183; makefile: 54; sh: 1
file content (138 lines) | stat: -rw-r--r-- 4,557 bytes parent folder | download | duplicates (4)
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))