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)).   48
   49/** <module> Base64 encoding and decoding
   50
   51Prolog-based base64 encoding using  DCG   rules.  Encoding  according to
   52rfc2045. For example:
   53
   54==
   551 ?- base64('Hello World', X).
   56X = 'SGVsbG8gV29ybGQ='.
   57
   582 ?- base64(H, 'SGVsbG8gV29ybGQ=').
   59H = 'Hello World'.
   60==
   61
   62The Base64URL encoding provides a URL and file name friendly alternative
   63to base64. Base64URL encoded strings do not contain white space.
   64
   65@tbd    Stream I/O
   66@tbd    White-space introduction and parsing
   67@author Jan Wielemaker
   68*/
   69
   70%!  base64_encoded(+Plain, -Encoded, +Options) is det.
   71%!  base64_encoded(-Plain, +Encoded, +Options) is det.
   72%
   73%   General the base64 encoding and   decoding.  This predicate subsumes
   74%   base64/2  and  base64url/2,  providing  control  over  padding,  the
   75%   characters used for encoding and the output type. Options:
   76%
   77%     - charset(+Charset)
   78%     Define the encoding character set to use.  The (default) `classic`
   79%     uses the classical rfc2045 characters.  The value `url` uses URL
   80%     and file name friendly characters.  See base64url/2.
   81%     - padding(+Boolean)
   82%     If `true` (default), the output is padded with `=` characters.
   83%     - as(+Type)
   84%     Defines the type of the output.  One of `string` (default) or
   85%     `atom`.
   86%
   87%   @arg Plain is an atom or string containing the unencoded (plain)
   88%   text.
   89%   @arg Encoded is an atom or string containing the base64 encoded
   90%   version of Plain.
   91
   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).
  115
  116%!  base64(+Plain, -Encoded) is det.
  117%!  base64(-Plain, +Encoded) is det.
  118%
  119%   Translates between plaintext and base64  encoded atom or string.
  120%   See also base64//1.
  121
  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)).
  136
  137%!  base64url(+Plain, -Encoded) is det.
  138%!  base64url(-Plain, +Encoded) is det.
  139%
  140%   Translates between plaintext  and  base64url   encoded  atom  or
  141%   string. Base64URL encoded values can safely  be used as URLs and
  142%   file names. The use "-" instead of   "+", "_" instead of "/" and
  143%   do not use padding. This implies   that the encoded value cannot
  144%   be embedded inside a longer string.
  145
  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, _)).
  160
  161%!  base64_encoded(+PlainText, +Options)// is det.
  162%!  base64_encoded(-PlainText, +Options)// is det.
  163
  164base64_encoded(PlainText, Options) -->
  165    { option(charset(CharSet), Options, classic),
  166      option(padding(Padding), Options, true)
  167    },
  168    base64(Padding, PlainText, CharSet).
  169
  170
  171%!  base64(+PlainText)// is det.
  172%!  base64(-PlainText)// is det.
  173%
  174%   Encode/decode list of character codes using _base64_.  See also
  175%   base64/2.
  176
  177base64(PlainText) -->
  178    base64(true, PlainText, classic).
  179
  180%!  base64url(+PlainText)// is det.
  181%!  base64url(-PlainText)// is det.
  182%
  183%   Encode/decode list of character codes  using Base64URL. See also
  184%   base64url/2.
  185
  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                 *******************************/
  199
  200%!  encode(+Padded, +PlainText, +Charset)//
  201
  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                 *******************************/
  263
  264%!  decode(+Padded, -PlainText, +Charset)//
  265
  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] ]