aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-07-20 16:54:31 +0200
committerLudovic Courtès <ludo@gnu.org>2016-07-20 16:54:31 +0200
commitff6638d112d794c9c433731643711932452fd2ff (patch)
tree483ff44e6ba65eb14a1fcd8482315f14da63f252
parent260bc60f83b1955ac7f48b71872d3d2809132ee2 (diff)
downloadguix-ff6638d112d794c9c433731643711932452fd2ff.tar
guix-ff6638d112d794c9c433731643711932452fd2ff.tar.gz
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.
-rw-r--r--doc/guix.texi14
-rw-r--r--guix/scripts/publish.scm59
-rw-r--r--tests/publish.scm34
3 files changed, 106 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 7ea9ddfe35..e7b233d828 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 3baceaf645..2ca2aeebe3 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -31,6 +31,7 @@
#: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 @@
#: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 @@ appropriate duration."
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 @@ blocking."
(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 @@ blocking."
(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 @@ blocking."
(_
%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))))
diff --git a/tests/publish.scm b/tests/publish.scm
index 9bf181f1fc..0ba33487bd 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -26,6 +26,8 @@
#: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 @@ References: ~%"
(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")