gistfile1.cl

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "junk/http"))

(in-package "junk")

(defvar *oauth-consumer-key* "コンシューマキー")
(defvar *oauth-consumer-secret* "コンシューマ秘密鍵")

(defun uri-encode-string (str)
  (si:www-url-encode str nil "0-9A-Za-z---._~"))

(defun time-stamp ()
  (princ-to-string (- (get-universal-time) (* 25567 24 60 60))))

(defun random-string ()
  (si:sha-1 (princ-to-string (make-random-state t))))

(defun query-compose (query)
  (format nil "~{~{~A~^=~}~^&~}" query))

(defun raw-digest (hex)
  (let ((a '()))
    (dotimes (i (/ (length hex) 2))
      (push (parse-integer hex :radix 16 :start (* i 2) :end (* (1+ i) 2)) a))
    (map 'string #'code-char (nreverse a))))

(defun signature (method uri info &optional (token-secret ""))
  (let* ((query-string (query-compose info))
         (signature-basic-string (concat method "&"
                                         (uri-encode-string uri) "&"
                                         (uri-encode-string query-string))))
    (uri-encode-string
     (si:base64-encode
      (raw-digest
       (si:hmac-sha-1 (format nil "~A&~A" *oauth-consumer-secret* token-secret)
                      signature-basic-string))))))

(defun http-post (url data &key headers)
  (let (http)
    (multiple-value-bind (proto host file anchor port)
        (junk-http-url-study url)
      (unless (string= proto "http")
        (junk-error "Protocol is not http: ~A" url))
      (unwind-protect
          (multiple-value-prog1
           (setq http (junk-http-request-send host file "POST"
                                              :data data
                                              :headers headers))
           (multiple-value-bind (is status headers response)
               (junk-http-response-get http)
             (format t "~A~%~A~%~{  ~A~%~}~A~%~%" is status headers response)
             (let (line)
               (while (setf line (read-line is nil nil))
                 (format t "~A~%" line))))
           (and http (close http)))
        (close http :abort t)))))

(defun oauth-post ()
  (let* ((query `(("oauth_consumer_key" ,*oauth-consumer-key*)
                  ("oauth_nonce" ,(random-string))
                  ("oauth_signature_method" "HMAC-SHA1")
                  ("oauth_timestamp" ,(time-stamp))
                  ("oauth_version" "1.0")))
         (s (signature "POST" "http://twitter.com/oauth/request_token" query)))
    (http-post "http://twitter.com/oauth/request_token"
               (query-compose `(,@query ("oauth_signature" ,s))))))

Gauche で OAuth - 主題のない日記 http://d.hatena.ne.jp/SaitoAtsushi/20100429/1272545442
をベタに移植してみたけど、あっているかどうかの確かめ方がよく分からない。