roolebo/des.tcl

## des.tcl
#initial permutation
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
}
#final permutation
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
}
#helper functions
proc listcomp {a b} {
    set diff {}
    foreach i $a {
        if {[lsearch -exact $b $i]==-1} {
            lappend diff $i
        }
    }
    return $diff
}

proc int2bits {i {digits {} } } {
    #returns a bitslist, e.g. int2bits 10 => {1 0 1 0}
    # digits determines the length of the returned list (left truncated or added left 0 )
    # use of digits allows concatenation of bits sub-fields

    set res ""
    while {$i>0} {
        set res [expr {$i%2}]$res
        set i [expr {$i/2}]
    }
    if {$res==""} {set res 0}

    if {$digits != {} } {
        append d [string repeat 0 $digits ] $res
        set res [string range $d [string length $res ] end ]
    }
    split $res ""
}
proc bits2int {bits} {
    #returns integer equivalent of a bitlist
    set res 0
    foreach i $bits {
        set res [expr {$res*2+$i}]
    }
    set res
}

proc lrotate {"left" l num} {
    return [concat [lrange $l $num end] [lrange $l 0 $num-1]]
}
#end of helper functions

proc permute {text permutation} {
    foreach bitnum $permutation {
        lappend restext [lindex $text $bitnum-1]
    }

    return $restext
}

proc keyshedule {key n} {
    #Permuted Choice 1
    set PC1 {
        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
        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
    }
    #Permuted Choice 2
    set PC2 {
        14    17   11    24     1    5
         3    28   15     6    21   10
        23    19   12     4    26    8
        16     7   27    20    13    2
        41    52   31    37    47   55
        30    40   51    45    33   48
        44    49   39    56    34   53
        46    42   50    36    29   32
    }
    #Left Shifts
    set LS {
         1   1   2   2   2   2   2   2   1   2   2   2   2   2   2   1
    }

    set permuted [permute $key $PC1]
    set C [lrange $permuted 0 27]
    set D [lrange $permuted 28 55]
    #shift left
    for {set i 0} {$i < $n} {incr i} {
        set shiftNum [lindex $LS $i]
        set C [lrotate left $C $shiftNum]
        set D [lrotate left $D $shiftNum]
    }
    return [permute [concat $C $D] $PC2]
}

proc cipher {right key} {
    #Expansion Permutation
    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
    }
    #Selection Functions
    set S(0) {
        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
    }
    set S(1) {
        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
    }
    set S(2) {
        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
    }
    set S(3) {
         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
    }
    set S(4) {
         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
    }
    set S(5) {
        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
    }
    set S(6) {
         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
    }
    set S(7) {
        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
    }
    #Round Permutation
    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 right [permute $right $E]
    foreach rightbit $right keybit $key {
        lappend modres [expr {($rightbit + $keybit) % 2}]
    }

    for {set i 0} {$i < 8} {incr i} {
        set first [expr {6 * $i}]
        set sixth [expr {5 + 6 * $i}]
        set row [list [lindex $modres $first] [lindex $modres $sixth]]
        set row [bits2int $row]

        set col [lrange $modres [expr {1 + 6 * $i}] [expr {4 + 6 * $i}]]
        set col [bits2int $col]

        set outnum [lindex $S($i) [expr {$col + $row * 16}]]
        lappend selectres {*}[int2bits $outnum 4]
    }
    return [permute $selectres $P]
}

proc encipher {plaintext fullkey} {
    global IP FP
    set permuted [permute $plaintext $IP]
    set left [lrange $permuted 0 31]
    set right [lrange $permuted 32 63]

    for {set i 1} {$i <= 16} {incr i} {
        set key [keyshedule $fullkey $i]
        set tmpright $right

        set ciphered [cipher $right $key]
        set right {}
        foreach leftbit $left cipherbit $ciphered {
            lappend right [expr {($leftbit + $cipherbit) % 2}]
        }
        set left $tmpright
    }

    return [permute [concat $right $left] $FP]
}

proc decipher {ciphertext fullkey} {
    global IP FP
    set inversepermuted [permute $ciphertext $IP]
    set left [lrange $inversepermuted 32 63]
    set right [lrange $inversepermuted 0 31]

    for {set i 16} {$i >= 1} {incr i -1} {
        set key [keyshedule $fullkey $i]
        set tmpleft $left

        set ciphered [cipher $left $key]
        set left {}
        foreach rightbit $right cipherbit $ciphered {
            lappend left [expr {($rightbit + $cipherbit) % 2}]
        }
        set right $tmpleft
    }

    return [permute [concat $left $right] $FP]
}

global IP FP
set blocksize 8

set keyfile [open key r]
fconfigure $keyfile -translation binary
set key [read $keyfile $blocksize]
close $keyfile

set inputfile [open data r]
fconfigure $inputfile -translation binary
set plaintext [read $inputfile $blocksize]
close $inputfile

binary scan $key B* digits
set key [split $digits ""]
puts "Key: $key"

binary scan $plaintext B* digits
set plaintext [split $digits ""]
puts "Plaintext: $plaintext"

set ciphertext [encipher $plaintext $key]
puts "Ciphertext: $ciphertext"
set deciphered [decipher $ciphertext $key]
puts "Deciphered: $deciphered"
puts "Difference between plaintext and deciphered: [listcomp $plaintext $deciphered]"
	#initial permutation
	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
	}
	#final permutation
	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
	}
	#helper functions
	proc listcomp {a b} {
	set diff {}
	foreach i $a {
	if {[lsearch -exact $b $i]==-1} {
	lappend diff $i
	}
	}
	return $diff
	}

	proc int2bits {i {digits {} } } {
	#returns a bitslist, e.g. int2bits 10 => {1 0 1 0}
	# digits determines the length of the returned list (left truncated or added left 0 )
	# use of digits allows concatenation of bits sub-fields

	set res ""
	while {$i>0} {
	set res [expr {$i%2}]$res
	set i [expr {$i/2}]
	}
	if {$res==""} {set res 0}

	if {$digits != {} } {
	append d [string repeat 0 $digits ] $res
	set res [string range $d [string length $res ] end ]
	}
	split $res ""
	}
	proc bits2int {bits} {
	#returns integer equivalent of a bitlist
	set res 0
	foreach i $bits {
	set res [expr {$res*2+$i}]
	}
	set res
	}

	proc lrotate {"left" l num} {
	return [concat [lrange $l $num end] [lrange $l 0 $num-1]]
	}
	#end of helper functions

	proc permute {text permutation} {
	foreach bitnum $permutation {
	lappend restext [lindex $text $bitnum-1]
	}

	return $restext
	}

	proc keyshedule {key n} {
	#Permuted Choice 1
	set PC1 {
	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
	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
	}
	#Permuted Choice 2
	set PC2 {
	14 17 11 24 1 5
	3 28 15 6 21 10
	23 19 12 4 26 8
	16 7 27 20 13 2
	41 52 31 37 47 55
	30 40 51 45 33 48
	44 49 39 56 34 53
	46 42 50 36 29 32
	}
	#Left Shifts
	set LS {
	1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1
	}

	set permuted [permute $key $PC1]
	set C [lrange $permuted 0 27]
	set D [lrange $permuted 28 55]
	#shift left
	for {set i 0} {$i < $n} {incr i} {
	set shiftNum [lindex $LS $i]
	set C [lrotate left $C $shiftNum]
	set D [lrotate left $D $shiftNum]
	}
	return [permute [concat $C $D] $PC2]
	}

	proc cipher {right key} {
	#Expansion Permutation
	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
	}
	#Selection Functions
	set S(0) {
	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
	}
	set S(1) {
	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
	}
	set S(2) {
	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
	}
	set S(3) {
	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
	}
	set S(4) {
	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
	}
	set S(5) {
	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
	}
	set S(6) {
	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
	}
	set S(7) {
	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
	}
	#Round Permutation
	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 right [permute $right $E]
	foreach rightbit $right keybit $key {
	lappend modres [expr {($rightbit + $keybit) % 2}]
	}

	for {set i 0} {$i < 8} {incr i} {
	set first [expr {6 * $i}]
	set sixth [expr {5 + 6 * $i}]
	set row [list [lindex $modres $first] [lindex $modres $sixth]]
	set row [bits2int $row]

	set col [lrange $modres [expr {1 + 6 * $i}] [expr {4 + 6 * $i}]]
	set col [bits2int $col]

	set outnum [lindex $S($i) [expr {$col + $row * 16}]]
	lappend selectres {*}[int2bits $outnum 4]
	}
	return [permute $selectres $P]
	}

	proc encipher {plaintext fullkey} {
	global IP FP
	set permuted [permute $plaintext $IP]
	set left [lrange $permuted 0 31]
	set right [lrange $permuted 32 63]

	for {set i 1} {$i <= 16} {incr i} {
	set key [keyshedule $fullkey $i]
	set tmpright $right

	set ciphered [cipher $right $key]
	set right {}
	foreach leftbit $left cipherbit $ciphered {
	lappend right [expr {($leftbit + $cipherbit) % 2}]
	}
	set left $tmpright
	}

	return [permute [concat $right $left] $FP]
	}

	proc decipher {ciphertext fullkey} {
	global IP FP
	set inversepermuted [permute $ciphertext $IP]
	set left [lrange $inversepermuted 32 63]
	set right [lrange $inversepermuted 0 31]

	for {set i 16} {$i >= 1} {incr i -1} {
	set key [keyshedule $fullkey $i]
	set tmpleft $left

	set ciphered [cipher $left $key]
	set left {}
	foreach rightbit $right cipherbit $ciphered {
	lappend left [expr {($rightbit + $cipherbit) % 2}]
	}
	set right $tmpleft
	}

	return [permute [concat $left $right] $FP]
	}

	global IP FP
	set blocksize 8

	set keyfile [open key r]
	fconfigure $keyfile -translation binary
	set key [read $keyfile $blocksize]
	close $keyfile

	set inputfile [open data r]
	fconfigure $inputfile -translation binary
	set plaintext [read $inputfile $blocksize]
	close $inputfile

	binary scan $key B* digits
	set key [split $digits ""]
	puts "Key: $key"

	binary scan $plaintext B* digits
	set plaintext [split $digits ""]
	puts "Plaintext: $plaintext"

	set ciphertext [encipher $plaintext $key]
	puts "Ciphertext: $ciphertext"
	set deciphered [decipher $ciphertext $key]
	puts "Deciphered: $deciphered"
	puts "Difference between plaintext and deciphered: [listcomp $plaintext $deciphered]"