Commit 054b5fe6 authored by Eric Timmons's avatar Eric Timmons
Browse files

Vastly simplify OPEN-OBJECT-STREAM for HTTP-OBJECT-STORE

Somehow I missed that Range: could be open ended, meaning we don't need to do a
HEAD to get the size. Additionally, make a bit more robust (specify
Accept-Encoding: identity and handle the case where the server sends a 200
instead of 206 on Range requests)
parent 4af3147e
Loading
Loading
Loading
Loading
+34 −49
Original line number Diff line number Diff line
@@ -49,50 +49,25 @@
  (declare (ignore if-exists))
  (when (and offset (not binary-p))
    ;; Technically we can offset if it's not binary, but its not very efficient
    ;; (we'd have to transfer the entire prefix from the server).
    ;; (we'd have to transfer the entire prefix from the server to robustly
    ;; handle variable width encodings).
    (error "Cannot offset object stream unless it's binary."))
  (let ((size)
        (uri (puri:merge-uris path (http-object-store-url object-store)))
        (accept-ranges)
        headers
        (last-modified))
  (let ((uri (puri:merge-uris path (http-object-store-url object-store)))
        headers)
    (when (and offset (plusp offset))
      (multiple-value-bind (content code headers)
          (http-client-request (http-object-store-http-client object-store)
                               uri
                               :method :head
                               :force-binary binary-p)
        (declare (ignore content))
        ;;(format t "~S~%" headers)
        (when (= code 404)
          (ecase if-does-not-exist
            ((nil)
             (signal 'object-missing :store object-store :path path)
             (return-from open-object-stream nil))
            (:error
             (cerror "Continue" 'object-missing :store object-store :path path))))
        (when (and (>= code 400) (/= code 404))
          (error "Unknown error!"))
        (setf size (assoc-value headers :content-length))
        (setf accept-ranges (assoc-value headers :accept-ranges))
        (setf last-modified (parse-date-time (assoc-value headers :last-modified)))
        (when (and signal-if-older-than
                   (< last-modified signal-if-older-than))
          (signal 'object-out-of-date
                  :store object-store
                  :path path
                  :universal-time last-modified)))
      (when (equal accept-ranges "bytes")
        (when (= offset (parse-integer size))
          (return-from open-object-stream (make-concatenated-stream)))
        ;; Server supports range requests!
        (push (cons :range (format nil "bytes=~D-~D" offset (1- size))) headers)))
    (multiple-value-bind (s code)
      ;; Subtract one from the offset to avoid issues with the start of the
      ;; range being beyond the end of the resource. This lets us avoind having
      ;; to do a HEAD to figure out the size.
      (push (cons :range (format nil "bytes=~D-" (1- offset))) headers)
      ;; Explicitly ask for no compression.
      (push (cons :accept-encoding "identity") headers))
    (multiple-value-bind (s code response-headers)
        (http-client-request (http-object-store-http-client object-store) uri
                             :additional-headers headers
                             :want-stream t
                             :force-binary binary-p)
      (when (= code 404)
      (cond
        ((= code 404)
         (ecase if-does-not-exist
          ((nil)
           (signal 'object-missing :store object-store :path path)
@@ -101,14 +76,24 @@
          (:error
           (close s)
           (cerror "Continue" 'object-missing :store object-store :path path))))
      (when (and (>= code 400) (/= code 404))
        ;; Something funky has happened..
        ((>= code 400)
         ;; Don't know what happened.
         (close s)
        (error "Unknown error!"))
      (when (and offset (not (equal accept-ranges "bytes")))
        ;; Server doesn't support requesting ranges. We have to forward the
        ;; stream ourselves. Should we emit a warning here to let the user know
        ;; they're using an awful server?
         (error "Don't know how to handle response ~D for ~A" code uri))
        ((and (= code 200) offset (plusp offset))
         ;; The server didn't understand our request... Need to forward the
         ;; stream ourselves. Should probably emit a warning here to let the
         ;; user know they're using an awful server.
         (dotimes (i offset)
           (read-byte s)))
        ((= code 206)
         ;; Got partial content back! Pop off the one extra byte we requested.
         (read-byte s)))
      (let ((last-modified (parse-date-time (assoc-value response-headers :last-modified))))
        (when (and signal-if-older-than
                   (< last-modified signal-if-older-than))
          (signal 'object-out-of-date
                  :store object-store
                  :path path
                  :universal-time last-modified)))
      s)))