Merge 53ef29d into 3c84240

fukamachi · Jul 30, 2018 · 8caf67b · 8caf67b
2 parents 3c84240 + 53ef29d
commit 8caf67b
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 13 deletions.
diff --git a/src/backend/usocket.lisp b/src/backend/usocket.lisp
@@ -622,7 +622,6 @@
                                                                                    (uri-path uri))))
                                                       set-cookies)))))
                (when (and (member status '(301 302 303 307) :test #'=)
-                          (member method '(:get :head) :test #'eq)
                           (gethash "location" response-headers)
                           (/= max-redirects 0))
                  ;; Need to read the response body
@@ -637,13 +636,15 @@
                         (read-until-crlf*2 body)))))
 
                  (let ((location-uri (quri:uri (gethash "location" response-headers))))
-                   (if (or (null (uri-host location-uri))
-                           (and (string= (uri-scheme location-uri)
-                                         (uri-scheme uri))
-                                (string= (uri-host location-uri)
-                                         (uri-host uri))
-                                (eql (uri-port location-uri)
-                                     (uri-port uri))))
+                   (if (and (or (null (uri-host location-uri))
+                                (and (string= (uri-scheme location-uri)
+                                              (uri-scheme uri))
+                                     (string= (uri-host location-uri)
+                                              (uri-host uri))
+                                     (eql (uri-port location-uri)
+                                          (uri-port uri))))
+                            (or (= status 307)
+                                (member method '(:get :head) :test #'eq)))
                        (progn
                          (setq uri (merge-uris location-uri uri))
                          (setq first-line-data
@@ -662,11 +663,16 @@
                              (setq reusing-stream-p t))
                          (go retry))
                        (progn
+                         (setf location-uri (quri:merge-uris location-uri uri))
                          (finalize-connection stream (gethash "connection" response-headers) uri)
                          (setf (getf args :headers)
                                (nconc `((:host . ,(uri-host location-uri))) headers))
                          (setf (getf args :max-redirects)
                                (1- max-redirects))
+                         ;; Redirect as GET if it's 301, 302, 303
+                         (unless (or (= status 307)
+                                     (member method '(:get :head) :test #'eq))
+                           (setf (getf args :method) :get))
                          (return-from request
                            (apply #'request location-uri args))))))
                (unwind-protect

diff --git a/t/dexador.lisp b/t/dexador.lisp
@@ -86,7 +86,7 @@
           ((= id 3)
            '(200 (:content-length 2) ("OK")))
           ((<= 300 id 399)
-           '(302 (:location "/200") ()))
+           `(,id (:location "/200") ()))
           ((= id 200)
            (let ((method (princ-to-string (getf env :request-method))))
              `(200 (:content-length ,(length method))
@@ -111,11 +111,20 @@
       (declare (ignore body))
       (is code 302)
       (is (gethash "location" headers) "/12")))
-  (subtest "Don't redirect POST"
-    (multiple-value-bind (body code)
+  (subtest "POST redirects as GET"
+    (multiple-value-bind (body code headers uri)
         (dex:post (localhost "/301"))
-      (declare (ignore body))
-      (is code 302))))
+      (declare (ignore headers))
+      (is body "GET")
+      (is code 200)
+      (is (quri:uri-path uri) "/200")))
+  (subtest "POST redirects as POST for 307"
+    (multiple-value-bind (body code headers uri)
+        (dex:post (localhost "/307"))
+      (declare (ignore headers))
+      (is body "POST")
+      (is code 200)
+      (is (quri:uri-path uri) "/200"))))
 
 (subtest "content-disposition"
   (is (dexador.backend.usocket::content-disposition "upload" #P"data/plain-file.txt")