Tcl Library Source Code

Artifact [bad4075262]
Login

Artifact bad4075262209993992f78660d4afb3ae1da8415:

Attachment "oauth-1.0.tm" to ticket [4004568d8f] added by aku 2014-10-07 20:33:35.
# !/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

apply {code {
    set modver [file root [file tail [info script]]]
    lassign [split $modver -] ns version
    package provide $ns $version
    namespace eval $ns $code
} ::} {
    package require http
    package require tls
    package require base64
    package require sha1
    package require json
    
    namespace export query
    variable commands [namespace export]
    variable project {OAuth1.0}
    variable version [uplevel 1 {set version}]	
    variable description {OAuth authentication for Twitter support.}
    variable author {Javier Pérez <[email protected]>}
    variable created {12.30.2012, published 02.10.2014}
    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              1
            -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 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 ""} {
                return -code error "Unkown option \"${flag}\", must be: $usage"
            }
            set oauth($optionflag) $value
        }
        return [array get oauth]
    }
    
    # header --
    #       Following OAuth1.0a rules, this proc collect all information
    #       required for get the authentication.
    #       All we need is a header for our api queries with our user and app
    #       information for verify 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 proc 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 header {baseURL {postQuery ""}} {
        variable oauth

        if {$oauth(-signmethod) eq ""} {
            return -code error "ERROR: invalid argument for -signmethod."
        }
        if {$oauth(-oauthversion) != {1.0}} {
            return -code error "ERROR: this script only supports oauth_version 1.0"
        }
        if {$oauth(-consumerkey) eq ""} {
            return -code error "ERROR: please define your consumer key.\
             [namespace current]::config -consumerkey <...>"
        }
        if {$oauth(-accesstoken) eq ""} {
            return -code error "ERROR: please define your app's access token.\
             [namespace current]::config -accesstoken <...>"
        }

        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 query {baseURL {postQuery ""}} {
        variable oauth
        if {$oauth(-consumerkey) eq ""} {
            return -code error "ERROR: please define your consumer key.\
             [namespace current]::config -consumerkey <...>"
        }
        if {$oauth(-consumersecret) eq ""} {
            return -code error "ERROR: please define your app's consumer secret.\
             [namespace current]::config -consumersecret <...>"
        }
        if {$oauth(-accesstoken) eq ""} {
            return -code error "ERROR: please define your access token.\
             [namespace current]::config -accesstoken <...>"
        }
        if {$oauth(-accesstokensecret) eq ""} {
            return -code error "ERROR: please define your app's access token secret.\
             [namespace current]::config -accesstokensecret <...>"
        }
        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)
        http::register https 443 ::tls::socket
        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 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"]]}]]]
    }
}