cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Serve nar files for the derivation source files

Browse source
This commit is contained in:
Christopher Baines 2019-12-28 23:50:52 +00:00
parent 67af7e17f0
commit da3a294496
2 changed files with 64 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

18
guix-data-service/model/derivation.scm
View file

@ -41,6 +41,7 @@
select-derivation-sources-by-derivation-id select-derivation-sources-by-derivation-id
select-derivation-references-by-derivation-id select-derivation-references-by-derivation-id
select-derivation-source-file-by-store-path select-derivation-source-file-by-store-path
select-derivation-source-file-nar-data-by-file-name
select-derivation-by-output-filename select-derivation-by-output-filename
select-derivations-using-output select-derivations-using-output
select-derivations-in-revision select-derivations-in-revision
@ -804,6 +805,23 @@ WHERE store_path = $1")
(map car (exec-query conn query (list store-path)))) (map car (exec-query conn query (list store-path))))
(define (select-derivation-source-file-nar-data-by-file-name conn file-name)
(match (exec-query
conn
"
SELECT data
FROM derivation_source_file_nars
INNER JOIN derivation_source_files
ON derivation_source_file_nars.derivation_source_file_id =
derivation_source_files.id
WHERE derivation_source_files.store_path = $1"
(list file-name))
(((data))
(base16-string->bytevector
;; Drop \x from the start of the string
(string-drop data 2)))
(() #f)))
(define (select-serialized-derivation-by-file-name conn derivation-file-name) (define (select-serialized-derivation-by-file-name conn derivation-file-name)
(define (double-quote s) (define (double-quote s)
(string-append (string-append

73
guix-data-service/web/nar/controller.scm
View file

@ -70,11 +70,16 @@
(('GET "substitutes") (('GET "substitutes")
(render-html (render-html
#:sxml (view-substitutes (%narinfo-signing-public-key)))) #:sxml (view-substitutes (%narinfo-signing-public-key))))
(('GET "nar" derivation) (('GET "nar" file-name)
(render-nar request (render-nar request
mime-types mime-types
conn conn
(string-append "/gnu/store/" derivation))) (string-append "/gnu/store/" file-name)))
(('GET "nar" "lzip" file-name)
(render-lzip-nar request
mime-types
conn
(string-append "/gnu/store/" file-name)))
(('GET (? .narinfo-suffix path)) (('GET (? .narinfo-suffix path))
(let* ((hash (string-drop-right (let* ((hash (string-drop-right
path path
@ -126,31 +131,45 @@
(define (render-nar request (define (render-nar request
mime-types mime-types
conn conn
derivation-file-name) file-name)
(let ((derivation-text (or
(select-serialized-derivation-by-file-name (and=> (select-serialized-derivation-by-file-name conn
conn file-name)
derivation-file-name))) (lambda (derivation-text)
(if derivation-text (let ((derivation-bytevector
(let ((derivation-bytevector (string->bytevector derivation-text
(string->bytevector derivation-text "ISO-8859-1")))
"ISO-8859-1"))) (list (build-response
(list (build-response #:code 200
#:code 200 #:headers '((content-type . (application/x-nix-archive
#:headers '((content-type . (application/x-nix-archive (charset . "ISO-8859-1")))))
(charset . "ISO-8859-1"))))) (lambda (port)
(lambda (port) (write-file-tree
(write-file-tree file-name
derivation-file-name port
port #:file-type+size
#:file-type+size (lambda (file)
(lambda (file) (values 'regular
(values 'regular (bytevector-length derivation-bytevector)))
(bytevector-length derivation-bytevector))) #:file-port
#:file-port (lambda (file)
(lambda (file) (open-bytevector-input-port derivation-bytevector))))))))
(open-bytevector-input-port derivation-bytevector)))))) (not-found (request-uri request))))
(not-found (request-uri request)))))
(define (render-lzip-nar request
mime-types
conn
file-name)
(or
(and=> (select-derivation-source-file-nar-data-by-file-name conn file-name)
(lambda (data)
(list (build-response
#:code 200
#:headers '((content-type . (application/x-nix-archive
(charset . "ISO-8859-1")))))
(lambda (port)
(put-bytevector port data)))))
(not-found (request-uri request))))
(define* (narinfo-string store-item (define* (narinfo-string store-item
nar-bytevector nar-bytevector