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)  2011-2013, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(base32,
   36          [ base32/2,                   % ?PlainText, ?Encoded
   37            base32//1                   % ?PlainText
   38          ]).   39
   40/** <module> Base32 encoding and decoding
   41
   42Prolog-based base32 encoding using  DCG   rules.  Encoding  according to
   43rfc4648.
   44
   45For example:
   46
   47==
   481 ?- base32('Hello World', X).
   49
   50X = 'JBSWY3DPEBLW64TMMQ======'
   51
   52Yes
   532 ?- base32(H, 'JBSWY3DPEBLW64TMMQ======').
   54
   55H = 'Hello World'
   56==
   57
   58@see    http://en.wikipedia.org/wiki/Base32
   59@author Jan Wielemaker
   60*/
   61
   62%!  base32(+Plain, -Encoded) is det.
   63%!  base32(-Plain, +Encoded) is det.
   64%
   65%   Translates between plaintext and base32  encoded atom or string.
   66%   See also base32//1.
   67
   68base32(Plain, Encoded) :-
   69    nonvar(Plain),
   70    !,
   71    atom_codes(Plain, PlainCodes),
   72    phrase(base32(PlainCodes), EncCodes),
   73    atom_codes(Encoded, EncCodes).
   74base32(Plain, Encoded) :-
   75    nonvar(Encoded),
   76    !,
   77    atom_codes(Encoded, EncCodes),
   78    phrase(base32(PlainCodes), EncCodes),
   79    atom_codes(Plain, PlainCodes).
   80base32(_, _) :-
   81    throw(error(instantiation_error, _)).
   82
   83
   84%!  base32(+PlainText)// is det.
   85%!  base32(-PlainText)// is det.
   86%
   87%   Encode/decode list of character codes using _base32_.  See also
   88%   base32/2.
   89
   90base32(Input) -->
   91    { nonvar(Input) },
   92    !,
   93    encode(Input).
   94base32(Output) -->
   95    decode(Output).
   96
   97
   98                 /*******************************
   99                 *            ENCODING          *
  100                 *******************************/
  101
  102encode([I0, I1, I2, I3, I4|Rest]) -->
  103    !,
  104    [O0, O1, O2, O3, O4, O5, O6, O7],
  105    { A is (I0<<32)+(I1<<24)+(I2<<16)+(I3<<8)+I4,
  106      O00 is (A>>35) /\ 0x1f,
  107      O01 is (A>>30) /\ 0x1f,
  108      O02 is (A>>25) /\ 0x1f,
  109      O03 is (A>>20) /\ 0x1f,
  110      O04 is (A>>15) /\ 0x1f,
  111      O05 is (A>>10) /\ 0x1f,
  112      O06 is  (A>>5) /\ 0x1f,
  113      O07 is       A /\ 0x1f,
  114      base32_char(O00, O0),
  115      base32_char(O01, O1),
  116      base32_char(O02, O2),
  117      base32_char(O03, O3),
  118      base32_char(O04, O4),
  119      base32_char(O05, O5),
  120      base32_char(O06, O6),
  121      base32_char(O07, O7)
  122    },
  123    encode(Rest).
  124encode([I0, I1, I2, I3]) -->
  125    !,
  126    [O0, O1, O2, O3, O4, O5, O6, 0'=],
  127    { A is (I0<<32)+(I1<<24)+(I2<<16)+(I3<<8),
  128      O00 is (A>>35) /\ 0x1f,
  129      O01 is (A>>30) /\ 0x1f,
  130      O02 is (A>>25) /\ 0x1f,
  131      O03 is (A>>20) /\ 0x1f,
  132      O04 is (A>>15) /\ 0x1f,
  133      O05 is (A>>10) /\ 0x1f,
  134      O06 is  (A>>5) /\ 0x1f,
  135      base32_char(O00, O0),
  136      base32_char(O01, O1),
  137      base32_char(O02, O2),
  138      base32_char(O03, O3),
  139      base32_char(O04, O4),
  140      base32_char(O05, O5),
  141      base32_char(O06, O6)
  142    }.
  143encode([I0, I1, I2]) -->
  144    !,
  145    [O0, O1, O2, O3, O4, 0'=, 0'=, 0'=],
  146    { A is (I0<<32)+(I1<<24)+(I2<<16),
  147      O00 is (A>>35) /\ 0x1f,
  148      O01 is (A>>30) /\ 0x1f,
  149      O02 is (A>>25) /\ 0x1f,
  150      O03 is (A>>20) /\ 0x1f,
  151      O04 is (A>>15) /\ 0x1f,
  152      base32_char(O00, O0),
  153      base32_char(O01, O1),
  154      base32_char(O02, O2),
  155      base32_char(O03, O3),
  156      base32_char(O04, O4)
  157    }.
  158encode([I0, I1]) -->
  159    !,
  160    [O0, O1, O2, O3, 0'=, 0'=, 0'=, 0'=],
  161    { A is (I0<<32)+(I1<<24),
  162      O00 is (A>>35) /\ 0x1f,
  163      O01 is (A>>30) /\ 0x1f,
  164      O02 is (A>>25) /\ 0x1f,
  165      O03 is (A>>20) /\ 0x1f,
  166      base32_char(O00, O0),
  167      base32_char(O01, O1),
  168      base32_char(O02, O2),
  169      base32_char(O03, O3)
  170    }.
  171encode([I0]) -->
  172    !,
  173    [O0, O1, 0'=, 0'=, 0'=, 0'=, 0'=, 0'=],
  174    { A is (I0<<32),
  175      O00 is (A>>35) /\ 0x1f,
  176      O01 is (A>>30) /\ 0x1f,
  177      base32_char(O00, O0),
  178      base32_char(O01, O1)
  179    }.
  180encode([]) -->
  181    [].
  182
  183
  184                 /*******************************
  185                 *            DECODE            *
  186                 *******************************/
  187
  188decode(Text) -->
  189    [C0, C1, C2, C3, C4, C5, C6, C7],
  190    !,
  191    { base32_char(B0, C0),
  192      base32_char(B1, C1)
  193    },
  194    !,
  195    {   C7 == 0'=
  196    ->  (   C6 == 0'=, C5 == 0'=
  197        ->  (   C4 == 0'=
  198            ->  (   C3 = 0'=, C2 = 0'=
  199                ->  A is (B0<<35) + (B1<<30),
  200                    I0 is (A>>32) /\ 0xff,
  201                    Text = [I0|Rest]
  202                ;   base32_char(B2, C2),
  203                    base32_char(B3, C3),
  204                    base32_char(B4, C4),
  205                    A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) + (B4<<15),
  206                    I0 is (A>>32) /\ 0xff,
  207                    I1 is (A>>24) /\ 0xff,
  208                    Text = [I0,I1|Rest]
  209                )
  210            ;   base32_char(B2, C2),
  211                base32_char(B3, C3),
  212                base32_char(B4, C4),
  213                base32_char(B5, C5),
  214                A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) +
  215                     (B4<<15) + (B5<<10),
  216                I0 is (A>>32) /\ 0xff,
  217                I1 is (A>>24) /\ 0xff,
  218                I2 is (A>>16) /\ 0xff,
  219                Text = [I0,I1,I2|Rest]
  220            )
  221        ;   base32_char(B2, C2),
  222            base32_char(B3, C3),
  223            base32_char(B4, C4),
  224            base32_char(B5, C5),
  225            base32_char(B6, C6)
  226        ->  A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) +
  227                 (B4<<15) + (B5<<10) + (B6<<5),
  228            I0 is (A>>32) /\ 0xff,
  229            I1 is (A>>24) /\ 0xff,
  230            I2 is (A>>16) /\ 0xff,
  231            I3 is  (A>>8) /\ 0xff,
  232            Text = [I0,I1,I2,I3|Rest]
  233        )
  234    ;   base32_char(B2, C2),
  235        base32_char(B3, C3),
  236        base32_char(B4, C4),
  237        base32_char(B5, C5),
  238        base32_char(B6, C6),
  239        base32_char(B7, C7)
  240    ->  A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) +
  241             (B4<<15) + (B5<<10) + (B6<<5) + B7,
  242        I0 is (A>>32) /\ 0xff,
  243        I1 is (A>>24) /\ 0xff,
  244        I2 is (A>>16) /\ 0xff,
  245        I3 is  (A>>8) /\ 0xff,
  246        I4 is      A  /\ 0xff,
  247        Text = [I0,I1,I2,I3,I4|Rest]
  248    },
  249    decode(Rest).
  250decode([]) -->
  251    [].
  252
  253
  254                 /*******************************
  255                 *   BASIC CHARACTER ENCODING   *
  256                 *******************************/
  257
  258base32_char(00, 0'A).
  259base32_char(01, 0'B).
  260base32_char(02, 0'C).
  261base32_char(03, 0'D).
  262base32_char(04, 0'E).
  263base32_char(05, 0'F).
  264base32_char(06, 0'G).
  265base32_char(07, 0'H).
  266base32_char(08, 0'I).
  267base32_char(09, 0'J).
  268base32_char(10, 0'K).
  269base32_char(11, 0'L).
  270base32_char(12, 0'M).
  271base32_char(13, 0'N).
  272base32_char(14, 0'O).
  273base32_char(15, 0'P).
  274base32_char(16, 0'Q).
  275base32_char(17, 0'R).
  276base32_char(18, 0'S).
  277base32_char(19, 0'T).
  278base32_char(20, 0'U).
  279base32_char(21, 0'V).
  280base32_char(22, 0'W).
  281base32_char(23, 0'X).
  282base32_char(24, 0'Y).
  283base32_char(25, 0'Z).
  284base32_char(26, 0'2).
  285base32_char(27, 0'3).
  286base32_char(28, 0'4).
  287base32_char(29, 0'5).
  288base32_char(30, 0'6).
  289base32_char(31, 0'7)