Permalink
Browse files

changes to support posting images in a hacky way to tumblr

  • Loading branch information...
1 parent 38f3de6 commit e63bf0d6794364bcb9830404ba1bf20df0ace288 @hanshuebner hanshuebner committed Nov 11, 2012
Showing with 37 additions and 18 deletions.
  1. +10 −1 src/core/consumer.lisp
  2. +1 −1 src/core/signature.lisp
  3. +1 −0 src/package.lisp
  4. +5 −1 src/util/query-string.lisp
  5. +20 −15 src/util/uri.lisp
View
@@ -284,12 +284,21 @@ whenever the access token is renewed."
(key (hmac-key (token-secret consumer-token) (token-secret access-token)))
(signature (encode-signature (hmac-sha1 sbs key) nil))
(signed-parameters (cons `("oauth_signature" . ,signature) auth-parameters)))
+ (when (and (eql request-method :post)
+ user-parameters)
+ (assert (and (not (getf drakma-args :content-type))
+ (not (getf drakma-args :content)))
+ () "User parameters and content/content-type in drakma arguments cannot be combined")
+ (setf drakma-args (list* :content-type "application/x-www-form-urlencoded"
+ :content (alist->query-string user-parameters
+ :url-encode t
+ :include-leading-ampersand nil)
+ drakma-args)))
(multiple-value-bind (body status headers)
(http-request uri
:method request-method
:auth-location auth-location
:auth-parameters signed-parameters
- :parameters user-parameters
:additional-headers additional-headers
:drakma-args drakma-args)
(if (eql status 200)
View
@@ -9,7 +9,7 @@
(normalize-uri uri))
"&" (url-encode
(alist->query-string parameters
- :url-encode t
+ :url-encode t
:include-leading-ampersand nil))))
(declaim (notinline hmac-key)) ; we want to trace this when debugging.
View
@@ -63,6 +63,7 @@
#:signature-base-string
#:hmac-key
#:hmac-sha1
+ #:encode-url
#:encode-signature
;;; parameters
@@ -3,7 +3,11 @@
(defun alist->query-string (alist &key (include-leading-ampersand t) url-encode)
(let* ((plist (splice-alist alist))
- (plist* (if url-encode (mapcar #'(lambda (item) (url-encode (string item))) plist) plist))
+ (plist* (if url-encode
+ (loop for (key value) on plist by #'cddr
+ collect (url-encode (string key))
+ collect (url-encode value))
+ plist))
(result (format nil "~{&~A=~A~}" plist*)))
(subseq ; TODO: nsubseq http://darcs.informatimago.com/lisp/common-lisp/utility.lisp
result
View
@@ -7,22 +7,27 @@
;; this function is taken from Hunchentoot but modified to
;; satisfy the OAuth spec demands.
-(defun url-encode (string &optional (external-format +utf-8+))
- "URL-encodes a string using the external format EXTERNAL-FORMAT."
+(defun url-encode (input &optional (external-format +utf-8+))
+ "URL-encodes INPUT according to the percent encoding rules of
+ RFC5849 (section 3.6). If a string is passed as INPUT, it is
+ encoded using the external format EXTERNAL-FORMAT. If a vector of
+ bytes is passed, the values are used verbatim."
(with-output-to-string (s)
- (loop for c across string
- for index from 0
- do (cond ((or (char<= #\0 c #\9)
- (char<= #\a c #\z)
- (char<= #\A c #\Z)
- (find c "-_.~" :test #'char=))
- (write-char c s))
- (t (loop for octet across (flexi-streams:string-to-octets string
- :start index
- :end (1+ index)
- :external-format external-format)
- do (format s "%~2,'0x" octet)))))))
-
+ (loop for octet across (etypecase input
+ (string
+ (flexi-streams:string-to-octets input :external-format external-format))
+ ((or (array (integer) (*))
+ (array (unsigned-byte 8) (*)))
+ input)
+ (null
+ #()))
+ for char = (code-char octet)
+ do (if (or (char<= #\0 char #\9)
+ (char<= #\a char #\z)
+ (char<= #\A char #\Z)
+ (find char "-_.~" :test #'char=))
+ (write-char char s)
+ (format s "%~2,'0x" octet)))))
(defmacro upgrade-vector (vector new-type &key converter)
"Returns a vector with the same length and the same elements as

0 comments on commit e63bf0d

Please sign in to comment.