"Fossies" - the Fresh Open Source Software Archive 
Member "zebedee-2.5.3/passphrase.tcl" (7 May 2002, 7094 Bytes) of package /linux/privat/old/zebedee-2.5.3.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "passphrase.tcl" see the
Fossies "Dox" file reference documentation.
1 #!/usr/bin/wish -f
2 #
3 # Simple passphrase-to-key generator for Zebedee.
4 #
5 # This can be invoked from Zebedee by using the "keygencommand" keyword.
6 # When invoked with no additional arguments it will prompt for a passphrase
7 # and output a key derived from it to standard output. If an argument is
8 # specified it must be the name of a supplementary key data file. The script
9 # will read the first line from this file and add this to the passphrase
10 # before generating the key.
11 #
12 #
13 # This file is part of "Zebedee".
14 #
15 # Copyright 2001, 2002 by Neil Winton. All rights reserved.
16 #
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
21 #
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU General Public License for more details.
26 #
27 # You should have received a copy of the GNU General Public License
28 # along with this program; if not, write to the Free Software
29 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
30 #
31 # For further details on "Zebedee" see http://www.winton.org.uk/zebedee/
32 #
33 # $Id: passphrase.tcl,v 1.1 2002/05/07 08:28:10 ndwinton Exp $
34
35 # The SHA1 hash generation code was derived from code containing the
36 # following attribution. Note that there is a slight modification for
37 # Zebedee compatibility (the "PreNIST" option).
38 #
39 ##################################################
40 #
41 # sha1.tcl - SHA1 in Tcl
42 # Author: Don Libes <libes@nist.gov>, May 2001
43 # Version 1.0.0
44 #
45 # SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm",
46 # http://www.itl.nist.gov/fipspubs/fip180-1.htm
47 # HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
48 #
49 # Some of the comments below come right out of FIPS 180-1; That's why
50 # they have such peculiar numbers. In addition, I have retained
51 # original syntax, etc. from the FIPS. All remaining bugs are mine.
52 #
53 # HMAC implementation by D. J. Hagberg <dhagberg@millibits.com> and
54 # is based on C code in FIPS 2104.
55 #
56 # For more info, see: http://expect.nist.gov/sha1pure
57 #
58 # - Don
59 ##################################################
60
61 namespace eval sha1pure {
62 variable i
63 variable j
64 variable t
65 variable K
66 variable PreNIST
67
68 set j 0
69 foreach t {
70 0x5A827999
71 0x6ED9EBA1
72 0x8F1BBCDC
73 0xCA62C1D6
74 } {
75 for {set i 0} {$i < 20} {incr i; incr j} {
76 set K($j) $t
77 }
78 }
79
80 # Set this true for compatibility with the original version on SHA1
81 # prior to modification by NIST for the final standard. This is,
82 # unfortunately, the version used by Zebedee 2.x ...
83
84 set PreNIST true
85 }
86
87 proc sha1pure::sha1 {msg} {
88 variable K
89 variable PreNIST
90
91 #
92 # 4. MESSAGE PADDING
93 #
94
95 # pad to 512 bits (512/8 = 64 bytes)
96
97 set msgLen [string length $msg]
98
99 # last 8 bytes are reserved for msgLen
100 # plus 1 for "1"
101
102 set padLen [expr {56 - $msgLen%64}]
103 if {$msgLen % 64 >= 56} {
104 incr padLen 64
105 }
106
107 # 4a. and b. append single 1b followed by 0b's
108 append msg [binary format "a$padLen" \200]
109
110 # 4c. append 64-bit length
111 # Our implementation obviously limits string length to 32bits.
112 append msg \0\0\0\0[binary format "I" [expr {8*$msgLen}]]
113
114 #
115 # 7. COMPUTING THE MESSAGE DIGEST
116 #
117
118 # initial H buffer
119
120 set i 0
121 foreach t {
122 0x67452301
123 0xEFCDAB89
124 0x98BADCFE
125 0x10325476
126 0xC3D2E1F0
127 } {
128 set H($i) [expr $t]
129 incr i
130 }
131
132 #
133 # process message in 16-word blocks (64-byte blocks)
134 #
135
136 # convert message to array of 32-bit integers
137 # each block of 16-words is stored in M($i,0-16)
138
139 binary scan $msg I* words
140 set i 1
141 set j 0
142 foreach w $words {
143 lappend M($i) $w
144 if {[incr j] == 16} {
145 incr i
146 set j 0
147 }
148 }
149
150 set blockLen [expr {$i-1}]
151
152 for {set i 1} {$i <= $blockLen} {incr i} {
153 # 7a. Divide M[i] into 16 words W[0], W[1], ...
154 set t 0
155 foreach m $M($i) {
156 set W($t) $m
157 incr t
158 }
159
160 # 7b. For t = 16 to 79 let W[t] = ....
161 set t 16
162 set t3 12
163 set t8 7
164 set t14 1
165 set t16 -1
166 for {} {$t < 80} {incr t} {
167 set x [expr {$W([incr t3]) ^ $W([incr t8]) ^ $W([incr t14]) ^ $W([incr t16])}]
168 if {$PreNIST} {
169 set W($t) $x
170 } {
171 set W($t) [expr {($x << 1) | (($x >> 31) & 1)}]
172 }
173 }
174
175 # 7c. Let A = H[0] ....
176 set A $H(0)
177 set B $H(1)
178 set C $H(2)
179 set D $H(3)
180 set E $H(4)
181
182 # 7d. For t = 0 to 79 do
183 for {set t 0} {$t < 80} {incr t} {
184 set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + [f $t $B $C $D] + $E + $W($t) + $K($t)}]
185 set E $D
186 set D $C
187 set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
188 set B $A
189 set A $TEMP
190 }
191
192 incr H(0) $A
193 incr H(1) $B
194 incr H(2) $C
195 incr H(3) $D
196 incr H(4) $E
197 }
198 return [bytes $H(0)][bytes $H(1)][bytes $H(2)][bytes $H(3)][bytes $H(4)]
199 }
200
201 proc sha1pure::f {t B C D} {
202 switch [expr {$t/20}] {
203 0 {
204 expr {($B & $C) | ((~$B) & $D)}
205 } 1 - 3 {
206 expr {$B ^ $C ^ $D}
207 } 2 {
208 expr {($B & $C) | ($B & $D) | ($C & $D)}
209 }
210 }
211 }
212
213 proc sha1pure::byte0 {i} {expr {0xff & $i}}
214 proc sha1pure::byte1 {i} {expr {(0xff00 & $i) >> 8}}
215 proc sha1pure::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
216 proc sha1pure::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}
217
218 proc sha1pure::bytes {i} {
219 format %0.2x%0.2x%0.2x%0.2x [byte3 $i] [byte2 $i] [byte1 $i] [byte0 $i]
220 }
221
222 ### End of SHA1 code
223
224 # The main program starts here ...
225
226 # If an additional file has been mentioned on the command line
227 # the read the first line from this and stash it in FileKey.
228
229 set FileKey {}
230
231 if {[lindex $argv 0] != {}} {
232 if {[catch {open [lindex $argv 0]} fh]} {
233 wm withdraw .
234 tk_messageBox -icon error -type ok -title Error -message "Can't open supplementary key data file [lindex $argv 0]:\n$fh"
235 destroy .
236 exit 1
237 }
238
239 catch {
240 set FileKey [gets $fh]
241 close $fh
242 }
243 }
244
245 # Create the basic dialogue entry box
246
247 frame .f
248 label .f.label -text "Enter Pass Phrase:"
249
250 entry .f.entry -width 30 -relief sunken -textvariable PassPhrase -show {*}
251
252 button .finish -text " OK " -command {
253 puts [sha1pure::sha1 "$PassPhrase$FileKey"]
254 flush stdout
255 destroy .
256 }
257
258 # Pack all the elements for display
259
260 pack .f.label -side left -expand no -fill x -padx 5
261 pack .f.entry -side right -expand yes -fill x -padx 5
262 pack .f -side top -expand yes -fill both -pady 5
263 pack .finish -side bottom -anchor e -pady 5 -padx 10
264
265 bind . <Return> {.finish invoke}
266
267 # Calculate location of top left corner of box necessary to place
268 # it in the middle of the screen.
269
270 set xRoot [expr {[winfo screenwidth .]/2 - [winfo reqwidth .]/2}]
271 set yRoot [expr {[winfo screenheight .]/2 - [winfo reqheight .]/2}]
272
273 wm geometry . +$xRoot+$yRoot
274 wm title . "Zebedee Key Generator"
275
276 # Put the window to the top, focus on it and grab all mouse events.
277
278 raise .
279 grab -global .
280 focus .f.entry