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 | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
6e84da168040e26b892624f6f72c9deb |
| User & Date: | oehhar 2017-08-31 09:05:13 |
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
Changes to ClientSide.tcl.
43 43 package require Tcl 8.4 44 44 package require WS::Utils 2.4 ; # dict, lassign 45 45 package require tdom 0.8 46 46 package require http 2 47 47 package require log 48 48 package require uri 49 49 50 -package provide WS::Client 2.4.1 50 +package provide WS::Client 2.4.2 51 51 52 52 namespace eval ::WS::Client { 53 53 # register https only if not yet registered 54 54 if {[catch { http::unregister https } lPortCmd]} { 55 55 # not registered -> register on my own 56 56 if {[catch { 57 57 package require tls ................................................................................ 1917 1917 # Maintenance History - as this file is modified, please be sure that you 1918 1918 # update this segment of the file header block by 1919 1919 # adding a complete entry at the bottom of the list. 1920 1920 # 1921 1921 # Version Date Programmer Comments / Changes / Reasons 1922 1922 # ------- ---------- ---------- ------------------------------------------- 1923 1923 # 1 07/06/2006 G.Lester Initial version 1924 +# 2.4.2 2017-08-31 H.Oehlmann The response node name may also be the 1925 +# output name and not only the output type. 1926 +# (ticket [21f41e22bc]). 1924 1927 # 1925 1928 # 1926 1929 ########################################################################### 1927 1930 proc ::WS::Client::parseResults {serviceName operationName inXML} { 1928 1931 variable serviceArr 1929 1932 1930 1933 ::log::log debug "In parseResults $serviceName $operationName {$inXML}" ................................................................................ 2008 2011 -errorcode [list WS CLIENT REMERR $faultcode] \ 2009 2012 -errorinfo $detail \ 2010 2013 $faultstring 2011 2014 } 2012 2015 2013 2016 ## 2014 2017 ## Validated that it is the expected packet type 2018 + ## The outputsname is also verified (see ticket [21f41e22bc]) 2015 2019 ## 2016 - if {$rootName ne $expectedMsgTypeBase} { 2020 + if {$rootName ne $expectedMsgTypeBase 2021 + && $rootName ne [dict get $serviceInfo operation $operationName outputsname]} { 2017 2022 $doc delete 2018 2023 return \ 2019 2024 -code error \ 2020 2025 -errorcode [list WS CLIENT BADREPLY [list $rootName $expectedMsgTypeBase]] \ 2021 - "Bad reply type, received '$rootName; but expected '$expectedMsgTypeBase'." 2026 + "Bad reply type, received '$rootName'; but expected '$expectedMsgTypeBase'." 2022 2027 } 2023 2028 2024 2029 ## 2025 2030 ## Convert the packet to a dictionary 2026 2031 ## 2027 2032 set results {} 2028 2033 set headerRootNode [$top selectNodes ENV:Header] ................................................................................ 2662 2667 # Maintenance History - as this file is modified, please be sure that you 2663 2668 # update this segment of the file header block by 2664 2669 # adding a complete entry at the bottom of the list. 2665 2670 # 2666 2671 # Version Date Programmer Comments / Changes / Reasons 2667 2672 # ------- ---------- ---------- ------------------------------------------- 2668 2673 # 1 08/06/2006 G.Lester Initial version 2674 +# 2.4.2 2017-08-31 H.Oehlmann Also set serviceArr operation members 2675 +# inputsName and outputsName. 2669 2676 # 2670 2677 # 2671 2678 ########################################################################### 2672 2679 proc ::WS::Client::parseBinding {wsdlNode serviceName bindingName serviceInfoVar} { 2673 2680 ::log:::log debug "Entering [info level 0]" 2674 2681 upvar 1 $serviceInfoVar serviceInfo 2675 2682 variable options ................................................................................ 2752 2759 ## 2753 2760 ## Clone it 2754 2761 ## 2755 2762 dict set serviceInfo operation $baseName cloned 1 2756 2763 dict lappend serviceInfo operList $newName 2757 2764 dict set serviceInfo operation $newName [dict get $serviceInfo operation $operName] 2758 2765 } 2759 - set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style] 2760 - set operName ${operName}_[lindex [split [lindex $typeList 0] {:}] end] 2766 + # typNameList contains inType inName outType outName 2767 + set typeNameList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style] 2768 + set operName ${operName}_[lindex [split [lindex $typeNameList 0] {:}] end] 2761 2769 set cloneList [dict get $serviceInfo operation $baseName cloneList] 2762 2770 lappend cloneList $operName 2763 2771 dict set serviceInfo operation $baseName cloneList $cloneList 2764 2772 dict set serviceInfo operation $operName isClone 1 2765 2773 } else { 2766 - set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style] 2774 + set typeNameList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style] 2767 2775 dict set serviceInfo operation $operName isClone 0 2768 2776 } 2769 2777 2770 2778 #puts "Processing operation $operName" 2771 2779 set actionNode [$oper selectNodes d:operation] 2772 2780 if {$actionNode eq {}} { 2773 2781 ::log:::log debug "Skiping operation with no action [$oper asXML]" ................................................................................ 2848 2856 ::log:::log debug "Leaving [lindex [info level 0] 0] with error @5" 2849 2857 return \ 2850 2858 -code error \ 2851 2859 -errorcode [list WS CLIENT MIXUSE $use $tmp] \ 2852 2860 "Mixed usageage not supported!'" 2853 2861 } 2854 2862 } 2855 - #set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style] 2856 - ::log:::log debug "\t Messages are {$typeList}" 2857 - foreach type $typeList mode {inputs outputs} { 2863 + ::log:::log debug "\t Input/Output types and names are {$typeNameList}" 2864 + foreach {type name} $typeNameList mode {inputs outputs} { 2858 2865 dict set serviceInfo operation $operName $mode $type 2866 + # also set outputsname which is used to match it as alternate response node name 2867 + dict set serviceInfo operation $operName ${mode}name $name 2859 2868 } 2860 2869 set inMessage [dict get $serviceInfo operation $operName inputs] 2861 2870 if {[dict exists $serviceInfo inputMessages $inMessage] } { 2862 2871 set operList [dict get $serviceInfo inputMessages $inMessage] 2863 2872 } else { 2864 2873 set operList {} 2865 2874 } ................................................................................ 2919 2928 # Maintenance History - as this file is modified, please be sure that you 2920 2929 # update this segment of the file header block by 2921 2930 # adding a complete entry at the bottom of the list. 2922 2931 # 2923 2932 # Version Date Programmer Comments / Changes / Reasons 2924 2933 # ------- ---------- ---------- ------------------------------------------- 2925 2934 # 1 08/06/2006 G.Lester Initial version 2935 +# 2.4.1 2017-08-31 H.Oehlmann Extend return by names to verify this 2936 +# as return output node name. 2926 2937 # 2927 2938 # 2928 2939 ########################################################################### 2929 2940 proc ::WS::Client::getTypesForPort {wsdlNode serviceName operName portName inName serviceInfoVar style} { 2930 2941 ::log:::log debug "Enteringing [info level 0]" 2931 2942 upvar 1 $serviceInfoVar serviceInfo 2932 2943 ................................................................................ 2946 2957 set operNode [$wsdlNode selectNodes $operQuery] 2947 2958 if {$operNode eq {} && $inName ne {}} { 2948 2959 set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \ 2949 2960 $portName $operName] 2950 2961 ::log:::log debug "\t operNode query is {$operQuery}" 2951 2962 set operNode [$wsdlNode selectNodes $operQuery] 2952 2963 } 2953 - 2954 - set inputMsgNode [$operNode selectNodes {w:input}] 2955 - if {$inputMsgNode ne {}} { 2956 - set inputMsgPath [$inputMsgNode getAttribute message] 2957 - set inputMsg [lindex [split $inputMsgPath {:}] end] 2958 - set inType [messageToType $wsdlNode $serviceName $operName $inputMsg serviceInfo $style] 2959 - } 2960 - 2961 - set outputMsgNode [$operNode selectNodes {w:output}] 2962 - if {$outputMsgNode ne {}} { 2963 - set outputMsgPath [$outputMsgNode getAttribute message] 2964 - set outputMsg [lindex [split $outputMsgPath {:}] end] 2965 - set outType [messageToType $wsdlNode $serviceName $operName $outputMsg serviceInfo $style] 2964 + 2965 + set resList {} 2966 + foreach sel {w:input w:output} { 2967 + set nodeList [$operNode selectNodes $sel] 2968 + if {1 == [llength $nodeList]} { 2969 + set nodeCur [lindex $nodeList 0] 2970 + set msgPath [$nodeCur getAttribute message] 2971 + set msgCur [lindex [split $msgPath {:}] end] 2972 + # Append type 2973 + lappend resList [messageToType $wsdlNode $serviceName $operName $msgCur serviceInfo $style] 2974 + # Append name 2975 + if {[$nodeCur hasAttribute name]} { 2976 + lappend resList [$nodeCur getAttribute name] 2977 + } else { 2978 + lappend resList {} 2979 + } 2980 + } 2966 2981 } 2967 2982 2968 2983 ## 2969 2984 ## Return the types 2970 2985 ## 2971 - ::log:::log debug "Leaving [lindex [info level 0] 0] with [list $inType $outType]" 2972 - return [list $inType $outType] 2986 + ::log:::log debug "Leaving [lindex [info level 0] 0] with $resList" 2987 + return $resList 2973 2988 } 2974 2989 2975 2990 ########################################################################### 2976 2991 # 2977 2992 # Private Procedure Header - as this procedure is modified, please be sure 2978 2993 # that you update this header block. Thanks. 2979 2994 #
Changes to pkgIndex.tcl.
6 6 # information so that packages will be loaded automatically 7 7 # in response to "package require" commands. When this 8 8 # script is sourced, the variable $dir must contain the 9 9 # full path name of this file's directory. 10 10 11 11 package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]] 12 12 package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]] 13 -package ifneeded WS::Client 2.4.1 [list source [file join $dir ClientSide.tcl]] 13 +package ifneeded WS::Client 2.4.2 [list source [file join $dir ClientSide.tcl]] 14 14 package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]] 15 15 package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]] 16 16 package ifneeded WS::Utils 2.4.0 [list source [file join $dir Utilities.tcl]] 17 17 package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]] 18 18 package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]