Index: modules/oauth/oauth.man ================================================================== --- modules/oauth/oauth.man +++ modules/oauth/oauth.man @@ -1,7 +1,7 @@ [comment {-*- tcl -*- doctools manpage}] -[vset PACKAGE_VERSION 1.0] +[vset PACKAGE_VERSION 1.0.1] [manpage_begin oauth n [vset PACKAGE_VERSION]] [keywords {oauth}] [keywords {RFC 5849}] [keywords {RFC 2718}] [keywords twitter] Index: modules/oauth/oauth.tcl ================================================================== --- modules/oauth/oauth.tcl +++ modules/oauth/oauth.tcl @@ -1,6 +1,6 @@ -# !/bin/sh +#!/bin/sh # the next line will restart with tclsh wherever it is \ exec tclsh "$0" "$@" # oauth.tcl -*- tcl -*- # This module pretend give full support to API version 1.1 of Twitter @@ -23,11 +23,11 @@ # 1.7 Version (oauth_version) the OAuth version, actually 1.0 # TODO: create online documentation package require Tcl 8.5 -package provide oauth 1 +package provide oauth 1.0.1 package require http package require tls package require base64 package require sha1 @@ -123,11 +123,11 @@ # oauth_signature="tnnArxj06cWHq44gCs1OSKk%2FjLY%3D", # oauth_signature_method="HMAC-SHA1", # oauth_timestamp="1318622958", # oauth_token="370773112-GmHxMAgYyLbNEtIKZeRNFsMKPR9EyMZeS9weJAEb", # oauth_version="1.0" -proc ::oauth::header {baseURL {postQuery ""}} { +proc ::oauth::header {baseURL {postQuery {}}} { variable oauth if {$oauth(-signmethod) eq ""} { Error "ERROR: invalid argument for -signmethod." BAD SIGN-METHOD } @@ -153,62 +153,58 @@ lappend paramList "oauth_nonce=$randomKey" lappend paramList "oauth_signature_method=$oauth(-signmethod)" lappend paramList "oauth_timestamp=$timestamp" lappend paramList "oauth_token=$oauth(-accesstoken)" lappend paramList "oauth_version=$oauth(-oauthversion)" - + + set header $paramList + if {$postQuery eq {}} { - set url [lindex [split $baseURL {?}] 0] - set queryString [lindex [split $baseURL {?}] 1] - foreach argument [split $queryString {&}] { - lappend paramList $argument - } - set httpMethod {GET} + lassign [Split $baseURL ?] url queryString + set httpMethod GET } else { - set url $baseURL - set httpMethod {POST} - } - - foreach parameter $paramList { - set key [lindex [split $parameter {=}] 0] - set value [join [lrange [split $parameter {=}] 1 end] {=}] - lappend header "${key}=\"${value}\"" - } - set paramString [join [lsort -dictionary $paramList] {&}] + set url $baseURL + set queryString $postQuery + set httpMethod POST + } + lappend paramList {*}[split $queryString &] + + set headerQ [QuoteValues $header] + set paramString [join [lsort -dictionary $paramList] &] lappend baseList $httpMethod lappend baseList [PercentEncode $url] lappend baseList [PercentEncode $paramString] - set signString [join $baseList {&}] + set signString [join $baseList &] set signKey "[PercentEncode $oauth(-consumersecret)]&[PercentEncode $oauth(-accesstokensecret)]" set signature [base64::encode [sha1::hmac -bin -key $signKey $signString]] - lappend header "oauth_signature=\"[PercentEncode $signature]\"" + lappend headerQ "oauth_signature=\"[PercentEncode $signature]\"" if {$oauth(-debug) == 1} { puts {oauth::header: Authorization Oauth} foreach line $header { puts "\t$line" } puts "\nBaseString: $signString" } - return "Authorization [list [concat OAuth [join [lsort -dictionary $header] {, }]]]" + return "Authorization [list [concat OAuth [join [lsort -dictionary $headerQ] {, }]]]" } # 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: +# 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 ""}} { +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 @@ -227,34 +223,32 @@ 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} + lassign [Split $baseURL ?] url queryString + set httpMethod GET } else { set url $baseURL - set httpMethod {POST} + set queryString $postQuery + set httpMethod POST } - if {$httpMethod eq {GET}} { + if {$httpMethod eq "GET"} { if {$queryString ne {}} { append url ? $queryString } set requestBody {} } else { set requestBody $queryString } if {$queryString ne {}} { - set headerURL ${url}?${queryString} + set header [header $url $queryString] } else { - set headerURL $url + set header [header $url] } - set header [header $headerURL] - http::config \ -proxyhost $oauth(-proxyhost) \ -proxyport $oauth(-proxyport) \ -useragent $oauth(-useragent) @@ -271,10 +265,29 @@ http::cleanup $token return $result } +# QuoteValues -- +# Add double-quotes around all values in the parameter string +# and return a list of modified parameter assignments. +proc ::oauth::QuoteValues {params} { + set tmp {} + foreach parameter $header { + lassign [Split $parameter =] key value + lappend tmp "${key}=\"${value}\"" + } + return $tmp +} + +# Split - +# Split the string on the first separator +# and return both parts as a list. +proc ::oauth::Split {string sep} { + regexp "{^(\[^${sep}\]+)${sep}(.*)\$" $string -> key value + list $key $value +} # PercentEncode -- # Encoding process in http://tools.ietf.org/html/rfc3986#section-2.1 # for Twitter authentication. (http::formatQuery is lowcase) proc ::oauth::PercentEncode {string} { Index: modules/oauth/pkgIndex.tcl ================================================================== --- modules/oauth/pkgIndex.tcl +++ modules/oauth/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded oauth 1 [list source [file join $dir oauth.tcl]] +package ifneeded oauth 1.0.1 [list source [file join $dir oauth.tcl]]