From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:56059) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f4rJu-0003eZ-1p for guix-patches@gnu.org; Sat, 07 Apr 2018 13:08:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f4rJq-0002fF-Vy for guix-patches@gnu.org; Sat, 07 Apr 2018 13:08:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:33581) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1f4rJq-0002ex-Qu for guix-patches@gnu.org; Sat, 07 Apr 2018 13:08:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1f4rJq-00031f-Jd for guix-patches@gnu.org; Sat, 07 Apr 2018 13:08:02 -0400 Subject: [bug#31089] [PATCH 3/5] services: cgit: Add support for file-like objects. Resent-Message-ID: From: =?UTF-8?Q?Cl=C3=A9ment?= Lassieur Date: Sat, 7 Apr 2018 19:07:07 +0200 Message-Id: <20180407170709.22160-3-clement@lassieur.org> In-Reply-To: <20180407170709.22160-1-clement@lassieur.org> References: <20180407170709.22160-1-clement@lassieur.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 31089@debbugs.gnu.org * 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 | 37 +++++++++--------- gnu/services/cgit.scm | 87 ++++++++++++++++++++++++------------------- 2 files changed, 67 insertions(+), 57 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 738fdf65c..35d23e1be 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18552,7 +18552,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). @@ -18568,7 +18568,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. @@ -18677,7 +18677,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{""}. @@ -18693,14 +18693,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. @@ -18824,7 +18824,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"}. @@ -18856,7 +18856,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. @@ -18888,7 +18888,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. @@ -18903,7 +18903,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. @@ -18972,7 +18972,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{""}. @@ -19010,7 +19010,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{""}. @@ -19128,7 +19128,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. @@ -19190,7 +19190,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{""}. @@ -19204,7 +19204,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{""}. @@ -19226,7 +19226,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{""}. @@ -19266,7 +19266,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{""}. @@ -19336,7 +19336,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. @@ -19351,7 +19351,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{""}. @@ -19436,6 +19436,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 3c685f1b5..98e46e0b8 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) -- 2.17.0