Web Services for Tcl (aka tclws): Check-in [170d9d7c59]

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 \| SQL archive
Timelines:	family \| ancestors \| descendants \| both \| trunk
Files:	files \| file ages \| folders
SHA3-256:	170d9d7c591f1ce1fc38e8813587ec60848b87cde2cd49c63d9352f9de41e8db
User & Date:	oehhar 2017-11-03 11:19:46

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

Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

###############################################################################
##                                                                           ##
##  Copyright (c) 2016, 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                                      ##
................................................................................
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.2

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
................................................................................
    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

................................................................................
#
# 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 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 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"
    }
    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]
        if {$rootName eq {}} {

            set rootName [$rootNode nodeName]


        }
    } else {





        set rootName {}




    }
    ::log::log debug "root name is {$rootName}"

    ##
    ## See if it is a standard error packet
    ##
    if {$rootName eq {Fault}} {
        set faultcode {}
        set faultstring {}
................................................................................
        return \
            -code error \
            -errorcode [list WS CLIENT REMERR $faultcode] \
            -errorinfo $detail \
            $faultstring
    }

    ##
    ## Validated that it is the expected packet type
    ## The outputsname is also verified (see ticket [21f41e22bc])
    ##
    if {$rootName ne $expectedMsgTypeBase
            && $rootName ne [dict get $serviceInfo operation $operationName outputsname]} {
        $doc delete
        return \
            -code error \
            -errorcode [list WS CLIENT BADREPLY [list $rootName $expectedMsgTypeBase]] \
            "Bad reply type, received '$rootName'; but expected '$expectedMsgTypeBase'."
    }

    ##
    ## 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] {
................................................................................

    ::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"
................................................................................
#                       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

................................................................................
        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} {
        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 {


                lappend resList {}
            }
        }
    }

    ##
    ## Return the types
    ##


|







 







|







 







>







 







>
>







 







|

|







 







<
>
|
<
>
|
|
|
<
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
|
<
<
|
>
|
>
>

<
>
>
>
>
>
|
>
>
>
>

<







 







<
<
<
<
<
<
<
<
<
<
<
<
<







 







>







 







>
>
>







 







|











>
>
|

###############################################################################
##                                                                           ##
##  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                                      ##
................................................................................
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
................................................................................
    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

................................................................................
#
# 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 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] {
................................................................................
    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 {}
................................................................................
        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] {
................................................................................

    ::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"
................................................................................
#                       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

................................................................................
        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.

# 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.2 [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]]







|





>

# 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]]