Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Correct issue with cyclic includes and some simple type declarations. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
342697b2e81968799d6b3c8fbaa9e5bd |
| User & Date: | gerald 2014-04-01 01:17:25 |
References
| 2014-06-24 15:19 | • New ticket [805c828c82] DoCall: ActiveTcl Version 8.6 + WS Version 2.8.6 fails to get Complete Response. artifact: d46ef2302e user: anonymous | |
Context
| 2014-11-06 16:56 | Change to address open vulnerability via "poodle" attack (see http://nvd.nist.gov/view/vuln/detail?vulnId=CVE-2014-3566). check-in: aa1358233d user: gerald tags: trunk | |
| 2014-04-01 01:17 | Correct issue with cyclic includes and some simple type declarations. check-in: 342697b2e8 user: gerald tags: trunk | |
| 2014-01-13 23:25 | Corrected logic of test. check-in: a487bd41ac user: gerald tags: trunk | |
Changes
Changes to ClientSide.tcl.
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
....
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
|
}
if {[info exists currentBaseUrl]} {
set url $currentBaseUrl
} else {
set url $targetNs
}
::WS::Utils::ProcessIncludes $wsdlNode $url
if {[string length $defaults(-serviceAlias)]} {
set serviceAlias $defaults(-serviceAlias)
} else {
set serviceAlias {}
}
................................................................................
"Unknown operation '$operationName' for service '$serviceName'"
}
if {[dict exists $serviceInfo headers]} {
set headers [concat $headers [dict get $serviceInfo headers]]
}
set url [dict get $serviceInfo object $objectName location]
SaveAndSetOptions $serviceName
if {catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList} err]} {
RestoreSavedOptions $serviceName
return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
} else {
RestoreSavedOptions $serviceName
}
if {[llength $headers]} {
::log::log info [list \
|
>
>
|
|
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
....
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
|
}
if {[info exists currentBaseUrl]} {
set url $currentBaseUrl
} else {
set url $targetNs
}
array unset ::WS::Utils::includeArr
::WS::Utils::ProcessIncludes $wsdlNode $url
if {[string length $defaults(-serviceAlias)]} {
set serviceAlias $defaults(-serviceAlias)
} else {
set serviceAlias {}
}
................................................................................
"Unknown operation '$operationName' for service '$serviceName'"
}
if {[dict exists $serviceInfo headers]} {
set headers [concat $headers [dict get $serviceInfo headers]]
}
set url [dict get $serviceInfo object $objectName location]
SaveAndSetOptions $serviceName
if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
RestoreSavedOptions $serviceName
return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
} else {
RestoreSavedOptions $serviceName
}
if {[llength $headers]} {
::log::log info [list \
|
Changes to Utilities.tcl.
745 746 747 748 749 750 751 752 753 754 755 756 757 758 ... 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 ... 860 861 862 863 864 865 866 867 868 869 870 871 872 873 .... 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 .... 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 .... 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 .... 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 .... 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 .... 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 .... 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 .... 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 .... 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 .... 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 .... 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 .... 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 |
$doc selectNodesNamespaces {
w http://schemas.xmlsoap.org/wsdl/
d http://schemas.xmlsoap.org/wsdl/soap/
xs http://www.w3.org/2001/XMLSchema
}
$doc documentElement schema
if {[catch {ProcessIncludes $schema $baseUrl} errMsg]} {
puts stderr $::errorInfo
puts stderr $::errorCode
puts stderr $errMsg
}
set prevSchema $currentSchema
set currentSchema $schema
................................................................................
#
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 25/05/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl} {
variable ::WS::Utils::xsltSchemaDom
variable nsList
set includeNodeList [$rootNode selectNodes -namespaces $nsList xs:include]
set inXml [$rootNode asXML]
set included 0
foreach includeNode $includeNodeList {
if {![$includeNode hasAttribute schemaLocation]} {
continue
}
incr included
set urlTail [$includeNode getAttribute schemaLocation]
set url [::uri::resolve $baseUrl $urlTail]
::log::log debug "\t Importing {$url}"
switch -exact -- [dict get [::uri::split $url] scheme] {
file {
upvar #0 [::uri::geturl $url] token
set xml $token(data)
unset token
}
https -
................................................................................
set xml [string range $xml $first end]
}
dom parse $xml tmpdoc
$tmpdoc xslt $xsltSchemaDom doc
$tmpdoc delete
set children 0
set top [$doc documentElement]
foreach childNode [$top childNodes] {
if {[catch {
#set newNode [$parentNode appendXML [$childNode asXML]]
#$parentNode removeChild $newNode
#$parentNode insertBefore $newNode $includeNode
$parentNode insertBefore $childNode $includeNode
}]} {
................................................................................
##
## Get sibling node to scheme and add tempory type definitions
##
## type == sibing of temp type
## temp_type == newType of newType
##
set tnsCountVar [llength [dict get $::WS::Client::serviceArr($serviceName) targetNamespace]]
set tns tnx$tnsCountVar
set dataNode {}
$schemeNode nextSibling dataNode
if {![info exists dataNode] || ![string length $dataNode]} {
$schemeNode previousSibling dataNode
}
set dataNodeNameList [split [$dataNode nodeName] :]
set dataTnsName [lindex $dataNodeNameList 0]
................................................................................
upvar 1 $serviceInfoVar serviceInfo
variable currentSchema
variable nsList
variable options
variable unkownRef
set currentSchema $schemaNode
if {[$schemaNode hasAttribute targetNamespace]} {
set xns [$schemaNode getAttribute targetNamespace]
} else {
set xns $baseUrl
}
::log::log debug "@3a {$xns} {[dict get $serviceInfo tnsList url]}"
if {![dict exists $serviceInfo tnsList url $xns]} {
set tns [format {tns%d} [incr tnsCount]]
dict set serviceInfo targetNamespace $tns $xns
dict set serviceInfo tnsList url $xns $tns
dict set serviceInfo tnsList tns $tns $tns
................................................................................
}
}
}
}
if {$lastUnknownRefCount} {
switch -exact -- $options(StrictMode) {
error -
default {
return \
-code error \
-errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
"Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
}
}
}
................................................................................
set errorCode $::errorCode
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t last element: $::elementName"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
log::log error "\t last element: $::elementName"
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorCode $::errorCode
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorCode $::errorCode
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
dict set serviceInfo tnsList tns $prevTnsDict
}
###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
# that you update this header block. Thanks.
................................................................................
-code error \
-errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
"Missing Schema Location in '$baseUrl'"
}
}
set urlTail [$importNode getAttribute $attrName]
set url [::uri::resolve $baseUrl $urlTail]
set lastPos [string last / $url]
set testUrl [string range $url 0 [expr {$lastPos - 1}]]
if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
set newUrl $::WS::Utils::redirectArray($testUrl)
append newUrl [string range $url $lastPos end]
::log::log debug "newUrl = $newUrl"
................................................................................
ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
}
https -
http {
::log::log debug "In http/https processor"
set ncode -1
set token [geturl_followRedirects $url]
parray $token
::http::wait $token
set ncode [::http::ncode $token]
set xml [::http::data $token]
::http::cleanup $token
ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
return \
-code error \
-errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
"HTTP get of import file failed '$url'"
} elseif {($ncode != 200) && ![string equal $options(includeDirectory) {}]} {
set fn [file join $options(includeDirectory) $urlTail]
set ifd [open $fn r]
set xml [read $ifd]
close $ifd
ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
}
}
default {
return \
-code error \
-errorcode [list WS CLIENT UNKURLTYP $url] \
"Unknown URL type '$url'"
................................................................................
proc ::WS::Utils::parseSimpleType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable nsList
::log::log debug "Entering [info level 0]"
set typeName [$node getAttribute name]
set isList no
::log::log debug "Simple Type is $typeName"
if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
::log::log debug "\t Type $tns:$typeName is already defined -- leaving"
return
}
#puts "Simple Type is $typeName"
set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
if {[string equal $restrictionNode {}]} {
set restrictionNode [$node selectNodes -namespaces $nsList xs:list/xs:simpleType/xs:restriction]
}
if {[string equal $restrictionNode {}]} {
set restrictionNode [$node selectNodes -namespaces $nsList xs:list]
set isList yes
}
................................................................................
set lastPos [string last / $initialUrl]
set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
set lastPos [string last / $finalUrl]
set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
::log::log debug "initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir"
set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
}
return $token
}
array set meta [set ${token}(meta)]
if {![info exist meta(Location)]} {
return $token
}
array set uri [::uri::split $meta(Location)]
|
> | | > > | < > | > > > > > > > > > | > > > > > > > > | > > > > > > > > > > > > > > > > | > < | | > > | > > > > > > > > > > > > |
745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 ... 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 ... 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 .... 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 .... 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 .... 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 .... 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 .... 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 .... 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 .... 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 .... 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 .... 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 .... 2941 2942 2943 2944 2945 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 .... 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 .... 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 |
$doc selectNodesNamespaces {
w http://schemas.xmlsoap.org/wsdl/
d http://schemas.xmlsoap.org/wsdl/soap/
xs http://www.w3.org/2001/XMLSchema
}
$doc documentElement schema
if {[catch {ProcessIncludes $schema $baseUrl} errMsg]} {
puts stderr "Error processing include $schema $baseUrl"
puts stderr $::errorInfo
puts stderr $::errorCode
puts stderr $errMsg
}
set prevSchema $currentSchema
set currentSchema $schema
................................................................................
#
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 25/05/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl {includePath {}}} {
variable xsltSchemaDom
variable nsList
variable options
variable includeArr
set includeNodeList [$rootNode selectNodes -namespaces $nsList descendant::xs:include]
set inXml [$rootNode asXML]
set included 0
foreach includeNode $includeNodeList {
if {![$includeNode hasAttribute schemaLocation]} {
continue
}
set urlTail [$includeNode getAttribute schemaLocation]
set url [::uri::resolve $baseUrl $urlTail]
if {[lsearch -exact $includePath $url] != -1} {
log::log warning "Include loop detected: [join $includePath { -> }]"
continue
} elseif {[info exists includeArr($url)]} {
continue
} else {
set includeArr($url) 1
}
incr included
::log::log info "\t Including {$url} from base {$baseUrl}"
switch -exact -- [dict get [::uri::split $url] scheme] {
file {
upvar #0 [::uri::geturl $url] token
set xml $token(data)
unset token
}
https -
................................................................................
set xml [string range $xml $first end]
}
dom parse $xml tmpdoc
$tmpdoc xslt $xsltSchemaDom doc
$tmpdoc delete
set children 0
set top [$doc documentElement]
::WS::Utils::ProcessIncludes $top $url [concat $includePath $baseUrl]
foreach childNode [$top childNodes] {
if {[catch {
#set newNode [$parentNode appendXML [$childNode asXML]]
#$parentNode removeChild $newNode
#$parentNode insertBefore $newNode $includeNode
$parentNode insertBefore $childNode $includeNode
}]} {
................................................................................
##
## Get sibling node to scheme and add tempory type definitions
##
## type == sibing of temp type
## temp_type == newType of newType
##
set tnsCountVar [llength [dict get $::WS::Client::serviceArr($serviceName) targetNamespace]]
set tns tns$tnsCountVar
set dataNode {}
$schemeNode nextSibling dataNode
if {![info exists dataNode] || ![string length $dataNode]} {
$schemeNode previousSibling dataNode
}
set dataNodeNameList [split [$dataNode nodeName] :]
set dataTnsName [lindex $dataNodeNameList 0]
................................................................................
upvar 1 $serviceInfoVar serviceInfo
variable currentSchema
variable nsList
variable options
variable unkownRef
set currentSchema $schemaNode
set tmpTargetNs $::WS::Utils::targetNs
foreach attr [$schemaNode attributes] {
set value {?}
catch {set value [$schemaNode getAttribute $attr]}
::log::log debug "Attribute $attr = $value"
}
if {[$schemaNode hasAttribute targetNamespace]} {
set xns [$schemaNode getAttribute targetNamespace]
::log::log debug "In Parse Scheme, found targetNamespace attribute with {$xns}"
set ::WS::Utils::targetNs $xns
} else {
set xns $::WS::Utils::targetNs
}
::log::log debug "@3a {$xns} {[dict get $serviceInfo tnsList url]}"
if {![dict exists $serviceInfo tnsList url $xns]} {
set tns [format {tns%d} [incr tnsCount]]
dict set serviceInfo targetNamespace $tns $xns
dict set serviceInfo tnsList url $xns $tns
dict set serviceInfo tnsList tns $tns $tns
................................................................................
}
}
}
}
if {$lastUnknownRefCount} {
switch -exact -- $options(StrictMode) {
debug -
warning {
set ::WS::Utils::targetNs $tmpTargetNs
::log::log $options(StrictMode) "Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
}
error -
default {
set ::WS::Utils::targetNs $tmpTargetNs
set ofd [open full.xsd w];puts $ofd [$schemaNode asXML];close $ofd
return \
-code error \
-errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
"Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
}
}
}
................................................................................
set errorCode $::errorCode
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t last element: $::elementName"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
log::log error "\t last element: $::elementName"
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorCode $::errorCode
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
................................................................................
set errorCode $::errorCode
set errorInfo $::errorInfo
log::log error "Could not parse:\n [$element asXML]"
log::log error "\t error was: $msg"
log::log error "\t error info: $errorInfo"
log::log error "\t error in: [lindex [info level 0] 0]"
log::log error "\t error code: $errorCode"
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
set ::WS::Utils::targetNs $tmpTargetNs
::log::log debug "Leaving :WS::Utils::parseScheme $mode $baseUrl $schemaNode $serviceName $serviceInfoVar $tnsCountVar"
::log::log debug "Target NS is now: $::WS::Utils::targetNs"
dict set serviceInfo tnsList tns $prevTnsDict
}
###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
# that you update this header block. Thanks.
................................................................................
-code error \
-errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
"Missing Schema Location in '$baseUrl'"
}
}
set urlTail [$importNode getAttribute $attrName]
set url [::uri::resolve $baseUrl $urlTail]
::log::log info "Including $url"
set lastPos [string last / $url]
set testUrl [string range $url 0 [expr {$lastPos - 1}]]
if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
set newUrl $::WS::Utils::redirectArray($testUrl)
append newUrl [string range $url $lastPos end]
::log::log debug "newUrl = $newUrl"
................................................................................
ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
}
https -
http {
::log::log debug "In http/https processor"
set ncode -1
set token [geturl_followRedirects $url]
#parray $token
::http::wait $token
set ncode [::http::ncode $token]
puts "returned code {$ncode}"
set xml [::http::data $token]
::http::cleanup $token
if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
return \
-code error \
-errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
"HTTP get of import file failed '$url'"
} elseif {($ncode == 200) && ![string equal $options(includeDirectory) {}]} {
set fn [file join $options(includeDirectory) [file tail $urlTail]]
::log::log info "Could not access $url -- using $fn"
set ifd [open $fn r]
set xml [read $ifd]
close $ifd
}
if {[catch {ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar} err]} {
::log::log info "Error during processing of XML: $err"
#puts stderr "error Info: $::errorInfo"
} else {
#puts stderr "import successful"
}
}
default {
return \
-code error \
-errorcode [list WS CLIENT UNKURLTYP $url] \
"Unknown URL type '$url'"
................................................................................
proc ::WS::Utils::parseSimpleType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable nsList
::log::log debug "Entering [info level 0]"
set typeName [$node getAttribute name]
if {$typeName in {SAP_VALID_FROM}} {
set foo 1
}
set isList no
::log::log debug "Simple Type is $typeName"
if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
::log::log debug "\t Type $tns:$typeName is already defined -- leaving"
return
}
#puts "Simple Type is $typeName"
set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
if {[string equal $restrictionNode {}]} {
set restrictionNode [$node selectNodes -namespaces $nsList xs:simpleType/xs:restriction]
}
if {[string equal $restrictionNode {}]} {
set restrictionNode [$node selectNodes -namespaces $nsList xs:list/xs:simpleType/xs:restriction]
}
if {[string equal $restrictionNode {}]} {
set restrictionNode [$node selectNodes -namespaces $nsList xs:list]
set isList yes
}
................................................................................
set lastPos [string last / $initialUrl]
set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
set lastPos [string last / $finalUrl]
set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
::log::log debug "initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir"
set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
}
return $token
} elseif {![string match {20[1237]} $ncode]} {
return $token
}
array set meta [set ${token}(meta)]
if {![info exist meta(Location)]} {
return $token
}
array set uri [::uri::split $meta(Location)]
|