Check-in [2e7e8c373f]
Not logged in
Home Documentation Downloads Timeline Files Branches Tags Tickets Wiki Login

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
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2e7e8c373fe09d14b7571efcf8c763fb0760b882
User & Date: oehhar 2016-10-31 15:46:48.027
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
Unified Diff Ignore Whitespace Patch
Changes to ClientSide.tcl. 
1
2

3
4
5
6
7
8
9

###############################################################################
##                                                                           ##

##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##



>








1
2
3
4
5
6
7
8
9
10

###############################################################################
##                                                                           ##
##  Copyright (c) 2016, Harald Oehlmann                                      ##
##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
︙︙
42
43
44
45
46
47
48






49
50
51
52
53
54



55
56

57
58
59
60
61
62
63
64
65

package require Tcl 8.4
package require WS::Utils 2.3.7 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
package require uri







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
    ##   objList  - list of operations
    ##   headers  - list of http headers








>
>
>
>
>
>
|
|
|
|
|
|
>
>
>
|
<
>

<








43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

66
67

68
69
70
71
72
73
74

package require Tcl 8.4
package require WS::Utils 2.3.7 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
package require uri

package provide WS::Client 2.3.8

namespace eval ::WS::Client {
    # register https only if not jet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        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"
        }
    } else {
        # Ok, was registered - reregister
        http::register https {*}$lPortCmd
    }

    unset -nocomplain err lPortCmd


    ##
    ## 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
    ##   objList  - list of operations
    ##   headers  - list of http headers
︙︙
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'"
        }








>
>
>
|
>
>
>
>
>
>
>








535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

        file {
            upvar #0 [::uri::geturl $url] token
            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'"
            }
        }
        default {
            return \
                -code error \
                -errorcode [list WS CLIENT UNKURLTYP $url] \
                "Unknown URL type '$url'"
        }
︙︙
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'"
        }








|

|

>
>
>
>
>
>
>
>
>
>
>
|
>








924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954

            upvar #0 [::uri::geturl $url] token
            set wsdlInfo [ParseWsdl $token(data) -headers $headers -serviceAlias $serviceAlias]
            unset token
        }
        http -
        https {
            if {[llength $headers]} {
                set token [::WS::Utils::geturl_followRedirects $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
        }
        default {
            return \
                -code error \
                -errorcode [list WS CLIENT UNKURLTYP $url] \
                "Unknown URL type '$url'"
        }
︙︙
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.
#








|
|

|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>








1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343

    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]} {
        ::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
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
︙︙
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








>
|

>
|

>




>
>
>
>
|
|
|
|
|
|
<















>
>
>
>
>
>

>
>
>
>
>
>
>
>









>








1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493

    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]} {
        ::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 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 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
            }
        }
    } 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 \
            -errorinfo $errorInfo \
            $results
︙︙
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.
#








|
|

|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>








3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
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
3260
3261

    } else {
        RestoreSavedOptions $serviceName
    }
    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
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
︙︙
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.
#








|
|

|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
|
>
>
>
>
>
>

>
|
>
>
>
|
<
|
|
>
>








3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390

3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401

    } else {
        RestoreSavedOptions $serviceName
    }
    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
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
︙︙
Utilities.tcl became executable.
︙︙
Fossil 2.26 [1205ec86cb] 2025-04-30 16:57:32