From ad05e96e14ff61c5739a9f8fc79aba8ed6545d16 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Lassieur?= Date: Tue, 20 Mar 2018 20:33:38 +0100 Subject: [PATCH] services: cgit: Add support for file-like objects. * doc/guix.texi (Version Control Services): Update accordingly. * gnu/services/cgit.scm (serialize-field, serialize-string, serialize-boolean, serialize-integer, serialize-repository-cgit-configuration-list, serialize-nginx-server-configuration-list, serialize-repo-field, serialize-repo-boolean, serialize-repo-integer, serialize-module-link-path, serialize-repository-directory, serialize-mimetype-alist): Return strings or string-valued gexps and stop printing. (repository-cgit-configuration)[source-filter, about-filter, commit-filter, logo, owner-filter], (cgit-configuration)[auth-filter, commit-filter, css, email-filter, favicon, include, logo, owner-filter, mimetype-file, readme, source-filter]: Replace STRING with FILE-OBJECT. (file-object?, serialize-file-object, repo-file-object?, serialize-repo-file-object): New procedures. (cgit-activation): Use SERIALIZE-CONFIGURATION's return value with MIXED-TEXT-FILE instead of using its output with PLAIN-FILE. --- doc/guix.texi | 40 +++++++++++--------- gnu/services/cgit.scm | 87 ++++++++++++++++++++++++------------------- 2 files changed, 70 insertions(+), 57 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index d825f39e0e..1e9601ca11 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18542,6 +18542,9 @@ By default, Cgit can be accessed on port 80 (@code{http://localhost:80}). (service cgit-service-type) @end example +The @code{file-object} type designates either a file-like object +(@pxref{G-Expressions, file-like objects}) or a string. + @c %start of fragment Available @code{cgit-configuration} fields are: @@ -18556,7 +18559,7 @@ NGINX configuration. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string about-filter +@deftypevr {@code{cgit-configuration} parameter} file-object about-filter Specifies a command which will be invoked to format the content of about pages (both top-level and for each repository). @@ -18572,7 +18575,7 @@ Defaults to @samp{""}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string auth-filter +@deftypevr {@code{cgit-configuration} parameter} file-object auth-filter Specifies a command that will be invoked for authenticating repository access. @@ -18681,7 +18684,7 @@ Defaults to @samp{()}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string commit-filter +@deftypevr {@code{cgit-configuration} parameter} file-object commit-filter Command which will be invoked to format commit messages. Defaults to @samp{""}. @@ -18697,14 +18700,14 @@ Defaults to @samp{"git log"}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string css +@deftypevr {@code{cgit-configuration} parameter} file-object css URL which specifies the css document to include in all cgit pages. Defaults to @samp{"/share/cgit/cgit.css"}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string email-filter +@deftypevr {@code{cgit-configuration} parameter} file-object email-filter Specifies a command which will be invoked to format names and email address of committers, authors, and taggers, as represented in various places throughout the cgit interface. @@ -18828,7 +18831,7 @@ Defaults to @samp{#f}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string favicon +@deftypevr {@code{cgit-configuration} parameter} file-object favicon URL used as link to a shortcut icon for cgit. Defaults to @samp{"/favicon.ico"}. @@ -18860,7 +18863,7 @@ Defaults to @samp{""}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string include +@deftypevr {@code{cgit-configuration} parameter} file-object include Name of a configfile to include before the rest of the current config- file is parsed. @@ -18892,7 +18895,7 @@ Defaults to @samp{#f}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string logo +@deftypevr {@code{cgit-configuration} parameter} file-object logo URL which specifies the source of an image which will be used as a logo on all cgit pages. @@ -18907,7 +18910,7 @@ Defaults to @samp{""}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string owner-filter +@deftypevr {@code{cgit-configuration} parameter} file-object owner-filter Command which will be invoked to format the Owner column of the main page. @@ -18976,7 +18979,7 @@ Defaults to @samp{((gif "image/gif") (html "text/html") (jpg @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string mimetype-file +@deftypevr {@code{cgit-configuration} parameter} file-object mimetype-file Specifies the file to use for automatic mimetype lookup. Defaults to @samp{""}. @@ -19014,7 +19017,7 @@ Defaults to @samp{#f}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string readme +@deftypevr {@code{cgit-configuration} parameter} file-object readme Text which will be used as default value for @code{cgit-repo-readme}. Defaults to @samp{""}. @@ -19132,7 +19135,7 @@ Defaults to @samp{#f}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} string source-filter +@deftypevr {@code{cgit-configuration} parameter} file-object source-filter Specifies a command which will be invoked to format plaintext blobs in the tree view. @@ -19194,7 +19197,7 @@ Defaults to @samp{()}. @end deftypevr -@deftypevr {@code{repository-cgit-configuration} parameter} repo-string source-filter +@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object source-filter Override the default @code{source-filter}. Defaults to @samp{""}. @@ -19208,7 +19211,7 @@ Defaults to @samp{""}. @end deftypevr -@deftypevr {@code{repository-cgit-configuration} parameter} repo-string about-filter +@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object about-filter Override the default @code{about-filter}. Defaults to @samp{""}. @@ -19230,7 +19233,7 @@ Defaults to @samp{()}. @end deftypevr -@deftypevr {@code{repository-cgit-configuration} parameter} repo-string commit-filter +@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object commit-filter Override the default @code{commit-filter}. Defaults to @samp{""}. @@ -19270,7 +19273,7 @@ Defaults to @samp{""}. @end deftypevr -@deftypevr {@code{repository-cgit-configuration} parameter} repo-string email-filter +@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object email-filter Override the default @code{email-filter}. Defaults to @samp{""}. @@ -19340,7 +19343,7 @@ Defaults to @samp{#f}. @end deftypevr -@deftypevr {@code{repository-cgit-configuration} parameter} repo-string logo +@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object logo URL which specifies the source of an image which will be used as a logo on this repo’s pages. @@ -19355,7 +19358,7 @@ Defaults to @samp{""}. @end deftypevr -@deftypevr {@code{repository-cgit-configuration} parameter} repo-string owner-filter +@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object owner-filter Override the default @code{owner-filter}. Defaults to @samp{""}. @@ -19440,6 +19443,7 @@ Defaults to @samp{()}. @end deftypevr + @c %end of fragment However, it could be that you just want to get a @code{cgitrc} up and diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm index 3c685f1b56..98e46e0b88 100644 --- a/gnu/services/cgit.scm +++ b/gnu/services/cgit.scm @@ -76,13 +76,12 @@ (string-delete #\? (symbol->string field-name))) (define (serialize-field field-name val) - (format #t "~a=~a\n" (uglify-field-name field-name) val)) + #~(format #f "~a=~a\n" #$(uglify-field-name field-name) #$val)) (define (serialize-string field-name val) - (if (string=? val "") "" (serialize-field field-name val))) - -(define (serialize-boolean field-name val) - (serialize-field field-name (if val 1 0))) + (if (and (string? val) (string=? val "")) + "" + (serialize-field field-name val))) (define (serialize-list field-name val) (if (null? val) "" (serialize-field field-name (string-join val)))) @@ -96,7 +95,10 @@ (exact-integer? val)) (define (serialize-integer field-name val) - (serialize-field field-name val)) + (serialize-field field-name (number->string val))) + +(define (serialize-boolean field-name val) + (serialize-integer field-name (if val 1 0))) (define (serialize-repository-cgit-configuration x) (serialize-configuration x repository-cgit-configuration-fields)) @@ -105,7 +107,13 @@ (list? val)) (define (serialize-repository-cgit-configuration-list field-name val) - (for-each serialize-repository-cgit-configuration val)) + #~(string-append + #$@(map serialize-repository-cgit-configuration val))) + +(define (file-object? val) + (or (file-like? val) (string? val))) +(define (serialize-file-object field-name val) + (serialize-string field-name val)) ;;; @@ -116,7 +124,7 @@ (and (list? val) (and-map nginx-server-configuration? val))) (define (serialize-nginx-server-configuration-list field-name val) - #f) + "") ;;; @@ -124,18 +132,18 @@ ;;; (define (serialize-repo-field field-name val) - (format #t "repo.~a=~a\n" (uglify-field-name field-name) val)) + #~(format #f "repo.~a=~a\n" #$(uglify-field-name field-name) #$val)) (define (serialize-repo-list field-name val) (if (null? val) "" (serialize-repo-field field-name (string-join val)))) (define repo-boolean? boolean?) -(define (serialize-repo-boolean field-name val) - (serialize-repo-field field-name (if val 1 0))) - (define (serialize-repo-integer field-name val) - (serialize-repo-field field-name val)) + (serialize-repo-field field-name (number->string val))) + +(define (serialize-repo-boolean field-name val) + (serialize-repo-integer field-name (if val 1 0))) (define repo-list? list?) @@ -144,23 +152,26 @@ (define (serialize-repo-string field-name val) (if (string=? val "") "" (serialize-repo-field field-name val))) +(define repo-file-object? file-object?) +(define serialize-repo-file-object serialize-repo-string) + (define module-link-path? list?) (define (serialize-module-link-path field-name val) (if (null? val) "" (match val ((path text) - (format #t "repo.module-link.~a=~a\n" path text))))) + (format #f "repo.module-link.~a=~a\n" path text))))) (define repository-directory? string?) (define (serialize-repository-directory _ val) - (if (string=? val "") "" (format #t "scan-path=~a\n" val))) + (if (string=? val "") "" (format #f "scan-path=~a\n" val))) (define mimetype-alist? list?) (define (serialize-mimetype-alist field-name val) - (format #t "# Mimetypes\n~a" + (format #f "# Mimetypes\n~a" (string-join (map (match-lambda ((extension mimetype) @@ -174,13 +185,13 @@ "A mask of snapshot formats for this repo that cgit generates links for, restricted by the global @code{snapshots} setting.") (source-filter - (repo-string "") + (repo-file-object "") "Override the default @code{source-filter}.") (url (repo-string "") "The relative URL used to access the repository.") (about-filter - (repo-string "") + (repo-file-object "") "Override the default @code{about-filter}.") (branch-sort (repo-string "") @@ -190,7 +201,7 @@ ref list, and when set to @samp{name} enables ordering by branch name.") (repo-list '()) "A list of URLs which can be used to clone repo.") (commit-filter - (repo-string "") + (repo-file-object "") "Override the default @code{commit-filter}.") (commit-sort (repo-string "") @@ -209,7 +220,7 @@ is no suitable HEAD.") (repo-string "") "The value to show as repository homepage.") (email-filter - (repo-string "") + (repo-file-object "") "Override the default @code{email-filter}.") (enable-commit-graph? (repo-boolean #f) @@ -243,14 +254,14 @@ repository index.") (repo-boolean #f) "Flag which, when set to @samp{#t}, ignores the repository.") (logo - (repo-string "") + (repo-file-object "") "URL which specifies the source of an image which will be used as a logo on this repo’s pages.") (logo-link (repo-string "") "URL loaded when clicking on the cgit logo image.") (owner-filter - (repo-string "") + (repo-file-object "") "Override the default @code{owner-filter}.") (module-link (repo-string "") @@ -296,7 +307,7 @@ after this option will inherit the current section name.") (nginx-server-configuration-list (list %cgit-configuration-nginx)) "NGINX configuration.") (about-filter - (string "") + (file-object "") "Specifies a command which will be invoked to format the content of about pages (both top-level and for each repository).") (agefile @@ -304,7 +315,7 @@ pages (both top-level and for each repository).") "Specifies a path, relative to each repository path, which can be used to specify the date and time of the youngest commit in the repository.") (auth-filter - (string "") + (file-object "") "Specifies a command that will be invoked for authenticating repository access.") (branch-sort @@ -357,7 +368,7 @@ generates valid clone URLs for the repository.") (list '()) "List of @code{clone-url} templates.") (commit-filter - (string "") + (file-object "") "Command which will be invoked to format commit messages.") (commit-sort (string "git log") @@ -365,10 +376,10 @@ generates valid clone URLs for the repository.") commit log, and when set to @samp{topo} enables strict topological ordering.") (css - (string "/share/cgit/cgit.css") + (file-object "/share/cgit/cgit.css") "URL which specifies the css document to include in all cgit pages.") (email-filter - (string "") + (file-object "") "Specifies a command which will be invoked to format names and email address of committers, authors, and taggers, as represented in various places throughout the cgit interface.") @@ -432,7 +443,7 @@ links for plaintext blobs printed in the tree view.") "Flag which, when set to @samp{#f}, will allow cgit to use Git config to set any repo specific settings.") (favicon - (string "/favicon.ico") + (file-object "/favicon.ico") "URL used as link to a shortcut icon for cgit.") (footer (string "") @@ -448,7 +459,7 @@ verbatim in the HTML HEAD section on all pages.") "The content of the file specified with this option will be included verbatim at the top of all pages.") (include - (string "") + (file-object "") "Name of a configfile to include before the rest of the current config- file is parsed.") (index-header @@ -464,14 +475,14 @@ verbatim below the heading on the repository index page.") "Flag which, if set to @samp{#t}, makes cgit print commit and tag times in the servers timezone.") (logo - (string "/share/cgit/cgit.png") + (file-object "/share/cgit/cgit.png") "URL which specifies the source of an image which will be used as a logo on all cgit pages.") (logo-link (string "") "URL loaded when clicking on the cgit logo image.") (owner-filter - (string "") + (file-object "") "Command which will be invoked to format the Owner column of the main page.") (max-atom-items @@ -508,7 +519,7 @@ on the repository index page.") (svg "image/svg+xml"))) "Mimetype for the specified filename extension.") (mimetype-file - (string "") + (file-object "") "Specifies the file to use for automatic mimetype lookup.") (module-link (string "") @@ -533,7 +544,7 @@ header on all pages.") ;; "A list of subdirectories inside of @code{repository-directory}, ;; relative to it, that should loaded as Git repositories.") (readme - (string "") + (file-object "") "Text which will be used as default value for @code{cgit-repo-readme}.") (remove-suffix? (boolean #f) @@ -591,7 +602,7 @@ many path elements from each repo path to use as a default section name.") "If set to @samp{#t} shows side-by-side diffs instead of unidiffs per default.") (source-filter - (string "") + (file-object "") "Specifies a command which will be invoked to format plaintext blobs in the tree view.") (summary-branches @@ -640,16 +651,14 @@ for cgit to allow access to that repository.") (config-str (if opaque-config? (opaque-cgit-configuration-cgitrc config) - (with-output-to-string - (lambda () - (serialize-configuration config - cgit-configuration-fields)))))) + (serialize-configuration config cgit-configuration-fields)))) #~(begin (use-modules (guix build utils)) (mkdir-p #$(if opaque-config? (opaque-cgit-configuration-cache-root config) (cgit-configuration-cache-root config))) - (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc")))) + (copy-file #$(mixed-text-file "cgitrc" config-str) + "/etc/cgitrc")))) (define (cgit-configuration-nginx-config config) (if (opaque-cgit-configuration? config)