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.
This commit is contained in:
Clément Lassieur
parent
36027f05e9
commit
ad05e96e14
2 changed files with 70 additions and 57 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Reference in a new issue