Flickr/GaucheでflickrAPIを書いてみた - kobapan @ wiki

Flickr/flickr-upload.scmを書いた後で、ふと思った。なにも、CのFlickrAPIを介さずとも、GaucheでFlickrAPIを書けばいいではないか。

ということで書いた。

GaucheでOAuthを使ってTwitterに投稿する | tana-laevatein をベースにして、 Flickr API with OAuth-based user authentication | mathworks と User Authentication | flickr を参考に、Flickr の Oauth フローを書く。一部、Gauche-net-oauth から引用した。httpsを使う点とか、oauth_callbackの指定とか、パラメータをアルファベット順にするとか、uriとパラメータの間には"?"を書くとか、その辺が変更点。画像のアップロードまでやろうと思ってたけど、力尽きて、test.loginの結果を返して終わり。

これで、Flickr Oauthの流れが分かったので、次はGauche-net-oauth | githubを使って書いてみようと思う。

Gaucheのユーザリファレンスは、具体例が少なすぎる。 (;ﾟд ...！ 各関数のTIPS的なのはWiLiKiを見れってことなんだろうか。

#!/usr/bin/env gosh
 
(use rfc.http)
(use rfc.sha)
(use rfc.hmac)
(use rfc.base64)
(use www.cgi)
(use math.mt-random)
(use gauche.uvector)
(use sxml.ssax)
(use sxml.sxpath)
 
;; ------------
;; custom var
;; ------------
;; API-KEY と API-SECRET は事前に、
;; https://www.flickr.com/services/apps/create/apply/
;; で、新しいAPIを作って取得しておく。
(define consumer-key "API-KEY")
(define consumer-secret "API-SECRET") ; client-credentials-secret
 
;; ------------
;; lib
;; ------------
(define (uri-encode-string str)
  (call-with-string-io str
    (lambda(in out)
      (while (read-byte in) (compose not eof-object?) => ch
             (if (char-set-contains? #[a-zA-Z0-9.~_-] (integer->char ch))
                 (write-char (integer->char ch) out)
                 (format out "%~2,'0X" (char->integer (integer->char ch))))))))
 
(define (time-stamp)
  (number->string (sys-time)))
 
(define (random-string)
  (let ((random-source
         (make <mersenne-twister> :seed (sys-time)))
        (v (make-u32vector 10)))
    (mt-random-fill-u32vector! random-source v)
    (digest-hexify (sha1-digest-string (x->string v)))))
 
;; !! alphabetical order is needed
(define (param-form-data? param)
  (odd? (length param)))
(define (oauth-normalize-parameters params)
  (define (param-sorter a b)
    (or (string<? (car a) (car b))
        (and (string=? (car a) (car b))
             (string<? (cadr a) (cadr b)))))
  (sort (remove param-form-data? params) param-sorter))
 
(define (query-compose query)
  (string-join (map (cut string-join <> "=")
                    (oauth-normalize-parameters query) ) "&"))
 
(define (signature method uri info :optional (token-secret ""))
  (let* ((query-string (query-compose info))
         (signature-basic-string
          (string-append method "&"
                         (uri-encode-string uri) "&" ; !! this is not '?' 
                         (uri-encode-string query-string))))
    (uri-encode-string
     (base64-encode-string
      (hmac-digest-string signature-basic-string
                          :key #`",|consumer-secret|&,|token-secret|" ; client-credentials-secret '&' token-credentials-secret
                          :hasher <sha1>))) ))
(define (string->sxml str)
  (call-with-input-string str
    (lambda (port)
      (ssax:xml->sxml port '()))))
 
;; ------------
;; Oauth
;; ------------
 
;; Request Tokenの取得
(define query
  `(("oauth_consumer_key" ,consumer-key)
    ("oauth_nonce" ,(random-string))
    ("oauth_signature_method" "HMAC-SHA1")
    ("oauth_timestamp" ,(time-stamp))
    ("oauth_callback" "oob") ; out of band authentication = not web authentication
    ("oauth_version" "1.0") ; option
    ))
(define credential (signature "GET"
                     "https://www.flickr.com/services/oauth/request_token" ; !! https
                     query
                     ;; no token-credentials-secret this time
                     ))
(define token
  (receive (status header body)
      (http-get "www.flickr.com"
                 (string-append "/services/oauth/request_token?" ; !! you need '?"
                                (query-compose
                                 `(,@query ("oauth_signature" ,credential)) ))
                 :secure #t ) ; !! https
    (cgi-parse-parameters :query-string body)))
(define oauth-token (cadr (assoc "oauth_token" token)))
(define oauth-token-secret (cadr (assoc "oauth_token_secret" token)))
 
;; OAuth Verifierの取得
(display "open this url.")
(newline)
(format #t
        "https://www.flickr.com/services/oauth/authorize?oauth_token=~A&perms=write"
        oauth-token) ; optional perms= parameter, asking for read, write, or delete
(newline)
(newline)
(display "input pin: ")
(flush) ;これが無いと、「input pin: 」と表示されるのがread-lineの後になってしまう。
(define oauth-verifier (read-line))
 
;; Access Tokenの取得
(define query
  `(("oauth_consumer_key" ,consumer-key)
    ("oauth_nonce" ,(random-string))
    ("oauth_signature_method" "HMAC-SHA1")
    ("oauth_timestamp" ,(time-stamp))
    ("oauth_token" ,oauth-token)
    ("oauth_verifier" ,oauth-verifier)
    ("oauth_version" "1.0") ; option
    ))
(define credential (signature "GET"
                      "https://www.flickr.com/services/oauth/access_token" ; !! https
                      query
                      oauth-token-secret)) ; token-credentials-secret
(define token
  (receive (status header body)
      (http-get "www.flickr.com"
                 (string-append "/services/oauth/access_token?" ; !! you need '?"
                                (query-compose
                                 `(,@query ("oauth_signature" ,credential)) ))
                 :secure #t)
    (cgi-parse-parameters :query-string body)))
;; request_tokenの時と同じ oauth_token というkeyだが、Access Token の値が入ってる
(define access-token (cadr (assoc "oauth_token" token)))
;; request_tokenの時と同じ oauth_token_secret というkeyだが、Access Token Secret の値が入ってる
(define access-token-secret (cadr (assoc "oauth_token_secret" token)))
 
;; ------------
;; test
;; ------------
(define query
 `(("oauth_consumer_key" ,consumer-key)
   ("oauth_nonce" ,(random-string))
   ("oauth_signature_method" "HMAC-SHA1")
   ("oauth_timestamp" ,(time-stamp))
   ("oauth_token" ,access-token)
   ("method" "flickr.test.login")
   ))
(define credential (signature "GET"
                     "https://api.flickr.com/services/rest" ; !! https
                     query
                     access-token-secret) ) ; token-credentials-secret
(define test-login
  (receive (status header body)
      (http-get "api.flickr.com"
                (string-append "/services/rest?"
                               (query-compose
                                `(,@query ("oauth_signature" ,credential)) ))
                :secure #t)
    (sxml:string ((sxpath "rsp/@stat") 
                  (string->sxml body)) )))
 
(print test-login)