1# aes.tcl -
2#
3# Copyright (c) 2005 Thorsten Schloermann
4# Copyright (c) 2005 Pat Thoyts <patthoyts@users.sourceforge.net>
5#
6# A Tcl implementation of the Advanced Encryption Standard (US FIPS PUB 197)
7#
8# AES is a block cipher with a block size of 128 bits and a variable
9# key size of 128, 192 or 256 bits.
10# The algorithm works on each block as a 4x4 state array. There are 4 steps
11# in each round:
12#   SubBytes    a non-linear substitution step using a predefined S-box
13#   ShiftRows   cyclic transposition of rows in the state matrix
14#   MixColumns  transformation upon columns in the state matrix
15#   AddRoundKey application of round specific sub-key
16#
17# -------------------------------------------------------------------------
18# See the file "license.terms" for information on usage and redistribution
19# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20# -------------------------------------------------------------------------
21
22package require Tcl 8.2
23
24namespace eval ::aes {
25    variable version 1.0.2
26    variable rcsid {$Id: aes.tcl,v 1.7 2010/07/06 19:39:00 andreas_kupries Exp $}
27    variable uid ; if {![info exists uid]} { set uid 0 }
28
29    namespace export {aes}
30
31    # constants
32
33    # S-box
34    variable sbox {
35        0x63 0x7c 0x77 0x7b 0xf2 0x6b 0x6f 0xc5 0x30 0x01 0x67 0x2b 0xfe 0xd7 0xab 0x76
36        0xca 0x82 0xc9 0x7d 0xfa 0x59 0x47 0xf0 0xad 0xd4 0xa2 0xaf 0x9c 0xa4 0x72 0xc0
37        0xb7 0xfd 0x93 0x26 0x36 0x3f 0xf7 0xcc 0x34 0xa5 0xe5 0xf1 0x71 0xd8 0x31 0x15
38        0x04 0xc7 0x23 0xc3 0x18 0x96 0x05 0x9a 0x07 0x12 0x80 0xe2 0xeb 0x27 0xb2 0x75
39        0x09 0x83 0x2c 0x1a 0x1b 0x6e 0x5a 0xa0 0x52 0x3b 0xd6 0xb3 0x29 0xe3 0x2f 0x84
40        0x53 0xd1 0x00 0xed 0x20 0xfc 0xb1 0x5b 0x6a 0xcb 0xbe 0x39 0x4a 0x4c 0x58 0xcf
41        0xd0 0xef 0xaa 0xfb 0x43 0x4d 0x33 0x85 0x45 0xf9 0x02 0x7f 0x50 0x3c 0x9f 0xa8
42        0x51 0xa3 0x40 0x8f 0x92 0x9d 0x38 0xf5 0xbc 0xb6 0xda 0x21 0x10 0xff 0xf3 0xd2
43        0xcd 0x0c 0x13 0xec 0x5f 0x97 0x44 0x17 0xc4 0xa7 0x7e 0x3d 0x64 0x5d 0x19 0x73
44        0x60 0x81 0x4f 0xdc 0x22 0x2a 0x90 0x88 0x46 0xee 0xb8 0x14 0xde 0x5e 0x0b 0xdb
45        0xe0 0x32 0x3a 0x0a 0x49 0x06 0x24 0x5c 0xc2 0xd3 0xac 0x62 0x91 0x95 0xe4 0x79
46        0xe7 0xc8 0x37 0x6d 0x8d 0xd5 0x4e 0xa9 0x6c 0x56 0xf4 0xea 0x65 0x7a 0xae 0x08
47        0xba 0x78 0x25 0x2e 0x1c 0xa6 0xb4 0xc6 0xe8 0xdd 0x74 0x1f 0x4b 0xbd 0x8b 0x8a
48        0x70 0x3e 0xb5 0x66 0x48 0x03 0xf6 0x0e 0x61 0x35 0x57 0xb9 0x86 0xc1 0x1d 0x9e
49        0xe1 0xf8 0x98 0x11 0x69 0xd9 0x8e 0x94 0x9b 0x1e 0x87 0xe9 0xce 0x55 0x28 0xdf
50        0x8c 0xa1 0x89 0x0d 0xbf 0xe6 0x42 0x68 0x41 0x99 0x2d 0x0f 0xb0 0x54 0xbb 0x16
51    }
52    # inverse S-box
53    variable xobs {
54        0x52 0x09 0x6a 0xd5 0x30 0x36 0xa5 0x38 0xbf 0x40 0xa3 0x9e 0x81 0xf3 0xd7 0xfb
55        0x7c 0xe3 0x39 0x82 0x9b 0x2f 0xff 0x87 0x34 0x8e 0x43 0x44 0xc4 0xde 0xe9 0xcb
56        0x54 0x7b 0x94 0x32 0xa6 0xc2 0x23 0x3d 0xee 0x4c 0x95 0x0b 0x42 0xfa 0xc3 0x4e
57        0x08 0x2e 0xa1 0x66 0x28 0xd9 0x24 0xb2 0x76 0x5b 0xa2 0x49 0x6d 0x8b 0xd1 0x25
58        0x72 0xf8 0xf6 0x64 0x86 0x68 0x98 0x16 0xd4 0xa4 0x5c 0xcc 0x5d 0x65 0xb6 0x92
59        0x6c 0x70 0x48 0x50 0xfd 0xed 0xb9 0xda 0x5e 0x15 0x46 0x57 0xa7 0x8d 0x9d 0x84
60        0x90 0xd8 0xab 0x00 0x8c 0xbc 0xd3 0x0a 0xf7 0xe4 0x58 0x05 0xb8 0xb3 0x45 0x06
61        0xd0 0x2c 0x1e 0x8f 0xca 0x3f 0x0f 0x02 0xc1 0xaf 0xbd 0x03 0x01 0x13 0x8a 0x6b
62        0x3a 0x91 0x11 0x41 0x4f 0x67 0xdc 0xea 0x97 0xf2 0xcf 0xce 0xf0 0xb4 0xe6 0x73
63        0x96 0xac 0x74 0x22 0xe7 0xad 0x35 0x85 0xe2 0xf9 0x37 0xe8 0x1c 0x75 0xdf 0x6e
64        0x47 0xf1 0x1a 0x71 0x1d 0x29 0xc5 0x89 0x6f 0xb7 0x62 0x0e 0xaa 0x18 0xbe 0x1b
65        0xfc 0x56 0x3e 0x4b 0xc6 0xd2 0x79 0x20 0x9a 0xdb 0xc0 0xfe 0x78 0xcd 0x5a 0xf4
66        0x1f 0xdd 0xa8 0x33 0x88 0x07 0xc7 0x31 0xb1 0x12 0x10 0x59 0x27 0x80 0xec 0x5f
67        0x60 0x51 0x7f 0xa9 0x19 0xb5 0x4a 0x0d 0x2d 0xe5 0x7a 0x9f 0x93 0xc9 0x9c 0xef
68        0xa0 0xe0 0x3b 0x4d 0xae 0x2a 0xf5 0xb0 0xc8 0xeb 0xbb 0x3c 0x83 0x53 0x99 0x61
69        0x17 0x2b 0x04 0x7e 0xba 0x77 0xd6 0x26 0xe1 0x69 0x14 0x63 0x55 0x21 0x0c 0x7d
70    }
71}
72
73# aes::Init --
74#
75#	Initialise our AES state and calculate the key schedule. An initialization
76#	vector is maintained in the state for modes that require one. The key must
77#	be binary data of the correct size and the IV must be 16 bytes.
78#
79#	Nk: columns of the key-array
80#	Nr: number of rounds (depends on key-length)
81#	Nb: columns of the text-block, is always 4 in AES
82#
83proc ::aes::Init {mode key iv} {
84    switch -exact -- $mode {
85        ecb - cbc { }
86        cfb - ofb {
87            return -code error "$mode mode not implemented"
88        }
89        default {
90            return -code error "invalid mode \"$mode\":\
91                must be one of ecb or cbc."
92        }
93    }
94
95    set size [expr {[string length $key] << 3}]
96    switch -exact -- $size {
97        128 {set Nk 4; set Nr 10; set Nb 4}
98        192 {set Nk 6; set Nr 12; set Nb 4}
99        256 {set Nk 8; set Nr 14; set Nb 4}
100        default {
101            return -code error "invalid key size \"$size\":\
102                must be one of 128, 192 or 256."
103        }
104    }
105
106    variable uid
107    set Key [namespace current]::[incr uid]
108    upvar #0 $Key state
109    array set state [list M $mode K $key I $iv Nk $Nk Nr $Nr Nb $Nb W {}]
110    ExpandKey $Key
111    return $Key
112}
113
114# aes::Reset --
115#
116#	Reset the initialization vector for the specified key. This permits the
117#	key to be reused for encryption or decryption without the expense of
118#	re-calculating the key schedule.
119#
120proc ::aes::Reset {Key iv} {
121    upvar #0 $Key state
122    set state(I) $iv
123    return
124}
125
126# aes::Final --
127#
128#	Clean up the key state
129#
130proc ::aes::Final {Key} {
131    # FRINK: nocheck
132    unset $Key
133}
134
135# -------------------------------------------------------------------------
136
137# 5.1 Cipher:  Encipher a single block of 128 bits.
138proc ::aes::EncryptBlock {Key block} {
139    upvar #0 $Key state
140    if {[binary scan $block I4 data] != 1} {
141        return -code error "invalid block size: blocks must be 16 bytes"
142    }
143
144    if {[string equal $state(M) cbc]} {
145        if {[binary scan $state(I) I4 iv] != 1} {
146            return -code error "invalid initialization vector: must be 16 bytes"
147        }
148        for {set n 0} {$n < 4} {incr n} {
149            lappend data2 [expr {0xffffffff & ([lindex $data $n] ^ [lindex $iv $n])}]
150        }
151        set data $data2
152    }
153
154    set data [AddRoundKey $Key 0 $data]
155    for {set n 1} {$n < $state(Nr)} {incr n} {
156        set data [AddRoundKey $Key $n [MixColumns [ShiftRows [SubBytes $data]]]]
157    }
158    set data [AddRoundKey $Key $n [ShiftRows [SubBytes $data]]]
159
160    # Bug 2993029:
161    # Force all elements of data into the 32bit range.
162    set res {}
163    foreach d $data {
164        lappend res [expr {$d & 0xffffffff}]
165    }
166    set data $res
167
168    return [set state(I) [binary format I4 $data]]
169}
170
171# 5.3: Inverse Cipher: Decipher a single 128 bit block.
172proc ::aes::DecryptBlock {Key block} {
173    upvar #0 $Key state
174    if {[binary scan $block I4 data] != 1} {
175        return -code error "invalid block size: block must be 16 bytes"
176    }
177
178    set n $state(Nr)
179    set data [AddRoundKey $Key $state(Nr) $data]
180    for {incr n -1} {$n > 0} {incr n -1} {
181        set data [InvMixColumns [AddRoundKey $Key $n [InvSubBytes [InvShiftRows $data]]]]
182    }
183    set data [AddRoundKey $Key $n [InvSubBytes [InvShiftRows $data]]]
184
185    if {[string equal $state(M) cbc]} {
186        if {[binary scan $state(I) I4 iv] != 1} {
187            return -code error "invalid initialization vector: must be 16 bytes"
188        }
189        for {set n 0} {$n < 4} {incr n} {
190            lappend data2 [expr {0xffffffff & ([lindex $data $n] ^ [lindex $iv $n])}]
191        }
192        set data $data2
193    } else {
194        # Bug 2993029:
195        # Force all elements of data into the 32bit range.
196        # The trimming we see above only happens for CBC mode.
197        set res {}
198        foreach d $data {
199            lappend res [expr {$d & 0xffffffff}]
200        }
201        set data $res
202    }
203
204    set state(I) $block
205    return [binary format I4 $data]
206}
207
208# 5.2: KeyExpansion
209proc ::aes::ExpandKey {Key} {
210    upvar #0 $Key state
211    set Rcon [list 0x00000000 0x01000000 0x02000000 0x04000000 0x08000000 \
212                  0x10000000 0x20000000 0x40000000 0x80000000 0x1b000000 \
213                  0x36000000 0x6c000000 0xd8000000 0xab000000 0x4d000000]
214    # Split the key into Nk big-endian words
215    binary scan $state(K) I* W
216    set max [expr {$state(Nb) * ($state(Nr) + 1)}]
217    set i $state(Nk)
218    set h $state(Nk) ; incr h -1
219    set j 0
220    for {} {$i < $max} {incr i; incr h; incr j} {
221        set temp [lindex $W $h]
222        if {($i % $state(Nk)) == 0} {
223            set sub [SubWord [RotWord $temp]]
224            set rc [lindex $Rcon [expr {$i/$state(Nk)}]]
225            set temp [expr {$sub ^ $rc}]
226        } elseif {$state(Nk) > 6 && ($i % $state(Nk)) == 4} {
227            set temp [SubWord $temp]
228        }
229        lappend W [expr {[lindex $W $j] ^ $temp}]
230    }
231    set state(W) $W
232    return
233}
234
235# 5.2: Key Expansion: Apply S-box to each byte in the 32 bit word
236proc ::aes::SubWord {w} {
237    variable sbox
238    set s3 [lindex $sbox [expr {(($w >> 24) & 255)}]]
239    set s2 [lindex $sbox [expr {(($w >> 16) & 255)}]]
240    set s1 [lindex $sbox [expr {(($w >> 8 ) & 255)}]]
241    set s0 [lindex $sbox [expr {( $w        & 255)}]]
242    return [expr {($s3 << 24) | ($s2 << 16) | ($s1 << 8) | $s0}]
243}
244
245proc ::aes::InvSubWord {w} {
246    variable xobs
247    set s3 [lindex $xobs [expr {(($w >> 24) & 255)}]]
248    set s2 [lindex $xobs [expr {(($w >> 16) & 255)}]]
249    set s1 [lindex $xobs [expr {(($w >> 8 ) & 255)}]]
250    set s0 [lindex $xobs [expr {( $w        & 255)}]]
251    return [expr {($s3 << 24) | ($s2 << 16) | ($s1 << 8) | $s0}]
252}
253
254# 5.2: Key Expansion: Rotate a 32bit word by 8 bits
255proc ::aes::RotWord {w} {
256    return [expr {(($w << 8) | (($w >> 24) & 0xff)) & 0xffffffff}]
257}
258
259# 5.1.1: SubBytes() Transformation
260proc ::aes::SubBytes {words} {
261    set r {}
262    foreach w $words {
263        lappend r [SubWord $w]
264    }
265    return $r
266}
267
268# 5.3.2: InvSubBytes() Transformation
269proc ::aes::InvSubBytes {words} {
270    set r {}
271    foreach w $words {
272        lappend r [InvSubWord $w]
273    }
274    return $r
275}
276
277# 5.1.2: ShiftRows() Transformation
278proc ::aes::ShiftRows {words} {
279    for {set n0 0} {$n0 < 4} {incr n0} {
280        set n1 [expr {($n0 + 1) % 4}]
281        set n2 [expr {($n0 + 2) % 4}]
282        set n3 [expr {($n0 + 3) % 4}]
283        lappend r [expr {(  [lindex $words $n0] & 0xff000000)
284                         | ([lindex $words $n1] & 0x00ff0000)
285                         | ([lindex $words $n2] & 0x0000ff00)
286                         | ([lindex $words $n3] & 0x000000ff)
287                     }]
288    }
289    return $r
290}
291
292
293# 5.3.1: InvShiftRows() Transformation
294proc ::aes::InvShiftRows {words} {
295    for {set n0 0} {$n0 < 4} {incr n0} {
296        set n1 [expr {($n0 + 1) % 4}]
297        set n2 [expr {($n0 + 2) % 4}]
298        set n3 [expr {($n0 + 3) % 4}]
299        lappend r [expr {(  [lindex $words $n0] & 0xff000000)
300                         | ([lindex $words $n3] & 0x00ff0000)
301                         | ([lindex $words $n2] & 0x0000ff00)
302                         | ([lindex $words $n1] & 0x000000ff)
303                     }]
304    }
305    return $r
306}
307
308# 5.1.3: MixColumns() Transformation
309proc ::aes::MixColumns {words} {
310    set r {}
311    foreach w $words {
312        set r0 [expr {(($w >> 24) & 255)}]
313        set r1 [expr {(($w >> 16) & 255)}]
314        set r2 [expr {(($w >> 8 ) & 255)}]
315        set r3 [expr {( $w        & 255)}]
316
317        set s0 [expr {[GFMult2 $r0] ^ [GFMult3 $r1] ^ $r2 ^ $r3}]
318        set s1 [expr {$r0 ^ [GFMult2 $r1] ^ [GFMult3 $r2] ^ $r3}]
319        set s2 [expr {$r0 ^ $r1 ^ [GFMult2 $r2] ^ [GFMult3 $r3]}]
320        set s3 [expr {[GFMult3 $r0] ^ $r1 ^ $r2 ^ [GFMult2 $r3]}]
321
322        lappend r [expr {($s0 << 24) | ($s1 << 16) | ($s2 << 8) | $s3}]
323    }
324    return $r
325}
326
327# 5.3.3: InvMixColumns() Transformation
328proc ::aes::InvMixColumns {words} {
329    set r {}
330    foreach w $words {
331        set r0 [expr {(($w >> 24) & 255)}]
332        set r1 [expr {(($w >> 16) & 255)}]
333        set r2 [expr {(($w >> 8 ) & 255)}]
334        set r3 [expr {( $w        & 255)}]
335
336        set s0 [expr {[GFMult0e $r0] ^ [GFMult0b $r1] ^ [GFMult0d $r2] ^ [GFMult09 $r3]}]
337        set s1 [expr {[GFMult09 $r0] ^ [GFMult0e $r1] ^ [GFMult0b $r2] ^ [GFMult0d $r3]}]
338        set s2 [expr {[GFMult0d $r0] ^ [GFMult09 $r1] ^ [GFMult0e $r2] ^ [GFMult0b $r3]}]
339        set s3 [expr {[GFMult0b $r0] ^ [GFMult0d $r1] ^ [GFMult09 $r2] ^ [GFMult0e $r3]}]
340
341        lappend r [expr {($s0 << 24) | ($s1 << 16) | ($s2 << 8) | $s3}]
342    }
343    return $r
344}
345
346# 5.1.4: AddRoundKey() Transformation
347proc ::aes::AddRoundKey {Key round words} {
348    upvar #0 $Key state
349    set r {}
350    set n [expr {$round * $state(Nb)}]
351    foreach w $words {
352        lappend r [expr {$w ^ [lindex $state(W) $n]}]
353        incr n
354    }
355    return $r
356}
357
358# -------------------------------------------------------------------------
359# ::aes::GFMult*
360#
361#	some needed functions for multiplication in a Galois-field
362#
363proc ::aes::GFMult2 {number} {
364    # this is a tabular representation of xtime (multiplication by 2)
365    # it is used instead of calculation to prevent timing attacks
366    set xtime {
367        0x00 0x02 0x04 0x06 0x08 0x0a 0x0c 0x0e 0x10 0x12 0x14 0x16 0x18 0x1a 0x1c 0x1e
368        0x20 0x22 0x24 0x26 0x28 0x2a 0x2c 0x2e 0x30 0x32 0x34 0x36 0x38 0x3a 0x3c 0x3e
369        0x40 0x42 0x44 0x46 0x48 0x4a 0x4c 0x4e 0x50 0x52 0x54 0x56 0x58 0x5a 0x5c 0x5e
370        0x60 0x62 0x64 0x66 0x68 0x6a 0x6c 0x6e 0x70 0x72 0x74 0x76 0x78 0x7a 0x7c 0x7e
371        0x80 0x82 0x84 0x86 0x88 0x8a 0x8c 0x8e 0x90 0x92 0x94 0x96 0x98 0x9a 0x9c 0x9e
372        0xa0 0xa2 0xa4 0xa6 0xa8 0xaa 0xac 0xae 0xb0 0xb2 0xb4 0xb6 0xb8 0xba 0xbc 0xbe
373        0xc0 0xc2 0xc4 0xc6 0xc8 0xca 0xcc 0xce 0xd0 0xd2 0xd4 0xd6 0xd8 0xda 0xdc 0xde
374        0xe0 0xe2 0xe4 0xe6 0xe8 0xea 0xec 0xee 0xf0 0xf2 0xf4 0xf6 0xf8 0xfa 0xfc 0xfe
375        0x1b 0x19 0x1f 0x1d 0x13 0x11 0x17 0x15 0x0b 0x09 0x0f 0x0d 0x03 0x01 0x07 0x05
376        0x3b 0x39 0x3f 0x3d 0x33 0x31 0x37 0x35 0x2b 0x29 0x2f 0x2d 0x23 0x21 0x27 0x25
377        0x5b 0x59 0x5f 0x5d 0x53 0x51 0x57 0x55 0x4b 0x49 0x4f 0x4d 0x43 0x41 0x47 0x45
378        0x7b 0x79 0x7f 0x7d 0x73 0x71 0x77 0x75 0x6b 0x69 0x6f 0x6d 0x63 0x61 0x67 0x65
379        0x9b 0x99 0x9f 0x9d 0x93 0x91 0x97 0x95 0x8b 0x89 0x8f 0x8d 0x83 0x81 0x87 0x85
380        0xbb 0xb9 0xbf 0xbd 0xb3 0xb1 0xb7 0xb5 0xab 0xa9 0xaf 0xad 0xa3 0xa1 0xa7 0xa5
381        0xdb 0xd9 0xdf 0xdd 0xd3 0xd1 0xd7 0xd5 0xcb 0xc9 0xcf 0xcd 0xc3 0xc1 0xc7 0xc5
382        0xfb 0xf9 0xff 0xfd 0xf3 0xf1 0xf7 0xf5 0xeb 0xe9 0xef 0xed 0xe3 0xe1 0xe7 0xe5
383    }
384    return [lindex $xtime $number]
385}
386
387proc ::aes::GFMult3 {number} {
388    # multliply by 2 (via GFMult2) and add the number again on the result (via XOR)
389    return [expr {$number ^ [GFMult2 $number]}]
390}
391
392proc ::aes::GFMult09 {number} {
393    # 09 is: (02*02*02) + 01
394    return [expr {[GFMult2 [GFMult2 [GFMult2 $number]]] ^ $number}]
395}
396
397proc ::aes::GFMult0b {number} {
398    # 0b is: (02*02*02) + 02 + 01
399    #return [expr [GFMult2 [GFMult2 [GFMult2 $number]]] ^ [GFMult2 $number] ^ $number]
400    #set g0 [GFMult2 $number]
401    return [expr {[GFMult09 $number] ^ [GFMult2 $number]}]
402}
403
404proc ::aes::GFMult0d {number} {
405    # 0d is: (02*02*02) + (02*02) + 01
406    set temp [GFMult2 [GFMult2 $number]]
407    return [expr {[GFMult2 $temp] ^ ($temp ^ $number)}]
408}
409
410proc ::aes::GFMult0e {number} {
411    # 0e is: (02*02*02) + (02*02) + 02
412    set temp [GFMult2 [GFMult2 $number]]
413    return [expr {[GFMult2 $temp] ^ ($temp ^ [GFMult2 $number])}]
414}
415
416# -------------------------------------------------------------------------
417
418# aes::Encrypt --
419#
420#	Encrypt a blocks of plain text and returns blocks of cipher text.
421#	The input data must be a multiple of the block size (16).
422#
423proc ::aes::Encrypt {Key data} {
424    set len [string length $data]
425    if {($len % 16) != 0} {
426        return -code error "invalid block size: AES requires 16 byte blocks"
427    }
428
429    set result {}
430    for {set i 0} {$i < $len} {incr i 1} {
431        set block [string range $data $i [incr i 15]]
432        append result [EncryptBlock $Key $block]
433    }
434    return $result
435}
436
437# aes::DecryptBlock --
438#
439#	Decrypt a blocks of cipher text and returns blocks of plain text.
440#	The input data must be a multiple of the block size (16).
441#
442proc ::aes::Decrypt {Key data} {
443    set len [string length $data]
444    if {($len % 16) != 0} {
445        return -code error "invalid block size: AES requires 16 byte blocks"
446    }
447
448    set result {}
449    for {set i 0} {$i < $len} {incr i 1} {
450        set block [string range $data $i [incr i 15]]
451        append result [DecryptBlock $Key $block]
452    }
453    return $result
454}
455
456# -------------------------------------------------------------------------
457# Fileevent handler for chunked file reading.
458#
459proc ::aes::Chunk {Key in {out {}} {chunksize 4096}} {
460    upvar #0 $Key state
461
462    if {[eof $in]} {
463        fileevent $in readable {}
464        set state(reading) 0
465    }
466
467    set data [read $in $chunksize]
468    # FIX ME: we should ony pad after eof
469    set data [Pad $data 16]
470
471    if {$out == {}} {
472        append state(output) [$state(cmd) $Key $data]
473    } else {
474        puts -nonewline $out [$state(cmd) $Key $data]
475    }
476}
477
478proc ::aes::SetOneOf {lst item} {
479    set ndx [lsearch -glob $lst "${item}*"]
480    if {$ndx == -1} {
481        set err [join $lst ", "]
482        return -code error "invalid mode \"$item\": must be one of $err"
483    }
484    return [lindex $lst $ndx]
485}
486
487proc ::aes::CheckSize {what size thing} {
488    if {[string length $thing] != $size} {
489        return -code error "invalid value for $what: must be $size bytes long"
490    }
491    return $thing
492}
493
494proc ::aes::Pad {data blocksize {fill \0}} {
495    set len [string length $data]
496    if {$len == 0} {
497        set data [string repeat $fill $blocksize]
498    } elseif {($len % $blocksize) != 0} {
499        set pad [expr {$blocksize - ($len % $blocksize)}]
500        append data [string repeat $fill $pad]
501    }
502    return $data
503}
504
505proc ::aes::Pop {varname {nth 0}} {
506    upvar 1 $varname args
507    set r [lindex $args $nth]
508    set args [lreplace $args $nth $nth]
509    return $r
510}
511
512proc ::aes::Hex {data} {
513    binary scan $data H* r
514    return $r
515}
516
517proc ::aes::aes {args} {
518    array set opts {-dir encrypt -mode cbc -key {} -in {} -out {} -chunksize 4096 -hex 0}
519    set opts(-iv) [string repeat \0 16]
520    set modes {ecb cbc}
521    set dirs {encrypt decrypt}
522    while {[string match -* [set option [lindex $args 0]]]} {
523        switch -exact -- $option {
524            -mode      { set opts(-mode) [SetOneOf $modes [Pop args 1]] }
525            -dir       { set opts(-dir) [SetOneOf $dirs [Pop args 1]] }
526            -iv        { set opts(-iv) [CheckSize -iv 16 [Pop args 1]] }
527            -key       { set opts(-key) [Pop args 1] }
528            -in        { set opts(-in) [Pop args 1] }
529            -out       { set opts(-out) [Pop args 1] }
530            -chunksize { set opts(-chunksize) [Pop args 1] }
531            -hex       { set opts(-hex) 1 }
532            --         { Pop args ; break }
533            default {
534                set err [join [lsort [array names opts]] ", "]
535                return -code error "bad option \"$option\":\
536                    must be one of $err"
537            }
538        }
539        Pop args
540    }
541
542    if {$opts(-key) == {}} {
543        return -code error "no key provided: the -key option is required"
544    }
545
546    set r {}
547    if {$opts(-in) == {}} {
548
549        if {[llength $args] != 1} {
550            return -code error "wrong \# args:\
551                should be \"aes ?options...? -key keydata plaintext\""
552        }
553
554        set data [Pad [lindex $args 0] 16]
555        set Key [Init $opts(-mode) $opts(-key) $opts(-iv)]
556        if {[string equal $opts(-dir) "encrypt"]} {
557            set r [Encrypt $Key $data]
558        } else {
559            set r [Decrypt $Key $data]
560        }
561
562        if {$opts(-out) != {}} {
563            puts -nonewline $opts(-out) $r
564            set r {}
565        }
566        Final $Key
567
568    } else {
569
570        if {[llength $args] != 0} {
571            return -code error "wrong \# args:\
572                should be \"aes ?options...? -key keydata -in channel\""
573        }
574
575        set Key [Init $opts(-mode) $opts(-key) $opts(-iv)]
576        upvar 1 $Key state
577        set state(reading) 1
578        if {[string equal $opts(-dir) "encrypt"]} {
579            set state(cmd) Encrypt
580        } else {
581            set state(cmd) Decrypt
582        }
583        set state(output) ""
584        fileevent $opts(-in) readable \
585            [list [namespace origin Chunk] \
586                 $Key $opts(-in) $opts(-out) $opts(-chunksize)]
587        if {[info commands ::tkwait] != {}} {
588            tkwait variable [subst $Key](reading)
589        } else {
590            vwait [subst $Key](reading)
591        }
592        if {$opts(-out) == {}} {
593            set r $state(output)
594        }
595        Final $Key
596
597    }
598
599    if {$opts(-hex)} {
600        set r [Hex $r]
601    }
602    return $r
603}
604
605# -------------------------------------------------------------------------
606
607package provide aes $::aes::version
608
609# -------------------------------------------------------------------------
610# Local variables:
611# mode: tcl
612# indent-tabs-mode: nil
613# End:
614