Index: ClientSide.tcl ================================================================== --- ClientSide.tcl +++ ClientSide.tcl @@ -51,11 +51,11 @@ http::register https 443 [list ::tls::socket -ssl2 no -ssl3 no -tls1 yes] } err]} { log::log warning "No https support: $err" } -package provide WS::Client 2.3.8 +package provide WS::Client 2.3.9 namespace eval ::WS::Client { ## ## serviceArr is indexed by service name and contains a dictionary that ## defines the service. The dictionary has the following structure: @@ -528,21 +528,11 @@ set xml $token(data) unset token } http - https { - set token [::http::geturl $url] - ::http::wait $token - set ncode [::http::ncode $token] - set xml [::http::data $token] - ::http::cleanup $token - if {$ncode != 200} { - return \ - -code error \ - -errorcode [list WS CLIENT HTTPFAIL $url] \ - "HTTP get of import file failed '$url'" - } + set xml [::WS::Utils::geturl_fetchbody $url] } default { return \ -code error \ -errorcode [list WS CLIENT UNKURLTYP $url] \ @@ -917,27 +907,15 @@ unset token } http - https { if {[llength $headers]} { - set token [::WS::Utils::geturl_followRedirects $url -headers $headers] + set body [::WS::Utils::geturl_fetchbody $url -headers $headers] } else { - set token [::WS::Utils::geturl_followRedirects $url] - } - ::http::wait $token - if {![string equal [::http::status $token] ok] || - [::http::ncode $token] != 200} { - set errorCode [list WS CLIENT HTTPERROR [::http::code $token]] - set errorInfo [FormatHTTPError $token] - ::http::cleanup $token - return \ - -code error \ - -errorcode $errorCode \ - $errorInfo - } - set wsdlInfo [ParseWsdl [::http::data $token] -headers $headers -serviceAlias $serviceAlias] - ::http::cleanup $token + set body [::WS::Utils::geturl_fetchbody $url] + } + set wsdlInfo [ParseWsdl $body -headers $headers -serviceAlias $serviceAlias] } default { return \ -code error \ -errorcode [list WS CLIENT UNKURLTYP $url] \ @@ -1287,46 +1265,18 @@ } if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } if {[llength $headers]} { - ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - } else { - ::log::log info [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] - } - ::http::wait $token - - ## - ## Check for errors - ## - set body [::http::data $token] - ::log::log info "\nReceived: $body" - if {![string equal [::http::status $token] ok] || - ([::http::ncode $token] != 200 && [string equal $body {}])} { - set errorCode [list WS CLIENT HTTPERROR [::http::code $token]] - set errorInfo {} - set results [FormatHTTPError $token] - set hadError 1 - } else { - set hadError 0 - set results [::http::data $token] - } - ::http::cleanup $token - if {$hadError} { - ::log::log debug "Leaving (error) ::WS::Client::DoRawCall" - return \ - -code error \ - -errorcode $errorCode \ - -errorinfo $errorInfo \ - $results - } else { - ::log::log debug "Leaving ::WS::Client::DoRawCall with {$results}" - return $results - } - + set body [::WS::Utils::geturl_fetchbody -bodyalwaysok 1\ + $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] + } else { + set body [::WS::Utils::geturl_fetchbody -bodyalwaysok 1\ + $url -query $query -type [dict get $serviceInfo contentType]] + } + ::log::log debug "Leaving ::WS::Client::DoRawCall with {$body}" + return $body } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure @@ -1412,31 +1362,25 @@ } if {[dict exists $serviceInfo operation $operationName action]} { lappend headers SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]] } if {[llength $headers]} { - ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] + set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { - ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ] + set token [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] ] } - ::http::wait $token ## ## Check for errors ## - set httpStatus [::http::status $token] - if {[string equal $httpStatus ok] && [::http::ncode $token] == 500} { - set body [::http::data $token] - ::log::log debug "\tReceived: $body" - set outTransform [dict get $serviceInfo outTransform] - if {![string equal $outTransform {}]} { - SaveAndSetOptions $serviceName - catch {set body [$outTransform $serviceName $operationName REPLY $body]} - RestoreSavedOptions $serviceName - } + set outTransform [dict get $serviceInfo outTransform] + if {![string equal $outTransform {}]} { + SaveAndSetOptions $serviceName + catch {set body [$outTransform $serviceName $operationName REPLY $body]} + RestoreSavedOptions $serviceName + } + if { $ncode == 500} { set hadError [catch {parseResults $serviceName $operationName $body} results] if {$hadError} { lassign $::errorCode mainError subError if {[string equal $mainError WSCLIENT] && [string equal $subError NOSOAP]} { ::log::log debug "\tHTTP error $body" @@ -1448,35 +1392,20 @@ ::log::log debug "Reply was $body" set errorCode $::errorCode set errorInfo $::errorInfo } } - } elseif {![string equal $httpStatus ok] || [::http::ncode $token] != 200} { - ::log::log debug "\tHTTP error [array get $token]" - set results [FormatHTTPError $token] - set errorCode [list WSCLIENT HTTPERROR [::http::code $token]] - set errorInfo {} - set hadError 1 } else { - set body [::http::data $token] - ::log::log debug "\tReceived: $body" - set outTransform [dict get $serviceInfo outTransform] - if {![string equal $outTransform {}]} { - SaveAndSetOptions $serviceName - catch {set body [$outTransform $serviceName $operationName REPLY $body]} - RestoreSavedOptions $serviceName - } SaveAndSetOptions $serviceName catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} RestoreSavedOptions $serviceName if {$hadError} { ::log::log debug "Reply was $body" set errorCode $::errorCode set errorInfo $::errorInfo } } - ::http::cleanup $token if {$hadError} { ::log::log debug "Leaving (error) ::WS::Client::DoCall" return \ -code error \ -errorcode $errorCode \ @@ -3206,45 +3135,18 @@ } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { - ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - } else { - ::log::log [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] - } - ::http::wait $token - - ## - ## Check for errors - ## - set body [::http::data $token] - if {![string equal [::http::status $token] ok] || - ([::http::ncode $token] != 200 && [string equal $body {}])} { - set errorCode [list WS CLIENT HTTPERROR [::http::code $token]] - set errorInfo {} - set results [FormatHTTPError $token] - set hadError 1 - } else { - set hadError 0 - set results [::http::data $token] - } - ::http::cleanup $token - if {$hadError} { - ::log::log debug "Leaving (error) ::WS::Client::DoRawRestCall" - return \ - -code error \ - -errorcode $errorCode \ - -errorinfo $errorInfo \ - $results - } else { - ::log::log debug "Leaving ::WS::Client::DoRawRestCall with {$results}" - return $results - } - + set body [geturl_fetchbody -bodyalwaysok 1\ + $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] + } else { + set body [geturl_fetchbody -bodyalwaysok 1\ + $url -query $query -type [dict get $serviceInfo contentType]] + } + ::log::log debug "Leaving ::WS::Client::DoRawRestCall with {$body}" + return $body } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure @@ -3331,60 +3233,25 @@ } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { - ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] - } else { - ::log::log info [list::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] - set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]] - } - ::http::wait $token - - ## - ## Check for errors - ## - set body [::http::data $token] - ::log::log info "\tReceived: $body" - set httpStatus [::http::status $token] - set hadError 0 - set results {} - if {![string equal $httpStatus ok] || - ([::http::ncode $token] != 200 && [string equal $body {}])} { - ::log::log debug "\tHTTP error [array get $token]" - set results [FormatHTTPError $token] - set errorCode [list WS CLIENT HTTPERROR [::http::code $token]] - set errorInfo {} - set hadError 1 - } else { - SaveAndSetOptions $serviceName - if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} { - RestoreSavedOptions $serviceName - return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err - } else { - RestoreSavedOptions $serviceName - } - if {$hadError} { - ::log::log debug "Reply was [::http::data $token]" - set errorCode $::errorCode - set errorInfo $::errorInfo - } - } - ::http::cleanup $token - if {$hadError} { - ::log::log debug "Leaving (error) ::WS::Client::DoRestCall" - return \ - -code error \ - -errorcode $errorCode \ - -errorinfo $errorInfo \ - $results - } else { - ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}" - return $results - } - + set body [geturl_fetchbody -bodyalwaysok 1\ + $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] + } else { + set body [geturl_fetchbody -bodyalwaysok 1\ + $url -query $query -type [dict get $serviceInfo contentType]] + } + SaveAndSetOptions $serviceName + if {[catch {parseRestResults $serviceName $objectName $operationName $body} results]} { + ::log::log debug "Reply was $body" + ::log::log debug "Leaving (error) ::WS::Client::DoRestCall" + return -code error $results + } + RestoreSavedOptions $serviceName + ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}" + return $results } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure Index: Utilities.tcl ================================================================== --- Utilities.tcl +++ Utilities.tcl @@ -4616,7 +4616,99 @@ set url [eval ::uri::join [array get uri]] ::log::log debug "url = $url" set finalUrl $url } # > 5 redirects reached -> exit with error - return -code error "http redirect limit exceeded" + return -errorcode [list WS CLIENT REDIRECTLIMIT $url]\ + -code error "http redirect limit exceeded for $url" +} +########################################################################### +# +# Private Procedure Header - as this procedure is modified, please be sure +# that you update this header block. Thanks. +# +#>>BEGIN PRIVATE<< +# +# Procedure Name : ::WS::Utils::geturl_fetchbody +# +# Description : fetch via http following redirects and return data or error +# +# Arguments : +# ?-codeok list? - list of acceptable http codes. +# If not given, 200 is used +# ?-codevar varname ? - Uplevel variable name to return current code +# value. +# ?-bodyalwaysok bool? - If a body is delivered any ncode is ok +# url - target document url +# args - additional argument list to http::geturl call +# +# Returns : fetched data +# +# Side-Effects : None +# +# Exception Conditions : None +# +# Pre-requisite Conditions : None +# +# Original Author : Harald Oehlmann +# +#>>END PRIVATE<< +# +# Maintenance History - as this file is modified, please be sure that you +# update this segment of the file header block by +# adding a complete entry at the bottom of the list. +# +# Version Date Programmer Comments / Changes / Reasons +# ------- ---------- ---------- ------------------------------------------- +# 1 11/08/2015 H.Oehlmann Initial version +# +########################################################################### +proc ::WS::Utils::geturl_fetchbody {args} { + set codeOkList {200} + set codeVar "" + set bodyAlwaysOk 0 + ::log::log info [concat ::WS::Utils::geturl_fetchbody $args] + if {[lindex $args 0] eq "-codeok"} { + set codeOkList [lindex $args 1] + set args [lrange $args 2 end] + } + if {[lindex $args 0] eq "-codevar"} { + set codeVar [lindex $args 1] + set args [lrange $args 2 end] + } + if {[lindex $args 0] eq "-bodyalwaysok"} { + set bodyAlwaysOk [lindex $args 1] + set args [lrange $args 2 end] + } + + set token [eval ::WS::Utils::geturl_followRedirects $args] + ::http::wait $token + if {[string equal [::http::status $token] ok]} { + if {[::http::size $token] == 0} { + ::log::log debug "\tHTTP error: no data" + ::http::cleanup $token + return -errorcode [list WS CLIENT NODATA [lindex $args 0]]\ + -code error "HTTP failure socket closed" + } + if {![string equal $codeVar ""]} { + upvar 1 $codeVar ncode + } + set ncode [::http::ncode $token] + set body [::http::data $token] + ::http::cleanup $token + if {$bodyAlwaysOk && ![string equal $body ""] + || -1 != [lsearch $codeOkList $ncode] + } { + # >> Fetch ok + ::log::log debug "\tReceived: $body" + return $body + } + ::log::log debug "\tHTTP error: Wrong code $ncode or no data" + return -code error -errorcode [list WS CLIENT HTTPERROR $ncode]\ + "HTTP failure code $ncode" + } + ::log::log debug "\tHTTP error [array get $token]" + set error [::http::error $token] + ::http::cleanup $token + return -errorcode [list WS CLIENT HTTPERROR $error]\ + -code error "HTTP error: $error" } Index: pkgIndex.tcl ================================================================== --- pkgIndex.tcl +++ pkgIndex.tcl @@ -6,11 +6,11 @@ # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. -package ifneeded WS::Client 2.3.8 [list source [file join $dir ClientSide.tcl]] +package ifneeded WS::Client 2.3.9 [list source [file join $dir ClientSide.tcl]] package ifneeded WS::Server 2.3.7 [list source [file join $dir ServerSide.tcl]] package ifneeded WS::Utils 2.3.10 [list source [file join $dir Utilities.tcl]] package ifneeded WS::Embeded 2.3.0 [list source [file join $dir Embedded.tcl]] package ifneeded WS::AOLserver 2.0.0 [list source [file join $dir AOLserver.tcl]]