1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  2007-2015, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(base64,
  37          [ base64/2,                   % ?PlainText, ?Encoded
  38            base64url/2,                % ?PlainText, ?Encoded
  39
  40            base64//1,                  % ?PlainText
  41            base64url//1                % ?PlainText
  42          ]).
  43
  44/** <module> Base64 encoding and decoding
  45
  46Prolog-based base64 encoding using  DCG   rules.  Encoding  according to
  47rfc2045. For example:
  48
  49==
  501 ?- base64('Hello World', X).
  51
  52X = 'SGVsbG8gV29ybGQ='
  53
  54Yes
  552 ?- base64(H, 'SGVsbG8gV29ybGQ=').
  56
  57H = 'Hello World'
  58==
  59
  60The Base64URL encoding provides a URL and file name friendly alternative
  61to base64. Base64URL encoded strings do not contain white space.
  62
  63@tbd    Stream I/O
  64@tbd    White-space introduction and parsing
  65@author Jan Wielemaker
  66*/
  67
  68%!  base64(+Plain, -Encoded) is det.
  69%!  base64(-Plain, +Encoded) is det.
  70%
  71%   Translates between plaintext and base64  encoded atom or string.
  72%   See also base64//1.
  73
  74base64(Plain, Encoded) :-
  75    nonvar(Plain),
  76    !,
  77    atom_codes(Plain, PlainCodes),
  78    phrase(base64(PlainCodes), EncCodes),
  79    atom_codes(Encoded, EncCodes).
  80base64(Plain, Encoded) :-
  81    nonvar(Encoded),
  82    !,
  83    atom_codes(Encoded, EncCodes),
  84    phrase(base64(PlainCodes), EncCodes),
  85    atom_codes(Plain, PlainCodes).
  86base64(_, _) :-
  87    throw(error(instantiation_error, _)).
  88
  89%!  base64url(+Plain, -Encoded) is det.
  90%!  base64url(-Plain, +Encoded) is det.
  91%
  92%   Translates between plaintext  and  base64url   encoded  atom  or
  93%   string. Base64URL encoded values can safely  be used as URLs and
  94%   file names. The use "-" instead of   "+", "_" instead of "/" and
  95%   do not use padding. This implies   that the encoded value cannot
  96%   be embedded inside a longer string.
  97
  98base64url(Plain, Encoded) :-
  99    nonvar(Plain),
 100    !,
 101    atom_codes(Plain, PlainCodes),
 102    phrase(encode_url(PlainCodes), EncCodes),
 103    atom_codes(Encoded, EncCodes).
 104base64url(Plain, Encoded) :-
 105    nonvar(Encoded),
 106    !,
 107    atom_codes(Encoded, EncCodes),
 108    phrase(decode_url(PlainCodes), EncCodes),
 109    atom_codes(Plain, PlainCodes).
 110base64url(_, _) :-
 111    throw(error(instantiation_error, _)).
 112
 113%!  base64(+PlainText)// is det.
 114%!  base64(-PlainText)// is det.
 115%
 116%   Encode/decode list of character codes using _base64_.  See also
 117%   base64/2.
 118
 119base64(Input) -->
 120    { nonvar(Input) },
 121    !,
 122    encode(Input).
 123base64(Output) -->
 124    decode(Output).
 125
 126%!  base64url(+PlainText)// is det.
 127%!  base64url(-PlainText)// is det.
 128%
 129%   Encode/decode list of character codes  using Base64URL. See also
 130%   base64url/2.
 131
 132base64url(Input) -->
 133    { nonvar(Input) },
 134    !,
 135    encode_url(Input).
 136base64url(Output) -->
 137    decode_url(Output).
 138
 139                 /*******************************
 140                 *            ENCODING          *
 141                 *******************************/
 142
 143encode([I0, I1, I2|Rest]) -->
 144    !,
 145    [O0, O1, O2, O3],
 146    { A is (I0<<16)+(I1<<8)+I2,
 147      O00 is (A>>18) /\ 0x3f,
 148      O01 is (A>>12) /\ 0x3f,
 149      O02 is  (A>>6) /\ 0x3f,
 150      O03 is       A /\ 0x3f,
 151      base64_char(O00, O0),
 152      base64_char(O01, O1),
 153      base64_char(O02, O2),
 154      base64_char(O03, O3)
 155    },
 156    encode(Rest).
 157encode([I0, I1]) -->
 158    !,
 159    [O0, O1, O2, 0'=],
 160    { A is (I0<<16)+(I1<<8),
 161      O00 is (A>>18) /\ 0x3f,
 162      O01 is (A>>12) /\ 0x3f,
 163      O02 is  (A>>6) /\ 0x3f,
 164      base64_char(O00, O0),
 165      base64_char(O01, O1),
 166      base64_char(O02, O2)
 167    }.
 168encode([I0]) -->
 169    !,
 170    [O0, O1, 0'=, 0'=],
 171    { A is (I0<<16),
 172      O00 is (A>>18) /\ 0x3f,
 173      O01 is (A>>12) /\ 0x3f,
 174      base64_char(O00, O0),
 175      base64_char(O01, O1)
 176    }.
 177encode([]) -->
 178    [].
 179
 180
 181encode_url([I0, I1, I2|Rest]) -->
 182    !,
 183    [O0, O1, O2, O3],
 184    { A is (I0<<16)+(I1<<8)+I2,
 185      O00 is (A>>18) /\ 0x3f,
 186      O01 is (A>>12) /\ 0x3f,
 187      O02 is  (A>>6) /\ 0x3f,
 188      O03 is       A /\ 0x3f,
 189      base64url_char(O00, O0),
 190      base64url_char(O01, O1),
 191      base64url_char(O02, O2),
 192      base64url_char(O03, O3)
 193    },
 194    encode_url(Rest).
 195encode_url([I0, I1]) -->
 196    !,
 197    [O0, O1, O2],
 198    { A is (I0<<16)+(I1<<8),
 199      O00 is (A>>18) /\ 0x3f,
 200      O01 is (A>>12) /\ 0x3f,
 201      O02 is  (A>>6) /\ 0x3f,
 202      base64url_char(O00, O0),
 203      base64url_char(O01, O1),
 204      base64url_char(O02, O2)
 205    }.
 206encode_url([I0]) -->
 207    !,
 208    [O0, O1],
 209    { A is (I0<<16),
 210      O00 is (A>>18) /\ 0x3f,
 211      O01 is (A>>12) /\ 0x3f,
 212      base64url_char(O00, O0),
 213      base64url_char(O01, O1)
 214    }.
 215encode_url([]) -->
 216    [].
 217
 218
 219                 /*******************************
 220                 *            DECODE            *
 221                 *******************************/
 222
 223decode(Text) -->
 224    [C0, C1, C2, C3],
 225    !,
 226    { base64_char(B0, C0),
 227      base64_char(B1, C1)
 228    },
 229    !,
 230    {   C3 == 0'=
 231    ->  (   C2 == 0'=
 232        ->  A is (B0<<18) + (B1<<12),
 233            I0 is (A>>16) /\ 0xff,
 234            Text = [I0|Rest]
 235        ;   base64_char(B2, C2)
 236        ->  A is (B0<<18) + (B1<<12) + (B2<<6),
 237            I0 is (A>>16) /\ 0xff,
 238            I1 is  (A>>8) /\ 0xff,
 239            Text = [I0,I1|Rest]
 240        )
 241    ;   base64_char(B2, C2),
 242        base64_char(B3, C3)
 243    ->  A is (B0<<18) + (B1<<12) + (B2<<6) + B3,
 244        I0 is (A>>16) /\ 0xff,
 245        I1 is  (A>>8) /\ 0xff,
 246        I2 is      A  /\ 0xff,
 247        Text = [I0,I1,I2|Rest]
 248    },
 249    decode(Rest).
 250decode([]) -->
 251    [].
 252
 253%!  decode_url(-Text)//
 254%
 255%   Decode a Base64URL string that has a   given length, i.e., it is
 256%   not a Base64 string embedded in a longer string.
 257
 258decode_url(Text) -->
 259    [C0, C1, C2, C3],
 260    !,
 261    { base64url_char(B0, C0),
 262      base64url_char(B1, C1),
 263      base64url_char(B2, C2),
 264      base64url_char(B3, C3),
 265      A is (B0<<18) + (B1<<12) + (B2<<6) + B3,
 266      I0 is (A>>16) /\ 0xff,
 267      I1 is  (A>>8) /\ 0xff,
 268      I2 is      A  /\ 0xff,
 269      Text = [I0,I1,I2|Rest]
 270    },
 271    decode_url(Rest).
 272decode_url(Text) -->
 273    [C0, C1, C2],
 274    !,
 275    { base64url_char(B0, C0),
 276      base64url_char(B1, C1),
 277      base64url_char(B2, C2),
 278      A is (B0<<18) + (B1<<12) + (B2<<6),
 279      I0 is (A>>16) /\ 0xff,
 280      I1 is  (A>>8) /\ 0xff,
 281      Text = [I0,I1]
 282    }.
 283decode_url(Text) -->
 284    [C0, C1],
 285    !,
 286    { base64url_char(B0, C0),
 287      base64url_char(B1, C1),
 288      A is (B0<<18) + (B1<<12),
 289      I0 is (A>>16) /\ 0xff,
 290      Text = [I0]
 291    }.
 292decode_url([]) -->
 293    [].
 294
 295
 296                 /*******************************
 297                 *   BASIC CHARACTER ENCODING   *
 298                 *******************************/
 299
 300base64_char(00, 0'A).
 301base64_char(01, 0'B).
 302base64_char(02, 0'C).
 303base64_char(03, 0'D).
 304base64_char(04, 0'E).
 305base64_char(05, 0'F).
 306base64_char(06, 0'G).
 307base64_char(07, 0'H).
 308base64_char(08, 0'I).
 309base64_char(09, 0'J).
 310base64_char(10, 0'K).
 311base64_char(11, 0'L).
 312base64_char(12, 0'M).
 313base64_char(13, 0'N).
 314base64_char(14, 0'O).
 315base64_char(15, 0'P).
 316base64_char(16, 0'Q).
 317base64_char(17, 0'R).
 318base64_char(18, 0'S).
 319base64_char(19, 0'T).
 320base64_char(20, 0'U).
 321base64_char(21, 0'V).
 322base64_char(22, 0'W).
 323base64_char(23, 0'X).
 324base64_char(24, 0'Y).
 325base64_char(25, 0'Z).
 326base64_char(26, 0'a).
 327base64_char(27, 0'b).
 328base64_char(28, 0'c).
 329base64_char(29, 0'd).
 330base64_char(30, 0'e).
 331base64_char(31, 0'f).
 332base64_char(32, 0'g).
 333base64_char(33, 0'h).
 334base64_char(34, 0'i).
 335base64_char(35, 0'j).
 336base64_char(36, 0'k).
 337base64_char(37, 0'l).
 338base64_char(38, 0'm).
 339base64_char(39, 0'n).
 340base64_char(40, 0'o).
 341base64_char(41, 0'p).
 342base64_char(42, 0'q).
 343base64_char(43, 0'r).
 344base64_char(44, 0's).
 345base64_char(45, 0't).
 346base64_char(46, 0'u).
 347base64_char(47, 0'v).
 348base64_char(48, 0'w).
 349base64_char(49, 0'x).
 350base64_char(50, 0'y).
 351base64_char(51, 0'z).
 352base64_char(52, 0'0).
 353base64_char(53, 0'1).
 354base64_char(54, 0'2).
 355base64_char(55, 0'3).
 356base64_char(56, 0'4).
 357base64_char(57, 0'5).
 358base64_char(58, 0'6).
 359base64_char(59, 0'7).
 360base64_char(60, 0'8).
 361base64_char(61, 0'9).
 362base64_char(62, 0'+).
 363base64_char(63, 0'/).
 364
 365base64url_char_x(62, 0'-).
 366base64url_char_x(63, 0'_).
 367
 368base64url_char(D, E) :-
 369    base64url_char_x(D, E),
 370    !.
 371base64url_char(D, E) :-
 372    base64_char(D, E),
 373    !.
 374base64url_char(D, E) :-
 375    throw(error(syntax_error(base64url_char(D, E)), _)).
 376
 377
 378                 /*******************************
 379                 *            MESSAGES          *
 380                 *******************************/
 381
 382:- multifile prolog:error_message//1.
 383
 384prolog:error_message(syntax_error(base64url_char(_D,E))) -->
 385    { nonvar(E) },
 386    !,
 387    [ 'Illegal Base64URL character: "~c"'-[E] ].