1# ripemd160.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sf.net>
2#
3# This is a Tcl-only implementation of the RIPEMD-160 hash algorithm as
4# described in [RIPE].
5# Included is an implementation of keyed message authentication using
6# the RIPEMD-160 function [HMAC].
7#
8# See http://www.esat.kuleuven.ac.be/~cosicart/pdf/AB-9601/
9#
10# [RIPE] Dobbertin, H., Bosselaers A., and Preneel, B.
11#        "RIPEMD-160: A Strengthened Version of RIPEMD"
12#        Fast Software Encryption, LNCS 1039, D. Gollmann, Ed.,
13#        Springer-Verlag, 1996, pp. 71-82
14# [HMAC] Krawczyk, H., Bellare, M., and R. Canetti,
15#       "HMAC: Keyed-Hashing for Message Authentication",
16#        RFC 2104, February 1997.
17#
18# RFC 2286, ``Test cases for HMAC-RIPEMD160 and HMAC-RIPEMD128,''
19# Internet Request for Comments 2286, J. Kapp,
20#
21# -------------------------------------------------------------------------
22# See the file "license.terms" for information on usage and redistribution
23# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
24# -------------------------------------------------------------------------
25#
26# $Id: ripemd160.tcl,v 1.8 2009/05/07 01:12:59 patthoyts Exp $
27
28package require Tcl 8.2;                # tcl minimum version
29#catch {package require ripemdc 1.0};   # tcllib critcl alternative
30
31namespace eval ::ripemd {
32    namespace eval ripemd160 {
33        variable version 1.0.4
34        variable rcsid {$Id: ripemd160.tcl,v 1.8 2009/05/07 01:12:59 patthoyts Exp $}
35        variable accel
36        array set accel {cryptkit 0 trf 0}
37
38        variable uid
39        if {![info exists uid]} {
40            set uid 0
41        }
42
43        namespace export ripemd160 hmac160 Hex \
44            RIPEMD160Init RIPEMD160Update RIPEMD160Final \
45            RIPEHMAC160Init RIPEHMAC160Update RIPEHMAC160Final
46    }
47}
48
49# -------------------------------------------------------------------------
50
51# RIPEMD160Init - create and initialize the state variable. This will be
52# cleaned up when we call RIPEMD160Final
53#
54proc ::ripemd::ripemd160::RIPEMD160Init {} {
55    variable accel
56    variable uid
57    set token [namespace current]::[incr uid]
58    upvar #0 $token state
59
60    # Initialize RIPEMD-160 state structure (same as MD4).
61    array set state \
62        [list \
63             A [expr {0x67452301}] \
64             B [expr {0xefcdab89}] \
65             C [expr {0x98badcfe}] \
66             D [expr {0x10325476}] \
67             E [expr {0xc3d2e1f0}] \
68             n 0 i "" ]
69    if {$accel(cryptkit)} {
70        cryptkit::cryptCreateContext state(ckctx) \
71            CRYPT_UNUSED CRYPT_ALGO_RIPEMD160
72    } elseif {$accel(trf)} {
73        set s {}
74        switch -exact -- $::tcl_platform(platform) {
75            windows { set s [open NUL w] }
76            unix    { set s [open /dev/null w] }
77        }
78        if {$s != {}} {
79            fconfigure $s -translation binary -buffering none
80            ::ripemd160 -attach $s -mode write \
81                -read-type variable \
82                -read-destination [subst $token](trfread) \
83                -write-type variable \
84                -write-destination [subst $token](trfwrite)
85            array set state [list trfread 0 trfwrite 0 trf $s]
86        }
87    }
88    return $token
89}
90
91proc ::ripemd::ripemd160::RIPEMD160Update {token data} {
92    upvar #0 $token state
93
94    if {[info exists state(ckctx)]} {
95        if {[string length $data] > 0} {
96            cryptkit::cryptEncrypt $state(ckctx) $data
97        }
98        return
99    } elseif {[info exists state(trf)]} {
100        puts -nonewline $state(trf) $data
101        return
102    }
103
104    # Update the state values
105    incr state(n) [string length $data]
106    append state(i) $data
107
108    # Calculate the hash for any complete blocks
109    set len [string length $state(i)]
110    for {set n 0} {($n + 64) <= $len} {} {
111        RIPEMD160Hash $token [string range $state(i) $n [incr n 64]]
112    }
113
114    # Adjust the state for the blocks completed.
115    set state(i) [string range $state(i) $n end]
116    return
117}
118
119proc ::ripemd::ripemd160::RIPEMD160Final {token} {
120    upvar #0 $token state
121
122    if {[info exists state(ckctx)]} {
123        cryptkit::cryptEncrypt $state(ckctx) ""
124        cryptkit::cryptGetAttributeString $state(ckctx) \
125            CRYPT_CTXINFO_HASHVALUE r 20
126        cryptkit::cryptDestroyContext $state(ckctx)
127        # If nothing was hashed, we get no r variable set!
128        if {[info exists r]} {
129            unset state
130            return $r
131        }
132    } elseif {[info exists state(trf)]} {
133        close $state(trf)
134        set r $state(trfwrite)
135        unset state
136        return $r
137    }
138
139    # Padding
140    #
141    set len [string length $state(i)]
142    set pad [expr {56 - ($len % 64)}]
143    if {$len % 64 > 56} {
144        incr pad 64
145    }
146    if {$pad == 0} {
147        incr pad 64
148    }
149    append state(i) [binary format a$pad \x80]
150
151    # Append length in bits as little-endian wide int.
152    append state(i) [binary format ii [expr {8 * $state(n)}] 0]
153
154    # Calculate the hash for the remaining block.
155    set len [string length $state(i)]
156    for {set n 0} {($n + 64) <= $len} {} {
157        RIPEMD160Hash $token [string range $state(i) $n [incr n 64]]
158    }
159
160    # Output
161    set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)]
162    unset state
163    return $r
164}
165
166# -------------------------------------------------------------------------
167# HMAC Hashed Message Authentication (RFC 2104)
168#
169# hmac = H(K xor opad, H(K xor ipad, text))
170#
171proc ::ripemd::ripemd160::RIPEHMAC160Init {K} {
172
173    # Key K is adjusted to be 64 bytes long. If K is larger, then use
174    # the RIPEMD-160 digest of K and pad this instead.
175    set len [string length $K]
176    if {$len > 64} {
177        set tok [RIPEMD160Init]
178        RIPEMD160Update $tok $K
179        set K [RIPEMD160Final $tok]
180        set len [string length $K]
181    }
182    set pad [expr {64 - $len}]
183    append K [string repeat \0 $pad]
184
185    # Cacluate the padding buffers.
186    set Ki {}
187    set Ko {}
188    binary scan $K i16 Ks
189    foreach k $Ks {
190        append Ki [binary format i [expr {$k ^ 0x36363636}]]
191        append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]]
192    }
193
194    set tok [RIPEMD160Init]
195    RIPEMD160Update $tok $Ki;                 # initialize with the inner pad
196
197    # preserve the Ko value for the final stage.
198    # FRINK: nocheck
199    set [subst $tok](Ko) $Ko
200
201    return $tok
202}
203
204proc ::ripemd::ripemd160::RIPEHMAC160Update {token data} {
205    RIPEMD160Update $token $data
206    return
207}
208
209proc ::ripemd::ripemd160::RIPEHMAC160Final {token} {
210    # FRINK: nocheck
211    variable $token
212    upvar 0 $token state
213
214    set tok [RIPEMD160Init];            # init the outer hashing function
215    RIPEMD160Update $tok $state(Ko);    # prepare with the outer pad.
216    RIPEMD160Update $tok [RIPEMD160Final $token];  # hash the inner result
217    return [RIPEMD160Final $tok]
218}
219
220# -------------------------------------------------------------------------
221
222set ::ripemd::ripemd160::RIPEMD160Hash_body {
223    variable $token
224    upvar 0 $token state
225
226    binary scan $msg i* blocks
227    foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks {
228        set A $state(A)   ;  set AA $state(A)
229        set B $state(B)   ;  set BB $state(B)
230        set C $state(C)   ;  set CC $state(C)
231        set D $state(D)   ;  set DD $state(D)
232        set E $state(E)   ;  set EE $state(E)
233
234        FF A B C D E $X0 11
235        FF E A B C D $X1 14
236        FF D E A B C $X2 15
237        FF C D E A B $X3 12
238        FF B C D E A $X4 5
239        FF A B C D E $X5 8
240        FF E A B C D $X6 7
241        FF D E A B C $X7 9
242        FF C D E A B $X8 11
243        FF B C D E A $X9 13
244        FF A B C D E $X10 14
245        FF E A B C D $X11 15
246        FF D E A B C $X12 6
247        FF C D E A B $X13 7
248        FF B C D E A $X14 9
249        FF A B C D E $X15 8
250
251        GG E A B C D $X7 7
252        GG D E A B C $X4 6
253        GG C D E A B $X13 8
254        GG B C D E A $X1 13
255        GG A B C D E $X10 11
256        GG E A B C D $X6 9
257        GG D E A B C $X15 7
258        GG C D E A B $X3 15
259        GG B C D E A $X12 7
260        GG A B C D E $X0 12
261        GG E A B C D $X9 15
262        GG D E A B C $X5 9
263        GG C D E A B $X2 11
264        GG B C D E A $X14 7
265        GG A B C D E $X11 13
266        GG E A B C D $X8 12
267
268        HH D E A B C $X3 11
269        HH C D E A B $X10 13
270        HH B C D E A $X14 6
271        HH A B C D E $X4 7
272        HH E A B C D $X9 14
273        HH D E A B C $X15 9
274        HH C D E A B $X8 13
275        HH B C D E A $X1 15
276        HH A B C D E $X2 14
277        HH E A B C D $X7 8
278        HH D E A B C $X0 13
279        HH C D E A B $X6 6
280        HH B C D E A $X13 5
281        HH A B C D E $X11 12
282        HH E A B C D $X5 7
283        HH D E A B C $X12 5
284
285        II C D E A B $X1 11
286        II B C D E A $X9 12
287        II A B C D E $X11 14
288        II E A B C D $X10 15
289        II D E A B C $X0 14
290        II C D E A B $X8 15
291        II B C D E A $X12 9
292        II A B C D E $X4 8
293        II E A B C D $X13 9
294        II D E A B C $X3 14
295        II C D E A B $X7 5
296        II B C D E A $X15 6
297        II A B C D E $X14 8
298        II E A B C D $X5 6
299        II D E A B C $X6 5
300        II C D E A B $X2 12
301
302        JJ B C D E A $X4 9
303        JJ A B C D E $X0 15
304        JJ E A B C D $X5 5
305        JJ D E A B C $X9 11
306        JJ C D E A B $X7 6
307        JJ B C D E A $X12 8
308        JJ A B C D E $X2 13
309        JJ E A B C D $X10 12
310        JJ D E A B C $X14 5
311        JJ C D E A B $X1 12
312        JJ B C D E A $X3 13
313        JJ A B C D E $X8 14
314        JJ E A B C D $X11 11
315        JJ D E A B C $X6 8
316        JJ C D E A B $X15 5
317        JJ B C D E A $X13 6
318
319        JJJ AA BB CC DD EE $X5 8
320        JJJ EE AA BB CC DD $X14 9
321        JJJ DD EE AA BB CC $X7 9
322        JJJ CC DD EE AA BB $X0 11
323        JJJ BB CC DD EE AA $X9 13
324        JJJ AA BB CC DD EE $X2 15
325        JJJ EE AA BB CC DD $X11 15
326        JJJ DD EE AA BB CC $X4 5
327        JJJ CC DD EE AA BB $X13 7
328        JJJ BB CC DD EE AA $X6 7
329        JJJ AA BB CC DD EE $X15 8
330        JJJ EE AA BB CC DD $X8 11
331        JJJ DD EE AA BB CC $X1 14
332        JJJ CC DD EE AA BB $X10 14
333        JJJ BB CC DD EE AA $X3 12
334        JJJ AA BB CC DD EE $X12 6
335
336        III EE AA BB CC DD $X6 9
337        III DD EE AA BB CC $X11 13
338        III CC DD EE AA BB $X3 15
339        III BB CC DD EE AA $X7 7
340        III AA BB CC DD EE $X0 12
341        III EE AA BB CC DD $X13 8
342        III DD EE AA BB CC $X5 9
343        III CC DD EE AA BB $X10 11
344        III BB CC DD EE AA $X14 7
345        III AA BB CC DD EE $X15 7
346        III EE AA BB CC DD $X8 12
347        III DD EE AA BB CC $X12 7
348        III CC DD EE AA BB $X4 6
349        III BB CC DD EE AA $X9 15
350        III AA BB CC DD EE $X1 13
351        III EE AA BB CC DD $X2 11
352
353        HHH DD EE AA BB CC $X15 9
354        HHH CC DD EE AA BB $X5 7
355        HHH BB CC DD EE AA $X1 15
356        HHH AA BB CC DD EE $X3 11
357        HHH EE AA BB CC DD $X7 8
358        HHH DD EE AA BB CC $X14 6
359        HHH CC DD EE AA BB $X6 6
360        HHH BB CC DD EE AA $X9 14
361        HHH AA BB CC DD EE $X11 12
362        HHH EE AA BB CC DD $X8 13
363        HHH DD EE AA BB CC $X12 5
364        HHH CC DD EE AA BB $X2 14
365        HHH BB CC DD EE AA $X10 13
366        HHH AA BB CC DD EE $X0 13
367        HHH EE AA BB CC DD $X4 7
368        HHH DD EE AA BB CC $X13 5
369
370        GGG CC DD EE AA BB $X8 15
371        GGG BB CC DD EE AA $X6 5
372        GGG AA BB CC DD EE $X4 8
373        GGG EE AA BB CC DD $X1 11
374        GGG DD EE AA BB CC $X3 14
375        GGG CC DD EE AA BB $X11 14
376        GGG BB CC DD EE AA $X15 6
377        GGG AA BB CC DD EE $X0 14
378        GGG EE AA BB CC DD $X5 6
379        GGG DD EE AA BB CC $X12 9
380        GGG CC DD EE AA BB $X2 12
381        GGG BB CC DD EE AA $X13 9
382        GGG AA BB CC DD EE $X9 12
383        GGG EE AA BB CC DD $X7 5
384        GGG DD EE AA BB CC $X10 15
385        GGG CC DD EE AA BB $X14 8
386
387        FFF BB CC DD EE AA $X12 8
388        FFF AA BB CC DD EE $X15 5
389        FFF EE AA BB CC DD $X10 12
390        FFF DD EE AA BB CC $X4 9
391        FFF CC DD EE AA BB $X1 12
392        FFF BB CC DD EE AA $X5 5
393        FFF AA BB CC DD EE $X8 14
394        FFF EE AA BB CC DD $X7 6
395        FFF DD EE AA BB CC $X6 8
396        FFF CC DD EE AA BB $X2 13
397        FFF BB CC DD EE AA $X13 6
398        FFF AA BB CC DD EE $X14 5
399        FFF EE AA BB CC DD $X0 15
400        FFF DD EE AA BB CC $X3 13
401        FFF CC DD EE AA BB $X9 11
402        FFF BB CC DD EE AA $X11 11
403
404        # Then perform the following additions to combine the results.
405        set DD       [expr {$state(B) + $C + $DD}]
406        set state(B) [expr {$state(C) + $D + $EE}]
407        set state(C) [expr {$state(D) + $E + $AA}]
408        set state(D) [expr {$state(E) + $A + $BB}]
409        set state(E) [expr {$state(A) + $B + $CC}]
410        set state(A) $DD
411    }
412
413    return
414}
415
416proc ::ripemd::ripemd160::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}}
417proc ::ripemd::ripemd160::bytes {v} {
418    #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v]
419    format %c%c%c%c \
420        [expr {0xFF & $v}] \
421        [expr {(0xFF00 & $v) >> 8}] \
422        [expr {(0xFF0000 & $v) >> 16}] \
423        [expr {((0xFF000000 & $v) >> 24) & 0xFF}]
424}
425
426#  F(x,y,z) = x ^ y ^ z
427proc ::ripemd::ripemd160::F {X Y Z} {
428    return [expr {$X ^ $Y ^ $Z}]
429}
430# G(x,y,z) = (x & y) | (~x & z)
431proc ::ripemd::ripemd160::G {X Y Z} {
432    return [expr {($X & $Y) | (~$X & $Z)}]
433}
434# H(x,y,z) = (x | ~y) ^ z
435proc ::ripemd::ripemd160::H {X Y Z} {
436    return [expr {($X | ~$Y) ^ $Z}]
437}
438# I(x,y,z) = (x & z) | (y & ~z)
439proc ::ripemd::ripemd160::I {X Y Z} {
440    return [expr {($X & $Z) | ($Y & ~$Z)}]
441}
442# J(x,y,z) = x ^ (y | ~z)
443proc ::ripemd::ripemd160::J {X Y Z} {
444    return [expr {($X ^ ($Y | ~$Z))}]
445}
446
447proc ::ripemd::ripemd160::FF {a b c d e x s} {
448    upvar $a A $b B $c C $d D $e E
449    set A [<<< [expr {$A + ($B ^ $C ^ $D) + $x}] $s]
450    incr A $E
451    set C [<<< $C 10]
452}
453
454proc ::ripemd::ripemd160::GG {a b c d e x s} {
455    upvar $a A $b B $c C $d D $e E
456    set A [<<< [expr {$A + (($B & $C) | (~$B & $D)) + $x + 0x5a827999}] $s]
457    incr A $E
458    set C [<<< $C 10]
459}
460
461proc ::ripemd::ripemd160::HH {a b c d e x s} {
462    upvar $a A $b B $c C $d D $e E
463    set A [<<< [expr {$A + (($B | ~$C) ^ $D) + $x + 0x6ed9eba1}] $s]
464    incr A $E
465    set C [<<< $C 10]
466}
467
468proc ::ripemd::ripemd160::II {a b c d e x s} {
469    upvar $a A $b B $c C $d D $e E
470    set A [<<< [expr {$A + (($B & $D)|($C & ~$D)) + $x + 0x8f1bbcdc}] $s]
471    incr A $E
472    set C [<<< $C 10]
473
474}
475
476proc ::ripemd::ripemd160::JJ {a b c d e x s} {
477    upvar $a A $b B $c C $d D $e E
478    set A [<<< [expr {$A + ($B ^ ($C | ~$D)) + $x + 0xa953fd4e}] $s]
479    incr A $E
480    set C [<<< $C 10]
481}
482
483
484proc ::ripemd::ripemd160::FFF {a b c d e x s} {
485    upvar $a A $b B $c C $d D $e E
486    set A [<<< [expr {$A + ($B ^ $C ^ $D) + $x}] $s]
487    incr A $E
488    set C [<<< $C 10]
489}
490
491proc ::ripemd::ripemd160::GGG {a b c d e x s} {
492    upvar $a A $b B $c C $d D $e E
493    set A [<<< [expr {$A + (($B & $C) | (~$B & $D)) + $x + 0x7a6d76e9}] $s]
494    incr A $E
495    set C [<<< $C 10]
496}
497
498proc ::ripemd::ripemd160::HHH {a b c d e x s} {
499    upvar $a A $b B $c C $d D $e E
500    set A [<<< [expr {$A + (($B | ~$C) ^ $D) + $x + 0x6d703ef3}] $s]
501    incr A $E
502    set C [<<< $C 10]
503}
504
505proc ::ripemd::ripemd160::III {a b c d e x s} {
506    upvar $a A $b B $c C $d D $e E
507    set A [<<< [expr {$A + (($B & $D)|($C & ~$D)) + $x + 0x5c4dd124}] $s]
508    incr A $E
509    set C [<<< $C 10]
510
511}
512
513proc ::ripemd::ripemd160::JJJ {a b c d e x s} {
514    upvar $a A $b B $c C $d D $e E
515    set A [<<< [expr {$A + ($B ^ ($C | ~$D)) + $x + 0x50a28be6}] $s]
516    incr A $E
517    set C [<<< $C 10]
518}
519
520# 32bit rotate-left
521proc ::ripemd::ripemd160::<<< {v n} {
522    return [expr {((($v << $n) \
523                        | (($v >> (32 - $n)) \
524                               & (0x7FFFFFFF >> (31 - $n))))) \
525                      & 0xFFFFFFFF}]
526}
527
528# -------------------------------------------------------------------------
529# Inline the algorithm functions
530#
531# On my test system inlining the functions like this improves
532#   time {ripmd::ripmd160 [string repeat a 100]} 100
533# from 28ms per iteration to 13ms per iteration.
534#
535# This means that the functions above (F - J, FF - JJ and FFF-JJJ) are
536# not actually required for the code to operate. However, they provide
537# a readable way to document what is going on so have been left in.
538#
539namespace eval ::ripemd::ripemd160 {
540
541    # Inline function FF and FFF
542    set Split {(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)}
543
544    regsub -all -line \
545        "^\\s+FFF?\\s+$Split$" \
546        $RIPEMD160Hash_body \
547        {set \1 [<<< [expr {$\1 + ($\2 ^ $\3 ^ $\4) + \6}] \7];\
548             incr \1 $\5; set \3 [<<< $\3 10]} \
549        RIPEMD160Hash_body
550
551    # Inline function GG
552    regsub -all -line \
553        "^\\s+GG\\s+$Split$" \
554        $RIPEMD160Hash_body \
555        {set \1 [<<< [expr {$\1 + (($\2 \& $\3) | (~$\2 \& $\4)) + \6 \
556                                + 0x5a827999}] \7];\
557             incr \1 $\5; set \3 [<<< $\3 10]} \
558        RIPEMD160Hash_body
559
560    # Inline function GGG
561    regsub -all -line \
562        "^\\s+GGG\\s+$Split$" \
563        $RIPEMD160Hash_body \
564        {set \1 [<<< [expr {$\1 + (($\2 \& $\3) | (~$\2 \& $\4)) + \6 \
565                                + 0x7a6d76e9}] \7];\
566             incr \1 $\5; set \3 [<<< $\3 10]} \
567        RIPEMD160Hash_body
568
569    # Inline function HH
570    regsub -all -line \
571        "^\\s+HH\\s+$Split$" \
572        $RIPEMD160Hash_body \
573        {set \1 [<<< [expr {$\1 + (($\2 | ~$\3) ^ $\4) + \6 \
574                                + 0x6ed9eba1}] \7];\
575             incr \1 $\5; set \3 [<<< $\3 10]} \
576        RIPEMD160Hash_body
577
578    # Inline function HHH
579    regsub -all -line \
580        "^\\s+HHH\\s+$Split$" \
581        $RIPEMD160Hash_body \
582        {set \1 [<<< [expr {$\1 + (($\2 | ~$\3) ^ $\4) + \6 \
583                                + 0x6d703ef3}] \7];\
584             incr \1 $\5; set \3 [<<< $\3 10]} \
585        RIPEMD160Hash_body
586
587    # Inline function II
588    regsub -all -line \
589        "^\\s+II\\s+$Split$" \
590        $RIPEMD160Hash_body \
591        {set \1 [<<< [expr {$\1 + (($\2 \& $\4) | ($\3 \& ~$\4)) + \6 \
592                                + 0x8f1bbcdc}] \7];\
593             incr \1 $\5; set \3 [<<< $\3 10]} \
594        RIPEMD160Hash_body
595
596    # Inline function III
597    regsub -all -line \
598        "^\\s+III\\s+$Split$" \
599        $RIPEMD160Hash_body \
600        {set \1 [<<< [expr {$\1 + (($\2 \& $\4) | ($\3 \& ~$\4)) + \6 \
601                                + 0x5c4dd124}] \7];\
602             incr \1 $\5; set \3 [<<< $\3 10]} \
603        RIPEMD160Hash_body
604
605    # Inline function JJ
606    regsub -all -line \
607        "^\\s+JJ\\s+$Split$" \
608        $RIPEMD160Hash_body \
609        {set \1 [<<< [expr {$\1 + ($\2 ^ ($\3 | ~$\4)) + \6 \
610                                + 0xa953fd4e}] \7];\
611             incr \1 $\5; set \3 [<<< $\3 10]} \
612        RIPEMD160Hash_body
613
614    # Inline function JJJ
615    regsub -all -line \
616        "^\\s+JJJ\\s+$Split$" \
617        $RIPEMD160Hash_body \
618        {set \1 [<<< [expr {$\1 + ($\2 ^ ($\3 | ~$\4)) + \6 \
619                                + 0x50a28be6}] \7];\
620             incr \1 $\5; set \3 [<<< $\3 10]} \
621        RIPEMD160Hash_body
622
623    # Inline simple <<<
624    regsub -all -line \
625        {\[<<< (\$\S+)\s+(\d+)\]$} \
626        $RIPEMD160Hash_body \
627        {[expr {(((\1 << \2) \
628                      | ((\1 >> (32 - \2)) \
629                             \& (0x7FFFFFFF >> (31 - \2))))) \
630                    \& 0xFFFFFFFF}]} \
631        RIPEMD160Hash_body
632}
633
634# -------------------------------------------------------------------------
635
636# Define the hashing procedure with inline functions.
637proc ::ripemd::ripemd160::RIPEMD160Hash {token msg} \
638    $::ripemd::ripemd160::RIPEMD160Hash_body
639
640unset ::ripemd::ripemd160::RIPEMD160Hash_body
641
642# -------------------------------------------------------------------------
643
644proc ::ripemd::ripemd160::Hex {data} {
645    binary scan $data H* result
646    return $result
647}
648
649# -------------------------------------------------------------------------
650
651# LoadAccelerator --
652#
653#	This package can make use of a number of compiled extensions to
654#	accelerate the digest computation. This procedure manages the
655#	use of these extensions within the package. During normal usage
656#	this should not be called, but the test package manipulates the
657#	list of enabled accelerators.
658#
659proc ::ripemd::ripemd160::LoadAccelerator {name} {
660    variable accel
661    set r 0
662    switch -exact -- $name {
663        #critcl {
664        #    if {![catch {package require tcllibc}]
665        #        || ![catch {package require sha1c}]} {
666        #        set r [expr {[info command ::sha1::sha1c] != {}}]
667        #    }
668        #}
669        cryptkit {
670            if {![catch {package require cryptkit}]} {
671                set r [expr {![catch {cryptkit::cryptInit}]}]
672            }
673        }
674        trf {
675            if {![catch {package require Trf}]} {
676                set r [expr {![catch {::ripemd160 aa} msg]}]
677            }
678        }
679        default {
680            return -code error "invalid accelerator package:\
681                must be one of [join [array names accel] {, }]"
682        }
683    }
684    set accel($name) $r
685}
686
687# -------------------------------------------------------------------------
688
689# Description:
690#  Pop the nth element off a list. Used in options processing.
691#
692proc ::ripemd::ripemd160::Pop {varname {nth 0}} {
693    upvar $varname args
694    set r [lindex $args $nth]
695    set args [lreplace $args $nth $nth]
696    return $r
697}
698
699# -------------------------------------------------------------------------
700
701# fileevent handler for chunked file hashing.
702#
703proc ::ripemd::ripemd160::Chunk {token channel {chunksize 4096}} {
704    # FRINK: nocheck
705    variable $token
706    upvar 0 $token state
707
708    if {[eof $channel]} {
709        fileevent $channel readable {}
710        set state(reading) 0
711    }
712
713    RIPEMD160Update $token [read $channel $chunksize]
714}
715
716# -------------------------------------------------------------------------
717
718proc ::ripemd::ripemd160::ripemd160 {args} {
719    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
720    while {[string match -* [set option [lindex $args 0]]]} {
721        switch -glob -- $option {
722            -hex       { set opts(-hex) 1 }
723            -file*     { set opts(-filename) [Pop args 1] }
724            -channel   { set opts(-channel) [Pop args 1] }
725            -chunksize { set opts(-chunksize) [Pop args 1] }
726            default {
727                if {[llength $args] == 1} { break }
728                if {[string compare $option "--"] == 0} { Pop args; break }
729                set err [join [lsort [array names opts]] ", "]
730                return -code error "bad option $option:\
731                    must be one of $err"
732            }
733        }
734        Pop args
735    }
736
737    if {$opts(-filename) != {}} {
738        set opts(-channel) [open $opts(-filename) r]
739        fconfigure $opts(-channel) -translation binary
740    }
741
742    if {$opts(-channel) == {}} {
743
744        if {[llength $args] != 1} {
745            return -code error "wrong # args:\
746                should be \"ripemd160 ?-hex? -filename file | string\""
747        }
748        set tok [RIPEMD160Init]
749        RIPEMD160Update $tok [lindex $args 0]
750        set r [RIPEMD160Final $tok]
751
752    } else {
753
754        set tok [RIPEMD160Init]
755        # FRINK: nocheck
756        set [subst $tok](reading) 1
757        fileevent $opts(-channel) readable \
758            [list [namespace origin Chunk] \
759                 $tok $opts(-channel) $opts(-chunksize)]
760        vwait [subst $tok](reading)
761        set r [RIPEMD160Final $tok]
762
763        # If we opened the channel - we should close it too.
764        if {$opts(-filename) != {}} {
765            close $opts(-channel)
766        }
767    }
768
769    if {$opts(-hex)} {
770        set r [Hex $r]
771    }
772    return $r
773}
774
775# -------------------------------------------------------------------------
776
777proc ::ripemd::ripemd160::hmac160 {args} {
778    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
779    while {[string match -* [set option [lindex $args 0]]]} {
780        switch -glob -- $option {
781            -key       { set opts(-key) [Pop args 1] }
782            -hex       { set opts(-hex) 1 }
783            -file*     { set opts(-filename) [Pop args 1] }
784            -channel   { set opts(-channel) [Pop args 1] }
785            -chunksize { set opts(-chunksize) [Pop args 1] }
786            default {
787                if {[llength $args] == 1} { break }
788                if {[string compare $option "--"] == 0} { Pop args; break }
789                set err [join [lsort [array names opts]] ", "]
790                return -code error "bad option $option:\
791                    must be one of $err"
792            }
793        }
794        Pop args
795    }
796
797    if {![info exists opts(-key)]} {
798        return -code error "wrong # args:\
799            should be \"hmac160 ?-hex? -key key -filename file | string\""
800    }
801
802    if {$opts(-filename) != {}} {
803        set opts(-channel) [open $opts(-filename) r]
804        fconfigure $opts(-channel) -translation binary
805    }
806
807    if {$opts(-channel) == {}} {
808
809        if {[llength $args] != 1} {
810            return -code error "wrong # args:\
811                should be \"hmac160 ?-hex? -key key -filename file | string\""
812        }
813        set tok [RIPEHMAC160Init $opts(-key)]
814        RIPEHMAC160Update $tok [lindex $args 0]
815        set r [RIPEHMAC160Final $tok]
816
817    } else {
818
819        set tok [RIPEHMAC160Init $opts(-key)]
820        # FRINK: nocheck
821        set [subst $tok](reading) 1
822        fileevent $opts(-channel) readable \
823            [list [namespace origin Chunk] \
824                 $tok $opts(-channel) $opts(-chunksize)]
825        vwait [subst $tok](reading)
826        set r [RIPEHMAC160Final $tok]
827
828        # If we opened the channel - we should close it too.
829        if {$opts(-filename) != {}} {
830            close $opts(-channel)
831        }
832    }
833
834    if {$opts(-hex)} {
835        set r [Hex $r]
836    }
837    return $r
838}
839
840# -------------------------------------------------------------------------
841
842namespace eval ::ripemd {
843
844    namespace import -force [namespace current]::ripemd160::*
845
846    namespace export ripemd160 hmac160 \
847        RIPEMD160Init RIPEMD160Update RIPEMD160Final \
848        RIPEHMAC160Init RIPEHMAC160Update RIPEHMAC160Final
849}
850
851# -------------------------------------------------------------------------
852
853# Try and load a compiled extension to help.
854namespace eval ::ripemd::ripemd160 {
855    foreach e {cryptkit trf} { if {[LoadAccelerator $e]} { break } }
856    unset e
857}
858
859package provide ripemd160 $::ripemd::ripemd160::version
860
861# -------------------------------------------------------------------------
862# Local Variables:
863#   mode: tcl
864#   indent-tabs-mode: nil
865# End:
866
867
868