Check-in [178aaf8434]
Not logged in

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

Overview
Comment:Clean up end-of-line whitespace
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:178aaf8434c9aee629d6503dd33a065796b5ce701d1896cc06787ae1994271ec
User & Date: andy 2018-07-24 02:42:16
Context
2018-07-24 02:47
Remove extra colon in namespace delimiter check-in: 01f9053e79 user: andy tags: trunk
2018-07-24 02:42
Clean up end-of-line whitespace check-in: 178aaf8434 user: andy tags: trunk
2018-07-20 16:50
Add change history message (assuming next version is 2.6.1) and clean up whitespace check-in: 667c024d14 user: andy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
....
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
....
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
....
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
....
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
....
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
....
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
....
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
....
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
....
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
....
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  04/272009   G.Lester     Initial version
#   2.4.5  2017-12-04  H.Oehlmann   Return all current options if no argument
#                                   given. Options -globalonly or -defaultonly
#                                   limit this to options which are (not)
#                                   copied to the service.
#                                   
###########################################################################
proc ::WS::Client::SetOption {args} {
    variable options
    variable serviceLocalOptionsList
    if {0 == [llength $args]} {
        return [array get options]
    }
    set args [lassign $args option]
    
    switch -exact -- $option {
        -globalonly {
            ##
            ## Return list of global options
            ##
            # A list convertible to a dict is build for performance reasons:
            # - lappend does not test existence for each element
................................................................................
proc ::WS::Client::Config {args} {
    variable serviceArr
    variable options
    variable serviceLocalOptionsList

    set validOptionList $serviceLocalOptionsList
    lappend validOptionList location targetNamespace
    
    if {0 == [llength $args]} {
        # A list convertible to a dict is build for performance reasons:
        # - lappend does not test existence for each element
        # - if a list is needed, dict build burden is avoided
        set res {}
        foreach item $validOptionList {
            lappend res $item
................................................................................
            if {[info exists options($item)]} {
                lappend res $options($item)
            } else {
                lappend res {}
            }
        }
        return $res
    }    
    set args [lassign $args serviceName]
    if {0 == [llength $args]} {
        set res {}
        foreach item $validOptionList {
            lappend res $item [dict get $serviceArr($serviceName) $item]
        }
        return $res
    }
    
    set args [lassign $args item]
    if { $item ni $validOptionList } {
        return -code error "Uknown option '$item' -- must be one of: [join $validOptionList {, }]"
    }

    switch -exact -- [llength $args] {
        0 {
................................................................................
#                       is a key value list argument. It must be a list with
#                       an even number of elements that alternate between
#                       keys and values. The keys become header field names.
#                       Newlines are stripped from the values so the header
#                       cannot be corrupted.
#                       This is an optional argument and defaults to {}.
#       serviceAlias  - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name 
#                       of the service in serviceInfo.
#       serviceNumber - Number of service within the WSDL to assign the
#                       serviceAlias to. Only usable with a serviceAlias.
#                       First service (default) is addressed by value "1".
#
# Returns : The parsed service definition
#
................................................................................
    }

    ##
    ## build list of namespace definition nodes
    ##
    ## the top node is always used
    set NSDefinitionNodeList [list $wsdlNode]
    
    ##
    ## get namespace definitions in element nodes
    ##
    ## Element nodes may declare namespaces inline like:
    ## <xs:element xmlns:q1="myURI" type="q1:MessageQ1"/>
    ## ticket [dcce437d7a]
    
    # This is only done, if option inlineElementNS is set in the default
    # options. Service dependent options may not be used at this stage,
    # as serviceArr is not created jet (Client::Config will fail) and the
    # service name is not known jet.
    if {$options(inlineElementNS)} {
        lappend NSDefinitionNodeList {*}[$wsdlDoc selectNodes {//xs:element}]
    }
    foreach elemNode $NSDefinitionNodeList {
        # Get list of xmlns attributes
        # This list looks for the example like: {{q1 q1 {}} ... }
        set xmlnsAttributes [$elemNode attributes xmlns:*] 
        # Loop over found namespaces
        foreach itemList $xmlnsAttributes {
            set ns [lindex $itemList 0]
            set url [$elemNode getAttribute xmlns:$ns]

            if {[dict exists $nsDict url $url]} {
                set tns [dict get $nsDict url $url]
................................................................................
    set serviceInfo $serviceArr($serviceName)
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    
    ##
    ## build query
    ##
    
    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
................................................................................
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]]
    }
    
    ##
    ## do http call
    ##
    
    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ::log::logsubst debug {Leaving ::WS::Client::DoRawCall with {$body}}
................................................................................
            if {$URIServer eq $URICur} {
                dict set xnsDistantToLocalDict $attributeCur $prefixCur
                break
            }
        }
    }
    ::log::logsubst debug {Server to Client prefix dict: $xnsDistantToLocalDict}
    
    ##
    ## Get body tag
    ##
    set body [$top selectNodes ENV:Body]
    if {![llength $body]} {
        return \
            -code error \
................................................................................
    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::logsubst debug {Have [llength $rootNodeList] node under Body}
    foreach rootNodeCur $rootNodeList {
        set rootNameCur [$rootNodeCur localName]
        if {$rootNameCur eq {}} {
            set rootNameCur [$rootNodeCur nodeName]
        }
................................................................................
    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 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]
................................................................................
    }
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    
    ##
    ## build call query
    ##
    
    if {$location ne {}} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
................................................................................
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    
    ##
    ## do http call
    ##
    
    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ::log::logsubst debug {Leaving ::WS::Client::DoRawRestCall with {$body}}
................................................................................
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {$location ne {}} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    
    ##
    ## build call query
    ##
    
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    }
    RestoreSavedOptions $serviceName
    
    ##
    ## Do http call
    ##
    
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ##
    ## Parse results
    ##
    
    SaveAndSetOptions $serviceName
    if {[catch {
        parseRestResults $serviceName $objectName $operationName $body
    } results]} {
        RestoreSavedOptions $serviceName
        ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
        return -code error $results







|








|







 







|







 







|








|







 







|







 







|






|










|







 







|



|







 







|



|







 







|







 







|







 







|







 







|



|







 







|



|







 







|



|






|



|












|







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
....
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
....
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
....
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
....
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
....
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
....
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
....
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
....
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
....
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
....
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  04/272009   G.Lester     Initial version
#   2.4.5  2017-12-04  H.Oehlmann   Return all current options if no argument
#                                   given. Options -globalonly or -defaultonly
#                                   limit this to options which are (not)
#                                   copied to the service.
#
###########################################################################
proc ::WS::Client::SetOption {args} {
    variable options
    variable serviceLocalOptionsList
    if {0 == [llength $args]} {
        return [array get options]
    }
    set args [lassign $args option]

    switch -exact -- $option {
        -globalonly {
            ##
            ## Return list of global options
            ##
            # A list convertible to a dict is build for performance reasons:
            # - lappend does not test existence for each element
................................................................................
proc ::WS::Client::Config {args} {
    variable serviceArr
    variable options
    variable serviceLocalOptionsList

    set validOptionList $serviceLocalOptionsList
    lappend validOptionList location targetNamespace

    if {0 == [llength $args]} {
        # A list convertible to a dict is build for performance reasons:
        # - lappend does not test existence for each element
        # - if a list is needed, dict build burden is avoided
        set res {}
        foreach item $validOptionList {
            lappend res $item
................................................................................
            if {[info exists options($item)]} {
                lappend res $options($item)
            } else {
                lappend res {}
            }
        }
        return $res
    }
    set args [lassign $args serviceName]
    if {0 == [llength $args]} {
        set res {}
        foreach item $validOptionList {
            lappend res $item [dict get $serviceArr($serviceName) $item]
        }
        return $res
    }

    set args [lassign $args item]
    if { $item ni $validOptionList } {
        return -code error "Uknown option '$item' -- must be one of: [join $validOptionList {, }]"
    }

    switch -exact -- [llength $args] {
        0 {
................................................................................
#                       is a key value list argument. It must be a list with
#                       an even number of elements that alternate between
#                       keys and values. The keys become header field names.
#                       Newlines are stripped from the values so the header
#                       cannot be corrupted.
#                       This is an optional argument and defaults to {}.
#       serviceAlias  - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name
#                       of the service in serviceInfo.
#       serviceNumber - Number of service within the WSDL to assign the
#                       serviceAlias to. Only usable with a serviceAlias.
#                       First service (default) is addressed by value "1".
#
# Returns : The parsed service definition
#
................................................................................
    }

    ##
    ## build list of namespace definition nodes
    ##
    ## the top node is always used
    set NSDefinitionNodeList [list $wsdlNode]

    ##
    ## get namespace definitions in element nodes
    ##
    ## Element nodes may declare namespaces inline like:
    ## <xs:element xmlns:q1="myURI" type="q1:MessageQ1"/>
    ## ticket [dcce437d7a]

    # This is only done, if option inlineElementNS is set in the default
    # options. Service dependent options may not be used at this stage,
    # as serviceArr is not created jet (Client::Config will fail) and the
    # service name is not known jet.
    if {$options(inlineElementNS)} {
        lappend NSDefinitionNodeList {*}[$wsdlDoc selectNodes {//xs:element}]
    }
    foreach elemNode $NSDefinitionNodeList {
        # Get list of xmlns attributes
        # This list looks for the example like: {{q1 q1 {}} ... }
        set xmlnsAttributes [$elemNode attributes xmlns:*]
        # Loop over found namespaces
        foreach itemList $xmlnsAttributes {
            set ns [lindex $itemList 0]
            set url [$elemNode getAttribute xmlns:$ns]

            if {[dict exists $nsDict url $url]} {
                set tns [dict get $nsDict url $url]
................................................................................
    set serviceInfo $serviceArr($serviceName)
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }

    ##
    ## build query
    ##

    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
................................................................................
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]]
    }

    ##
    ## do http call
    ##

    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ::log::logsubst debug {Leaving ::WS::Client::DoRawCall with {$body}}
................................................................................
            if {$URIServer eq $URICur} {
                dict set xnsDistantToLocalDict $attributeCur $prefixCur
                break
            }
        }
    }
    ::log::logsubst debug {Server to Client prefix dict: $xnsDistantToLocalDict}

    ##
    ## Get body tag
    ##
    set body [$top selectNodes ENV:Body]
    if {![llength $body]} {
        return \
            -code error \
................................................................................
    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::logsubst debug {Have [llength $rootNodeList] node under Body}
    foreach rootNodeCur $rootNodeList {
        set rootNameCur [$rootNodeCur localName]
        if {$rootNameCur eq {}} {
            set rootNameCur [$rootNodeCur nodeName]
        }
................................................................................
    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 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]
................................................................................
    }
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }

    ##
    ## build call query
    ##

    if {$location ne {}} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
................................................................................
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }

    ##
    ## do http call
    ##

    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ::log::logsubst debug {Leaving ::WS::Client::DoRawRestCall with {$body}}
................................................................................
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {$location ne {}} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }

    ##
    ## build call query
    ##

    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    }
    RestoreSavedOptions $serviceName

    ##
    ## Do http call
    ##

    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ##
    ## Parse results
    ##

    SaveAndSetOptions $serviceName
    if {[catch {
        parseRestResults $serviceName $objectName $operationName $body
    } results]} {
        RestoreSavedOptions $serviceName
        ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
        return -code error $results