diff options
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 51 | ||||
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http/server.scm | 28 | ||||
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 12 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 2 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore.scm | 4 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 115 |
6 files changed, 206 insertions, 6 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) |