Changes On Branch unify_http::geturl
Not logged in
Home Documentation Downloads Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

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
56

57
58
59
60
61
62
63

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.8
package provide WS::Client 2.3.9

namespace eval ::WS::Client {
    ##
    ## serviceArr is indexed by service name and contains a dictionary that
    ## defines the service.  The dictionary has the following structure:
    ##   targetNamespace - the target namespace
    ##   operList - list of operations
︙
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

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 token [::http::geturl $url]
            ::http::wait $token
            set ncode [::http::ncode $token]
            set xml [::http::data $token]
            set xml [::WS::Utils::geturl_fetchbody $url]
            ::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'"
        }
︙
915
916
917
918
919
920
921
922

923
924

925
926
927
928
929
930
931
932
933
934
935
936
937

938
939
940
941
942
943
944
945

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 token [::WS::Utils::geturl_followRedirects $url -headers $headers]
                set body [::WS::Utils::geturl_fetchbody $url -headers $headers]
            } else {
                set token [::WS::Utils::geturl_followRedirects $url]
                set body [::WS::Utils::geturl_fetchbody $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]
            set wsdlInfo [ParseWsdl $body -headers $headers -serviceAlias $serviceAlias]
            ::http::cleanup $token
        }
        default {
            return \
                -code error \
                -errorcode [list WS CLIENT UNKURLTYP $url] \
                "Unknown URL type '$url'"
        }
︙
1285
1286
1287
1288
1289
1290
1291
1292
1293


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

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]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set body [::WS::Utils::geturl_fetchbody -bodyalwaysok 1\
            $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]]
        set body [::WS::Utils::geturl_fetchbody -bodyalwaysok 1\
            $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
    ::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
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
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

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]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set body [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        ::log::log info  [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType]  ]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] ]
        set token [::WS::Utils::geturl_fetchbody -codeok {200 500} -codevar ncode $url -query $query -type [dict get $serviceInfo contentType] ]
    }
    ::http::wait $token

    ##
    ## Check for errors
    ##
    set httpStatus [::http::status $token]
    if {[string equal $httpStatus ok] && [::http::ncode $token] == 500} {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set outTransform [dict get $serviceInfo outTransform]
        if {![string equal $outTransform {}]} {
            SaveAndSetOptions $serviceName
            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
            RestoreSavedOptions $serviceName
        }
    set outTransform [dict get $serviceInfo outTransform]
    if {![string equal $outTransform {}]} {
        SaveAndSetOptions $serviceName
        catch {set body [$outTransform $serviceName $operationName REPLY $body]}
        RestoreSavedOptions $serviceName
    }
    if { $ncode == 500} {
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        if {$hadError} {
            lassign $::errorCode mainError subError
            if {[string equal $mainError WSCLIENT] && [string equal $subError NOSOAP]} {
                ::log::log debug "\tHTTP error $body"
                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
︙
3204
3205
3206
3207
3208
3209
3210
3211
3212


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

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]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set body [geturl_fetchbody -bodyalwaysok 1\
            $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]]
        set body [geturl_fetchbody -bodyalwaysok 1\
            $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
    ::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
3336
3337


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

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]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
        set body [geturl_fetchbody -bodyalwaysok 1\
            $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        ::log::log info [list::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType]]
        set body [geturl_fetchbody -bodyalwaysok 1\
            $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]} {
    SaveAndSetOptions $serviceName
    if {[catch {parseRestResults $serviceName $objectName $operationName $body} results]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            ::log::log debug "Reply was [::http::data $token]"
        ::log::log debug "Reply was $body"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    ::http::cleanup $token
    if {$hadError} {
        ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
        return \
            -code error \
        return -code error $results
            -errorcode $errorCode \
            -errorinfo $errorInfo \
            $results
    }
    RestoreSavedOptions $serviceName
    } else {
        ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}"
        return $results
    ::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

4621




























































































4622

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]\
    return -code error "http redirect limit exceeded"
            -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
11

12
13
14
15
16
17
18

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.8  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Client 2.3.9  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Server 2.3.7  [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.3.10 [list source [file join $dir Utilities.tcl]]

package ifneeded WS::Embeded 2.3.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::AOLserver 2.0.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.0.0 [list source [file join $dir ChannelServer.tcl]]
︙

Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19