publish: Handle '/file' URLs, for content-addressed files.

* guix/scripts/publish.scm (render-content-addressed-file): New procedure.
(http-write): Add 'application/octet-stream' case.
(make-request-handler): Add /file/NAME/sha256/HASH URLs.
* tests/publish.scm ("/file/NAME/sha256/HASH")
("/file/NAME/sha256/INVALID-NIX-BASE32-STRING")
("/file/NAME/sha256/INVALID-HASH"): New tests.
* doc/guix.texi (Invoking guix publish): Mention the /file URLs.
This commit is contained in:
Ludovic Courtès 2016-07-20 16:54:31 +02:00
parent 260bc60f83
commit ff6638d112
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 106 additions and 1 deletions

View file

@ -5633,6 +5633,20 @@ archive}), the daemon may download substitutes from it:
guix-daemon --substitute-urls=http://example.org:8080
@end example
As a bonus, @command{guix publish} also serves as a content-addressed
mirror for source files referenced in @code{origin} records
(@pxref{origin Reference}). For instance, assuming @command{guix
publish} is running on @code{example.org}, the following URL returns the
raw @file{hello-2.10.tar.gz} file with the given SHA256 hash
(represented in @code{nix-base32} format, @pxref{Invoking guix hash}):
@example
http://example.org/file/hello-2.10.tar.gz/sha256/0ssi1@dots{}ndq1i
@end example
Obviously, these URLs only work for files that are in the store; in
other cases, they return 404 (``Not Found'').
The following options are available:
@table @code

View file

@ -31,6 +31,7 @@ (define-module (guix scripts publish)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:use-module (web http)
#:use-module (web request)
@ -49,6 +50,7 @@ (define-module (guix scripts publish)
#:use-module (guix zlib)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module ((guix build utils) #:select (dump-port))
#:export (guix-publish))
(define (show-help)
@ -308,6 +310,25 @@ (define* (render-nar store request store-item
store-path)
(not-found request))))
(define (render-content-addressed-file store request
name algo hash)
"Return the content of the result of the fixed-output derivation NAME that
has the given HASH of type ALGO."
;; TODO: Support other hash algorithms.
(if (and (eq? algo 'sha256) (= 32 (bytevector-length hash)))
(let ((item (fixed-output-path name hash
#:hash-algo algo
#:recursive? #f)))
(if (valid-path? store item)
(values `((content-type . (application/octet-stream
(charset . "ISO-8859-1"))))
;; XXX: We're not returning the actual contents, deferring
;; instead to 'http-write'. This is a hack to work around
;; <http://bugs.gnu.org/21093>.
item)
(not-found request)))
(not-found request)))
(define extract-narinfo-hash
(let ((regexp (make-regexp "^([a-df-np-sv-z0-9]{32}).narinfo$")))
(lambda (str)
@ -398,6 +419,34 @@ (define (http-write server client response body)
(swallow-zlib-error
(close-port port))
(values)))))
(('application/octet-stream . _)
;; Send a raw file in a separate thread.
(call-with-new-thread
(lambda ()
(catch 'system-error
(lambda ()
(call-with-input-file (utf8->string body)
(lambda (input)
(let* ((size (stat:size (stat input)))
(headers (alist-cons 'content-length size
(alist-delete 'content-length
(response-headers response)
eq?)))
(response (write-response (set-field response
(response-headers)
headers)
client))
(output (response-port response)))
(dump-port input output)
(close-port output)
(values)))))
(lambda args
;; If the file was GC'd behind our back, that's fine. Likewise if
;; the client closes the connection.
(unless (memv (system-error-errno args)
(list ENOENT EPIPE ECONNRESET))
(apply throw args))
(values))))))
(_
;; Handle other responses sequentially.
(%http-write server client response body))))
@ -418,7 +467,7 @@ (define* (make-request-handler store
(format #t "~a ~a~%"
(request-method request)
(uri-path (request-uri request)))
(if (get-request? request) ; reject POST, PUT, etc.
(if (get-request? request) ;reject POST, PUT, etc.
(match (request-path-components request)
;; /nix-cache-info
(("nix-cache-info")
@ -450,6 +499,14 @@ (define* (make-request-handler store
(_
%default-gzip-compression)))
(not-found request)))
;; /nar/file/NAME/sha256/HASH
(("file" name "sha256" hash)
(guard (c ((invalid-base32-character? c)
(not-found request)))
(let ((hash (nix-base32-string->bytevector hash)))
(render-content-addressed-file store request
name 'sha256 hash))))
(_ (not-found request)))
(not-found request))))

View file

@ -26,6 +26,8 @@ (define-module (test-publish)
#:use-module (guix utils)
#:use-module (guix hash)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix base32)
#:use-module (guix base64)
#:use-module ((guix records) #:select (recutils->alist))
@ -210,4 +212,36 @@ (define (wait-until-ready port)
(display "This file is not a valid store item." port)))
(response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
(test-equal "/file/NAME/sha256/HASH"
"Hello, Guix world!"
(let* ((data "Hello, Guix world!")
(hash (call-with-input-string data port-sha256))
(drv (run-with-store %store
(gexp->derivation "the-file.txt"
#~(call-with-output-file #$output
(lambda (port)
(display #$data port)))
#:hash-algo 'sha256
#:hash hash)))
(out (build-derivations %store (list drv))))
(utf8->string
(http-get-body
(publish-uri
(string-append "/file/the-file.txt/sha256/"
(bytevector->nix-base32-string hash)))))))
(test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
404
(let ((uri (publish-uri
"/file/the-file.txt/sha256/not-a-nix-base32-string")))
(response-code (http-get uri))))
(test-equal "/file/NAME/sha256/INVALID-HASH"
404
(let ((uri (publish-uri
(string-append "/file/the-file.txt/sha256/"
(bytevector->nix-base32-string
(call-with-input-string "" port-sha256))))))
(response-code (http-get uri))))
(test-end "publish")