Check-in [a1cf727fd3]
Not logged in

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

Overview
Comment:(WSDL)Support type with namespace definition in tag. Ticket [6fbee3208e]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:a1cf727fd30673daa3fd0e06b9fa13af499d796af4eb756c3f529bfbf50612e1
User & Date: oehhar 2018-12-06 12:17:39
Original Comment: Fail in case of a node local namespace, which is not found globally. Before, an identical global prefix (with other namespace) may be picked. Ticket [6fbee3208e]
Context
2018-12-06 13:06
Revert an optimisation which limits the argument list. The method may set multiple arguments. Leaf check-in: 58072a102f user: oehhar tags: trunk, Release_2.6.2
2018-12-06 12:17
(WSDL)Support type with namespace definition in tag. Ticket [6fbee3208e] check-in: a1cf727fd3 user: oehhar tags: trunk
2018-11-05 13:41
Fail in case of a node local namespace, which is not found globally. Before, an identical global prefix (with other namespace) may be picked. Closed-Leaf check-in: 12bb39fa7a user: oehhar tags: ticket-6fbee320-local-ns-prefix
2018-09-03 17:55
Replaced stderr error print by error log (::WS::Utils::ProcessImportXml). Plus some documentation and ticket numbers. check-in: 07f65e990e user: oehhar tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to Utilities.tcl.

    66     66           ::log::log $level [uplevel 1 [list subst $text]]
    67     67       }
    68     68   }
    69     69   
    70     70   package require tdom 0.8
    71     71   package require struct::set
    72     72   
    73         -package provide WS::Utils 2.6.1
           73  +package provide WS::Utils 2.6.2
    74     74   
    75     75   namespace eval ::WS {}
    76     76   
    77     77   namespace eval ::WS::Utils {
    78     78       set ::WS::Utils::typeInfo {}
    79     79       set ::WS::Utils::currentSchema {}
    80     80       array set ::WS::Utils::importedXref {}
................................................................................
  3388   3388                           set refNS [lindex $refTypeInfo 0]
  3389   3389                           if {[string equal $refNS {}]} {
  3390   3390                               set partType $tns:$partType
  3391   3391                           }
  3392   3392                           ##
  3393   3393                           ## Convert the reference to the local tns space
  3394   3394                           ##
  3395         -                        set partType  [getQualifiedType $results $partType $tns]
         3395  +                        set partType [getQualifiedType $results $partType $tns $middleNode]
  3396   3396                           set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
  3397   3397                           set refTypeInfo [dict get $refTypeInfo definition]
  3398   3398                           set tmpList [dict keys $refTypeInfo]
  3399   3399                           if {[llength $tmpList] == 1} {
  3400   3400                               ##
  3401   3401                               ## See if the reference is to an element or a type
  3402   3402                               ##
  3403   3403                               if {![dict exists $results elements $partType]} {
  3404   3404                                   ##
  3405   3405                                   ## To at type, so redefine the name
  3406   3406                                   ##
  3407   3407                                   set partName [lindex [dict keys $refTypeInfo] 0]
  3408   3408                               }
  3409         -                            set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns]
         3409  +                            set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns $middleNode]
  3410   3410                           }
  3411   3411                           lappend partList $partName [list type $partType]
  3412   3412                       }]} {
  3413   3413                           lappend unknownRef($partType) $typeName
  3414   3414                           return \
  3415   3415                               -code error \
  3416   3416                               -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
  3417   3417                               "Unknown forward type reference {$partType} in {$typeName}"
  3418   3418                       }
  3419   3419                   } else {
  3420   3420                       set partName [$middleNode getAttribute name]
  3421         -                    set partType [string trimright [getQualifiedType $results [$middleNode getAttribute type string:string] $tns] {?}]
         3421  +                    set partType [string trimright \
         3422  +                        [getQualifiedType $results [$middleNode getAttribute type string:string] $tns $middleNode] {?}]
  3422   3423                       set partMax [$middleNode getAttribute maxOccurs 1]
  3423   3424                       if {$partMax <= 1} {
  3424   3425                           lappend partList $partName [list type $partType comment $comment]
  3425   3426                       } else {
  3426   3427                           lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment]
  3427   3428                       }
  3428   3429                   }
................................................................................
  3641   3642               ##
  3642   3643               ## Do Nothing
  3643   3644               ##
  3644   3645           }
  3645   3646           element {
  3646   3647               catch {
  3647   3648                   set partName [$node getAttribute name]
  3648         -                set partType [string trimright [getQualifiedType $results [$node getAttribute type string] $tns] {?}]
         3649  +                set partType [string trimright [getQualifiedType $results [$node getAttribute type string] $tns $node] {?}]
  3649   3650                   set partMax [$node getAttribute maxOccurs 1]
  3650   3651                   if {$partMax <= 1} {
  3651   3652                       set partList [list $partName [list type $partType comment {}]]
  3652   3653                   } else {
  3653   3654                       set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
  3654   3655                   }
  3655   3656               }
  3656   3657           }
  3657   3658           extension {
  3658         -            set baseName [getQualifiedType $results [$node getAttribute base string] $tns]
         3659  +            set baseName [getQualifiedType $results [$node getAttribute base string] $tns $node]
  3659   3660               set baseTypeInfo [TypeInfo Client $serviceName $baseName]
  3660   3661               ::log::logsubst debug {\t base name of extension is {$baseName} with typeinfo {$baseTypeInfo}}
  3661   3662               if {[lindex $baseTypeInfo 0]} {
  3662   3663                   if {[catch {::WS::Utils::GetServiceTypeDef Client $serviceName $baseName}]} {
  3663   3664                       set baseQuery [format {child::*[attribute::name='%s']} $baseName]
  3664   3665                       set baseNode [$currentSchema selectNodes $baseQuery]
  3665   3666                       #puts "$baseQuery gave {$baseNode}"
................................................................................
  3749   3750                                   set partType $partName
  3750   3751                                   parseComplexType $mode results $serviceName $element $tns
  3751   3752                                   if {[info exists simpleTypes($mode,$serviceName,$tns:$partName)]} {
  3752   3753                                     set additional_defininition_elements $simpleTypes($mode,$serviceName,$tns:$partName)
  3753   3754                                     set partType [dict get $additional_defininition_elements baseType]
  3754   3755                                   }
  3755   3756                               } else {
  3756         -                                set partType [getQualifiedType $results [$element getAttribute type string] $tns]
         3757  +                                set partType [getQualifiedType $results [$element getAttribute type string] $tns $element]
  3757   3758                               }
  3758   3759                           } else {
  3759         -                            set partType [getQualifiedType $results [$element getAttribute type string] $tns]
         3760  +                            set partType [getQualifiedType $results [$element getAttribute type string] $tns $element]
  3760   3761                           }
  3761   3762                       }
  3762   3763                       if {[string length $occurs]} {
  3763   3764                           set partMax [$element getAttribute maxOccurs 1]
  3764   3765                           if {$partMax < $occurs} {
  3765   3766                               set partMax $occurs
  3766   3767                           }
................................................................................
  3898   3899       set typeName [$node getAttribute $attributeName]
  3899   3900       if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
  3900   3901           ::log::logsubst debug {\t Type $tns:$typeName is already defined -- leaving}
  3901   3902           return
  3902   3903       }
  3903   3904       set typeType ""
  3904   3905       if {[$node hasAttribute type]} {
  3905         -        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
         3906  +        set typeType [getQualifiedType $results [$node getAttribute type string] $tns $node]
  3906   3907       }
  3907   3908       ::log::logsubst debug {Elemental Type is $typeName}
  3908   3909       set partList {}
  3909   3910       set partType {}
  3910   3911       set isAbstractType false
  3911   3912       if {[$node hasAttribute abstract]} {
  3912   3913           set isAbstractType [$node getAttribute abstract]
................................................................................
  3974   3975               set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
  3975   3976               ::log::logsubst debug {\t\t\ has no ref has [llength $childList]}
  3976   3977               if {[llength $childList]} {
  3977   3978                   ##
  3978   3979                   ## Element defines another element layer
  3979   3980                   ##
  3980   3981                   set partName [$element getAttribute name]
  3981         -                set partType [getQualifiedType $results $partName $tns]
         3982  +                set partType [getQualifiedType $results $partName $tns $element]
  3982   3983                   parseElementalType $mode results $serviceName $element $tns
  3983   3984               } else {
  3984   3985                   set partName [$element getAttribute name]
  3985   3986                   if {[$element hasAttribute type]} {
  3986         -                    set partType [getQualifiedType $results [$element getAttribute type] $tns]
         3987  +                    set partType [getQualifiedType $results [$element getAttribute type] $tns $element]
  3987   3988                   } else {
  3988   3989                       set partType xs:string
  3989   3990                   }
  3990   3991   
  3991   3992               }
  3992   3993           }
  3993   3994           set partMax [$element getAttribute maxOccurs -1]
................................................................................
  4030   4031                       ## Placed here to shut up tclchecker
  4031   4032                       ##
  4032   4033                   }
  4033   4034               }
  4034   4035           }
  4035   4036           # have an element with a type only, so do the work here
  4036   4037           if {[$node hasAttribute type]} {
  4037         -            set partType [getQualifiedType $results [$node getAttribute type] $tns]
         4038  +            set partType [getQualifiedType $results [$node getAttribute type] $tns $node]
  4038   4039           } elseif {[$node hasAttribute base]}  {
  4039         -            set partType [getQualifiedType $results [$node getAttribute base] $tns]
         4040  +            set partType [getQualifiedType $results [$node getAttribute base] $tns $node]
  4040   4041           } else {
  4041   4042               set partType xs:string
  4042   4043           }
  4043   4044           set partMax [$node getAttribute maxOccurs 1]
  4044   4045           if {$partMax <= 1} {
  4045   4046               ##
  4046   4047               ## See if this is just a restriction on a simple type
................................................................................
  4525   4526   # Private Procedure Header - as this procedure is modified, please be sure
  4526   4527   #                           that you update this header block. Thanks.
  4527   4528   #
  4528   4529   #>>BEGIN PRIVATE<<
  4529   4530   #
  4530   4531   # Procedure Name : ::WS::Utils::getQualifiedType
  4531   4532   #
  4532         -# Description : Set attributes on a DOM node
         4533  +# Description : Get a qualified type name from a local reference.
         4534  +#               Thus return <Prefix>:<Type> which is in the global type list.
         4535  +#               The <Prefix> is adjusted to point to the global type list.
  4533   4536   #
  4534   4537   # Arguments :
  4535   4538   #       serviceInfo - service information dictionary
  4536   4539   #       type        - type to get local qualified type on
  4537   4540   #       tns         - current namespace
         4541  +#       node        - optional XML item to search for xmlns:* attribute
  4538   4542   #
  4539   4543   # Returns :     nothing
  4540   4544   #
  4541   4545   # Side-Effects :        None
  4542   4546   #
  4543   4547   # Exception Conditions :        None
  4544   4548   #
................................................................................
  4551   4555   # Maintenance History - as this file is modified, please be sure that you
  4552   4556   #                       update this segment of the file header block by
  4553   4557   #                       adding a complete entry at the bottom of the list.
  4554   4558   #
  4555   4559   # Version     Date     Programmer   Comments / Changes / Reasons
  4556   4560   # -------  ----------  ----------   -------------------------------------------
  4557   4561   #       1  02/24/2011  G. Lester    Initial version
         4562  +#   2.6.2  2018-09-22  C. Werner    Added parameter "node" to first search a
         4563  +#                                   namespace attribute "xmlns:yprefix>" in the
         4564  +#                                   current node.
  4558   4565   #
  4559   4566   ###########################################################################
  4560         -proc ::WS::Utils::getQualifiedType {serviceInfo type tns} {
         4567  +proc ::WS::Utils::getQualifiedType {serviceInfo type tns {node {}}} {
  4561   4568   
  4562   4569       set typePartsList [split $type {:}]
  4563   4570       if {[llength $typePartsList] == 1} {
         4571  +        # No namespace prefix given - use current prefix
  4564   4572           set result $tns:$type
  4565   4573       } else {
  4566   4574           lassign $typePartsList tmpTns tmpType
         4575  +        # Search the namespace attribute in the current node for a node-local prefix.
         4576  +        # Aim is to translate the node-local prefix to a global namespace prefix.
         4577  +        # Example:
         4578  +        # <xs:element name="A_O_S"
         4579  +        #    type="x1:ArrayOfSomething"
         4580  +        #    xmlns:x1="http://foo.org/bar" />
         4581  +        #
         4582  +        # Variable setup:
         4583  +        # - type: x1:ArrayOfSomething
         4584  +        # - tmpTns: x1
         4585  +        # - tmpType: ArrayOfSomething
         4586  +        # Return value:
         4587  +        #   - <Prefix in serviceinfo which corresponds to namespace: "http://foo.org/bar">
         4588  +        #   - plus ":ArrayOfSomething"
         4589  +        if {$node ne {}} {
         4590  +            set attr xmlns:$tmpTns
         4591  +            if {[$node hasAttribute $attr]} {
         4592  +                # There is a node-local attribute (Example: xmlns:x1) giving the node namespace
         4593  +                set xmlns [$node getAttribute $attr]
         4594  +                if {[dict exists $serviceInfo tnsList url $xmlns]} {
         4595  +                    set result [dict get $serviceInfo tnsList url $xmlns]:$tmpType
         4596  +                    ::log::logsubst debug {Got global qualified type '$result' from node-local qualified namespace '$xmlns'}
         4597  +                    return $result
         4598  +                } else {
         4599  +                    # The node namespace (Ex: http://foo.org/bar) was not found as global prefix.
         4600  +                    # Thus, the type is refused.
         4601  +                    # HaO 2018-11-05 Opinion:
         4602  +                    # Continuing here is IMHO not an option, as the prefix (Ex: x1) might have a
         4603  +                    # different namespace on the global level which would lead to a misassignment.
         4604  +                    #
         4605  +                    # One day, we may support cascading namespace prefixes. Then, we may define
         4606  +                    # the namespace here
         4607  +                    set errMsg "Node local namespace URI '$xmlns' not found for type: '$type'"
         4608  +                    ::log::log error $errMsg
         4609  +                    return -code error $errMsg
         4610  +                }
         4611  +            }
         4612  +        }
  4567   4613           if {[dict exists $serviceInfo tnsList tns $tmpTns]} {
  4568   4614               set result [dict get $serviceInfo tnsList tns $tmpTns]:$tmpType
  4569   4615           } elseif {[dict exists $serviceInfo types $type]} {
  4570   4616               set result $type
  4571   4617           } else {
  4572   4618               ::log::log error $serviceInfo
  4573   4619               ::log::logsubst error {Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}}
  4574         -            set result $tns:$type
  4575         -            return -code error
         4620  +            return -code error "Namespace prefix of type '$Type' not found."
  4576   4621           }
  4577         -
  4578   4622       }
  4579   4623       return $result
  4580   4624   }
  4581   4625   
  4582   4626   ###########################################################################
  4583   4627   #
  4584   4628   # Private Procedure Header - as this procedure is modified, please be sure
................................................................................
  4836   4880   #
  4837   4881   ###########################################################################
  4838   4882   if {[package vcompare [info patchlevel] 8.5] == -1} {
  4839   4883       ##
  4840   4884       ## 8.4, so can not use {*} expansion
  4841   4885       ##
  4842   4886       proc ::WS::Utils::setAttr {node attrList} {
  4843         -        foreach {name value} $attrList {
  4844         -            $node setAttribute $name $value
  4845         -        }
         4887  +        lassign $attrList name value
         4888  +        $node setAttribute $name $value
  4846   4889       }
  4847   4890   } else {
  4848   4891       ##
  4849   4892       ## 8.5 or later, so use {*} expansion
  4850   4893       ##
  4851   4894       proc ::WS::Utils::setAttr {node attrList} {
  4852   4895           $node setAttribute {*}$attrList

Changes to pkgIndex.tcl.

    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     13   package ifneeded WS::Client 2.6.0 [list source [file join $dir ClientSide.tcl]]
    14     14   package ifneeded WS::Embeded 2.6.0 [list source [file join $dir Embedded.tcl]]
    15     15   package ifneeded WS::Embedded 2.6.0 [list source [file join $dir Embedded.tcl]]
    16     16   package ifneeded WS::Server 2.6.0 [list source [file join $dir ServerSide.tcl]]
    17         -package ifneeded WS::Utils 2.6.1 [list source [file join $dir Utilities.tcl]]
           17  +package ifneeded WS::Utils 2.6.2 [list source [file join $dir Utilities.tcl]]
    18     18   package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
    19     19   package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]