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