1# sasl.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> 2# 3# Tests for the Tcllib SASL package 4# 5# ------------------------------------------------------------------------- 6# See the file "license.terms" for information on usage and redistribution 7# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 8# ------------------------------------------------------------------------- 9# RCS: @(#) $Id: sasl.test,v 1.10 2008/01/29 00:51:39 patthoyts Exp $ 10 11# ------------------------------------------------------------------------- 12 13source [file join \ 14 [file dirname [file dirname [file join [pwd] [info script]]]] \ 15 devtools testutilities.tcl] 16 17testsNeedTcl 8.2 18testsNeedTcltest 1.0 19 20testing { 21 useLocal sasl.tcl SASL 22} 23 24# ------------------------------------------------------------------------- 25# Tests 26# ------------------------------------------------------------------------- 27 28proc SASLCallback {clientblob context command args} { 29 upvar #0 $context ctx 30 switch -exact -- $command { 31 login { return "" } 32 username { return "tester" } 33 password { return "secret" } 34 realm { return "tcllib.sourceforge.net" } 35 hostname { return [info host] } 36 default { 37 return -code error "oops: client needs to write $command" 38 } 39 } 40} 41 42# ------------------------------------------------------------------------- 43 44test SASL-1.0 {Check mechanisms preference sorting} { 45 list [catch { 46 set M $::SASL::mechanisms 47 set ::SASL::mechanisms {} 48 SASL::register TEST-1 10 client server 49 SASL::register TEST-3 100 client 50 SASL::register TEST-2 50 client 51 set r [SASL::mechanisms] 52 set ::SASL::mechanisms $M 53 set r 54 } res] $res 55} [list 0 [list TEST-3 TEST-2 TEST-1]] 56 57test SASL-1.1 {Check mechanisms type parameter} { 58 list [catch { 59 set M $::SASL::mechanisms 60 set ::SASL::mechanisms {} 61 SASL::register TEST-1 10 client server 62 SASL::register TEST-3 100 client 63 SASL::register TEST-2 50 client 64 set r [list [SASL::mechanisms client] [SASL::mechanisms server]] 65 set ::SASL::mechanisms $M 66 set r 67 } res] $res 68} [list 0 [list [list TEST-3 TEST-2 TEST-1] [list TEST-1]]] 69 70test SASL-1.2 {Check mechanisms preference minimum} { 71 list [catch { 72 set M $::SASL::mechanisms 73 set ::SASL::mechanisms {} 74 SASL::register TEST-1 10 client server 75 SASL::register TEST-3 100 client 76 SASL::register TEST-2 50 client 77 set r [list [SASL::mechanisms client 50] [SASL::mechanisms client 80]] 78 set ::SASL::mechanisms $M 79 set r 80 } res] $res 81} [list 0 [list [list TEST-3 TEST-2] [list TEST-3]]] 82 83# ------------------------------------------------------------------------- 84 85test SASL-PLAIN-1.0 {} { 86 list [catch { 87 set ctx [SASL::new -mechanism PLAIN \ 88 -callback [list SASLCallback 0]] 89 SASL::step $ctx "" 90 set r [SASL::response $ctx] 91 SASL::cleanup $ctx 92 set r 93 } res] $res 94} [list 0 "\x00tester\x00secret"] 95 96# ------------------------------------------------------------------------- 97 98test SASL-LOGIN-2.0 {Check basic LOGIN operation} { 99 list [catch { 100 set r {} 101 set ctx [SASL::new -mechanism LOGIN \ 102 -callback [list SASLCallback 0]] 103 SASL::step $ctx "VXNlcm5hbWU6" 104 lappend r [SASL::response $ctx] 105 SASL::step $ctx "UGFzc3dvcmQ6" 106 lappend r [SASL::response $ctx] 107 SASL::cleanup $ctx 108 set r 109 } res] $res 110} [list 0 [list tester secret]] 111 112test SASL-LOGIN-2.1 {Check initial NULL challenge is ignored.} { 113 list [catch { 114 set r {} 115 set ctx [SASL::new -mechanism LOGIN \ 116 -callback [list SASLCallback 0]] 117 SASL::step $ctx "" 118 lappend r [SASL::response $ctx] 119 SASL::step $ctx "VXNlcm5hbWU6" 120 lappend r [SASL::response $ctx] 121 SASL::step $ctx "UGFzc3dvcmQ6" 122 lappend r [SASL::response $ctx] 123 SASL::cleanup $ctx 124 set r 125 } res] $res 126} [list 0 [list {} tester secret]] 127 128# ------------------------------------------------------------------------- 129 130test SASL-CRAMMD5-3.0 {} { 131 list [catch { 132 set ctx [SASL::new -mechanism CRAM-MD5 \ 133 -callback [list SASLCallback 0]] 134 SASL::step $ctx "<1234.987654321@tcllib.sourceforge.net>" 135 set r [SASL::response $ctx] 136 SASL::cleanup $ctx 137 set r 138 } res] $res 139} [list 0 [list tester c7e3043702b782d70716bd1e21d6e2f7]] 140 141test SASL-CRAMMD5-3.1 {} { 142 list [catch { 143 set ctx [SASL::new -mechanism CRAM-MD5 \ 144 -callback [list SASLCallback 0]] 145 SASL::step $ctx "" 146 set r1 [SASL::response $ctx] 147 SASL::step $ctx "" 148 set r2 [SASL::response $ctx] 149 SASL::cleanup $ctx 150 list $r1 $r2 151 } res] $res 152} {0 {{} {}}} 153 154test SASL-CRAMMD5-3.2 {} { 155 list [catch { 156 set ctx [SASL::new -mechanism CRAM-MD5 \ 157 -callback [list SASLCallback 0]] 158 SASL::step $ctx "<1234.987654321@tcllib.sourceforge.net>" 159 set r [SASL::response $ctx] 160 SASL::step $ctx "" 161 set r2 [SASL::response $ctx] 162 SASL::cleanup $ctx 163 list $r $r2 164 } res] $res 165} [list 1 "unexpected state: CRAM-MD5 has only 1 step"] 166 167test SASL-CRAMMD5-3.3 {} { 168 list [catch { 169 set ctx [SASL::new -mechanism CRAM-MD5 \ 170 -callback [list SASLCallback 0]] 171 SASL::step $ctx "<1234.987654321@tcllib.sourceforge.net>" 172 set r1 [SASL::response $ctx] 173 SASL::step $ctx "" 174 set r2 [SASL::response $ctx] 175 SASL::cleanup $ctx 176 list $r1 $r2 177 } res] $res 178} [list 1 "unexpected state: CRAM-MD5 has only 1 step"] 179 180# ------------------------------------------------------------------------- 181 182test SASL-DIGESTMD5-4.0 {Basic check of DIGEST-MD5 operation} { 183 list [catch { 184 set ctx [SASL::new -mechanism DIGEST-MD5 \ 185 -callback [list SASLCallback 0]] 186 SASL::step $ctx "nonce=\"0123456789\",realm=\"tcllib.sourceforge.net\"" 187 set r [split [SASL::response $ctx] ,] 188 SASL::cleanup $ctx 189 foreach thing $r { 190 set x [split $thing =] 191 set R([lindex $x 0]) [lindex [lindex $x 1] 0] 192 } 193 set A1 [SASL::md5_bin "tester:tcllib.sourceforge.net:secret"] 194 set A2 "AUTHENTICATE:smtp/tcllib.sourceforge.net" 195 set A3 [SASL::md5_hex "$A1:$R(nonce):$R(cnonce)"] 196 set A4 [SASL::md5_hex $A2] 197 set r [SASL::md5_hex "$A3:0123456789:$R(nc):$R(cnonce):auth:$A4"] 198 string compare $r $R(response) 199 } res] $res 200} [list 0 0] 201 202test SASL-DIGESTMD5-4.1 {Check initial empty challenge is accepted.} { 203 list [catch { 204 set ctx [SASL::new -mechanism DIGEST-MD5 \ 205 -callback [list SASLCallback 0]] 206 SASL::step $ctx "" 207 SASL::step $ctx "nonce=\"0123456789\",realm=\"tcllib.sourceforge.net\"" 208 set r [split [SASL::response $ctx] ,] 209 SASL::cleanup $ctx 210 foreach thing $r { 211 set x [split $thing =] 212 set R([lindex $x 0]) [lindex [lindex $x 1] 0] 213 } 214 set A1 [SASL::md5_bin "tester:tcllib.sourceforge.net:secret"] 215 set A2 "AUTHENTICATE:smtp/tcllib.sourceforge.net" 216 set A3 [SASL::md5_hex "$A1:$R(nonce):$R(cnonce)"] 217 set A4 [SASL::md5_hex $A2] 218 set r [SASL::md5_hex "$A3:0123456789:$R(nc):$R(cnonce):auth:$A4"] 219 string compare $r $R(response) 220 } res] $res 221} [list 0 0] 222 223test SASL-DIGESTMD5-4.2 "bug #1412021: ensure service used correctly" { 224 list [catch { 225 set service xmpp 226 set ctx [SASL::new -mechanism DIGEST-MD5 -service $service \ 227 -callback [list SASLCallback 0]] 228 SASL::step $ctx "nonce=\"0123456789\",realm=\"tcllib.sourceforge.net\"" 229 set r [split [SASL::response $ctx] ,] 230 SASL::cleanup $ctx 231 foreach thing $r { 232 set x [split $thing =] 233 set R([lindex $x 0]) [lindex [lindex $x 1] 0] 234 } 235 set A1 [SASL::md5_bin "tester:tcllib.sourceforge.net:secret"] 236 set A2 "AUTHENTICATE:$service/tcllib.sourceforge.net" 237 set A3 [SASL::md5_hex "$A1:$R(nonce):$R(cnonce)"] 238 set A4 [SASL::md5_hex $A2] 239 set r [SASL::md5_hex "$A3:0123456789:$R(nc):$R(cnonce):auth:$A4"] 240 string compare $r $R(response) 241 } res] $res 242} [list 0 0] 243 244test SASL-DIGESTMD5-4.3 "check for support of charset parameter" { 245 list [catch { 246 set service xmpp 247 set ctx [SASL::new -mechanism DIGEST-MD5 -service $service \ 248 -callback [list SASLCallback 0]] 249 SASL::step $ctx "nonce=\"0123456789\",realm=\"tcllib.sourceforge.net\",charset=utf-8" 250 array set p [SASL::DigestParameters [SASL::response $ctx]] 251 SASL::cleanup $ctx 252 info exists p(charset) 253 } res] $res 254} [list 0 1] 255 256test SASL-DIGESTMD5-4.4 "check parsing of spaces in params" { 257 list [catch { 258 set service xmpp 259 set ctx [SASL::new -mechanism DIGEST-MD5 -service $service \ 260 -callback [list SASLCallback 0]] 261 SASL::step $ctx "nonce=\"0123456789\", realm=\"tcllib.sourceforge.net\", charset=utf-8" 262 set r {} 263 foreach {k v} [SASL::DigestParameters [SASL::response $ctx]] { lappend r $k } 264 SASL::cleanup $ctx 265 lsort $r 266 } res] $res 267} [list 0 {charset cnonce digest-uri nc nonce qop realm response username}] 268 269test SASL-OTP-5.0 {Check basic OTP (otp-md5) operation} { 270 list [catch { 271 set r {} 272 set ctx [SASL::new -mechanism OTP \ 273 -callback [list SASLCallback 0]] 274 SASL::step $ctx "" 275 lappend r [SASL::response $ctx] 276 SASL::step $ctx "otp-md5 5 test5 ext" 277 lappend r [SASL::response $ctx] 278 SASL::cleanup $ctx 279 set r 280 } res] $res 281} [list 0 [list "\x00tester" "word:RIG ACRE TALL CALL OAR NEIL"]] 282 283# ------------------------------------------------------------------------- 284 285testsuiteCleanup 286 287# Local Variables: 288# mode: tcl 289# indent-tabs-mode: nil 290# End: 291