Check-in [2e7e8c373f]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Load and register tls only if no https handler was registered before
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2e7e8c373fe09d14b7571efcf8c763fb0760b882
User & Date: oehhar 2016-10-31 15:46:48
Context
2016-10-31 16:02
SOAP fault return: elemts faultcode and faultstring should not use own namesape. Ticket [b65828c8cc] check-in: fc39f59118 user: oehhar tags: trunk
2016-10-31 15:46
Load and register tls only if no https handler was registered before check-in: 2e7e8c373f user: oehhar tags: trunk
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

     1      1   ###############################################################################
     2      2   ##                                                                           ##
            3  +##  Copyright (c) 2016, Harald Oehlmann                                      ##
     3      4   ##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
     4      5   ##  Copyright (c) 2008, Georgios Petasis                                     ##
     5      6   ##  Copyright (c) 2006, Visiprise Software, Inc                              ##
     6      7   ##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
     7      8   ##  Copyright (c) 2006, Colin McCormack                                      ##
     8      9   ##  Copyright (c) 2006, Rolf Ade                                             ##
     9     10   ##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
................................................................................
    42     43   package require Tcl 8.4
    43     44   package require WS::Utils 2.3.7 ; # dict, lassign
    44     45   package require tdom 0.8
    45     46   package require http 2
    46     47   package require log
    47     48   package require uri
    48     49   
    49         -if {[catch {
    50         -    package require tls
    51         -    http::register https 443 [list ::tls::socket -ssl2 no -ssl3 no -tls1 yes]
    52         -} err]} {
    53         -    log::log warning "No https support: $err"
    54         -}
    55         -
    56         -package provide WS::Client 2.3.9
           50  +package provide WS::Client 2.3.8
    57     51   
    58     52   namespace eval ::WS::Client {
           53  +    # register https only if not jet registered
           54  +    if {[catch { http::unregister https } lPortCmd]} {
           55  +        # not registered -> register on my own
           56  +        if {[catch {
           57  +            package require tls
           58  +            http::register https 443 [list ::tls::socket -ssl2 no -ssl3 no -tls1 yes]
           59  +        } err]} {
           60  +            log::log warning "No https support: $err"
           61  +        }
           62  +    } else {
           63  +        # Ok, was registered - reregister
           64  +        http::register https {*}$lPortCmd
           65  +    }
           66  +    unset -nocomplain err lPortCmd
           67  +
    59     68       ##
    60     69       ## serviceArr is indexed by service name and contains a dictionary that
    61     70       ## defines the service.  The dictionary has the following structure:
    62     71       ##   targetNamespace - the target namespace
    63     72       ##   operList - list of operations
    64     73       ##   objList  - list of operations
    65     74       ##   headers  - list of http headers
................................................................................
   526    535           file {
   527    536               upvar #0 [::uri::geturl $url] token
   528    537               set xml $token(data)
   529    538               unset token
   530    539           }
   531    540           http -
   532    541           https {
   533         -            set xml [::WS::Utils::geturl_fetchbody $url]
          542  +            set token [::http::geturl $url]
          543  +            ::http::wait $token
          544  +            set ncode [::http::ncode $token]
          545  +            set xml [::http::data $token]
          546  +            ::http::cleanup $token
          547  +            if {$ncode != 200} {
          548  +                return \
          549  +                    -code error \
          550  +                    -errorcode [list WS CLIENT HTTPFAIL $url] \
          551  +                    "HTTP get of import file failed '$url'"
          552  +            }
   534    553           }
   535    554           default {
   536    555               return \
   537    556                   -code error \
   538    557                   -errorcode [list WS CLIENT UNKURLTYP $url] \
   539    558                   "Unknown URL type '$url'"
   540    559           }
................................................................................
   905    924               upvar #0 [::uri::geturl $url] token
   906    925               set wsdlInfo [ParseWsdl $token(data) -headers $headers -serviceAlias $serviceAlias]
   907    926               unset token
   908    927           }
   909    928           http -
   910    929           https {
   911    930               if {[llength $headers]} {
   912         -                set body [::WS::Utils::geturl_fetchbody $url -headers $headers]
          931  +                set token [::WS::Utils::geturl_followRedirects $url -headers $headers]
   913    932               } else {
   914         -                set body [::WS::Utils::geturl_fetchbody $url]
          933  +                set token [::WS::Utils::geturl_followRedirects $url]
   915    934               }
   916         -            set wsdlInfo [ParseWsdl $body -headers $headers -serviceAlias $serviceAlias]
          935  +            ::http::wait $token
          936  +            if {![string equal [::http::status $token] ok] ||
          937  +                [::http::ncode $token] != 200} {
          938  +                set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
          939  +                set errorInfo [FormatHTTPError $token]
          940  +                ::http::cleanup $token
          941  +                return \
          942  +                    -code error \
          943  +                    -errorcode $errorCode \
          944  +                    $errorInfo
          945  +            }
          946  +            set wsdlInfo [ParseWsdl [::http::data $token] -headers $headers -serviceAlias $serviceAlias]
          947  +            ::http::cleanup $token
   917    948           }
   918    949           default {
   919    950               return \
   920    951                   -code error \
   921    952                   -errorcode [list WS CLIENT UNKURLTYP $url] \
   922    953                   "Unknown URL type '$url'"
   923    954           }
................................................................................
  1263   1294       if {[dict exists $serviceInfo headers]} {
  1264   1295           set headers [concat $headers [dict get $serviceInfo headers]]
  1265   1296       }
  1266   1297       if {[dict exists $serviceInfo operation $operationName action]} {
  1267   1298           lappend headers  SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]]
  1268   1299       }
  1269   1300       if {[llength $headers]} {
  1270         -        set body [::WS::Utils::geturl_fetchbody -bodyalwaysok 1\
  1271         -            $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         1301  +        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         1302  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
  1272   1303       } else {
  1273         -        set body [::WS::Utils::geturl_fetchbody -bodyalwaysok 1\
  1274         -            $url -query $query -type [dict get $serviceInfo contentType]]
         1304  +        ::log::log info [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
         1305  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
  1275   1306       }
  1276         -    ::log::log debug "Leaving ::WS::Client::DoRawCall with {$body}"
  1277         -    return $body
         1307  +    ::http::wait $token
         1308  +
         1309  +    ##
         1310  +    ## Check for errors
         1311  +    ##
         1312  +    set body [::http::data $token]
         1313  +    ::log::log info "\nReceived: $body"
         1314  +    if {![string equal [::http::status $token] ok] ||
         1315  +        ([::http::ncode $token] != 200 && [string equal $body {}])} {
         1316  +        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
         1317  +        set errorInfo {}
         1318  +        set results [FormatHTTPError $token]
         1319  +        set hadError 1
         1320  +    } else {
         1321  +        set hadError 0
         1322  +        set results [::http::data $token]
         1323  +    }
         1324  +    ::http::cleanup $token
         1325  +    if {$hadError} {
         1326  +        ::log::log debug "Leaving (error) ::WS::Client::DoRawCall"
         1327  +        return \
         1328  +            -code error \
         1329  +            -errorcode $errorCode \
         1330  +            -errorinfo $errorInfo \
         1331  +            $results
         1332  +    } else {
         1333  +        ::log::log debug "Leaving ::WS::Client::DoRawCall with {$results}"
         1334  +        return $results
         1335  +    }
         1336  +
  1278   1337   }
  1279   1338   
  1280   1339   ###########################################################################
  1281   1340   #
  1282   1341   # Public Procedure Header - as this procedure is modified, please be sure
  1283   1342   #                           that you update this header block. Thanks.
  1284   1343   #
................................................................................
  1360   1419       if {[dict exists $serviceInfo headers]} {
  1361   1420           set headers [concat $headers [dict get $serviceInfo headers]]
  1362   1421       }
  1363   1422       if {[dict exists $serviceInfo operation $operationName action]} {
  1364   1423           lappend headers  SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]]
  1365   1424       }
  1366   1425       if {[llength $headers]} {
  1367         -        set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         1426  +        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         1427  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
  1368   1428       } else {
  1369         -        set token [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] ]
         1429  +        ::log::log info  [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType]  ]
         1430  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ]
  1370   1431       }
         1432  +    ::http::wait $token
  1371   1433   
  1372   1434       ##
  1373   1435       ## Check for errors
  1374   1436       ##
  1375         -    set outTransform [dict get $serviceInfo outTransform]
  1376         -    if {![string equal $outTransform {}]} {
  1377         -        SaveAndSetOptions $serviceName
  1378         -        catch {set body [$outTransform $serviceName $operationName REPLY $body]}
  1379         -        RestoreSavedOptions $serviceName
  1380         -    }
  1381         -    if { $ncode == 500} {
         1437  +    set httpStatus [::http::status $token]
         1438  +    if {[string equal $httpStatus ok] && [::http::ncode $token] == 500} {
         1439  +        set body [::http::data $token]
         1440  +        ::log::log debug "\tReceived: $body"
         1441  +        set outTransform [dict get $serviceInfo outTransform]
         1442  +        if {![string equal $outTransform {}]} {
         1443  +            SaveAndSetOptions $serviceName
         1444  +            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
         1445  +            RestoreSavedOptions $serviceName
         1446  +        }
  1382   1447           set hadError [catch {parseResults $serviceName $operationName $body} results]
  1383   1448           if {$hadError} {
  1384   1449               lassign $::errorCode mainError subError
  1385   1450               if {[string equal $mainError WSCLIENT] && [string equal $subError NOSOAP]} {
  1386   1451                   ::log::log debug "\tHTTP error $body"
  1387   1452                   set results $body
  1388   1453                   set errorCode [list WSCLIENT HTTPERROR $body]
................................................................................
  1390   1455                   set hadError 1
  1391   1456               } else {
  1392   1457                   ::log::log debug "Reply was $body"
  1393   1458                   set errorCode $::errorCode
  1394   1459                   set errorInfo $::errorInfo
  1395   1460               }
  1396   1461           }
         1462  +    } elseif {![string equal $httpStatus ok] || [::http::ncode $token] != 200} {
         1463  +        ::log::log debug "\tHTTP error [array get $token]"
         1464  +        set results [FormatHTTPError $token]
         1465  +        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
         1466  +        set errorInfo {}
         1467  +        set hadError 1
  1397   1468       } else {
         1469  +        set body [::http::data $token]
         1470  +        ::log::log debug "\tReceived: $body"
         1471  +        set outTransform [dict get $serviceInfo outTransform]
         1472  +        if {![string equal $outTransform {}]} {
         1473  +            SaveAndSetOptions $serviceName
         1474  +            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
         1475  +            RestoreSavedOptions $serviceName
         1476  +        }
  1398   1477           SaveAndSetOptions $serviceName
  1399   1478           catch {set hadError [catch {parseResults $serviceName $operationName $body} results]}
  1400   1479           RestoreSavedOptions $serviceName
  1401   1480           if {$hadError} {
  1402   1481               ::log::log debug "Reply was $body"
  1403   1482               set errorCode $::errorCode
  1404   1483               set errorInfo $::errorInfo
  1405   1484           }
  1406   1485       }
         1486  +    ::http::cleanup $token
  1407   1487       if {$hadError} {
  1408   1488           ::log::log debug "Leaving (error) ::WS::Client::DoCall"
  1409   1489           return \
  1410   1490               -code error \
  1411   1491               -errorcode $errorCode \
  1412   1492               -errorinfo $errorInfo \
  1413   1493               $results
................................................................................
  3133   3213       } else {
  3134   3214           RestoreSavedOptions $serviceName
  3135   3215       }
  3136   3216       if {[dict exists $serviceInfo headers]} {
  3137   3217           set headers [concat $headers [dict get $serviceInfo headers]]
  3138   3218       }
  3139   3219       if {[llength $headers]} {
  3140         -        set body [geturl_fetchbody -bodyalwaysok 1\
  3141         -            $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         3220  +        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         3221  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         3222  +    } else {
         3223  +        ::log::log [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
         3224  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
         3225  +    }
         3226  +    ::http::wait $token
         3227  +
         3228  +    ##
         3229  +    ## Check for errors
         3230  +    ##
         3231  +    set body [::http::data $token]
         3232  +    if {![string equal [::http::status $token] ok] ||
         3233  +        ([::http::ncode $token] != 200 && [string equal $body {}])} {
         3234  +        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
         3235  +        set errorInfo {}
         3236  +        set results [FormatHTTPError $token]
         3237  +        set hadError 1
         3238  +    } else {
         3239  +        set hadError 0
         3240  +        set results [::http::data $token]
         3241  +    }
         3242  +    ::http::cleanup $token
         3243  +    if {$hadError} {
         3244  +        ::log::log debug "Leaving (error) ::WS::Client::DoRawRestCall"
         3245  +        return \
         3246  +            -code error \
         3247  +            -errorcode $errorCode \
         3248  +            -errorinfo $errorInfo \
         3249  +            $results
  3142   3250       } else {
  3143         -        set body [geturl_fetchbody -bodyalwaysok 1\
  3144         -            $url -query $query -type [dict get $serviceInfo contentType]]
         3251  +        ::log::log debug "Leaving ::WS::Client::DoRawRestCall with {$results}"
         3252  +        return $results
  3145   3253       }
  3146         -    ::log::log debug "Leaving ::WS::Client::DoRawRestCall with {$body}"
  3147         -    return $body
         3254  +
  3148   3255   }
  3149   3256   
  3150   3257   ###########################################################################
  3151   3258   #
  3152   3259   # Public Procedure Header - as this procedure is modified, please be sure
  3153   3260   #                           that you update this header block. Thanks.
  3154   3261   #
................................................................................
  3231   3338       } else {
  3232   3339           RestoreSavedOptions $serviceName
  3233   3340       }
  3234   3341       if {[dict exists $serviceInfo headers]} {
  3235   3342           set headers [concat $headers [dict get $serviceInfo headers]]
  3236   3343       }
  3237   3344       if {[llength $headers]} {
  3238         -        set body [geturl_fetchbody -bodyalwaysok 1\
  3239         -            $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         3345  +        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         3346  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
         3347  +    } else {
         3348  +        ::log::log info [list::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
         3349  +        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
         3350  +    }
         3351  +    ::http::wait $token
         3352  +
         3353  +    ##
         3354  +    ## Check for errors
         3355  +    ##
         3356  +    set body [::http::data $token]
         3357  +    ::log::log info "\tReceived: $body"
         3358  +    set httpStatus [::http::status $token]
         3359  +    set hadError 0
         3360  +    set results {}
         3361  +    if {![string equal $httpStatus ok] ||
         3362  +        ([::http::ncode $token] != 200 && [string equal $body {}])} {
         3363  +        ::log::log debug "\tHTTP error [array get $token]"
         3364  +        set results [FormatHTTPError $token]
         3365  +        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
         3366  +        set errorInfo {}
         3367  +        set hadError 1
  3240   3368       } else {
  3241         -        set body [geturl_fetchbody -bodyalwaysok 1\
  3242         -            $url -query $query -type [dict get $serviceInfo contentType]]
         3369  +        SaveAndSetOptions $serviceName
         3370  +        if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
         3371  +            RestoreSavedOptions $serviceName
         3372  +            return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
         3373  +        } else {
         3374  +            RestoreSavedOptions $serviceName
         3375  +        }
         3376  +        if {$hadError} {
         3377  +            ::log::log debug "Reply was [::http::data $token]"
         3378  +            set errorCode $::errorCode
         3379  +            set errorInfo $::errorInfo
         3380  +        }
  3243   3381       }
  3244         -    SaveAndSetOptions $serviceName
  3245         -    if {[catch {parseRestResults $serviceName $objectName $operationName $body} results]} {
  3246         -        ::log::log debug "Reply was $body"
         3382  +    ::http::cleanup $token
         3383  +    if {$hadError} {
  3247   3384           ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
  3248         -        return -code error $results
         3385  +        return \
         3386  +            -code error \
         3387  +            -errorcode $errorCode \
         3388  +            -errorinfo $errorInfo \
         3389  +            $results
         3390  +    } else {
         3391  +        ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}"
         3392  +        return $results
  3249   3393       }
  3250         -    RestoreSavedOptions $serviceName
  3251         -    ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}"
  3252         -    return $results
         3394  +
  3253   3395   }
  3254   3396   
  3255   3397   ###########################################################################
  3256   3398   #
  3257   3399   # Public Procedure Header - as this procedure is modified, please be sure
  3258   3400   #                           that you update this header block. Thanks.
  3259   3401   #

Utilities.tcl became executable.