ADDED modules/oauth/oauth.man Index: modules/oauth/oauth.man ================================================================== --- /dev/null +++ modules/oauth/oauth.man @@ -0,0 +1,189 @@ +[comment {-*- tcl -*- doctools manpage}] +[vset PACKAGE_VERSION 1.0] +[manpage_begin oauth n [vset PACKAGE_VERSION]] +[keywords {oauth}] +[keywords {RFC 5849}] +[keywords {RFC 2718}] +[keywords twitter] +[copyright {2014 Javi P. }] +[moddesc {oauth}] +[titledesc {oauth API base signature}] +[category Networking] +[require Tcl 8.5] +[require oauth [opt [vset PACKAGE_VERSION]]] +[description] +[para] + +The [package oauth] package provides a simple Tcl-only library +for communication with [uri http://oauth.net oauth] APIs. + +This current version of the package supports the Oauth 1.0 Protocol, +as specified in [uri http://tools.ietf.org/rfc/rfc5849.txt {RFC 5849}]. + +[section COMMANDS] + +[list_begin definitions] +[call [cmd ::oauth::config]] + +When this command is invoked without arguments it returns a dictionary +containing the current values of all options. + +[call [cmd ::oauth::config] [opt [arg options]...]] + +When invoked with arguments, options followed by their values, it is used +to set and query various parameters of application and client, like proxy +host and user agent for the HTTP requests. The detailed list of options +is below: + +[list_begin options] +[opt_def -accesstoken [arg string]] +This is the user's token. + +[opt_def -accesstokensecret [arg string]] +This is the user's secret token. + +[opt_def -consumerkey [arg string]] +This is the public token of your app. + +[opt_def -consumersecret [arg string]] +This is the private token of your app. + +[opt_def -debug [arg bool]] +The default value is [const off]. If you change this option to [const on], +the basic signature just created will be printed to stdout, among other +debug output. + +[opt_def -oauthversion [arg version]] +This is the version of the OAuth protocol to use. +At the moment only [const 1.0] is supported, the default. + +[opt_def -proxyhost [arg hostname]] +You can set up a proxy host for send contact the oauth's api server. + +[opt_def -proxyport [arg port-number]] +Port number of your proxy. + +[opt_def -signmethod [arg method]] +The signature method to use. OAuth 1.0 only supports [const HMAC-SHA1], the default. + +[opt_def -timeout [arg milliseconds]] +Timeout in milliseconds for your query. +The default value is [const 6000], i.e. 6 seconds. + +[opt_def -urlencoding [emph encoding]] +The encoding used for creating the x-url-encoded URLs with +[cmd ::http::formatQuery]. The default is [const utf-8], as specified +by [uri http://tools.ietf.org/rfc/rfc2718.txt {RFC 2718}]. + +[list_end] + +[call [cmd ::oauth::header] [arg baseURL] [opt [arg postQuery]]] + +This command is the base signature creator. With proper settings for various tokens +and secrets (See [cmd ::oauth::config]) the result is the base authentication string +to send to the server. + +[para] You do not need to call this procedure to create the query because +[cmd ::oauth::query] (see below) will do for it for you. + +Doing so is useful for debugging purposes, though. + +[list_begin arguments] +[arg_def url baseURL] + +This argument is the URI path to the OAuth API server. +If you plan send a GET query, you should provide a full path. + +[example_begin] +HTTP GET +::oauth::header {https://api.twitter.com/1.1/users/lookup.json?screen_name=AbiertaMente} +[example_end] + +[arg_def url-encoded-string postQuery] + +When you have to send a header in POST format, you have to put the query string into this argument. + +[example_begin] +::oauth::header {https://api.twitter.com/1.1/friendships/create.json} {user_id=158812437&follow=true} +[example_end] + +[list_end] + +[call [cmd ::oauth::query] [arg baseURL] [opt [arg postQuery]]] + +This procedure will use the settings made with [cmd ::oauth::config] to create the +basic authentication and then send the command to the server API. + +It takes the same arguments as [cmd ::oauth::header]. + +[para] The returned result will be a list containing 2 elements. The first +element will be a dictionary containing the HTTP header data response. +This allows you, for example, to check the X-Rate-Limit from OAuth. +The second element will be the raw data returned from API server. +This string is usually a json object which can be further decoded with the +functions of package [package json], or any other json-parser for Tcl. + +[para] Here is an example of how it would work in Twitter. Do not forget to +replace the placeholder tokens and keys of the example with your own tokens +and keys when trying it out. + +[example {% package require oauth +% package require json +% oauth::config -consumerkey {your_consumer_key}\ +-consumersecret {your_consumer_key_secret}\ +-accesstoken {your_access_token}\ +-accesstokensecret {your_access_token_secret} + +% set response [oauth::query https://api.twitter.com/1.1/users/lookup.json?screen_name=AbiertaMente] +% set jsondata [lindex $response 1] +% set data [json::json2dict $jsondata] +$ set data [lindex $data 0] +% dict for {key val} $data {puts "$key => $val"} +id => 158812437 +id_str => 158812437 +name => Un Librepensador +screen_name => AbiertaMente +location => Explico mis tuits ahí → +description => 160Caracteres para un SMS y contaba mi vida entera sin recortar vocales. Ahora en Twitter, podemos usar hasta 140 y a mí me sobrarían 20 para contaros todo lo q +url => http://t.co/SGs3k9odBn +entities => url {urls {{url http://t.co/SGs3k9odBn expanded_url http://librepensamiento.es display_url librepensamiento.es indices {0 22}}}} description {urls {}} +protected => false +followers_count => 72705 +friends_count => 53099 +listed_count => 258 +created_at => Wed Jun 23 18:29:58 +0000 2010 +favourites_count => 297 +utc_offset => 7200 +time_zone => Madrid +geo_enabled => false +verified => false +statuses_count => 8996 +lang => es +status => created_at {Sun Oct 12 08:02:38 +0000 2014} id 521209314087018496 id_str 521209314087018496 text {@thesamethanhim http://t.co/WFoXOAofCt} source {Twitter Web Client} truncated false in_reply_to_status_id 521076457490350081 in_reply_to_status_id_str 521076457490350081 in_reply_to_user_id 2282730867 in_reply_to_user_id_str 2282730867 in_reply_to_screen_name thesamethanhim geo null coordinates null place null contributors null retweet_count 0 favorite_count 0 entities {hashtags {} symbols {} urls {{url http://t.co/WFoXOAofCt expanded_url http://www.elmundo.es/internacional/2014/03/05/53173dc1268e3e3f238b458a.html display_url elmundo.es/internacional/… indices {16 38}}} user_mentions {{screen_name thesamethanhim name Ἑλένη id 2282730867 id_str 2282730867 indices {0 15}}}} favorited false retweeted false possibly_sensitive false lang und +contributors_enabled => false +is_translator => true +is_translation_enabled => false +profile_background_color => 709397 +profile_background_image_url => http://pbs.twimg.com/profile_background_images/704065051/9309c02aa2728bdf543505ddbd408e2e.jpeg +profile_background_image_url_https => https://pbs.twimg.com/profile_background_images/704065051/9309c02aa2728bdf543505ddbd408e2e.jpeg +profile_background_tile => true +profile_image_url => http://pbs.twimg.com/profile_images/2629816665/8035fb81919b840c5cc149755d3d7b0b_normal.jpeg +profile_image_url_https => https://pbs.twimg.com/profile_images/2629816665/8035fb81919b840c5cc149755d3d7b0b_normal.jpeg +profile_banner_url => https://pbs.twimg.com/profile_banners/158812437/1400828874 +profile_link_color => FF3300 +profile_sidebar_border_color => FFFFFF +profile_sidebar_fill_color => A0C5C7 +profile_text_color => 333333 +profile_use_background_image => true +default_profile => false +default_profile_image => false +following => true +follow_request_sent => false +notifications => false}] + +[list_end] +[para] + +[vset CATEGORY oauth] + +[manpage_end] ADDED modules/oauth/oauth.tcl Index: modules/oauth/oauth.tcl ================================================================== --- /dev/null +++ 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 - +# 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 ADDED modules/oauth/pkgIndex.tcl Index: modules/oauth/pkgIndex.tcl ================================================================== --- /dev/null +++ modules/oauth/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.5]} {return} +package ifneeded oauth 1 [list source [file join $dir oauth.tcl]] Index: support/installation/modules.tcl ================================================================== --- support/installation/modules.tcl +++ support/installation/modules.tcl @@ -100,10 +100,11 @@ Module ncgi _tcl _man _null Module nmea _tcl _man _null Module nns _tcl _man _null Module nntp _tcl _man _exa Module ntp _tcl _man _exa +Module oauth _tcl _man _null Module ooutil _tcl _man _null Module otp _tcl _man _null Module page _trt _man _null Module pki _tcl _man _null Module pluginmgr _tcl _man _null