1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
  
     | 
    
      # -*- tcl -*-
# sha1.test:  tests for the sha1 commands
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2001 by ActiveState Tool Corp.
# All rights reserved.
#
# RCS: @(#) $Id: sha1v1.test,v 1.2 2006/10/09 21:41:42 andreas_kupries Exp $
# -------------------------------------------------------------------------
source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]
testsNeedTcl     8.2
testsNeedTcltest 1.0
testing {
    useLocal sha1v1.tcl sha1
}
# -------------------------------------------------------------------------
# Now the package specific tests....
# -------------------------------------------------------------------------
if {[::sha1::LoadAccelerator critcl]} {
    puts "> critcl based"
}
if {[::sha1::LoadAccelerator cryptkit]} {
    puts "> cryptkit based"
}
if {[::sha1::LoadAccelerator trf]} {
    puts "> Trf based"
}
puts "> pure Tcl"
# -------------------------------------------------------------------------
# Handle multiple implementation testing
#
array set preserve [array get ::sha1::accel]
proc implementations {} {
    variable ::sha1::accel
    foreach {a v} [array get accel] {if {$v} {lappend r $a}}
    lappend r tcl; set r
}
proc select_implementation {impl} {
    variable ::sha1::accel
    foreach e [array names accel] { set accel($e) 0 }
    if {[string compare "tcl" $impl] != 0} {
        set accel($impl) 1
    }
}
proc reset_implementation {} {
    variable ::sha1::accel
    array set accel [array get ::preserve]
}
# -------------------------------------------------------------------------
test sha1-1.0 {sha1} {
    catch {::sha1::sha1} result
    set result
} "wrong # args: should be \"sha1 ?-hex? -filename file | string\""
test sha1-1.1 {sha1} {
    catch {::sha1::hmac} result
    set result
} "wrong # args: should be \"hmac ?-hex? -key key -filename file | string\""
test sha1-1.2 {sha1} {
    catch {::sha1::hmac key} result
    set result
} "wrong # args: should be \"hmac ?-hex? -key key -filename file | string\""
set vectors {
    1 "abc"
    "a9993e364706816aba3e25717850c26c9cd0d89d"
    2 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
    "84983e441c3bd26ebaae4aa1f95129e5e54670f1"
}
foreach impl [implementations] {
    select_implementation $impl
    foreach {n msg expected} $vectors {
        test sha1-$impl-2.$n "sha1 ($impl impl)" {
            list [catch {::sha1::sha1 $msg} r] $r
        } [list 0 $expected]
    }
    reset_implementation
}
set vectors {
    1 ""     ""      "fbdb1d1b18aa6c08324b7d64b71fb76370690e1d"
    2 "foo"  "hello" "4c883e9bc42763641bba04185d492de00de7ce2c"
    3 "bar"  "world" "a905e79f51faa446cb5a3888b577e34577ef7fce"
    4 "key"  "text"  "369e2959eb49450338b212748f77d8ded74847bb"
    5 "sha1" "hmac"  "2660aeeccf432596e56f8f8260de971322e8935b"
    6 "hmac" "sha1"  "170523fd610da92dd4b4fb948a01a8365d66511a"
    7 "sha1" "sha1"  "5154473317173f66212fc59365233ffd9cbaab94"
    8 "hmac" "hmac"  "9e08393f6ac829c4385930ea38567dad582d958f"
    9 "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" "hello world"
    "dd80c541f75064d70e53a6b7b0a45210127f484e"
}
foreach impl [implementations] {
    select_implementation $impl
    foreach {n key text expected} $vectors {
        test sha1-$impl-3.$n "hmac ($impl impl)" {
            list [catch {::sha1::hmac $key $text} r] $r
        } [list 0 $expected]
    }
    reset_implementation
}
# -------------------------------------------------------------------------
# RFC 2202 has a set of test vectors for HMAC-MD5 and HMAC-SHA1.
# This is those test vectors...
# -------------------------------------------------------------------------
set vectors \
    [list \
         1 [string repeat \x0b 20] "Hi There" \
         b617318655057264e28bc0b6fb378c8ef146be00 \
         2 "Jefe" "what do ya want for nothing?" \
         effcdf6ae5eb2fa2d27416d5f184df9c259a7c79 \
         3 [string repeat \xaa 20] [string repeat \xdd 50] \
         125d7342b9ac11cd91a39af48aa17b4f63f175d3 \
         4 \
         [binary format H* 0102030405060708090a0b0c0d0e0f10111213141516171819]\
         [string repeat \xcd 50] \
         4c9007f4026250c6bc8414f9bf50c86c2d7235da \
         5 [string repeat \x0c 20] "Test With Truncation" \
         4c1a03424b55e07fe7f27be1d58bb9324a9a5a04 \
         6 [string repeat \xaa 80] \
         "Test Using Larger Than Block-Size Key - Hash Key First" \
         aa4ae5e15272d00e95705637ce8a3b55ed402112 \
         7 [string repeat \xaa 80] \
         "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" \
         e8e99d0f45237d786d6bbaa7965c7808bbff1a91 \
        ]
foreach impl [implementations] {
    select_implementation $impl
    foreach {n key msg hash} $vectors {
        test sha1-$impl-4a.$n "RFC2202 test vectors for HMAC-SHA1 ($impl)" {
            list [catch {::sha1::hmac $key $msg} r] $r
        } [list 0 $hash]
    }
    reset_implementation
}
# -------------------------------------------------------------------------
test sha1-5.1 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::sha1 -hello} msg] $msg
} {0 bd32f1769a47f98c73348c87f5d6842ccd129911}
test sha1-5.2 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::sha1 -hex -- -hello} msg] $msg
} {0 bd32f1769a47f98c73348c87f5d6842ccd129911}
test sha1-5.3 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::sha1 --} msg] $msg
} {0 e6a9fc04320a924f46c7c737432bb0389d9dd095}
test sha1-5.4 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::sha1 -hex -- --} msg] $msg
} {0 e6a9fc04320a924f46c7c737432bb0389d9dd095}
test sha1-6.1 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::hmac - -hello} msg] $msg
} {0 872c0aa5dca317c3be39a209c5aaa4d8139052b1}
test sha1-6.2 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::hmac -- -hello} msg] $msg
} {0 a0e2547c63c9de64338efb19b0c6c533968748cc}
test sha1-6.3 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::hmac -hex -key -- --} msg] $msg
} {0 d1efe5ea394610b39c10b97418278199ddd65766}
test sha1-6.4 {Check hashing data that begins with hyphen} {
    list [catch {::sha1::hmac -hex -key - --} msg] $msg
} {0 01c134b54ab872941acfce0cf3202f16ee64fb14}
# -------------------------------------------------------------------------
set testfile [makeFile {} sha1[pid].data]
# pattern repeatcount sha1-hash
set vectors \
    [list \
         0 "\x00" 81922 a9fb4910179d5088ab606944ca0216e4403a5141 \
         1 "\x5a" 81920 fef13bbee20792b7b2e65f15d5e4dd6ae04e2323 \
         2 "\x01\x23\x45\x67\x89\xab\xcd\xef" 2048 \
           846b9be26036a0b3c16a32805b5f3a85f8d0e0f5 \
         ]
foreach {n pattern repeat hash} $vectors {
    test sha1-7.$n "file hashing" {
        list [catch {
            set f [open $testfile w]
            fconfigure $f -encoding binary -translation binary
            puts -nonewline $f [string repeat $pattern $repeat]
            close $f
            sha1::sha1 -hex -file $testfile
        } msg] $msg
    } [list 0 $hash]
}
removeFile $testfile
# -------------------------------------------------------------------------
testsuiteCleanup
# -------------------------------------------------------------------------
# Local Variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:
 
     |