Tcl Library Source Code

Check-in [bdfca38680]
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:Integrated changed by Javi after verification that it works.
Timelines: family | ancestors | descendants | both | oauth
Files: files | file ages | folders
SHA1: bdfca38680474a3859a6bddc2147e631fa066a16
User & Date: andreask 2014-10-09 23:17:41
Context
2014-10-14
21:14
Added documentation for oauth, written by JaviP, with editing by myself. Closed-Leaf check-in: 0982cecb8c user: andreask tags: oauth
2014-10-09
23:17
Integrated changed by Javi after verification that it works. check-in: bdfca38680 user: andreask tags: oauth
2014-10-08
03:57
Oops, merge trunk head, started branch way too far in the past. check-in: a5946bb57c user: aku tags: oauth
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/oauth/oauth.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
..
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
..
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
...
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
# !/bin/sh
# the next line will restart with tclsh wherever it is \
exec tclsh "$0" "[email protected]"

# oauth-1.0.tm -*- tcl -*-
# 		This module pretend give full support to API version 1.1 of Twitter
#		according to API v1.1’s Authentication Model
#
# Copyright (c) 2014 Javier Pérez - <[email protected]>
#   gave to tcllib
#
# About OAuthv1.0a
................................................................................
package require Tcl 8.5
package provide oauth 1

package require http
package require tls
package require base64
package require sha1
package require json

http::register https 443 ::tls::socket
    
namespace eval ::oauth {
    namespace export query

    variable commands [namespace export]
................................................................................
    variable description {OAuth authentication for Twitter support.}
    variable author {Javier Pérez <[email protected]>}
    # AK: changed to ISO date format.
    variable created {2012-12-30, published 2014-02-10}
    variable script [info script]
    variable contact "$project $version ~ $description ($author)"

    # urlRequest     {https://api.twitter.com/oauth/request_token}
    # urlAuthorize   {https://api.twitter.com/oauth/authorize}
    # urlAccesstoken {https://api.twitter.com/oauth/access_token}
    variable oauth
    if {![info exists oauth]} {
        array set oauth {
            -accesstoken        {}
            -accesstokensecret  {}
            -consumerkey        {}
            -consumersecret     {}
................................................................................

# header --
#       Following OAuth1.0a rules, this procedure collects all
#       information required for get the authentication.  All we need
#       is a header for our api queries with our user and app
#       information for the verification of who we are. Collect it,
#       encode it as the protocol says and add it to the geturl
#       command.  If you prefer it you can use this procedure for your
#       own queries, just use it as header. Example:
#           http::geturl $twitter(url) -header [oauth::header <...>] <...>
#
# You can get more information about how twitter api works reading this:
#   https://dev.twitter.com/overview/documentation
#
# Arguments:
................................................................................
	}
	puts "\nBaseString: $signString"
    }
    return "Authorization [list [concat OAuth [join [lsort -dictionary $header] {, }]]]"
}

# query --
#       Sends to twitter API url the proper oauth header and querybody
#       returning the raw data from Twitter for your parse.
# Arguments:
#       url         index of array tUrl with ?arguments if it's a GET request
#       postQuery   POST query if it's a POST query
# Result:
#       The result will be list with 2 arguments.
#       The first argument is an array with the http's header
#       and the second one is JSON data received from Twitter. The header is
#       very important because it reports your rest API limit and will
#       inform you if you can get your account suspended.
proc ::oauth::query {baseURL {postQuery ""}} {
    variable oauth
    if {$oauth(-consumerkey) eq ""} {
	Error "ERROR: please define your consumer key.\
             [namespace current]::config -consumerkey <...>" \
	    BAD CONSUMER-KEY
    }
    if {$oauth(-consumersecret) eq ""} {
	Error "ERROR: please define your app's consumer secret.\
             [namespace current]::config -consumersecret <...>" \
	    BAD CONSUMER-SECRET
    }
    if {$oauth(-accesstoken) eq ""} {
	Error "ERROR: please define your access token.\
             [namespace current]::config -accesstoken <...>" \
	    BAD ACCESS-TOKEN
    }
    if {$oauth(-accesstokensecret) eq ""} {
	Error "ERROR: please define your app's access token secret.\
             [namespace current]::config -accesstokensecret <...>" \
	    BAD ACCESS-TOKEN-SECRET
    }
    if {$postQuery eq ""} {
	set url [lindex [split $baseURL {?}] 0]
	set queryString [join [lrange [split $baseURL {?}] 1 end] {?}]
	set httpMethod {GET}
    } else {
................................................................................
		   -headers $header \
		   -query   $requestBody \
		   -method  $httpMethod \
		   -timeout $oauth(-timeout)]
    set ncode [http::ncode $token]
    set data  [http::data $token]
    upvar #0 $token state

    foreach key [array names state] {
	dict set dictResult metadata_${key} $state($key)
    }
    lappend result [array names state]
    lappend result $data
    http::cleanup $token

    return $result
}




|







 







<







 







<
<
<







 







|







 







|


|




|






|




|




|




|







 







<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
..
27
28
29
30
31
32
33

34
35
36
37
38
39
40
..
43
44
45
46
47
48
49



50
51
52
53
54
55
56
..
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
...
262
263
264
265
266
267
268




269
270
271
272
273
274
275
# !/bin/sh
# the next line will restart with tclsh wherever it is \
exec tclsh "$0" "[email protected]"

# oauth.tcl -*- tcl -*-
# 		This module pretend give full support to API version 1.1 of Twitter
#		according to API v1.1’s Authentication Model
#
# Copyright (c) 2014 Javier Pérez - <[email protected]>
#   gave to tcllib
#
# About OAuthv1.0a
................................................................................
package require Tcl 8.5
package provide oauth 1

package require http
package require tls
package require base64
package require sha1


http::register https 443 ::tls::socket
    
namespace eval ::oauth {
    namespace export query

    variable commands [namespace export]
................................................................................
    variable description {OAuth authentication for Twitter support.}
    variable author {Javier Pérez <[email protected]>}
    # AK: changed to ISO date format.
    variable created {2012-12-30, published 2014-02-10}
    variable script [info script]
    variable contact "$project $version ~ $description ($author)"




    variable oauth
    if {![info exists oauth]} {
        array set oauth {
            -accesstoken        {}
            -accesstokensecret  {}
            -consumerkey        {}
            -consumersecret     {}
................................................................................

# header --
#       Following OAuth1.0a rules, this procedure collects all
#       information required for get the authentication.  All we need
#       is a header for our api queries with our user and app
#       information for the verification of who we are. Collect it,
#       encode it as the protocol says and add it to the geturl
#       command.  If you want, you can use this procedure for your
#       own queries, just use it as header. Example:
#           http::geturl $twitter(url) -header [oauth::header <...>] <...>
#
# You can get more information about how twitter api works reading this:
#   https://dev.twitter.com/overview/documentation
#
# Arguments:
................................................................................
	}
	puts "\nBaseString: $signString"
    }
    return "Authorization [list [concat OAuth [join [lsort -dictionary $header] {, }]]]"
}

# query --
#       Sends to oauth API url the proper oauth header and querybody
#       returning the raw data from Twitter for your parse.
# Arguments:
#       baseURL     api host URL with ?arguments if it's a GET request
#       postQuery   POST query if it's a POST query
# Result:
#       The result will be list with 2 arguments.
#       The first argument is an array with the http's header
#       and the second one is JSON data received from the server. The header is
#       very important because it reports your rest API limit and will
#       inform you if you can get your account suspended.
proc ::oauth::query {baseURL {postQuery ""}} {
    variable oauth
    if {$oauth(-consumerkey) eq ""} {
	Error "ERROR: please define your consumer key.\
            [namespace current]::config -consumerkey <...>" \
	    BAD CONSUMER-KEY
    }
    if {$oauth(-consumersecret) eq ""} {
	Error "ERROR: please define your app's consumer secret.\
            [namespace current]::config -consumersecret <...>" \
	    BAD CONSUMER-SECRET
    }
    if {$oauth(-accesstoken) eq ""} {
	Error "ERROR: please define your access token.\
            [namespace current]::config -accesstoken <...>" \
	    BAD ACCESS-TOKEN
    }
    if {$oauth(-accesstokensecret) eq ""} {
	Error "ERROR: please define your app's access token secret.\
            [namespace current]::config -accesstokensecret <...>" \
	    BAD ACCESS-TOKEN-SECRET
    }
    if {$postQuery eq ""} {
	set url [lindex [split $baseURL {?}] 0]
	set queryString [join [lrange [split $baseURL {?}] 1 end] {?}]
	set httpMethod {GET}
    } else {
................................................................................
		   -headers $header \
		   -query   $requestBody \
		   -method  $httpMethod \
		   -timeout $oauth(-timeout)]
    set ncode [http::ncode $token]
    set data  [http::data $token]
    upvar #0 $token state




    lappend result [array names state]
    lappend result $data
    http::cleanup $token

    return $result
}