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
   41
   42/** <module> Base32 encoding and decoding
   43
   44Prolog-based base32 encoding using  DCG   rules.  Encoding  according to
   45rfc4648.
   46
   47For example:
   48
   49==
   501 ?- base32('Hello World', X).
   51
   52X = 'JBSWY3DPEBLW64TMMQ======'
   53
   54Yes
   552 ?- base32(H, 'JBSWY3DPEBLW64TMMQ======').
   56
   57H = 'Hello World'
   58==
   59
   60@see    http://en.wikipedia.org/wiki/Base32
   61@author Jan Wielemaker
   62*/
   63
   64%!  base32(+Plain, -Encoded) is det.
   65%!  base32(-Plain, +Encoded) is det.
   66%
   67%   Translates between plaintext and base32  encoded atom or string.
   68%   See also base32//1.
   69
   70base32(Plain, Encoded) :-
   71    nonvar(Plain),
   72    !,
   73    atom_codes(Plain, PlainCodes),
   74    phrase(base32(PlainCodes), EncCodes),
   75    atom_codes(Encoded, EncCodes).
   76base32(Plain, Encoded) :-
   77    nonvar(Encoded),
   78    !,
   79    atom_codes(Encoded, EncCodes),
   80    phrase(base32(PlainCodes), EncCodes),
   81    atom_codes(Plain, PlainCodes).
   82base32(_, _) :-
   83    throw(error(instantiation_error, _)).
   84
   85
   86%!  base32(+PlainText)// is det.
   87%!  base32(-PlainText)// is det.
   88%
   89%   Encode/decode list of character codes using _base32_.  See also
   90%   base32/2.
   91
   92base32(Input) -->
   93    { nonvar(Input) },
   94    !,
   95    encode(Input).
   96base32(Output) -->
   97    decode(Output).
   98
   99
  100                 /*******************************
  101                 *            ENCODING          *
  102                 *******************************/
  103
  104encode([I0, I1, I2, I3, I4|Rest]) -->
  105    !,
  106    [O0, O1, O2, O3, O4, O5, O6, O7],
  107    { A is (I0<<32)+(I1<<24)+(I2<<16)+(I3<<8)+I4,
  108      O00 is (A>>35) /\ 0x1f,
  109      O01 is (A>>30) /\ 0x1f,
  110      O02 is (A>>25) /\ 0x1f,
  111      O03 is (A>>20) /\ 0x1f,
  112      O04 is (A>>15) /\ 0x1f,
  113      O05 is (A>>10) /\ 0x1f,
  114      O06 is  (A>>5) /\ 0x1f,
  115      O07 is       A /\ 0x1f,
  116      base32_char(O00, O0),
  117      base32_char(O01, O1),
  118      base32_char(O02, O2),
  119      base32_char(O03, O3),
  120      base32_char(O04, O4),
  121      base32_char(O05, O5),
  122      base32_char(O06, O6),
  123      base32_char(O07, O7)
  124    },
  125    encode(Rest).
  126encode([I0, I1, I2, I3]) -->
  127    !,
  128    [O0, O1, O2, O3, O4, O5, O6, 0'=],
  129    { A is (I0<<32)+(I1<<24)+(I2<<16)+(I3<<8),
  130      O00 is (A>>35) /\ 0x1f,
  131      O01 is (A>>30) /\ 0x1f,
  132      O02 is (A>>25) /\ 0x1f,
  133      O03 is (A>>20) /\ 0x1f,
  134      O04 is (A>>15) /\ 0x1f,
  135      O05 is (A>>10) /\ 0x1f,
  136      O06 is  (A>>5) /\ 0x1f,
  137      base32_char(O00, O0),
  138      base32_char(O01, O1),
  139      base32_char(O02, O2),
  140      base32_char(O03, O3),
  141      base32_char(O04, O4),
  142      base32_char(O05, O5),
  143      base32_char(O06, O6)
  144    }.
  145encode([I0, I1, I2]) -->
  146    !,
  147    [O0, O1, O2, O3, O4, 0'=, 0'=, 0'=],
  148    { A is (I0<<32)+(I1<<24)+(I2<<16),
  149      O00 is (A>>35) /\ 0x1f,
  150      O01 is (A>>30) /\ 0x1f,
  151      O02 is (A>>25) /\ 0x1f,
  152      O03 is (A>>20) /\ 0x1f,
  153      O04 is (A>>15) /\ 0x1f,
  154      base32_char(O00, O0),
  155      base32_char(O01, O1),
  156      base32_char(O02, O2),
  157      base32_char(O03, O3),
  158      base32_char(O04, O4)
  159    }.
  160encode([I0, I1]) -->
  161    !,
  162    [O0, O1, O2, O3, 0'=, 0'=, 0'=, 0'=],
  163    { A is (I0<<32)+(I1<<24),
  164      O00 is (A>>35) /\ 0x1f,
  165      O01 is (A>>30) /\ 0x1f,
  166      O02 is (A>>25) /\ 0x1f,
  167      O03 is (A>>20) /\ 0x1f,
  168      base32_char(O00, O0),
  169      base32_char(O01, O1),
  170      base32_char(O02, O2),
  171      base32_char(O03, O3)
  172    }.
  173encode([I0]) -->
  174    !,
  175    [O0, O1, 0'=, 0'=, 0'=, 0'=, 0'=, 0'=],
  176    { A is (I0<<32),
  177      O00 is (A>>35) /\ 0x1f,
  178      O01 is (A>>30) /\ 0x1f,
  179      base32_char(O00, O0),
  180      base32_char(O01, O1)
  181    }.
  182encode([]) -->
  183    [].
  184
  185
  186                 /*******************************
  187                 *            DECODE            *
  188                 *******************************/
  189
  190decode(Text) -->
  191    [C0, C1, C2, C3, C4, C5, C6, C7],
  192    !,
  193    { base32_char(B0, C0),
  194      base32_char(B1, C1)
  195    },
  196    !,
  197    {   C7 == 0'=
  198    ->  (   C6 == 0'=, C5 == 0'=
  199        ->  (   C4 == 0'=
  200            ->  (   C3 = 0'=, C2 = 0'=
  201                ->  A is (B0<<35) + (B1<<30),
  202                    I0 is (A>>32) /\ 0xff,
  203                    Text = [I0|Rest]
  204                ;   base32_char(B2, C2),
  205                    base32_char(B3, C3),
  206                    base32_char(B4, C4),
  207                    A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) + (B4<<15),
  208                    I0 is (A>>32) /\ 0xff,
  209                    I1 is (A>>24) /\ 0xff,
  210                    Text = [I0,I1|Rest]
  211                )
  212            ;   base32_char(B2, C2),
  213                base32_char(B3, C3),
  214                base32_char(B4, C4),
  215                base32_char(B5, C5),
  216                A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) +
  217                     (B4<<15) + (B5<<10),
  218                I0 is (A>>32) /\ 0xff,
  219                I1 is (A>>24) /\ 0xff,
  220                I2 is (A>>16) /\ 0xff,
  221                Text = [I0,I1,I2|Rest]
  222            )
  223        ;   base32_char(B2, C2),
  224            base32_char(B3, C3),
  225            base32_char(B4, C4),
  226            base32_char(B5, C5),
  227            base32_char(B6, C6)
  228        ->  A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) +
  229                 (B4<<15) + (B5<<10) + (B6<<5),
  230            I0 is (A>>32) /\ 0xff,
  231            I1 is (A>>24) /\ 0xff,
  232            I2 is (A>>16) /\ 0xff,
  233            I3 is  (A>>8) /\ 0xff,
  234            Text = [I0,I1,I2,I3|Rest]
  235        )
  236    ;   base32_char(B2, C2),
  237        base32_char(B3, C3),
  238        base32_char(B4, C4),
  239        base32_char(B5, C5),
  240        base32_char(B6, C6),
  241        base32_char(B7, C7)
  242    ->  A is (B0<<35) + (B1<<30) + (B2<<25) + (B3<<20) +
  243             (B4<<15) + (B5<<10) + (B6<<5) + B7,
  244        I0 is (A>>32) /\ 0xff,
  245        I1 is (A>>24) /\ 0xff,
  246        I2 is (A>>16) /\ 0xff,
  247        I3 is  (A>>8) /\ 0xff,
  248        I4 is      A  /\ 0xff,
  249        Text = [I0,I1,I2,I3,I4|Rest]
  250    },
  251    decode(Rest).
  252decode([]) -->
  253    [].
  254
  255
  256                 /*******************************
  257                 *   BASIC CHARACTER ENCODING   *
  258                 *******************************/
  259
  260base32_char(00, 0'A).
  261base32_char(01, 0'B).
  262base32_char(02, 0'C).
  263base32_char(03, 0'D).
  264base32_char(04, 0'E).
  265base32_char(05, 0'F).
  266base32_char(06, 0'G).
  267base32_char(07, 0'H).
  268base32_char(08, 0'I).
  269base32_char(09, 0'J).
  270base32_char(10, 0'K).
  271base32_char(11, 0'L).
  272base32_char(12, 0'M).
  273base32_char(13, 0'N).
  274base32_char(14, 0'O).
  275base32_char(15, 0'P).
  276base32_char(16, 0'Q).
  277base32_char(17, 0'R).
  278base32_char(18, 0'S).
  279base32_char(19, 0'T).
  280base32_char(20, 0'U).
  281base32_char(21, 0'V).
  282base32_char(22, 0'W).
  283base32_char(23, 0'X).
  284base32_char(24, 0'Y).
  285base32_char(25, 0'Z).
  286base32_char(26, 0'2).
  287base32_char(27, 0'3).
  288base32_char(28, 0'4).
  289base32_char(29, 0'5).
  290base32_char(30, 0'6).
  291base32_char(31, 0'7)