Also attachment "oauth.tcl" to
ticket [4004568d8f]
added by
aku
2014-10-08 03:42:48.
# !/bin/sh
# the next line will restart with tclsh wherever it is \
exec tclsh "$0" "$@"
# 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
# There are 3 steps we need complete to get authenticated with OAuth.
# Steps:
# 1. Authorizing a request: we need 7 parameters.
# 1.1 Consumer key (oauth_consumer_key) from your app (dev.twitter.com/apps)
# 1.2 Nonce (oauth_nonce) unique&random token autogenerated by base64 32bits
# 1.3 Signature (oauth_signature) all the other requests and 2 secret values
# trought a signing algorithm.
# 1.4 Signature method (oauth_signature_method) which is HMAC-SHA1
# 1.5 Timestamp (oauth_timestamp) time in unix format of the request
# 1.6 Token (oauth_token) a parameter you can obtain in your account settings
# 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 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 project {OAuth1.0}
variable version [package present oauth]
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 {}
-debug 0
-oauthversion 1.0
-proxyhost {}
-proxyport {}
-ratelimit 1
-signmethod HMAC-SHA1
-timeout 6000
-urlencoding utf-8
}
set oauth(-useragent) "Mozilla/5.0\
([string totitle $::tcl_platform(platform)]; U;\
$::tcl_platform(os) $::tcl_platform(osVersion))\
oauth/${version} Tcl/[package provide Tcl]"
}
}
# config --
#
# See documentation for details.
#
# Arguments:
# args options parsed by the procedure.
# Results:
# This procedure returns the array with the current configuration
# In order to create an array with the result of this procedure you can do
# it in this way: array set settings [oauth::config ...]
proc ::oauth::config {args} {
variable oauth
set options [array names oauth -*]
set usage [join $options {, }]
if {$args eq {}} {
return [array get oauth]
}
foreach {flag value} $args {
set optionflag [lsearch -inline -nocase $options $flag]
if {$optionflag eq ""} {
Error "Unknown option \"${flag}\", must be: $usage" BAD OPTION
}
set oauth($optionflag) $value
}
return [array get oauth]
}
# 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:
# baseURL: full url path of twitter api. If it should be sent
# as GET, add the query string.
# postQuery: arguments passed at the request body as POST. This
# should be in http query format.
# Result:
# This proc will return a list of values like this:
# Authorization:
# OAuth oauth_consumer_key="xvz1evFS4wEEPTGEFPHBog",
# oauth_nonce="kYjzVBB8Y0ZFabxSWbWovY3uYSQ2pTgmZeNu2VS4cg",
# 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 ""}} {
variable oauth
if {$oauth(-signmethod) eq ""} {
Error "ERROR: invalid argument for -signmethod." BAD SIGN-METHOD
}
if {[package vcompare $oauth(-oauthversion) 1.0] != 0} {
Error "ERROR: this script only supports oauth_version 1.0" \
BAD OAUTH-VERSION
}
if {$oauth(-consumerkey) eq ""} {
Error "ERROR: please define your consumer key.\
[namespace current]::config -consumerkey <...>" \
BAD CONSUMER-KEY
}
if {$oauth(-accesstoken) eq ""} {
Error "ERROR: please define your app's access token.\
[namespace current]::config -accesstoken <...>" \
BAD ACCESS-TOKEN
}
set randomKey [sha1::sha1 [expr {[clock milliseconds] + round(rand()*50000)}]]
set timestamp [clock seconds]
lappend paramList "oauth_consumer_key=$oauth(-consumerkey)"
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)"
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}
} 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] {&}]
lappend baseList $httpMethod
lappend baseList [PercentEncode $url]
lappend baseList [PercentEncode $paramString]
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]\""
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] {, }]]]"
}
# 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 {
set url $baseURL
set httpMethod {POST}
}
if {$httpMethod eq {GET}} {
if {$queryString ne {}} {
append url ? $queryString
}
set requestBody {}
} else {
set requestBody $queryString
}
if {$queryString ne {}} {
set headerURL ${url}?${queryString}
} else {
set headerURL $url
}
set header [header $headerURL]
http::config \
-proxyhost $oauth(-proxyhost) \
-proxyport $oauth(-proxyport) \
-useragent $oauth(-useragent)
set token [http::geturl $baseURL \
-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
}
# PercentEncode --
# Encoding process in http://tools.ietf.org/html/rfc3986#section-2.1
# for Twitter authentication. (http::formatQuery is lowcase)
proc ::oauth::PercentEncode {string} {
set utf8String [encoding convertto utf-8 $string]
return [string map {"\n" "%0A"} \
[subst [regsub -all \
{[^-A-Za-z0-9._~\n]} $utf8String \
{%[format "%02X" [scan "\\\0" "%c"]]}]]]
}
proc ::oauth::Error {string args} {
return -code error -errorcode [linsert $args 0 OAUTH] $string
}
return
