1# soapinteropC.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com> 2# 3# SOAP Interoperability Lab "Round 2" Proposal C Client Tests 4# 5# See http://www.whitemesa.com/interop.htm for details. 6# 7# ------------------------------------------------------------------------- 8# This software is distributed in the hope that it will be useful, but 9# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 10# or FITNESS FOR A PARTICULAR PURPOSE. See the accompanying file `LICENSE' 11# for more details. 12# ------------------------------------------------------------------------- 13# 14# @(#)$Id: soapinteropC.tcl,v 1.2 2001/10/07 22:28:08 patthoyts Exp $ 15 16package require -exact soapinterop::base 1.0 17package provide soapinterop::C 1.0 18 19namespace eval soapinterop { 20} 21 22proc soapinterop::round2:proposalC {proxy} { 23 validate.echoMeStringRequest $proxy 24 validate.echoMeStructRequest $proxy 25} 26 27proc soapinterop::validate.echoMeStringRequest {proxy} { 28 SOAP::create echoVoid -proxy $proxy \ 29 -uri http://soapinterop.org/ \ 30 -action http://soapinterop.org/ 31 32 catch {validate.emsr:A} msg ; puts "$msg" 33 catch {validate.emsr:B} msg ; puts "$msg" 34 catch {validate.emsr:C} msg ; puts "$msg" 35 catch {validate.emsr:D} msg ; puts "$msg" 36 catch {validate.emsr:E} msg ; puts "$msg" 37 catch {validate.emsr:F} msg ; puts "$msg" 38} 39 40proc soapinterop::validate.echoMeStructRequest {proxy} { 41 42 SOAP::create echoVoid -proxy $proxy \ 43 -uri http://soapinterop.org/ \ 44 -action http://soapinterop.org/ 45 46 catch {validate.emtr:A} msg ; puts "$msg" 47 catch {validate.emtr:B} msg ; puts "$msg" 48 catch {validate.emtr:C} msg ; puts "$msg" 49 catch {validate.emtr:D} msg ; puts "$msg" 50 catch {validate.emtr:E} msg ; puts "$msg" 51 catch {validate.emtr:F} msg ; puts "$msg" 52} 53 54# ------------------------------------------------------------------------- 55# Header contructors 56# ------------------------------------------------------------------------- 57 58proc soapinterop::emsr:header {actor mustUnderstand request {siop http://soapinterop.org/echoheader/} } { 59 return [list siop:echoMeStringRequest \ 60 [rpcvar::rpcvar -attr [list xmlns:siop $siop \ 61 SOAP-ENV:mustUnderstand $mustUnderstand \ 62 SOAP-ENV:actor $actor]\ 63 string $request]] 64} 65 66proc soapinterop::emtr:header {actor mustUnderstand request {siop http://soapinterop.org/echoheader/}} { 67 return [list siop:echoMeStructRequest \ 68 [rpcvar::rpcvar -attr [list xmlns:siop $siop \ 69 SOAP-ENV:mustUnderstand $mustUnderstand \ 70 SOAP-ENV:actor $actor]\ 71 SOAPStruct $request]] 72} 73 74# ------------------------------------------------------------------------- 75 76proc soapinterop::validate.emsr:A {} { 77 78 set actor http://schemas.xmlsoap.org/soap/actor/next 79 set request "TestA" 80 set header [emsr:header $actor 0 $request] 81 82 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 83 echoVoid -header $header 84 array set h [SOAP::cget echoVoid headers] 85 86 if {! [info exists h(echoMeStringResponse)]} { 87 error "failed: no suitable header returned." 88 } 89 if {![string match $request $h(echoMeStringResponse)]} { 90 error "failed: reply mismatch \"$request\" != \"$h(echoMeStringResponse)\"" 91 } 92 return "echoMeStringRequest(actor=next, mustUnderstand=0)" 93} 94 95proc soapinterop::validate.emsr:B {} { 96 97 set actor http://schemas.xmlsoap.org/soap/actor/next 98 set request "TestB" 99 set header [emsr:header $actor 1 $request] 100 101 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 102 echoVoid -header $header 103 array set h [SOAP::cget echoVoid headers] 104 105 if {! [info exists h(echoMeStringResponse)]} { 106 error "failed: no suitable header returned." 107 } 108 if {![string match $request $h(echoMeStringResponse)]} { 109 error "failed: reply mismatch \"$request\" != \"$h(echoMeStringResponse)\"" 110 } 111 return "echoMeStringRequest(actor=next, mustUnderstand=1)" 112} 113 114proc soapinterop::validate.emsr:C {} { 115 116 set actor "http://tempuri.org/not/me" 117 set request "TestC" 118 set header [emsr:header $actor 0 $request] 119 120 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 121 echoVoid -header $header 122 array set h [SOAP::cget echoVoid headers] 123 124 if {[info exists h(echoMeStringResponse)]} { 125 error "failed: recipient should not have replied: $h(echoMeStringResponse)" 126 } 127 return "echoMeStringRequest(actor=other, mustUnderstand=0)" 128} 129 130proc soapinterop::validate.emsr:D {} { 131 132 set actor "http://tempuri.org/not/me" 133 set request "TestD" 134 set header [emsr:header $actor 1 $request] 135 136 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 137 echoVoid -header $header 138 array set h [SOAP::cget echoVoid headers] 139 140 if {[info exists h(echoMeStringResponse)]} { 141 error "failed: recipient should not have replied: $h(echoMeStringRequest)" 142 } 143 return "echoMeStringRequest(actor=other, mustUnderstand=1)" 144} 145 146# actor=next, mustUnderstand=1, wrong namespace => error. 147proc soapinterop::validate.emsr:E {} { 148 149 set actor http://schemas.xmlsoap.org/soap/actor/next 150 set request "TestE" 151 set header [emsr:header $actor 1 $request http://tempuri.org/not/siop] 152 153 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 154 if {[catch {echoVoid -header $header} msg]} { 155 if {![regexp {^([^ ]*:)?MustUnderstand} $msg]} { 156 error "failed: expected MustUnderstand fault. Received \"$msg\"" 157 } 158 } else { 159 error "failed: should return error for incomprehensible required header" 160 } 161 162 return "echoMeStringRequest(actor=next, mustUnderstand=1, namespace=rubbish)" 163} 164 165# actor=next, mustUnderstand=1, wrong namespace => ignored. 166proc soapinterop::validate.emsr:F {} { 167 168 set actor http://schemas.xmlsoap.org/soap/actor/next 169 set request "TestF" 170 set header [emsr:header $actor 0 $request http://tempuri.org/not/siop] 171 172 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 173 if {[catch {echoVoid -header $header} msg]} { 174 if {[regexp {^([^ ]*:)?MustUnderstand} $msg]} { 175 error "failed: received unexpected MustUnderstand fault." 176 } else { 177 error "failed: received error \"$msg\"" 178 } 179 } 180 181 array set h [SOAP::cget echoVoid headers] 182 if {[info exists h(echoMeStringResponse)]} { 183 error "failed: recipient should not have replied: $h(echoMeStringRequest)" 184 } 185 186 return "echoMeStringRequest(actor=next, mustUnderstand=0, namespace=rubbish)" 187} 188# ------------------------------------------------------------------------- 189 190proc soapinterop::validate.emtr:A {} { 191 192 set request [list varString "TestA" varInt [rand_int] varFloat [rand_float]] 193 set actor http://schemas.xmlsoap.org/soap/actor/next 194 set header [emtr:header $actor 0 $request] 195 196 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 197 echoVoid -header $header 198 array set h [SOAP::cget echoVoid headers] 199 200 if {! [info exists h(echoMeStructResponse)]} { 201 error "failed: no suitable header returned." 202 } 203 if {[catch {validateSOAPStruct $request $h(echoMeStructResponse)} msg]} { 204 error "failed: $msg" 205 } 206 return "echoMeStructRequest(actor=next, mustUnderstand=0)" 207} 208 209proc soapinterop::validate.emtr:B {} { 210 211 set request [list varString "TestB" varInt [rand_int] varFloat [rand_float]] 212 set actor http://schemas.xmlsoap.org/soap/actor/next 213 set header [emtr:header $actor 1 $request] 214 215 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 216 echoVoid -header $header 217 array set h [SOAP::cget echoVoid headers] 218 219 if {! [info exists h(echoMeStructResponse)]} { 220 error "failed: no suitable header returned." 221 } 222 if {[catch {validateSOAPStruct $request $h(echoMeStructResponse)} msg]} { 223 error "failed: $msg" 224 } 225 return "echoMeStructRequest(actor=next, mustUnderstand=1)" 226} 227 228proc soapinterop::validate.emtr:C {} { 229 230 set request [list varString "TestC" varInt [rand_int] varFloat [rand_float]] 231 set actor "http://tempuri.org/not/me" 232 set header [emtr:header $actor 0 $request] 233 234 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 235 echoVoid -header $header 236 array set h [SOAP::cget echoVoid headers] 237 238 if {[info exists h(echoMeStructResponse)]} { 239 error "failed: recipient should not have replied: $h(echoMeStructResponse)" 240 } 241 return "echoMeStructRequest(actor=other, mustUnderstand=0)" 242} 243 244proc soapinterop::validate.emtr:D {} { 245 246 set request [list varString "TestD" varInt [rand_int] varFloat [rand_float]] 247 set actor "http://tempuri.org/not/me" 248 set header [emtr:header $actor 1 $request] 249 250 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 251 echoVoid -header $header 252 array set h [SOAP::cget echoVoid headers] 253 254 if {[info exists h(echoMeStructResponse)]} { 255 error "failed: recipient should not have replied: $h(echoMeStructResponse)" 256 } 257 return "echoMeStructRequest(actor=other, mustUnderstand=1)" 258} 259 260proc soapinterop::validate.emtr:E {} { 261 262 set request [list varString "TestE" varInt [rand_int] varFloat [rand_float]] 263 set actor "http://schemas.xmlsoap.org/soap/actor/next" 264 set header [emtr:header $actor 1 $request http://tempuri.org/not/siop] 265 266 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 267 if {[catch {echoVoid -header $header} msg]} { 268 if {![regexp {^([^ ]*:)?MustUnderstand} $msg]} { 269 error "failed: expected MustUnderstand fault. Received \"$msg\"" 270 } 271 } else { 272 error "failed: should return error for incomprehensible required header" 273 } 274 return "echoMeStructRequest(actor=next, mustUnderstand=1, namespace=rubbish)" 275} 276 277proc soapinterop::validate.emtr:F {} { 278 279 set request [list varString "TestF" varInt [rand_int] varFloat [rand_float]] 280 set actor "http://schemas.xmlsoap.org/soap/actor/next" 281 set header [emtr:header $actor 0 $request http://tempuri.org/not/siop] 282 283 set ::SOAP::_soapinterop_echoVoid(headers) {} ;# HACK 284 if {[catch {echoVoid -header $header} msg]} { 285 if {[regexp {^([^ ]*:)?MustUnderstand} $msg]} { 286 error "failed: received unexpected MustUnderstand fault." 287 } else { 288 error "failed: received error \"$msg\"" 289 } 290 } 291 292 array set h [SOAP::cget echoVoid headers] 293 if {[info exists h(echoMeStructResponse)]} { 294 error "failed: recipient should not have replied: $h(echoMeStructResponse)" 295 } 296 297 return "echoMeStructRequest(actor=next, mustUnderstand=0, namespace=rubbish)" 298} 299 300# ------------------------------------------------------------------------- 301 302# 303# Local variables: 304# mode: tcl 305# indent-tabs-mode: nil 306# End: 307