From 1d84d7bf6052c0c80bd212d4524876576e9817d4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 15 Feb 2018 16:13:36 +0100 Subject: build: Require Guile >= 2.0.13. * README, configure.ac, doc/guix.texi (Requirements): Increase minimum Guile version from 2.0.9 to 2.0.13. * config-daemon.ac: Remove use of 'GUIX_CHECK_UNBUFFERED_CBIP'. * m4/guix.m4 (GUIX_CHECK_UNBUFFERED_CBIP): Remove. * guix/build/download.scm (current-http-proxy): Remove. * guix/build/syscalls.scm (%libc-errno-pointer, errno): Remove. (syscall->procedure): Use #:return-errno unconditionally. * guix/hash.scm (open-sha256-input-port)[unbuffered]: Remove outdated comment. * guix/http-client.scm (when-guile<=2.0.5-or-otherwise-broken): Remove. : Remove 'when-guile<=2.0.5-or-otherwise-broken' block. * guix/scripts/substitute.scm (fetch): Remove 'guile-version>?' conditional. * tests/hash.scm (supports-unbuffered-cbip?): Remove. : Remove 'test-skip' call. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 691164502b..f9d7e13e21 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -601,7 +601,7 @@ in the Guix source tree for additional details. GNU Guix depends on the following packages: @itemize -@item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.9 or +@item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.13 or later, including 2.2.x; @item @url{http://gnupg.org/, GNU libgcrypt}; @item -- cgit v1.2.3 From e1cf4fd2d2fc0aab0f91c8ac961a8134cbefe200 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Tue, 12 Dec 2017 02:13:55 +0300 Subject: services: cgit: Add more configuration fields. * gnu/services/version-control.scm (cgit-service-type): Move to separate file. * gnu/services/cgit.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add this. * gnu/tests/version-control.scm: Add this. * doc/guix.texi (Cgit Service): Document this. --- doc/guix.texi | 948 +++++++++++++++++++++++++++++++++++++-- gnu/local.mk | 1 + gnu/services/cgit.scm | 686 ++++++++++++++++++++++++++++ gnu/services/version-control.scm | 121 ----- gnu/tests/version-control.scm | 3 +- 5 files changed, 1601 insertions(+), 158 deletions(-) create mode 100644 gnu/services/cgit.scm (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index f9d7e13e21..24db167618 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -45,7 +45,8 @@ Copyright @copyright{} 2017 George Clemmer@* Copyright @copyright{} 2017 Andy Wingo@* Copyright @copyright{} 2017, 2018 Arun Isaac@* Copyright @copyright{} 2017 nee@* -Copyright @copyright{} 2018 Rutger Helling +Copyright @copyright{} 2018 Rutger Helling@* +Copyright @copyright{} 2018 Oleg Pykhalov Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -18542,54 +18543,929 @@ By default, Cgit can be accessed on port 80 (@code{http://localhost:80}). (service cgit-service-type) @end example -@deftp {Data Type} cgit-configuration -Data type representing the configuration of Cgit. -This type has the following parameters: +@c %start of fragment + +Available @code{cgit-configuration} fields are: + +@deftypevr {@code{cgit-configuration} parameter} package package +The CGIT package. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} nginx-server-configuration-list nginx +NGINX configuration. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string about-filter +Specifies a command which will be invoked to format the content of about +pages (both top-level and for each repository). + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string agefile +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. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string auth-filter +Specifies a command that will be invoked for authenticating repository +access. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string branch-sort +Flag which, when set to @samp{age}, enables date ordering in the branch +ref list, and when set @samp{name} enables ordering by branch name. + +Defaults to @samp{"name"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string cache-root +Path used to store the cgit cache entries. + +Defaults to @samp{"/var/cache/cgit"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-static-ttl +Number which specifies the time-to-live, in minutes, for the cached +version of repository pages accessed with a fixed SHA1. + +Defaults to @samp{-1}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-dynamic-ttl +Number which specifies the time-to-live, in minutes, for the cached +version of repository pages accessed without a fixed SHA1. + +Defaults to @samp{5}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-repo-ttl +Number which specifies the time-to-live, in minutes, for the cached +version of the repository summary page. + +Defaults to @samp{5}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-root-ttl +Number which specifies the time-to-live, in minutes, for the cached +version of the repository index page. + +Defaults to @samp{5}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-scanrc-ttl +Number which specifies the time-to-live, in minutes, for the result of +scanning a path for Git repositories. + +Defaults to @samp{15}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-about-ttl +Number which specifies the time-to-live, in minutes, for the cached +version of the repository about page. + +Defaults to @samp{15}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-snapshot-ttl +Number which specifies the time-to-live, in minutes, for the cached +version of snapshots. + +Defaults to @samp{5}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer cache-size +The maximum number of entries in the cgit cache. When set to @samp{0}, +caching is disabled. + +Defaults to @samp{0}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean case-sensitive-sort? +Sort items in the repo list case sensitively. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} list clone-prefix +List of common prefixes which, when combined with a repository URL, +generates valid clone URLs for the repository. + +Defaults to @samp{()}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} list clone-url +List of @code{clone-url} templates. + +Defaults to @samp{()}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string commit-filter +Command which will be invoked to format commit messages. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string commit-sort +Flag which, when set to @samp{date}, enables strict date ordering in the +commit log, and when set to @samp{topo} enables strict topological +ordering. + +Defaults to @samp{"git log"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string 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 +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. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean embedded? +Flag which, when set to @samp{#t}, will make cgit generate a HTML +fragment suitable for embedding in other HTML pages. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-commit-graph? +Flag which, when set to @samp{#t}, will make cgit print an ASCII-art +commit history graph to the left of the commit messages in the +repository log page. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-filter-overrides? +Flag which, when set to @samp{#t}, allows all filter settings to be +overridden in repository-specific cgitrc files. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-follow-links? +Flag which, when set to @samp{#t}, allows users to follow a file in the +log view. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-http-clone? +If set to @samp{#t}, cgit will act as an dumb HTTP endpoint for Git +clones. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-index-links? +Flag which, when set to @samp{#t}, will make cgit generate extra links +"summary", "commit", "tree" for each repo in the repository index. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-index-owner? +Flag which, when set to @samp{#t}, will make cgit display the owner of +each repo in the repository index. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-log-filecount? +Flag which, when set to @samp{#t}, will make cgit print the number of +modified files for each commit on the repository log page. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-log-linecount? +Flag which, when set to @samp{#t}, will make cgit print the number of +added and removed lines for each commit on the repository log page. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-remote-branches? +Flag which, when set to @code{#t}, will make cgit display remote +branches in the summary and refs views. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-subject-links? +Flag which, when set to @code{1}, will make cgit use the subject of the +parent commit as link text when generating links to parent commits in +commit view. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-html-serving? +Flag which, when set to @samp{#t}, will make cgit use the subject of the +parent commit as link text when generating links to parent commits in +commit view. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-tree-linenumbers? +Flag which, when set to @samp{#t}, will make cgit generate linenumber +links for plaintext blobs printed in the tree view. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean enable-git-config? +Flag which, when set to @samp{#f}, will allow cgit to use Git config to +set any repo specific settings. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string favicon +URL used as link to a shortcut icon for cgit. + +Defaults to @samp{"/favicon.ico"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string footer +The content of the file specified with this option will be included +verbatim at the bottom of all pages (i.e. it replaces the standard +"generated by..." message). + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string head-include +The content of the file specified with this option will be included +verbatim in the HTML HEAD section on all pages. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string header +The content of the file specified with this option will be included +verbatim at the top of all pages. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string include +Name of a configfile to include before the rest of the current config- +file is parsed. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string index-header +The content of the file specified with this option will be included +verbatim above the repository index. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string index-info +The content of the file specified with this option will be included +verbatim below the heading on the repository index page. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean local-time? +Flag which, if set to @samp{#t}, makes cgit print commit and tag times +in the servers timezone. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string logo +URL which specifies the source of an image which will be used as a logo +on all cgit pages. + +Defaults to @samp{"/share/cgit/cgit.png"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string logo-link +URL loaded when clicking on the cgit logo image. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string owner-filter +Command which will be invoked to format the Owner column of the main +page. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer max-atom-items +Number of items to display in atom feeds view. + +Defaults to @samp{10}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer max-commit-count +Number of entries to list per page in "log" view. + +Defaults to @samp{50}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer max-message-length +Number of commit message characters to display in "log" view. + +Defaults to @samp{80}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer max-repo-count +Specifies the number of entries to list per page on the repository index +page. + +Defaults to @samp{50}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer max-repodesc-length +Specifies the maximum number of repo description characters to display +on the repository index page. + +Defaults to @samp{80}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer max-blob-size +Specifies the maximum size of a blob to display HTML for in KBytes. + +Defaults to @samp{0}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string max-stats +Maximum statistics period. Valid values are @samp{week},@samp{month}, +@samp{quarter} and @samp{year}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} mimetype-alist mimetype +Mimetype for the specified filename extension. + +Defaults to @samp{((gif "image/gif") (html "text/html") (jpg +"image/jpeg") (jpeg "image/jpeg") (pdf "application/pdf") (png +"image/png") (svg "image/svg+xml"))}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string mimetype-file +Specifies the file to use for automatic mimetype lookup. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string module-link +Text which will be used as the formatstring for a hyperlink when a +submodule is printed in a directory listing. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean nocache? +If set to the value @samp{#t} caching will be disabled. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean noplainemail? +If set to @samp{#t} showing full author email addresses will be +disabled. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean noheader? +Flag which, when set to @samp{#t}, will make cgit omit the standard +header on all pages. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string readme +Text which will be used as default value for @code{cgit-repo-readme}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean remove-suffix? +If set to @code{#t} and @code{repository-directory} is enabled, if any +repositories are found with a suffix of @code{.git}, this suffix will be +removed for the URL and name. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer renamelimit +Maximum number of files to consider when detecting renames. + +Defaults to @samp{-1}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string repository-sort +The way in which repositories in each section are sorted. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} robots-list robots +Text used as content for the @code{robots} meta-tag. + +Defaults to @samp{("noindex" "nofollow")}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string root-desc +Text printed below the heading on the repository index page. + +Defaults to @samp{"a fast webinterface for the git dscm"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string root-readme +The content of the file specified with this option will be included +verbatim below thef "about" link on the repository index page. -@table @asis -@item @code{config-file} (default: @code{(cgit-configuration-file)}) -The configuration file to use for Cgit. This can be set to a -@dfn{cgit-configuration-file} record value, or any gexp -(@pxref{G-Expressions}). +Defaults to @samp{""}. -For example, to instead use a local file, the @code{local-file} function -can be used: +@end deftypevr -@example -(service cgit-service-type - (cgit-configuration - (config-file (local-file "./my-cgitrc.conf")))) -@end example +@deftypevr {@code{cgit-configuration} parameter} string root-title +Text printed as heading on the repository index page. -@item @code{package} (default: @code{cgit}) -The Cgit package to use. +Defaults to @samp{""}. -@end table -@end deftp +@end deftypevr -@deftp {Data Type} cgit-configuration-file -Data type representing the configuration options for Cgit. -This type has the following parameters: +@deftypevr {@code{cgit-configuration} parameter} boolean scan-hidden-path +If set to @samp{#t} and repository-directory is enabled, +repository-directory will recurse into directories whose name starts +with a period. Otherwise, repository-directory will stay away from such +directories, considered as "hidden". Note that this does not apply to +the ".git" directory in non-bare repos. -@table @asis -@item @code{css} (default: @code{"/share/cgit/cgit.css"}) -URL which specifies the css document to include in all Cgit pages. +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} list snapshots +Text which specifies the default set of snapshot formats that cgit +generates links for. + +Defaults to @samp{()}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} repository-directory repository-directory +Name of the directory to scan for repositories (represents +@code{scan-path}). + +Defaults to @samp{"/srv/git"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string section +The name of the current repository section - all repositories defined +after this option will inherit the current section name. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string section-sort +Flag which, when set to @samp{1}, will sort the sections on the +repository listing by name. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer section-from-path +A number which, if defined prior to repository-directory, specifies how +many path elements from each repo path to use as a default section name. + +Defaults to @samp{0}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} boolean side-by-side-diffs? +If set to @samp{#t} shows side-by-side diffs instead of unidiffs per +default. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string source-filter +Specifies a command which will be invoked to format plaintext blobs in +the tree view. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer summary-branches +Specifies the number of branches to display in the repository "summary" +view. + +Defaults to @samp{10}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer summary-log +Specifies the number of log entries to display in the repository +"summary" view. + +Defaults to @samp{10}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} integer summary-tags +Specifies the number of tags to display in the repository "summary" +view. + +Defaults to @samp{10}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string strict-export +Filename which, if specified, needs to be present within the repository +for cgit to allow access to that repository. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} string virtual-root +URL which, if specified, will be used as root for all cgit links. + +Defaults to @samp{"/"}. + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} repository-cgit-configuration-list repositories +A list of @dfn{cgit-repo} records to use with config. + +Defaults to @samp{()}. + +Available @code{repository-cgit-configuration} fields are: + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-list snapshots +A mask of snapshot formats for this repo that cgit generates links for, +restricted by the global @code{snapshots} setting. + +Defaults to @samp{()}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string source-filter +Override the default @code{source-filter}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string url +The relative URL used to access the repository. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string about-filter +Override the default @code{about-filter}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string branch-sort +Flag which, when set to @samp{age}, enables date ordering in the branch +ref list, and when set to @samp{name} enables ordering by branch name. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-list clone-url +A list of URLs which can be used to clone repo. + +Defaults to @samp{()}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string commit-filter +Override the default @code{commit-filter}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string commit-sort +Flag which, when set to @samp{date}, enables strict date ordering in the +commit log, and when set to @samp{topo} enables strict topological +ordering. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string defbranch +The name of the default branch for this repository. If no such branch +exists in the repository, the first branch name (when sorted) is used as +default instead. By default branch pointed to by HEAD, or "master" if +there is no suitable HEAD. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string desc +The value to show as repository description. + +Defaults to @samp{""}. -@item @code{logo} (default: @code{"/share/cgit/cgit.png"}) +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string homepage +The value to show as repository homepage. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string email-filter +Override the default @code{email-filter}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean enable-commit-graph? +A flag which can be used to disable the global setting +@code{enable-commit-graph?}. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean enable-log-filecount? +A flag which can be used to disable the global setting +@code{enable-log-filecount?}. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean enable-log-linecount? +A flag which can be used to disable the global setting +@code{enable-log-linecount?}. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean enable-remote-branches? +Flag which, when set to @code{#t}, will make cgit display remote +branches in the summary and refs views. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean enable-subject-links? +A flag which can be used to override the global setting +@code{enable-subject-links?}. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean enable-html-serving? +A flag which can be used to override the global setting +@code{enable-html-serving?}. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean hide? +Flag which, when set to @code{#t}, hides the repository from the +repository index. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-boolean ignore? +Flag which, when set to @samp{#t}, ignores the repository. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string logo URL which specifies the source of an image which will be used as a logo -on all Cgit pages. +on this repo’s pages. -@item @code{virtual-root} (default: @code{"/"}) -URL which, if specified, will be used as root for all Cgit links. +Defaults to @samp{""}. -@item @code{repository-directory} (default: @code{"/srv/git"}) -Name of the directory to scan for repositories. +@end deftypevr -@item @code{robots} (default: @code{(list "noindex" "nofollow")}) -Text used as content for the ``robots'' meta-tag. +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string logo-link +URL loaded when clicking on the cgit logo image. -@end table -@end deftp +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string owner-filter +Override the default @code{owner-filter}. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string module-link +Text which will be used as the formatstring for a hyperlink when a +submodule is printed in a directory listing. The arguments for the +formatstring are the path and SHA1 of the submodule commit. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} module-link-path module-link-path +Text which will be used as the formatstring for a hyperlink when a +submodule with the specified subdirectory path is printed in a directory +listing. + +Defaults to @samp{()}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string max-stats +Override the default maximum statistics period. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string name +The value to show as repository name. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string owner +A value used to identify the owner of the repository. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string path +An absolute path to the repository directory. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string readme +A path (relative to repo) which specifies a file to include verbatim as +the "About" page for this repo. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-string section +The name of the current repository section - all repositories defined +after this option will inherit the current section name. + +Defaults to @samp{""}. + +@end deftypevr + +@deftypevr {@code{repository-cgit-configuration} parameter} repo-list extra-options +Extra options will be appended to cgitrc file. + +Defaults to @samp{()}. + +@end deftypevr + +@end deftypevr + +@deftypevr {@code{cgit-configuration} parameter} list extra-options +Extra options will be appended to cgitrc file. + +Defaults to @samp{()}. + +@end deftypevr + +@c %end of fragment + +However, it could be that you just want to get a @code{cgitrc} up and +running. In that case, you can pass an @code{opaque-cgit-configuration} +as a record to @code{cgit-service-type}. As its name indicates, an +opaque configuration does not have easy reflective capabilities. + +Available @code{opaque-cgit-configuration} fields are: + +@deftypevr {@code{opaque-cgit-configuration} parameter} package cgit +The cgit package. +@end deftypevr + +@deftypevr {@code{opaque-cgit-configuration} parameter} string string +The contents of the @code{cgitrc}, as a string. +@end deftypevr + +For example, if your @code{cgitrc} is just the empty string, you +could instantiate a cgit service like this: + +@example +(service cgit-service-type + (opaque-cgit-configuration + (cgitrc ""))) +@end example @node Setuid Programs @subsection Setuid Programs diff --git a/gnu/local.mk b/gnu/local.mk index bae3df5a6d..94ffbe1b53 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -454,6 +454,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/avahi.scm \ %D%/services/base.scm \ %D%/services/certbot.scm \ + %D%/services/cgit.scm \ %D%/services/configuration.scm \ %D%/services/cuirass.scm \ %D%/services/cups.scm \ diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm new file mode 100644 index 0000000000..a868d758a4 --- /dev/null +++ b/gnu/services/cgit.scm @@ -0,0 +1,686 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Oleg Pykhalov +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services cgit) + #:use-module (gnu packages admin) + #:use-module (gnu packages version-control) + #:use-module (gnu services base) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu services web) + #:use-module (gnu services) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (repository-cgit-configuration + cgit-configuration + %cgit-configuration-nginx + cgit-configuration-nginx-config + opaque-cgit-configuration + cgit-service-type)) + +;;; Commentary: +;;; +;;; This module provides a service definition for the Cgit a web frontend for +;;; Git repositories written in C. +;;; +;;; Note: fields of and +;;; should be specified in the specific order. +;;; +;;; Code: + +(define %cgit-configuration-nginx + (nginx-server-configuration + (root cgit) + (locations + (list + (nginx-location-configuration + (uri "@cgit") + (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;" + "fastcgi_param PATH_INFO $uri;" + "fastcgi_param QUERY_STRING $args;" + "fastcgi_param HTTP_HOST $server_name;" + "fastcgi_pass 127.0.0.1:9000;"))))) + (try-files (list "$uri" "@cgit")) + (listen '("80")) + (ssl-certificate #f) + (ssl-certificate-key #f))) + + +;;; +;;; Serialize +;;; + +(define (uglify-field-name field-name) + (let ((str (symbol->string field-name))) + (string-join (string-split (string-delete #\? str) #\-) "-"))) + +(define (serialize-field field-name val) + (format #t "~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))) + +(define (serialize-list field-name val) + (if (null? val) "" (serialize-field field-name (string-join val)))) + +(define robots-list? list?) + +(define (serialize-robots-list field-name val) + (if (null? val) "" (serialize-field field-name (string-join val ", ")))) + +(define (integer? val) + (exact-integer? val)) + +(define (serialize-integer field-name val) + (serialize-field field-name val)) + +(define (serialize-repository-cgit-configuration x) + (serialize-configuration x repository-cgit-configuration-fields)) + +(define (repository-cgit-configuration-list? val) + (list? val)) + +(define (serialize-repository-cgit-configuration-list field-name val) + (for-each serialize-repository-cgit-configuration val)) + + +;;; +;;; Serialize +;;; + +(define (nginx-server-configuration-list? val) + (and (list? val) (and-map nginx-server-configuration? val))) + +(define (serialize-nginx-server-configuration-list field-name val) + #f) + + +;;; +;;; Serialize +;;; + +(define (serialize-repo-field field-name val) + (format #t "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)) + +(define repo-list? list?) + +(define repo-string? string?) + +(define (serialize-repo-string field-name val) + (if (string=? val "") "" (serialize-repo-field field-name val))) + +(define module-link-path? list?) + +(define (serialize-module-link-path field-name val) + (if (null? val) "" + (match val + ((path text) + (format #t "repo.~a.~a=~a\n" + (string-drop-right (uglify-field-name 'module-link-path) + (string-length "-path")) + path text))))) + +(define repository-directory? string?) + +(define (serialize-repository-directory _ val) + (if (string=? val "") "" (format #t "scan-path=~a\n" val))) + +(define mimetype-alist? list?) + +(define (serialize-mimetype-alist field-name val) + (format #t "# Mimetypes\n~a" + (string-join + (map (match-lambda + ((extension mimetype) + (format #f "mimetype.~a=~a" + (symbol->string extension) mimetype))) + val) "\n"))) + +(define-configuration repository-cgit-configuration + (snapshots + (repo-list '()) + "A mask of snapshot formats for this repo that cgit generates links for, +restricted by the global @code{snapshots} setting.") + (source-filter + (repo-string "") + "Override the default @code{source-filter}.") + (url + (repo-string "") + "The relative URL used to access the repository.") + (about-filter + (repo-string "") + "Override the default @code{about-filter}.") + (branch-sort + (repo-string "") + "Flag which, when set to @samp{age}, enables date ordering in the branch +ref list, and when set to @samp{name} enables ordering by branch name.") + (clone-url + (repo-list '()) + "A list of URLs which can be used to clone repo.") + (commit-filter + (repo-string "") + "Override the default @code{commit-filter}.") + (commit-sort + (repo-string "") + "Flag which, when set to @samp{date}, enables strict date ordering in the +commit log, and when set to @samp{topo} enables strict topological ordering.") + (defbranch + (repo-string "") + "The name of the default branch for this repository. If no such branch +exists in the repository, the first branch name (when sorted) is used as +default instead. By default branch pointed to by HEAD, or \"master\" if there +is no suitable HEAD.") + (desc + (repo-string "") + "The value to show as repository description.") + (homepage + (repo-string "") + "The value to show as repository homepage.") + (email-filter + (repo-string "") + "Override the default @code{email-filter}.") + (enable-commit-graph? + (repo-boolean #f) + "A flag which can be used to disable the global setting +@code{enable-commit-graph?}.") + (enable-log-filecount? + (repo-boolean #f) + "A flag which can be used to disable the global setting +@code{enable-log-filecount?}.") + (enable-log-linecount? + (repo-boolean #f) + "A flag which can be used to disable the global setting +@code{enable-log-linecount?}.") + (enable-remote-branches? + (repo-boolean #f) + "Flag which, when set to @code{#t}, will make cgit display remote +branches in the summary and refs views.") + (enable-subject-links? + (repo-boolean #f) + "A flag which can be used to override the global setting +@code{enable-subject-links?}.") + (enable-html-serving? + (repo-boolean #f) + "A flag which can be used to override the global setting +@code{enable-html-serving?}.") + (hide? + (repo-boolean #f) + "Flag which, when set to @code{#t}, hides the repository from the +repository index.") + (ignore? + (repo-boolean #f) + "Flag which, when set to @samp{#t}, ignores the repository.") + (logo + (repo-string "") + "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 "") + "Override the default @code{owner-filter}.") + (module-link + (repo-string "") + "Text which will be used as the formatstring for a hyperlink when a +submodule is printed in a directory listing. The arguments for the +formatstring are the path and SHA1 of the submodule commit.") + (module-link-path + (module-link-path '()) + "Text which will be used as the formatstring for a hyperlink when a +submodule with the specified subdirectory path is printed in a directory +listing.") + (max-stats + (repo-string "") + "Override the default maximum statistics period.") + (name + (repo-string "") + "The value to show as repository name.") + (owner + (repo-string "") + "A value used to identify the owner of the repository.") + (path + (repo-string "") + "An absolute path to the repository directory.") + (readme + (repo-string "") + "A path (relative to repo) which specifies a file to include verbatim +as the \"About\" page for this repo.") + (section + (repo-string "") + "The name of the current repository section - all repositories defined +after this option will inherit the current section name.") + (extra-options + (repo-list '()) + "Extra options will be appended to cgitrc file.")) + +;; Generate a record, which may include a list of +;; , , . +(define-configuration cgit-configuration + (package + (package cgit) + "The CGIT package.") + (nginx + (nginx-server-configuration-list (list %cgit-configuration-nginx)) + "NGINX configuration.") + (about-filter + (string "") + "Specifies a command which will be invoked to format the content of about +pages (both top-level and for each repository).") + (agefile + (string "") + "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 "") + "Specifies a command that will be invoked for authenticating repository +access.") + (branch-sort + (string "name") + "Flag which, when set to @samp{age}, enables date ordering in the branch +ref list, and when set @samp{name} enables ordering by branch name.") + (cache-root + (string "/var/cache/cgit") + "Path used to store the cgit cache entries.") + (cache-static-ttl + (integer -1) + "Number which specifies the time-to-live, in minutes, for the cached +version of repository pages accessed with a fixed SHA1.") + (cache-dynamic-ttl + (integer 5) + "Number which specifies the time-to-live, in minutes, for the cached +version of repository pages accessed without a fixed SHA1.") + (cache-repo-ttl + (integer 5) + "Number which specifies the time-to-live, in minutes, for the cached +version of the repository summary page.") + (cache-root-ttl + (integer 5) + "Number which specifies the time-to-live, in minutes, for the cached +version of the repository index page.") + (cache-scanrc-ttl + (integer 15) + "Number which specifies the time-to-live, in minutes, for the result of +scanning a path for Git repositories.") + (cache-about-ttl + (integer 15) + "Number which specifies the time-to-live, in minutes, for the cached +version of the repository about page.") + (cache-snapshot-ttl + (integer 5) + "Number which specifies the time-to-live, in minutes, for the cached +version of snapshots.") + (cache-size + (integer 0) + "The maximum number of entries in the cgit cache. When set to +@samp{0}, caching is disabled.") + (case-sensitive-sort? + (boolean #t) + "Sort items in the repo list case sensitively.") + (clone-prefix + (list '()) + "List of common prefixes which, when combined with a repository URL, +generates valid clone URLs for the repository.") + (clone-url + (list '()) + "List of @code{clone-url} templates.") + (commit-filter + (string "") + "Command which will be invoked to format commit messages.") + (commit-sort + (string "git log") + "Flag which, when set to @samp{date}, enables strict date ordering in the +commit log, and when set to @samp{topo} enables strict topological +ordering.") + (css + (string "/share/cgit/cgit.css") + "URL which specifies the css document to include in all cgit pages.") + (email-filter + (string "") + "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.") + (embedded? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit generate a HTML +fragment suitable for embedding in other HTML pages.") + (enable-commit-graph? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit print an ASCII-art +commit history graph to the left of the commit messages in the +repository log page.") + (enable-filter-overrides? + (boolean #f) + "Flag which, when set to @samp{#t}, allows all filter settings to be +overridden in repository-specific cgitrc files.") + (enable-follow-links? + (boolean #f) + "Flag which, when set to @samp{#t}, allows users to follow a file in the +log view.") + (enable-http-clone? + (boolean #t) + "If set to @samp{#t}, cgit will act as an dumb HTTP endpoint for Git +clones.") + (enable-index-links? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit generate extra links +\"summary\", \"commit\", \"tree\" for each repo in the repository index.") + (enable-index-owner? + (boolean #t) + "Flag which, when set to @samp{#t}, will make cgit display the owner of +each repo in the repository index.") + (enable-log-filecount? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit print the number of +modified files for each commit on the repository log page.") + (enable-log-linecount? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit print the number of +added and removed lines for each commit on the repository log page.") + (enable-remote-branches? + (boolean #f) + "Flag which, when set to @code{#t}, will make cgit display remote +branches in the summary and refs views.") + (enable-subject-links? + (boolean #f) + "Flag which, when set to @code{1}, will make cgit use the subject of +the parent commit as link text when generating links to parent commits +in commit view.") + (enable-html-serving? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit use the subject of the +parent commit as link text when generating links to parent commits in +commit view.") + (enable-tree-linenumbers? + (boolean #t) + "Flag which, when set to @samp{#t}, will make cgit generate linenumber +links for plaintext blobs printed in the tree view.") + (enable-git-config? + (boolean #f) + "Flag which, when set to @samp{#f}, will allow cgit to use Git config to +set any repo specific settings.") + (favicon + (string "/favicon.ico") + "URL used as link to a shortcut icon for cgit.") + (footer + (string "") + "The content of the file specified with this option will be included +verbatim at the bottom of all pages (i.e. it replaces the standard +\"generated by...\" message).") + (head-include + (string "") + "The content of the file specified with this option will be included +verbatim in the HTML HEAD section on all pages.") + (header + (string "") + "The content of the file specified with this option will be included +verbatim at the top of all pages.") + (include + (string "") + "Name of a configfile to include before the rest of the current config- +file is parsed.") + (index-header + (string "") + "The content of the file specified with this option will be included +verbatim above the repository index.") + (index-info + (string "") + "The content of the file specified with this option will be included +verbatim below the heading on the repository index page.") + (local-time? + (boolean #f) + "Flag which, if set to @samp{#t}, makes cgit print commit and tag times +in the servers timezone.") + (logo + (string "/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 "") + "Command which will be invoked to format the Owner column of the main +page.") + (max-atom-items + (integer 10) + "Number of items to display in atom feeds view.") + (max-commit-count + (integer 50) + "Number of entries to list per page in \"log\" view.") + (max-message-length + (integer 80) + "Number of commit message characters to display in \"log\" view.") + (max-repo-count + (integer 50) + "Specifies the number of entries to list per page on the repository index +page.") + (max-repodesc-length + (integer 80) + "Specifies the maximum number of repo description characters to display +on the repository index page.") + (max-blob-size + (integer 0) + "Specifies the maximum size of a blob to display HTML for in KBytes.") + (max-stats + (string "") + "Maximum statistics period. Valid values are @samp{week},@samp{month}, +@samp{quarter} and @samp{year}.") + (mimetype + (mimetype-alist '((gif "image/gif") + (html "text/html") + (jpg "image/jpeg") + (jpeg "image/jpeg") + (pdf "application/pdf") + (png "image/png") + (svg "image/svg+xml"))) + "Mimetype for the specified filename extension.") + (mimetype-file + (string "") + "Specifies the file to use for automatic mimetype lookup.") + (module-link + (string "") + "Text which will be used as the formatstring for a hyperlink when a +submodule is printed in a directory listing.") + (nocache? + (boolean #f) + "If set to the value @samp{#t} caching will be disabled.") + (noplainemail? + (boolean #f) + "If set to @samp{#t} showing full author email addresses will be +disabled.") + (noheader? + (boolean #f) + "Flag which, when set to @samp{#t}, will make cgit omit the standard +header on all pages.") + ;; TODO: cgit expects a file name + ;; that should be created from a list of strings provided by the user. + ;; + ;; (project-list + ;; (string "") + ;; "A list of subdirectories inside of @code{repository-directory}, + ;; relative to it, that should loaded as Git repositories.") + (readme + (string "") + "Text which will be used as default value for @code{cgit-repo-readme}.") + (remove-suffix? + (boolean #f) + "If set to @code{#t} and @code{repository-directory} is enabled, if any +repositories are found with a suffix of @code{.git}, this suffix will be +removed for the URL and name.") + (renamelimit + (integer -1) + "Maximum number of files to consider when detecting renames.") + (repository-sort + (string "") + "The way in which repositories in each section are sorted.") + (robots + (robots-list (list "noindex" "nofollow")) + "Text used as content for the @code{robots} meta-tag.") + (root-desc + (string "a fast webinterface for the git dscm") + "Text printed below the heading on the repository index page.") + (root-readme + (string "") + "The content of the file specified with this option will be included +verbatim below thef \"about\" link on the repository index page.") + (root-title + (string "") + "Text printed as heading on the repository index page.") + (scan-hidden-path + (boolean #f) + "If set to @samp{#t} and repository-directory is enabled, +repository-directory will recurse into directories whose name starts with a +period. Otherwise, repository-directory will stay away from such directories, +considered as \"hidden\". Note that this does not apply to the \".git\" +directory in non-bare repos.") + (snapshots + (list '()) + "Text which specifies the default set of snapshot formats that cgit +generates links for.") + (repository-directory + (repository-directory "/srv/git") + "Name of the directory to scan for repositories (represents +@code{scan-path}).") + (section + (string "") + "The name of the current repository section - all repositories defined +after this option will inherit the current section name.") + (section-sort + (string "") + "Flag which, when set to @samp{1}, will sort the sections on the repository +listing by name.") + (section-from-path + (integer 0) + "A number which, if defined prior to repository-directory, specifies how +many path elements from each repo path to use as a default section name.") + (side-by-side-diffs? + (boolean #f) + "If set to @samp{#t} shows side-by-side diffs instead of unidiffs per +default.") + (source-filter + (string "") + "Specifies a command which will be invoked to format plaintext blobs in the +tree view.") + (summary-branches + (integer 10) + "Specifies the number of branches to display in the repository \"summary\" +view.") + (summary-log + (integer 10) + "Specifies the number of log entries to display in the repository +\"summary\" view.") + (summary-tags + (integer 10) + "Specifies the number of tags to display in the repository \"summary\" +view.") + (strict-export + (string "") + "Filename which, if specified, needs to be present within the repository +for cgit to allow access to that repository.") + (virtual-root + (string "/") + "URL which, if specified, will be used as root for all cgit links.") + (repositories + (repository-cgit-configuration-list '()) + "A list of @dfn{cgit-repo} records to use with config.") + (extra-options + (list '()) + "Extra options will be appended to cgitrc file.")) + +(define-configuration opaque-cgit-configuration + (cgit + (package cgit) + "The cgit package.") + (cgitrc + (string (configuration-missing-field 'opaque-cgit-configuration 'cgitrc)) + "The contents of the @code{cgitrc} to use.") + (cache-root + (string "/var/cache/cgit") + "Path used to store the cgit cache entries.") + (nginx + (nginx-server-configuration-list (list %cgit-configuration-nginx)) + "NGINX configuration.")) + +(define (cgit-activation config) + "Return the activation gexp for CONFIG." + (let* ((opaque-config? (opaque-cgit-configuration? config)) + (config-str + (if opaque-config? + (opaque-cgit-configuration-cgitrc config) + (with-output-to-string + (lambda () + (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")))) + +(define (cgit-configuration-nginx-config config) + (if (opaque-cgit-configuration? config) + (opaque-cgit-configuration-nginx config) + (cgit-configuration-nginx config))) + +(define cgit-service-type + (service-type + (name 'cgit) + (extensions + (list (service-extension activation-service-type + cgit-activation) + (service-extension nginx-service-type + cgit-configuration-nginx-config) + + ;; Make sure fcgiwrap is instantiated. + (service-extension fcgiwrap-service-type + (const #t)))) + (default-value (cgit-configuration)) + (description + "Run the cgit web interface, which allows users to browse Git +repositories."))) + +(define (generate-cgit-documentation) + (generate-documentation + `((cgit-configuration + ,cgit-configuration-fields + (repositories repository-cgit-configuration)) + (repository-cgit-configuration + ,repository-cgit-configuration-fields)) + 'cgit-configuration)) diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index 7166ed3d4f..afead87ec7 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -38,26 +38,6 @@ git-daemon-configuration git-daemon-configuration? - - cgit-configuration-file - cgit-configuration-file? - cgit-configuration-file-css - cgit-configuration-file-logo - cgit-configuration-file-robots - cgit-configuration-file-virtual-root - cgit-configuration-file-repository-directory - - - cgit-configuration - cgit-configuration? - cgit-configuration-config-file - cgit-configuration-package - - %cgit-configuration-nginx - cgit-configuration-nginx-config - - cgit-service-type - git-http-configuration git-http-configuration? git-http-nginx-location-configuration)) @@ -172,107 +152,6 @@ The optional @var{config} argument should be a access to exported repositories under @file{/srv/git}." (service git-daemon-service-type config)) - -;;; -;;; Cgit -;;; - -(define-record-type* - cgit-configuration-file - make-cgit-configuration-file - cgit-configuration-file? - (css cgit-configuration-file-css ; string - (default "/share/cgit/cgit.css")) - (logo cgit-configuration-file-logo ; string - (default "/share/cgit/cgit.png")) - (robots cgit-configuration-file-robots ; list - (default '("noindex" "nofollow"))) - (virtual-root cgit-configuration-file-virtual-root ; string - (default "/")) - (repository-directory cgit-configuration-file-repository-directory ; string - (default "/srv/git"))) - -(define (cgit-configuration-robots-string robots) - (string-join robots ", ")) - -(define-gexp-compiler (cgit-configuration-file-compiler - (file ) system target) - (match file - (($ css logo - robots virtual-root repository-directory) - (apply text-file* "cgitrc" - (letrec-syntax ((option (syntax-rules () - ((_ key value) - (if value - `(,key "=" ,value "\n") - '())))) - (key/value (syntax-rules () - ((_ (key value) rest ...) - (append (option key value) - (key/value rest ...))) - ((_) - '())))) - (key/value ("css" css) - ("logo" logo) - ("robots" (cgit-configuration-robots-string robots)) - ("virtual-root" virtual-root) - ("scan-path" repository-directory))))))) - -(define %cgit-configuration-nginx - (list - (nginx-server-configuration - (root cgit) - (locations - (list - (nginx-location-configuration - (uri "@cgit") - (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;" - "fastcgi_param PATH_INFO $uri;" - "fastcgi_param QUERY_STRING $args;" - "fastcgi_param HTTP_HOST $server_name;" - "fastcgi_pass 127.0.0.1:9000;"))))) - (try-files (list "$uri" "@cgit")) - (listen '("80")) - (ssl-certificate #f) - (ssl-certificate-key #f)))) - -(define-record-type* - cgit-configuration make-cgit-configuration - cgit-configuration? - (config-file cgit-configuration-config-file - (default (cgit-configuration-file))) - (package cgit-configuration-package - (default cgit)) - (nginx cgit-configuration-nginx - (default %cgit-configuration-nginx))) - -(define (cgit-activation config) - ;; Cgit compiled with default configuration path - #~(begin - (use-modules (guix build utils)) - (mkdir-p "/var/cache/cgit") - (copy-file #$(cgit-configuration-config-file config) "/etc/cgitrc"))) - -(define (cgit-configuration-nginx-config config) - (cgit-configuration-nginx config)) - -(define cgit-service-type - (service-type - (name 'cgit) - (extensions - (list (service-extension activation-service-type - cgit-activation) - (service-extension nginx-service-type - cgit-configuration-nginx-config) - - ;; Make sure fcgiwrap is instantiated. - (service-extension fcgiwrap-service-type - (const #t)))) - (default-value (cgit-configuration)) - (description - "Run the Cgit web interface, which allows users to browse Git -repositories."))) - ;;; ;;; HTTP access. Add the result of calling diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index 9882cdbe28..8024739734 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Oleg Pykhalov +;;; Copyright © 2017, 2018 Oleg Pykhalov ;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Clément Lassieur ;;; @@ -26,6 +26,7 @@ #:use-module (gnu system vm) #:use-module (gnu services) #:use-module (gnu services version-control) + #:use-module (gnu services cgit) #:use-module (gnu services web) #:use-module (gnu services networking) #:use-module (gnu packages version-control) -- cgit v1.2.3 From 07ec349229eeae9f733fe92a300c7cfa4cf8e321 Mon Sep 17 00:00:00 2001 From: Mike Gerwitz Date: Thu, 25 Jan 2018 22:29:15 -0500 Subject: environment: Add --link-profile. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This change is motivated by attempts to run programs (like GNU IceCat) within containers. The 'fontconfig' program, for example, is configured explicitly to check ~/.guix-profile for additional fonts. There were no existing container tests in 'tests/guix-environment.sh', but I added one anyway for this change. * doc/guix.texi (Invoking guix environment): Add '--link-profile'. * guix/scripts/environment.scm (show-help): Add '--link-profile'. (%options): Add 'link-profile' as '#\P', assigned to 'link-profile?'. (link-environment): New procedure. (launch-environment/container): Use it when 'link-profile?'. [link-profile?]: New parameter. (guix-environment): Leave when '--link-prof' but not '--container'. Add '#:link-profile?' argument to 'launch-environment/container' application. * tests/guix-environment-container.sh: New '--link-profile' test. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 21 ++++++++++++++++-- guix/scripts/environment.scm | 43 +++++++++++++++++++++++++++++++------ tests/guix-environment-container.sh | 14 ++++++++++++ 3 files changed, 70 insertions(+), 8 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 24db167618..826f924d22 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -46,7 +46,8 @@ Copyright @copyright{} 2017 Andy Wingo@* Copyright @copyright{} 2017, 2018 Arun Isaac@* Copyright @copyright{} 2017 nee@* Copyright @copyright{} 2018 Rutger Helling@* -Copyright @copyright{} 2018 Oleg Pykhalov +Copyright @copyright{} 2018 Oleg Pykhalov@* +Copyright @copyright{} 2018 Mike Gerwitz Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -1572,7 +1573,7 @@ To be able to use such full names for the TrueType fonts installed in your Guix profile, you need to extend the font path of the X server: @example -xset +fp ~/.guix-profile/share/fonts/truetype +xset +fp `readlink -f ~/.guix-profile/share/fonts/truetype` @end example @cindex @code{xlsfonts} @@ -7296,6 +7297,22 @@ For containers, share the network namespace with the host system. Containers created without this flag only have access to the loopback device. +@item --link-profile +@itemx -P +For containers, link the environment profile to +@file{~/.guix-profile} within the container. This is equivalent to +running the command @command{ln -s $GUIX_ENVIRONMENT ~/.guix-profile} +within the container. Linking will fail and abort the environment if +the directory already exists, which will certainly be the case if +@command{guix environment} was invoked in the user's home directory. + +Certain packages are configured to look in +@code{~/.guix-profile} for configuration files and data;@footnote{For +example, the @code{fontconfig} package inspects +@file{~/.guix-profile/share/fonts} for additional fonts.} +@code{--link-profile} allows these programs to behave as expected within +the environment. + @item --expose=@var{source}[=@var{target}] For containers, expose the file system @var{source} from the host system as the read-only file system @var{target} within the container. If diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 67da6fc3bf..5c7d83881c 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2018 David Thompson ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2018 Mike Gerwitz ;;; ;;; This file is part of GNU Guix. ;;; @@ -159,6 +160,9 @@ COMMAND or an interactive shell in that environment.\n")) -C, --container run command within an isolated container")) (display (G_ " -N, --network allow containers to access the network")) + (display (G_ " + -P, --link-profile link environment profile to ~/.guix-profile within + an isolated container")) (display (G_ " --share=SPEC for containers, share writable host file system according to SPEC")) @@ -243,6 +247,9 @@ COMMAND or an interactive shell in that environment.\n")) (option '(#\N "network") #f #f (lambda (opt name arg result) (alist-cons 'network? #t result))) + (option '(#\P "link-profile") #f #f + (lambda (opt name arg result) + (alist-cons 'link-profile? #t result))) (option '("share") #t #f (lambda (opt name arg result) (alist-cons 'file-system-mapping @@ -404,18 +411,20 @@ environment variables are cleared before setting the new ones." ((_ . status) status))))) (define* (launch-environment/container #:key command bash user-mappings - profile paths network?) + profile paths link-profile? network?) "Run COMMAND within a container that features the software in PROFILE. Environment variables are set according to PATHS, a list of native search paths. The global shell is BASH, a file name for a GNU Bash binary in the store. When NETWORK?, access to the host system network is permitted. USER-MAPPINGS, a list of file system mappings, contains the user-specified -host file systems to mount inside the container." +host file systems to mount inside the container. LINK-PROFILE? creates a +symbolic link from ~/.guix-profile to the environment profile." (mlet %store-monad ((reqs (inputs->requisites (list (direct-store-path bash) profile)))) (return - (let* ((cwd (getcwd)) - (passwd (getpwuid (getuid))) + (let* ((cwd (getcwd)) + (passwd (getpwuid (getuid))) + (home-dir (passwd:dir passwd)) ;; Bind-mount all requisite store items, user-specified mappings, ;; /bin/sh, the current working directory, and possibly networking ;; configuration files within the container. @@ -460,8 +469,13 @@ host file systems to mount inside the container." ;; Create a dummy home directory under the same name as on the ;; host. - (mkdir-p (passwd:dir passwd)) - (setenv "HOME" (passwd:dir passwd)) + (mkdir-p home-dir) + (setenv "HOME" home-dir) + + ;; If requested, link $GUIX_ENVIRONMENT to $HOME/.guix-profile; + ;; this allows programs expecting that path to continue working as + ;; expected within a container. + (when link-profile? (link-environment profile home-dir)) ;; Create a dummy /etc/passwd to satisfy applications that demand ;; to read it, such as 'git clone' over SSH, a valid use-case when @@ -491,6 +505,18 @@ host file systems to mount inside the container." (delq 'net %namespaces) ; share host network %namespaces))))))) +(define (link-environment profile home-dir) + "Create a symbolic link from HOME-DIR/.guix-profile to PROFILE." + (let ((profile-dir (string-append home-dir "/.guix-profile"))) + (catch 'system-error + (lambda () + (symlink profile profile-dir)) + (lambda args + (if (= EEXIST (system-error-errno args)) + (leave (G_ "cannot link profile: '~a' already exists within container~%") + profile-dir) + (apply throw args)))))) + (define (environment-bash container? bootstrap? system) "Return a monadic value in the store monad for the version of GNU Bash needed in the environment for SYSTEM, if any. If CONTAINER? is #f, return #f. @@ -564,6 +590,7 @@ message if any test fails." (let* ((opts (parse-args args)) (pure? (assoc-ref opts 'pure)) (container? (assoc-ref opts 'container?)) + (link-prof? (assoc-ref opts 'link-profile?)) (network? (assoc-ref opts 'network?)) (bootstrap? (assoc-ref opts 'bootstrap?)) (system (assoc-ref opts 'system)) @@ -597,6 +624,9 @@ message if any test fails." (when container? (assert-container-features)) + (when (and (not container?) link-prof?) + (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) + (with-store store (set-build-options-from-command-line store opts) @@ -646,6 +676,7 @@ message if any test fails." #:user-mappings mappings #:profile profile #:paths paths + #:link-profile? link-prof? #:network? network?))) (else (return diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index d7c1b7057e..df40ce03e0 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -97,6 +97,20 @@ grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash rm $tmpdir/mounts +# Make sure 'GUIX_ENVIRONMENT' is linked to '~/.guix-profile' when requested +# within a container. +( + linktest='(exit (string=? (getenv "GUIX_ENVIRONMENT") +(readlink (string-append (getenv "HOME") "/.guix-profile"))))' + + cd "$tmpdir" \ + && guix environment --bootstrap --container --link-profile \ + --ad-hoc guile-bootstrap --pure \ + -- guile -c "$linktest" +) + +# Check the exit code. + abnormal_exit_code=" (use-modules (system foreign)) ;; Purposely make Guile crash with a segfault. :) -- cgit v1.2.3 From e37944d8270cdca5729e3583136c4fe9d487779c Mon Sep 17 00:00:00 2001 From: Mike Gerwitz Date: Thu, 25 Jan 2018 22:29:32 -0500 Subject: environment: Add --user. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This change allows overriding the home directory of all filesystem mappings to help hide the identity of the calling user in a container. * doc/guix.texi (Invoking guix environment)[--container]: Mention --user. [--user]: Add item. * guix/scripts/environment.scm (show-help): Add --user. (%options): Add --user. (launch-environment/container) Add 'user' parameter. Update doc. Override 'user-mappings' using 'override-user-mappings'. Consider override for chdir. (mock-passwd, user-override-home, overrid-euser-dir): New procedures. (guix-environment): Disallow --user without --container. Provide user to 'launch-environment/container'. * tests/guix-environment.sh: Add user test. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 34 ++++++++-- guix/scripts/environment.scm | 122 ++++++++++++++++++++++++++++-------- tests/guix-environment-container.sh | 11 ++++ 3 files changed, 138 insertions(+), 29 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 826f924d22..d35ce0e26b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7286,10 +7286,11 @@ Attempt to build for @var{system}---e.g., @code{i686-linux}. @cindex container Run @var{command} within an isolated container. The current working directory outside the container is mapped inside the container. -Additionally, a dummy home directory is created that matches the current -user's home directory, and @file{/etc/passwd} is configured accordingly. -The spawned process runs as the current user outside the container, but -has root privileges in the context of the container. +Additionally, unless overridden with @code{--user}, a dummy home +directory is created that matches the current user's home directory, and +@file{/etc/passwd} is configured accordingly. The spawned process runs +as the current user outside the container, but has root privileges in +the context of the container. @item --network @itemx -N @@ -7313,6 +7314,31 @@ example, the @code{fontconfig} package inspects @code{--link-profile} allows these programs to behave as expected within the environment. +@item --user=@var{user} +@itemx -u @var{user} +For containers, use the username @var{user} in place of the current +user. The generated @file{/etc/passwd} entry within the container will +contain the name @var{user}; the home directory will be +@file{/home/USER}; and no user GECOS data will be copied. @var{user} +need not exist on the system. + +Additionally, any shared or exposed path (see @code{--share} and +@code{--expose} respectively) whose target is within the current user's +home directory will be remapped relative to @file{/home/USER}; this +includes the automatic mapping of the current working directory. + +@example +# will expose paths as /home/foo/wd, /home/foo/test, and /home/foo/target +cd $HOME/wd +guix environment --container --user=foo \ + --expose=$HOME/test \ + --expose=/tmp/target=$HOME/target +@end example + +While this will limit the leaking of user identity through home paths +and each of the user fields, this is only one useful component of a +broader privacy/anonymity solution---not one in and of itself. + @item --expose=@var{source}[=@var{target}] For containers, expose the file system @var{source} from the host system as the read-only file system @var{target} within the container. If diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 5c7d83881c..4f88c513c0 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -163,6 +163,10 @@ COMMAND or an interactive shell in that environment.\n")) (display (G_ " -P, --link-profile link environment profile to ~/.guix-profile within an isolated container")) + (display (G_ " + -u, --user=USER instead of copying the name and home of the current + user into an isolated container, use the name USER + with home directory /home/USER")) (display (G_ " --share=SPEC for containers, share writable host file system according to SPEC")) @@ -250,6 +254,10 @@ COMMAND or an interactive shell in that environment.\n")) (option '(#\P "link-profile") #f #f (lambda (opt name arg result) (alist-cons 'link-profile? #t result))) + (option '(#\u "user") #t #f + (lambda (opt name arg result) + (alist-cons 'user arg + (alist-delete 'user result eq?)))) (option '("share") #t #f (lambda (opt name arg result) (alist-cons 'file-system-mapping @@ -410,43 +418,50 @@ environment variables are cleared before setting the new ones." (pid (match (waitpid pid) ((_ . status) status))))) -(define* (launch-environment/container #:key command bash user-mappings +(define* (launch-environment/container #:key command bash user user-mappings profile paths link-profile? network?) "Run COMMAND within a container that features the software in PROFILE. Environment variables are set according to PATHS, a list of native search paths. The global shell is BASH, a file name for a GNU Bash binary in the store. When NETWORK?, access to the host system network is permitted. USER-MAPPINGS, a list of file system mappings, contains the user-specified -host file systems to mount inside the container. LINK-PROFILE? creates a -symbolic link from ~/.guix-profile to the environment profile." +host file systems to mount inside the container. If USER is not #f, each +target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER +will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from +~/.guix-profile to the environment profile." (mlet %store-monad ((reqs (inputs->requisites (list (direct-store-path bash) profile)))) (return (let* ((cwd (getcwd)) - (passwd (getpwuid (getuid))) + (home (getenv "HOME")) + (passwd (mock-passwd (getpwuid (getuid)) + user + bash)) (home-dir (passwd:dir passwd)) ;; Bind-mount all requisite store items, user-specified mappings, ;; /bin/sh, the current working directory, and possibly networking ;; configuration files within the container. (mappings - (append user-mappings - ;; Current working directory. - (list (file-system-mapping - (source cwd) - (target cwd) - (writable? #t))) - ;; When in Rome, do as Nix build.cc does: Automagically - ;; map common network configuration files. - (if network? - %network-file-mappings - '()) - ;; Mappings for the union closure of all inputs. - (map (lambda (dir) - (file-system-mapping - (source dir) - (target dir) - (writable? #f))) - reqs))) + (override-user-mappings + user home + (append user-mappings + ;; Current working directory. + (list (file-system-mapping + (source cwd) + (target cwd) + (writable? #t))) + ;; When in Rome, do as Nix build.cc does: Automagically + ;; map common network configuration files. + (if network? + %network-file-mappings + '()) + ;; Mappings for the union closure of all inputs. + (map (lambda (dir) + (file-system-mapping + (source dir) + (target dir) + (writable? #f))) + reqs)))) (file-systems (append %container-file-systems (map file-system-mapping->bind-mount mappings)))) @@ -467,8 +482,7 @@ symbolic link from ~/.guix-profile to the environment profile." ;; The same variables as in Nix's 'build.cc'. '("TMPDIR" "TEMPDIR" "TMP" "TEMP")) - ;; Create a dummy home directory under the same name as on the - ;; host. + ;; Create a dummy home directory. (mkdir-p home-dir) (setenv "HOME" home-dir) @@ -495,7 +509,7 @@ symbolic link from ~/.guix-profile to the environment profile." ;; For convenience, start in the user's current working ;; directory rather than the root directory. - (chdir cwd) + (chdir (override-user-dir user home cwd)) (primitive-exit/status ;; A container's environment is already purified, so no need to @@ -505,6 +519,60 @@ symbolic link from ~/.guix-profile to the environment profile." (delq 'net %namespaces) ; share host network %namespaces))))))) +(define (mock-passwd passwd user-override shell) + "Generate mock information for '/etc/passwd'. If USER-OVERRIDE is not '#f', +it is expected to be a string representing the mock username; it will produce +a user of that name, with a home directory of '/home/USER-OVERRIDE', and no +GECOS field. If USER-OVERRIDE is '#f', data will be inherited from PASSWD. +In either case, the shadow password and UID/GID are cleared, since the user +runs as root within the container. SHELL will always be used in place of the +shell in PASSWD. + +The resulting vector is suitable for use with Guile's POSIX user procedures. + +See passwd(5) for more information each of the fields." + (if user-override + (vector + user-override + "x" "0" "0" ;; no shadow, user is now root + "" ;; no personal information + (user-override-home user-override) + shell) + (vector + (passwd:name passwd) + "x" "0" "0" ;; no shadow, user is now root + (passwd:gecos passwd) + (passwd:dir passwd) + shell))) + +(define (user-override-home user) + "Return home directory for override user USER." + (string-append "/home/" user)) + +(define (override-user-mappings user home mappings) + "If a username USER is provided, rewrite each HOME prefix in file system +mappings MAPPINGS to a home directory determined by 'override-user-dir'; +otherwise, return MAPPINGS." + (if (not user) + mappings + (map (lambda (mapping) + (let ((target (file-system-mapping-target mapping))) + (if (string-prefix? home target) + (file-system-mapping + (source (file-system-mapping-source mapping)) + (target (override-user-dir user home target)) + (writable? (file-system-mapping-writable? mapping))) + mapping))) + mappings))) + +(define (override-user-dir user home dir) + "If username USER is provided, overwrite string prefix HOME in DIR with a +directory determined by 'user-override-home'; otherwise, return DIR." + (if (and user (string-prefix? home dir)) + (string-append (user-override-home user) + (substring dir (string-length home))) + dir)) + (define (link-environment profile home-dir) "Create a symbolic link from HOME-DIR/.guix-profile to PROFILE." (let ((profile-dir (string-append home-dir "/.guix-profile"))) @@ -592,6 +660,7 @@ message if any test fails." (container? (assoc-ref opts 'container?)) (link-prof? (assoc-ref opts 'link-profile?)) (network? (assoc-ref opts 'network?)) + (user (assoc-ref opts 'user)) (bootstrap? (assoc-ref opts 'bootstrap?)) (system (assoc-ref opts 'system)) (command (or (assoc-ref opts 'exec) @@ -626,6 +695,8 @@ message if any test fails." (when (and (not container?) link-prof?) (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) + (when (and (not container?) user) + (leave (G_ "'--user' cannot be used without '--container'~%"))) (with-store store (set-build-options-from-command-line store opts) @@ -673,6 +744,7 @@ message if any test fails." "/bin/sh")))) (launch-environment/container #:command command #:bash bash-binary + #:user user #:user-mappings mappings #:profile profile #:paths paths diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index df40ce03e0..a2da9a0773 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -109,6 +109,17 @@ rm $tmpdir/mounts -- guile -c "$linktest" ) +# Test that user can be mocked. +usertest='(exit (and (string=? (getenv "HOME") "/home/foognu") + (string=? (passwd:name (getpwuid 0)) "foognu") + (file-exists? "/home/foognu/umock")))' +touch "$tmpdir/umock" +HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \ + --ad-hoc guile-bootstrap --pure \ + --share="$tmpdir/umock" \ + -- guile -c "$usertest" + + # Check the exit code. abnormal_exit_code=" -- cgit v1.2.3 From bc499b113a598c0e7863da9887a4133472985713 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 27 Feb 2018 11:42:09 +0100 Subject: system: Add 'initrd-modules' field. * gnu/system.scm ()[initrd-modules]: New field. (operating-system-initrd-file): Pass #:linux-modules to 'make-initrd'. * gnu/system/linux-initrd.scm (default-initrd-modules): New procedure. (%base-initrd-modules): New macro. (base-initrd): Add #:linux-modules and honor it. * gnu/system/install.scm (embedded-installation-os): Use 'initrd-modules' instead of 'initrd'. * gnu/tests/install.scm (%raid-root-os): Likewise. * doc/guix.texi (operating-system Reference): Add 'initrd-modules'. (Initial RAM Disk): Document it. Adjust example to not use #:extra-modules. --- doc/guix.texi | 40 ++++++++++++++++++++++++++++++++-------- gnu/system.scm | 7 +++++++ gnu/system/install.scm | 7 ++----- gnu/system/linux-initrd.scm | 34 ++++++++++++++++++++++------------ gnu/tests/install.scm | 11 +++++------ 5 files changed, 68 insertions(+), 31 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index d35ce0e26b..70e53b3825 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8889,11 +8889,16 @@ the command-line of the kernel---e.g., @code{("console=ttyS0")}. @item @code{bootloader} The system bootloader configuration object. @xref{Bootloader Configuration}. -@item @code{initrd} (default: @code{base-initrd}) +@item @code{initrd-modules} (default: @code{%base-initrd-modules}) @cindex initrd @cindex initial RAM disk -A two-argument monadic procedure that returns an initial RAM disk for -the Linux kernel. @xref{Initial RAM Disk}. +The list of Linux kernel modules that need to be available in the +initial RAM disk. @xref{Initial RAM Disk}. + +@item @code{initrd} (default: @code{base-initrd}) +A monadic procedure that returns an initial RAM disk for the Linux +kernel. This field is provided to support low-level customization and +should rarely be needed for casual use. @xref{Initial RAM Disk}. @item @code{firmware} (default: @var{%base-firmware}) @cindex firmware @@ -19768,7 +19773,27 @@ root file system as well as an initialization script. The latter is responsible for mounting the real root file system, and for loading any kernel modules that may be needed to achieve that. -The @code{initrd} field of an @code{operating-system} declaration allows +The @code{initrd-modules} field of an @code{operating-system} +declaration allows you to specify Linux-libre kernel modules that must +be available in the initrd. In particular, this is where you would list +modules needed to actually drive the hard disk where your root partition +is---although the default value of @code{initrd-modules} should cover +most use cases. For example, assuming you need the @code{megaraid_sas} +module in addition to the default modules to be able to access your root +file system, you would write: + +@example +(operating-system + ;; @dots{} + (initrd-modules (cons "megaraid_sas" %base-initrd-modules))) +@end example + +@defvr {Scheme Variable} %base-initrd-modules +This is the list of kernel modules included in the initrd by default. +@end defvr + +Furthermore, if you need lower-level customization, the @code{initrd} +field of an @code{operating-system} declaration allows you to specify which initrd you would like to use. The @code{(gnu system linux-initrd)} module provides three ways to build an initrd: the high-level @code{base-initrd} procedure and the low-level @@ -19781,11 +19806,10 @@ system declaration like this: @example (initrd (lambda (file-systems . rest) - ;; Create a standard initrd that has modules "foo.ko" - ;; and "bar.ko", as well as their dependencies, in - ;; addition to the modules available by default. + ;; Create a standard initrd but set up networking + ;; with the parameters QEMU expects by default. (apply base-initrd file-systems - #:extra-modules '("foo" "bar") + #:qemu-networking? #t rest))) @end example diff --git a/gnu/system.scm b/gnu/system.scm index 71beee8259..1bcc1e1384 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -74,6 +74,7 @@ operating-system-kernel operating-system-kernel-file operating-system-kernel-arguments + operating-system-initrd-modules operating-system-initrd operating-system-users operating-system-groups @@ -154,6 +155,10 @@ booted from ROOT-DEVICE" (initrd operating-system-initrd ; (list fs) -> M derivation (default base-initrd)) + (initrd-modules operating-system-initrd-modules ; list of strings + (thunked) ; it's system-dependent + (default %base-initrd-modules)) + (firmware operating-system-firmware ; list of packages (default %base-firmware)) @@ -846,6 +851,8 @@ hardware-related operations as necessary when booting a Linux container." (mlet %store-monad ((initrd (make-initrd boot-file-systems #:linux (operating-system-kernel os) + #:linux-modules + (operating-system-initrd-modules os) #:mapped-devices mapped-devices))) (return (file-append initrd "/initrd")))) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index b61660b4b9..37c591ec3a 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016 Andreas Enge ;;; Copyright © 2017 Marius Bakke @@ -396,10 +396,7 @@ The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET." (kernel-arguments (cons (string-append "console=" tty) (operating-system-user-kernel-arguments installation-os))) - (initrd (lambda (fs . rest) - (apply base-initrd fs - #:extra-modules extra-modules - rest))))) + (initrd-modules (append extra-modules %base-initrd-modules)))) (define beaglebone-black-installation-os (embedded-installation-os u-boot-beaglebone-black-bootloader diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 830445ac83..e7f97bb88d 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -43,6 +43,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (expression->initrd + %base-initrd-modules raw-initrd file-system-packages base-initrd)) @@ -277,14 +278,31 @@ FILE-SYSTEMS." (append-map (compose file-system-type-modules file-system-type) file-systems)) +(define* (default-initrd-modules #:optional (system (%current-system))) + "Return the list of modules included in the initrd by default." + `("ahci" ;for SATA controllers + "usb-storage" "uas" ;for the installation image etc. + "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot + "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions + "nls_iso8859-1" ;for `mkfs.fat`, et.al + ,@(if (string-match "^(x86_64|i[3-6]86)-" system) + '("pata_acpi" "pata_atiixp" ;for ATA controllers + "isci") ;for SAS controllers like Intel C602 + '()))) + +(define-syntax %base-initrd-modules + ;; This more closely matches our naming convention. + (identifier-syntax (default-initrd-modules))) + (define* (base-initrd file-systems #:key (linux linux-libre) + (linux-modules '()) (mapped-devices '()) qemu-networking? volatile-root? (virtio? #t) - (extra-modules '()) + (extra-modules '()) ;deprecated (on-error 'debug)) "Return a monadic derivation that builds a generic initrd, with kernel modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be @@ -307,17 +325,9 @@ loaded at boot time in the order in which they appear." '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net" "virtio_console")) - (define linux-modules + (define linux-modules* ;; Modules added to the initrd and loaded from the initrd. - `("ahci" ;for SATA controllers - "usb-storage" "uas" ;for the installation image etc. - "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot - "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions - "nls_iso8859-1" ;for `mkfs.fat`, et.al - ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system)) - '("pata_acpi" "pata_atiixp" ;for ATA controllers - "isci") ;for SAS controllers like Intel C602 - '()) + `(,@linux-modules ,@(if (or virtio? qemu-networking?) virtio-modules '()) @@ -332,7 +342,7 @@ loaded at boot time in the order in which they appear." (raw-initrd file-systems #:linux linux - #:linux-modules linux-modules + #:linux-modules linux-modules* #:mapped-devices mapped-devices #:helper-packages helper-packages #:qemu-networking? qemu-networking? diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 3ac4a579da..e3bb1b46af 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. @@ -565,11 +565,10 @@ where /gnu lives on a separate partition.") (bootloader grub-bootloader) (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) - (initrd (lambda (file-systems . rest) - ;; Add a kernel module for RAID-0 (aka. "stripe"). - (apply base-initrd file-systems - #:extra-modules '("raid0") - rest))) + + ;; Add a kernel module for RAID-0 (aka. "stripe"). + (initrd-modules (cons "raid0" %base-initrd-modules)) + (mapped-devices (list (mapped-device (source (list "/dev/vda2" "/dev/vda3")) (target "/dev/md0") -- cgit v1.2.3 From eac026e5c80caae88a6cef317a46007dca343578 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 3 Mar 2018 09:33:34 +0100 Subject: linux-initrd: Add virtio modules to '%base-initrd-modules'. Fixes a regression in installation tests, whereby 'guix system init' would report that virtio modules are missing for the target devices. In practice virtio modules were always available since 'base-initrd' was always called with #:virtio? #t. This commit simply moves them to '%base-initrd-modules' so that 'guix system' knows they're available. Reported by Danny Milosavljevic at . * gnu/system/linux-initrd.scm (default-initrd-modules): Add virtio modules. (base-initrd): Remove #:virtio? and 'virtio-modules'. * gnu/system/vm.scm (expression->derivation-in-linux-vm) (system-qemu-image, virtualized-operating-system): Remove uses of #:virtio?. * doc/guix.texi (Initial RAM Disk): Update 'base-initrd' doc. --- doc/guix.texi | 18 +++++++++--------- gnu/system/linux-initrd.scm | 26 ++++++++++---------------- gnu/system/vm.scm | 9 +-------- 3 files changed, 20 insertions(+), 33 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 70e53b3825..50438f7cb4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -19893,18 +19893,18 @@ to it are lost. @deffn {Monadic Procedure} base-initrd @var{file-systems} @ [#:mapped-devices '()] [#:qemu-networking? #f] [#:volatile-root? #f]@ - [#:virtio? #t] [#:extra-modules '()] -Return a monadic derivation that builds a generic initrd. @var{file-systems} is -a list of file systems to be mounted by the initrd like for @code{raw-initrd}. -@var{mapped-devices}, @var{qemu-networking?} and @var{volatile-root?} -also behaves as in @code{raw-initrd}. + [#:linux-modules '()] +Return a monadic derivation that builds a generic initrd, with kernel +modules taken from @var{linux}. @var{file-systems} is a list of file-systems to be +mounted by the initrd, possibly in addition to the root file system specified +on the kernel command line via @code{--root}. @var{mapped-devices} is a list of device +mappings to realize before @var{file-systems} are mounted. -When @var{virtio?} is true, load additional modules so that the -initrd can be used as a QEMU guest with para-virtualized I/O drivers. +@var{qemu-networking?} and @var{volatile-root?} behaves as in @code{raw-initrd}. The initrd is automatically populated with all the kernel modules necessary -for @var{file-systems} and for the given options. However, additional kernel -modules can be listed in @var{extra-modules}. They will be added to the initrd, and +for @var{file-systems} and for the given options. Additional kernel +modules can be listed in @var{linux-modules}. They will be added to the initrd, and loaded at boot time in the order in which they appear. @end deffn diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 7a7592bf0a..e0cb59c009 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -280,6 +280,11 @@ FILE-SYSTEMS." (define* (default-initrd-modules #:optional (system (%current-system))) "Return the list of modules included in the initrd by default." + (define virtio-modules + ;; Modules for Linux para-virtualized devices, for use in QEMU guests. + '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net" + "virtio_console")) + `("ahci" ;for SATA controllers "usb-storage" "uas" ;for the installation image etc. "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot @@ -288,7 +293,9 @@ FILE-SYSTEMS." ,@(if (string-match "^(x86_64|i[3-6]86)-" system) '("pata_acpi" "pata_atiixp" ;for ATA controllers "isci") ;for SAS controllers like Intel C602 - '()))) + '()) + + ,@virtio-modules)) (define-syntax %base-initrd-modules ;; This more closely matches our naming convention. @@ -301,7 +308,6 @@ FILE-SYSTEMS." (mapped-devices '()) qemu-networking? volatile-root? - (virtio? #t) (extra-modules '()) ;deprecated (on-error 'debug)) "Return a monadic derivation that builds a generic initrd, with kernel @@ -312,25 +318,13 @@ mappings to realize before FILE-SYSTEMS are mounted. QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd. -When VIRTIO? is true, load additional modules so the initrd can -be used as a QEMU guest with the root file system on a para-virtualized block -device. - The initrd is automatically populated with all the kernel modules necessary -for FILE-SYSTEMS and for the given options. However, additional kernel -modules can be listed in EXTRA-MODULES. They will be added to the initrd, and +for FILE-SYSTEMS and for the given options. Additional kernel +modules can be listed in LINUX-MODULES. They will be added to the initrd, and loaded at boot time in the order in which they appear." - (define virtio-modules - ;; Modules for Linux para-virtualized devices, for use in QEMU guests. - '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net" - "virtio_console")) - (define linux-modules* ;; Modules added to the initrd and loaded from the initrd. `(,@linux-modules - ,@(if (or virtio? qemu-networking?) - virtio-modules - '()) ,@(file-system-modules file-systems) ,@(if volatile-root? '("overlay") diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index db29fd5ce9..91ff32ce9a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -144,7 +144,6 @@ made available under the /xchg CIFS share." (base-initrd %linux-vm-file-systems #:linux linux #:linux-modules %base-initrd-modules - #:virtio? #t #:qemu-networking? #t)))) (define builder @@ -513,12 +512,7 @@ of the GNU system as described by OS." (let ((os (operating-system (inherit os) - ;; Use an initrd with the whole QEMU shebang. - (initrd (lambda (file-systems . rest) - (apply (operating-system-initrd os) - file-systems - #:virtio? #t - rest))) + ;; Assume we have an initrd with the whole QEMU shebang. ;; Force our own root file system. Refer to it by UUID so that ;; it works regardless of how the image is used ("qemu -hda", @@ -615,7 +609,6 @@ environment with the store shared with the host. MAPPINGS is a list of (apply (operating-system-initrd os) file-systems #:volatile-root? #t - #:virtio? #t rest))) ;; Disable swap. -- cgit v1.2.3 From bdcf0e6fd484a54240a98ddf8b6fa433c1b9bd6c Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Mon, 26 Feb 2018 01:12:24 +0100 Subject: services: messaging: Prosody config supports file-like objects. * doc/guix.texi (Messaging Services): Update accordingly. * gnu/services/configuration.scm (serialize-configuration, serialize-maybe-stem, serialize-package): Return strings or string-valued gexps (these procedures were only used for their side-effects). * gnu/services/messaging.scm (serialize-field, serialize-field-list, enclose-quotes, serialize-raw-content, serialize-ssl-configuration, serialize-virtualhost-configuration-list, serialize-int-component-configuration-list, serialize-ext-component-configuration-list, serialize-virtualhost-configuration, serialize-int-component-configuration, serialize-ext-component-configuration, serialize-prosody-configuration): Return strings or string-valued gexps and stop printing. (prosody-activation): Use SERIALIZE-PROSODY-CONFIGURATION's return value with MIXED-TEXT-FILE instead of using its output with PLAIN-FILE. (serialize-non-negative-integer, serialize-non-negative-integer-list): Convert numbers to strings. (file-object?, serialize-file-object, file-object-list?, serialize-file-object-list): New procedures. (ssl-configuration)[capath, cafile], (prosody-configuration)[plugin-paths, groups-file]: Replace FILE-NAME with FILE-OBJECT. * guix/gexp.scm (file-like?): New exported procedure. --- doc/guix.texi | 13 +++-- gnu/services/configuration.scm | 17 +++---- gnu/services/messaging.scm | 106 ++++++++++++++++++++++------------------- guix/gexp.scm | 7 +++ 4 files changed, 83 insertions(+), 60 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 50438f7cb4..057272df46 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14258,6 +14258,9 @@ There is also a way to specify the configuration as a string, if you have an old @code{prosody.cfg.lua} file that you want to port over from some other system; see the end for more details. +The @code{file-object} type designates either a file-like object +(@pxref{G-Expressions, file-like objects}) or a file name. + @c The following documentation was initially generated by @c (generate-documentation) in (gnu services messaging). Manually maintained @c documentation is better, so we shouldn't hesitate to edit below as @@ -14278,7 +14281,7 @@ Location of the Prosody data storage directory. See Defaults to @samp{"/var/lib/prosody"}. @end deftypevr -@deftypevr {@code{prosody-configuration} parameter} file-name-list plugin-paths +@deftypevr {@code{prosody-configuration} parameter} file-object-list plugin-paths Additional plugin directories. They are searched in all the specified paths in order. See @url{https://prosody.im/doc/plugins_directory}. Defaults to @samp{()}. @@ -14319,7 +14322,7 @@ should you want to disable them then add them to this list. Defaults to @samp{()}. @end deftypevr -@deftypevr {@code{prosody-configuration} parameter} file-name groups-file +@deftypevr {@code{prosody-configuration} parameter} file-object groups-file Path to a text file where the shared groups are defined. If this path is empty then @samp{mod_groups} does nothing. See @url{https://prosody.im/doc/modules/mod_groups}. @@ -14352,13 +14355,13 @@ Path to your private key file. Path to your certificate file. @end deftypevr -@deftypevr {@code{ssl-configuration} parameter} file-name capath +@deftypevr {@code{ssl-configuration} parameter} file-object capath Path to directory containing root certificates that you wish Prosody to trust when verifying the certificates of remote servers. Defaults to @samp{"/etc/ssl/certs"}. @end deftypevr -@deftypevr {@code{ssl-configuration} parameter} maybe-file-name cafile +@deftypevr {@code{ssl-configuration} parameter} maybe-file-object cafile Path to a file containing root certificates that you wish Prosody to trust. Similar to @code{capath} but with all certificates concatenated together. @end deftypevr @@ -14618,6 +14621,8 @@ string, you could instantiate a prosody service like this: (prosody.cfg.lua ""))) @end example +@c end of Prosody auto-generated documentation + @subsubheading BitlBee Service @cindex IRC (Internet Relay Chat) diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index c45340f02f..707944cbe0 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Andy Wingo ;;; Copyright © 2017 Mathieu Othacehe -;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2017, 2018 Clément Lassieur ;;; ;;; This file is part of GNU Guix. ;;; @@ -74,11 +74,12 @@ (documentation configuration-field-documentation)) (define (serialize-configuration config fields) - (for-each (lambda (field) - ((configuration-field-serializer field) - (configuration-field-name field) - ((configuration-field-getter field) config))) - fields)) + #~(string-append + #$@(map (lambda (field) + ((configuration-field-serializer field) + (configuration-field-name field) + ((configuration-field-getter field) config))) + fields))) (define (validate-configuration config fields) (for-each (lambda (field) @@ -105,7 +106,7 @@ (define (maybe-stem? val) (or (eq? val 'disabled) (stem? val))) (define (serialize-maybe-stem field-name val) - (when (stem? val) (serialize-stem field-name val))))))))) + (if (stem? val) (serialize-stem field-name val) "")))))))) (define-syntax define-configuration (lambda (stx) @@ -147,7 +148,7 @@ conf)))))))) (define (serialize-package field-name val) - #f) + "") ;; A little helper to make it easier to document all those fields. (define (generate-documentation documentation documentation-name) diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 427e2121f6..80ffed0f2f 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2015, 2017, 2018 Ludovic Courtès ;;; @@ -115,16 +115,9 @@ "_"))) (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-field-list field-name val) - (serialize-field field-name - (with-output-to-string - (lambda () - (format #t "{\n") - (for-each (lambda (x) - (format #t "~a;\n" x)) - val) - (format #t "}"))))) + (serialize-field field-name #~(format #f "{\n~@{~a;\n~}}" #$@val))) (define (serialize-boolean field-name val) (serialize-field field-name (if val "true" "false"))) @@ -140,17 +133,17 @@ (define (non-negative-integer? val) (and (exact-integer? val) (not (negative? val)))) (define (serialize-non-negative-integer field-name val) - (serialize-field field-name val)) + (serialize-field field-name (number->string val))) (define-maybe non-negative-integer) (define (non-negative-integer-list? val) (and (list? val) (and-map non-negative-integer? val))) (define (serialize-non-negative-integer-list field-name val) - (serialize-field-list field-name val)) + (serialize-field-list field-name (map number->string val))) (define-maybe non-negative-integer-list) (define (enclose-quotes s) - (format #f "\"~a\"" s)) + #~(string-append "\"" #$s "\"")) (define (serialize-string field-name val) (serialize-field field-name (enclose-quotes val))) (define-maybe string) @@ -183,10 +176,22 @@ (serialize-string-list field-name val)) (define-maybe file-name) +(define (file-object? val) + (or (file-like? val) (file-name? val))) +(define (serialize-file-object field-name val) + (serialize-string field-name val)) +(define-maybe file-object) + +(define (file-object-list? val) + (and (list? val) (and-map file-object? val))) +(define (serialize-file-object-list field-name val) + (serialize-string-list field-name val)) +(define-maybe file-object) + (define (raw-content? val) (not (eq? val 'disabled))) (define (serialize-raw-content field-name val) - (format #t "~a" val)) + val) (define-maybe raw-content) (define-configuration mod-muc-configuration @@ -224,12 +229,12 @@ just joined the room.")) "Path to your certificate file.") (capath - (file-name "/etc/ssl/certs") + (file-object "/etc/ssl/certs") "Path to directory containing root certificates that you wish Prosody to trust when verifying the certificates of remote servers.") (cafile - (maybe-file-name 'disabled) + (maybe-file-object 'disabled) "Path to a file containing root certificates that you wish Prosody to trust. Similar to @code{capath} but with all certificates concatenated together.") @@ -273,9 +278,8 @@ can create such a file with: (maybe-string 'disabled) "Password for encrypted private keys.")) (define (serialize-ssl-configuration field-name val) - (format #t "ssl = {\n") - (serialize-configuration val ssl-configuration-fields) - (format #t "};\n")) + #~(format #f "ssl = {\n~a};\n" + #$(serialize-configuration val ssl-configuration-fields))) (define-maybe ssl-configuration) (define %default-modules-enabled @@ -303,20 +307,23 @@ can create such a file with: (define (virtualhost-configuration-list? val) (and (list? val) (and-map virtualhost-configuration? val))) (define (serialize-virtualhost-configuration-list l) - (for-each - (lambda (val) (serialize-virtualhost-configuration val)) l)) + #~(string-append + #$@(map (lambda (val) + (serialize-virtualhost-configuration val)) l))) (define (int-component-configuration-list? val) (and (list? val) (and-map int-component-configuration? val))) (define (serialize-int-component-configuration-list l) - (for-each - (lambda (val) (serialize-int-component-configuration val)) l)) + #~(string-append + #$@(map (lambda (val) + (serialize-int-component-configuration val)) l))) (define (ext-component-configuration-list? val) (and (list? val) (and-map ext-component-configuration? val))) (define (serialize-ext-component-configuration-list l) - (for-each - (lambda (val) (serialize-ext-component-configuration val)) l)) + #~(string-append + #$@(map (lambda (val) + (serialize-ext-component-configuration val)) l))) (define-all-configurations prosody-configuration (prosody @@ -331,7 +338,7 @@ can create such a file with: global) (plugin-paths - (file-name-list '()) + (file-object-list '()) "Additional plugin directories. They are searched in all the specified paths in order. See @url{https://prosody.im/doc/plugins_directory}." global) @@ -372,7 +379,7 @@ should you want to disable them then add them to this list." common) (groups-file - (file-name "/var/lib/prosody/sharedgroups.txt") + (file-object "/var/lib/prosody/sharedgroups.txt") "Path to a text file where the shared groups are defined. If this path is empty then @samp{mod_groups} does nothing. See @url{https://prosody.im/doc/modules/mod_groups}." @@ -566,8 +573,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." '(domain)))) (let ((domain (virtualhost-configuration-domain config)) (rest (filter rest? virtualhost-configuration-fields))) - (format #t "VirtualHost \"~a\"\n" domain) - (serialize-configuration config rest))) + #~(string-append + #$(format #f "VirtualHost \"~a\"\n" domain) + #$(serialize-configuration config rest)))) ;; Serialize Component line first. (define (serialize-int-component-configuration config) @@ -577,8 +585,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." (let ((hostname (int-component-configuration-hostname config)) (plugin (int-component-configuration-plugin config)) (rest (filter rest? int-component-configuration-fields))) - (format #t "Component \"~a\" \"~a\"\n" hostname plugin) - (serialize-configuration config rest))) + #~(string-append + #$(format #f "Component \"~a\" \"~a\"\n" hostname plugin) + #$(serialize-configuration config rest)))) ;; Serialize Component line first. (define (serialize-ext-component-configuration config) @@ -587,22 +596,24 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." '(hostname)))) (let ((hostname (ext-component-configuration-hostname config)) (rest (filter rest? ext-component-configuration-fields))) - (format #t "Component \"~a\"\n" hostname) - (serialize-configuration config rest))) + #~(string-append + #$(format #f "Component \"~a\"\n" hostname) + #$(serialize-configuration config rest)))) ;; Serialize virtualhosts and components last. (define (serialize-prosody-configuration config) (define (rest? field) (not (memq (configuration-field-name field) '(virtualhosts int-components ext-components)))) - (let ((rest (filter rest? prosody-configuration-fields))) - (serialize-configuration config rest)) - (serialize-virtualhost-configuration-list - (prosody-configuration-virtualhosts config)) - (serialize-int-component-configuration-list - (prosody-configuration-int-components config)) - (serialize-ext-component-configuration-list - (prosody-configuration-ext-components config))) + #~(string-append + #$(let ((rest (filter rest? prosody-configuration-fields))) + (serialize-configuration config rest)) + #$(serialize-virtualhost-configuration-list + (prosody-configuration-virtualhosts config)) + #$(serialize-int-component-configuration-list + (prosody-configuration-int-components config)) + #$(serialize-ext-component-configuration-list + (prosody-configuration-ext-components config)))) (define-configuration opaque-prosody-configuration (prosody @@ -646,13 +657,12 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." (default-certs-dir "/etc/prosody/certs") (data-path (prosody-configuration-data-path config)) (pidfile-dir (dirname (prosody-configuration-pidfile config))) - (config-str - (if (opaque-prosody-configuration? config) - (opaque-prosody-configuration-prosody.cfg.lua config) - (with-output-to-string - (lambda () - (serialize-prosody-configuration config))))) - (config-file (plain-file "prosody.cfg.lua" config-str))) + (config-str (if (opaque-prosody-configuration? config) + (opaque-prosody-configuration-prosody.cfg.lua config) + #~(begin + (use-modules (ice-9 format)) + #$(serialize-prosody-configuration config)))) + (config-file (mixed-text-file "prosody.cfg.lua" config-str))) #~(begin (use-modules (guix build utils)) (define %user (getpw "prosody")) diff --git a/guix/gexp.scm b/guix/gexp.scm index f005c4d296..8dea022e04 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2018 Clément Lassieur ;;; ;;; This file is part of GNU Guix. ;;; @@ -86,6 +87,7 @@ define-gexp-compiler gexp-compiler? + file-like? lower-object lower-inputs @@ -182,6 +184,11 @@ procedure to lower it; otherwise return #f." (and=> (hashq-ref %gexp-compilers (struct-vtable object)) gexp-compiler-lower)) +(define (file-like? object) + "Return #t if OBJECT leads to a file in the store once unquoted in a +G-expression; otherwise return #f." + (and (struct? object) (->bool (lookup-compiler object)))) + (define (lookup-expander object) "Search for an expander for OBJECT. Upon success, return the three argument procedure to expand it; otherwise return #f." -- cgit v1.2.3 From 16718b6776b6cb918cddb3abb3bfcf2405b0b297 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Tue, 28 Nov 2017 10:19:11 +0200 Subject: services: Add openntpd service. * gnu/packages/ntp.scm (openntpd)[arguments]: Add 'configure-flags to set openntpd daemon's user and localstatedir. Add a custom phase to not try to create said directory at install time. * gnu/services/networking.scm (): New record type. (openntpd-shepherd-service, openntpd-service-activation): New procedures. (openntpd-service-type): New variable. * doc/guix.texi (Networking Services): Add openntpd documentation. --- doc/guix.texi | 55 +++++++++++++++++++++++- gnu/packages/ntp.scm | 13 +++++- gnu/services/networking.scm | 102 +++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 167 insertions(+), 3 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 057272df46..60703875f6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -24,7 +24,7 @@ Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016, 2017 Chris Marusich@* -Copyright @copyright{} 2016, 2017 Efraim Flashner@* +Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@* Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016, 2017 ng0@* Copyright @copyright{} 2016, 2017 Jan Nieuwenhuizen@* @@ -10767,6 +10767,59 @@ make an initial adjustment of more than 1,000 seconds. List of host names used as the default NTP servers. @end defvr +@cindex OpenNTPD +@deffn {Scheme Procedure} openntpd-service-type +Run the @command{ntpd}, the Network Time Protocol (NTP) daemon, as implemented +by @uref{http://www.openntpd.org, OpenNTPD}. The daemon will keep the system +clock synchronized with that of the given servers. + +@example +(service + openntpd-service-type + (openntpd-configuration + (listen-on '("127.0.0.1" "::1")) + (sensor '("udcf0 correction 70000")) + (constraint-from '("www.gnu.org")) + (constraints-from '("https://www.google.com/")) + (allow-large-adjustment? #t))) + +@end example +@end deffn + +@deftp {Data Type} openntpd-configuration +@table @asis +@item @code{openntpd} (default: @code{(file-append openntpd "/sbin/ntpd")}) +The openntpd executable to use. +@item @code{listen-on} (default: @code{'("127.0.0.1" "::1")}) +A list of local IP addresses or hostnames the ntpd daemon should listen on. +@item @code{query-from} (default: @code{'()}) +A list of local IP address the ntpd daemon should use for outgoing queries. +@item @code{sensor} (default: @code{'()}) +Specify a list of timedelta sensor devices ntpd should use. @code{ntpd} +will listen to each sensor that acutally exists and ignore non-existant ones. +See @uref{https://man.openbsd.org/ntpd.conf, upstream documentation} for more +information. +@item @code{server} (default: @var{%ntp-servers}) +Specify a list of IP addresses or hostnames of NTP servers to synchronize to. +@item @code{servers} (default: @code{'()}) +Specify a list of IP addresses or hostnames of NTP pools to synchronize to. +@item @code{constraint-from} (default: @code{'()}) +@code{ntpd} can be configured to query the ‘Date’ from trusted HTTPS servers via TLS. +This time information is not used for precision but acts as an authenticated +constraint, thereby reducing the impact of unauthenticated NTP +man-in-the-middle attacks. +Specify a list of URLs, IP addresses or hostnames of HTTPS servers to provide +a constraint. +@item @code{constraints-from} (default: @code{'()}) +As with constraint from, specify a list of URLs, IP addresses or hostnames of +HTTPS servers to provide a constraint. Should the hostname resolve to multiple +IP addresses, @code{ntpd} will calculate a median constraint from all of them. +@item @code{allow-large-adjustment?} (default: @code{#f}) +Determines if @code{ntpd} is allowed to make an initial adjustment of more +than 180 seconds. +@end table +@end deftp + @cindex inetd @deffn {Scheme variable} inetd-service-type This service runs the @command{inetd} (@pxref{inetd invocation,,, diff --git a/gnu/packages/ntp.scm b/gnu/packages/ntp.scm index d270f513dc..1c3b8cd313 100644 --- a/gnu/packages/ntp.scm +++ b/gnu/packages/ntp.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2014, 2015 Mark H Weaver ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer ;;; Copyright © 2015 Ludovic Courtès -;;; Copyright © 2016, 2017 Efraim Flashner +;;; Copyright © 2016, 2017, 2018 Efraim Flashner ;;; ;;; This file is part of GNU Guix. ;;; @@ -107,6 +107,17 @@ computers over a network.") (base32 "0fn12i4kzsi0zkr4qp3dp9bycmirnfapajqvdfx02zhr4hanj0kv")))) (build-system gnu-build-system) + (arguments + '(#:configure-flags '("--with-privsep-user=ntpd" + "--localstatedir=/var") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'modify-install-locations + (lambda _ + ;; Don't try to create /var/run or /var/db + (substitute* "src/Makefile.in" + (("DESTDIR\\)\\$\\(localstatedir") "TMPDIR")) + #t))))) (inputs `(("libressl" ,libressl))) ; enable TLS time constraints. See ntpd.conf(5). (home-page "http://www.openntpd.org/") diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 5ba3c5eed6..6ac440fd26 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver -;;; Copyright © 2016 Efraim Flashner +;;; Copyright © 2016, 2018 Efraim Flashner ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2017 Thomas Danckaert @@ -64,6 +64,10 @@ ntp-service ntp-service-type + openntpd-configuration + openntpd-configuration? + openntpd-service-type + inetd-configuration inetd-entry inetd-service-type @@ -446,6 +450,102 @@ make an initial adjustment of more than 1,000 seconds." (allow-large-adjustment? allow-large-adjustment?)))) + +;;; +;;; OpenNTPD. +;;; + +(define-record-type* + openntpd-configuration make-openntpd-configuration + openntpd-configuration? + (openntpd openntpd-configuration-openntpd + (default openntpd)) + (listen-on openntpd-listen-on + (default '("127.0.0.1" + "::1"))) + (query-from openntpd-query-from + (default '())) + (sensor openntpd-sensor + (default '())) + (server openntpd-server + (default %ntp-servers)) + (servers openntpd-servers + (default '())) + (constraint-from openntpd-constraint-from + (default '())) + (constraints-from openntpd-constraints-from + (default '())) + (allow-large-adjustment? openntpd-allow-large-adjustment? + (default #f))) ; upstream default + +(define (openntpd-shepherd-service config) + (match-record config + (openntpd listen-on query-from sensor server servers constraint-from + constraints-from allow-large-adjustment?) + (let () + (define config + (string-join + (filter-map + (lambda (field value) + (string-join + (map (cut string-append field <> "\n") + value))) + '("listen on " "query from " "sensor " "server " "servers " + "constraint from ") + (list listen-on query-from sensor server servers constraint-from)) + ;; The 'constraints from' field needs to be enclosed in double quotes. + (string-join + (map (cut string-append "constraints from \"" <> "\"\n") + constraints-from)))) + + (define ntpd.conf + (plain-file "ntpd.conf" config)) + + (list (shepherd-service + (provision '(ntpd)) + (documentation "Run the Network Time Protocol (NTP) daemon.") + (requirement '(user-processes networking)) + (start #~(make-forkexec-constructor + (list (string-append #$openntpd "/sbin/ntpd") + "-f" #$ntpd.conf + "-d" ;; don't daemonize + #$@(if allow-large-adjustment? + '("-s") + '())) + ;; When ntpd is daemonized it repeatedly tries to respawn + ;; while running, leading shepherd to disable it. To + ;; prevent spamming stderr, redirect output to logfile. + #:log-file "/var/log/ntpd")) + (stop #~(make-kill-destructor))))))) + +(define (openntpd-service-activation config) + "Return the activation gexp for CONFIG." + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (mkdir-p "/var/db") + (mkdir-p "/var/run") + (unless (file-exists? "/var/db/ntpd.drift") + (with-output-to-file "/var/db/ntpd.drift" + (lambda _ + (format #t "0.0"))))))) + +(define openntpd-service-type + (service-type (name 'openntpd) + (extensions + (list (service-extension shepherd-root-service-type + openntpd-shepherd-service) + (service-extension account-service-type + (const %ntp-accounts)) + (service-extension activation-service-type + openntpd-service-activation))) + (default-value (openntpd-configuration)) + (description + "Run the @command{ntpd}, the Network Time Protocol (NTP) +daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The +daemon will keep the system clock synchronized with that of the given servers."))) + ;;; ;;; Inetd. -- cgit v1.2.3 From ca041ec1a3dc9319ca8ac72bbdd984f0bd36ba48 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 4 Mar 2018 22:39:43 +0100 Subject: doc: Adjust 'xset -fp' command to avoid symlinks. Fixes . Reported by Marco van Hulten . * doc/guix.texi (Application Setup): Adjust 'xset +fp' example. --- doc/guix.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 60703875f6..abec0c0879 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1572,8 +1572,10 @@ full name of a font using XLFD (X Logical Font Description), like this: To be able to use such full names for the TrueType fonts installed in your Guix profile, you need to extend the font path of the X server: +@c Note: 'xset' does not accept symlinks so the trick below arranges to +@c get at the real directory. See . @example -xset +fp `readlink -f ~/.guix-profile/share/fonts/truetype` +xset +fp $(dirname $(readlink -f ~/.guix-profile/share/fonts/truetype/fonts.dir)) @end example @cindex @code{xlsfonts} -- cgit v1.2.3 From 1f3921e1435db7c9489f22832554ad4692434efc Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 7 Mar 2018 17:39:04 +0100 Subject: doc: Explain what we mean by root in binary installation. * doc/guix.texi (Binary Installation): Add explicit instructions to become root. --- doc/guix.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index abec0c0879..d3a7908f9c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -443,7 +443,8 @@ and rerun the @code{gpg --verify} command. @c end authentication part @item -As @code{root}, run: +Now, you need to become the @code{root} user. Depending on your distribution, +you may have to run @code{su -} or @code{sudo -i}. As @code{root}, run: @example # cd /tmp -- cgit v1.2.3