1# -*- tcl -*- 2# This code is hereby put into the public domain. 3# ### ### ### ######### ######### ######### 4#= Overview 5 6# Fundamental handling of base32 conversion tables. Expansion of a 7# basic mapping into a full mapping and its inverse mapping. 8 9# ### ### ### ######### ######### ######### 10#= Requisites 11 12namespace eval ::base32::core {} 13 14# ### ### ### ######### ######### ######### 15#= API & Implementation 16 17proc ::base32::core::define {map fv bv iv} { 18 variable bits 19 upvar 1 $fv forward $bv backward $iv invalid 20 21 # bytes - bits - padding - tail | bits - padding - tail 22 # 0 - 0 - "" - "xxxxxxxx" | 0 - "" - "" 23 # 1 - 8 - "======" - "xx======" | 3 - "======" - "x======" 24 # 2 - 16 - "====" - "xxxx====" | 1 - "====" - "x====" 25 # 3 - 24 - "===" - "xxxxx===" | 4 - "===" - "x===" 26 # 4 - 32 - "=" - "xxxxxxx=" | 2 - "=" - "x=" 27 28 array set _ $bits 29 30 set invalid "\[^=" 31 set forward {} 32 set btmp {} 33 34 foreach {code char} $map { 35 set b $_($code) 36 37 append invalid [string tolower $char][string toupper $char] 38 39 # 5 bit remainder 40 lappend forward $b $char 41 lappend btmp [list $char $b] 42 43 # 4 bit remainder 44 if {$code%2} continue 45 set b [string range $b 0 end-1] 46 lappend forward ${b}=/4 ${char}=== 47 lappend btmp [list ${char}=== $b] 48 49 # 3 bit remainder 50 if {$code%4} continue 51 set b [string range $b 0 end-1] 52 lappend forward ${b}=/3 ${char}====== 53 lappend btmp [list ${char}====== $b] 54 55 # 2 bit remainder 56 if {$code%8} continue 57 set b [string range $b 0 end-1] 58 lappend forward ${b}=/2 ${char}= 59 lappend btmp [list ${char}= $b] 60 61 # 1 bit remainder 62 if {$code%16} continue 63 set b [string range $b 0 end-1] 64 lappend forward ${b}=/1 ${char}==== 65 lappend btmp [list ${char}==== $b] 66 } 67 68 set backward {} 69 foreach item [lsort -index 0 -decreasing $btmp] { 70 foreach {c b} $item break 71 lappend backward $c $b 72 } 73 74 append invalid "\]" 75 return 76} 77 78proc ::base32::core::valid {estring pattern mv} { 79 upvar 1 $mv message 80 81 if {[string length $estring] % 8} { 82 set message "Length is not a multiple of 8" 83 return 0 84 } elseif {[regexp -indices $pattern $estring where]} { 85 foreach {s e} $where break 86 set message "Invalid character at index $s: \"[string index $estring $s]\"" 87 return 0 88 } elseif {[regexp {(=+)$} $estring -> pad]} { 89 set padlen [string length $pad] 90 if { 91 ($padlen != 6) && 92 ($padlen != 4) && 93 ($padlen != 3) && 94 ($padlen != 1) 95 } { 96 set message "Invalid padding of length $padlen" 97 return 0 98 } 99 } 100 101 # Remove the brackets and ^= from the pattern, to construct the 102 # class of valid characters which must not follow the padding. 103 104 set badp "=\[[string range $pattern 3 end-1]\]" 105 if {[regexp -indices $badp $estring where]} { 106 foreach {s e} $where break 107 set message "Invalid character at index $s: \"[string index $estring $s]\" (padding found in the middle of the input)" 108 return 0 109 } 110 return 1 111} 112 113# ### ### ### ######### ######### ######### 114## Data structures 115 116namespace eval ::base32::core { 117 namespace export define valid 118 119 variable bits { 120 0 00000 1 00001 2 00010 3 00011 121 4 00100 5 00101 6 00110 7 00111 122 8 01000 9 01001 10 01010 11 01011 123 12 01100 13 01101 14 01110 15 01111 124 16 10000 17 10001 18 10010 19 10011 125 20 10100 21 10101 22 10110 23 10111 126 24 11000 25 11001 26 11010 27 11011 127 28 11100 29 11101 30 11110 31 11111 128 } 129} 130 131# ### ### ### ######### ######### ######### 132#= Registration 133 134package provide base32::core 0.1 135