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:- autoload(library(error),
   47	    [instantiation_error/1,must_be/2,syntax_error/1]).   48:- autoload(library(option),[option/3]).

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.

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

  124base64(Plain, Encoded) :-
  125    nonvar(Plain),
  126    !,
  127    atom_codes(Plain, PlainCodes),
  128    phrase(base64(true, PlainCodes, classic), EncCodes),
  129    atom_codes(Encoded, EncCodes).
  130base64(Plain, Encoded) :-
  131    nonvar(Encoded),
  132    !,
  133    atom_codes(Encoded, EncCodes),
  134    phrase(base64(true, PlainCodes, classic), EncCodes),
  135    atom_codes(Plain, PlainCodes).
  136base64(Plain, Encoded) :-
  137    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.

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

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

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

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

 base64(+PlainText)// is det

base64(-PlainText)// is det

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

  179base64(PlainText) -->
  180    base64(true, PlainText, classic).

 base64url(+PlainText)// is det

base64url(-PlainText)// is det

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

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

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

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

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

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