pax_global_header00006660000000000000000000000064143640106000014504gustar00rootroot0000000000000052 comment=084346f14ed1e6706d733402dd6ff65b0dc4f718 ocaml-base64-3.5.1/000077500000000000000000000000001436401060000136675ustar00rootroot00000000000000ocaml-base64-3.5.1/.gitignore000066400000000000000000000001011436401060000156470ustar00rootroot00000000000000_build _tests tmp *~ \.\#* \#*# *.install *.native *.byte .merlinocaml-base64-3.5.1/.ocamlformat000066400000000000000000000003041436401060000161710ustar00rootroot00000000000000version = 0.16.0 break-infix = fit-or-vertical parse-docstrings = true indicate-multiline-delimiters=no nested-match=align sequence-style=separator break-before-in=auto if-then-else=keyword-first ocaml-base64-3.5.1/.ocp-indent000066400000000000000000000000641436401060000157300ustar00rootroot00000000000000strict_with=always,match_clause=4,strict_else=never ocaml-base64-3.5.1/.travis-ci.sh000077500000000000000000000013561436401060000162120ustar00rootroot00000000000000case "$OCAML_VERSION,$OPAM_VERSION" in 4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;; 4.00.1,1.2.0) ppa=avsm/ocaml40+opam12 ;; 4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;; 4.01.0,1.2.0) ppa=avsm/ocaml41+opam12 ;; 4.02.1,1.1.0) ppa=avsm/ocaml42+opam11 ;; 4.02.1,1.2.0) ppa=avsm/ocaml42+opam12 ;; *) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;; esac echo "yes" | sudo add-apt-repository ppa:$ppa sudo apt-get update -qq sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam time export OPAMYES=1 export OPAMVERBOSE=1 echo OCaml version ocaml -version echo OPAM versions opam --version opam --git-version opam init git://github.com/ocaml/opam-repository >/dev/null 2>&1 opam install ocamlfind eval `opam config env` make make install ocaml-base64-3.5.1/CHANGES.md000066400000000000000000000076061436401060000152720ustar00rootroot00000000000000### v3.5.1 (2023-01-24) - Few fixes about benchmarks and tests (#51, @tbrk, @dinosaure) - Add missing dependency about `fmt` and fix the compilation for OCaml 5.0 (#52, @kit-ty-kate) ### v3.5.0 (2021-02-08) - Fix support for `x-compilation` (@samoht, #44) - Update to `dune.2.0` and apply `ocamlformat` (@samoht, #45) - Select `unsafe.ml` only with `dune` (@emillon, #46) - Remove indirect dependecy to `ocamlfind` (@kit-ty-kate, #49) - Hide internals of `base64` and return a `string` as the alphabet (@reynir, #48) **breaking chnages** `Base64.alphabet` is updated and return a simple `string` now ### v3.4.0 (2020-03-13) - Fix tests about `alcotest.1.0.0` (@dinosaure, #40) - Be more strict about padding when we decode a base64 input (@dinosaure, @hannesm, @cfcs, #43) - Remove `fmt` dependency (#43) ### v3.3.0 (2019-01-30) - Remove `build` directive on dune dependency (@CraigFe, #35) - Make error poly-variant open (@copy, #39) - Use `unsafe_bytes_set16u` instead `unsafe_string_set16u` (@dinosaure, @hhugo, @avsm, #37) ### v3.2.0 (2019-04-04) * `Base64_rfc2045.decode` can now progress on many input errors, allowing clients to make forward progress by discarding a single character and trying to continue. This allows, for example, newlines and other invalid characters to be discarded. (#34 @tiash, review by @dinosaure @avsm) * Add more test cases for RFC2045 (#34 @dinosaure) * Improve README toplevel output example (#28 @djs55) ### v3.1.0 (2019-02-03) * Add `Base64.encode_string` that doesn't raise or return an error. This makes it easier to port pre-3.0 code to the new interface (#26 @avsm) ### v3.0.0 (2018-01-21) * Implementation of Base64 according to RFC 2045 (available on base64.rfc2045) * New implementation of Base64 according to RFC 4648 from nocrypto's implementation * Fix bad access with `String.iter` on the old implementation of Base64 (@dinosaure, #23) * Check isomorphism between `encode` & `decode` function (@hannesm, @dinosaure, #20) * Add tests from RFC 3548 and from PHP impl. (@hannesm, @dinosaure, #24) * Add fuzzer on both implementations - check isomorphism - check bijection - check if `decode` does not raise any exception * __break-api__, `B64` was renamed to `Base64` (@copy, @avsm, @dinosaure, #17) * __break-api__, `Base64.decode` and `Base64.encode` returns a result type instead to raise an exception (@hannesm, @dinosaure, #21) * __break-api__, Add `sub` type to avoid allocation to the end-user (@avsm, @dinosaure, #24) * __break-api__, Add `pad` argument on `decode` function to check if input is well-padded or not (@hannesm, @dinosaure, #24) * __break-api__, Add `off` and `len` optional arguments on `encode` & `decode` functions to compute a part of input (@cfcs, @dinosaure, #24) * Better performance (see #24) (@dinosaure) * Review of code by @cfcs (see #24) ### v2.3.0 (2018-11-23) * Add a `decode_opt` function that is a non-raising variant of `decode`. * Reformat the code with ocamlformat (@dinosaure) * Port build to dune from jbuilder (@dinosaure ### v2.2.0 (2017-06-20) * Switch to jbuilder (#13, @rgrinberg) ### v2.1.2 (2016-10-18) * Fix version number (#11, @hannesm) ### v2.1.1 (2016-10-03) * Switch build to `topkg` and obey the `odig` conventions for installing metadata files. * Add a test suite based on RFC4648 test vectors. * Improve Travis CI tests to be multidistro. ### v2.0.0 (2014-12-24) * Switch the top-level `Base64` module to `B64` to avoid clashing with various other similarly named modules in `extlib` and some other libraries. This is obviously backwards compatibility breaking with all current users of this library. (#3). ### 1.1.0 (2014-12-16) * Allow specifying a different alphabet during encoding or decoding, and supply a URI-safe alphabet along with the default Base64 standard. * Add OCaml 4.02 `safe-string` compatibility. * Optionally support encoding without padding. ### 1.0.0 (2014-08-03) * Initial public release. ocaml-base64-3.5.1/LICENSE.md000066400000000000000000000014401436401060000152720ustar00rootroot00000000000000Copyright (c) 2006-2009 Citrix Systems Inc. Copyright (c) 2010 Thomas Gazagnaire Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ocaml-base64-3.5.1/Makefile000066400000000000000000000001221436401060000153220ustar00rootroot00000000000000.PHONY: all test clean all: dune build test: dune runtest clean: dune clean ocaml-base64-3.5.1/README.md000066400000000000000000000013121436401060000151430ustar00rootroot00000000000000Base64 for OCaml ================ Base64 is a group of similar binary-to-text encoding schemes that represent binary data in an ASCII string format by translating it into a radix-64 representation. It is specified in [RFC 4648][rfc4648]. See also [documentation][docs]. [rfc4648]: https://tools.ietf.org/html/rfc4648 [docs]: http://mirage.github.io/ocaml-base64/base64/ ## Example Simple encoding and decoding. ```shell utop # #require "base64";; utop # let enc = Base64.encode_exn "OCaml rocks!";; val enc : string = "T0NhbWwgcm9ja3Mh" utop # let plain = Base64.decode_exn enc;; val plain : string = "OCaml rocks!" ``` ## License [ISC](https://www.isc.org/downloads/software-support-policy/isc-license/) ocaml-base64-3.5.1/base64.opam000066400000000000000000000016711436401060000156360ustar00rootroot00000000000000opam-version: "2.0" maintainer: "mirageos-devel@lists.xenproject.org" authors: [ "Thomas Gazagnaire" "Anil Madhavapeddy" "Calascibetta Romain" "Peter Zotov" ] license: "ISC" homepage: "https://github.com/mirage/ocaml-base64" doc: "https://mirage.github.io/ocaml-base64/" bug-reports: "https://github.com/mirage/ocaml-base64/issues" dev-repo: "git+https://github.com/mirage/ocaml-base64.git" synopsis: "Base64 encoding for OCaml" description: """ Base64 is a group of similar binary-to-text encoding schemes that represent binary data in an ASCII string format by translating it into a radix-64 representation. It is specified in RFC 4648. """ depends: [ "ocaml" {>= "4.03.0"} "dune" {>= "2.0"} "fmt" {with-test & >= "0.8.7"} "bos" {with-test} "rresult" {with-test} "alcotest" {with-test} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] ocaml-base64-3.5.1/bench/000077500000000000000000000000001436401060000147465ustar00rootroot00000000000000ocaml-base64-3.5.1/bench/benchmarks.ml000066400000000000000000000071371436401060000174250ustar00rootroot00000000000000module Old_version = struct let default_alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" let uri_safe_alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_" let padding = '=' let of_char ?(alphabet = default_alphabet) x = if x = padding then 0 else String.index alphabet x let to_char ?(alphabet = default_alphabet) x = alphabet.[x] let decode ?alphabet input = let length = String.length input in let input = if length mod 4 = 0 then input else input ^ String.make (4 - (length mod 4)) padding in let length = String.length input in let words = length / 4 in let padding = match length with | 0 -> 0 | _ when input.[length - 2] = padding -> 2 | _ when input.[length - 1] = padding -> 1 | _ -> 0 in let output = Bytes.make ((words * 3) - padding) '\000' in for i = 0 to words - 1 do let a = of_char ?alphabet input.[(4 * i) + 0] and b = of_char ?alphabet input.[(4 * i) + 1] and c = of_char ?alphabet input.[(4 * i) + 2] and d = of_char ?alphabet input.[(4 * i) + 3] in let n = (a lsl 18) lor (b lsl 12) lor (c lsl 6) lor d in let x = (n lsr 16) land 255 and y = (n lsr 8) land 255 and z = n land 255 in Bytes.set output ((3 * i) + 0) (char_of_int x) ; if i <> words - 1 || padding < 2 then Bytes.set output ((3 * i) + 1) (char_of_int y) ; if i <> words - 1 || padding < 1 then Bytes.set output ((3 * i) + 2) (char_of_int z) done ; Bytes.unsafe_to_string output let decode_opt ?alphabet input = try Some (decode ?alphabet input) with Not_found -> None let encode ?(pad = true) ?alphabet input = let length = String.length input in let words = (length + 2) / 3 (* rounded up *) in let padding_len = if length mod 3 = 0 then 0 else 3 - (length mod 3) in let output = Bytes.make (words * 4) '\000' in let get i = if i >= length then 0 else int_of_char input.[i] in for i = 0 to words - 1 do let x = get ((3 * i) + 0) and y = get ((3 * i) + 1) and z = get ((3 * i) + 2) in let n = (x lsl 16) lor (y lsl 8) lor z in let a = (n lsr 18) land 63 and b = (n lsr 12) land 63 and c = (n lsr 6) land 63 and d = n land 63 in Bytes.set output ((4 * i) + 0) (to_char ?alphabet a) ; Bytes.set output ((4 * i) + 1) (to_char ?alphabet b) ; Bytes.set output ((4 * i) + 2) (to_char ?alphabet c) ; Bytes.set output ((4 * i) + 3) (to_char ?alphabet d) done ; for i = 1 to padding_len do Bytes.set output (Bytes.length output - i) padding done ; if pad then Bytes.unsafe_to_string output else Bytes.sub_string output 0 (Bytes.length output - padding_len) end let random len = let ic = open_in "/dev/urandom" in let rs = Bytes.create len in really_input ic rs 0 len ; close_in ic ; Bytes.unsafe_to_string rs open Core open Core_bench let b64_encode_and_decode len = let input = random len in Staged.stage @@ fun () -> let encoded = Base64.encode_exn input in let _decoded = Base64.decode_exn encoded in () let old_encode_and_decode len = let input = random len in Staged.stage @@ fun () -> let encoded = Old_version.encode input in let _decoded = Old_version.decode encoded in () let args = [ 0; 10; 50; 100; 500; 1000; 2500; 5000 ] let test_b64 = Bench.Test.create_indexed ~name:"Base64" ~args b64_encode_and_decode let test_old = Bench.Test.create_indexed ~name:"Old" ~args old_encode_and_decode let command = Bench.make_command [ test_b64; test_old ] let () = Command.run command ocaml-base64-3.5.1/bench/dune000066400000000000000000000001501436401060000156200ustar00rootroot00000000000000(executable (name benchmarks) (enabled_if (= %{profile} benchmark)) (libraries base64 core_bench)) ocaml-base64-3.5.1/config/000077500000000000000000000000001436401060000151345ustar00rootroot00000000000000ocaml-base64-3.5.1/config/config.ml000066400000000000000000000003431436401060000167330ustar00rootroot00000000000000let parse s = Scanf.sscanf s "%d.%d" (fun major minor -> (major, minor)) let () = let version = parse Sys.ocaml_version in if version >= (4, 7) then print_string "unsafe_stable.ml" else print_string "unsafe_pre407.ml" ocaml-base64-3.5.1/config/dune000066400000000000000000000001371436401060000160130ustar00rootroot00000000000000(executable (name config)) (rule (with-stdout-to which-unsafe-file (run ./config.exe))) ocaml-base64-3.5.1/dune-project000066400000000000000000000000361436401060000162100ustar00rootroot00000000000000(lang dune 2.3) (name base64) ocaml-base64-3.5.1/fuzz/000077500000000000000000000000001436401060000146655ustar00rootroot00000000000000ocaml-base64-3.5.1/fuzz/dune000066400000000000000000000004251436401060000155440ustar00rootroot00000000000000(executable (name fuzz_rfc2045) (enabled_if (= %{profile} fuzz)) (modules fuzz_rfc2045) (libraries astring crowbar fmt base64.rfc2045)) (executable (name fuzz_rfc4648) (enabled_if (= %{profile} fuzz)) (modules fuzz_rfc4648) (libraries astring crowbar fmt base64)) ocaml-base64-3.5.1/fuzz/fuzz_rfc2045.ml000066400000000000000000000112611436401060000173630ustar00rootroot00000000000000open Crowbar exception Encode_error of string exception Decode_error of string (** Pretty printers *) let register_printer () = Printexc.register_printer (function | Encode_error err -> Some (Fmt.str "(Encoding error: %s)" err) | Decode_error err -> Some (Fmt.str "(Decoding error: %s)" err) | _ -> None) let pp_chr = let escaped = function ' ' .. '~' as c -> String.make 1 c | _ -> "." in Fmt.using escaped Fmt.string let pp_scalar : type buffer. get:(buffer -> int -> char) -> length:(buffer -> int) -> buffer Fmt.t = fun ~get ~length ppf b -> let l = length b in for i = 0 to l / 16 do Fmt.pf ppf "%08x: " (i * 16) ; let j = ref 0 in while !j < 16 do if (i * 16) + !j < l then Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j)) else Fmt.pf ppf " " ; if !j mod 2 <> 0 then Fmt.pf ppf " " ; incr j done ; Fmt.pf ppf " " ; j := 0 ; while !j < 16 do if (i * 16) + !j < l then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j)) else Fmt.pf ppf " " ; incr j done ; Fmt.pf ppf "@\n" done let pp = pp_scalar ~get:String.get ~length:String.length (** Encoding and decoding *) let check_encode str = let subs = Astring.String.cuts ~sep:"\r\n" str in let check str = if String.length str > 78 then raise (Encode_error "too long string returned") in List.iter check subs ; str let encode input = let buf = Buffer.create 80 in let encoder = Base64_rfc2045.encoder (`Buffer buf) in String.iter (fun c -> let ret = Base64_rfc2045.encode encoder (`Char c) in match ret with `Ok -> () | _ -> assert false) (* XXX(dinosaure): [`Partial] can never occur. *) input ; let encode = Base64_rfc2045.encode encoder `End in match encode with | `Ok -> Buffer.contents buf |> check_encode | _ -> (* XXX(dinosaure): [`Partial] can never occur. *) assert false let decode input = let decoder = Base64_rfc2045.decoder (`String input) in let rec go acc = if Base64_rfc2045.decoder_dangerous decoder then raise (Decode_error "Dangerous input") ; match Base64_rfc2045.decode decoder with | `End -> List.rev acc | `Flush output -> go (output :: acc) | `Malformed _ -> raise (Decode_error "Malformed") | `Wrong_padding -> raise (Decode_error "Wrong padding") | _ -> (* XXX(dinosaure): [`Await] can never occur. *) assert false in String.concat "" (go []) (** String generators *) let bytes_fixed_range : string gen = dynamic_bind (range 78) bytes_fixed let char_from_alpha alpha : string gen = map [ range (String.length alpha) ] (fun i -> alpha.[i] |> String.make 1) let string_from_alpha n = let acc = const "" in let alpha = Base64_rfc2045.default_alphabet in let rec add_char_from_alpha alpha acc = function | 0 -> acc | n -> add_char_from_alpha alpha (concat_gen_list (const "") [ acc; char_from_alpha alpha ]) (n - 1) in add_char_from_alpha alpha acc n let random_string_from_alpha n = dynamic_bind (range n) string_from_alpha let bytes_fixed_range_from_alpha : string gen = dynamic_bind (range 78) bytes_fixed let set_canonic str = let l = String.length str in let to_drop = l * 6 mod 8 in if to_drop = 6 (* XXX(clecat): Case when we need to drop 6 bits which means a whole letter *) then String.sub str 0 (l - 1) else if to_drop <> 0 (* XXX(clecat): Case when we need to drop 2 or 4 bits: we apply a mask droping the bits *) then ( let buf = Bytes.of_string str in let value = String.index Base64_rfc2045.default_alphabet (Bytes.get buf (l - 1)) in let canonic = Base64_rfc2045.default_alphabet.[value land lnot ((1 lsl to_drop) - 1)] in Bytes.set buf (l - 1) canonic ; Bytes.unsafe_to_string buf) else str let add_padding str = let str = set_canonic str in let str = str ^ "===" in String.sub str 0 (String.length str / 4 * 4) (** Tests *) let e2d inputs = let input = String.concat "\r\n" inputs in let encode = encode input in let decode = decode encode in check_eq ~pp ~cmp:String.compare ~eq:String.equal input decode let d2e inputs end_input = let end_input = add_padding end_input in let inputs = inputs @ [ end_input ] in let input = List.fold_left (fun acc s -> if String.length s <> 0 then acc ^ "\r\n" ^ s else acc) (List.hd inputs) (List.tl inputs) in let decode = decode input in let encode = encode decode in check_eq ~pp ~cmp:String.compare ~eq:String.equal input encode let () = register_printer () ; add_test ~name:"rfc2045: encode -> decode" [ list bytes_fixed_range ] e2d ; add_test ~name:"rfc2045: decode -> encode" [ list (string_from_alpha 76); random_string_from_alpha 76 ] d2e ocaml-base64-3.5.1/fuzz/fuzz_rfc4648.ml000066400000000000000000000132341436401060000174000ustar00rootroot00000000000000open Crowbar let pp_chr = let escaped = function ' ' .. '~' as c -> String.make 1 c | _ -> "." in Fmt.using escaped Fmt.string let pp_scalar : type buffer. get:(buffer -> int -> char) -> length:(buffer -> int) -> buffer Fmt.t = fun ~get ~length ppf b -> let l = length b in for i = 0 to l / 16 do Fmt.pf ppf "%08x: " (i * 16) ; let j = ref 0 in while !j < 16 do if (i * 16) + !j < l then Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j)) else Fmt.pf ppf " " ; if !j mod 2 <> 0 then Fmt.pf ppf " " ; incr j done ; Fmt.pf ppf " " ; j := 0 ; while !j < 16 do if (i * 16) + !j < l then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j)) else Fmt.pf ppf " " ; incr j done ; Fmt.pf ppf "@\n" done let pp = pp_scalar ~get:String.get ~length:String.length let ( <.> ) f g x = f (g x) let char_from_alphabet alphabet : string gen = map [ range 64 ] (String.make 1 <.> String.get (Base64.alphabet alphabet)) let random_string_from_alphabet alphabet len : string gen = let rec add_char_from_alphabet acc = function | 0 -> acc | n -> add_char_from_alphabet (concat_gen_list (const "") [ acc; char_from_alphabet alphabet ]) (n - 1) in add_char_from_alphabet (const "") len let random_string_from_alphabet ~max alphabet = dynamic_bind (range max) @@ fun real_len -> dynamic_bind (random_string_from_alphabet alphabet real_len) @@ fun input -> if real_len <= 1 then const (input, 0, real_len) else dynamic_bind (range (real_len / 2)) @@ fun off -> map [ range (real_len - off) ] (fun len -> (input, off, len)) let encode_and_decode (input, off, len) = match Base64.encode ~pad:true ~off ~len input with | Error (`Msg err) -> fail err | Ok result -> match Base64.decode ~pad:true result with | Error (`Msg err) -> fail err | Ok result -> check_eq ~pp ~cmp:String.compare ~eq:String.equal result (String.sub input off len) let decode_and_encode (input, off, len) = match Base64.decode ~pad:true ~off ~len input with | Error (`Msg err) -> fail err | Ok result -> match Base64.encode ~pad:true result with | Error (`Msg err) -> fail err | Ok result -> check_eq ~pp:Fmt.string ~cmp:String.compare ~eq:String.equal result (String.sub input off len) let ( // ) x y = if y < 1 then raise Division_by_zero ; if x > 0 then 1 + ((x - 1) / y) else 0 [@@inline] let canonic alphabet = let dmap = Array.make 256 (-1) in String.iteri (fun i x -> dmap.(Char.code x) <- i) (Base64.alphabet alphabet) ; fun (input, off, len) -> let real_len = String.length input in let input_len = len in let normalized_len = input_len // 4 * 4 in if normalized_len = input_len then (input, off, input_len) else if normalized_len - input_len = 3 then (input, off, input_len - 1) else let remainder_len = normalized_len - input_len in let last = input.[off + input_len - 1] in let output = Bytes.make (max real_len (off + normalized_len)) '=' in Bytes.blit_string input 0 output 0 (off + input_len) ; if off + normalized_len < real_len then Bytes.blit_string input (off + normalized_len) output (off + normalized_len) (real_len - (off + normalized_len)) ; let mask = match remainder_len with 1 -> 0x3c | 2 -> 0x30 | _ -> assert false in let decoded = dmap.(Char.code last) in let canonic = decoded land mask in let encoded = (Base64.alphabet alphabet).[canonic] in Bytes.set output (off + input_len - 1) encoded ; (Bytes.unsafe_to_string output, off, normalized_len) let isomorphism0 (input, off, len) = (* x0 = decode(input) && x1 = decode(encode(x0)) && x0 = x1 *) match Base64.decode ~pad:false ~off ~len input with | Error (`Msg err) -> fail err | Ok result0 -> ( let result1 = Base64.encode_exn result0 in match Base64.decode ~pad:true result1 with | Error (`Msg err) -> fail err | Ok result2 -> check_eq ~pp ~cmp:String.compare ~eq:String.equal result0 result2) let isomorphism1 (input, off, len) = let result0 = Base64.encode_exn ~off ~len input in match Base64.decode ~pad:true result0 with | Error (`Msg err) -> fail err | Ok result1 -> let result2 = Base64.encode_exn result1 in check_eq ~pp:Fmt.string ~cmp:String.compare ~eq:String.equal result0 result2 let bytes_and_range : (string * int * int) gen = dynamic_bind bytes @@ fun t -> let real_length = String.length t in if real_length <= 1 then const (t, 0, real_length) else dynamic_bind (range (real_length / 2)) @@ fun off -> map [ range (real_length - off) ] (fun len -> (t, off, len)) let range_of_max max : (int * int) gen = dynamic_bind (range (max / 2)) @@ fun off -> map [ range (max - off) ] (fun len -> (off, len)) let failf fmt = Fmt.kstr fail fmt let no_exception pad off len input = try let _ = Base64.decode ?pad ?off ?len ~alphabet:Base64.default_alphabet input in () with exn -> failf "decode fails with: %s." (Printexc.to_string exn) let () = add_test ~name:"rfc4648: encode -> decode" [ bytes_and_range ] encode_and_decode ; add_test ~name:"rfc4648: decode -> encode" [ random_string_from_alphabet ~max:1000 Base64.default_alphabet ] (decode_and_encode <.> canonic Base64.default_alphabet) ; add_test ~name:"rfc4648: x = decode(encode(x))" [ random_string_from_alphabet ~max:1000 Base64.default_alphabet ] isomorphism0 ; add_test ~name:"rfc4648: x = encode(decode(x))" [ bytes_and_range ] isomorphism1 ; add_test ~name:"rfc4648: no exception leak" [ option bool; option int; option int; bytes ] no_exception ocaml-base64-3.5.1/src/000077500000000000000000000000001436401060000144565ustar00rootroot00000000000000ocaml-base64-3.5.1/src/base64.ml000066400000000000000000000246031436401060000161010ustar00rootroot00000000000000(* * Copyright (c) 2006-2009 Citrix Systems Inc. * Copyright (c) 2010 Thomas Gazagnaire * Copyright (c) 2014-2016 Anil Madhavapeddy * Copyright (c) 2016 David Kaloper Meršinjak * Copyright (c) 2018 Romain Calascibetta * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) type alphabet = { emap : int array; dmap : int array } type sub = string * int * int let ( // ) x y = if y < 1 then raise Division_by_zero ; if x > 0 then 1 + ((x - 1) / y) else 0 [@@inline] let unsafe_get_uint8 t off = Char.code (String.unsafe_get t off) let unsafe_set_uint8 t off v = Bytes.unsafe_set t off (Char.chr v) let unsafe_set_uint16 = Unsafe.unsafe_set_uint16 external unsafe_get_uint16 : string -> int -> int = "%caml_string_get16u" [@@noalloc] external swap16 : int -> int = "%bswap16" [@@noalloc] let none = -1 (* We mostly want to have an optional array for [dmap] (e.g. [int option array]). So we consider the [none] value as [-1]. *) let make_alphabet alphabet = if String.length alphabet <> 64 then invalid_arg "Length of alphabet must be 64" ; if String.contains alphabet '=' then invalid_arg "Alphabet can not contain padding character" ; let emap = Array.init (String.length alphabet) (fun i -> Char.code alphabet.[i]) in let dmap = Array.make 256 none in String.iteri (fun idx chr -> dmap.(Char.code chr) <- idx) alphabet ; { emap; dmap } let length_alphabet { emap; _ } = Array.length emap let alphabet { emap; _ } = String.init (Array.length emap) (fun i -> Char.chr emap.(i)) let default_alphabet = make_alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" let uri_safe_alphabet = make_alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_" let unsafe_set_be_uint16 = if Sys.big_endian then fun t off v -> unsafe_set_uint16 t off v else fun t off v -> unsafe_set_uint16 t off (swap16 v) (* We make this exception to ensure to keep a control about which exception we can raise and avoid appearance of unknown exceptions like an ex-nihilo magic rabbit (or magic money?). *) exception Out_of_bounds exception Too_much_input let get_uint8 t off = if off < 0 || off >= String.length t then raise Out_of_bounds ; unsafe_get_uint8 t off let padding = int_of_char '=' let error_msgf fmt = Format.ksprintf (fun err -> Error (`Msg err)) fmt let encode_sub pad { emap; _ } ?(off = 0) ?len input = let len = match len with Some len -> len | None -> String.length input - off in if len < 0 || off < 0 || off > String.length input - len then error_msgf "Invalid bounds" else let n = len in let n' = n // 3 * 4 in let res = Bytes.create n' in let emap i = Array.unsafe_get emap i in let emit b1 b2 b3 i = unsafe_set_be_uint16 res i ((emap ((b1 lsr 2) land 0x3f) lsl 8) lor emap ((b1 lsl 4) lor (b2 lsr 4) land 0x3f)) ; unsafe_set_be_uint16 res (i + 2) ((emap ((b2 lsl 2) lor (b3 lsr 6) land 0x3f) lsl 8) lor emap (b3 land 0x3f)) in let rec enc j i = if i = n then () else if i = n - 1 then emit (unsafe_get_uint8 input (off + i)) 0 0 j else if i = n - 2 then emit (unsafe_get_uint8 input (off + i)) (unsafe_get_uint8 input (off + i + 1)) 0 j else ( emit (unsafe_get_uint8 input (off + i)) (unsafe_get_uint8 input (off + i + 1)) (unsafe_get_uint8 input (off + i + 2)) j ; enc (j + 4) (i + 3)) in let rec unsafe_fix = function | 0 -> () | i -> unsafe_set_uint8 res (n' - i) padding ; unsafe_fix (i - 1) in enc 0 0 ; let pad_to_write = (3 - (n mod 3)) mod 3 in if pad then ( unsafe_fix pad_to_write ; Ok (Bytes.unsafe_to_string res, 0, n')) else Ok (Bytes.unsafe_to_string res, 0, n' - pad_to_write) (* [pad = false], we don't want to write them. *) let encode ?(pad = true) ?(alphabet = default_alphabet) ?off ?len input = match encode_sub pad alphabet ?off ?len input with | Ok (res, off, len) -> Ok (String.sub res off len) | Error _ as err -> err let encode_string ?pad ?alphabet input = match encode ?pad ?alphabet input with | Ok res -> res | Error _ -> assert false let encode_sub ?(pad = true) ?(alphabet = default_alphabet) ?off ?len input = encode_sub pad alphabet ?off ?len input let encode_exn ?pad ?alphabet ?off ?len input = match encode ?pad ?alphabet ?off ?len input with | Ok v -> v | Error (`Msg err) -> invalid_arg err let decode_sub ?(pad = true) { dmap; _ } ?(off = 0) ?len input = let len = match len with Some len -> len | None -> String.length input - off in if len < 0 || off < 0 || off > String.length input - len then error_msgf "Invalid bounds" else let n = len // 4 * 4 in let n' = n // 4 * 3 in let res = Bytes.create n' in let invalid_pad_overflow = pad in let get_uint8_or_padding = if pad then (fun t i -> if i >= len then raise Out_of_bounds ; get_uint8 t (off + i)) else fun t i -> try if i < len then get_uint8 t (off + i) else padding with Out_of_bounds -> padding in let set_be_uint16 t off v = (* can not write 2 bytes. *) if off < 0 || off + 1 > Bytes.length t then () (* can not write 1 byte but can write 1 byte *) else if off < 0 || off + 2 > Bytes.length t then unsafe_set_uint8 t off (v lsr 8) (* can write 2 bytes. *) else unsafe_set_be_uint16 t off v in let set_uint8 t off v = if off < 0 || off >= Bytes.length t then () else unsafe_set_uint8 t off v in let emit a b c d j = let x = (a lsl 18) lor (b lsl 12) lor (c lsl 6) lor d in set_be_uint16 res j (x lsr 8) ; set_uint8 res (j + 2) (x land 0xff) in let dmap i = let x = Array.unsafe_get dmap i in if x = none then raise Not_found ; x in let only_padding pad idx = (* because we round length of [res] to the upper bound of how many characters we should have from [input], we got at this stage only padding characters and we need to delete them, so for each [====], we delete 3 bytes. *) let pad = ref (pad + 3) in let idx = ref idx in while !idx + 4 < len do (* use [unsafe_get_uint16] instead [unsafe_get_uint32] to avoid allocation of [int32]. Of course, [3d3d3d3d] is [====]. *) if unsafe_get_uint16 input (off + !idx) <> 0x3d3d || unsafe_get_uint16 input (off + !idx + 2) <> 0x3d3d then raise Not_found ; (* We got something bad, should be a valid character according to [alphabet] but outside the scope. *) idx := !idx + 4 ; pad := !pad + 3 done ; while !idx < len do if unsafe_get_uint8 input (off + !idx) <> padding then raise Not_found ; incr idx done ; !pad in let rec dec j i = if i = n then 0 else let d, pad = let x = get_uint8_or_padding input (i + 3) in try (dmap x, 0) with Not_found when x = padding -> (0, 1) in (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *) let c, pad = let x = get_uint8_or_padding input (i + 2) in try (dmap x, pad) with Not_found when x = padding && pad = 1 -> (0, 2) in (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *) let b, pad = let x = get_uint8_or_padding input (i + 1) in try (dmap x, pad) with Not_found when x = padding && pad = 2 -> (0, 3) in (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *) let a, pad = let x = get_uint8_or_padding input i in try (dmap x, pad) with Not_found when x = padding && pad = 3 -> (0, 4) in (* [Not_found] iff [x ∉ alphabet and x <> '='] can leak. *) emit a b c d j ; if i + 4 = n (* end of input in anyway *) then match pad with | 0 -> 0 | 4 -> (* assert (invalid_pad_overflow = false) ; *) 3 (* [get_uint8] lies and if we get [4], that mean we got one or more (at most 4) padding character. In this situation, because we round length of [res] (see [n // 4]), we need to delete 3 bytes. *) | pad -> pad else match pad with | 0 -> dec (j + 3) (i + 4) | 4 -> (* assert (invalid_pad_overflow = false) ; *) only_padding 3 (i + 4) (* Same situation than above but we should get only more padding characters then. *) | pad -> if invalid_pad_overflow = true then raise Too_much_input ; only_padding pad (i + 4) in match dec 0 0 with | 0 -> Ok (Bytes.unsafe_to_string res, 0, n') | pad -> Ok (Bytes.unsafe_to_string res, 0, n' - pad) | exception Out_of_bounds -> error_msgf "Wrong padding" (* appear only when [pad = true] and when length of input is not a multiple of 4. *) | exception Not_found -> (* appear when one character of [input] ∉ [alphabet] and this character <> '=' *) error_msgf "Malformed input" | exception Too_much_input -> error_msgf "Too much input" let decode ?pad ?(alphabet = default_alphabet) ?off ?len input = match decode_sub ?pad alphabet ?off ?len input with | Ok (res, off, len) -> Ok (String.sub res off len) | Error _ as err -> err let decode_sub ?pad ?(alphabet = default_alphabet) ?off ?len input = decode_sub ?pad alphabet ?off ?len input let decode_exn ?pad ?alphabet ?off ?len input = match decode ?pad ?alphabet ?off ?len input with | Ok res -> res | Error (`Msg err) -> invalid_arg err ocaml-base64-3.5.1/src/base64.mli000066400000000000000000000104711436401060000162500ustar00rootroot00000000000000(* * Copyright (c) 2006-2009 Citrix Systems Inc. * Copyright (c) 2010 Thomas Gazagnaire * Copyright (c) 2014-2016 Anil Madhavapeddy * Copyright (c) 2018 Romain Calascibetta * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** Base64 RFC4648 implementation. Base64 is a group of similar binary-to-text encoding schemes that represent binary data in an ASCII string format by translating it into a radix-64 representation. It is specified in RFC 4648. {e Release %%VERSION%% - %%PKG_HOMEPAGE%%} *) type alphabet (** Type of alphabet. *) type sub = string * int * int (** Type of sub-string: [str, off, len]. *) val default_alphabet : alphabet (** A 64-character alphabet specifying the regular Base64 alphabet. *) val uri_safe_alphabet : alphabet (** A 64-character alphabet specifying the URI- and filename-safe Base64 alphabet. *) val make_alphabet : string -> alphabet (** Make a new alphabet. *) val length_alphabet : alphabet -> int (** Returns length of the alphabet, should be 64. *) val alphabet : alphabet -> string (** Returns the alphabet. *) val decode_exn : ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> string (** [decode_exn ?off ?len s] decodes [len] bytes (defaults to [String.length s - off]) of the string [s] starting from [off] (defaults to [0]) that is encoded in Base64 format. Will leave trailing NULLs on the string, padding it out to a multiple of 3 characters. [alphabet] defaults to {!default_alphabet}. [pad = true] specifies to check if [s] is padded or not, otherwise, it raises an exception. Decoder can fail when character of [s] is not a part of [alphabet] or is not [padding] character. If input is not padded correctly, decoder does the best-effort but it does not ensure [decode_exn (encode ~pad:false x) = x]. @raise if Invalid_argument [s] is not a valid Base64 string. *) val decode_sub : ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> (sub, [> `Msg of string ]) result (** Same as {!decode_exn} but it returns a result type instead to raise an exception. Then, it returns a {!sub} string. Decoded input [(str, off, len)] will starting to [off] and will have [len] bytes - by this way, we ensure to allocate only one time result. *) val decode : ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> (string, [> `Msg of string ]) result (** Same as {!decode_exn}, but returns an explicit error message {!result} if it fails. *) val encode : ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> (string, [> `Msg of string ]) result (** [encode s] encodes the string [s] into base64. If [pad] is false, no trailing padding is added. [pad] defaults to [true], and [alphabet] to {!default_alphabet}. [encode] fails when [off] and [len] do not designate a valid range of [s]. *) val encode_string : ?pad:bool -> ?alphabet:alphabet -> string -> string (** [encode_string s] encodes the string [s] into base64. If [pad] is false, no trailing padding is added. [pad] defaults to [true], and [alphabet] to {!default_alphabet}. *) val encode_sub : ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> (sub, [> `Msg of string ]) result (** Same as {!encode} but return a {!sub}-string instead a plain result. By this way, we ensure to allocate only one time result. *) val encode_exn : ?pad:bool -> ?alphabet:alphabet -> ?off:int -> ?len:int -> string -> string (** Same as {!encode} but raises an invalid argument exception if we retrieve an error. *) ocaml-base64-3.5.1/src/base64_rfc2045.ml000066400000000000000000000356401436401060000172510ustar00rootroot00000000000000(* * Copyright (c) 2018 Romain Calascibetta * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) let default_alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" let io_buffer_size = 65536 let invalid_arg fmt = Format.ksprintf (fun s -> invalid_arg s) fmt let invalid_bounds off len = invalid_arg "Invalid bounds (off: %d, len: %d)" off len let malformed chr = `Malformed (String.make 1 chr) let unsafe_byte source off pos = Bytes.unsafe_get source (off + pos) let unsafe_blit = Bytes.unsafe_blit let unsafe_chr = Char.unsafe_chr let unsafe_set_chr source off chr = Bytes.unsafe_set source off chr type state = { quantum : int; size : int; buffer : Bytes.t } let continue state (quantum, size) = `Continue { state with quantum; size } let flush state = `Flush { state with quantum = 0; size = 0 } let table = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\062\255\255\255\063\052\053\054\055\056\057\058\059\060\061\255\255\255\255\255\255\255\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015\016\017\018\019\020\021\022\023\024\025\255\255\255\255\255\255\026\027\028\029\030\031\032\033\034\035\036\037\038\039\040\041\042\043\044\045\046\047\048\049\050\051\255\255\255\255\255" let r_repr ({ quantum; size; _ } as state) chr = (* assert (0 <= off && 0 <= len && off + len <= String.length source); *) (* assert (len >= 1); *) let code = Char.code table.[Char.code chr] in match size with | 0 -> continue state (code, 1) | 1 -> continue state ((quantum lsl 6) lor code, 2) | 2 -> continue state ((quantum lsl 6) lor code, 3) | 3 -> unsafe_set_chr state.buffer 0 (unsafe_chr ((quantum lsr 10) land 255)) ; unsafe_set_chr state.buffer 1 (unsafe_chr ((quantum lsr 2) land 255)) ; unsafe_set_chr state.buffer 2 (unsafe_chr ((quantum lsl 6) lor code land 255)) ; flush state | _ -> malformed chr type src = [ `Channel of in_channel | `String of string | `Manual ] type decode = [ `Await | `End | `Wrong_padding | `Malformed of string | `Flush of string ] type input = [ `Line_break | `Wsp | `Padding | `Malformed of string | `Flush of state ] type decoder = { src : src; mutable i : Bytes.t; mutable i_off : int; mutable i_pos : int; mutable i_len : int; mutable s : state; mutable padding : int; mutable unsafe : bool; mutable byte_count : int; mutable limit_count : int; mutable pp : decoder -> input -> decode; mutable k : decoder -> decode; } let i_rem decoder = decoder.i_len - decoder.i_pos + 1 let end_of_input decoder = decoder.i <- Bytes.empty ; decoder.i_off <- 0 ; decoder.i_pos <- 0 ; decoder.i_len <- min_int let src decoder source off len = if off < 0 || len < 0 || off + len > Bytes.length source then invalid_bounds off len else if len = 0 then end_of_input decoder else ( decoder.i <- source ; decoder.i_off <- off ; decoder.i_pos <- 0 ; decoder.i_len <- len - 1) let refill k decoder = match decoder.src with | `Manual -> decoder.k <- k ; `Await | `String _ -> end_of_input decoder ; k decoder | `Channel ic -> let len = input ic decoder.i 0 (Bytes.length decoder.i) in src decoder decoder.i 0 len ; k decoder let dangerous decoder v = decoder.unsafe <- v let reset decoder = decoder.limit_count <- 0 let ret k v byte_count decoder = decoder.k <- k ; decoder.byte_count <- decoder.byte_count + byte_count ; decoder.limit_count <- decoder.limit_count + byte_count ; if decoder.limit_count > 78 then dangerous decoder true ; decoder.pp decoder v type flush_and_malformed = [ `Flush of state | `Malformed of string ] let padding { size; _ } padding = match (size, padding) with | 0, 0 -> true | 1, _ -> false | 2, 2 -> true | 3, 1 -> true | _ -> false let t_flush { quantum; size; buffer } = match size with | 0 | 1 -> `Flush { quantum; size; buffer = Bytes.empty } | 2 -> let quantum = quantum lsr 4 in `Flush { quantum; size; buffer = Bytes.make 1 (unsafe_chr (quantum land 255)) } | 3 -> let quantum = quantum lsr 2 in unsafe_set_chr buffer 0 (unsafe_chr ((quantum lsr 8) land 255)) ; unsafe_set_chr buffer 1 (unsafe_chr (quantum land 255)) ; `Flush { quantum; size; buffer = Bytes.sub buffer 0 2 } | _ -> assert false (* this branch is impossible, size can only ever be in the range [0..3]. *) let wrong_padding decoder = let k _ = `End in decoder.k <- k ; `Wrong_padding let rec t_decode_base64 chr decoder = if decoder.padding = 0 then let rec go pos = function | `Continue state -> if decoder.i_len - (decoder.i_pos + pos) + 1 > 0 then ( match unsafe_byte decoder.i decoder.i_off (decoder.i_pos + pos) with | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '+' | '/') as chr -> go (succ pos) (r_repr state chr) | '=' -> decoder.padding <- decoder.padding + 1 ; decoder.i_pos <- decoder.i_pos + pos + 1 ; decoder.s <- state ; ret decode_base64 `Padding (pos + 1) decoder | ' ' | '\t' -> decoder.i_pos <- decoder.i_pos + pos + 1 ; decoder.s <- state ; ret decode_base64 `Wsp (pos + 1) decoder | '\r' -> decoder.i_pos <- decoder.i_pos + pos + 1 ; decoder.s <- state ; decode_base64_lf_after_cr decoder | chr -> decoder.i_pos <- decoder.i_pos + pos + 1 ; decoder.s <- state ; ret decode_base64 (malformed chr) (pos + 1) decoder) else ( decoder.i_pos <- decoder.i_pos + pos ; decoder.byte_count <- decoder.byte_count + pos ; decoder.limit_count <- decoder.limit_count + pos ; decoder.s <- state ; refill decode_base64 decoder) | #flush_and_malformed as v -> decoder.i_pos <- decoder.i_pos + pos ; ret decode_base64 v pos decoder in go 1 (r_repr decoder.s chr) else ( decoder.i_pos <- decoder.i_pos + 1 ; ret decode_base64 (malformed chr) 1 decoder) and decode_base64_lf_after_cr decoder = let rem = i_rem decoder in if rem < 0 then ret decode_base64 (malformed '\r') 1 decoder else if rem = 0 then refill decode_base64_lf_after_cr decoder else match unsafe_byte decoder.i decoder.i_off decoder.i_pos with | '\n' -> decoder.i_pos <- decoder.i_pos + 1 ; ret decode_base64 `Line_break 2 decoder | _ -> ret decode_base64 (malformed '\r') 1 decoder and decode_base64 decoder = let rem = i_rem decoder in if rem <= 0 then if rem < 0 then ret (fun decoder -> if padding decoder.s decoder.padding then `End else wrong_padding decoder) (t_flush decoder.s) 0 decoder else refill decode_base64 decoder else match unsafe_byte decoder.i decoder.i_off decoder.i_pos with | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '+' | '/') as chr -> t_decode_base64 chr decoder | '=' -> decoder.padding <- decoder.padding + 1 ; decoder.i_pos <- decoder.i_pos + 1 ; ret decode_base64 `Padding 1 decoder | ' ' | '\t' -> decoder.i_pos <- decoder.i_pos + 1 ; ret decode_base64 `Wsp 1 decoder | '\r' -> decoder.i_pos <- decoder.i_pos + 1 ; decode_base64_lf_after_cr decoder | chr -> decoder.i_pos <- decoder.i_pos + 1 ; ret decode_base64 (malformed chr) 1 decoder let pp_base64 decoder = function | `Line_break -> reset decoder ; decoder.k decoder | `Wsp | `Padding -> decoder.k decoder | `Flush state -> decoder.s <- state ; `Flush (Bytes.to_string state.buffer) | `Malformed _ as v -> v let decoder src = let pp = pp_base64 in let k = decode_base64 in let i, i_off, i_pos, i_len = match src with | `Manual -> (Bytes.empty, 0, 1, 0) | `Channel _ -> (Bytes.create io_buffer_size, 0, 1, 0) | `String s -> (Bytes.unsafe_of_string s, 0, 0, String.length s - 1) in { src; i_off; i_pos; i_len; i; s = { quantum = 0; size = 0; buffer = Bytes.create 3 }; padding = 0; unsafe = false; byte_count = 0; limit_count = 0; pp; k; } let decode decoder = decoder.k decoder let decoder_byte_count decoder = decoder.byte_count let decoder_src decoder = decoder.src let decoder_dangerous decoder = decoder.unsafe (* / *) let invalid_encode () = invalid_arg "Expected `Await encode" type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ] type encode = [ `Await | `End | `Char of char ] type encoder = { dst : dst; mutable o : Bytes.t; mutable o_off : int; mutable o_pos : int; mutable o_len : int; mutable c_col : int; i : Bytes.t; mutable s : int; t : Bytes.t; mutable t_pos : int; mutable t_len : int; mutable k : encoder -> encode -> [ `Ok | `Partial ]; } let o_rem encoder = encoder.o_len - encoder.o_pos + 1 let dst encoder source off len = if off < 0 || len < 0 || off + len > Bytes.length source then invalid_bounds off len ; encoder.o <- source ; encoder.o_off <- off ; encoder.o_pos <- 0 ; encoder.o_len <- len - 1 let dst_rem = o_rem let partial k encoder = function | `Await -> k encoder | `Char _ | `End -> invalid_encode () let flush k encoder = match encoder.dst with | `Manual -> encoder.k <- partial k ; `Partial | `Channel oc -> output oc encoder.o encoder.o_off encoder.o_pos ; encoder.o_pos <- 0 ; k encoder | `Buffer b -> let o = Bytes.unsafe_to_string encoder.o in Buffer.add_substring b o encoder.o_off encoder.o_pos ; encoder.o_pos <- 0 ; k encoder let t_range encoder len = encoder.t_pos <- 0 ; encoder.t_len <- len let rec t_flush k encoder = let blit encoder len = unsafe_blit encoder.t encoder.t_pos encoder.o encoder.o_pos len ; encoder.o_pos <- encoder.o_pos + len ; encoder.t_pos <- encoder.t_pos + len in let rem = o_rem encoder in let len = encoder.t_len - encoder.t_pos + 1 in if rem < len then ( blit encoder rem ; flush (t_flush k) encoder) else ( blit encoder len ; k encoder) let rec encode_line_break k encoder = let rem = o_rem encoder in let s, j, k = if rem < 2 then ( t_range encoder 2 ; (encoder.t, 0, t_flush k)) else let j = encoder.o_pos in encoder.o_pos <- encoder.o_pos + 2 ; (encoder.o, encoder.o_off + j, k) in unsafe_set_chr s j '\r' ; unsafe_set_chr s (j + 1) '\n' ; encoder.c_col <- 0 ; k encoder and encode_char chr k (encoder : encoder) = if encoder.s >= 2 then ( let a, b, c = (unsafe_byte encoder.i 0 0, unsafe_byte encoder.i 0 1, chr) in encoder.s <- 0 ; let quantum = (Char.code a lsl 16) + (Char.code b lsl 8) + Char.code c in let a = quantum lsr 18 in let b = (quantum lsr 12) land 63 in let c = (quantum lsr 6) land 63 in let d = quantum land 63 in let rem = o_rem encoder in let s, j, k = if rem < 4 then ( t_range encoder 4 ; (encoder.t, 0, t_flush (k 4))) else let j = encoder.o_pos in encoder.o_pos <- encoder.o_pos + 4 ; (encoder.o, encoder.o_off + j, k 4) in unsafe_set_chr s j default_alphabet.[a] ; unsafe_set_chr s (j + 1) default_alphabet.[b] ; unsafe_set_chr s (j + 2) default_alphabet.[c] ; unsafe_set_chr s (j + 3) default_alphabet.[d] ; flush k encoder) else ( unsafe_set_chr encoder.i encoder.s chr ; encoder.s <- encoder.s + 1 ; k 0 encoder) and encode_trailing k encoder = match encoder.s with | 2 -> let b, c = (unsafe_byte encoder.i 0 0, unsafe_byte encoder.i 0 1) in encoder.s <- 0 ; let quantum = (Char.code b lsl 10) + (Char.code c lsl 2) in let b = (quantum lsr 12) land 63 in let c = (quantum lsr 6) land 63 in let d = quantum land 63 in let rem = o_rem encoder in let s, j, k = if rem < 4 then ( t_range encoder 4 ; (encoder.t, 0, t_flush (k 4))) else let j = encoder.o_pos in encoder.o_pos <- encoder.o_pos + 4 ; (encoder.o, encoder.o_off + j, k 4) in unsafe_set_chr s j default_alphabet.[b] ; unsafe_set_chr s (j + 1) default_alphabet.[c] ; unsafe_set_chr s (j + 2) default_alphabet.[d] ; unsafe_set_chr s (j + 3) '=' ; flush k encoder | 1 -> let c = unsafe_byte encoder.i 0 0 in encoder.s <- 0 ; let quantum = Char.code c lsl 4 in let c = (quantum lsr 6) land 63 in let d = quantum land 63 in let rem = o_rem encoder in let s, j, k = if rem < 4 then ( t_range encoder 4 ; (encoder.t, 0, t_flush (k 4))) else let j = encoder.o_pos in encoder.o_pos <- encoder.o_pos + 4 ; (encoder.o, encoder.o_off + j, k 4) in unsafe_set_chr s j default_alphabet.[c] ; unsafe_set_chr s (j + 1) default_alphabet.[d] ; unsafe_set_chr s (j + 2) '=' ; unsafe_set_chr s (j + 3) '=' ; flush k encoder | 0 -> k 0 encoder | _ -> assert false and encode_base64 encoder v = let k col_count encoder = encoder.c_col <- encoder.c_col + col_count ; encoder.k <- encode_base64 ; `Ok in match v with | `Await -> k 0 encoder | `End -> if encoder.c_col = 76 then encode_line_break (fun encoder -> encode_base64 encoder v) encoder else encode_trailing k encoder | `Char chr -> let rem = o_rem encoder in if rem < 1 then flush (fun encoder -> encode_base64 encoder v) encoder else if encoder.c_col = 76 then encode_line_break (fun encoder -> encode_base64 encoder v) encoder else encode_char chr k encoder let encoder dst = let o, o_off, o_pos, o_len = match dst with | `Manual -> (Bytes.empty, 1, 0, 0) | `Buffer _ | `Channel _ -> (Bytes.create io_buffer_size, 0, 0, io_buffer_size - 1) in { dst; o_off; o_pos; o_len; o; t = Bytes.create 4; t_pos = 1; t_len = 0; c_col = 0; i = Bytes.create 3; s = 0; k = encode_base64; } let encode encoder = encoder.k encoder let encoder_dst encoder = encoder.dst ocaml-base64-3.5.1/src/base64_rfc2045.mli000066400000000000000000000111651436401060000174160ustar00rootroot00000000000000(* * Copyright (c) 2014-2016 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** Decode *) val default_alphabet : string (** A 64-character string specifying the regular Base64 alphabet. *) type decoder (** The type for decoders. *) type src = [ `Manual | `Channel of in_channel | `String of string ] (** The type for input sources. With a [`Manual] source the client must provide input with {!src}. *) type decode = [ `Await | `End | `Flush of string | `Malformed of string | `Wrong_padding ] val src : decoder -> Bytes.t -> int -> int -> unit (** [src d s j l] provides [d] with [l] bytes to read, starting at [j] in [s]. This byte range is read by calls to {!decode} with [d] until [`Await] is returned. To signal the end of input, call the function with [l = 0]. *) val decoder : src -> decoder (** [decoder src] is a decoder that inputs from [src]. *) val decode : decoder -> decode (** [decode d] is: - [`Await] if [d] has a [`Manual] input source and awaits for more input. The client must use {!src} to provide it. - [`End] if the end of input was reached - [`Malformed bytes] if the [bytes] sequence is malformed according to the decoded base64 encoding scheme. If you are interested in a best-effort decoding, you can still continue to decode after an error until the decode synchronizes again on valid bytes. - [`Flush data] if a [data] sequence value was decoded. - [`Wrong_padding] if decoder retrieve a wrong padding at the end of the input. {b Note}. Repeated invocation always eventually returns [`End], even in case of errors. *) val decoder_byte_count : decoder -> int (** [decoder_byte_count d] is the number of characters already decoded on [d] (included malformed ones). This is the last {!decode}'s end output offset counting from beginning of the stream. *) val decoder_src : decoder -> src (** [decoder_src d] is [d]'s input source. *) val decoder_dangerous : decoder -> bool (** [decoder_dangerous d] returns [true] if encoded input does not respect the 80-columns rule. If your are interested in a best-effort decoding you can still continue to decode even if [decoder_dangerous d] returns [true]. Nothing grow automatically internally in this state. *) type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ] (** The type for output destinations. With a [`Manual] destination the client must provide output storage with {!dst}. *) type encode = [ `Await | `End | `Char of char ] type encoder (** The type for Base64 (RFC2045) encoder. *) val encoder : dst -> encoder (** [encoder dst] is an encoder for Base64 (RFC2045) that outputs to [dst]. *) val encode : encoder -> encode -> [ `Ok | `Partial ] (** [encode e v]: is - [`Partial] iff [e] has a [`Manual] destination and needs more output storage. The client must use {!dst} to provide a new buffer and then call {!encode} with [`Await] until [`Ok] is returned. - [`Ok] when the encoder is ready to encode a new [`Char] or [`End] For [`Manual] destination, encoding [`End] always return [`Partial], the client should continue as usual with [`Await] until [`Ok] is returned at which point {!dst_rem} [encoder] is guaranteed to be the size of the last provided buffer (i.e. nothing was written). {b Raises.} [Invalid_argument] if a [`Char] or [`End] is encoded after a [`Partial] encode. *) val encoder_dst : encoder -> dst (** [encoder_dst encoder] is [encoder]'s output destination. *) val dst : encoder -> Bytes.t -> int -> int -> unit (** [dst e s j l] provides [e] with [l] bytes to write, starting at [j] in [s]. This byte range is written by calls to {!encode} with [e] until [`Partial] is returned. Use {!dst_rem} to know the remaining number of non-written free bytes in [s]. *) val dst_rem : encoder -> int (** [dst_rem e] is the remaining number of non-written, free bytes in the last buffer provided with {!dst}. *) ocaml-base64-3.5.1/src/dune000066400000000000000000000003401436401060000153310ustar00rootroot00000000000000(library (name base64) (modules unsafe base64) (public_name base64)) (rule (copy %{read:../config/which-unsafe-file} unsafe.ml)) (library (name base64_rfc2045) (modules base64_rfc2045) (public_name base64.rfc2045)) ocaml-base64-3.5.1/src/unsafe_pre407.ml000066400000000000000000000001371436401060000173730ustar00rootroot00000000000000external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_string_set16u" [@@noalloc] ocaml-base64-3.5.1/src/unsafe_stable.ml000066400000000000000000000001361436401060000176230ustar00rootroot00000000000000external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u" [@@noalloc] ocaml-base64-3.5.1/test/000077500000000000000000000000001436401060000146465ustar00rootroot00000000000000ocaml-base64-3.5.1/test/dune000066400000000000000000000002771436401060000155320ustar00rootroot00000000000000(executable (modes byte exe) (name test) (libraries base64 base64.rfc2045 rresult alcotest bos)) (rule (alias runtest) (deps (:exe test.exe)) (action (run %{exe} --color=always))) ocaml-base64-3.5.1/test/test.ml000066400000000000000000000224521436401060000161640ustar00rootroot00000000000000(* * Copyright (c) 2016 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) open Printf open Rresult (* Test vectors from RFC4648 BASE64("") = "" BASE64("f") = "Zg==" BASE64("fo") = "Zm8=" BASE64("foo") = "Zm9v" BASE64("foob") = "Zm9vYg==" BASE64("fooba") = "Zm9vYmE=" BASE64("foobar") = "Zm9vYmFy" *) let rfc4648_tests = [ ("", ""); ("f", "Zg=="); ("fo", "Zm8="); ("foo", "Zm9v"); ("foob", "Zm9vYg=="); ("fooba", "Zm9vYmE="); ("foobar", "Zm9vYmFy"); ] let hannes_tests = [ ("dummy", "ZHVtbXk="); ("dummy", "ZHVtbXk"); ("dummy", "ZHVtbXk=="); ("dummy", "ZHVtbXk==="); ("dummy", "ZHVtbXk===="); ("dummy", "ZHVtbXk====="); ("dummy", "ZHVtbXk======"); ] let php_tests = [ ( "πάντα χωρεῖ καὶ οὐδὲν μένει …", "z4DOrM69z4TOsSDPh8-Jz4HOteG_liDOus6x4b22IM6_4b2QzrThvbLOvSDOvM6tzr3Otc65IOKApg" ); ] let rfc3548_tests = [ ("\x14\xfb\x9c\x03\xd9\x7e", "FPucA9l+"); ("\x14\xfb\x9c\x03\xd9", "FPucA9k="); ("\x14\xfb\x9c\x03", "FPucAw=="); ] let cfcs_tests = [ (0, 2, "\004", "BB"); (1, 2, "\004", "ABB"); (1, 2, "\004", "ABBA"); (2, 2, "\004", "AABBA"); (2, 2, "\004", "AABBAA"); (0, 0, "", "BB"); (1, 0, "", "BB"); (2, 0, "", "BB"); ] let nocrypto_tests = [ ("\x00\x5a\x6d\x39\x76", None); ("\x5a\x6d\x39\x76", Some "\x66\x6f\x6f"); ("\x5a\x6d\x39\x76\x76", None); ("\x5a\x6d\x39\x76\x76\x76", None); ("\x5a\x6d\x39\x76\x76\x76\x76", None); ("\x5a\x6d\x39\x76\x00", None); ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d", Some "\x66\x6f\x6f\x6f"); ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00", None); ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00\x01", None); ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00\x01\x02", None); ("\x5a\x6d\x39\x76\x62\x77\x3d\x3d\x00\x01\x02\x03", None); ("\x5a\x6d\x39\x76\x62\x32\x38\x3d", Some "\x66\x6f\x6f\x6f\x6f"); ("\x5a\x6d\x39\x76\x62\x32\x39\x76", Some "\x66\x6f\x6f\x6f\x6f\x6f"); ("YWE=", Some "aa"); ("YWE==", None); ("YWE===", None); ("YWE=====", None); ("YWE======", None); ] let alphabet_size () = List.iter (fun (name, alphabet) -> Alcotest.(check int) (sprintf "Alphabet size %s = 64" name) 64 (Base64.length_alphabet alphabet)) [ ("default", Base64.default_alphabet); ("uri_safe", Base64.uri_safe_alphabet); ] (* Encode using OpenSSL `base64` utility *) let openssl_encode buf = Bos.( OS.Cmd.in_string buf |> OS.Cmd.run_io (Cmd.v "base64") |> OS.Cmd.to_string ~trim:true) |> function | Ok r -> prerr_endline r ; r | Error (`Msg e) -> raise (Failure (sprintf "OpenSSL decode: %s" e)) (* Encode using this library *) let lib_encode buf = Base64.encode_exn ~pad:true buf let test_rfc4648 () = List.iter (fun (c, r) -> (* Base64 vs openssl *) Alcotest.(check string) (sprintf "encode %s" c) (openssl_encode c) (lib_encode c) ; (* Base64 vs test cases above *) Alcotest.(check string) (sprintf "encode rfc4648 %s" c) r (lib_encode c) ; (* Base64 decode vs library *) Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn r)) rfc4648_tests let test_rfc3548 () = List.iter (fun (c, r) -> (* Base64 vs openssl *) Alcotest.(check string) (sprintf "encode %s" c) (openssl_encode c) (lib_encode c) ; (* Base64 vs test cases above *) Alcotest.(check string) (sprintf "encode rfc3548 %s" c) r (lib_encode c) ; (* Base64 decode vs library *) Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn r)) rfc3548_tests let test_hannes () = List.iter (fun (c, r) -> (* Base64 vs test cases above *) Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn ~pad:false r)) hannes_tests let test_php () = List.iter (fun (c, r) -> Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn ~pad:false ~alphabet:Base64.uri_safe_alphabet r)) php_tests let test_cfcs () = List.iter (fun (off, len, c, r) -> Alcotest.(check string) (sprintf "decode %s" r) c (Base64.decode_exn ~pad:false ~off ~len r)) cfcs_tests let test_nocrypto () = List.iter (fun (input, res) -> let res' = match Base64.decode ~pad:true input with | Ok v -> Some v | Error _ -> None in Alcotest.(check (option string)) (sprintf "decode %S" input) res' res) nocrypto_tests exception Malformed exception Wrong_padding let strict_base64_rfc2045_of_string x = let decoder = Base64_rfc2045.decoder (`String x) in let res = Buffer.create 16 in let rec go () = match Base64_rfc2045.decode decoder with | `End -> () | `Wrong_padding -> raise Wrong_padding | `Malformed _ -> raise Malformed | `Flush x -> Buffer.add_string res x ; go () | `Await -> Alcotest.failf "Retrieve impossible case: `Await" in Base64_rfc2045.src decoder (Bytes.unsafe_of_string x) 0 (String.length x) ; go () ; Buffer.contents res let relaxed_base64_rfc2045_of_string x = let decoder = Base64_rfc2045.decoder (`String x) in let res = Buffer.create 16 in let rec go () = match Base64_rfc2045.decode decoder with | `End -> () | `Wrong_padding -> go () | `Malformed _ -> go () | `Flush x -> Buffer.add_string res x ; go () | `Await -> Alcotest.failf "Retrieve impossible case: `Await" in Base64_rfc2045.src decoder (Bytes.unsafe_of_string x) 0 (String.length x) ; go () ; Buffer.contents res let test_strict_rfc2045 = [ ( "c2FsdXQgbGVzIGNvcGFpbnMgZmF1dCBhYnNvbHVtZW50IHF1ZSBqZSBkw6lwYXNzZSBsZXMgODAg\r\n\ Y2hhcmFjdGVycyBwb3VyIHZvaXIgc2kgbW9uIGVuY29kZXIgZml0cyBiaWVuIGRhbnMgbGVzIGxp\r\n\ bWl0ZXMgZGUgbGEgUkZDIDIwNDUgLi4u", "salut les copains faut absolument que je dépasse les 80 characters \ pour voir si mon encoder fits bien dans les limites de la RFC 2045 ..." ); ("", ""); ("Zg==", "f"); ("Zm8=", "fo"); ("Zm9v", "foo"); ("Zm9vYg==", "foob"); ("Zm9vYmE=", "fooba"); ("Zm9vYmFy", "foobar"); ] let test_relaxed_rfc2045 = [ ("Zg", "f"); ("Zm\n8", "fo"); ("Zm\r9v", "foo"); ("Zm9 vYg", "foob"); ("Zm9\r\n vYmE", "fooba"); ("Zm9évYmFy", "foobar"); ] let strict_base64_rfc2045_to_string x = let res = Buffer.create 16 in let encoder = Base64_rfc2045.encoder (`Buffer res) in String.iter (fun chr -> match Base64_rfc2045.encode encoder (`Char chr) with | `Ok -> () | `Partial -> Alcotest.failf "Retrieve impossible case for (`Char %02x): `Partial" (Char.code chr)) x ; match Base64_rfc2045.encode encoder `End with | `Ok -> Buffer.contents res | `Partial -> Alcotest.fail "Retrieve impossible case for `End: `Partial" let test_strict_with_malformed_input_rfc2045 = List.mapi (fun i (has, _) -> Alcotest.test_case (Fmt.str "strict rfc2045 - %02d" i) `Quick @@ fun () -> try let _ = strict_base64_rfc2045_of_string has in Alcotest.failf "Strict parser valids malformed input: %S" has with Malformed | Wrong_padding -> ()) test_relaxed_rfc2045 let test_strict_rfc2045 = List.mapi (fun i (has, expect) -> Alcotest.test_case (Fmt.str "strict rfc2045 - %02d" i) `Quick @@ fun () -> try let res0 = strict_base64_rfc2045_of_string has in let res1 = strict_base64_rfc2045_to_string res0 in Alcotest.(check string) "encode(decode(x)) = x" res1 has ; Alcotest.(check string) "decode(x)" res0 expect with Malformed | Wrong_padding -> Alcotest.failf "Invalid input %S" has) test_strict_rfc2045 let test_relaxed_rfc2045 = List.mapi (fun i (has, expect) -> Alcotest.test_case (Fmt.str "relaxed rfc2045 - %02d" i) `Quick @@ fun () -> let res0 = relaxed_base64_rfc2045_of_string has in Alcotest.(check string) "decode(x)" res0 expect) test_relaxed_rfc2045 let test_invariants = [ ("Alphabet size", `Quick, alphabet_size) ] let test_codec = [ ("RFC4648 test vectors", `Quick, test_rfc4648); ("RFC3548 test vectors", `Quick, test_rfc3548); ("Hannes test vectors", `Quick, test_hannes); ("Cfcs test vectors", `Quick, test_cfcs); ("PHP test vectors", `Quick, test_php); ("Nocrypto test vectors", `Quick, test_nocrypto); ] let () = Alcotest.run "Base64" [ ("invariants", test_invariants); ("codec", test_codec); ("rfc2045 (0)", test_strict_rfc2045); ("rfc2045 (1)", test_strict_with_malformed_input_rfc2045); ("rfc2045 (2)", test_relaxed_rfc2045); ]