Tcl Library Source Code

Check-in [87b07c73c6]
Login
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:rest <E> - Tkt [284fd715e4] - Accepted patch to return response body of error result, if requested by the call's configuration. Modified the patch to fix a bug in its handling of redirections, the location information got lost. Documented the full callback behaviour now. Bumped version to 1.2.
Timelines: family | ancestors | descendants | both | rest-tkt-284fd715e4
Files: files | file ages | folders
SHA1: 87b07c73c6bbdd6cd86b671a1d506679cd70efbe
User & Date: aku 2016-03-02 05:44:47
References
2016-03-02
05:48 Ticket [284fd715e4] Return $result on HTTP Error status still Open with 4 other changes artifact: a0c264dab3 user: aku
Context
2016-03-03
06:24
rest <E> - Tkt [284fd715e4] - Merged fix check-in: 9703590256 user: aku tags: trunk
2016-03-02
05:44
rest <E> - Tkt [284fd715e4] - Accepted patch to return response body of error result, if requested by the call's configuration. Modified the patch to fix a bug in its handling of redirections, the location information got lost. Documented the full callback behaviour now. Bumped version to 1.2. Closed-Leaf check-in: 87b07c73c6 user: aku tags: rest-tkt-284fd715e4
04:59
Added github-specific templates for issues and pull-requests (See https://github.com/blog/2111-issue-and-pull-request-templates) to direct people to the correct location for dev. check-in: cd04484640 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/rest/pkgIndex.tcl.

1
2
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded rest 1.0.2 [list source [file join $dir rest.tcl]]
|
1
2
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded rest 1.2 [list source [file join $dir rest.tcl]]

Changes to modules/rest/rest.man.

1
2
3
4
5
6
7
8
9
..
46
47
48
49
50
51
52

53
54
55
56
57
58
59
...
335
336
337
338
339
340
341
342
343
344
345



346
347







348
349
350
351
352
353
354
355
...
434
435
436
437
438
439
440









441
442
443
444
445
446
447
[comment {-*- tcl -*- doctools manpage}]
[vset VERSION 1.1]
[manpage_begin rest n [vset VERSION]]
[moddesc   {A framework for RESTful web services}]
[titledesc {define REST web APIs and call them inline or asychronously}]
[require Tcl 8.5]
[require rest [opt [vset VERSION]]]
[description]

................................................................................

[para] The [arg config] dictionary supports the following keys

[list_begin definitions]
[def [const auth]]
[def [const content-type]]
[def [const cookie]]

[def [const format]]
[def [const headers]]
[def [const method]]

[comment {-- TODO -- describe the meaning of the various keys -- }]
[list_end]

................................................................................
[def [const callback]]

If this option is present then the method will be created as an
[term async] call. Such calls will return immediately with the value
of the associated http token instead of the call's result. The event
loop must be active to use this option.

[para] The value of this option is treated as a command prefix which is
invoked when the HTTP call is complete. The prefix will receive three
additional arguments, the name of the calling procedure, the status of
the result (one of [const OK] or [const ERROR]), and the data associated



with the result, in this order.








The http request header will be available in that procedure via
[cmd {upvar token token}].

[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@]
[def [const cookie]]

The value of this option is a list of cookies to be passed in the http
header. This is a shortcut to the [const headers] option.
................................................................................
[para] The first expression is checks the OK condition, it must return
[const true] when the result is satisfactory, and [const false]
otherwise.

[para] The second expression is the ERROR condition, it must return
[const false] unless there is an error, then it has to return
[const true].










[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@]
[list_end]

[list_end][comment {-- end of command list --}]

[section Examples]
|







 







>







 







|
|
|
|
>
>
>
|

>
>
>
>
>
>
>
|







 







>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
..
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
...
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
[comment {-*- tcl -*- doctools manpage}]
[vset VERSION 1.2]
[manpage_begin rest n [vset VERSION]]
[moddesc   {A framework for RESTful web services}]
[titledesc {define REST web APIs and call them inline or asychronously}]
[require Tcl 8.5]
[require rest [opt [vset VERSION]]]
[description]

................................................................................

[para] The [arg config] dictionary supports the following keys

[list_begin definitions]
[def [const auth]]
[def [const content-type]]
[def [const cookie]]
[def [const error-body]]
[def [const format]]
[def [const headers]]
[def [const method]]

[comment {-- TODO -- describe the meaning of the various keys -- }]
[list_end]

................................................................................
[def [const callback]]

If this option is present then the method will be created as an
[term async] call. Such calls will return immediately with the value
of the associated http token instead of the call's result. The event
loop must be active to use this option.

[para] The value of this option is treated as a command prefix which
is invoked when the HTTP call is complete. The prefix will receive at
least two additional arguments, the name of the calling procedure and
the status of the result (one of [const OK] or [const ERROR]), in this
order.

[para] In case of [const OK] a third argument is added, the data
associated with the result.

[para] If and only if the [const ERROR] is a redirection, the location
redirected to will be added as argument.

Further, if the configuration key [const error-body] is set to
[const true] the data associated with the result will be added as
argument as well.

[para] The http request header will be available in that procedure via
[cmd {upvar token token}].

[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@]
[def [const cookie]]

The value of this option is a list of cookies to be passed in the http
header. This is a shortcut to the [const headers] option.
................................................................................
[para] The first expression is checks the OK condition, it must return
[const true] when the result is satisfactory, and [const false]
otherwise.

[para] The second expression is the ERROR condition, it must return
[const false] unless there is an error, then it has to return
[const true].

[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@]
[def [const error_body]]

The value of this option determines whether to return the response
when encountering an HTTP error, or not. The default is to not return
the response body on error.

[para] See [const callback] above for more information.

[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@]
[list_end]

[list_end][comment {-- end of command list --}]

[section Examples]

Changes to modules/rest/rest.tcl.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
65
66
67
68
69
70
71




72

73
74
75
76
77
78
79
80
...
185
186
187
188
189
190
191






192
193
194
195
196
197
198
...
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
454
455
456
457
458
459
460
461


462
463

464


465
466

467
468
469
470

471
472
473

474
475

476
477
478
479
480
481
482
package require Tcl 8.5
package require http 2.7
package require json
package require tdom
package require base64

package provide rest 1.1

namespace eval ::rest {
    namespace export create_interface parameters parse_opts save \
    describe substitute
}

# simple --
................................................................................
    }
    if {[dict exists $config headers]} {
        dict for {key val} [dict get $config headers] { lappend headers $key $val }
    }
    if {[dict exists $config cookie]} {
        lappend headers Cookie [join [dict get $config cookie] \;]
    }






    set result [::rest::_call {} $headers $url $query $body]

    # if a format was specified then convert the data, but dont do any auto formatting
    if {[dict exists $config result]} {
        set result [::rest::format_[dict get $config result] $result]
    }

    return $result
................................................................................
                lappend proc "lappend query [lindex [dict get $config body] 1] \$body" {set body ""}
            } elseif {[string match mime_multi* [lindex [dict get $config body] 0]]} {
                lappend proc {if {$body == ""} { return -code error "wrong # args: should be \"[lindex [info level 0] 0] ?options? string\"" }}
                lappend proc {set b [::rest::mime_multipart body $body]}
                lappend proc {dict set config headers content-type "multipart/related; boundary=$b"}
            }
        }






        # end option processing

        if {[dict exists $config auth]} {
            set auth [dict get $config auth]
            if {$auth == "basic"} {
                lappend proc "lappend headers Authorization \"Basic \[base64::encode \$\{::${name}::user\}:\$\{::${name}::password\}]\""
                if {[info commands ::${name}::basic_auth] == ""} {
................................................................................
        lappend proc {set query [::http::formatQuery {*}$query]}
        
        # if this is an async call (has defined a callback)
        # then end the main proc here by returning the http token
        # the rest of the normal result processing will be put in a _callback_NAME
        # proc which is called by the generic _callback proc
        if {[dict exists $config callback]} {
            lappend proc "set t \[::rest::_call \{[list ::${name}::_callback_$call [dict get $config callback]]\} \$headers \$url \$query \$body]"
            lappend proc {return $t}
            proc ::${name}::$call args [join $proc \n]
            set proc {}
            lappend proc {upvar token token}
        } else {
            lappend proc {set result [::rest::_call {} $headers $url $query $body]}
        }
        
        # process results
        _transform $name $call $config proc pre_transform result
        if {[dict exists $config result]} {
            lappend proc "set result \[::rest::format_[dict get $config result] \$result]"
        } elseif {[dict exists $config format]} {
................................................................................
#
# EFFECTS:
#       creates a new namespace and builds api procedures within it
#
# RETURNS:
#       the data from the http reply, or an http token if the request was async
#
proc ::rest::_call {callback headers url query body} {
    #puts "_call [list $callback $headers $url $query $body]"
    # get the settings from the calling proc
    upvar config config
    
    set method GET
    if {[dict exists $config method]} { set method [string toupper [dict get $config method]] }

    # assume the query should really be the body for post or put requests
................................................................................
        lappend opts -command [list ::rest::_callback {*}$callback]
    }

    #puts "headers $headers"
    #puts "opts $opts"
    #puts "geturl $url"
    #return
    set t [http::geturl $url -headers $headers {*}$opts]



    # if this is an async request return now, otherwise process the result

    if {$callback != ""} { return $t }


    if {![string match 2* [http::ncode $t]]} {
        #parray $t

        if {[string match {30[123]} [http::ncode $t]]} {
            upvar #0 $t a
            return -code error [list HTTP [http::ncode $t] [dict get $a(meta) Location]]
        }

        return -code error [list HTTP [http::ncode $t]]
    }
    set data [http::data $t]

    # copy the token into the calling scope so that the transforms can access it
    # via uplevel, and we can still call cleanup on the real token

    upvar token token
    array set token [array get $t]

    #parray $t
    #puts "data: $data"
    http::cleanup $t
    return $data






|







 







>
>
>
>
|
>
|







 







>
>
>
>
>
>







 







|





|







 







|
|







 







|
>
>

|
>

>
>
|

>
|

|

>
|

<
>
|
|
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
...
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
...
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
package require Tcl 8.5
package require http 2.7
package require json
package require tdom
package require base64

package provide rest 1.2

namespace eval ::rest {
    namespace export create_interface parameters parse_opts save \
    describe substitute
}

# simple --
................................................................................
    }
    if {[dict exists $config headers]} {
        dict for {key val} [dict get $config headers] { lappend headers $key $val }
    }
    if {[dict exists $config cookie]} {
        lappend headers Cookie [join [dict get $config cookie] \;]
    }
    if {[dict exists $config error-body]} {
        set error_body [dict get $config error-body]
    } else {
        set error_body 0
    }
 
    set result [::rest::_call {} $headers $url $query $body $error_body]

    # if a format was specified then convert the data, but dont do any auto formatting
    if {[dict exists $config result]} {
        set result [::rest::format_[dict get $config result] $result]
    }

    return $result
................................................................................
                lappend proc "lappend query [lindex [dict get $config body] 1] \$body" {set body ""}
            } elseif {[string match mime_multi* [lindex [dict get $config body] 0]]} {
                lappend proc {if {$body == ""} { return -code error "wrong # args: should be \"[lindex [info level 0] 0] ?options? string\"" }}
                lappend proc {set b [::rest::mime_multipart body $body]}
                lappend proc {dict set config headers content-type "multipart/related; boundary=$b"}
            }
        }
        if {[dict exists $config error-body]} {
            set error_body [dict get $config error-body]
        } else {
            set error_body 0
        }
        lappend proc "set error_body $error_body"
        # end option processing

        if {[dict exists $config auth]} {
            set auth [dict get $config auth]
            if {$auth == "basic"} {
                lappend proc "lappend headers Authorization \"Basic \[base64::encode \$\{::${name}::user\}:\$\{::${name}::password\}]\""
                if {[info commands ::${name}::basic_auth] == ""} {
................................................................................
        lappend proc {set query [::http::formatQuery {*}$query]}
        
        # if this is an async call (has defined a callback)
        # then end the main proc here by returning the http token
        # the rest of the normal result processing will be put in a _callback_NAME
        # proc which is called by the generic _callback proc
        if {[dict exists $config callback]} {
            lappend proc "set t \[::rest::_call \{[list ::${name}::_callback_$call [dict get $config callback]]\} \$headers \$url \$query \$body \$error_body]"
            lappend proc {return $t}
            proc ::${name}::$call args [join $proc \n]
            set proc {}
            lappend proc {upvar token token}
        } else {
            lappend proc {set result [::rest::_call {} $headers $url $query $body $error_body]}
        }
        
        # process results
        _transform $name $call $config proc pre_transform result
        if {[dict exists $config result]} {
            lappend proc "set result \[::rest::format_[dict get $config result] \$result]"
        } elseif {[dict exists $config format]} {
................................................................................
#
# EFFECTS:
#       creates a new namespace and builds api procedures within it
#
# RETURNS:
#       the data from the http reply, or an http token if the request was async
#
proc ::rest::_call {callback headers url query body error_body} {
    #puts "_call [list $callback $headers $url $query $body $error_body]"
    # get the settings from the calling proc
    upvar config config
    
    set method GET
    if {[dict exists $config method]} { set method [string toupper [dict get $config method]] }

    # assume the query should really be the body for post or put requests
................................................................................
        lappend opts -command [list ::rest::_callback {*}$callback]
    }

    #puts "headers $headers"
    #puts "opts $opts"
    #puts "geturl $url"
    #return
    set t        [http::geturl $url -headers $headers {*}$opts]
    set data     [http::data  $t]
    set httpCode [http::ncode $t]

    # if this is an async request return now, otherwise process the
    # result
    if {$callback != ""} { return $t }

    # Generate an error return for a failed request
    if {![string match 2* $httpCode]} {
        #parray $t
	set retList [list HTTP $httpCode]
        if {[string match {30[123]} $httpCode]} {
            upvar #0 $t a
            lappend retList [dict get $a(meta) Location]
        }
        if {$error_body} {lappend retList $data}
        return -code error $retList
    }


    # copy the token into the calling scope so that the transforms can
    # access it via uplevel, and we can still call cleanup on the real
    # token
    upvar token token
    array set token [array get $t]

    #parray $t
    #puts "data: $data"
    http::cleanup $t
    return $data