Tcl Library Source Code

[manpage_begin base64url n 1.0]
[keywords base64url]
[keywords base64]
[keywords encoding]
[copyright  {2014, Neil Madden}]
[moddesc    {URL-safe text encoding & decoding binary data}]
[titledesc  {base64url-encode/decode binary data}]
[category   {Text processing}]
[require Tcl 8.5]
[require base64url [opt 1.0]]
[description]
[para]

This package provides procedures to encode binary data into URL-safe base64
and back. This is identical to Base64 encoding, except that no wrapping is
performed, the "+" and "/" characters are replaced by "-" and "_" respectively,
and no padding characters are appended.

[list_begin definitions]

[call [cmd {::base64url encode}] [arg encoding] [arg data]]

Base64url encodes the given [arg data] string and returns the encoded
result. The [arg data] string is first converted into binary data
using the given [arg encoding], as if by [cmd {encoding convertto}] [arg encoding].
If [arg encoding] is "binary" then no conversion is done.

[para]

The command will throw an error if the encoding is not recognised.

[call [cmd {::base64url decode}] [arg encoding] [arg data]]

Base64url decodes the given [arg data] and returns the decoded data.
The returned data is converted into a string according to the
[arg encoding], as if by [cmd {encoding convertfrom}] [arg encoding].
If [arg encoding] is "binary" then no conversion is done.

[list_end]

[section {EXAMPLES}]

[example {
% base64url encode utf-8 "Hello, world!"
SGVsbG8sIHdvcmxkIQ
}]

[example {
% base64url encode binary [binary format c* {1 2 3 4 5}]  
AQIDBAU
% binary scan [base64url decode binary AQIDBAU] c* xs
1
% set xs
1 2 3 4 5
}]

[vset CATEGORY base64url]
[include ../doctools2base/include/feedback.inc]
[manpage_end]

# base64url.tcl --
#
#       Provides encode/decode routines for the 'base64url' encoding standard.
#       See: http://tools.ietf.org/html/rfc4648#section-5
#       We implement the version without padding as described here:
#       https://tools.ietf.org/html/draft-ietf-jose-json-web-signature-36#appendix-C
#
# Copyright (c) 2014 Neil Madden.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require Tcl         8.5
package require base64      2.4

package provide base64url   1.0

namespace eval ::base64url {
    namespace export encode decode
    namespace ensemble create

    # ::base64url encode encoding data --
    #
    #   Base64url encode a given string.
    #
    # Arguments:
    #   encoding    The character encoding to use when converting the string
    #               bytes. Use "binary" if already encoded.
    #   data        The data to encode.
    #
    # Results:
    #   A base6url encoded version of $data in $encoding encoding.
    #
    proc encode {encoding data} {
        if {$encoding ne "binary"} {
            set data [encoding convertto $encoding $data]
        }
        string map {
            +       -
            /       _
            =       ""
        } [base64::encode -wrapchar "" $data]
    }

    # :base64url decode encoding data --
    #
    #   Base64url decode a given string.
    #
    # Arguments:
    #   encoding    The character encoding to apply to the data after
    #               decoding. Use "binary" if data is binary.
    #   data        The data to decode. Should be in base64url format.
    #
    # Results:
    #   The decoded data after conversion to the given character encoding.
    #
    proc decode {encoding data} {
        set data [base64::decode [string map {
            -       +
            _       /
        } [pad-align 4 "=" $data]]]
        if {$encoding ne "binary"} {
            set data [encoding convertfrom $encoding $data]
        }
        return $data
    }

    # pad-align width padChar data --
    #
    #       Right-pads $data with $padChar until it is a multiple of $width
    #       characters in length.
    #
    proc pad-align {width padChar data} {
        append data [string repeat $padChar \
            [expr {$width - ([string length $data] % $width)}]]
    }
}

# base64url.test --
# vim: ft=tcl
#
#       Unit tests for the base64url module.
#
# Copyright (c) 2014 Neil Madden.

source [file join \
        [file dirname [file dirname [file join [pwd] [info script]]]] \
        devtools testutilities.tcl]

testsNeedTcl        8.5
testsNeedTcltest    1.0

testing {
    useLocal base64url.tcl base64url
}

test base64url-1.1 {base64url encode utf-8} {
    # "Password" in Japanese
    base64url encode utf-8 "\u30D1\u30B9\u30EF\u30FC\u30C9\u30D1\u30B9\u30EF\u30FC\u30C9"
} "44OR44K544Ov44O844OJ44OR44K544Ov44O844OJ"

test base64url-1.2 {base64url decode utf-8} {
    base64url decode utf-8 "44OR44K544Ov44O844OJ44OR44K544Ov44O844OJ"
} "\u30D1\u30B9\u30EF\u30FC\u30C9\u30D1\u30B9\u30EF\u30FC\u30C9"

test base64url-1.3 {base64url encode binary} {
    # Generate binary string of all bytes 0-255
    set bytes [list]
    for {set i 0} {$i < 256} {incr i} { lappend bytes $i }
    set bin [binary format c* $bytes]
    base64url encode binary $bin
} [join {"AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4v" 
    "MDEyMzQ1Njc4OTo7PD0-P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2" 
    "RlZmdoaWprbG1ub3BxcnN0dXZ3eHl6e3x9fn-AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeY"
    "mZqbnJ2en6ChoqOkpaanqKmqq6ytrq-wsbKztLW2t7i5uru8vb6_wMHCw8TFxsfIycrLzM" 
    "3Oz9DR0tPU1dbX2Nna29zd3t_g4eLj5OXm5-jp6uvs7e7v8PHy8_T19vf4-fr7_P3-_w"} ""]

test base64url-1.4 {base64url decode binary} {
    set input \
    [join {"AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4v" 
    "MDEyMzQ1Njc4OTo7PD0-P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2" 
    "RlZmdoaWprbG1ub3BxcnN0dXZ3eHl6e3x9fn-AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeY"
    "mZqbnJ2en6ChoqOkpaanqKmqq6ytrq-wsbKztLW2t7i5uru8vb6_wMHCw8TFxsfIycrLzM"
    "3Oz9DR0tPU1dbX2Nna29zd3t_g4eLj5OXm5-jp6uvs7e7v8PHy8_T19vf4-fr7_P3-_w"} ""]

    binary scan [base64url decode binary $input] c* xs
    join $xs ,
} [join {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
    27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
    52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
    77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
    101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
    120 121 122 123 124 125 126 127 -128 -127 -126 -125 -124 -123 -122 -121
    -120 -119 -118 -117 -116 -115 -114 -113 -112 -111 -110 -109 -108 -107 -106
    -105 -104 -103 -102 -101 -100 -99 -98 -97 -96 -95 -94 -93 -92 -91 -90 -89
    -88 -87 -86 -85 -84 -83 -82 -81 -80 -79 -78 -77 -76 -75 -74 -73 -72 -71 -70
    -69 -68 -67 -66 -65 -64 -63 -62 -61 -60 -59 -58 -57 -56 -55 -54 -53 -52 -51
    -50 -49 -48 -47 -46 -45 -44 -43 -42 -41 -40 -39 -38 -37 -36 -35 -34 -33 -32
    -31 -30 -29 -28 -27 -26 -25 -24 -23 -22 -21 -20 -19 -18 -17 -16 -15 -14 -13
    -12 -11 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1} ,]

test base64url-1.6 {base64url encode - strip padding 1} {
    base64url encode utf-8 xx
} "eHg"

test base64url-1.7 {base64url encode - strip padding 2} {
    base64url encode utf-8 x
} "eA"

test base64url-1.8 {base64url decode - padding 1} {
    base64url decode utf-8 "eHg"
} "xx"

test base64url-1.9 {base64url decode - padding 2} {
    base64url decode utf-8 "eA"
} "x"

test base64url-1.10 {base64url decode - allow pad chars 1} {
    base64url decode utf-8 "eHg="
} "xx"

test base64url-1.11 {base64url decode - allow pad chars 2} {
    base64url decode utf-8 "eA=="
} "x"

    
testsuiteCleanup
return

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded base64url 1.0 [list source [file join $dir base64url.tcl]]

#       name         pkg   doc   example
Module  aes         _tcl  _man  _null
Module  amazon-s3   _tcl  _man  _null
Module  asn         _tcl  _man  _null
Module  base32      _tcl  _man  _null
Module  base64      _tcl  _man  _null
Module  base64url   _tcl  _man  _null
Module  bee         _tcl  _man  _null
Module  bench       _tcl _null  _null
Module  bibtex      _tcl  _man  _exa
Module  blowfish    _tcl  _man  _null
Module  cache       _tcl  _man  _null
Module  calendar     _tci _man  _null
Module  clock       _tcl  _man _null