guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

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
Show stats 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-references-by-derivation-id
select-derivation-source-file-by-store-path
select-derivation-source-file-nar-data-by-file-name
select-derivation-by-output-filename
select-derivations-using-output
select-derivations-in-revision
@ -804,6 +805,23 @@ WHERE store_path = $1")
(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 (double-quote s)
(string-append

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

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