add timeout support for sbcl & Add support to encode unicode characters in uri path

read.lisp

@@ -61,10 +61,12 @@ HTTP-REQUEST.  Returns NIL if there is no such header amongst
 HEADERS."
   (when-let (content-type (header-value :content-type headers))
     (with-sequence-from-string (stream content-type)
-      (let* ((*current-error-message* "Corrupted Content-Type header:")
+      (let* ((*current-error-message* (format nil "Corrupted Content-Type header:(~s)" content-type))
              (type (read-token stream))
-             (subtype (and (assert-char stream #\/)
-                           (read-token stream)))
+             (subtype (let ((subtype-pos (position #\/ type :test #'char=)))
+                        (cond (subtype-pos
+                               (prog1 (subseq type (1+ subtype-pos))
+                                      (setf type (subseq type 0 subtype-pos)))))))
              (parameters (read-name-value-pairs stream)))
         (values type subtype parameters)))))
 

request.lisp

@@ -223,12 +223,14 @@ headers of the chunked stream \(if any) as a second value."
                               want-stream
                               stream
                               preserve-uri
+                              (encode-unicode-path-p t)
                               decode-content ; default to nil for backwards compatibility
                               #+(or abcl clisp lispworks mcl openmcl sbcl)
                               (connection-timeout 20)
                               #+:lispworks (read-timeout 20)
                               #+(and :lispworks (not :lw-does-not-have-write-timeout))
                               (write-timeout 20 write-timeout-provided-p)
+                              #+sbcl (io-timeout 20)
                               #+:openmcl
                               deadline
                               &aux (unparsed-uri (if (stringp uri) (copy-seq uri) (puri:copy-uri uri))))
@@ -574,6 +576,10 @@ Any encodings in Transfer-Encoding, such as chunking, are always performed."
                                                              connection-timeout
                                                              :nodelay :if-supported)))
                     raw-http-stream http-stream)
+              #+sbcl
+              (when io-timeout
+                (setf (sb-impl::fd-stream-timeout http-stream) 
+                        (coerce io-timeout 'single-float)))
               #+:openmcl
               (when deadline
                 ;; it is correct to set the deadline here even though
@@ -653,20 +659,28 @@ Any encodings in Transfer-Encoding, such as chunking, are always performed."
                       (puri:uri-query uri) nil))
               (write-http-line "~A ~A ~A"
                                (string-upcase method)
-                               (if (and preserve-uri
-                                        (stringp unparsed-uri))
-                                   (trivial-uri-path unparsed-uri)
-                                   (puri:render-uri (if (and proxy
-                                                             (null stream)
-                                                             (not proxying-https-p)
-                                                             (not real-host))
-                                                        uri
-                                                        (make-instance 'puri:uri
-                                                                       :path (puri:uri-path uri)
-                                                                       :parsed-path (puri:uri-parsed-path uri)
-                                                                       :query (puri:uri-query uri)
-                                                                       :escaped t))
-                                                    nil))
+                               (let ((uri-string (if (and preserve-uri
+                                                          (stringp unparsed-uri))
+                                                     (trivial-uri-path unparsed-uri)
+                                                     (puri:render-uri (if (and proxy
+                                                                               (null stream)
+                                                                               (not proxying-https-p)
+                                                                               (not real-host))
+                                                                          uri
+                                                                          (make-instance 'puri:uri
+                                                                             :path (puri:uri-path uri)
+                                                                             :parsed-path (puri:uri-parsed-path uri)
+                                                                             :query (puri:uri-query uri)
+                                                                             :escaped t))
+                                                                      nil))))
+                                 (if encode-unicode-path-p
+                                     (with-output-to-string (*standard-output*)
+                                       (loop for c across uri-string
+                                             if (> (char-code c) 255)
+                                               ;; It's not a latin-1 character, so we need to encode it.
+                                               do (write-string (funcall url-encoder (format nil "~c" c) external-format-in))
+                                             else do (write-char c)))
+                                     uri-string))
                                (string-upcase protocol))
               (when (not (assoc "Host" additional-headers :test #'string-equal))
                 (write-header "Host" "~A~@[:~A~]" (puri:uri-host uri) (non-default-port uri)))