/pliant/util/encoding/base64.pli
 
 1  abstract 
 2    [Base64 encoding according to RFC 1521.] 
 3   
 4  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 5  # 
 6  # This program is free software; you can redistribute it and/or 
 7  # modify it under the terms of the GNU General Public License version 2 
 8  # as published by the Free Software Foundation. 
 9  # 
 10  # This program is distributed in the hope that it will be useful, 
 11  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 13  # GNU General Public License for more details. 
 14  # 
 15  # You should have received a copy of the GNU General Public License 
 16  # version 2 along with this program; if not, write to the Free Software 
 17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 18   
 19  module "/pliant/language/unsafe.pli" 
 20  module "/pliant/language/stream.pli" 
 21   
 22  constant trace false 
 23   
 24  # this is a not efficient at all implementation, but it works 
 25   
 26   
 27  function base64_setup encode decode 
 28    arg Str encode ; arg_w Array:Int decode 
 29    check encode:len=64 or encode:len=65 
 30    decode size := 256 
 31    for (gvar Int i) 0 255 
 32      decode := -1 
 33    for 0 63 
 34      decode encode:i:number := i 
 35   
 36  constant default_encode "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" 
 37  gvar Array:Int default_decode 
 38  base64_setup default_encode default_decode 
 39   
 40  constant alt_encode "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_." 
 41  gvar Array:Int alt_decode 
 42  base64_setup alt_encode alt_decode 
 43   
 44   
 45  function base64_encode clear encode -> encoded 
 46    arg Str clear encode encoded 
 47    var Int len := (clear:len+2)\3*4 
 48    var Address buf := memory_allocate len addressof:encoded 
 49    var Int total := 0 
 50    part encode_blocs 
 51      for (var Int i) clear:len-1 step 3 
 52        var Int count := min clear:len-3 
 53        var uInt32 value := 0 
 54        for (var Int j) count-1 
 55          (addressof:value translate Byte 2-j) map Byte := (clear:characters translate Byte i+j) map Byte 
 56        for (var Int j) 0 3 
 57          var Char := encode value\2^(6*(3-j))%64 
 58          if j>count 
 59            if encode:len=65 
 60              := encode 64 
 61            else 
 62              leave encode_blocs 
 63          check total<len 
 64          memory_copy addressof:c (buf translate Char total) 1 
 65          total += 1 
 66      check total=len 
 67    encoded set buf total true 
 68   
 69  function base64_encode clear -> encoded 
 70    arg Str clear encoded 
 71    encoded := base64_encode clear default_encode 
 72   
 73  function base64_alt_encode clear -> encoded 
 74    arg Str clear encoded 
 75    encoded := base64_encode clear alt_encode 
 76   
 77   
 78  function base64_decode encoded decode -> clear 
 79    arg Str encoded clear ; arg Array:Int decode 
 80    var Address buf := memory_allocate encoded:len addressof:clear 
 81    var Int total := 0 
 82    var Int count := 0 ; var uInt32 value := 0 
 83    for (var Int i) encoded:len-1 
 84      var Int := decode encoded:i:number 
 85      if c>=0 
 86        value += c*2^(6*(3-count)) 
 87        count += 1 
 88        if count>=4 
 89          for (var Int j) 2 0 step -1 
 90            memory_copy (addressof:value translate Byte j) (buf translate Char total) 1 
 91            total += 1          
 92          count := 0 ; value := 0 
 93    if count<>0 
 94      for (var Int j) 2 (4-count) step -1 
 95        memory_copy (addressof:value translate Byte j) (buf translate Char total) 1 
 96        total += 1 
 97    clear set buf total true 
 98   
 99  function base64_decode encoded -> clear 
 100    arg Str encoded clear 
 101    clear := base64_decode encoded default_decode 
 102   
 103  function base64_alt_decode encoded -> clear 
 104    arg Str encoded clear 
 105    clear := base64_decode encoded alt_decode 
 106   
 107             
 108  export base64_encode base64_decode 
 109  export base64_alt_encode base64_alt_decode