crypt in pure tcl

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 [1 ] 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 [3 ] is the Mozilla Public License [2 ], 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
 }