Check-in [ecbb5e058a]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Preliminary hacks working towards custom SOAP headers. Ticket [7c2ae385da]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | soap-header
Files: files | file ages | folders
SHA3-256: ecbb5e058a424deb180cc7c2ce250249ec6d32f38242d709c1832204f0b88b6f
User & Date: andy 2018-07-24 04:47:45
Original Comment: Preliminary hacks working towards custom SOAP headers
References
2018-09-03 18:01 New ticket [7c2ae385da] Use XSD file. artifact: c9995ace97 user: oehhar
Context
2018-07-24 04:47
Preliminary hacks working towards custom SOAP headers. Ticket [7c2ae385da] Leaf check-in: ecbb5e058a user: andy tags: soap-header
2018-07-24 02:47
Remove extra colon in namespace delimiter check-in: 01f9053e79 user: andy tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

   147    147           suppressNS
   148    148           useTypeNs
   149    149           nsOnChangeOnly
   150    150       }
   151    151   }
   152    152   
   153    153   
          154  +
          155  +# BEGIN Andy Goth hacks -------------------------------------------------------
          156  +
          157  +if {0} {
          158  +    package require log
          159  +    package require WS::Client
          160  +    #log::lvSuppress debug 0
          161  +    WS::Client::GetAndParseWsdl https://coverity.labs.quest.com/ws/v9/configurationservice?wsdl
          162  +    WS::Client::GetAndAddXsdTypes ConfigurationServiceService http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd 
          163  +    WS::Client::AddInputHeader ConfigurationServiceService getVersion wsse:Security {
          164  +        wsse:UsernameToken {wsse:Username foo wsse:Password bar}
          165  +    }
          166  +}
          167  +
          168  +proc ::WS::Client::GetAndAddXsdTypes {serviceName url {headers {}}} {
          169  +    switch -- [dict get [::uri::split $url] scheme] {
          170  +    file {
          171  +        upvar #0 [::uri::geturl $url] token
          172  +        set xsd $token(data)
          173  +        unset token
          174  +    } http - https {
          175  +        if {[llength $headers]} {
          176  +            set xsd [::WS::Utils::geturl_fetchbody $url -headers $headers]
          177  +        } else {
          178  +            set xsd [::WS::Utils::geturl_fetchbody $url]
          179  +        }
          180  +        # HACK?? convert from UTF-8? shouldn't this have already been handled?
          181  +        set xsd [encoding convertfrom utf-8 $xsd]
          182  +    } default {
          183  +        return \
          184  +            -code error \
          185  +            -errorcode [list WS CLIENT UNKURLTYP $url] \
          186  +            "Unknown URL type '$url'"
          187  +    }}
          188  +
          189  +    AddXsdTypes $serviceName $xsd $url
          190  +}
          191  +
          192  +proc ::WS::Client::AddXsdTypes {serviceName xsd baseUrl} {
          193  +    variable serviceArr
          194  +
          195  +    dom parse $xsd doc
          196  +    $doc documentElement node
          197  +    set tnsCount [llength [dict keys\
          198  +            [dict get $serviceArr($serviceName) tnsList url]]]
          199  +    ::WS::Utils::parseScheme Client $baseUrl $node $serviceName\
          200  +            serviceArr($serviceName) tnsCount
          201  +    $doc delete
          202  +}
          203  +
          204  +# END Andy Goth hacks ---------------------------------------------------------
          205  +
   154    206   ###########################################################################
   155    207   #
   156    208   # Public Procedure Header - as this procedure is modified, please be sure
   157    209   #                           that you update this header block. Thanks.
   158    210   #
   159    211   #>>BEGIN PUBLIC<<
   160    212   #

Changes to Utilities.tcl.

  2819   2819       upvar 1 $serviceInfoVar serviceInfo
  2820   2820       variable currentSchema
  2821   2821       variable nsList
  2822   2822       variable options
  2823   2823       variable unknownRef
  2824   2824   
  2825   2825       set currentSchema $schemaNode
  2826         -    set tmpTargetNs $::WS::Utils::targetNs
         2826  +    if {[info exists ::WS::Utils::targetNs]} {
         2827  +        set tmpTargetNs $::WS::Utils::targetNs
         2828  +    }
  2827   2829       foreach attr [$schemaNode attributes] {
  2828   2830           set value {?}
  2829   2831           catch {set value [$schemaNode getAttribute $attr]}
  2830   2832           ::log::logsubst debug {Attribute $attr = $value}
  2831   2833       }
  2832   2834       if {[$schemaNode hasAttribute targetNamespace]} {
  2833   2835           set xns [$schemaNode getAttribute targetNamespace]
................................................................................
  2950   2952           }
  2951   2953       }
  2952   2954   
  2953   2955       if {$lastUnknownRefCount} {
  2954   2956           switch -exact -- $options(StrictMode) {
  2955   2957               debug -
  2956   2958               warning {
  2957         -                set ::WS::Utils::targetNs $tmpTargetNs
         2959  +                if {[info exists tmpTargetNs]} {
         2960  +                    set ::WS::Utils::targetNs $tmpTargetNs
         2961  +                } else {
         2962  +                    unset -nocomplain ::WS::Utils::targetNs
         2963  +                }
  2958   2964                   ::log::logsubst $options(StrictMode) {Found $lastUnknownRefCount forward type references: [join [array names unknownRef] {,}]}
  2959   2965               }
  2960   2966               error -
  2961   2967               default {
  2962         -                set ::WS::Utils::targetNs $tmpTargetNs
         2968  +                if {[info exists tmpTargetNs]} {
         2969  +                    set ::WS::Utils::targetNs $tmpTargetNs
         2970  +                } else {
         2971  +                    unset -nocomplain ::WS::Utils::targetNs
         2972  +                }
  2963   2973                   return \
  2964   2974                       -code error \
  2965   2975                       -errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
  2966   2976                       "Found $lastUnknownRefCount forward type references: [join [array names unknownRef] {,}]"
  2967   2977               }
  2968   2978           }
  2969   2979       }
................................................................................
  2990   3000                       set errorCode $::errorCode
  2991   3001                       set errorInfo $::errorInfo
  2992   3002                       ::log::logsubst error {Could not parse:\n [$element asXML]}
  2993   3003                       ::log::logsubst error {\t error was: $msg}
  2994   3004                       ::log::logsubst error {\t error info: $errorInfo}
  2995   3005                       ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
  2996   3006                       ::log::logsubst error {\t error code: $errorCode}
  2997         -                    set ::WS::Utils::targetNs $tmpTargetNs
         3007  +                    if {[info exists tmpTargetNs]} {
         3008  +                        set ::WS::Utils::targetNs $tmpTargetNs
         3009  +                    } else {
         3010  +                        unset -nocomplain ::WS::Utils::targetNs
         3011  +                    }
  2998   3012                       return \
  2999   3013                           -code error \
  3000   3014                           -errorcode $errorCode \
  3001   3015                           -errorinfo $errorInfo \
  3002   3016                           $msg
  3003   3017                   }
  3004   3018               }
................................................................................
  3021   3035                       set errorInfo $::errorInfo
  3022   3036                       ::log::logsubst error {Could not parse:\n [$element asXML]}
  3023   3037                       ::log::logsubst error {\t error was: $msg}
  3024   3038                       ::log::logsubst error {\t error info: $errorInfo}
  3025   3039                       ::log::logsubst error {\t last element: $::elementName}
  3026   3040                       ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
  3027   3041                       ::log::logsubst error {\t error code: $errorCode}
  3028         -                    set ::WS::Utils::targetNs $tmpTargetNs
         3042  +                    if {[info exists tmpTargetNs]} {
         3043  +                        set ::WS::Utils::targetNs $tmpTargetNs
         3044  +                    } else {
         3045  +                        unset -nocomplain ::WS::Utils::targetNs
         3046  +                    }
  3029   3047                       return \
  3030   3048                           -code error \
  3031   3049                           -errorcode $errorCode \
  3032   3050                           -errorinfo $errorInfo \
  3033   3051                           $msg
  3034   3052                   }
  3035   3053               }
................................................................................
  3052   3070                       set errorInfo $::errorInfo
  3053   3071                       ::log::logsubst error {Could not parse:\n [$element asXML]}
  3054   3072                       ::log::logsubst error {\t error was: $msg}
  3055   3073                       ::log::logsubst error {\t error info: $errorInfo}
  3056   3074                       ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
  3057   3075                       ::log::logsubst error {\t error code: $errorCode}
  3058   3076                       ::log::logsubst error {\t last element: $::elementName}
  3059         -                    set ::WS::Utils::targetNs $tmpTargetNs
         3077  +                    if {[info exists tmpTargetNs]} {
         3078  +                        set ::WS::Utils::targetNs $tmpTargetNs
         3079  +                    } else {
         3080  +                        unset -nocomplain ::WS::Utils::targetNs
         3081  +                    }
  3060   3082                       return \
  3061   3083                           -code error \
  3062   3084                           -errorcode $errorCode \
  3063   3085                           -errorinfo $errorInfo \
  3064   3086                           $msg
  3065   3087                   }
  3066   3088               }
................................................................................
  3082   3104                       set errorCode $::errorCode
  3083   3105                       set errorInfo $::errorInfo
  3084   3106                       ::log::logsubst error {Could not parse:\n [$element asXML]}
  3085   3107                       ::log::logsubst error {\t error was: $msg}
  3086   3108                       ::log::logsubst error {\t error info: $errorInfo}
  3087   3109                       ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
  3088   3110                       ::log::logsubst error {\t error code: $errorCode}
  3089         -                    set ::WS::Utils::targetNs $tmpTargetNs
         3111  +                    if {[info exists tmpTargetNs]} {
         3112  +                        set ::WS::Utils::targetNs $tmpTargetNs
         3113  +                    } else {
         3114  +                        unset -nocomplain ::WS::Utils::targetNs
         3115  +                    }
  3090   3116                       return \
  3091   3117                           -code error \
  3092   3118                           -errorcode $errorCode \
  3093   3119                           -errorinfo $errorInfo \
  3094   3120                           $msg
  3095   3121                   }
  3096   3122               }
................................................................................
  3112   3138                       set errorCode $::errorCode
  3113   3139                       set errorInfo $::errorInfo
  3114   3140                       ::log::logsubst error {Could not parse:\n [$element asXML]}
  3115   3141                       ::log::logsubst error {\t error was: $msg}
  3116   3142                       ::log::logsubst error {\t error info: $errorInfo}
  3117   3143                       ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
  3118   3144                       ::log::logsubst error {\t error code: $errorCode}
  3119         -                    set ::WS::Utils::targetNs $tmpTargetNs
         3145  +                    if {[info exists tmpTargetNs]} {
         3146  +                        set ::WS::Utils::targetNs $tmpTargetNs
         3147  +                    } else {
         3148  +                        unset -nocomplain ::WS::Utils::targetNs
         3149  +                    }
  3120   3150                       return \
  3121   3151                           -code error \
  3122   3152                           -errorcode $errorCode \
  3123   3153                           -errorinfo $errorInfo \
  3124   3154                           $msg
  3125   3155                   }
  3126   3156               }
  3127   3157           }
  3128   3158       }
  3129   3159   
  3130         -    set ::WS::Utils::targetNs $tmpTargetNs
         3160  +    if {[info exists tmpTargetNs]} {
         3161  +        set ::WS::Utils::targetNs $tmpTargetNs
         3162  +    } else {
         3163  +        unset -nocomplain ::WS::Utils::targetNs
         3164  +    }
  3131   3165       ::log::logsubst debug {Leaving :WS::Utils::parseScheme $mode $baseUrl $schemaNode $serviceName $serviceInfoVar $tnsCountVar}
  3132   3166       ::log::logsubst debug {Target NS is now: $::WS::Utils::targetNs}
  3133   3167       dict set serviceInfo tnsList tns $prevTnsDict
  3134   3168   }
  3135   3169   
  3136   3170   ###########################################################################
  3137   3171   #