unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: pierre.techoueyres@free.fr (Pierre Téchoueyres)
To: Eli Zaretskii <eliz@gnu.org>
Cc: emacs-devel@gnu.org
Subject: Re: Add support for base64url variant
Date: Mon, 27 May 2019 22:30:14 +0200	[thread overview]
Message-ID: <87lfyr4p49.fsf@killashandra.ballybran.fr> (raw)
In-Reply-To: <83mujd54qv.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 23 May 2019 22:51:20 +0300")

[-- Attachment #1: Type: text/plain, Size: 663 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: pierre.techoueyres@free.fr (Pierre Téchoueyres)
>> Cc: emacs-devel@gnu.org
>> Date: Thu, 23 May 2019 21:37:01 +0200
>> 
>> > I'd suggest to call the new argument base64url or somesuch, since
>> > this is trhe official name.
>> >
>> You mean in replacement of url_variant or b64_value_to_char ?
>
> The former.
>
>> How should I send new versions of the patch ? As a full patch in
>> attachment like previously ?
>
> Yes.  And please include the log messages (in the ChangeLog style).
>
>
You'll find two patches attached.
First one contains requested changes and, hoppefully, a valid Changelog

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: with parameters --]
[-- Type: text/x-patch, Size: 24899 bytes --]

From dcd03d67d4d7fa9d1f46554a6703ae562ef39ce5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre=20T=C3=A9choueyres?= <pierre.techoueyres@free.fr>
Date: Tue, 21 May 2019 23:00:13 +0200
Subject: [PATCH] Add support for base64url variant.

Implement the RFC4648 variant of base64 encoding used with url.

* doc/lispref/text.texi (base64-encode-region, base64-encode-string,
  base64-decode-region, base64-decode-string): Adds notice for
  optionals parameters.

* etc/NEWS: Announce support for URL variant of base 64 functions.

* src/fns.c (base64-encode-region, base64-encode-string) : Adds
  optional parameters to manage padding and url variant.
  (base64-decode-region, base64-decode-string): Adds optional
  parameter to indicate use of url-variant.
  (base64-encode-1): Adds parameters to manage padding and url
  variant.
  (base64-decode-1): Adds parameter to manage url variant.
* test/src/fns-tests.el: Adds tests for encoding / decoding variants.
---
 doc/lispref/text.texi |  29 ++++++++--
 etc/NEWS              |   7 +++
 src/fns.c             | 131 +++++++++++++++++++++++++++++++-----------
 test/src/fns-tests.el | 131 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 260 insertions(+), 38 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 278bc3c268..ca1bc4e2df 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4541,10 +4541,10 @@ Base 64
 usually written by technical experts acting on their own initiative,
 and are traditionally written in a pragmatic, experience-driven
 manner.
-}2045.  This section describes the functions for
+}2045 and also in RFC4648.  This section describes the functions for
 converting to and from this code.
 
-@deffn Command base64-encode-region beg end &optional no-line-break
+@deffn Command base64-encode-region beg end &optional no-line-break no-pad base64url
 This function converts the region from @var{beg} to @var{end} into base
 64 code.  It returns the length of the encoded text.  An error is
 signaled if a character in the region is multibyte, i.e., in a
@@ -4556,9 +4556,15 @@ Base 64
 text, to avoid overlong lines.  However, if the optional argument
 @var{no-line-break} is non-@code{nil}, these newlines are not added, so
 the output is just one long line.
+
+If optional argument @var{no-pad} is set then padding isn't
+generated.
+
+If optional argument @var{base64url} is set, then chars @code{+} and
+@code{/} are replaced by @code{-} and @code{_} (See RFC4648).
 @end deffn
 
-@defun base64-encode-string string &optional no-line-break
+@defun base64-encode-string string &optional no-line-break no-pad base64url
 This function converts the string @var{string} into base 64 code.  It
 returns a string containing the encoded text.  As for
 @code{base64-encode-region}, an error is signaled if a character in the
@@ -4568,22 +4574,35 @@ Base 64
 text, to avoid overlong lines.  However, if the optional argument
 @var{no-line-break} is non-@code{nil}, these newlines are not added, so
 the result string is just one long line.
+
+If optional argument @var{no-pad} is non-@code{nil} then padding isn't
+generated.
+
+If optional argument @var{base64url} is non-@code{nil} then chars
+@code{+} and @code{/} are replaced by @code{-} abd @code{_} (See
+RFC4648).
 @end defun
 
-@deffn Command base64-decode-region beg end
+@deffn Command base64-decode-region beg end &optional base64url
 This function converts the region from @var{beg} to @var{end} from base
 64 code into the corresponding decoded text.  It returns the length of
 the decoded text.
 
 The decoding functions ignore newline characters in the encoded text.
+
+If optional argument @var{base64url} is non-@code{nil} then padding
+become optionnal and url variant is used (See RFC4648).
 @end deffn
 
-@defun base64-decode-string string
+@defun base64-decode-string string &optional base64url
 This function converts the string @var{string} from base 64 code into
 the corresponding decoded text.  It returns a unibyte string containing the
 decoded text.
 
 The decoding functions ignore newline characters in the encoded text.
+
+If optional argument @var{base64url} is non-@code{nil} then padding become
+optionnal and url variant is used (See RFC4648).
 @end defun
 
 @node Checksum/Hash
diff --git a/etc/NEWS b/etc/NEWS
index 222b86ee2b..9d7bfe5e82 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -370,6 +370,13 @@ in tooltips, as it is not useful there.
 There are 2 new buffer local variables and 1 face to customize this
 mode they are described in the manual "(emacs) Display".
 
++++
+** Functions 'base64-(encode|decode)-(string|region)' now manage url variant (RFC4648)
+The functions 'base64-encode-(region|string)' now have optionals
+arguments to mange padding and url variant.
+Mirror function 'base64-decode-(region|string)' now have an optional
+argument url-variant to manage this RFC.
+
 \f
 * Editing Changes in Emacs 27.1
 
diff --git a/src/fns.c b/src/fns.c
index 6b1f7331f5..963b54fb86 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3169,7 +3169,7 @@ #define MIME_LINE_LENGTH 76
 #define IS_ASCII(Character) \
   ((Character) < 128)
 #define IS_BASE64(Character) \
-  (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
+  (IS_ASCII (Character) && b64_char_to_value[Character] >= 0)
 #define IS_BASE64_IGNORABLE(Character) \
   ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \
    || (Character) == '\f' || (Character) == '\r')
@@ -3202,6 +3202,17 @@ #define READ_QUADRUPLET_BYTE(retval)	\
   '8', '9', '+', '/'					/* 60-63 */
 };
 
+static const char base64url_value_to_char[64] =
+{
+  'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',	/*  0- 9 */
+  'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',	/* 10-19 */
+  'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',	/* 20-29 */
+  'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',	/* 30-39 */
+  'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x',	/* 40-49 */
+  'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',	/* 50-59 */
+  '8', '9', '-', '_'					/* 60-63 */
+};
+
 /* Table of base64 values for first 128 characters.  */
 static const short base64_char_to_value[128] =
 {
@@ -3220,6 +3231,23 @@ #define READ_QUADRUPLET_BYTE(retval)	\
   49,  50,  51,  -1,  -1,  -1,  -1,  -1			/* 120-127 */
 };
 
+static const short base64url_char_to_value[128] =
+{
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*   0-  9 */
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*  10- 19 */
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*  20- 29 */
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*  30- 39 */
+  -1,  -1,  -1,  -1,  -1,  62,  -1,  -1,  52,  53,	/*  40- 49 */
+  54,  55,  56,  57,  58,  59,  60,  61,  -1,  -1,	/*  50- 59 */
+  -1,  -1,  -1,  -1,  -1,  0,   1,   2,   3,   4,	/*  60- 69 */
+  5,   6,   7,   8,   9,   10,  11,  12,  13,  14,	/*  70- 79 */
+  15,  16,  17,  18,  19,  20,  21,  22,  23,  24,	/*  80- 89 */
+  25,  -1,  -1,  -1,  -1,  63,  -1,  26,  27,  28,	/*  90- 99 */
+  29,  30,  31,  32,  33,  34,  35,  36,  37,  38,	/* 100-109 */
+  39,  40,  41,  42,  43,  44,  45,  46,  47,  48,	/* 110-119 */
+  49,  50,  51,  -1,  -1,  -1,  -1,  -1                 /* 120-127 */
+};
+
 /* The following diagram shows the logical steps by which three octets
    get transformed into four base64 characters.
 
@@ -3239,17 +3267,21 @@ #define READ_QUADRUPLET_BYTE(retval)	\
    base64 characters.  */
 
 
-static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool);
+static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool,
+				  bool, bool);
 static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
-				  ptrdiff_t *);
+				  bool, ptrdiff_t *);
 
 DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
-       2, 3, "r",
+       2, 5, "r",
        doc: /* Base64-encode the region between BEG and END.
 Return the length of the encoded text.
 Optional third argument NO-LINE-BREAK means do not break long lines
-into shorter lines.  */)
-  (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
+into shorter lines.
+Optional fourth argument NO-PAD means do not add padding char =.
+Optional fifth argument URL-VARIANT means use Url variant (RFC4648).  */)
+  (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break,
+   Lisp_Object no_pad, Lisp_Object base64url)
 {
   char *encoded;
   ptrdiff_t allength, length;
@@ -3273,6 +3305,7 @@ DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
   encoded = SAFE_ALLOCA (allength);
   encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg),
 				    encoded, length, NILP (no_line_break),
+				    NILP (no_pad), !NILP (base64url),
 				    !NILP (BVAR (current_buffer, enable_multibyte_characters)));
   if (encoded_length > allength)
     emacs_abort ();
@@ -3304,11 +3337,14 @@ DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
 }
 
 DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
-       1, 2, 0,
+       1, 4, 0,
        doc: /* Base64-encode STRING and return the result.
 Optional second argument NO-LINE-BREAK means do not break long lines
-into shorter lines.  */)
-  (Lisp_Object string, Lisp_Object no_line_break)
+into shorter lines.
+Optional third argument NO-PAD means do not add padding char =.
+Optional fourth argument BASE64URL means use Url variant (RFC4648).  */)
+  (Lisp_Object string, Lisp_Object no_line_break,
+   Lisp_Object no_pad, Lisp_Object base64url)
 {
   ptrdiff_t allength, length, encoded_length;
   char *encoded;
@@ -3329,6 +3365,7 @@ DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
 
   encoded_length = base64_encode_1 (SSDATA (string),
 				    encoded, length, NILP (no_line_break),
+				    NILP (no_pad), !NILP (base64url),
 				    STRING_MULTIBYTE (string));
   if (encoded_length > allength)
     emacs_abort ();
@@ -3347,7 +3384,8 @@ DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
 
 static ptrdiff_t
 base64_encode_1 (const char *from, char *to, ptrdiff_t length,
-		 bool line_break, bool multibyte)
+		 bool line_break, bool pad, bool base64url,
+		 bool multibyte)
 {
   int counter = 0;
   ptrdiff_t i = 0;
@@ -3355,6 +3393,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
   int c;
   unsigned int value;
   int bytes;
+  char const *b64_value_to_char = (base64url) ? base64url_value_to_char : base64_value_to_char;
 
   while (i < length)
     {
@@ -3385,16 +3424,19 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
 
       /* Process first byte of a triplet.  */
 
-      *e++ = base64_value_to_char[0x3f & c >> 2];
+      *e++ = b64_value_to_char[0x3f & c >> 2];
       value = (0x03 & c) << 4;
 
       /* Process second byte of a triplet.  */
 
       if (i == length)
 	{
-	  *e++ = base64_value_to_char[value];
-	  *e++ = '=';
-	  *e++ = '=';
+	  *e++ = b64_value_to_char[value];
+	  if (pad)
+	    {
+	      *e++ = '=';
+	      *e++ = '=';
+	    }
 	  break;
 	}
 
@@ -3410,15 +3452,18 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
       else
 	c = from[i++];
 
-      *e++ = base64_value_to_char[value | (0x0f & c >> 4)];
+      *e++ = b64_value_to_char[value | (0x0f & c >> 4)];
       value = (0x0f & c) << 2;
 
       /* Process third byte of a triplet.  */
 
       if (i == length)
 	{
-	  *e++ = base64_value_to_char[value];
-	  *e++ = '=';
+	  *e++ = b64_value_to_char[value];
+	  if (pad)
+	    {
+	      *e++ = '=';
+	    }
 	  break;
 	}
 
@@ -3434,8 +3479,8 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
       else
 	c = from[i++];
 
-      *e++ = base64_value_to_char[value | (0x03 & c >> 6)];
-      *e++ = base64_value_to_char[0x3f & c];
+      *e++ = b64_value_to_char[value | (0x03 & c >> 6)];
+      *e++ = b64_value_to_char[0x3f & c];
     }
 
   return e - to;
@@ -3443,11 +3488,13 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
 
 
 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
-       2, 2, "r",
+       2, 3, "r",
        doc: /* Base64-decode the region between BEG and END.
 Return the length of the decoded text.
-If the region can't be decoded, signal an error and don't modify the buffer.  */)
-  (Lisp_Object beg, Lisp_Object end)
+If the region can't be decoded, signal an error and don't modify the buffer.
+Optional third argument BASE64URL define if base64Url variant will be used
+see RFC4648.  */)
+     (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url)
 {
   ptrdiff_t ibeg, iend, length, allength;
   char *decoded;
@@ -3472,7 +3519,7 @@ DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
 
   move_gap_both (XFIXNAT (beg), ibeg);
   decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
-				    decoded, length,
+				    decoded, length, !NILP (base64url),
 				    multibyte, &inserted_chars);
   if (decoded_length > allength)
     emacs_abort ();
@@ -3506,9 +3553,11 @@ DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
 }
 
 DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
-       1, 1, 0,
-       doc: /* Base64-decode STRING and return the result.  */)
-  (Lisp_Object string)
+       1, 2, 0,
+       doc: /* Base64-decode STRING and return the result
+Optional argument BASE64URL define if base64Url variant will be used
+see RFC4648.  */)
+     (Lisp_Object string, Lisp_Object base64url)
 {
   char *decoded;
   ptrdiff_t length, decoded_length;
@@ -3523,7 +3572,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
 
   /* The decoded result should be unibyte. */
   decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
-				    0, NULL);
+				    !NILP (base64url), 0, NULL);
   if (decoded_length > length)
     emacs_abort ();
   else if (decoded_length >= 0)
@@ -3545,6 +3594,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
 
 static ptrdiff_t
 base64_decode_1 (const char *from, char *to, ptrdiff_t length,
+		 bool base64url,
 		 bool multibyte, ptrdiff_t *nchars_return)
 {
   ptrdiff_t i = 0;		/* Used inside READ_QUADRUPLET_BYTE */
@@ -3552,6 +3602,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
   unsigned char c;
   unsigned long value;
   ptrdiff_t nchars = 0;
+  short const *b64_char_to_value = (base64url) ? base64url_char_to_value : base64_char_to_value;
 
   while (1)
     {
@@ -3561,7 +3612,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       if (!IS_BASE64 (c))
 	return -1;
-      value = base64_char_to_value[c] << 18;
+      value = b64_char_to_value[c] << 18;
 
       /* Process second byte of a quadruplet.  */
 
@@ -3569,7 +3620,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       if (!IS_BASE64 (c))
 	return -1;
-      value |= base64_char_to_value[c] << 12;
+      value |= b64_char_to_value[c] << 12;
 
       c = (unsigned char) (value >> 16);
       if (multibyte && c >= 128)
@@ -3580,7 +3631,14 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       /* Process third byte of a quadruplet.  */
 
-      READ_QUADRUPLET_BYTE (-1);
+      if (!base64url)
+	{
+	  READ_QUADRUPLET_BYTE (-1);
+	}
+      else
+	{
+	  READ_QUADRUPLET_BYTE (e-to);
+	}
 
       if (c == '=')
 	{
@@ -3593,7 +3651,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       if (!IS_BASE64 (c))
 	return -1;
-      value |= base64_char_to_value[c] << 6;
+      value |= b64_char_to_value[c] << 6;
 
       c = (unsigned char) (0xff & value >> 8);
       if (multibyte && c >= 128)
@@ -3604,14 +3662,21 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       /* Process fourth byte of a quadruplet.  */
 
-      READ_QUADRUPLET_BYTE (-1);
+      if (!base64url)
+	{
+	  READ_QUADRUPLET_BYTE (-1);
+	}
+      else
+	{
+	  READ_QUADRUPLET_BYTE (e-to);
+	}
 
       if (c == '=')
 	continue;
 
       if (!IS_BASE64 (c))
 	return -1;
-      value |= base64_char_to_value[c];
+      value |= b64_char_to_value[c];
 
       c = (unsigned char) (0xff & value);
       if (multibyte && c >= 128)
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 6ebab4287f..3301129567 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -233,6 +233,137 @@ fns-tests-func-arity
   (should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2)))
   (should (equal (func-arity 'let) '(1 . unevalled))))
 
+(defun string-repeat (s o)
+  (apply 'concat (make-list o s)))
+
+(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/"))
+
+  ;; no line break
+  (should (equal (base64-encode-string "") ""))
+  (should (equal (base64-encode-string (string-repeat "f" 100) t) (concat (string-repeat "Zm" 66) "Zg==")))
+  (should (equal (base64-encode-string (string-repeat "fo" 50) t) (concat (string-repeat "Zm9mb2Zv" 16) "Zm9mbw==")))
+  (should (equal (base64-encode-string (string-repeat "foo" 25) t) (string-repeat "Zm9v" 25)))
+  (should (equal (base64-encode-string (string-repeat "foob" 15) t) (string-repeat "Zm9vYmZvb2Jmb29i" 5)))
+  (should (equal (base64-encode-string (string-repeat "fooba" 15) t) (string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5)))
+  (should (equal (base64-encode-string (string-repeat "foobar" 15) t) (concat (string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy")))
+  (should (equal (base64-encode-string (string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t) (string-repeat "FPucA9l+" 10)))
+  (should (equal (base64-encode-string (string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) (string-repeat "FPucA9l/" 10)))
+
+  ;; no paddign
+  (should (equal (base64-encode-string "") ""))
+  (should (equal (base64-encode-string "f" nil t) "Zg"))
+  (should (equal (base64-encode-string "fo" nil t) "Zm8"))
+  (should (equal (base64-encode-string "foo" nil t) "Zm9v"))
+  (should (equal (base64-encode-string "foob" nil t) "Zm9vYg"))
+  (should (equal (base64-encode-string "fooba" nil t) "Zm9vYmE"))
+  (should (equal (base64-encode-string "foobar" nil t) "Zm9vYmFy"))
+
+  ;; url variant wih padding
+  (should (equal (base64-encode-string "" nil nil t) ""))
+  (should (equal (base64-encode-string "f" nil nil t) "Zg=="))
+  (should (equal (base64-encode-string "fo" nil nil t) "Zm8="))
+  (should (equal (base64-encode-string "foo" nil nil t) "Zm9v"))
+  (should (equal (base64-encode-string "foob" nil nil t) "Zm9vYg=="))
+  (should (equal (base64-encode-string "fooba" nil nil t) "Zm9vYmE="))
+  (should (equal (base64-encode-string "foobar" nil nil t) "Zm9vYmFy"))
+  (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7e" nil nil t) "FPucA9l-"))
+  (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f" nil nil t) "FPucA9l_"))
+
+  ;; url variant no padding
+  (should (equal (base64-encode-string "" nil t t) ""))
+  (should (equal (base64-encode-string "f" nil t t) "Zg"))
+  (should (equal (base64-encode-string "fo" nil t t) "Zm8"))
+  (should (equal (base64-encode-string "foo" nil t t) "Zm9v"))
+  (should (equal (base64-encode-string "foob" nil t t) "Zm9vYg"))
+  (should (equal (base64-encode-string "fooba" nil t t) "Zm9vYmE"))
+  (should (equal (base64-encode-string "foobar" nil t t) "Zm9vYmFy"))
+  (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7e" nil t t) "FPucA9l-"))
+  (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f" nil t t) "FPucA9l_"))
+
+
+  ;; url variant no line break no padding
+  (should (equal (base64-encode-string (string-repeat "f" 100) t t t) (concat (string-repeat "Zm" 66) "Zg")))
+  (should (equal (base64-encode-string (string-repeat "fo" 50) t t t) (concat (string-repeat "Zm9mb2Zv" 16) "Zm9mbw")))
+  (should (equal (base64-encode-string (string-repeat "foo" 25) t t t) (string-repeat "Zm9v" 25)))
+  (should (equal (base64-encode-string (string-repeat "foob" 15) t t t) (string-repeat "Zm9vYmZvb2Jmb29i" 5)))
+  (should (equal (base64-encode-string (string-repeat "fooba" 15) t t t) (string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5)))
+  (should (equal (base64-encode-string (string-repeat "foobar" 15) t t t) (concat (string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy")))
+  (should (equal (base64-encode-string (string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t t t) (string-repeat "FPucA9l-" 10)))
+  (should (equal (base64-encode-string (string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t t t) (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 (string-repeat "Zm" 66) "Zg") t) (string-repeat "f" 100)))
+  (should (equal (base64-decode-string (concat (string-repeat "Zm9mb2Zv" 16) "Zm9mbw") t) (string-repeat "fo" 50)))
+  (should (equal (base64-decode-string (string-repeat "Zm9v" 25) t) (string-repeat "foo" 25)))
+  (should (equal (base64-decode-string (string-repeat "Zm9vYmZvb2Jmb29i" 5) t) (string-repeat "foob" 15)))
+  (should (equal (base64-decode-string (string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5) t) (string-repeat "fooba" 15)))
+  (should (equal (base64-decode-string (concat (string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy") t) (string-repeat "foobar" 15)))
+  (should (equal (base64-decode-string (string-repeat "FPucA9l-" 10) t) (string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10)))
+  (should (equal (base64-decode-string (string-repeat "FPucA9l_" 10) t) (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
-- 
2.21.0


[-- Attachment #3: Type: text/plain, Size: 281 bytes --]


The second patch contains an reworked version wich instead of adding
many parameters to base64-encode-region (resp. base64-encode-string)
function create the base64url-encode-region
(resp. base64url-encode-string) function. Documentation and tests are
also updated consequently.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: new functions --]
[-- Type: text/x-patch, Size: 30190 bytes --]

From 8acbb905aeb49fb0bfb747acc6b4965cf120e23b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre=20T=C3=A9choueyres?= <pierre.techoueyres@free.fr>
Date: Tue, 21 May 2019 23:00:13 +0200
Subject: [PATCH] Add support for base64url variant.

Implements the RFC4648 variant of base64 encoding used by URLs.

* doc/lispref/text.texi (base64url-encode-region,
  base64url-encode-string): Documents new functions.
  (base64-decode-region, base64-decode-string): Documents new optional
  parameter 'base64url' used to use url variant when decoding data.

* etc/NEWS: Announce new functions and optionals parameters.

* src/fns.c (base64url-encode-region, base64url-encode-region): New
  functions to manage url variant.
  (base64-decode-region, base64-decode-string): Adds 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 internal
  functions previously defined.
  (base64-encode-1): Adds parameters to manage padding and url variant.
  (base64-decode-1): Adds 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.
---
 doc/lispref/text.texi |  42 +++++++++-
 etc/NEWS              |   8 ++
 src/fns.c             | 166 ++++++++++++++++++++++++++++++++-------
 test/src/fns-tests.el | 179 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 363 insertions(+), 32 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 278bc3c268..3e0cf4c06f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4541,7 +4541,7 @@ Base 64
 usually written by technical experts acting on their own initiative,
 and are traditionally written in a pragmatic, experience-driven
 manner.
-}2045.  This section describes the functions for
+}2045 and also in RFC4648.  This section describes the functions for
 converting to and from this code.
 
 @deffn Command base64-encode-region beg end &optional no-line-break
@@ -4558,6 +4558,22 @@ Base 64
 the output is just one long line.
 @end deffn
 
+@deffn Command base64url-encode-region beg end &optional no-pad
+This function converts the region from @var{beg} to @var{end} into base
+64 code.  It returns the length of the encoded text.  An error is
+signaled if a character in the region is multibyte, i.e., in a
+multibyte buffer the region must contain only characters from the
+charsets @code{ascii}, @code{eight-bit-control} and
+@code{eight-bit-graphic}.
+
+Contrary to the function @code{base64-encode-region}, this function
+doesnt inserts newline characters into the encoded text, so the output
+is just one long line.
+
+If the optional argument @var{no-pad} is non-@code{nil} then padding
+(@code{=}) isn't generated.
+@end deffn
+
 @defun base64-encode-string string &optional no-line-break
 This function converts the string @var{string} into base 64 code.  It
 returns a string containing the encoded text.  As for
@@ -4570,20 +4586,40 @@ Base 64
 the result string is just one long line.
 @end defun
 
-@deffn Command base64-decode-region beg end
+@defun base64url-encode-string string &optional no-pad
+This function converts the string @var{string} into base 64 url code
+(see RFC4648).  It returns a string containing the encoded text.  As
+for @code{base64url-encode-region}, an error is signaled if a
+character in the string is multibyte.
+
+Contrary to @code{base64-encode-string}, this function doesnt inserts
+newline characters into the encoded text, so the result string is just
+one long line.
+
+If the optional argument @var{no-pad} is non-@code{nil} then padding
+(@code{=}) isn't generated.
+@end defun
+
+@deffn Command base64-decode-region beg end &optional base64url
 This function converts the region from @var{beg} to @var{end} from base
 64 code into the corresponding decoded text.  It returns the length of
 the decoded text.
 
 The decoding functions ignore newline characters in the encoded text.
+
+If optional argument @var{base64url} is is non-@code{nil} then padding
+become optionnal and url variant is used (see RFC4648).
 @end deffn
 
-@defun base64-decode-string string
+@defun base64-decode-string string &optional base64url
 This function converts the string @var{string} from base 64 code into
 the corresponding decoded text.  It returns a unibyte string containing the
 decoded text.
 
 The decoding functions ignore newline characters in the encoded text.
+
+If optional argument @var{base64url} is is non-@code{nil} then padding
+become optionnal and url variant is used (see RFC4648).
 @end defun
 
 @node Checksum/Hash
diff --git a/etc/NEWS b/etc/NEWS
index 222b86ee2b..cae6b25aca 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -370,6 +370,14 @@ in tooltips, as it is not useful there.
 There are 2 new buffer local variables and 1 face to customize this
 mode they are described in the manual "(emacs) Display".
 
++++
+** New functions 'base64url-encode-(string|region)' manage url variant (RFC4648)
+The new functions 'base64url-encode-region' and
+'base64url-encode-region' now implements url-variant as defined in RFC.
+
+Mirror functions 'base64-decode-(region|string)' now have an optional
+argument base64url to manage this RFC.
+
 \f
 * Editing Changes in Emacs 27.1
 
diff --git a/src/fns.c b/src/fns.c
index 6b1f7331f5..8c6894b77d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3169,7 +3169,7 @@ #define MIME_LINE_LENGTH 76
 #define IS_ASCII(Character) \
   ((Character) < 128)
 #define IS_BASE64(Character) \
-  (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
+  (IS_ASCII (Character) && b64_char_to_value[Character] >= 0)
 #define IS_BASE64_IGNORABLE(Character) \
   ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \
    || (Character) == '\f' || (Character) == '\r')
@@ -3202,6 +3202,17 @@ #define READ_QUADRUPLET_BYTE(retval)	\
   '8', '9', '+', '/'					/* 60-63 */
 };
 
+static const char base64url_value_to_char[64] =
+{
+  'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',	/*  0- 9 */
+  'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',	/* 10-19 */
+  'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',	/* 20-29 */
+  'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',	/* 30-39 */
+  'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x',	/* 40-49 */
+  'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',	/* 50-59 */
+  '8', '9', '-', '_'					/* 60-63 */
+};
+
 /* Table of base64 values for first 128 characters.  */
 static const short base64_char_to_value[128] =
 {
@@ -3220,6 +3231,23 @@ #define READ_QUADRUPLET_BYTE(retval)	\
   49,  50,  51,  -1,  -1,  -1,  -1,  -1			/* 120-127 */
 };
 
+static const short base64url_char_to_value[128] =
+{
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*   0-  9 */
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*  10- 19 */
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*  20- 29 */
+  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,	/*  30- 39 */
+  -1,  -1,  -1,  -1,  -1,  62,  -1,  -1,  52,  53,	/*  40- 49 */
+  54,  55,  56,  57,  58,  59,  60,  61,  -1,  -1,	/*  50- 59 */
+  -1,  -1,  -1,  -1,  -1,  0,   1,   2,   3,   4,	/*  60- 69 */
+  5,   6,   7,   8,   9,   10,  11,  12,  13,  14,	/*  70- 79 */
+  15,  16,  17,  18,  19,  20,  21,  22,  23,  24,	/*  80- 89 */
+  25,  -1,  -1,  -1,  -1,  63,  -1,  26,  27,  28,	/*  90- 99 */
+  29,  30,  31,  32,  33,  34,  35,  36,  37,  38,	/* 100-109 */
+  39,  40,  41,  42,  43,  44,  45,  46,  47,  48,	/* 110-119 */
+  49,  50,  51,  -1,  -1,  -1,  -1,  -1                 /* 120-127 */
+};
+
 /* The following diagram shows the logical steps by which three octets
    get transformed into four base64 characters.
 
@@ -3239,9 +3267,17 @@ #define READ_QUADRUPLET_BYTE(retval)	\
    base64 characters.  */
 
 
-static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool);
+static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool,
+				  bool, bool);
 static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
-				  ptrdiff_t *);
+				  bool, ptrdiff_t *);
+
+Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
+				    bool, bool);
+
+Lisp_Object base64_encode_string_1(Lisp_Object, bool,
+				   bool, bool);
+
 
 DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
        2, 3, "r",
@@ -3250,6 +3286,26 @@ DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
 Optional third argument NO-LINE-BREAK means do not break long lines
 into shorter lines.  */)
   (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
+{
+  return base64_encode_region_1(beg, end, NILP (no_line_break), true, false);
+}
+
+
+DEFUN ("base64url-encode-region", Fbase64url_encode_region, Sbase64url_encode_region,
+       2, 3, "r",
+       doc: /* Base64url-encode the region between BEG and END.
+Return the length of the encoded text.
+Optional second argument NO-PAD means do not add padding char =.
+
+This is the variant defined in RFC4648.  */)
+  (Lisp_Object beg, Lisp_Object end, Lisp_Object no_pad)
+{
+  return base64_encode_region_1(beg, end, false, NILP(no_pad), true);
+}
+
+Lisp_Object
+base64_encode_region_1 (Lisp_Object beg, Lisp_Object end, bool line_break,
+			bool pad, bool base64url)
 {
   char *encoded;
   ptrdiff_t allength, length;
@@ -3272,7 +3328,8 @@ DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
 
   encoded = SAFE_ALLOCA (allength);
   encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg),
-				    encoded, length, NILP (no_line_break),
+				    encoded, length, line_break,
+				    pad, base64url,
 				    !NILP (BVAR (current_buffer, enable_multibyte_characters)));
   if (encoded_length > allength)
     emacs_abort ();
@@ -3310,6 +3367,26 @@ DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
 into shorter lines.  */)
   (Lisp_Object string, Lisp_Object no_line_break)
 {
+
+  return base64_encode_string_1(string, NILP (no_line_break), true, false);
+}
+
+DEFUN ("base64url-encode-string", Fbase64url_encode_string, Sbase64url_encode_string,
+       1, 2, 0,
+       doc: /* Base64url-encode STRING and return the result.
+Optional second argument NO-PAD means do not add padding char =.
+
+This is the variant defined in RFC4648.  */)
+  (Lisp_Object string, Lisp_Object no_pad)
+{
+
+  return base64_encode_string_1(string, false, NILP(no_pad), true);
+}
+
+Lisp_Object
+base64_encode_string_1(Lisp_Object string, bool line_break,
+		       bool pad, bool base64url)
+{
   ptrdiff_t allength, length, encoded_length;
   char *encoded;
   Lisp_Object encoded_string;
@@ -3328,7 +3405,8 @@ DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
   encoded = SAFE_ALLOCA (allength);
 
   encoded_length = base64_encode_1 (SSDATA (string),
-				    encoded, length, NILP (no_line_break),
+				    encoded, length, line_break,
+				    pad, base64url,
 				    STRING_MULTIBYTE (string));
   if (encoded_length > allength)
     emacs_abort ();
@@ -3347,7 +3425,8 @@ DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
 
 static ptrdiff_t
 base64_encode_1 (const char *from, char *to, ptrdiff_t length,
-		 bool line_break, bool multibyte)
+		 bool line_break, bool pad, bool base64url,
+		 bool multibyte)
 {
   int counter = 0;
   ptrdiff_t i = 0;
@@ -3355,6 +3434,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
   int c;
   unsigned int value;
   int bytes;
+  char const *b64_value_to_char = (base64url) ? base64url_value_to_char : base64_value_to_char;
 
   while (i < length)
     {
@@ -3385,16 +3465,19 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
 
       /* Process first byte of a triplet.  */
 
-      *e++ = base64_value_to_char[0x3f & c >> 2];
+      *e++ = b64_value_to_char[0x3f & c >> 2];
       value = (0x03 & c) << 4;
 
       /* Process second byte of a triplet.  */
 
       if (i == length)
 	{
-	  *e++ = base64_value_to_char[value];
-	  *e++ = '=';
-	  *e++ = '=';
+	  *e++ = b64_value_to_char[value];
+	  if (pad)
+	    {
+	      *e++ = '=';
+	      *e++ = '=';
+	    }
 	  break;
 	}
 
@@ -3410,15 +3493,18 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
       else
 	c = from[i++];
 
-      *e++ = base64_value_to_char[value | (0x0f & c >> 4)];
+      *e++ = b64_value_to_char[value | (0x0f & c >> 4)];
       value = (0x0f & c) << 2;
 
       /* Process third byte of a triplet.  */
 
       if (i == length)
 	{
-	  *e++ = base64_value_to_char[value];
-	  *e++ = '=';
+	  *e++ = b64_value_to_char[value];
+	  if (pad)
+	    {
+	      *e++ = '=';
+	    }
 	  break;
 	}
 
@@ -3434,8 +3520,8 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
       else
 	c = from[i++];
 
-      *e++ = base64_value_to_char[value | (0x03 & c >> 6)];
-      *e++ = base64_value_to_char[0x3f & c];
+      *e++ = b64_value_to_char[value | (0x03 & c >> 6)];
+      *e++ = b64_value_to_char[0x3f & c];
     }
 
   return e - to;
@@ -3443,11 +3529,13 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
 
 
 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
-       2, 2, "r",
+       2, 3, "r",
        doc: /* Base64-decode the region between BEG and END.
 Return the length of the decoded text.
-If the region can't be decoded, signal an error and don't modify the buffer.  */)
-  (Lisp_Object beg, Lisp_Object end)
+If the region can't be decoded, signal an error and don't modify the buffer.
+Optional third argument BASE64URL define if base64Url variant will be used
+see RFC4648.  */)
+     (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url)
 {
   ptrdiff_t ibeg, iend, length, allength;
   char *decoded;
@@ -3472,7 +3560,7 @@ DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
 
   move_gap_both (XFIXNAT (beg), ibeg);
   decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
-				    decoded, length,
+				    decoded, length, !NILP (base64url),
 				    multibyte, &inserted_chars);
   if (decoded_length > allength)
     emacs_abort ();
@@ -3506,9 +3594,11 @@ DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
 }
 
 DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
-       1, 1, 0,
-       doc: /* Base64-decode STRING and return the result.  */)
-  (Lisp_Object string)
+       1, 2, 0,
+       doc: /* Base64-decode STRING and return the result
+Optional argument BASE64URL define if base64Url variant will be used
+see RFC4648.  */)
+     (Lisp_Object string, Lisp_Object base64url)
 {
   char *decoded;
   ptrdiff_t length, decoded_length;
@@ -3523,7 +3613,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
 
   /* The decoded result should be unibyte. */
   decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
-				    0, NULL);
+				    !NILP (base64url), 0, NULL);
   if (decoded_length > length)
     emacs_abort ();
   else if (decoded_length >= 0)
@@ -3545,6 +3635,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
 
 static ptrdiff_t
 base64_decode_1 (const char *from, char *to, ptrdiff_t length,
+		 bool base64url,
 		 bool multibyte, ptrdiff_t *nchars_return)
 {
   ptrdiff_t i = 0;		/* Used inside READ_QUADRUPLET_BYTE */
@@ -3552,6 +3643,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
   unsigned char c;
   unsigned long value;
   ptrdiff_t nchars = 0;
+  short const *b64_char_to_value = (base64url) ? base64url_char_to_value : base64_char_to_value;
 
   while (1)
     {
@@ -3561,7 +3653,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       if (!IS_BASE64 (c))
 	return -1;
-      value = base64_char_to_value[c] << 18;
+      value = b64_char_to_value[c] << 18;
 
       /* Process second byte of a quadruplet.  */
 
@@ -3569,7 +3661,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       if (!IS_BASE64 (c))
 	return -1;
-      value |= base64_char_to_value[c] << 12;
+      value |= b64_char_to_value[c] << 12;
 
       c = (unsigned char) (value >> 16);
       if (multibyte && c >= 128)
@@ -3580,7 +3672,14 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       /* Process third byte of a quadruplet.  */
 
-      READ_QUADRUPLET_BYTE (-1);
+      if (!base64url)
+	{
+	  READ_QUADRUPLET_BYTE (-1);
+	}
+      else
+	{
+	  READ_QUADRUPLET_BYTE (e-to);
+	}
 
       if (c == '=')
 	{
@@ -3593,7 +3692,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       if (!IS_BASE64 (c))
 	return -1;
-      value |= base64_char_to_value[c] << 6;
+      value |= b64_char_to_value[c] << 6;
 
       c = (unsigned char) (0xff & value >> 8);
       if (multibyte && c >= 128)
@@ -3604,14 +3703,21 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
 
       /* Process fourth byte of a quadruplet.  */
 
-      READ_QUADRUPLET_BYTE (-1);
+      if (!base64url)
+	{
+	  READ_QUADRUPLET_BYTE (-1);
+	}
+      else
+	{
+	  READ_QUADRUPLET_BYTE (e-to);
+	}
 
       if (c == '=')
 	continue;
 
       if (!IS_BASE64 (c))
 	return -1;
-      value |= base64_char_to_value[c];
+      value |= b64_char_to_value[c];
 
       c = (unsigned char) (0xff & value);
       if (multibyte && c >= 128)
@@ -5445,6 +5551,8 @@ syms_of_fns (void)
   defsubr (&Sbase64_decode_region);
   defsubr (&Sbase64_encode_string);
   defsubr (&Sbase64_decode_string);
+  defsubr (&Sbase64url_encode_region);
+  defsubr (&Sbase64url_encode_string);
   defsubr (&Smd5);
   defsubr (&Ssecure_hash_algorithms);
   defsubr (&Ssecure_hash);
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 6ebab4287f..dab43212f5 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -233,6 +233,185 @@ fns-tests-func-arity
   (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
-- 
2.21.0


[-- Attachment #5: Type: text/plain, Size: 42 bytes --]


Tell me what you thing is the way to go.

  reply	other threads:[~2019-05-27 20:30 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-05-21 22:32 Add support for base64url variant Pierre Téchoueyres
2019-05-22  7:43 ` Eli Zaretskii
2019-05-22  9:25   ` Pierre Téchoueyres
2019-05-22  9:50     ` Eli Zaretskii
2019-05-23 17:51       ` Pierre Téchoueyres
2019-05-23 18:45         ` Noam Postavsky
2019-05-23 19:32           ` Pierre Téchoueyres
2019-05-23 18:58         ` Eli Zaretskii
2019-05-23 18:50 ` Eli Zaretskii
2019-05-23 19:37   ` Pierre Téchoueyres
2019-05-23 19:51     ` Eli Zaretskii
2019-05-27 20:30       ` Pierre Téchoueyres [this message]
2019-06-07 21:04         ` Pierre Téchoueyres
2019-06-08  5:52           ` Eli Zaretskii
2019-06-08  8:18         ` Eli Zaretskii
2019-06-11 18:36           ` Pierre Téchoueyres
2019-06-11 18:42             ` Eli Zaretskii
2019-06-11 18:47               ` Achim Gratz
2019-06-11 20:14                 ` Richard Copley
2019-06-12 15:34                   ` Eli Zaretskii
2019-06-12  6:50                 ` Stefan Monnier
2019-06-12 19:24                   ` Achim Gratz
2019-06-12 21:50                     ` Stefan Monnier

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87lfyr4p49.fsf@killashandra.ballybran.fr \
    --to=pierre.techoueyres@free.fr \
    --cc=eliz@gnu.org \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).