Add support for base64url variant of base-64 encoding/decoding

Implement the RFC4648 variant of base64 encoding used by URLs.
* doc/lispref/text.texi (base64url-encode-region,
base64url-encode-string): Document new functions.
(base64-decode-region, base64-decode-string): Document new optional
parameter 'base64url' used to use url variant when decoding data.

* src/fns.c (base64url-encode-region, base64url-encode-region): New
functions to manage url variant.
(base64-decode-region, base64-decode-string): Add optional
parameter to indicate use of url-variant.
(base64_encode_region_1, base64_encode_string_1): Internal functions
with extracted code from 'base64_encode_region' and
'base64_encode_string' and optional parameters to manage padding and
url variant.
(base64-encode-region, base64-encode-string) : Use
base64_encode_region_1 and base64_encode_string_1.
(base64-encode-1): Add parameters to manage padding and url variant.
(base64-decode-1): Add parameter to manage url variant.

* test/src/fns-tests.el (fns-tests--with-region): New helper macro to
test region variant of base64 encode / decode functions.
(fns-tests--string-repeat): Helper function used in base64 tests.
(fns-tests-base64-encode-region, fns-tests-base64-encode-string):
Tests for standard base64 function.
(fns-test-base64url-encode-region,
fns-test-base64url-encode-string): Tests for url variant.
(fns-tests-base64-decode-string): Tests for decoding part.

1 files changed, 179 insertions, 0 deletions

diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a9d4d11795c..9d4ae4fdf30 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -233,6 +233,185 @@
   (should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2)))
   (should (equal (func-arity 'let) '(1 . unevalled))))
 
+(defun fns-tests--string-repeat (s o)
+  (apply 'concat (make-list o s)))
+
+(defmacro fns-tests--with-region (funcname string &rest args)
+  "Apply FUNCNAME in a temp bufer on the region produced by STRING."
+  (declare (indent 1))
+  `(with-temp-buffer
+     (insert ,string)
+     (,funcname (point-min) (point-max) ,@args)
+     (buffer-string)))
+
+(ert-deftest fns-tests-base64-encode-region ()
+  ;; standard variant RFC2045
+  (should (equal (fns-tests--with-region base64-encode-region "") ""))
+  (should (equal (fns-tests--with-region base64-encode-region "f") "Zg=="))
+  (should (equal (fns-tests--with-region base64-encode-region "fo") "Zm8="))
+  (should (equal (fns-tests--with-region base64-encode-region "foo") "Zm9v"))
+  (should (equal (fns-tests--with-region base64-encode-region "foob") "Zm9vYg=="))
+  (should (equal (fns-tests--with-region base64-encode-region "fooba") "Zm9vYmE="))
+  (should (equal (fns-tests--with-region base64-encode-region "foobar") "Zm9vYmFy"))
+  (should (equal (fns-tests--with-region base64-encode-region "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l+"))
+  (should (equal (fns-tests--with-region base64-encode-region "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/")))
+
+(ert-deftest fns-tests-base64-encode-string ()
+  ;; standard variant RFC2045
+  (should (equal (base64-encode-string "") ""))
+  (should (equal (base64-encode-string "f") "Zg=="))
+  (should (equal (base64-encode-string "fo") "Zm8="))
+  (should (equal (base64-encode-string "foo") "Zm9v"))
+  (should (equal (base64-encode-string "foob") "Zm9vYg=="))
+  (should (equal (base64-encode-string "fooba") "Zm9vYmE="))
+  (should (equal (base64-encode-string "foobar") "Zm9vYmFy"))
+  (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l+"))
+  (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/")))
+
+(ert-deftest fns-test-base64url-encode-region ()
+  ;; url variant wih padding
+  (should (equal (fns-tests--with-region base64url-encode-region "") ""))
+  (should (equal (fns-tests--with-region base64url-encode-region "f") "Zg=="))
+  (should (equal (fns-tests--with-region base64url-encode-region "fo") "Zm8="))
+  (should (equal (fns-tests--with-region base64url-encode-region "foo") "Zm9v"))
+  (should (equal (fns-tests--with-region base64url-encode-region "foob") "Zm9vYg=="))
+  (should (equal (fns-tests--with-region base64url-encode-region "fooba") "Zm9vYmE="))
+  (should (equal (fns-tests--with-region base64url-encode-region "foobar") "Zm9vYmFy"))
+  (should (equal (fns-tests--with-region base64url-encode-region "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l-"))
+  (should (equal (fns-tests--with-region base64url-encode-region "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l_"))
+
+  ;; url variant no padding
+  (should (equal (fns-tests--with-region base64url-encode-region "" t) ""))
+  (should (equal (fns-tests--with-region base64url-encode-region "f" t) "Zg"))
+  (should (equal (fns-tests--with-region base64url-encode-region "fo" t) "Zm8"))
+  (should (equal (fns-tests--with-region base64url-encode-region "foo" t) "Zm9v"))
+  (should (equal (fns-tests--with-region base64url-encode-region "foob" t) "Zm9vYg"))
+  (should (equal (fns-tests--with-region base64url-encode-region "fooba" t) "Zm9vYmE"))
+  (should (equal (fns-tests--with-region base64url-encode-region "foobar" t) "Zm9vYmFy"))
+  (should (equal (fns-tests--with-region base64url-encode-region "\x14\xfb\x9c\x03\xd9\x7e" t) "FPucA9l-"))
+  (should (equal (fns-tests--with-region base64url-encode-region "\x14\xfb\x9c\x03\xd9\x7f" t) "FPucA9l_"))
+
+
+  ;; url variant no line break no padding
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "f" 100) t)
+                 (concat (fns-tests--string-repeat "Zm" 66) "Zg")))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "fo" 50) t)
+                 (concat (fns-tests--string-repeat "Zm9mb2Zv" 16) "Zm9mbw")))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "foo" 25) t)
+                 (fns-tests--string-repeat "Zm9v" 25)))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "foob" 15) t)
+                 (fns-tests--string-repeat "Zm9vYmZvb2Jmb29i" 5)))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "fooba" 15) t)
+                 (fns-tests--string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5)))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "foobar" 15) t)
+                 (concat (fns-tests--string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy")))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t)
+                 (fns-tests--string-repeat "FPucA9l-" 10)))
+  (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t)
+                 (fns-tests--string-repeat "FPucA9l_" 10))))
+
+(ert-deftest fns-test-base64url-encode-string ()
+  ;; url variant wih padding
+  (should (equal (base64url-encode-string "") ""))
+  (should (equal (base64url-encode-string "f") "Zg=="))
+  (should (equal (base64url-encode-string "fo") "Zm8="))
+  (should (equal (base64url-encode-string "foo") "Zm9v"))
+  (should (equal (base64url-encode-string "foob") "Zm9vYg=="))
+  (should (equal (base64url-encode-string "fooba") "Zm9vYmE="))
+  (should (equal (base64url-encode-string "foobar") "Zm9vYmFy"))
+  (should (equal (base64url-encode-string "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l-"))
+  (should (equal (base64url-encode-string "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l_"))
+
+  ;; url variant no padding
+  (should (equal (base64url-encode-string "" t) ""))
+  (should (equal (base64url-encode-string "f" t) "Zg"))
+  (should (equal (base64url-encode-string "fo" t) "Zm8"))
+  (should (equal (base64url-encode-string "foo" t) "Zm9v"))
+  (should (equal (base64url-encode-string "foob" t) "Zm9vYg"))
+  (should (equal (base64url-encode-string "fooba" t) "Zm9vYmE"))
+  (should (equal (base64url-encode-string "foobar" t) "Zm9vYmFy"))
+  (should (equal (base64url-encode-string "\x14\xfb\x9c\x03\xd9\x7e" t) "FPucA9l-"))
+  (should (equal (base64url-encode-string "\x14\xfb\x9c\x03\xd9\x7f" t) "FPucA9l_"))
+
+
+  ;; url variant no line break no padding
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "f" 100) t) (concat (fns-tests--string-repeat "Zm" 66) "Zg")))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "fo" 50) t) (concat (fns-tests--string-repeat "Zm9mb2Zv" 16) "Zm9mbw")))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "foo" 25) t) (fns-tests--string-repeat "Zm9v" 25)))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "foob" 15) t) (fns-tests--string-repeat "Zm9vYmZvb2Jmb29i" 5)))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "fooba" 15) t) (fns-tests--string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5)))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "foobar" 15) t) (concat (fns-tests--string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy")))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t) (fns-tests--string-repeat "FPucA9l-" 10)))
+  (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) (fns-tests--string-repeat "FPucA9l_" 10))))
+
+(ert-deftest fns-tests-base64-decode-string ()
+  ;; standard variant RFC2045
+  (should (equal (base64-decode-string "") ""))
+  (should (equal (base64-decode-string "Zg==") "f"))
+  (should (equal (base64-decode-string "Zm8=") "fo"))
+  (should (equal (base64-decode-string "Zm9v") "foo"))
+  (should (equal (base64-decode-string "Zm9vYg==") "foob"))
+  (should (equal (base64-decode-string "Zm9vYmE=") "fooba"))
+  (should (equal (base64-decode-string "Zm9vYmFy") "foobar"))
+  (should (equal (base64-decode-string "FPucA9l+") "\x14\xfb\x9c\x03\xd9\x7e"))
+  (should (equal (base64-decode-string "FPucA9l/") "\x14\xfb\x9c\x03\xd9\x7f"))
+
+  ;; no paddign
+  (should (equal (base64-decode-string "" t) ""))
+  (should (equal (base64-decode-string "Zg" t) "f"))
+  (should (equal (base64-decode-string "Zm8" t) "fo"))
+  (should (equal (base64-decode-string "Zm9v" t) "foo"))
+  (should (equal (base64-decode-string "Zm9vYg" t) "foob"))
+  (should (equal (base64-decode-string "Zm9vYmE" t) "fooba"))
+  (should (equal (base64-decode-string "Zm9vYmFy" t) "foobar"))
+
+  ;; url variant wih padding
+  (should (equal (base64-decode-string "") ""))
+  (should (equal (base64-decode-string "Zg==" t) "f") )
+  (should (equal (base64-decode-string "Zm8=" t) "fo"))
+  (should (equal (base64-decode-string "Zm9v" t) "foo"))
+  (should (equal (base64-decode-string "Zm9vYg==" t) "foob"))
+  (should (equal (base64-decode-string "Zm9vYmE=" t) "fooba"))
+  (should (equal (base64-decode-string "Zm9vYmFy" t) "foobar"))
+  (should (equal (base64-decode-string "FPucA9l-" t) "\x14\xfb\x9c\x03\xd9\x7e"))
+  (should (equal (base64-decode-string "FPucA9l_" t) "\x14\xfb\x9c\x03\xd9\x7f"))
+
+  ;; url variant no padding
+  (should (equal (base64-decode-string "") ""))
+  (should (equal (base64-decode-string "Zg" t) "f"))
+  (should (equal (base64-decode-string "Zm8" t) "fo"))
+  (should (equal (base64-decode-string "Zm9v" t) "foo"))
+  (should (equal (base64-decode-string "Zm9vYg" t) "foob"))
+  (should (equal (base64-decode-string "Zm9vYmE" t) "fooba"))
+  (should (equal (base64-decode-string "Zm9vYmFy" t) "foobar"))
+  (should (equal (base64-decode-string "FPucA9l-" t) "\x14\xfb\x9c\x03\xd9\x7e"))
+  (should (equal (base64-decode-string "FPucA9l_" t) "\x14\xfb\x9c\x03\xd9\x7f"))
+
+
+  ;; url variant no line break no padding
+  (should (equal (base64-decode-string (concat (fns-tests--string-repeat "Zm" 66) "Zg") t)
+                 (fns-tests--string-repeat "f" 100)))
+  (should (equal (base64-decode-string (concat (fns-tests--string-repeat "Zm9mb2Zv" 16) "Zm9mbw") t)
+                 (fns-tests--string-repeat "fo" 50)))
+  (should (equal (base64-decode-string (fns-tests--string-repeat "Zm9v" 25) t)
+                 (fns-tests--string-repeat "foo" 25)))
+  (should (equal (base64-decode-string (fns-tests--string-repeat "Zm9vYmZvb2Jmb29i" 5) t)
+                 (fns-tests--string-repeat "foob" 15)))
+  (should (equal (base64-decode-string (fns-tests--string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5) t)
+                 (fns-tests--string-repeat "fooba" 15)))
+  (should (equal (base64-decode-string (concat (fns-tests--string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy") t)
+                 (fns-tests--string-repeat "foobar" 15)))
+  (should (equal (base64-decode-string (fns-tests--string-repeat "FPucA9l-" 10) t)
+                 (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10)))
+  (should (equal (base64-decode-string (fns-tests--string-repeat "FPucA9l_" 10) t)
+                 (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10)))
+
+  ;; errors check
+  (should (eq :got-error (condition-case () (base64-decode-string "Zg=") (error :got-error))))
+  (should (eq :got-error (condition-case () (base64-decode-string "Zm9vYmE") (error :got-error))))
+  (should (eq :got-error (condition-case () (base64-decode-string "Zm9vYmFy=") (error :got-error))))
+  (should (eq :got-error (condition-case () (base64-decode-string "Zg=Zg=") (error :got-error)))))
+
 (ert-deftest fns-tests-hash-buffer ()
   (should (equal (sha1 "foo") "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33"))
   (should (equal (with-temp-buffer