diff options
21 files changed, 358 insertions, 18 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 1f2df0a..752f354 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -47,6 +47,8 @@ #:use-module (guix-build-coordinator agent-messaging abstract) #:export (make-http-agent-interface + fetch-session-credentials + submit-status submit-log-file submit-build-result @@ -68,7 +70,8 @@ #:agent-uuid agent-uuid #:password password)) -(define (coordinator-uri-for-path base-uri-string agent-path) +(define* (coordinator-uri-for-path base-uri-string agent-path + #:key query) (let* ((base-uri (string->uri base-uri-string)) (scheme (uri-scheme base-uri)) (host (uri-host base-uri)) @@ -82,7 +85,8 @@ path (if (string-suffix? path "/") agent-path - (string-drop agent-path 1)))))) + (string-drop agent-path 1))) + #:query query))) (define (with-request-mutex thunk) (if (running-on-the-hurd?) @@ -184,6 +188,49 @@ #:delay 10 #:ignore agent-error-from-coordinator?)) +(define* (fetch-session-credentials coordinator + name + token + #:key (log default-log)) + (define method 'POST) + (define path "/agent/fetch-session-credentials") + (define uri (coordinator-uri-for-path coordinator path + #:query + (simple-format #f "name=~A&token=~A" + name token))) + + (let-values (((response body) + (http-request uri + #:method method + #:decode-body? #f))) + (let ((code (response-code response))) + (cond + ((eq? code 400) + (and=> (coordinator-handle-failed-request log + method + path + response + body) + (lambda (error) + (raise-exception + (make-agent-error-from-coordinator + (assoc-ref error "error")))))) + + ((>= (response-code response) 400) + (let ((body + (coordinator-handle-failed-request log + method + path + response + body))) + (raise-exception + (make-exception-with-message + body)))) + (else + (values + (json-string->scm (utf8->string body)) + response)))))) + (define-method (submit-status (interface <http-agent-interface>) . diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm index 338bab6..da602ea 100644 --- a/guix-build-coordinator/agent-messaging/http/server.scm +++ b/guix-build-coordinator/agent-messaging/http/server.scm @@ -241,6 +241,34 @@ port. Also, the port used can be changed by passing the --port option.\n" (render-json '(("error" . "access denied")) #:code 403))) + (('POST "agent" "fetch-session-credentials") + (let* ((query-parameters (request-query-parameters request)) + (name (assq-ref query-parameters 'name)) + (token (assq-ref query-parameters 'token))) + (if (and (string? name) + (string? token)) + (let ((agent-uuid (or (datastore-find-agent-by-name + datastore + name) + (new-agent datastore + #:name name)))) + (if (datastore-dynamic-auth-token-exists? datastore token) + (let ((password + (match (datastore-agent-list-passwords datastore + agent-uuid) + (() + (new-agent-password datastore #:agent agent-uuid)) + ((password . rest) + password)))) + (render-json + `((id . ,agent-uuid) + (password . ,password)))) + (render-json + '(("error" . "token not recognised")) + #:code 403))) + (render-json + '(("error" . "access denied")) + #:code 403)))) (('POST "agent" uuid "fetch-builds") (if (authenticated? uuid request) (let* ((json-body (json-string->scm (utf8->string body))) diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 550b054..664b9aa 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -29,6 +29,7 @@ #:use-module (rnrs bytevectors) #:use-module (json) #:use-module (logging logger) + #:use-module (gcrypt random) #:use-module (web uri) #:use-module (web client) #:use-module (web request) @@ -52,6 +53,7 @@ request-failed-builds-with-blocking-count-list send-create-agent-request send-create-agent-password-request + send-create-dynamic-auth-token-request send-replace-agent-tags-request)) (define (start-client-request-server secret-key-base @@ -217,6 +219,11 @@ #:description (assoc-ref body "description")))) (render-json `((agent-id . ,uuid))))) + (('POST "dynamic-auth-tokens") + (let ((token (random-token))) + (datastore-insert-dynamic-auth-token datastore token) + (render-json + `((token . ,token))))) (('GET "agent" agent-id) (let ((agent-details (datastore-find-agent datastore agent-id))) (render-json @@ -631,6 +638,11 @@ 'POST (string-append "/agent/" agent-id "/passwords"))) +(define (send-create-dynamic-auth-token-request coordinator-uri) + (send-request coordinator-uri + 'POST + "/dynamic-auth-tokens")) + (define (send-replace-agent-tags-request coordinator-uri agent-id tags) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index f9f9bf8..bae5d11 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -390,11 +390,13 @@ (define* (new-agent datastore #:key requested-uuid + name description) (let ((uuid (or requested-uuid (random-v4-uuid)))) (datastore-new-agent datastore uuid + name description) uuid)) diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index 24b9bbb..0f072ac 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -19,6 +19,9 @@ (re-export datastore-new-agent) (re-export datastore-list-agents) (re-export datastore-find-agent) +(re-export datastore-find-agent-by-name) +(re-export datastore-insert-dynamic-auth-token) +(re-export datastore-dynamic-auth-token-exists?) (re-export datastore-fetch-agent-tags) (re-export datastore-count-build-results) (re-export datastore-insert-build-result) @@ -41,6 +44,7 @@ (re-export datastore-list-setup-failure-missing-inputs) (re-export datastore-new-agent-password) (re-export datastore-agent-password-exists?) +(re-export datastore-agent-list-passwords) (re-export datastore-replace-agent-tags) (re-export datastore-count-builds) (re-export datastore-for-each-build) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 3a110e5..898a148 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -46,6 +46,9 @@ datastore-new-agent datastore-list-agents datastore-find-agent + datastore-find-agent-by-name + datastore-insert-dynamic-auth-token + datastore-dynamic-auth-token-exists? datastore-fetch-agent-tags datastore-store-build-start datastore-find-build-starts @@ -64,6 +67,7 @@ datastore-list-builds-for-output-and-system datastore-new-agent-password datastore-agent-password-exists? + datastore-agent-list-passwords datastore-replace-agent-tags datastore-list-processed-builds datastore-list-unprocessed-builds @@ -378,6 +382,82 @@ SELECT description FROM agents WHERE id = :id" result))))) +(define-method (datastore-find-agent-by-name + (datastore <sqlite-datastore>) + name) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT id FROM agents WHERE name = :name" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:name name) + + (let ((result + (match (sqlite-map + (match-lambda + (#(id) id)) + statement) + (() #f) + ((agent) agent)))) + (sqlite-reset statement) + + result))))) + +(define-method (datastore-insert-dynamic-auth-token + (datastore <sqlite-datastore>) + token) + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +INSERT INTO dynamic_auth_tokens (token) VALUES (:token)" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:token token) + + (sqlite-step statement) + (sqlite-reset statement))))) + +(define-method (datastore-dynamic-auth-token-exists? + (datastore <sqlite-datastore>) + token) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT 1 FROM dynamic_auth_tokens WHERE token = :token" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:token token) + + (let ((result + (match (sqlite-map + (match-lambda + (#(1) #t)) + statement) + ((#t) #t) + (() #f)))) + (sqlite-reset statement) + + result))))) + (define-method (datastore-fetch-agent-tags (datastore <sqlite-datastore>) agent-id) @@ -416,11 +496,12 @@ WHERE agent_tags.agent_id = :agent_id" (define-method (datastore-new-agent (datastore <sqlite-datastore>) uuid + name description) (call-with-worker-thread (slot-ref datastore 'worker-writer-thread-channel) (lambda (db) - (insert-agent db uuid description))) + (insert-agent db uuid name description))) #t) (define-method (datastore-list-agents @@ -483,6 +564,31 @@ WHERE agent_id = :agent_id AND password = :password" result))))) +(define-method (datastore-agent-list-passwords + (datastore <sqlite-datastore>) + uuid) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT password FROM agent_passwords WHERE agent_id = :agent_id" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:agent_id uuid) + + (let ((result (sqlite-map + (match-lambda + (#(password) password)) + statement))) + (sqlite-reset statement) + + result))))) + (define-method (datastore-replace-agent-tags (datastore <sqlite-datastore>) agent-id @@ -3097,18 +3203,19 @@ VALUES (:uuid, :derivation_name, :priority, datetime('now'), :deferred_until)" (sqlite-reset statement)))) #t) -(define (insert-agent db uuid description) +(define (insert-agent db uuid name description) (let ((statement (sqlite-prepare db " -INSERT INTO agents (id, description) -VALUES (:id, :description)" +INSERT INTO agents (id, name, description) +VALUES (:id, :name, :description)" #:cache? #t))) (sqlite-bind-arguments statement #:id uuid + #:name name #:description description) (sqlite-step statement) diff --git a/scripts/guix-build-coordinator-agent.in b/scripts/guix-build-coordinator-agent.in index 895adf7..b5c0bd0 100644 --- a/scripts/guix-build-coordinator-agent.in +++ b/scripts/guix-build-coordinator-agent.in @@ -23,13 +23,15 @@ ;;; <http://www.gnu.org/licenses/>. (use-modules (srfi srfi-1) + (srfi srfi-11) (srfi srfi-37) (ice-9 threads) (ice-9 textual-ports) ((guix config) #:prefix guix-config:) (guix-build-coordinator utils) (guix-build-coordinator agent) - (guix-build-coordinator agent-messaging)) + (guix-build-coordinator agent-messaging) + (guix-build-coordinator agent-messaging http)) (define %options ;; Specifications of the command-line options @@ -43,6 +45,11 @@ (alist-cons 'uuid arg result))) + (option '("name") #t #f + (lambda (opt name arg result) + (alist-cons 'name + arg + result))) (option '("password") #t #f (lambda (opt name arg result) (alist-cons 'password @@ -54,6 +61,17 @@ (string-trim-right (call-with-input-file arg get-string-all)) result))) + (option '("dynamic-auth-token") #t #f + (lambda (opt name arg result) + (alist-cons 'dynamic-auth-token + arg + result))) + (option '("dynamic-auth-token-file") #t #f + (lambda (opt name arg result) + (alist-cons 'dynamic-auth-token + (string-trim-right + (call-with-input-file arg get-string-all)) + result))) (option '("max-parallel-builds") #t #f (lambda (opt name arg result) (alist-cons 'max-parallel-builds @@ -117,16 +135,39 @@ (let ((opts (parse-options %options %option-defaults (cdr (program-arguments))))) - (run-agent (assq-ref opts 'uuid) + (let-values + (((uuid coordinator-interface) + (cond + ((and (string? (assq-ref opts 'uuid)) + (string? (assq-ref opts 'password))) + (values + (assq-ref opts 'uuid) + (make-http-agent-interface + (assq-ref opts 'coordinator) + (assq-ref opts 'uuid) + (assq-ref opts 'password)))) + ((and (string? (assq-ref opts 'name)) + (string? (assq-ref opts 'dynamic-auth-token))) + (let ((session-credentials + (fetch-session-credentials (assq-ref opts 'coordinator) + (assq-ref opts 'name) + (assq-ref opts 'dynamic-auth-token)))) + (values + (assoc-ref session-credentials "id") (make-http-agent-interface (assq-ref opts 'coordinator) - (assq-ref opts 'uuid) - (assq-ref opts 'password)) - (delete-duplicates (assq-ref opts 'systems)) - (assq-ref opts 'max-parallel-builds) - (or (assq-ref opts 'derivation-substitute-urls) - (assq-ref opts 'substitute-urls)) - (or (assq-ref opts 'non-derivation-substitute-urls) - (assq-ref opts 'substitute-urls)) - (assq-ref opts 'metrics-file) - (assq-ref opts 'max-1min-load-average))) + (assoc-ref session-credentials "id") + (assoc-ref session-credentials "password"))))) + (else + (error "unknown coordinator interface"))))) + + (run-agent uuid + coordinator-interface + (delete-duplicates (assq-ref opts 'systems)) + (assq-ref opts 'max-parallel-builds) + (or (assq-ref opts 'derivation-substitute-urls) + (assq-ref opts 'substitute-urls)) + (or (assq-ref opts 'non-derivation-substitute-urls) + (assq-ref opts 'substitute-urls)) + (assq-ref opts 'metrics-file) + (assq-ref opts 'max-1min-load-average)))) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 4c7e208..f85a0ce 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -737,6 +737,17 @@ tags: (assoc-ref (request-agents-list (assq-ref opts 'coordinator)) "agents"))))) + (("dynamic-auth" "create-token") + (let ((opts (parse-options (append %client-options + %base-options) + (append %client-option-defaults + %base-option-defaults) + '()))) + (let ((token + (assoc-ref (send-create-dynamic-auth-token-request + (assq-ref opts 'coordinator)) + "token"))) + (simple-format #t "~A\n" token)))) ((arguments ...) (let* ((opts (parse-options (append %service-options %base-options) diff --git a/sqitch/pg/deploy/add_agent_names.sql b/sqitch/pg/deploy/add_agent_names.sql new file mode 100644 index 0000000..e53c2f1 --- /dev/null +++ b/sqitch/pg/deploy/add_agent_names.sql @@ -0,0 +1,7 @@ +-- Deploy guix-build-coordinator:add_agent_names to pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/pg/deploy/add_dynamic_auth_tokens.sql b/sqitch/pg/deploy/add_dynamic_auth_tokens.sql new file mode 100644 index 0000000..5a4022d --- /dev/null +++ b/sqitch/pg/deploy/add_dynamic_auth_tokens.sql @@ -0,0 +1,7 @@ +-- Deploy guix-build-coordinator:add_dynamic_auth_tokens to pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/pg/revert/add_agent_names.sql b/sqitch/pg/revert/add_agent_names.sql new file mode 100644 index 0000000..9446feb --- /dev/null +++ b/sqitch/pg/revert/add_agent_names.sql @@ -0,0 +1,7 @@ +-- Revert guix-build-coordinator:add_agent_names from pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/pg/revert/add_dynamic_auth_tokens.sql b/sqitch/pg/revert/add_dynamic_auth_tokens.sql new file mode 100644 index 0000000..b061032 --- /dev/null +++ b/sqitch/pg/revert/add_dynamic_auth_tokens.sql @@ -0,0 +1,7 @@ +-- Revert guix-build-coordinator:add_dynamic_auth_tokens from pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/pg/verify/add_agent_names.sql b/sqitch/pg/verify/add_agent_names.sql new file mode 100644 index 0000000..9f69522 --- /dev/null +++ b/sqitch/pg/verify/add_agent_names.sql @@ -0,0 +1,7 @@ +-- Verify guix-build-coordinator:add_agent_names on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; diff --git a/sqitch/pg/verify/add_dynamic_auth_tokens.sql b/sqitch/pg/verify/add_dynamic_auth_tokens.sql new file mode 100644 index 0000000..b0b62a0 --- /dev/null +++ b/sqitch/pg/verify/add_dynamic_auth_tokens.sql @@ -0,0 +1,7 @@ +-- Verify guix-build-coordinator:add_dynamic_auth_tokens on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan index 513609c..19e2b11 100644 --- a/sqitch/sqitch.plan +++ b/sqitch/sqitch.plan @@ -26,3 +26,5 @@ support_build_cancelation 2020-12-11T18:25:42Z Christopher Baines <mail@cbaines. add_build_tags_build_id_idx 2020-12-21T13:20:54Z Christopher Baines <mail@cbaines.net> # Add an index on build_tags.build_id add_builds_deferred_until 2020-12-26T19:26:32Z Christopher Baines <mail@cbaines.net> # Add builds.deferred_until add_agent_tags 2021-01-17T11:13:23Z Christopher Baines <mail@cbaines.net> # Add tags for agents +add_agent_names 2021-02-28T14:04:24Z Christopher Baines <mail@cbaines.net> # Add agent.names +add_dynamic_auth_tokens 2021-02-28T15:21:24Z Christopher Baines <mail@cbaines.net> # Add dynamic_auth_tokens diff --git a/sqitch/sqlite/deploy/add_agent_names.sql b/sqitch/sqlite/deploy/add_agent_names.sql new file mode 100644 index 0000000..bc2ec44 --- /dev/null +++ b/sqitch/sqlite/deploy/add_agent_names.sql @@ -0,0 +1,7 @@ +-- Deploy guix-build-coordinator:add_agent_names to sqlite + +BEGIN; + +ALTER TABLE agents ADD COLUMN name TEXT; + +COMMIT; diff --git a/sqitch/sqlite/deploy/add_dynamic_auth_tokens.sql b/sqitch/sqlite/deploy/add_dynamic_auth_tokens.sql new file mode 100644 index 0000000..9d50c95 --- /dev/null +++ b/sqitch/sqlite/deploy/add_dynamic_auth_tokens.sql @@ -0,0 +1,9 @@ +-- Deploy guix-build-coordinator:add_dynamic_auth_tokens to sqlite + +BEGIN; + +CREATE TABLE dynamic_auth_tokens ( + token TEXT NOT NULL +); + +COMMIT; diff --git a/sqitch/sqlite/revert/add_agent_names.sql b/sqitch/sqlite/revert/add_agent_names.sql new file mode 100644 index 0000000..5bfd09e --- /dev/null +++ b/sqitch/sqlite/revert/add_agent_names.sql @@ -0,0 +1,7 @@ +-- Revert guix-build-coordinator:add_agent_names from sqlite + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/sqlite/revert/add_dynamic_auth_tokens.sql b/sqitch/sqlite/revert/add_dynamic_auth_tokens.sql new file mode 100644 index 0000000..8bf4e0a --- /dev/null +++ b/sqitch/sqlite/revert/add_dynamic_auth_tokens.sql @@ -0,0 +1,7 @@ +-- Revert guix-build-coordinator:add_dynamic_auth_tokens from sqlite + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/sqlite/verify/add_agent_names.sql b/sqitch/sqlite/verify/add_agent_names.sql new file mode 100644 index 0000000..e072871 --- /dev/null +++ b/sqitch/sqlite/verify/add_agent_names.sql @@ -0,0 +1,7 @@ +-- Verify guix-build-coordinator:add_agent_names on sqlite + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; diff --git a/sqitch/sqlite/verify/add_dynamic_auth_tokens.sql b/sqitch/sqlite/verify/add_dynamic_auth_tokens.sql new file mode 100644 index 0000000..b14eba5 --- /dev/null +++ b/sqitch/sqlite/verify/add_dynamic_auth_tokens.sql @@ -0,0 +1,7 @@ +-- Verify guix-build-coordinator:add_dynamic_auth_tokens on sqlite + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; |