From time to time it seems someone posts on comp.lang.tcl looking for a crypt function. The tclhttpd package has a C-implementation. As an experiment I decided to convert a C crypt function to Tcl.
I used the C source code to AOLserver's ns_crypt function [L1 ] as a reference.
On my aging P-133 my original Tcl version took over 36 seconds to encrypt a single password. After placing braces around each expression to be evaluated by expr performance sped up to about 4.0/4.1 seconds on average. In comparison, on the same computer, the C version from the tclhttpd package runs in 713 microseconds. Still, I suppose there may be instances where a pure-Tcl version is desirable, and in a few years processors will be fast enough that maybe it won't make a noticeable difference. :-)
-- Michael A. Cleverly (23/Nov/2000)
AK 19 Jun 2003: The license of AOLserver [L2 ] is the Mozilla Public License [L3 ], and not GPL. MC: In deed it is, though an offer of dual-licensing is made (see Exhibit A of the AOLserver license). The MPL is more compatible with the Tcl license obviously.
On my PIII notebook under 8.4 this now takes 0.6 s to encrypt a single password. -- SC (August 2001)
Vince -- I notice that most of the arrays here are actually used like C arrays $IP(0), $IP(1), etc. Wouldn't the code be faster if those were changed to list accesses? i.e. instead of:
array set IP { 0 58 1 50 ... }
foo $IP($i)use:
set IP [list 58 50 42 ...] foo [lindex $IP $i]
I would be interested to hear how much of a difference it makes.
BBH - (23 Jan 2001) Actually accessing a single element is faster via array than list, (on my machine 3usec vs. 5usec) and setting is even more so.
compare
set ary($idx) [expr {$ary($idx2) * 3}]with
set lst [lreplace $lst $idx $idx [expr {[lindex $lst $idx2] *3}]]much less readable and in my test about 2.5 times slower
DGP - ...but how about using [lset] (in Tcl 8.4) ?!
MC 20 Jun 2003: I've rewritten it to use [lset] (see below). Seems to run 40-45% faster.
PT 20 Jun 2003: This seems nice and quite fast (0.2 sec per iteration on a PIII 800). However there are 3 NUL characters on the end of my string.
perl -e 'print length(crypt("secret", "az"));'gives 13 while
set c [crypt8.4 secret az] string length $c
gives 16. The crypt strings are identical apart from the 3 NUL suffix.
Are we going to put this into tcllib one day? Or is the license incompatible?
MC 20 Jun 2003: Fixed the extraneous null characters on the end. I pre-allocated too many elements in iobuf (since lset can't create new elements).
proc crypt {password salt} {
array set IP {
0 58 1 50 2 42 3 34 4 26 5 18 6 10 7 2
8 60 9 52 10 44 11 36 12 28 13 20 14 12 15 4
16 62 17 54 18 46 19 38 20 30 21 22 22 14 23 6
24 64 25 56 26 48 27 40 28 32 29 24 30 16 31 8
32 57 33 49 34 41 35 33 36 25 37 17 38 9 39 1
40 59 41 51 42 43 43 35 44 27 45 19 46 11 47 3
48 61 49 53 50 45 51 37 52 29 53 21 54 13 55 5
56 63 57 55 58 47 59 39 60 31 61 23 62 15 63 7}
array set FP {
0 40 1 8 2 48 3 16 4 56 5 24 6 64 7 32
8 39 9 7 10 47 11 15 12 55 13 23 14 63 15 31
16 38 17 6 18 46 19 14 20 54 21 22 22 62 23 30
24 37 25 5 26 45 27 13 28 53 29 21 30 61 31 29
32 36 33 4 34 44 35 12 36 52 37 20 38 60 39 28
40 35 41 3 42 43 43 11 44 51 45 19 46 59 47 27
48 34 49 2 50 42 51 10 52 50 53 18 54 58 55 26
56 33 57 1 58 41 59 9 60 49 61 17 62 57 63 25}
array set PC1_C {
0 57 1 49 2 41 3 33 4 25 5 17 6 9
7 1 8 58 9 50 10 42 11 34 12 26 13 18
14 10 15 2 16 59 17 51 18 43 19 35 20 27
21 19 22 11 23 3 24 60 25 52 26 44 27 36}
array set PC1_D {
0 63 1 55 2 47 3 39 4 31 5 23 6 15
7 7 8 62 9 54 10 46 11 38 12 30 13 22
14 14 15 6 16 61 17 53 18 45 19 37 20 29
21 21 22 13 23 5 24 28 25 20 26 12 27 4}
array set shifts {
0 1 1 1 2 2 3 2 4 2 5 2 6 2 7 2
8 1 9 2 10 2 11 2 12 2 13 2 14 2 15 1}
array set PC2_C {
0 14 1 17 2 11 3 24 4 1 5 5
6 3 7 28 8 15 9 6 10 21 11 10
12 23 13 19 14 12 15 4 16 26 17 8
18 16 19 7 20 27 21 20 22 13 23 2}
array set PC2_D {
0 41 1 52 2 31 3 37 4 47 5 55
6 30 7 40 8 51 9 45 10 33 11 48
12 44 13 49 14 39 15 56 16 34 17 53
18 46 19 42 20 50 21 36 22 29 23 32}
array set e {
0 32 1 1 2 2 3 3 4 4 5 5
6 4 7 5 8 6 9 7 10 8 11 9
12 8 13 9 14 10 15 11 16 12 17 13
18 12 19 13 20 14 21 15 22 16 23 17
24 16 25 17 26 18 27 19 28 20 29 21
30 20 31 21 32 22 33 23 34 24 35 25
36 24 37 25 38 26 39 27 40 28 41 29
42 28 43 29 44 30 45 31 46 32 47 1}
array set S {
0,0 14 0,1 4 0,2 13 0,3 1 0,4 2 0,5 15 0,6 11 0,7 8
0,8 3 0,9 10 0,10 6 0,11 12 0,12 5 0,13 9 0,14 0 0,15 7
0,16 0 0,17 15 0,18 7 0,19 4 0,20 14 0,21 2 0,22 13 0,23 1
0,24 10 0,25 6 0,26 12 0,27 11 0,28 9 0,29 5 0,30 3 0,31 8
0,32 4 0,33 1 0,34 14 0,35 8 0,36 13 0,37 6 0,38 2 0,39 11
0,40 15 0,41 12 0,42 9 0,43 7 0,44 3 0,45 10 0,46 5 0,47 0
0,48 15 0,49 12 0,50 8 0,51 2 0,52 4 0,53 9 0,54 1 0,55 7
0,56 5 0,57 11 0,58 3 0,59 14 0,60 10 0,61 0 0,62 6 0,63 13
1,0 15 1,1 1 1,2 8 1,3 14 1,4 6 1,5 11 1,6 3 1,7 4
1,8 9 1,9 7 1,10 2 1,11 13 1,12 12 1,13 0 1,14 5 1,15 10
1,16 3 1,17 13 1,18 4 1,19 7 1,20 15 1,21 2 1,22 8 1,23 14
1,24 12 1,25 0 1,26 1 1,27 10 1,28 6 1,29 9 1,30 11 1,31 5
1,32 0 1,33 14 1,34 7 1,35 11 1,36 10 1,37 4 1,38 13 1,39 1
1,40 5 1,41 8 1,42 12 1,43 6 1,44 9 1,45 3 1,46 2 1,47 15
1,48 13 1,49 8 1,50 10 1,51 1 1,52 3 1,53 15 1,54 4 1,55 2
1,56 11 1,57 6 1,58 7 1,59 12 1,60 0 1,61 5 1,62 14 1,63 9
2,0 10 2,1 0 2,2 9 2,3 14 2,4 6 2,5 3 2,6 15 2,7 5
2,8 1 2,9 13 2,10 12 2,11 7 2,12 11 2,13 4 2,14 2 2,15 8
2,16 13 2,17 7 2,18 0 2,19 9 2,20 3 2,21 4 2,22 6 2,23 10
2,24 2 2,25 8 2,26 5 2,27 14 2,28 12 2,29 11 2,30 15 2,31 1
2,32 13 2,33 6 2,34 4 2,35 9 2,36 8 2,37 15 2,38 3 2,39 0
2,40 11 2,41 1 2,42 2 2,43 12 2,44 5 2,45 10 2,46 14 2,47 7
2,48 1 2,49 10 2,50 13 2,51 0 2,52 6 2,53 9 2,54 8 2,55 7
2,56 4 2,57 15 2,58 14 2,59 3 2,60 11 2,61 5 2,62 2 2,63 12
3,0 7 3,1 13 3,2 14 3,3 3 3,4 0 3,5 6 3,6 9 3,7 10
3,8 1 3,9 2 3,10 8 3,11 5 3,12 11 3,13 12 3,14 4 3,15 15
3,16 13 3,17 8 3,18 11 3,19 5 3,20 6 3,21 15 3,22 0 3,23 3
3,24 4 3,25 7 3,26 2 3,27 12 3,28 1 3,29 10 3,30 14 3,31 9
3,32 10 3,33 6 3,34 9 3,35 0 3,36 12 3,37 11 3,38 7 3,39 13
3,40 15 3,41 1 3,42 3 3,43 14 3,44 5 3,45 2 3,46 8 3,47 4
3,48 3 3,49 15 3,50 0 3,51 6 3,52 10 3,53 1 3,54 13 3,55 8
3,56 9 3,57 4 3,58 5 3,59 11 3,60 12 3,61 7 3,62 2 3,63 14
4,0 2 4,1 12 4,2 4 4,3 1 4,4 7 4,5 10 4,6 11 4,7 6
4,8 8 4,9 5 4,10 3 4,11 15 4,12 13 4,13 0 4,14 14 4,15 9
4,16 14 4,17 11 4,18 2 4,19 12 4,20 4 4,21 7 4,22 13 4,23 1
4,24 5 4,25 0 4,26 15 4,27 10 4,28 3 4,29 9 4,30 8 4,31 6
4,32 4 4,33 2 4,34 1 4,35 11 4,36 10 4,37 13 4,38 7 4,39 8
4,40 15 4,41 9 4,42 12 4,43 5 4,44 6 4,45 3 4,46 0 4,47 14
4,48 11 4,49 8 4,50 12 4,51 7 4,52 1 4,53 14 4,54 2 4,55 13
4,56 6 4,57 15 4,58 0 4,59 9 4,60 10 4,61 4 4,62 5 4,63 3
5,0 12 5,1 1 5,2 10 5,3 15 5,4 9 5,5 2 5,6 6 5,7 8
5,8 0 5,9 13 5,10 3 5,11 4 5,12 14 5,13 7 5,14 5 5,15 11
5,16 10 5,17 15 5,18 4 5,19 2 5,20 7 5,21 12 5,22 9 5,23 5
5,24 6 5,25 1 5,26 13 5,27 14 5,28 0 5,29 11 5,30 3 5,31 8
5,32 9 5,33 14 5,34 15 5,35 5 5,36 2 5,37 8 5,38 12 5,39 3
5,40 7 5,41 0 5,42 4 5,43 10 5,44 1 5,45 13 5,46 11 5,47 6
5,48 4 5,49 3 5,50 2 5,51 12 5,52 9 5,53 5 5,54 15 5,55 10
5,56 11 5,57 14 5,58 1 5,59 7 5,60 6 5,61 0 5,62 8 5,63 13
6,0 4 6,1 11 6,2 2 6,3 14 6,4 15 6,5 0 6,6 8 6,7 13
6,8 3 6,9 12 6,10 9 6,11 7 6,12 5 6,13 10 6,14 6 6,15 1
6,16 13 6,17 0 6,18 11 6,19 7 6,20 4 6,21 9 6,22 1 6,23 10
6,24 14 6,25 3 6,26 5 6,27 12 6,28 2 6,29 15 6,30 8 6,31 6
6,32 1 6,33 4 6,34 11 6,35 13 6,36 12 6,37 3 6,38 7 6,39 14
6,40 10 6,41 15 6,42 6 6,43 8 6,44 0 6,45 5 6,46 9 6,47 2
6,48 6 6,49 11 6,50 13 6,51 8 6,52 1 6,53 4 6,54 10 6,55 7
6,56 9 6,57 5 6,58 0 6,59 15 6,60 14 6,61 2 6,62 3 6,63 12
7,0 13 7,1 2 7,2 8 7,3 4 7,4 6 7,5 15 7,6 11 7,7 1
7,8 10 7,9 9 7,10 3 7,11 14 7,12 5 7,13 0 7,14 12 7,15 7
7,16 1 7,17 15 7,18 13 7,19 8 7,20 10 7,21 3 7,22 7 7,23 4
7,24 12 7,25 5 7,26 6 7,27 11 7,28 0 7,29 14 7,30 9 7,31 2
7,32 7 7,33 11 7,34 4 7,35 1 7,36 9 7,37 12 7,38 14 7,39 2
7,40 0 7,41 6 7,42 10 7,43 13 7,44 15 7,45 3 7,46 5 7,47 8
7,48 2 7,49 1 7,50 14 7,51 7 7,52 4 7,53 10 7,54 8 7,55 13
7,56 15 7,57 12 7,58 9 7,59 0 7,60 3 7,61 5 7,62 6 7,63 11}
array set P {
0 16 1 7 2 20 3 21
4 29 5 12 6 28 7 17
8 1 9 15 10 23 11 26
12 5 13 18 14 31 15 10
16 2 17 8 18 24 19 14
20 32 21 27 22 3 23 9
24 19 25 13 26 30 27 6
28 22 29 11 30 4 31 25}
for {set i 0} {$i < 66} {incr i} {
set block($i) 0
}
set pw [split $password ""]
set pw_pos 0
for {set i 0} {[scan [lindex $pw $pw_pos] %c c] != -1 && $i < 64} \
{incr pw_pos} {
for {set j 0} {$j < 7} {incr j ; incr i} {
set block($i) [expr {($c >> (6 - $j)) & 01}]
}
incr i
}
for {set i 0} {$i < 28} {incr i} {
set C($i) $block([expr {$PC1_C($i) - 1}])
set D($i) $block([expr {$PC1_D($i) - 1}])
}
for {set i 0} {$i < 16} {incr i} {
for {set k 0} {$k < $shifts($i)} {incr k} {
set t $C(0)
for {set j 0} {$j < 27} {incr j} {
set C($j) $C([expr {$j + 1}])
}
set C(27) $t
set t $D(0)
for {set j 0} {$j < 27} {incr j} {
set D($j) $D([expr {$j + 1}])
}
set D(27) $t
}
for {set j 0} {$j < 24} {incr j} {
set KS($i,$j) $C([expr {$PC2_C($j) - 1}])
set KS($i,[expr {$j + 24}]) $D([expr {$PC2_D($j) - 28 - 1}])
}
}
for {set i 0} {$i < 48} {incr i} {
set E($i) $e($i)
}
for {set i 0} {$i < 66} {incr i} {
set block($i) 0
}
set salt [split $salt ""]
set salt_pos 0
set val_Z 90
set val_9 57
set val_period 46
for {set i 0} {$i < 2} {incr i} {
scan [lindex $salt $salt_pos] %c c
incr salt_pos
set iobuf($i) $c
if {$c > $val_Z} {
incr c -6
}
if {$c > $val_9} {
incr c -7
}
incr c -$val_period
for {set j 0} {$j < 6} {incr j} {
if {[expr {($c >> $j) & 01}]} {
set temp $E([expr {6 * $i + $j}])
set E([expr {6 * $i + $j}]) $E([expr {6 * $i + $j + 24}])
set E([expr {6 * $i + $j + 24}]) $temp
}
}
}
set edflag 0
for {set h 0} {$h < 25} {incr h} {
for {set j 0} {$j < 64} {incr j} {
set L($j) $block([expr {$IP($j) - 1}])
}
for {set ii 0} {$ii < 16} {incr ii} {
if {$edflag} {
set i [expr {15 - $ii}]
} else {
set i $ii
}
for {set j 0} {$j < 32} {incr j} {
set tempL($j) $L([expr {$j + 32}])
}
for {set j 0} {$j < 48} {incr j} {
set preS($j) [expr {$L([expr {$E($j) - 1 + 32}]) ^ $KS($i,$j)}]
}
for {set j 0} {$j < 8} {incr j} {
set t [expr {6 * $j}]
set k $S($j,[expr {($preS($t) << 5) + \
($preS([expr {$t + 1}]) << 3) + \
($preS([expr {$t + 2}]) << 2) + \
($preS([expr {$t + 3}]) << 1) + \
$preS([expr {$t + 4}]) + \
($preS([expr {$t + 5}]) << 4)}])
set t [expr {4 * $j}]
set f($t) [expr {($k >> 3) & 01}]
set f([expr {$t + 1}]) [expr {($k >> 2) & 01}]
set f([expr {$t + 2}]) [expr {($k >> 1) & 01}]
set f([expr {$t + 3}]) [expr { $k & 01}]
}
for {set j 0} {$j < 32} {incr j} {
set L([expr {$j + 32}]) [expr {$L($j) ^ \
$f([expr {$P($j) - 1}])}]
}
for {set j 0} {$j < 32} {incr j} {
set L($j) $tempL($j)
}
}
for {set j 0} {$j < 32} {incr j} {
set t $L($j)
set L($j) $L([expr {$j + 32}])
set L([expr {$j + 32}]) $t
}
for {set j 0} {$j < 64} {incr j} {
set block($j) $L([expr {$FP($j) - 1}])
}
}
for {set i 0} {$i < 11} {incr i} {
set c 0
for {set j 0} {$j < 6} {incr j} {
set c [expr {$c << 1}]
set c [expr {$c | $block([expr {6 * $i + $j}])}]
}
incr c $val_period
if {$c > $val_9} {
incr c 7
}
if {$c > $val_Z} {
incr c 6
}
set iobuf([expr {$i + 2}]) $c
}
if {$iobuf(1) == 0} {
set iobuf(1) $iobuf(0)
}
set elements [lsort -integer [array names iobuf]]
set encrypted ""
foreach element $elements {
append encrypted [format %c $iobuf($element)]
}
return $encrypted
}This version uses the [lset] command introduced in Tcl 8.4. It seems to result in a 40-45% improvement in speed over the original version which used [array]s.
proc crypt8.4 {password salt} {
set IP {58 50 42 34 26 18 10 2 60 52 44 36 28 20 12 4 62 54 46 38 30
22 14 6 64 56 48 40 32 24 16 8 57 49 41 33 25 17 9 1 59 51
43 35 27 19 11 3 61 53 45 37 29 21 13 5 63 55 47 39 31 23 15 7}
set FP {40 8 48 16 56 24 64 32 39 7 47 15 55 23 63 31 38 6 46 14 54
22 62 30 37 5 45 13 53 21 61 29 36 4 44 12 52 20 60 28 35 3
43 11 51 19 59 27 34 2 42 10 50 18 58 26 33 1 41 9 49 17 57 25}
set PC1_C {57 49 41 33 25 17 9 1 58 50 42 34 26 18 10 2 59 51 43 35 27
19 11 3 60 52 44 36}
set PC1_D {63 55 47 39 31 23 15 7 62 54 46 38 30 22 14 6 61 53 45 37 29
21 13 5 28 20 12 4}
set shifts {1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1}
set PC2_C {14 17 11 24 1 5 3 28 15 6 21 10 23 19 12 4 26 8 16 7 27 20 13 2}
set PC2_D {41 52 31 37 47 55 30 40 51 45 33 48 44 49 39 56 34 53 46 42 50
36 29 32}
set e {32 1 2 3 4 5 4 5 6 7 8 9 8 9 10 11 12 13 12 13 14 15
16 17 16 17 18 19 20 21 20 21 22 23 24 25 24 25 26 27 28 29 28 29
30 31 32 1}
set S {{14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7 0 15 7 4 14 2
13 1 10 6 12 11 9 5 3 8 4 1 14 8 13 6 2 11 15 12 9 7
3 10 5 0 15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13}
{15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10 3 13 4 7 15 2
8 14 12 0 1 10 6 9 11 5 0 14 7 11 10 4 13 1 5 8 12 6
9 3 2 15 13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9}
{10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8 13 7 0 9 3 4
6 10 2 8 5 14 12 11 15 1 13 6 4 9 8 15 3 0 11 1 2 12
5 10 14 7 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12}
{ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15 13 8 11 5 6 15
0 3 4 7 2 12 1 10 14 9 10 6 9 0 12 11 7 13 15 1 3 14
5 2 8 4 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14}
{ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9 14 11 2 12 4 7
13 1 5 0 15 10 3 9 8 6 4 2 1 11 10 13 7 8 15 9 12 5
6 3 0 14 11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3}
{12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11 10 15 4 2 7 12
9 5 6 1 13 14 0 11 3 8 9 14 15 5 2 8 12 3 7 0 4 10
1 13 11 6 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13}
{ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1 13 0 11 7 4 9
1 10 14 3 5 12 2 15 8 6 1 4 11 13 12 3 7 14 10 15 6 8
0 5 9 2 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12}
{13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7 1 15 13 8 10 3
7 4 12 5 6 11 0 14 9 2 7 11 4 1 9 12 14 2 0 6 10 13
15 3 5 8 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11}}
set P {16 7 20 21 29 12 28 17 1 15 23 26 5 18 31 10 2 8 24 14 32 27
3 9 19 13 30 6 22 11 4 25}
set block {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0}
set KS {{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}}
set iobuf {0 0 0 0 0 0 0 0 0 0 0 0 0}
set f {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
set pw [split $password ""]
set pw_pos 0
for {set i 0} {[scan [lindex $pw $pw_pos] %c c] != -1 && $i < 64} \
{incr pw_pos} {
for {set j 0} {$j < 7} {incr j ; incr i} {
lset block $i [expr {($c >> (6 - $j)) & 01}]
}
incr i
}
set C [list]
set D [list]
for {set i 0} {$i < 28} {incr i} {
lappend C [lindex $block [expr {[lindex $PC1_C $i] - 1}]]
lappend D [lindex $block [expr {[lindex $PC1_D $i] - 1}]]
}
for {set i 0} {$i < 16} {incr i} {
for {set k 0} {$k < [lindex $shifts $i]} {incr k} {
set t [lindex $C 0]
for {set j 0} {$j < 27} {incr j} {
lset C $j [lindex $C [expr {$j + 1}]]
}
lset C 27 $t
set t [lindex $D 0]
for {set j 0} {$j < 27} {incr j} {
lset D $j [lindex $D [expr {$j + 1}]]
}
lset D 27 $t
}
for {set j 0} {$j < 24} {incr j} {
lset KS $i $j [lindex $C [expr {[lindex $PC2_C $j] - 1}]]
lset KS $i [expr {$j + 24}] \
[lindex $D [expr {[lindex $PC2_D $j] - 28 - 1}]]
}
}
set E [list]
for {set i 0} {$i < 48} {incr i} {
lappend E [lindex $e $i]
}
for {set i 0} {$i < 66} {incr i} {
lset block $i 0
}
set salt [split $salt ""]
set salt_pos 0
set val_Z 90
set val_9 57
set val_period 46
for {set i 0} {$i < 2} {incr i} {
scan [lindex $salt $salt_pos] %c c
incr salt_pos
lset iobuf $i $c
if {$c > $val_Z} {
incr c -6
}
if {$c > $val_9} {
incr c -7
}
incr c -$val_period
for {set j 0} {$j < 6} {incr j} {
if {[expr {($c >> $j) & 01}]} {
set temp [lindex $E [expr {6 * $i + $j}]]
lset E [expr {6 * $i + $j}] \
[lindex $E [expr {6 * $i + $j + 24}]]
lset E [expr {6 * $i + $j + 24}] $temp
}
}
}
set edflag 0
for {set h 0} {$h < 25} {incr h} {
set L [list]
for {set j 0} {$j < 64} {incr j} {
lappend L [lindex $block [expr {[lindex $IP $j] - 1}]]
}
for {set ii 0} {$ii < 16} {incr ii} {
if {$edflag} {
set i [expr {15 - $ii}]
} else {
set i $ii
}
set tempL [list]
for {set j 0} {$j < 32} {incr j} {
lappend tempL [lindex $L [expr {$j + 32}]]
}
set preS [list]
for {set j 0} {$j < 48} {incr j} {
lappend preS [expr {[lindex $L \
[expr {[lindex $E $j] - 1 + 32}]] ^ [lindex $KS $i $j]}]
}
for {set j 0} {$j < 8} {incr j} {
set t [expr {6 * $j}]
set k [lindex $S $j \
[expr {([lindex $preS $t] << 5) + \
([lindex $preS [expr {$t + 1}]] << 3) + \
([lindex $preS [expr {$t + 2}]] << 2) + \
([lindex $preS [expr {$t + 3}]] << 1) + \
[lindex $preS [expr {$t + 4}]] + \
([lindex $preS [expr {$t + 5}]] << 4)}]]
set t [expr {4 * $j}]
lset f $t [expr {($k >> 3) & 01}]
lset f [expr {$t + 1}] [expr {($k >> 2) & 01}]
lset f [expr {$t + 2}] [expr {($k >> 1) & 01}]
lset f [expr {$t + 3}] [expr { $k & 01}]
}
for {set j 0} {$j < 32} {incr j} {
lset L [expr {$j + 32}] [expr {[lindex $L $j] ^ \
[lindex $f [expr {[lindex $P $j] - 1}]]}]
}
for {set j 0} {$j < 32} {incr j} {
lset L $j [lindex $tempL $j]
}
}
for {set j 0} {$j < 32} {incr j} {
set t [lindex $L $j]
lset L $j [lindex $L [expr {$j + 32}]]
lset L [expr {$j + 32}] $t
}
for {set j 0} {$j < 64} {incr j} {
lset block $j [lindex $L [expr {[lindex $FP $j] - 1}]]
}
}
for {set i 0} {$i < 11} {incr i} {
set c 0
for {set j 0} {$j < 6} {incr j} {
set c [expr {$c << 1}]
set c [expr {$c | [lindex $block [expr {6 * $i + $j}]]}]
}
incr c $val_period
if {$c > $val_9} {
incr c 7
}
if {$c > $val_Z} {
incr c 6
}
lset iobuf [expr {$i + 2}] $c
}
if {[lindex $iobuf 1] == 0} {
lset iobuf 1 [lindex $iobuf 0]
}
set encrypted ""
foreach element $iobuf {
append encrypted [format %c $element]
}
return $encrypted
}