Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | WSCall: also extend the output node name search to multiple message root nodes in the response Ticket [21f41e22bc] |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
170d9d7c591f1ce1fc38e8813587ec60 |
User & Date: | oehhar 2017-11-03 11:19:46.976 |
Context
2017-11-03 15:11 | Add some documentation (for me) on WSDL parsing namespaces in client mode check-in: f8d98804f8 user: oehhar tags: trunk | |
2017-11-03 11:19 | WSCall: also extend the output node name search to multiple message root nodes in the response Ticket [21f41e22bc] check-in: 170d9d7c59 user: oehhar tags: trunk | |
2017-08-31 09:14 | Documented name return check-in: 7677c62986 user: oehhar tags: trunk | |
Changes
Changes to ClientSide.tcl.
1 2 | ############################################################################### ## ## | | | 1 2 3 4 5 6 7 8 9 10 | ############################################################################### ## ## ## Copyright (c) 2016-2017, Harald Oehlmann ## ## Copyright (c) 2006-2013, Gerald W. Lester ## ## Copyright (c) 2008, Georgios Petasis ## ## Copyright (c) 2006, Visiprise Software, Inc ## ## Copyright (c) 2006, Arnulf Wiedemann ## ## Copyright (c) 2006, Colin McCormack ## ## Copyright (c) 2006, Rolf Ade ## ## Copyright (c) 2001-2006, Pat Thoyts ## |
︙ | ︙ | |||
43 44 45 46 47 48 49 | 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 | | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | 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.3 namespace eval ::WS::Client { # register https only if not yet registered if {[catch { http::unregister https } lPortCmd]} { # not registered -> register on my own if {[catch { package require tls |
︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 | if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } ## ## Do the http request ## # This will directly return with correct error if {[llength $headers]} { set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar httpCode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar httpCode $url -query $query -type [dict get $serviceInfo contentType] ] } # numerical http code was saved in variable httpCode | > | 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 | if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } ## ## Do the http request ## # This will directly return with correct error # side effect: sets the variable httpCode if {[llength $headers]} { set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar httpCode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar httpCode $url -query $query -type [dict get $serviceInfo contentType] ] } # numerical http code was saved in variable httpCode |
︙ | ︙ | |||
1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 | # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # 2.4.2 2017-08-31 H.Oehlmann The response node name may also be the # output name and not only the output type. # (ticket [21f41e22bc]). # # ########################################################################### proc ::WS::Client::parseResults {serviceName operationName inXML} { variable serviceArr ::log::log debug "In parseResults $serviceName $operationName {$inXML}" set serviceInfo $serviceArr($serviceName) 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] } | > > | | > > > > | > > > > | < | > > | > > > > > > > > > > > > > | | > > > | > > > | | < > > > > > > > > | | < > | > | | | > | | > > | | > > > > > > > > > > | 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 | # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # 2.4.2 2017-08-31 H.Oehlmann The response node name may also be the # output name and not only the output type. # (ticket [21f41e22bc]). # 2.4.3 2017-11-03 H.Oehlmann Extended upper commit also to search # for multiple child nodes. # # ########################################################################### proc ::WS::Client::parseResults {serviceName operationName inXML} { variable serviceArr ::log::log debug "In parseResults $serviceName $operationName {$inXML}" set serviceInfo $serviceArr($serviceName) 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 and free it when out of scope dom parse $inXML doc # save top node handle in variable top and free it if out of scope $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] { lappend xns $tmp } ::log::log debug "Using namespaces {$xns}" $doc selectNodesNamespaces $xns set body [$top selectNodes ENV:Body] if {![llength $body]} { return \ -code error \ -errorcode [list WS CLIENT BADREPLY $inXML] \ "Bad reply type, no SOAP envelope received in: \n$inXML" } ## ## Find the reply root node with the response. ## # <SOAP-ENV:Envelope...> # <SOAP-ENV:Body> # <i2:TestResponse id="ref-1" xmlns:i2=...> <-- this one # # WSDL 1.0: http://xml.coverpages.org/wsdl20000929.html # Chapter 2.4.2 (name optional) and 2.4.5 (default name) # The node name could be: # 1) an error node "Fault" # 2) equal to the WSDL name property of the output node # 3) if no name tag, equal to <Operation>Response # 4) the local output type name # # Possibility (2) "OutName" WSDL example: # <wsdl:portType...><wsdl:operation...> # <wsdl:output name="{OutName}" message="tns:{OutMsgName}" /> # This possibility is requested by ticket [21f41e22bc] # # Possibility (3) default name "{OperationName}Result" WSDL example: # <wsdl:portType...><wsdl:operation name="{OperationName}"> # <wsdl:output message="tns:{OutMsgName}" /> *** no name tag *** # # Possibility (4) was not found in wsdl 1.0 standard but was used as only # solution by TCLWS prior to 2.4.2. # The following sketch shows the location of the local output type name # "OutTypeName" in a WSDL file: # -> In WSDL portType output message name # <wsdl:portType...><wsdl:operation...> # <wsdl:output message="tns:{OutMsgName}" /> # -> then in message, use the element: # <wsdl:message name="{OutMsgName}"> # <wsdl:part name="..." element="tns:<{OutTypeName}>" /> # -> The element "OutTypeName" is also find in a type definition: # <wsdl:types> # <s:element name="{OutMsgName}"> # <s:complexType>... # # Build a list of possible names set nodeNameCandidateList [list Fault $expectedMsgTypeBase] # We check if the preparsed wsdl contains the name flag. # This is not the case, if it was parsed with tclws prior 2.4.2 # *** ToDo *** This security may be removed on a major release if {[dict exists $serviceInfo operation $operationName outputsname]} { lappend nodeNameCandidateList [dict get $serviceInfo operation $operationName outputsname] } set rootNodeList [$body childNodes] ::log::log debug "Have [llength $rootNodeList] node under Body" foreach rootNodeCur $rootNodeList { set rootNameCur [$rootNodeCur localName] if {$rootNameCur eq {}} { set rootNameCur [$rootNodeCur nodeName] } if {$rootNameCur in $nodeNameCandidateList} { set rootNode $rootNodeCur set rootName $rootNameCur ::log::log debug "Result root name is '$rootName'" break } ::log::log debug "Result root name '$rootNameCur' not in candidates '$nodeNameCandidateList'" } ## ## Exit if there is no such node ## if {![info exists rootName]} { return \ -code error \ -errorcode [list WS CLIENT BADREPLY [list $rootName $expectedMsgTypeBase]] \ "Bad reply type, received '$rootName'; but expected '$expectedMsgTypeBase'." } ## ## See if it is a standard error packet ## if {$rootName eq {Fault}} { set faultcode {} set faultstring {} |
︙ | ︙ | |||
2009 2010 2011 2012 2013 2014 2015 | return \ -code error \ -errorcode [list WS CLIENT REMERR $faultcode] \ -errorinfo $detail \ $faultstring } | < < < < < < < < < < < < < | 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 | return \ -code error \ -errorcode [list WS CLIENT REMERR $faultcode] \ -errorinfo $detail \ $faultstring } ## ## Convert the packet to a dictionary ## set results {} set headerRootNode [$top selectNodes ENV:Header] if {[llength $headerRootNode]} { foreach outHeaderType [dict get $serviceInfo operation $operationName soapReplyHeader] { |
︙ | ︙ | |||
2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 | ::log::log debug "Entering [info level 0]" set serviceInfo $serviceArr($serviceName) set msgType [dict get $serviceInfo operation $operationName inputs] set url [dict get $serviceInfo location] set xnsList [dict get $serviceInfo targetNamespace] dom createDocument "SOAP-ENV:Envelope" doc $doc documentElement env $env setAttribute \ "xmlns:SOAP-ENV" "http://schemas.xmlsoap.org/soap/envelope/" \ "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \ "xmlns:xsi" "http://www.w3.org/2001/XMLSchema-instance" \ "xmlns:xs" "http://www.w3.org/2001/XMLSchema" | > | 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 | ::log::log debug "Entering [info level 0]" set serviceInfo $serviceArr($serviceName) set msgType [dict get $serviceInfo operation $operationName inputs] set url [dict get $serviceInfo location] set xnsList [dict get $serviceInfo targetNamespace] # save the document in variable doc and free it if out of scope dom createDocument "SOAP-ENV:Envelope" doc $doc documentElement env $env setAttribute \ "xmlns:SOAP-ENV" "http://schemas.xmlsoap.org/soap/envelope/" \ "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \ "xmlns:xsi" "http://www.w3.org/2001/XMLSchema-instance" \ "xmlns:xs" "http://www.w3.org/2001/XMLSchema" |
︙ | ︙ | |||
2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 | # adding a complete entry at the bottom of the list. # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 08/06/2006 G.Lester Initial version # 2.4.2 2017-08-31 H.Oehlmann Extend return by names to verify this # as return output node name. # # ########################################################################### proc ::WS::Client::getTypesForPort {wsdlNode serviceName operName portName inName serviceInfoVar style} { ::log:::log debug "Enteringing [info level 0]" upvar 1 $serviceInfoVar serviceInfo | > > > | 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 | # adding a complete entry at the bottom of the list. # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 08/06/2006 G.Lester Initial version # 2.4.2 2017-08-31 H.Oehlmann Extend return by names to verify this # as return output node name. # 2.4.3 2017-11-03 H.Oehlmann If name is not given, set the default # name of <OP>Request/Response given by the # WSDL 1.0 standard. # # ########################################################################### proc ::WS::Client::getTypesForPort {wsdlNode serviceName operName portName inName serviceInfoVar style} { ::log:::log debug "Enteringing [info level 0]" upvar 1 $serviceInfoVar serviceInfo |
︙ | ︙ | |||
2959 2960 2961 2962 2963 2964 2965 | set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \ $portName $operName] ::log:::log debug "\t operNode query is {$operQuery}" set operNode [$wsdlNode selectNodes $operQuery] } set resList {} | | > > | | 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 | set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \ $portName $operName] ::log:::log debug "\t operNode query is {$operQuery}" set operNode [$wsdlNode selectNodes $operQuery] } set resList {} foreach sel {w:input w:output} defaultNameSuffix {Request Response} { set nodeList [$operNode selectNodes $sel] if {1 == [llength $nodeList]} { set nodeCur [lindex $nodeList 0] set msgPath [$nodeCur getAttribute message] set msgCur [lindex [split $msgPath {:}] end] # Append type lappend resList [messageToType $wsdlNode $serviceName $operName $msgCur serviceInfo $style] # Append name if {[$nodeCur hasAttribute name]} { lappend resList [$nodeCur getAttribute name] } else { # Build the default name according WSDL 1.0 as # <Operation>Request/Response lappend resList ${operName}$defaultNameSuffix } } } ## ## Return the types ## |
︙ | ︙ |
Changes to pkgIndex.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]] package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]] | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]] package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]] package ifneeded WS::Client 2.4.3 [list source [file join $dir ClientSide.tcl]] package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]] package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]] package ifneeded WS::Utils 2.4.0 [list source [file join $dir Utilities.tcl]] package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]] package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]] |