src/utils/net/base64.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 let b64_pattern plus slash =
  21   [| 'A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'; 'H'; 'I'; 'J'; 'K'; 'L'; 'M';
  22     'N'; 'O'; 'P'; 'Q'; 'R'; 'S'; 'T'; 'U'; 'V'; 'W'; 'X'; 'Y'; 'Z';
  23     'a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g'; 'h'; 'i'; 'j'; 'k'; 'l'; 'm';
  24     'n'; 'o'; 'p'; 'q'; 'r'; 's'; 't'; 'u'; 'v'; 'w'; 'x'; 'y'; 'z';
  25     '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; plus; slash |];;
  26
  27
  28 let rfc_pattern = b64_pattern '+' '/';;
  29 let url_pattern = b64_pattern '-' '/';;
  30
  31 let encode_with_options b64 equal s pos len linelen crlf =
  32 (* encode using "base64".
  33    * 'b64': The encoding table, created by b64_pattern.
  34    * 'equal': The character that should be used instead of '=' in the original
  35    *          encoding scheme. Pass '=' to get the original encoding scheme.
  36    * s, pos, len, linelen: See the interface description of encode_substring.
  37    *)
  38   assert (Array.length b64 = 64);
  39   if len < 0 or pos < 0 or pos > String.length s or linelen < 0 then
  40     invalid_arg "Netencoding.Base64.encode_with_options";
  41   if pos + len > String.length s then
  42     invalid_arg "Netencoding.Base64.encode_with_options";
  43
  44   let linelen =
  45     (linelen/4) * 4 in
  46
  47   let l_t = if len = 0 then 0 else ((len - 1) / 3 + 1) * 4 in
  48 (* l_t: length of the result without additional line endings *)
  49
  50   let l_t' =
  51     if linelen < 4 then
  52       l_t
  53     else
  54     if l_t = 0 then 0 else
  55     let n_lines = ((l_t - 1) / linelen) + 1 in
  56     l_t + n_lines * (if crlf then 2 else 1)
  57   in
  58 (* l_t': length of the result with CRLF or LF characters *)
  59
  60   let t = String.make l_t' equal in
  61   let j = ref 0 in
  62   let q = ref 0 in
  63   for k = 0 to len / 3 - 1 do
  64     let p = pos + 3*k in
  65 (* p >= pos >= 0: this is evident
  66        * p+2 < pos+len <= String.length s:
  67        *   Because k <= len/3-1
  68        *         3*k <= 3*(len/3-1) = len - 3
  69        *   pos+3*k+2 <= pos + len - 3 + 2 = pos + len - 1 < pos + len
  70        * So it is proved that the following unsafe string accesses always
  71        * work.
  72        *)
  73     let bits = (Char.code (String.unsafe_get s (p))   lsl 16) lor
  74         (Char.code (String.unsafe_get s (p+1)) lsl  8) lor
  75         (Char.code (String.unsafe_get s (p+2))) in
  76 (* Obviously, 'bits' is a 24 bit entity (i.e. bits < 2**24) *)
  77     assert(!j + 3 < l_t');
  78     String.unsafe_set t !j     (Array.unsafe_get b64 ( bits lsr 18));
  79     String.unsafe_set t (!j+1) (Array.unsafe_get b64 ((bits lsr 12) land 63));
  80     String.unsafe_set t (!j+2) (Array.unsafe_get b64 ((bits lsr  6) land 63));
  81     String.unsafe_set t (!j+3) (Array.unsafe_get b64 ( bits         land 63));
  82     j := !j + 4;
  83     if linelen > 3 then begin
  84         q := !q + 4;
  85         if !q + 4 > linelen then begin
  86 (* The next 4 characters won't fit on the current line. So insert
  87            * a line ending.
  88            *)
  89             if crlf then begin
  90                 t.[ !j ] <- '\013';
  91                 t.[ !j+1 ] <- '\010';
  92                 j := !j + 2;
  93               end
  94             else begin
  95                 t.[ !j ] <- '\010';
  96                 incr j
  97               end;
  98             q := 0;
  99           end;
 100       end;
 101   done;
 102 (* padding if needed: *)
 103   let m = len mod 3 in
 104   begin
 105     match m with
 106       0 -> ()
 107     | 1 ->
 108         let bits = Char.code (s.[pos + len - 1]) in
 109         t.[ !j     ] <- b64.( bits lsr 2);
 110         t.[ !j + 1 ] <- b64.( (bits land 0x03) lsl 4);
 111         j := !j + 4;
 112         q := !q + 4;
 113     | 2 ->
 114         let bits = (Char.code (s.[pos + len - 2]) lsl 8) lor
 115             (Char.code (s.[pos + len - 1])) in
 116         t.[ !j     ] <- b64.( bits lsr 10);
 117         t.[ !j + 1 ] <- b64.((bits lsr  4) land 0x3f);
 118         t.[ !j + 2 ] <- b64.((bits lsl  2) land 0x3f);
 119         j := !j + 4;
 120         q := !q + 4;
 121     | _ -> assert false
 122   end;
 123
 124 (* If required, add another line end: *)
 125
 126   if linelen > 3 && !q > 0 then begin
 127       if crlf then begin
 128           t.[ !j ] <- '\013';
 129           t.[ !j+1 ] <- '\010';
 130           j := !j + 2;
 131         end
 132       else begin
 133           t.[ !j ] <- '\010';
 134           incr j
 135         end;
 136     end;
 137
 138   t ;;
 139
 140
 141
 142 let encode s =
 143   encode_with_options rfc_pattern '=' s 0 (String.length s) 0 false;;
 144
 145
 146 let encode_substring s pos len =
 147   encode_with_options rfc_pattern '=' s pos len 0 false;;
 148
 149
 150 let url_encode ?(pos=0) ?len ?(linelength=0) ?(crlf=false) s =
 151   let l = match len with None -> String.length s - pos | Some x -> x in
 152   encode_with_options url_pattern '.' s pos l linelength crlf;;
 153
 154
 155 let decode_substring t ~pos ~len ~url_variant:p_url ~accept_spaces:p_spaces =
 156   if len < 0 or pos < 0 or pos > String.length t then
 157     invalid_arg "Netencoding.Base64.decode_substring";
 158   if pos + len > String.length t then
 159     invalid_arg "Netencoding.Base64.decode_substring";
 160
 161 (* Compute the number of effective characters l_t in 't';
 162      * pad_chars: number of '=' characters at the end of the string.
 163      *)
 164   let l_t, pad_chars =
 165     if p_spaces then begin
 166 (* Count all non-whitespace characters: *)
 167         let c = ref 0 in
 168         let p = ref 0 in
 169         for i = pos to pos + len - 1 do
 170           match String.unsafe_get t i with
 171             (' '|'\t'|'\r'|'\n') -> ()
 172           | ('='|'.') as ch ->
 173               if ch = '.' && not p_url then
 174                 invalid_arg "Netencoding.Base64.decode_substring";
 175               incr c;
 176               incr p;
 177               if !p > 2 then
 178                 invalid_arg "Netencoding.Base64.decode_substring";
 179               for j = i+1 to pos + len - 1 do
 180                 match String.unsafe_get t j with
 181                   (' '|'\t'|'\r'|'\n'|'.'|'=') -> ()
 182                 | _ ->
 183 (* Only another '=' or spaces allowed *)
 184                     invalid_arg "Netencoding.Base64.decode_substring";
 185               done
 186           | _ -> incr c
 187         done;
 188         if !c mod 4 <> 0 then
 189           invalid_arg "Netencoding.Base64.decode_substring";
 190         !c, !p
 191       end
 192     else
 193       len,
 194       ( if len mod 4 <> 0 then
 195           invalid_arg "Netencoding.Base64.decode_substring";
 196         if len > 0 then (
 197             if String.sub t (len - 2) 2 = "==" ||
 198               (p_url && String.sub t (len - 2) 2 = "..") then 2
 199             else
 200             if String.sub t (len - 1) 1 = "=" ||
 201               (p_url && String.sub t (len - 1) 1 = ".") then 1
 202             else
 203               0
 204           )
 205         else 0
 206       )
 207   in
 208
 209   let l_s = (l_t / 4) * 3 - pad_chars in       (* sic! *)
 210   let s = String.create l_s in
 211
 212   let decode_char c =
 213     match c with
 214       'A' .. 'Z'  -> Char.code(c) - 65     (* 65 = Char.code 'A' *)
 215     | 'a' .. 'z'  -> Char.code(c) - 71     (* 71 = Char.code 'a' - 26 *)
 216     | '0' .. '9'  -> Char.code(c) + 4      (* -4 = Char.code '0' - 52 *)
 217     | '+'         -> 62
 218     | '-'         -> if not p_url then
 219           invalid_arg "Netencoding.Base64.decode_substring";
 220         62
 221     | '/'         -> 63
 222     | _           -> invalid_arg "Netencoding.Base64.decode_substring";
 223   in
 224
 225 (* Decode all but the last quartet: *)
 226
 227   let cursor = ref pos in
 228   let rec next_char() =
 229     match t.[ !cursor ] with
 230       (' '|'\t'|'\r'|'\n') ->
 231         if p_spaces then (incr cursor; next_char())
 232         else invalid_arg "Netencoding.Base64.decode_substring"
 233     | c ->
 234         incr cursor; c
 235   in
 236
 237   if p_spaces then begin
 238       for k = 0 to l_t / 4 - 2 do
 239         let q = 3*k in
 240         let c0 = next_char() in
 241         let c1 = next_char() in
 242         let c2 = next_char() in
 243         let c3 = next_char() in
 244         let n0 = decode_char c0 in
 245         let n1 = decode_char c1 in
 246         let n2 = decode_char c2 in
 247         let n3 = decode_char c3 in
 248         let x0 = (n0 lsl 2) lor (n1 lsr 4) in
 249         let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
 250         let x2 = ((n2 lsl 6) land 0xc0) lor n3 in
 251         String.unsafe_set s q     (Char.chr x0);
 252         String.unsafe_set s (q+1) (Char.chr x1);
 253         String.unsafe_set s (q+2) (Char.chr x2);
 254       done;
 255     end
 256   else begin
 257 (* Much faster: *)
 258       for k = 0 to l_t / 4 - 2 do
 259         let p = pos + 4*k in
 260         let q = 3*k in
 261         let c0 = String.unsafe_get t p in
 262         let c1 = String.unsafe_get t (p + 1) in
 263         let c2 = String.unsafe_get t (p + 2) in
 264         let c3 = String.unsafe_get t (p + 3) in
 265         let n0 = decode_char c0 in
 266         let n1 = decode_char c1 in
 267         let n2 = decode_char c2 in
 268         let n3 = decode_char c3 in
 269         let x0 = (n0 lsl 2) lor (n1 lsr 4) in
 270         let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
 271         let x2 = ((n2 lsl 6) land 0xc0) lor n3 in
 272         String.unsafe_set s q     (Char.chr x0);
 273         String.unsafe_set s (q+1) (Char.chr x1);
 274         String.unsafe_set s (q+2) (Char.chr x2);
 275       done;
 276       cursor := pos + l_t - 4;
 277     end;
 278
 279 (* Decode the last quartet: *)
 280
 281   if l_t > 0 then begin
 282       let q = 3*(l_t / 4 - 1) in
 283       let c0 = next_char() in
 284       let c1 = next_char() in
 285       let c2 = next_char() in
 286       let c3 = next_char() in
 287
 288       if (c2 = '=' && c3 = '=') or (p_url && c2 = '.' && c3 = '.') then begin
 289           let n0 = decode_char c0 in
 290           let n1 = decode_char c1 in
 291           let x0 = (n0 lsl 2) lor (n1 lsr 4) in
 292           s.[ q ]   <- Char.chr x0;
 293         end
 294       else
 295       if (c3 = '=') or (p_url && c3 = '.') then begin
 296           let n0 = decode_char c0 in
 297           let n1 = decode_char c1 in
 298           let n2 = decode_char c2 in
 299           let x0 = (n0 lsl 2) lor (n1 lsr 4) in
 300           let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
 301           s.[ q ]   <- Char.chr x0;
 302           s.[ q+1 ] <- Char.chr x1;
 303         end
 304       else begin
 305           let n0 = decode_char c0 in
 306           let n1 = decode_char c1 in
 307           let n2 = decode_char c2 in
 308           let n3 = decode_char c3 in
 309           let x0 = (n0 lsl 2) lor (n1 lsr 4) in
 310           let x1 = ((n1 lsl 4) land 0xf0) lor (n2 lsr 2) in
 311           let x2 = ((n2 lsl 6) land 0xc0) lor n3 in
 312           s.[ q ]   <- Char.chr x0;
 313           s.[ q+1 ] <- Char.chr x1;
 314           s.[ q+2 ] <- Char.chr x2;
 315         end
 316
 317     end;
 318
 319   s ;;
 320
 321
 322
 323 let decode s =
 324   decode_substring s 0 (String.length s) false false
 325