Begin to add support for importing narinfo files
This commit adds the tables, as well as code to support extracting data from narinfo files.
This commit is contained in:
parent
20c75e1103
commit
b6194e7b3d
6 changed files with 321 additions and 0 deletions
|
|
@ -88,6 +88,7 @@ SOURCES = \
|
|||
guix-data-service/model/lint-warning-message.scm \
|
||||
guix-data-service/model/lint-warning.scm \
|
||||
guix-data-service/model/location.scm \
|
||||
guix-data-service/model/nar.scm \
|
||||
guix-data-service/model/package-derivation.scm \
|
||||
guix-data-service/model/package-metadata.scm \
|
||||
guix-data-service/model/package.scm \
|
||||
|
|
|
|||
247
guix-data-service/model/nar.scm
Normal file
247
guix-data-service/model/nar.scm
Normal file
|
|
@ -0,0 +1,247 @@
|
|||
1(define-module (guix-data-service model nar)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (web uri)
|
||||
#:use-module (squee)
|
||||
#:use-module (json)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (gcrypt pk-crypto)
|
||||
#:use-module (gcrypt base16)
|
||||
#:use-module (guix scripts substitute)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:export (select-outputs-for-successful-builds-without-known-nar-entries
|
||||
|
||||
record-narinfo-details-and-return-ids))
|
||||
|
||||
(define narinfo-contents
|
||||
(@@ (guix scripts substitute) narinfo-contents))
|
||||
|
||||
(define (record-narinfo-details-and-return-ids conn narinfos)
|
||||
(define data
|
||||
(map (lambda (narinfo)
|
||||
(match (string-split
|
||||
(narinfo-hash narinfo)
|
||||
#\:)
|
||||
((hash-algorithm hash)
|
||||
(list
|
||||
(narinfo-path narinfo)
|
||||
hash-algorithm
|
||||
hash
|
||||
(narinfo-size narinfo)
|
||||
(or (narinfo-system narinfo) NULL)
|
||||
(or (narinfo-deriver narinfo) NULL)))))
|
||||
narinfos))
|
||||
|
||||
(let ((nar-ids
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"nars"
|
||||
'(store_path hash_algorithm hash size system deriver)
|
||||
data)))
|
||||
|
||||
(exec-query
|
||||
conn
|
||||
(string-append
|
||||
"
|
||||
INSERT INTO nar_references (nar_id, reference)
|
||||
VALUES "
|
||||
(string-join
|
||||
(concatenate
|
||||
(map (lambda (nar-id narinfo)
|
||||
(map (lambda (reference)
|
||||
(simple-format
|
||||
#f
|
||||
"(~A, ~A)"
|
||||
nar-id
|
||||
(quote-string reference)))
|
||||
(narinfo-references narinfo)))
|
||||
nar-ids
|
||||
narinfos))
|
||||
", ")
|
||||
"
|
||||
ON CONFLICT DO NOTHING"))
|
||||
|
||||
(exec-query
|
||||
conn
|
||||
(string-append
|
||||
"
|
||||
INSERT INTO nar_urls (nar_id, url, compression, file_size)
|
||||
VALUES "
|
||||
(string-join
|
||||
(concatenate
|
||||
(map (lambda (nar-id narinfo)
|
||||
(map (lambda (uri compression file-size)
|
||||
(simple-format
|
||||
#f
|
||||
"(~A, ~A, ~A, ~A)"
|
||||
nar-id
|
||||
(quote-string
|
||||
(uri->string uri))
|
||||
(quote-string compression)
|
||||
file-size))
|
||||
(narinfo-uris narinfo)
|
||||
(narinfo-compressions narinfo)
|
||||
(narinfo-file-sizes narinfo)))
|
||||
nar-ids
|
||||
narinfos))
|
||||
", ")
|
||||
"
|
||||
ON CONFLICT DO NOTHING"))
|
||||
|
||||
(for-each (lambda (nar-id narinfo)
|
||||
(let ((narinfo-signature-data-id
|
||||
(narinfo-signature->data-id conn narinfo)))
|
||||
|
||||
(exec-query
|
||||
conn
|
||||
(string-append
|
||||
"
|
||||
INSERT INTO narinfo_signatures (nar_id, narinfo_signature_data_id)
|
||||
VALUES "
|
||||
(simple-format
|
||||
#f
|
||||
"(~A,~A)"
|
||||
nar-id
|
||||
narinfo-signature-data-id)
|
||||
"
|
||||
ON CONFLICT DO NOTHING"))))
|
||||
nar-ids
|
||||
narinfos)
|
||||
|
||||
nar-ids))
|
||||
|
||||
(define (sexp->json-string sexp)
|
||||
(define (transform x)
|
||||
(if (list? x)
|
||||
(list->vector (map transform x))
|
||||
(if (bytevector? x)
|
||||
`((base16 . ,(bytevector->base16-string x)))
|
||||
x)))
|
||||
|
||||
(scm->json-string (transform sexp)))
|
||||
|
||||
(define (narinfo-signature->data-id conn narinfo)
|
||||
(let ((public-key-id
|
||||
(narinfo-signature->public-key-id
|
||||
conn
|
||||
(narinfo-signature narinfo)))
|
||||
(contents
|
||||
(narinfo-contents narinfo)))
|
||||
|
||||
(match (string-contains contents "Signature:")
|
||||
(#f #f)
|
||||
(index
|
||||
(let* ((body (string-take contents index))
|
||||
(signature-line (string-drop contents index))
|
||||
(signature-sexp
|
||||
(canonical-sexp->sexp
|
||||
(narinfo-signature narinfo))))
|
||||
|
||||
(match (string-split (second (string-split signature-line
|
||||
#\space))
|
||||
#\;)
|
||||
((version host-name signature-data)
|
||||
|
||||
(first
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"narinfo_signature_data"
|
||||
'(version host_name data_hash data_hash_algorithm
|
||||
data_json sig_val_json narinfo_signature_public_key_id
|
||||
narinfo_body narinfo_signature_line)
|
||||
(list
|
||||
(append (list (string->number version)
|
||||
host-name)
|
||||
(let* ((data-sexp
|
||||
(find (match-lambda
|
||||
((component data ...)
|
||||
(if (eq? component 'data)
|
||||
data
|
||||
#f))
|
||||
(_ #f))
|
||||
signature-sexp))
|
||||
(hash-sexp
|
||||
(third data-sexp))
|
||||
(hash-algorithm
|
||||
(second hash-sexp))
|
||||
(hash
|
||||
(third hash-sexp)))
|
||||
(list
|
||||
(bytevector->base16-string hash)
|
||||
hash-algorithm
|
||||
(cons "jsonb"
|
||||
(sexp->json-string data-sexp))))
|
||||
(let ((sig-val-sexp
|
||||
(find (match-lambda
|
||||
((component data ...)
|
||||
(if (eq? component 'sig-val)
|
||||
data
|
||||
#f))
|
||||
(_ #f))
|
||||
signature-sexp)))
|
||||
(list
|
||||
(cons "jsonb"
|
||||
(sexp->json-string sig-val-sexp))))
|
||||
(list public-key-id
|
||||
body
|
||||
signature-line))))))))))))
|
||||
|
||||
(define (narinfo-signature->public-key-id conn signature)
|
||||
(let* ((public-key-sexp
|
||||
(find (match-lambda
|
||||
((component data ...)
|
||||
(if (eq? component 'public-key)
|
||||
data
|
||||
#f))
|
||||
(_ #f))
|
||||
(canonical-sexp->sexp signature)))
|
||||
(public-key-json-string
|
||||
(sexp->json-string public-key-sexp)))
|
||||
|
||||
(first
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"narinfo_signature_public_keys"
|
||||
'(sexp_json)
|
||||
(list (list (cons "jsonb"
|
||||
public-key-json-string)))))))
|
||||
|
||||
(define (select-outputs-for-successful-builds-without-known-nar-entries
|
||||
conn
|
||||
build-server-id
|
||||
guix-revision-commits)
|
||||
(define query
|
||||
(string-append "
|
||||
SELECT DISTINCT derivation_output_details.path
|
||||
FROM derivations
|
||||
INNER JOIN derivation_outputs
|
||||
ON derivations.id = derivation_outputs.id
|
||||
INNER JOIN derivation_output_details
|
||||
ON derivation_outputs.derivation_output_details_id = derivation_output_details.id
|
||||
WHERE file_name IN (
|
||||
SELECT derivation_file_name
|
||||
FROM builds
|
||||
INNER JOIN build_status
|
||||
ON builds.id = build_status.build_id
|
||||
WHERE
|
||||
build_server_id = $1 AND
|
||||
build_status.status = 'succeeded'
|
||||
) AND derivation_output_details.path NOT IN (
|
||||
SELECT store_path FROM nars
|
||||
) AND
|
||||
derivations.id IN (
|
||||
SELECT derivation_id
|
||||
FROM package_derivations
|
||||
INNER JOIN guix_revision_package_derivations
|
||||
ON guix_revision_package_derivations.package_derivation_id = package_derivations.id
|
||||
INNER JOIN guix_revisions
|
||||
ON guix_revisions.id = guix_revision_package_derivations.revision_id
|
||||
WHERE guix_revisions.commit IN ("
|
||||
(string-join (map quote-string guix-revision-commits)
|
||||
",")
|
||||
")
|
||||
)
|
||||
LIMIT 1500"))
|
||||
|
||||
(map car (exec-query conn query (list (number->string
|
||||
build-server-id)))))
|
||||
53
sqitch/deploy/nar_related_tables.sql
Normal file
53
sqitch/deploy/nar_related_tables.sql
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
-- Deploy guix-data-service:nar_related_tables to pg
|
||||
|
||||
BEGIN;
|
||||
|
||||
CREATE TABLE nars (
|
||||
id integer PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
|
||||
store_path varchar NOT NULL,
|
||||
hash_algorithm varchar NOT NULL,
|
||||
hash varchar NOT NULL,
|
||||
size integer NOT NULL,
|
||||
system varchar,
|
||||
deriver varchar
|
||||
);
|
||||
|
||||
CREATE TABLE nar_urls (
|
||||
nar_id integer NOT NULL REFERENCES nars(id),
|
||||
url varchar PRIMARY KEY,
|
||||
compression varchar NOT NULL,
|
||||
file_size integer NOT NULL
|
||||
);
|
||||
|
||||
CREATE TABLE nar_references (
|
||||
nar_id integer NOT NULL REFERENCES nars(id),
|
||||
reference varchar NOT NULL
|
||||
);
|
||||
|
||||
CREATE TABLE narinfo_signature_public_keys (
|
||||
id integer PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
|
||||
sexp_json jsonb NOT NULL,
|
||||
UNIQUE (sexp_json)
|
||||
);
|
||||
|
||||
CREATE TABLE narinfo_signature_data (
|
||||
id integer PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
|
||||
version integer NOT NULL,
|
||||
host_name varchar NOT NULL,
|
||||
data_hash varchar NOT NULL,
|
||||
data_hash_algorithm varchar NOT NULL,
|
||||
data_json jsonb NOT NULL,
|
||||
sig_val_json jsonb NOT NULL,
|
||||
narinfo_signature_public_key_id integer NOT NULL REFERENCES narinfo_signature_public_keys(id),
|
||||
narinfo_body varchar NOT NULL,
|
||||
narinfo_signature_line varchar NOT NULL,
|
||||
UNIQUE (narinfo_signature_line)
|
||||
);
|
||||
|
||||
CREATE TABLE narinfo_signatures (
|
||||
nar_id integer NOT NULL REFERENCES nars(id),
|
||||
narinfo_signature_data_id integer NOT NULL REFERENCES narinfo_signature_data(id),
|
||||
UNIQUE (nar_id, narinfo_signature_data_id)
|
||||
);
|
||||
|
||||
COMMIT;
|
||||
12
sqitch/revert/nar_related_tables.sql
Normal file
12
sqitch/revert/nar_related_tables.sql
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
-- Revert guix-data-service:nar_related_tables from pg
|
||||
|
||||
BEGIN;
|
||||
|
||||
DROP TABLE narinfo_signatures;
|
||||
DROP TABLE narinfo_signature_data;
|
||||
DROP TABLE narinfo_signature_public_keys;
|
||||
DROP TABLE nar_references;
|
||||
DROP TABLE nar_urls;
|
||||
DROP TABLE nars;
|
||||
|
||||
COMMIT;
|
||||
|
|
@ -29,3 +29,4 @@ package_derivations_by_guix_revision_range 2019-11-09T19:09:48Z Christopher Bain
|
|||
channel_news_tables 2019-11-15T07:32:07Z Christopher Baines <mail@cbaines.net> # Add tables to store channel news
|
||||
build_server_token_seeds 2019-11-23T09:26:48Z Christopher Baines <mail@cbaines.net> # Add build_server_token_seeds table
|
||||
rework_builds 2019-11-23T20:41:20Z Christopher Baines <mail@cbaines.net> # Rework the build tables
|
||||
nar_related_tables 2019-11-29T20:28:19Z Christopher Baines <mail@cbaines.net> # Add nar related tables
|
||||
|
|
|
|||
7
sqitch/verify/nar_related_tables.sql
Normal file
7
sqitch/verify/nar_related_tables.sql
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
-- Verify guix-data-service:nar_related_tables on pg
|
||||
|
||||
BEGIN;
|
||||
|
||||
-- XXX Add verifications here.
|
||||
|
||||
ROLLBACK;
|
||||
Loading…
Add table
Add a link
Reference in a new issue