Check-in [6e84da1680]
Not logged in
Home Documentation Downloads Timeline Files Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:The response node name may also be the output name and not only the output type [21f41e22bc]
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 6e84da168040e26b892624f6f72c9deb172d414a
User & Date: oehhar 2017-08-31 09:05:13.161
References
2017-08-31 09:07 • Closed ticket [21f41e22bc]: "Bad reply type" when calling a service plus 2 other changes artifact: ba565753f9 user: oehhar
Context
2017-08-31 09:10
Documented wrong version check-in: 3b9fcbf29a user: oehhar tags: trunk
2017-08-31 09:05
The response node name may also be the output name and not only the output type [21f41e22bc] check-in: 6e84da1680 user: oehhar tags: trunk
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
Changes
Side-by-Side Diff Ignore Whitespace Patch
Changes to ClientSide.tcl.
︙
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57

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.1
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
︙
1917
1918
1919
1920
1921
1922
1923



1924
1925
1926
1927
1928
1929
1930

1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933








+
+
+








# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# 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}"
︙
2008
2009
2010
2011
2012
2013
2014

2015
2016


2017
2018
2019
2020
2021

2022
2023
2024
2025
2026
2027
2028

2011
2012
2013
2014
2015
2016
2017
2018
2019

2020
2021
2022
2023
2024
2025

2026
2027
2028
2029
2030
2031
2032
2033








+

-
+
+




-
+








            -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} {
    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'."
            "Bad reply type, received '$rootName'; but expected '$expectedMsgTypeBase'."
    }

    ##
    ## Convert the packet to a dictionary
    ##
    set results {}
    set headerRootNode [$top selectNodes ENV:Header]
︙
2662
2663
2664
2665
2666
2667
2668


2669
2670
2671
2672
2673
2674
2675

2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682








+
+








# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       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   Also set serviceArr operation members
#                                   inputsName and outputsName.
#
#
###########################################################################
proc ::WS::Client::parseBinding {wsdlNode serviceName bindingName serviceInfoVar} {
    ::log:::log debug "Entering [info level 0]"
    upvar 1 $serviceInfoVar serviceInfo
    variable options
︙
2752
2753
2754
2755
2756
2757
2758

2759
2760


2761
2762
2763
2764
2765
2766

2767
2768
2769
2770
2771
2772
2773

2759
2760
2761
2762
2763
2764
2765
2766


2767
2768
2769
2770
2771
2772
2773

2774
2775
2776
2777
2778
2779
2780
2781








+
-
-
+
+





-
+








                    ##
                    ## Clone it
                    ##
                    dict set serviceInfo operation $baseName cloned 1
                    dict lappend serviceInfo operList $newName
                    dict set serviceInfo operation $newName [dict get $serviceInfo operation $operName]
                }
                # typNameList contains inType inName outType outName
                set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
                set operName ${operName}_[lindex [split [lindex $typeList 0] {:}] end]
                set typeNameList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
                set operName ${operName}_[lindex [split [lindex $typeNameList 0] {:}] end]
                set cloneList [dict get $serviceInfo operation $baseName cloneList]
                lappend cloneList $operName
                dict set serviceInfo operation $baseName cloneList $cloneList
                dict set serviceInfo operation $operName isClone 1
            } else {
                set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
                set typeNameList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
                dict set serviceInfo operation $operName isClone 0
            }

            #puts "Processing operation $operName"
            set actionNode [$oper selectNodes d:operation]
            if {$actionNode eq {}} {
                ::log:::log debug "Skiping operation with no action [$oper asXML]"
︙
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857


2858


2859
2860
2861
2862
2863
2864
2865

2856
2857
2858
2859
2860
2861
2862



2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874








-
-
-
+
+

+
+








                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @5"
                    return \
                        -code error \
                        -errorcode [list WS CLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
            }
            #set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
            ::log:::log debug "\t Messages are {$typeList}"
            foreach type $typeList mode {inputs outputs} {
            ::log:::log debug "\t Input/Output types and names are {$typeNameList}"
            foreach {type name} $typeNameList mode {inputs outputs} {
                dict set serviceInfo operation $operName $mode $type
                # also set outputsname which is used to match it as alternate response node name
                dict set serviceInfo operation $operName ${mode}name $name
            }
            set inMessage [dict get $serviceInfo operation $operName inputs]
            if {[dict exists $serviceInfo inputMessages $inMessage] } {
                set operList [dict get $serviceInfo inputMessages $inMessage]
            } else {
                set operList {}
            }
︙
2919
2920
2921
2922
2923
2924
2925


2926
2927
2928
2929
2930
2931
2932

2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943








+
+








# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       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.1    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
︙
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960

















2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972


2973
2974
2975
2976
2977
2978
2979

2957
2958
2959
2960
2961
2962
2963








2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980





2981
2982
2983
2984
2985


2986
2987
2988
2989
2990
2991
2992
2993
2994








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-





-
-
+
+








    set operNode [$wsdlNode selectNodes $operQuery]
    if {$operNode eq {} && $inName ne {}} {
        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 inputMsgNode [$operNode selectNodes {w:input}]
    if {$inputMsgNode ne {}} {
        set inputMsgPath [$inputMsgNode getAttribute message]
        set inputMsg [lindex [split $inputMsgPath {:}] end]
        set inType [messageToType $wsdlNode $serviceName $operName $inputMsg serviceInfo $style]
    }

    
    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 {}
            }
        }
    set outputMsgNode [$operNode selectNodes {w:output}]
    if {$outputMsgNode ne {}} {
        set outputMsgPath [$outputMsgNode getAttribute message]
        set outputMsg [lindex [split $outputMsgPath {:}] end]
        set outType [messageToType $wsdlNode $serviceName $operName $outputMsg serviceInfo $style]
    }

    ##
    ## Return the types
    ##
    ::log:::log debug "Leaving [lindex [info level 0] 0] with [list $inType $outType]"
    return [list $inType $outType]
    ::log:::log debug "Leaving [lindex [info level 0] 0] with $resList"
    return $resList
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
︙
Changes to pkgIndex.tcl. 
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18













-
+






# 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.1 [list source [file join $dir ClientSide.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]]
Fossil 2.26 [1205ec86cb] 2025-04-30 16:57:32