summaryrefslogtreecommitdiffstats
path: root/tcllib/modules/oauth/oauth.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tcllib/modules/oauth/oauth.tcl')
-rw-r--r--tcllib/modules/oauth/oauth.tcl291
1 files changed, 291 insertions, 0 deletions
diff --git a/tcllib/modules/oauth/oauth.tcl b/tcllib/modules/oauth/oauth.tcl
new file mode 100644
index 0000000..b6ab07e
--- /dev/null
+++ b/tcllib/modules/oauth/oauth.tcl
@@ -0,0 +1,291 @@
+# !/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 - <hxm@eggdrop.es>
+# 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 <hxm@eggdrop.es>}
+ # 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
generated by cgit v0.12 at 2025-01-11 19:43:13 (GMT)