diff options
author | Christopher Baines <mail@cbaines.net> | 2019-06-24 20:30:47 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-06-24 20:30:47 +0100 |
commit | 54b992246637fb4f73a9d8b15d381cdc7bce3183 (patch) | |
tree | 8e2f8a01bcdf416ee59cb5c09af8a123d93e8146 /guix-data-service | |
parent | afa86d61158f3bbded19f71bed9370d76a4f6622 (diff) | |
download | data-service-54b992246637fb4f73a9d8b15d381cdc7bce3183.tar data-service-54b992246637fb4f73a9d8b15d381cdc7bce3183.tar.gz |
Iterate the log viewing
Replace the Guile-side HTML escaping with a less complete, but hopefully
faster PostgreSQL side HTML escaping approach.
Also, allow reading part of the log, by default, the last 1,000,000
characters, as this should render quickly.
Diffstat (limited to 'guix-data-service')
-rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 35 | ||||
-rw-r--r-- | guix-data-service/web/controller.scm | 21 | ||||
-rw-r--r-- | guix-data-service/web/view/html.scm | 25 |
3 files changed, 70 insertions, 11 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 8650202..7eb6cdf 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -69,14 +69,41 @@ #f) ; number of characters that can be read "w")) -(define (log-for-job conn job-id) +(define* (log-for-job conn job-id + #:key + character-limit + start-character) + (define (sql-html-escape s) + (string-append + "replace(" + (string-append + "replace(" + (string-append + "replace(" + s + ",'&','&')") + ",'<','<')") + ",'>','>')")) + + (define (get-characters s) + (if start-character + (simple-format #f "substr(~A, ~A, ~A)" + s start-character + character-limit) + (simple-format #f "right(~A, ~A)" s character-limit))) + (define log-query - "SELECT contents FROM load_new_guix_revision_job_logs WHERE job_id = $1") + (string-append + "SELECT " + (sql-html-escape (get-characters "contents")) + " FROM load_new_guix_revision_job_logs WHERE job_id = $1")) (define parts-query (string-append - "SELECT STRING_AGG(contents, '' ORDER BY id ASC) " - "FROM load_new_guix_revision_job_log_parts WHERE job_id = $1")) + "SELECT " + (sql-html-escape + (get-characters "STRING_AGG(contents, '' ORDER BY id ASC)")) + " FROM load_new_guix_revision_job_log_parts WHERE job_id = $1")) (match (exec-query conn log-query (list job-id)) (((contents)) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 6990fb9..d964497 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -529,11 +529,16 @@ #:sxml (view-jobs (select-jobs-and-events conn)))) -(define (render-job mime-types conn job-id) +(define (render-job mime-types conn job-id query-parameters) (render-html #:sxml (view-job job-id - (log-for-job conn job-id)))) + query-parameters + (log-for-job conn job-id + #:character-limit + (assq-ref query-parameters 'characters) + #:start-character + (assq-ref query-parameters 'start_character))))) (define (parse-commit conn) (lambda (s) @@ -823,8 +828,14 @@ (render-jobs mime-types conn)) ((GET "job" job-id) - (render-job mime-types - conn - job-id)) + (let ((parsed-query-parameters + (parse-query-parameters + request + `((start_character ,parse-number) + (characters ,parse-number #:default 1000000))))) + (render-job mime-types + conn + job-id + parsed-query-parameters))) ((GET path ...) (not-found (request-uri request))))) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index da7e992..ca744ff 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -975,7 +975,7 @@ '()))))) jobs-and-events))))))))) -(define (view-job job-id log) +(define (view-job job-id query-parameters log) (layout #:body `(,(header) @@ -989,7 +989,28 @@ (div (@ (class "row")) (div - (pre ,log))))))) + (@ (class "col-md-12")) + (div + (@ (class "well")) + (form + (@ (method "get") + (action "") + (class "form-horizontal")) + ,(form-horizontal-control + "Characters" query-parameters + #:help-text "Return at most this many characters.") + ,(form-horizontal-control + "Start character" query-parameters + #:help-text "Start reading the log from this character.") + (div (@ (class "form-group form-group-lg")) + (div (@ (class "col-sm-offset-2 col-sm-10")) + (button (@ (type "submit") + (class "btn btn-lg btn-primary")) + "Update log"))))))) + (div + (@ (class "row")) + (div + (pre (raw ,log)))))))) (define (view-derivation derivation derivation-inputs derivation-outputs builds) |