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