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.
master
Clément Lassieur 2018-03-20 20:33:38 +01:00
parent 36027f05e9
commit ad05e96e14
No known key found for this signature in database
GPG Key ID: 89F96D4808F359C7
2 changed files with 70 additions and 57 deletions

View File

@ -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 repos 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

View File

@ -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 repos 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)