|
changeKey key::increment key::intgen |
key::md5 key::sha key::time |
key.tcl
Provides key generation functions.
package provide key 1.0
if { ! [ info exists genericAPI ] } {
set msg "key.tcl is a module of\n"
append msg "the genericAPI.tcl and provides\n"
append msg "no independent functionality."
return -code error $msg
}
namespace eval key { }
set key [ key::sha $string ]Comments:
proc key::sha { { str "" } } {
if { ! [ string length $str ] } {
return {}
}
set key [ uplevel #0 sha1 -string \"$str\" ]
return $key
}
example: key::md5 foo --> acbd18db4cc2f85cedef654fccc4a4d8Comments:
proc key::md5 { text } {
namespace eval md5 {
variable i
variable t
variable T
set i 0
foreach t {
0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
0x6b901122 0xfd987193 0xa679438e 0x49b40821
0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8
0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a
0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665
0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
} {
incr i
set T($i) [expr $t]
}
}
proc md5::md5 {msg} {
variable T
set msgLen [string length $msg]
set padLen [expr {56 - $msgLen%64}]
if {$msgLen % 64 > 56} {
incr padLen 64
}
if {$padLen == 0} { incr padLen 64 }
append msg [binary format "a$padLen" \200]
append msg [binary format "i1i1" [expr {8*$msgLen}] 0]
set msgList [split $msg ""]
set A [expr 0x67452301]
set B [expr 0xefcdab89]
set C [expr 0x98badcfe]
set D [expr 0x10325476]
set i 0
foreach {c1 c2 c3 c4} $msgList {
binary scan $c1$c2$c3$c4 "i" M($i)
incr i
}
set blockLen [array size M]
for {set i 0} {$i < $blockLen/16} {incr i} {
for {set j 0} {$j<16} {incr j} {
set X($j) $M([expr {$i*16+$j}])
}
set AA $A
set BB $B
set CC $C
set DD $D
set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(0) + $T(1) }] 7]}]
set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(1) + $T(2) }] 12]}]
set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(2) + $T(3) }] 17]}]
set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(3) + $T(4) }] 22]}]
set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(4) + $T(5) }] 7]}]
set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(5) + $T(6) }] 12]}]
set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(6) + $T(7) }] 17]}]
set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(7) + $T(8) }] 22]}]
set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(8) + $T(9) }] 7]}]
set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(9) + $T(10)}] 12]}]
set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(10) + $T(11)}] 17]}]
set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(11) + $T(12)}] 22]}]
set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(12) + $T(13)}] 7]}]
set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(13) + $T(14)}] 12]}]
set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(14) + $T(15)}] 17]}]
set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(15) + $T(16)}] 22]}]
set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(1) + $T(17)}] 5]}]
set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(6) + $T(18)}] 9]}]
set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(11) + $T(19)}] 14]}]
set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(0) + $T(20)}] 20]}]
set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(5) + $T(21)}] 5]}]
set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(10) + $T(22)}] 9]}]
set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(15) + $T(23)}] 14]}]
set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(4) + $T(24)}] 20]}]
set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(9) + $T(25)}] 5]}]
set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(14) + $T(26)}] 9]}]
set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(3) + $T(27)}] 14]}]
set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(8) + $T(28)}] 20]}]
set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(13) + $T(29)}] 5]}]
set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(2) + $T(30)}] 9]}]
set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(7) + $T(31)}] 14]}]
set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(12) + $T(32)}] 20]}]
set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(5) + $T(33)}] 4]}]
set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(8) + $T(34)}] 11]}]
set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(11) + $T(35)}] 16]}]
set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(14) + $T(36)}] 23]}]
set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(1) + $T(37)}] 4]}]
set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(4) + $T(38)}] 11]}]
set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(7) + $T(39)}] 16]}]
set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(10) + $T(40)}] 23]}]
set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(13) + $T(41)}] 4]}]
set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(0) + $T(42)}] 11]}]
set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(3) + $T(43)}] 16]}]
set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(6) + $T(44)}] 23]}]
set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(9) + $T(45)}] 4]}]
set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(12) + $T(46)}] 11]}]
set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(15) + $T(47)}] 16]}]
set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(2) + $T(48)}] 23]}]
set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(0) + $T(49)}] 6]}]
set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(7) + $T(50)}] 10]}]
set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(14) + $T(51)}] 15]}]
set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(5) + $T(52)}] 21]}]
set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(12) + $T(53)}] 6]}]
set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(3) + $T(54)}] 10]}]
set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(10) + $T(55)}] 15]}]
set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(1) + $T(56)}] 21]}]
set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(8) + $T(57)}] 6]}]
set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(15) + $T(58)}] 10]}]
set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(6) + $T(59)}] 15]}]
set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(13) + $T(60)}] 21]}]
set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(4) + $T(61)}] 6]}]
set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(11) + $T(62)}] 10]}]
set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(2) + $T(63)}] 15]}]
set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(9) + $T(64)}] 21]}]
incr A $AA
incr B $BB
incr C $CC
incr D $DD
}
return [bytes $A][bytes $B][bytes $C][bytes $D]
}
proc md5::<<< {x i} { expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))} }
proc md5::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
proc md5::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
proc md5::H {x y z} {expr {$x ^ $y ^ $z}}
proc md5::I {x y z} {expr {$y ^ ($x | (~$z))}}
proc md5::byte0 {i} {expr {0xff & $i}}
proc md5::byte1 {i} {expr {(0xff00 & $i) >> 8}}
proc md5::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
proc md5::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}
proc md5::bytes {i} {format %0.2x%0.2x%0.2x%0.2x [byte0 $i] [byte1 $i] [byte2 $i] [byte3 $i]}
return [ md5::md5 $text ]
}
set unique_key [ key::time ]Comments:
proc key::time { } {
if { [ catch {
set key [ expr { int(pow(2,31))+[clock clicks] } ]
} err ] } {
set key [ expr { pow(2,31)+[clock clicks] } ]
}
set begin [ expr { [ string length $key ] -8 } ]
set end [ expr { [ string length $key ] -3 } ]
set key [ string range $key $begin $end ]
regsub -all -- {-} $key {} key
;## leapSecs calls getCurlUrl, which calls key::time
if { [ info exists ::leapdates ] } {
set key [ gpsTime ]$key
} else {
set key [ clock seconds ]$key
}
return $key
}
set key [ key::incr keyname ]Comments:
proc key::increment { { key "" } } {
set errs [ list ]
if { ! [ string length $key ] } {
return {}
}
if { [ string match shutdown $key ] } {
if { [ array exists ::keys ] && \
[ info exists ::keys($::RUNCODE) ] } {
set fid [ open $::KEYFILE w ]
puts $fid [ array get ::keys ]
close $fid
set msg "incrKey:\n"
append msg "\"key\" array written to:\n"
append msg "$::KEYFILE"
addLogEntry $msg
}
return {}
}
if { ! [ info exists ::keys($key) ] } {
set ::keys($key) 0
;## if the system was properly shut down, a keyfile
;## exists.
if { [ file exists $::KEYFILE ] } {
set fid [ open $::KEYFILE ]
array set ::keys [ read $fid ]
close $fid
set msg "incrKey:\n"
append msg "$::KEYFILE read into \"key\" array.\n"
addLogEntry $msg
if { ! [ set ::keys($key) ] } {
addLogEntry "key $key not found in keyfile!"
}
} else {
addLogEntry "$::KEYFILE not found!"
set ::keys($key) 0
}
;## if the key is set to 0, try to con it from the
;## logs archive.
if { ! [ set ::keys($key) ] } {
;## it is possible to recover the ::RUNCODE
;## key from the file $::LDASLOG/archiveIndex
;## where it should be found in the last line.
if { [ string match $key $::RUNCODE ] } {
set filename [ file join $::LDASARC archiveIndex ]
set N 0
if { [ file readable $filename ] } {
set fid [ open $filename r ]
;## regexp for matching last job number in an
;## archiveLog file
set arc_rx [ subst {${key}(\\d+)(\\s+\\d+)?$} ]
while { [ gets $fid line ] > -1 } {
set n 0
set line [ string trim $line ]
if { ! [ regexp $arc_rx $line -> n ] } {
set msg "something is wrong with $filename, "
append msg "I can't parse the job i.d. from this "
append msg "line: '$line'"
lappend errs $msg
}
if { $n > $N } { set N $n }
}
close $fid
}
if { ! $N } {
addLogEntry "new system key: $key"
} else {
addLogEntry "found key $key at $N in logs"
}
set ::keys($key) $N
}
}
} ;## end of handler for uninitialised keys
if { [ llength $errs ] } {
set subj "Error generating ::RUNCODE key"
addLogEntry "Subject: ${subj}; Body: $errs" mail
}
incr ::keys($key)
set fid [ open $::KEYFILE w ]
puts $fid [ array get ::keys ]
close $fid
return $key$::keys($key)
}
changeKey newkeyComments:
proc changeKey { { newkey "" } } {
set filename [ file join $::LDAS LDAS${::API}.rsc ]
set data [ dumpFile $filename ]
;## base64 class in regexp
regsub {USER_KEY[ a-zA-Z0-9]+} $data "USER_KEY $newkey" data
if { [ catch {
set fid [ open $filename w ]
} err ] } {
return -code error "Could not open LDAS${::API}.rsc for writing!"
}
puts $fid $data
close $fid
if { ! [ info exists ::USER_KEY ] } {
addLogEntry "USER_KEY not initialised in resource file." 2
}
set ::USER_KEY $newkey
return {}
}
proc key::intgen { { seed 0 } } {
set self [lindex [info level 0] 0]
proc $self "{ seed [ incr seed ] }" [ info body $self ]
set seed
}
Back to Top