# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*- # -- Tcl Module # @@ Meta Begin # Package oauth 1 # Meta as::build::date 2015-05-25 # Meta as::origin http://sourceforge.net/projects/tcllib # Meta category oauth # Meta description oauth API base signature # Meta license BSD # Meta platform tcl # Meta require {Tcl 8.5} # Meta require base64 # Meta require http # Meta require sha1 # Meta require tls # Meta subject {RFC 2718} {RFC 5849} oauth twitter # Meta summary oauth # @@ Meta End # ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS package require Tcl 8.5 package require base64 package require http package require sha1 package require tls # ACTIVESTATE TEAPOT-PKG END REQUIREMENTS # ACTIVESTATE TEAPOT-PKG BEGIN DECLARE package provide oauth 1 # ACTIVESTATE TEAPOT-PKG END DECLARE # ACTIVESTATE TEAPOT-PKG END TM # !/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 # according to API v1.1’s Authentication Model # # Copyright (c) 2014 Javier Pérez - # 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 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 } # 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 {} -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 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: # 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 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 { 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 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