Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch unify_http::geturl Excluding Merge-Ins
This is equivalent to a diff from c7cdb73c8f to 0f7ac08844
2016-03-03 21:09 | Unify all synchronous calls to http::geturl with error handling by utility function geturl_followRedirects check-in: f1d6d9f8d9 user: oehhar tags: trunk | |
2015-11-09 17:25 | Unify all synchronous calls to http::geturl with error handling by utility function geturl_followRedirects Closed-Leaf check-in: 0f7ac08844 user: oehhar tags: unify_http::geturl | |
2015-11-09 16:24 | restore deleted debug line check-in: c7cdb73c8f user: oehhar tags: trunk | |
2015-11-09 16:19 | Removed own debugging message, sorry check-in: 0cda2c9b1d user: oehhar tags: trunk | |
Changes to ClientSide.tcl.
︙ | ︙ | |||
49 50 51 52 53 54 55 | if {[catch { package require tls http::register https 443 [list ::tls::socket -ssl2 no -ssl3 no -tls1 yes] } err]} { log::log warning "No https support: $err" } | | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | if {[catch { package require tls 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.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: ## targetNamespace - the target namespace ## operList - list of operations |
︙ | ︙ | |||
526 527 528 529 530 531 532 | file { upvar #0 [::uri::geturl $url] token set xml $token(data) unset token } http - https { | < < < | < < < < < < < | 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 | file { upvar #0 [::uri::geturl $url] token set xml $token(data) unset token } http - https { set xml [::WS::Utils::geturl_fetchbody $url] } default { return \ -code error \ -errorcode [list WS CLIENT UNKURLTYP $url] \ "Unknown URL type '$url'" } |
︙ | ︙ | |||
915 916 917 918 919 920 921 | upvar #0 [::uri::geturl $url] token set wsdlInfo [ParseWsdl $token(data) -headers $headers -serviceAlias $serviceAlias] unset token } http - https { if {[llength $headers]} { | | | < < < < < < < < < < < | < | 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 | upvar #0 [::uri::geturl $url] token set wsdlInfo [ParseWsdl $token(data) -headers $headers -serviceAlias $serviceAlias] unset token } http - https { if {[llength $headers]} { set body [::WS::Utils::geturl_fetchbody $url -headers $headers] } else { 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] \ "Unknown URL type '$url'" } |
︙ | ︙ | |||
1285 1286 1287 1288 1289 1290 1291 | 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]] } if {[llength $headers]} { | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < | 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 | 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]] } if {[llength $headers]} { 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 # that you update this header block. Thanks. # |
︙ | ︙ | |||
1410 1411 1412 1413 1414 1415 1416 | 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]] } if {[llength $headers]} { | < | < | < < < < < | | | | | | > < < < < < < < < < < < < < < < | 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 | 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]] } if {[llength $headers]} { set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers] } else { set token [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] ] } ## ## Check for errors ## 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" set results $body set errorCode [list WSCLIENT HTTPERROR $body] set errorInfo {} set hadError 1 } else { ::log::log debug "Reply was $body" set errorCode $::errorCode set errorInfo $::errorInfo } } } else { 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 } } if {$hadError} { ::log::log debug "Leaving (error) ::WS::Client::DoCall" return \ -code error \ -errorcode $errorCode \ -errorinfo $errorInfo \ $results |
︙ | ︙ | |||
3204 3205 3206 3207 3208 3209 3210 | } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < | | < < | 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 | } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { 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 # that you update this header block. Thanks. # |
︙ | ︙ | |||
3329 3330 3331 3332 3333 3334 3335 | } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { | | | | | < < < < < < < < < < < < < < < < < < | | < < < < < < | < < < < < < < | < < > | < | | < < | 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 | } else { RestoreSavedOptions $serviceName } if {[dict exists $serviceInfo headers]} { set headers [concat $headers [dict get $serviceInfo headers]] } if {[llength $headers]} { 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 # that you update this header block. Thanks. # |
︙ | ︙ |
Changes to Utilities.tcl.
︙ | ︙ | |||
4614 4615 4616 4617 4618 4619 4620 | } # problem w/ relative versus absolute paths set url [eval ::uri::join [array get uri]] ::log::log debug "url = $url" set finalUrl $url } # > 5 redirects reached -> exit with error | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 | } # problem w/ relative versus absolute paths set url [eval ::uri::join [array get uri]] ::log::log debug "url = $url" set finalUrl $url } # > 5 redirects reached -> exit with error 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" } |
Changes to pkgIndex.tcl.
1 2 3 4 5 6 7 8 9 10 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # 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. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # 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.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]] package ifneeded WS::Channel 2.0.0 [list source [file join $dir ChannelServer.tcl]] |
︙ | ︙ |