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-2017, 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_encoded/3,		% ?Plain, ?Encoded, +Options
   38            base64_encoded//2,          % ?Plain, +Options
   39
   40            base64/2,                   % ?PlainText, ?Encoded
   41            base64//1,                  % ?PlainText
   42
   43            base64url/2,                % ?PlainText, ?Encoded
   44            base64url//1                % ?PlainText
   45          ]).   46:- use_module(library(error)).   47:- use_module(library(option)).

1 ?- base64('Hello World', X).
X = 'SGVsbG8gV29ybGQ='.

2 ?- base64(H, 'SGVsbG8gV29ybGQ=').
H = 'Hello World'.

 base64_encoded(+Plain, -Encoded, +Options) is det

base64_encoded(-Plain, +Encoded, +Options) is det

General the base64 encoding and decoding. This predicate subsumes base64/2 and base64url/2, providing control over padding, the characters used for encoding and the output type. Options:

charset(+Charset)

Define the encoding character set to use. The (default) classic uses the classical rfc2045 characters. The value url uses URL and file name friendly characters. See base64url/2.

padding(+Boolean)

If true (default), the output is padded with = characters.

as(+Type)

Defines the type of the output. One of string (default) or atom.

Arguments:

Plain	- is an atom or string containing the unencoded (plain) text.
Encoded	- is an atom or string containing the base64 encoded version of Plain.

   92base64_encoded(Plain, Encoded, Options) :-
   93    option(charset(CharSet), Options, classic),
   94    option(padding(Padding), Options, true),
   95    option(as(As), Options, string),
   96    (   nonvar(Plain)
   97    ->  atom_codes(Plain, PlainCodes),
   98        phrase(base64(Padding, PlainCodes, CharSet), EncCodes),
   99        as(As, Encoded, EncCodes)
  100    ;   nonvar(Encoded)
  101    ->  atom_codes(Encoded, EncCodes),
  102        phrase(base64(Padding, PlainCodes, CharSet), EncCodes),
  103        as(As, Plain, PlainCodes)
  104    ;   instantiation_error(base64(Plain, Encoded))
  105    ).
  106
  107as(atom, Atom, Codes) :-
  108    !,
  109    atom_codes(Atom, Codes).
  110as(string, String, Codes) :-
  111    !,
  112    string_codes(String, Codes).
  113as(As, _, _) :-
  114    must_be(oneof([atom,string]), As).

 base64(+Plain, -Encoded) is det

base64(-Plain, +Encoded) is det

Translates between plaintext and base64 encoded atom or string. See also base64//1.

  122base64(Plain, Encoded) :-
  123    nonvar(Plain),
  124    !,
  125    atom_codes(Plain, PlainCodes),
  126    phrase(base64(true, PlainCodes, classic), EncCodes),
  127    atom_codes(Encoded, EncCodes).
  128base64(Plain, Encoded) :-
  129    nonvar(Encoded),
  130    !,
  131    atom_codes(Encoded, EncCodes),
  132    phrase(base64(true, PlainCodes, classic), EncCodes),
  133    atom_codes(Plain, PlainCodes).
  134base64(Plain, Encoded) :-
  135    instantiation_error(base64(Plain, Encoded)).

 base64url(+Plain, -Encoded) is det

base64url(-Plain, +Encoded) is det

Translates between plaintext and base64url encoded atom or string. Base64URL encoded values can safely be used as URLs and file names. The use "-" instead of "+", "_" instead of "/" and do not use padding. This implies that the encoded value cannot be embedded inside a longer string.

  146base64url(Plain, Encoded) :-
  147    nonvar(Plain),
  148    !,
  149    atom_codes(Plain, PlainCodes),
  150    phrase(encode(false, PlainCodes, url), EncCodes),
  151    atom_codes(Encoded, EncCodes).
  152base64url(Plain, Encoded) :-
  153    nonvar(Encoded),
  154    !,
  155    atom_codes(Encoded, EncCodes),
  156    phrase(decode(false, PlainCodes, url), EncCodes),
  157    atom_codes(Plain, PlainCodes).
  158base64url(_, _) :-
  159    throw(error(instantiation_error, _)).

 base64_encoded(+PlainText, +Options)// is det

base64_encoded(-PlainText, +Options)// is det

  164base64_encoded(PlainText, Options) -->
  165    { option(charset(CharSet), Options, classic),
  166      option(padding(Padding), Options, true)
  167    },
  168    base64(Padding, PlainText, CharSet).

 base64(+PlainText)// is det

base64(-PlainText)// is det

Encode/decode list of character codes using base64. See also base64/2.

  177base64(PlainText) -->
  178    base64(true, PlainText, classic).

 base64url(+PlainText)// is det

base64url(-PlainText)// is det

Encode/decode list of character codes using Base64URL. See also base64url/2.

  186base64url(PlainText) -->
  187    base64(false, PlainText, url).
  188
  189base64(Padded, Input, Charset) -->
  190    { nonvar(Input) },
  191    !,
  192    encode(Padded, Input, Charset).
  193base64(Padded, Output, Charset) -->
  194    decode(Padded, Output, Charset).
  195
  196                 /*******************************
  197                 *            ENCODING          *
  198                 *******************************/

 encode(+Padded, +PlainText, +Charset)//

  202encode(Padded, [I0, I1, I2|Rest], Charset) -->
  203    !,
  204    [O0, O1, O2, O3],
  205    { A is (I0<<16)+(I1<<8)+I2,
  206      O00 is (A>>18) /\ 0x3f,
  207      O01 is (A>>12) /\ 0x3f,
  208      O02 is  (A>>6) /\ 0x3f,
  209      O03 is       A /\ 0x3f,
  210      base64_char(Charset, O00, O0),
  211      base64_char(Charset, O01, O1),
  212      base64_char(Charset, O02, O2),
  213      base64_char(Charset, O03, O3)
  214    },
  215    encode(Padded, Rest, Charset).
  216encode(true, [I0, I1], Charset) -->
  217    !,
  218    [O0, O1, O2, 0'=],
  219    { A is (I0<<16)+(I1<<8),
  220      O00 is (A>>18) /\ 0x3f,
  221      O01 is (A>>12) /\ 0x3f,
  222      O02 is  (A>>6) /\ 0x3f,
  223      base64_char(Charset, O00, O0),
  224      base64_char(Charset, O01, O1),
  225      base64_char(Charset, O02, O2)
  226    }.
  227encode(true, [I0], Charset) -->
  228    !,
  229    [O0, O1, 0'=, 0'=],
  230    { A is (I0<<16),
  231      O00 is (A>>18) /\ 0x3f,
  232      O01 is (A>>12) /\ 0x3f,
  233      base64_char(Charset, O00, O0),
  234      base64_char(Charset, O01, O1)
  235    }.
  236encode(false, [I0, I1], Charset) -->
  237    !,
  238    [O0, O1, O2],
  239    { A is (I0<<16)+(I1<<8),
  240      O00 is (A>>18) /\ 0x3f,
  241      O01 is (A>>12) /\ 0x3f,
  242      O02 is  (A>>6) /\ 0x3f,
  243      base64_char(Charset, O00, O0),
  244      base64_char(Charset, O01, O1),
  245      base64_char(Charset, O02, O2)
  246    }.
  247encode(false, [I0], Charset) -->
  248    !,
  249    [O0, O1],
  250    { A is (I0<<16),
  251      O00 is (A>>18) /\ 0x3f,
  252      O01 is (A>>12) /\ 0x3f,
  253      base64_char(Charset, O00, O0),
  254      base64_char(Charset, O01, O1)
  255    }.
  256encode(_, [], _) -->
  257    [].
  258
  259
  260                 /*******************************
  261                 *            DECODE            *
  262                 *******************************/

 decode(+Padded, -PlainText, +Charset)//

  266decode(true, Text, Charset) -->
  267    [C0, C1, C2, C3],
  268    !,
  269    { base64_char(Charset, B0, C0),
  270      base64_char(Charset, B1, C1)
  271    },
  272    !,
  273    {   C3 == 0'=
  274    ->  (   C2 == 0'=
  275        ->  A is (B0<<18) + (B1<<12),
  276            I0 is (A>>16) /\ 0xff,
  277            Text = [I0|Rest]
  278        ;   base64_char(Charset, B2, C2)
  279        ->  A is (B0<<18) + (B1<<12) + (B2<<6),
  280            I0 is (A>>16) /\ 0xff,
  281            I1 is  (A>>8) /\ 0xff,
  282            Text = [I0,I1|Rest]
  283        )
  284    ;   base64_char(Charset, B2, C2),
  285        base64_char(Charset, B3, C3)
  286    ->  A is (B0<<18) + (B1<<12) + (B2<<6) + B3,
  287        I0 is (A>>16) /\ 0xff,
  288        I1 is  (A>>8) /\ 0xff,
  289        I2 is      A  /\ 0xff,
  290        Text = [I0,I1,I2|Rest]
  291    },
  292    decode(true, Rest, Charset).
  293decode(false, Text, Charset) -->
  294    [C0, C1, C2, C3],
  295    !,
  296    { base64_char(Charset, B0, C0),
  297      base64_char(Charset, B1, C1),
  298      base64_char(Charset, B2, C2),
  299      base64_char(Charset, B3, C3),
  300      A is (B0<<18) + (B1<<12) + (B2<<6) + B3,
  301      I0 is (A>>16) /\ 0xff,
  302      I1 is  (A>>8) /\ 0xff,
  303      I2 is      A  /\ 0xff,
  304      Text = [I0,I1,I2|Rest]
  305    },
  306    decode(false, Rest, Charset).
  307decode(false, Text, Charset) -->
  308    [C0, C1, C2],
  309    !,
  310    { base64_char(Charset, B0, C0),
  311      base64_char(Charset, B1, C1),
  312      base64_char(Charset, B2, C2),
  313      A is (B0<<18) + (B1<<12) + (B2<<6),
  314      I0 is (A>>16) /\ 0xff,
  315      I1 is  (A>>8) /\ 0xff,
  316      Text = [I0,I1]
  317    }.
  318decode(false, Text, Charset) -->
  319    [C0, C1],
  320    !,
  321    { base64_char(Charset, B0, C0),
  322      base64_char(Charset, B1, C1),
  323      A is (B0<<18) + (B1<<12),
  324      I0 is (A>>16) /\ 0xff,
  325      Text = [I0]
  326    }.
  327decode(_, [], _) -->
  328    [].
  329
  330
  331
  332                 /*******************************
  333                 *   BASIC CHARACTER ENCODING   *
  334                 *******************************/
  335
  336base64_char(00, 0'A).
  337base64_char(01, 0'B).
  338base64_char(02, 0'C).
  339base64_char(03, 0'D).
  340base64_char(04, 0'E).
  341base64_char(05, 0'F).
  342base64_char(06, 0'G).
  343base64_char(07, 0'H).
  344base64_char(08, 0'I).
  345base64_char(09, 0'J).
  346base64_char(10, 0'K).
  347base64_char(11, 0'L).
  348base64_char(12, 0'M).
  349base64_char(13, 0'N).
  350base64_char(14, 0'O).
  351base64_char(15, 0'P).
  352base64_char(16, 0'Q).
  353base64_char(17, 0'R).
  354base64_char(18, 0'S).
  355base64_char(19, 0'T).
  356base64_char(20, 0'U).
  357base64_char(21, 0'V).
  358base64_char(22, 0'W).
  359base64_char(23, 0'X).
  360base64_char(24, 0'Y).
  361base64_char(25, 0'Z).
  362base64_char(26, 0'a).
  363base64_char(27, 0'b).
  364base64_char(28, 0'c).
  365base64_char(29, 0'd).
  366base64_char(30, 0'e).
  367base64_char(31, 0'f).
  368base64_char(32, 0'g).
  369base64_char(33, 0'h).
  370base64_char(34, 0'i).
  371base64_char(35, 0'j).
  372base64_char(36, 0'k).
  373base64_char(37, 0'l).
  374base64_char(38, 0'm).
  375base64_char(39, 0'n).
  376base64_char(40, 0'o).
  377base64_char(41, 0'p).
  378base64_char(42, 0'q).
  379base64_char(43, 0'r).
  380base64_char(44, 0's).
  381base64_char(45, 0't).
  382base64_char(46, 0'u).
  383base64_char(47, 0'v).
  384base64_char(48, 0'w).
  385base64_char(49, 0'x).
  386base64_char(50, 0'y).
  387base64_char(51, 0'z).
  388base64_char(52, 0'0).
  389base64_char(53, 0'1).
  390base64_char(54, 0'2).
  391base64_char(55, 0'3).
  392base64_char(56, 0'4).
  393base64_char(57, 0'5).
  394base64_char(58, 0'6).
  395base64_char(59, 0'7).
  396base64_char(60, 0'8).
  397base64_char(61, 0'9).
  398base64_char(62, 0'+).
  399base64_char(63, 0'/).
  400
  401base64url_char_x(62, 0'-).
  402base64url_char_x(63, 0'_).
  403
  404base64_char(classic, Value, Char) :-
  405    (   base64_char(Value, Char)
  406    ->  true
  407    ;   syntax_error(base64_char(Value, Char))
  408    ).
  409base64_char(url, Value, Char) :-
  410    (   base64url_char_x(Value, Char)
  411    ->  true
  412    ;   base64_char(Value, Char)
  413    ->  true
  414    ;   syntax_error(base64_char(Value, Char))
  415    ).
  416
  417
  418                 /*******************************
  419                 *            MESSAGES          *
  420                 *******************************/
  421
  422:- multifile prolog:error_message//1.  423
  424prolog:error_message(syntax_error(base64_char(_D,E))) -->
  425    { nonvar(E) },
  426    !,
  427    [ 'Illegal Base64 character: "~c"'-[E] ]