Check-in [118a1dadf5]
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 tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:Use utility function ::WS::Utils::geturl_fetchbody for http::geturl calls which handles errors and follows redirects. Exception are calls with a -command argument
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:118a1dadf594aca915adca5ad71fc974dc0f5ee4
User & Date: oehhar 2017-08-31 08:51:59
Context
2017-08-31 09:05
The response node name may also be the output name and not only the output type [21f41e22bc] check-in: 6e84da1680 user: oehhar tags: trunk
2017-08-31 08:51
Use utility function ::WS::Utils::geturl_fetchbody for http::geturl calls which handles errors and follows redirects. Exception are calls with a -command argument check-in: 118a1dadf5 user: oehhar tags: trunk
2017-08-31 08:41
Correct errors found by static analyser. Some documentation help for static analyser too check-in: 6e8f96d585 user: oehhar tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
...
521
522
523
524
525
526
527



528
529
530
531
532
533
534
...
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
...
908
909
910
911
912
913
914
915

916
917
918
919
920
921
922
...
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
....
1262
1263
1264
1265
1266
1267
1268



1269
1270
1271
1272
1273
1274
1275
....
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
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
....
1391
1392
1393
1394
1395
1396
1397



1398
1399
1400
1401
1402
1403
1404
....
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
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
....
3193
3194
3195
3196
3197
3198
3199



3200
3201
3202
3203
3204
3205
3206
....
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
....
3328
3329
3330
3331
3332
3333
3334



3335
3336
3337
3338
3339
3340
3341
....
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395

3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409

3410

3411

3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431


3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
package require Tcl 8.4
package require WS::Utils 2.4 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
package require uri

package provide WS::Client 2.4.0

namespace eval ::WS::Client {
    # register https only if not yet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls
................................................................................
# 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  01/30/2009  G.Lester     Initial version



#
#
###########################################################################
proc ::WS::Client::ImportNamespace {serviceName url} {
    variable serviceArr

    switch -exact -- [dict get [::uri::split $url] scheme] {
................................................................................
        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'"
        }
................................................................................
# 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  07/06/2006  G.Lester     Initial version
#

#
###########################################################################
proc ::WS::Client::GetAndParseWsdl {url {headers {}} {serviceAlias {}}} {
    variable currentBaseUrl

    set currentBaseUrl $url
    switch -exact -- [dict get [::uri::split $url] scheme] {
................................................................................
            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 {[::http::status $token] ne {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'"
        }
................................................................................
# 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  07/06/2006  G.Lester     Initial version



#
#
###########################################################################
proc ::WS::Client::DoRawCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoRawCall {$serviceName $operationName $argList}"
................................................................................
    }
    
    ##
    ## do http call
    ##
    
    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 {[::http::status $token] ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        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.
................................................................................
# 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  07/06/2006  G.Lester     Initial version



#
#
###########################################################################
proc ::WS::Client::DoCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoCall {$serviceName $operationName $argList}"
................................................................................
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]]
    }
    ##
    ## Do the http request
    ##

    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 {$httpStatus eq {ok} && [::http::ncode $token] == 500} {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set outTransform [dict get $serviceInfo outTransform]


        if {$outTransform ne {}} {
            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 {$mainError eq WSCLIENT && $subError eq 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 {$httpStatus ne {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 {$outTransform ne {}} {
            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
................................................................................
# 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  07/06/2006  G.Lester     Initial version



#
#
###########################################################################
proc ::WS::Client::DoRawRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::log debug "Entering [info level 0]"
................................................................................
    }
    
    ##
    ## do http call
    ##
    
    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 {[::http::status $token] ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        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.
................................................................................
# 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  07/06/2006  G.Lester     Initial version



#
#
###########################################################################
proc ::WS::Client::DoRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::log debug "Entering [info level 0]"
................................................................................
    ## Do http call
    ##
    
    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 {$httpStatus ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        ::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.







|







 







>
>
>







 







|
<
<
<
<
<
<
<
<
<
<







 







|
>







 







|

|

<
<
<
<
<
<
<
<
<
<
<
|
<







 







>
>
>







 







<
|

<
|

<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<







 







>
>
>







 







>

<
|

<
|

<
>


<
>

<
<
<
<
|
>
>








|




<






<
<
<
<
<
<

<
<
<






|







<







 







>
>
>







 







<
|

<
|

<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<







 







>
>
>







 







<
|

<
|

<


<
>

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

<
|
<
<
<
<
>
>
|
|
<







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
...
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
...
538
539
540
541
542
543
544
545










546
547
548
549
550
551
552
...
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
...
918
919
920
921
922
923
924
925
926
927
928











929

930
931
932
933
934
935
936
....
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
....
1292
1293
1294
1295
1296
1297
1298

1299
1300

1301
1302

1303
























1304
1305

1306
1307
1308
1309
1310
1311
1312
....
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
....
1394
1395
1396
1397
1398
1399
1400
1401
1402

1403
1404

1405
1406

1407
1408
1409

1410
1411




1412
1413
1414
1415
1416
1417
1418
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
....
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
....
3194
3195
3196
3197
3198
3199
3200

3201
3202

3203
3204

3205























3206
3207

3208
3209
3210
3211
3212
3213
3214
....
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
....
3304
3305
3306
3307
3308
3309
3310

3311
3312

3313
3314

3315
3316

3317
3318













3319
3320
3321
3322
3323
3324












3325

3326




3327
3328
3329
3330

3331
3332
3333
3334
3335
3336
3337
package require Tcl 8.4
package require WS::Utils 2.4 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
package require uri

package provide WS::Client 2.4.1

namespace eval ::WS::Client {
    # register https only if not yet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls
................................................................................
# 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  01/30/2009  G.Lester     Initial version
# 2.4.1    2017-08-31  H.Oehlmann   Use utility function
#                                   ::WS::Utils::geturl_fetchbody for http call
#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::ImportNamespace {serviceName url} {
    variable serviceArr

    switch -exact -- [dict get [::uri::split $url] scheme] {
................................................................................
        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'"
        }
................................................................................
# 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  07/06/2006  G.Lester     Initial version
# 2.4.1    2017-08-31  H.Oehlmann   Use utility function
#                                   ::WS::Utils::geturl_fetchbody for http call
#
###########################################################################
proc ::WS::Client::GetAndParseWsdl {url {headers {}} {serviceAlias {}}} {
    variable currentBaseUrl

    set currentBaseUrl $url
    switch -exact -- [dict get [::uri::split $url] scheme] {
................................................................................
            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'"
        }
................................................................................
# 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  07/06/2006  G.Lester     Initial version
# 2.4.1    2017-08-31  H.Oehlmann   Use utility function
#                                   ::WS::Utils::geturl_fetchbody for http call
#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::DoRawCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoRawCall {$serviceName $operationName $argList}"
................................................................................
    }
    
    ##
    ## do http call
    ##
    
    if {[llength $headers]} {

        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {

        set body [::WS::Utils::geturl_fetchbody $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.
................................................................................
# 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  07/06/2006  G.Lester     Initial version
# 2.4.1    2017-08-30  H.Oehlmann   Use ::WS::Utils::geturl_fetchbody to do
#                                   http call. This automates a lot and follows
#                                   redirects.
#
#
###########################################################################
proc ::WS::Client::DoCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoCall {$serviceName $operationName $argList}"
................................................................................
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [format {"%s"} [dict get $serviceInfo operation $operationName action]]
    }
    ##
    ## Do the http request
    ##
    # This will directly return with correct error
    if {[llength $headers]} {

        set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar httpCode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {

        set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar httpCode $url -query $query -type [dict get $serviceInfo contentType] ]
    }

    # numerical http code was saved in variable httpCode

    ##

    ## Process body
    ##




    set outTransform [dict get $serviceInfo outTransform]
    if {$httpCode == 500} {
        ## Code 500 treatment
        if {$outTransform ne {}} {
            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 {$mainError eq {WSCLIENT} && $subError eq {NOSOAP}} {
                ::log::log debug "\tHTTP error $body"
                set results $body
                set errorCode [list WSCLIENT HTTPERROR $body]
                set errorInfo {}

            } else {
                ::log::log debug "Reply was $body"
                set errorCode $::errorCode
                set errorInfo $::errorInfo
            }
        }






    } else {



        if {$outTransform ne {}} {
            SaveAndSetOptions $serviceName
            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
            RestoreSavedOptions $serviceName
        }
        SaveAndSetOptions $serviceName
        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
................................................................................
# 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  07/06/2006  G.Lester     Initial version
# 2.4.1    2017-08-31  H.Oehlmann   Use utility function
#                                   ::WS::Utils::geturl_fetchbody for http call
#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::DoRawRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::log debug "Entering [info level 0]"
................................................................................
    }
    
    ##
    ## do http call
    ##
    
    if {[llength $headers]} {

        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {

        set body [::WS::Utils::geturl_fetchbody $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.
................................................................................
# 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  07/06/2006  G.Lester     Initial version
# 2.4.1    2017-08-31  H.Oehlmann   Use utility function
#                                   ::WS::Utils::geturl_fetchbody for http call
#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::DoRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::log debug "Entering [info level 0]"
................................................................................
    ## Do http call
    ##
    
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {

        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {

        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }


    ##

    ## Parse results
    ##













    
    SaveAndSetOptions $serviceName
    if {[catch {
        parseRestResults $serviceName $objectName $operationName $body
    } results]} {
        RestoreSavedOptions $serviceName












        ::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 pkgIndex.tcl.

6
7
8
9
10
11
12
13
14
15
16
17
18
# 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::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.4.0 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.4.0 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]







|





6
7
8
9
10
11
12
13
14
15
16
17
18
# 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::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.4.1 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.4.0 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]