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
129
130
131
132
133
134
|
# -*- tcl -*-
# This code is hereby put into the public domain.
# ### ### ### ######### ######### #########
#= Overview
# Fundamental handling of base32 conversion tables. Expansion of a
# basic mapping into a full mapping and its inverse mapping.
# ### ### ### ######### ######### #########
#= Requisites
namespace eval ::base32::core {}
# ### ### ### ######### ######### #########
#= API & Implementation
proc ::base32::core::define {map fv bv iv} {
variable bits
upvar 1 $fv forward $bv backward $iv invalid
# bytes - bits - padding - tail | bits - padding - tail
# 0 - 0 - "" - "xxxxxxxx" | 0 - "" - ""
# 1 - 8 - "======" - "xx======" | 3 - "======" - "x======"
# 2 - 16 - "====" - "xxxx====" | 1 - "====" - "x===="
# 3 - 24 - "===" - "xxxxx===" | 4 - "===" - "x==="
# 4 - 32 - "=" - "xxxxxxx=" | 2 - "=" - "x="
array set _ $bits
set invalid "\[^="
set forward {}
set btmp {}
foreach {code char} $map {
set b $_($code)
append invalid [string tolower $char][string toupper $char]
# 5 bit remainder
lappend forward $b $char
lappend btmp [list $char $b]
# 4 bit remainder
if {$code%2} continue
set b [string range $b 0 end-1]
lappend forward ${b}=/4 ${char}===
lappend btmp [list ${char}=== $b]
# 3 bit remainder
if {$code%4} continue
set b [string range $b 0 end-1]
lappend forward ${b}=/3 ${char}======
lappend btmp [list ${char}====== $b]
# 2 bit remainder
if {$code%8} continue
set b [string range $b 0 end-1]
lappend forward ${b}=/2 ${char}=
lappend btmp [list ${char}= $b]
# 1 bit remainder
if {$code%16} continue
set b [string range $b 0 end-1]
lappend forward ${b}=/1 ${char}====
lappend btmp [list ${char}==== $b]
}
set backward {}
foreach item [lsort -index 0 -decreasing $btmp] {
foreach {c b} $item break
lappend backward $c $b
}
append invalid "\]"
return
}
proc ::base32::core::valid {estring pattern mv} {
upvar 1 $mv message
if {[string length $estring] % 8} {
set message "Length is not a multiple of 8"
return 0
} elseif {[regexp -indices $pattern $estring where]} {
foreach {s e} $where break
set message "Invalid character at index $s: \"[string index $estring $s]\""
return 0
} elseif {[regexp {(=+)$} $estring -> pad]} {
set padlen [string length $pad]
if {
($padlen != 6) &&
($padlen != 4) &&
($padlen != 3) &&
($padlen != 1)
} {
set message "Invalid padding of length $padlen"
return 0
}
}
# Remove the brackets and ^= from the pattern, to construct the
# class of valid characters which must not follow the padding.
set badp "=\[[string range $pattern 3 end-1]\]"
if {[regexp -indices $badp $estring where]} {
foreach {s e} $where break
set message "Invalid character at index $s: \"[string index $estring $s]\" (padding found in the middle of the input)"
return 0
}
return 1
}
# ### ### ### ######### ######### #########
## Data structures
namespace eval ::base32::core {
namespace export define valid
variable bits {
0 00000 1 00001 2 00010 3 00011
4 00100 5 00101 6 00110 7 00111
8 01000 9 01001 10 01010 11 01011
12 01100 13 01101 14 01110 15 01111
16 10000 17 10001 18 10010 19 10011
20 10100 21 10101 22 10110 23 10111
24 11000 25 11001 26 11010 27 11011
28 11100 29 11101 30 11110 31 11111
}
}
# ### ### ### ######### ######### #########
#= Registration
package provide base32::core 0.1
|
