TCL procedures for Base32 encoding/decoding

Problem this snippet solves:

Hi Folks,

the iRule below contains two TCL procedures to support Base32 encoding and decoding (see RFC 4648 as well as RFC 3548) within iRules.

The procedures are based on a rather simple but extensive

[string map]

syntax to translate or untranslate the Base32 alphabet on a given input data stream via its binary string representation. Compared to other Base32 libraries, which may convert the input on a per-charater/quantum basis, the single step

[string map]

translation will require significant less CPU cycles to handle the base32 encodings / decodings.

Note: The provided Base32 decoder uses a liberal input validation (see RFC 4648 Section 3.3), by ignoring incorrect "=" paddings, accepting upper as well as lower case base32 alphabet characters, automatically translating "0" (zero) to "O", "1" (one) to "I", "8" (eight) to "B" and silently removing any WHITESPACE, TAB and "CRLF" sequences from the input. If the input string contains any other non-Base32 alphabet characters, an internal error will be raised and the output will become an empty string.

Cheers, Kai

How to use this snippet:

1. The iRule below contains a

   RULE_INIT

   event which outlines the procedure usage.
2. Enjoy!

Code :

when RULE_INIT {
    
    set string "Hello World!"
    set output [call b32encode $string]
    
    log local0.debug "Base32 encoded the input \"$string\" to \"$output\""
 
    set string "JBSWY3DPEBLW64TMMQQQ===="
    set output [call b32decode $string]
    
    log local0.debug "Base32 decoded the input \"$string\" to \"$output\""
 
}
proc b32decode { input } {
    set bin [string map -nocase [list A 00000   B 00001   C 00010   D 00011 \
                                      E 00100   F 00101   G 00110   H 00111 \
                                      I 01000   J 01001   K 01010   L 01011 \
                                      M 01100   N 01101   O 01110   P 01111 \
                                      Q 10000   R 10001   S 10010   T 10011 \
                                      U 10100   V 10101   W 10110   X 10111 \
                                      Y 11000   Z 11001   2 11010   3 11011 \
                                      4 11100   5 11101   6 11110   7 11111 \
                                      = ""      0 01110   1 01000   8 00001 \
                                      " " ""    "" ""  "\n" ""] $input]
    if { [catch {   
        set output [binary format B[expr { int( [string length $bin] / 8 ) * 8 }] $bin]
    }] } then {
        set output ""
    }
    return $output
}
proc b32encode { input } {
    binary scan $input B* bin
    return [string map [list 00000 A        00001 B        00010 C        00011 D \
                             00100 E        00101 F        00110 G        00111 H \
                             01000 I        01001 J        01010 K        01011 L \
                             01100 M        01101 N        01110 O        01111 P \
                             10000 Q        10001 R        10010 S        10011 T \
                             10100 U        10101 V        10110 W        10111 X \
                             11000 Y        11001 Z        11010 2        11011 3 \
                             11100 4        11101 5        11110 6        11111 7 \
                             0000  A===     0001  C===     0010  E===     0011  G=== \
                             0100  I===     0101  K===     0110  M===     0111  O=== \
                             1000  Q===     1001  S===     1010  U===     1011  W=== \
                             1100  Y===     1101  2===     1110  4===     1111  6=== \
                             000   A======  001   E======  010   I======  011   M====== \
                             100   Q======  101   U======  110   Y======  111   4====== \
                             00    A=       01    I=       10    Q=       11    Y= \
                             0     A====    1     Q==== ] $bin]
}

Tested this on version:

12.0