Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Correct errors found by static analyser. Some documentation help for static analyser too |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
6e8f96d585fb9ba14fa7f3a7a9e4fb92 |
| User & Date: | oehhar 2017-08-31 08:41:25 |
Context
| 2017-08-31 08:51 | Use utility function ::WS::Utils::geturl_fetchbody for http::geturl calls which handles errors and follows redirects. Exception are calls with a -command argument check-in: 118a1dadf5 user: oehhar tags: trunk | |
| 2017-08-31 08:41 | Correct errors found by static analyser. Some documentation help for static analyser too check-in: 6e8f96d585 user: oehhar tags: trunk | |
| 2017-08-30 08:53 | Transfered some of the info in ticket [9c6ff35e39] about the 2.4 changes to the documentation. Restored stripping of a header from an xml response. check-in: 1ed3999e04 user: oehhar tags: trunk | |
Changes
Changes to ClientSide.tcl.
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 ... 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 ... 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 .... 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 .... 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 .... 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 .... 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 .... 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 .... 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 .... 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 .... 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 .... 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 .... 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 .... 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 .... 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 .... 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 .... 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 .... 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 |
## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ## ## ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ## ## POSSIBILITY OF SUCH DAMAGE. ## ## ## ############################################################################### package require Tcl 8.4 package require WS::Utils 2.3.7 ; # dict, lassign package require tdom 0.8 package require http 2 package require log package require uri package provide WS::Client 2.4.0 ................................................................................ # Public Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PUBLIC<< # # Procedure Name : ::WS::Client::AddOutputHeader # # Description : Import and additional namespace into the service # # Arguments : # serviceName - Service name to of the oepration # operation - name of operation to add an output header to # headerType - the type name to add as a header # attrList - list of name value pairs of attributes and their # values to add to the XML ................................................................................ # # ########################################################################### proc ::WS::Client::AddOutputHeader {serviceName operation headerType} { variable serviceArr set serviceInfo $serviceArr($serviceName) set soapReplyHeader [dict get $serviceInfo operation $operationName soapReplyHeader] lappend soapReplyHeader $headerType dict set serviceInfo operation $operationName soapReplyHeader $soapReplyHeader set serviceArr($serviceName) $serviceInfo return ; } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure ................................................................................ set first [string first {<} $wsdlXML] if {$first > 0} { set wsdlXML [string range $wsdlXML $first end] } ::log::log debug "Parsing WSDL {$wsdlXML}" dom parse $wsdlXML tmpdoc $tmpdoc xslt $::WS::Utils::xsltSchemaDom wsdlDoc $tmpdoc delete $wsdlDoc documentElement wsdlNode set nsCount 1 set targetNs [$wsdlNode getAttribute targetNamespace] set ::WS::Utils::targetNs $targetNs dict set nsDict url $targetNs tns$nsCount foreach itemList [$wsdlNode attributes xmlns:*] { set ns [lindex $itemList 0] ................................................................................ set serviceInfo $serviceArr($serviceName) if {![dict exists $serviceInfo operation $operationName]} { return \ -code error \ -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \ "Unknown operation '$operationName' for service '$serviceName'" } set url [dict get $serviceInfo location] SaveAndSetOptions $serviceName if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} { RestoreSavedOptions $serviceName return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err } else { RestoreSavedOptions $serviceName ................................................................................ } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ::log::log info [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] } ................................................................................ } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ] } ................................................................................ set expectedMsgType [dict get $serviceInfo operation $operationName outputs] set expectedMsgTypeBase [lindex [split $expectedMsgType {:}] end] set first [string first {<} $inXML] if {$first > 0} { set inXML [string range $inXML $first end] } dom parse $inXML doc $doc documentElement top set xns { ENV http://schemas.xmlsoap.org/soap/envelope/ xsi "http://www.w3.org/2001/XMLSchema-instance" xs "http://www.w3.org/2001/XMLSchema" } foreach tmp [dict get $serviceInfo targetNamespace] { ................................................................................ set rootNode [$body childNodes] ::log::log debug "Have [llength $rootNode] node under Body" if {[llength $rootNode] > 1} { foreach tmp $rootNode { #puts "\t Got {[$tmp localName]} looking for {$expectedMsgTypeBase}" if {[$tmp localName] eq $expectedMsgTypeBase || [$tmp nodeName] eq $expectedMsgTypeBase || [$tmp localName] eq Fault || [$tmp nodeName] eq Fault} { set rootNode $tmp break } } } if {([llength $rootNode] == 1) && $rootNode ne {}} { set rootName [$rootNode localName] ................................................................................ continue } set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType] xns] if {[info exists tnsArray($xns)]} { set xns $tnsArray($xns) } if {$firstHeader} { $env appendChild [$doc createElement "SOAP-ENV:Header" header] set firstHeader 0 } if {[dict exists $serviceInfo skipHeaderLevel] && [dict get $serviceInfo skipHeaderLevel]} { set headerData $header } else { set typeInfo [split $inputHeaderType {:}] ................................................................................ if {[llength $attrList]} { ::WS::Utils::setAttr $headerData $attrList } } ::WS::Utils::convertDictToType Client $serviceName $doc $headerData $argList $inputHeaderType } $env appendChild [$doc createElement "SOAP-ENV:Body" bod] #puts "set xns \[dict get \[::WS::Utils::GetServiceTypeDef Client $serviceName $msgType\] xns\]" #puts "\t [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType]" set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns] if {[info exists tnsArray($xns)]} { set xns $tnsArray($xns) } ................................................................................ ::WS::Utils::convertDictToEncodedType Client $serviceName $doc $headerData $argList $inputHeaderType } $env appendChild [$doc createElement "SOAP-ENV:Body" bod] set baseName [dict get $serviceInfo operation $operationName name] set callXns [dict get $serviceInfo operation $operationName xns] if {![string is space $callXns]} { $bod appendChild [$doc createElement $callXns:$baseName reply] } else { $bod appendChild [$doc createElement $baseName reply] } $reply setAttribute \ SOAP-ENV:encodingStyle "http://schemas.xmlsoap.org/soap/encoding/" ................................................................................ } if {[dict exists $serviceInfo operation $operName]} { if {!$options(allowOperOverloading)} { return -code error \ -errorcode [list WS CLIENT NOOVERLOAD $operName] } ## ## See if the existing operation needs to be cloned" ## set origType [lindex [split [dict get $serviceInfo operation $operName inputs] {:}] end] set newName ${operName}_${origType} if {![dict exists $serviceInfo operation $newName]} { ## ## Clone it ## ................................................................................ ::log:::log debug [list messageToType $wsdlNode $serviceName $baseName $msgName serviceInfo $style] set type [messageToType $wsdlNode $serviceName $baseName $msgName serviceInfo $style] lappend soapReplyHeaderList $type } dict set serviceInfo operation $operName soapReplyHeader $soapReplyHeaderList ## ## Validate that the input and output uses ## set inUse $use set outUse $use catch {set inUse [[$oper selectNodes w:input/d:body] getAttribute use]} catch {set outUse [[$oper selectNodes w:output/d:body] getAttribute use]} foreach tmp [list $inUse $outUse] { if {$tmp ne $use} { ................................................................................ } if {![dict exists $serviceInfo object $objectName operation $operationName]} { return \ -code error \ -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \ "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'" } if {$location ne {}} { set url $location } else { set url [dict get $serviceInfo object $objectName location] } SaveAndSetOptions $serviceName if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} { ................................................................................ return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ::log::log [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] } ................................................................................ "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'" } if {$location ne {}} { set url $location } else { set url [dict get $serviceInfo object $objectName location] } SaveAndSetOptions $serviceName if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} { RestoreSavedOptions $serviceName return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ................................................................................ } set serviceInfo $serviceArr($serviceName) set outTransform [dict get $serviceInfo outTransform] if {$outTransform ne {}} { set inXML [$outTransform $serviceName $operationName REPLY $inXML] } set expectedMsgType [dict get $serviceInfo object $objectName operation $operationName outputs] dom parse $inXML doc $doc documentElement top set xns {} foreach tmp [dict get $serviceInfo targetNamespace] { lappend xns $tmp } ::log::log debug "Using namespaces {$xns}" set body $top |
| | | | | > > > > > > > > > > > > > > > > > > | | > > > | | > > > > > > > > > > > > > > > < > | | > > > > > > |
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 ... 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 ... 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 .... 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 .... 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 .... 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 .... 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 .... 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 .... 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 .... 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 .... 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 .... 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 .... 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 .... 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 .... 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 .... 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 .... 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 .... 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 |
## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ## ## ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ## ## POSSIBILITY OF SUCH DAMAGE. ## ## ## ############################################################################### package require Tcl 8.4 package require WS::Utils 2.4 ; # dict, lassign package require tdom 0.8 package require http 2 package require log package require uri package provide WS::Client 2.4.0 ................................................................................ # Public Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PUBLIC<< # # Procedure Name : ::WS::Client::AddOutputHeader # # Description : Import any additional namespace into the service # # Arguments : # serviceName - Service name to of the oepration # operation - name of operation to add an output header to # headerType - the type name to add as a header # attrList - list of name value pairs of attributes and their # values to add to the XML ................................................................................ # # ########################################################################### proc ::WS::Client::AddOutputHeader {serviceName operation headerType} { variable serviceArr set serviceInfo $serviceArr($serviceName) set soapReplyHeader [dict get $serviceInfo operation $operation soapReplyHeader] lappend soapReplyHeader $headerType dict set serviceInfo operation $operation soapReplyHeader $soapReplyHeader set serviceArr($serviceName) $serviceInfo return } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure ................................................................................ set first [string first {<} $wsdlXML] if {$first > 0} { set wsdlXML [string range $wsdlXML $first end] } ::log::log debug "Parsing WSDL {$wsdlXML}" # save parsed document node to tmpdoc dom parse $wsdlXML tmpdoc # save transformed document handle in variable wsdlDoc $tmpdoc xslt $::WS::Utils::xsltSchemaDom wsdlDoc $tmpdoc delete # save top node in variable wsdlNode $wsdlDoc documentElement wsdlNode set nsCount 1 set targetNs [$wsdlNode getAttribute targetNamespace] set ::WS::Utils::targetNs $targetNs dict set nsDict url $targetNs tns$nsCount foreach itemList [$wsdlNode attributes xmlns:*] { set ns [lindex $itemList 0] ................................................................................ set serviceInfo $serviceArr($serviceName) if {![dict exists $serviceInfo operation $operationName]} { return \ -code error \ -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \ "Unknown operation '$operationName' for service '$serviceName'" } ## ## build query ## set url [dict get $serviceInfo location] SaveAndSetOptions $serviceName if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} { RestoreSavedOptions $serviceName return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err } else { RestoreSavedOptions $serviceName ................................................................................ } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } ## ## do http call ## if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ::log::log info [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] } ................................................................................ } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } ## ## Do the http request ## if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ] } ................................................................................ set expectedMsgType [dict get $serviceInfo operation $operationName outputs] set expectedMsgTypeBase [lindex [split $expectedMsgType {:}] end] set first [string first {<} $inXML] if {$first > 0} { set inXML [string range $inXML $first end] } # parse xml and save handle in variable doc dom parse $inXML doc # save top node handle in variable top $doc documentElement top set xns { ENV http://schemas.xmlsoap.org/soap/envelope/ xsi "http://www.w3.org/2001/XMLSchema-instance" xs "http://www.w3.org/2001/XMLSchema" } foreach tmp [dict get $serviceInfo targetNamespace] { ................................................................................ set rootNode [$body childNodes] ::log::log debug "Have [llength $rootNode] node under Body" if {[llength $rootNode] > 1} { foreach tmp $rootNode { #puts "\t Got {[$tmp localName]} looking for {$expectedMsgTypeBase}" if {[$tmp localName] eq $expectedMsgTypeBase || [$tmp nodeName] eq $expectedMsgTypeBase || [$tmp localName] eq {Fault} || [$tmp nodeName] eq {Fault}} { set rootNode $tmp break } } } if {([llength $rootNode] == 1) && $rootNode ne {}} { set rootName [$rootNode localName] ................................................................................ continue } set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType] xns] if {[info exists tnsArray($xns)]} { set xns $tnsArray($xns) } if {$firstHeader} { # side effect: save new node handle in variable header $env appendChild [$doc createElement "SOAP-ENV:Header" header] set firstHeader 0 } if {[dict exists $serviceInfo skipHeaderLevel] && [dict get $serviceInfo skipHeaderLevel]} { set headerData $header } else { set typeInfo [split $inputHeaderType {:}] ................................................................................ if {[llength $attrList]} { ::WS::Utils::setAttr $headerData $attrList } } ::WS::Utils::convertDictToType Client $serviceName $doc $headerData $argList $inputHeaderType } # side effect: save new element handle in variable bod $env appendChild [$doc createElement "SOAP-ENV:Body" bod] #puts "set xns \[dict get \[::WS::Utils::GetServiceTypeDef Client $serviceName $msgType\] xns\]" #puts "\t [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType]" set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns] if {[info exists tnsArray($xns)]} { set xns $tnsArray($xns) } ................................................................................ ::WS::Utils::convertDictToEncodedType Client $serviceName $doc $headerData $argList $inputHeaderType } $env appendChild [$doc createElement "SOAP-ENV:Body" bod] set baseName [dict get $serviceInfo operation $operationName name] set callXns [dict get $serviceInfo operation $operationName xns] # side effect: node handle is saved in variable reply if {![string is space $callXns]} { $bod appendChild [$doc createElement $callXns:$baseName reply] } else { $bod appendChild [$doc createElement $baseName reply] } $reply setAttribute \ SOAP-ENV:encodingStyle "http://schemas.xmlsoap.org/soap/encoding/" ................................................................................ } if {[dict exists $serviceInfo operation $operName]} { if {!$options(allowOperOverloading)} { return -code error \ -errorcode [list WS CLIENT NOOVERLOAD $operName] } ## ## See if the existing operation needs to be cloned ## set origType [lindex [split [dict get $serviceInfo operation $operName inputs] {:}] end] set newName ${operName}_${origType} if {![dict exists $serviceInfo operation $newName]} { ## ## Clone it ## ................................................................................ ::log:::log debug [list messageToType $wsdlNode $serviceName $baseName $msgName serviceInfo $style] set type [messageToType $wsdlNode $serviceName $baseName $msgName serviceInfo $style] lappend soapReplyHeaderList $type } dict set serviceInfo operation $operName soapReplyHeader $soapReplyHeaderList ## ## Validate that the input and output uses are the same ## set inUse $use set outUse $use catch {set inUse [[$oper selectNodes w:input/d:body] getAttribute use]} catch {set outUse [[$oper selectNodes w:output/d:body] getAttribute use]} foreach tmp [list $inUse $outUse] { if {$tmp ne $use} { ................................................................................ } if {![dict exists $serviceInfo object $objectName operation $operationName]} { return \ -code error \ -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \ "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'" } ## ## build call query ## if {$location ne {}} { set url $location } else { set url [dict get $serviceInfo object $objectName location] } SaveAndSetOptions $serviceName if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} { ................................................................................ return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } ## ## do http call ## if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ::log::log [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] } ................................................................................ "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'" } if {$location ne {}} { set url $location } else { set url [dict get $serviceInfo object $objectName location] } ## ## build call query ## SaveAndSetOptions $serviceName if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} { RestoreSavedOptions $serviceName return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err } RestoreSavedOptions $serviceName ## ## Do http call ## if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { ................................................................................ } set serviceInfo $serviceArr($serviceName) set outTransform [dict get $serviceInfo outTransform] if {$outTransform ne {}} { set inXML [$outTransform $serviceName $operationName REPLY $inXML] } set expectedMsgType [dict get $serviceInfo object $objectName operation $operationName outputs] # save parsed xml handle in variable doc dom parse $inXML doc # save top node handle in variable top $doc documentElement top set xns {} foreach tmp [dict get $serviceInfo targetNamespace] { lappend xns $tmp } ::log::log debug "Using namespaces {$xns}" set body $top |
Changes to Utilities.tcl.
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
....
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
|
# Description : fetch via http following redirects. # May not be used as asynchronous call with -command option. # # Arguments : # url - target document url # args - additional argument list to http::geturl call # # Returns : nothing # # Side-Effects : Save final url in redirectArray to forward info to # procedure "processImport". # # Exception Conditions : None # # Pre-requisite Conditions : None ................................................................................ if {[lindex $args 0] eq "-bodyalwaysok"} { set bodyAlwaysOk [lindex $args 1] set args [lrange $args 2 end] } set token [eval ::WS::Utils::geturl_followRedirects $args] ::http::wait $token if {[string equal [::http::status $token] ok]} { if {[::http::size $token] == 0} { ::log::log debug "\tHTTP error: no data" ::http::cleanup $token return -errorcode [list WS CLIENT NODATA [lindex $args 0]]\ -code error "HTTP failure socket closed" } if {![string equal $codeVar ""]} { upvar 1 $codeVar ncode } set ncode [::http::ncode $token] set body [::http::data $token] ::http::cleanup $token if {$bodyAlwaysOk && ![string equal $body ""] || -1 != [lsearch $codeOkList $ncode] |
|
|
|
|
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
....
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
|
# Description : fetch via http following redirects. # May not be used as asynchronous call with -command option. # # Arguments : # url - target document url # args - additional argument list to http::geturl call # # Returns : http package token of received data # # Side-Effects : Save final url in redirectArray to forward info to # procedure "processImport". # # Exception Conditions : None # # Pre-requisite Conditions : None ................................................................................ if {[lindex $args 0] eq "-bodyalwaysok"} { set bodyAlwaysOk [lindex $args 1] set args [lrange $args 2 end] } set token [eval ::WS::Utils::geturl_followRedirects $args] ::http::wait $token if {[::http::status $token] eq {ok}} { if {[::http::size $token] == 0} { ::log::log debug "\tHTTP error: no data" ::http::cleanup $token return -errorcode [list WS CLIENT NODATA [lindex $args 0]]\ -code error "HTTP failure socket closed" } if {$codeVar ne ""} { upvar 1 $codeVar ncode } set ncode [::http::ncode $token] set body [::http::data $token] ::http::cleanup $token if {$bodyAlwaysOk && ![string equal $body ""] || -1 != [lsearch $codeOkList $ncode] |