summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/certbot.scm22
-rw-r--r--gnu/services/cgit.scm133
-rw-r--r--gnu/services/desktop.scm22
3 files changed, 118 insertions, 59 deletions
diff --git a/gnu/services/certbot.scm b/gnu/services/certbot.scm
index a2a200f032..7548145c98 100644
--- a/gnu/services/certbot.scm
+++ b/gnu/services/certbot.scm
@@ -26,6 +26,7 @@
#:use-module (gnu services web)
#:use-module (gnu system shadow)
#:use-module (gnu packages tls)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
@@ -113,14 +114,19 @@
#$(certbot-command config))))
(define (certbot-activation config)
- (match config
- (($ <certbot-configuration> package webroot certificates email
- rsa-key-size default-location)
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir-p #$webroot)
- (zero? (system* #$(certbot-command config))))))))
+ (let* ((certbot-directory "/var/lib/certbot")
+ (script (in-vicinity certbot-directory "renew-certificates"))
+ (message (format #f (G_ "~a may need to be run~%") script)))
+ (match config
+ (($ <certbot-configuration> package webroot certificates email
+ rsa-key-size default-location)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p #$webroot)
+ (mkdir-p #$certbot-directory)
+ (copy-file #$(certbot-command config) #$script)
+ (display #$message)))))))
(define certbot-nginx-server-configurations
(match-lambda
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index a868d758a4..8ef12cd5a0 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -72,17 +73,15 @@
;;;
(define (uglify-field-name field-name)
- (let ((str (symbol->string field-name)))
- (string-join (string-split (string-delete #\? str) #\-) "-")))
+ (string-delete #\? (symbol->string field-name)))
(define (serialize-field field-name val)
- (format #t "~a=~a\n" (uglify-field-name field-name) val))
+ #~(format #f "~a=~a\n" #$(uglify-field-name field-name) #$val))
(define (serialize-string field-name val)
- (if (string=? val "") "" (serialize-field field-name val)))
-
-(define (serialize-boolean field-name val)
- (serialize-field field-name (if val 1 0)))
+ (if (and (string? val) (string=? val ""))
+ ""
+ (serialize-field field-name val)))
(define (serialize-list field-name val)
(if (null? val) "" (serialize-field field-name (string-join val))))
@@ -96,7 +95,10 @@
(exact-integer? val))
(define (serialize-integer field-name val)
- (serialize-field field-name val))
+ (serialize-field field-name (number->string val)))
+
+(define (serialize-boolean field-name val)
+ (serialize-integer field-name (if val 1 0)))
(define (serialize-repository-cgit-configuration x)
(serialize-configuration x repository-cgit-configuration-fields))
@@ -105,7 +107,13 @@
(list? val))
(define (serialize-repository-cgit-configuration-list field-name val)
- (for-each serialize-repository-cgit-configuration val))
+ #~(string-append
+ #$@(map serialize-repository-cgit-configuration val)))
+
+(define (file-object? val)
+ (or (file-like? val) (string? val)))
+(define (serialize-file-object field-name val)
+ (serialize-string field-name val))
;;;
@@ -116,7 +124,7 @@
(and (list? val) (and-map nginx-server-configuration? val)))
(define (serialize-nginx-server-configuration-list field-name val)
- #f)
+ "")
;;;
@@ -124,18 +132,18 @@
;;;
(define (serialize-repo-field field-name val)
- (format #t "repo.~a=~a\n" (uglify-field-name field-name) val))
+ #~(format #f "repo.~a=~a\n" #$(uglify-field-name field-name) #$val))
(define (serialize-repo-list field-name val)
(if (null? val) "" (serialize-repo-field field-name (string-join val))))
(define repo-boolean? boolean?)
-(define (serialize-repo-boolean field-name val)
- (serialize-repo-field field-name (if val 1 0)))
-
(define (serialize-repo-integer field-name val)
- (serialize-repo-field field-name val))
+ (serialize-repo-field field-name (number->string val)))
+
+(define (serialize-repo-boolean field-name val)
+ (serialize-repo-integer field-name (if val 1 0)))
(define repo-list? list?)
@@ -144,26 +152,32 @@
(define (serialize-repo-string field-name val)
(if (string=? val "") "" (serialize-repo-field field-name val)))
+(define repo-file-object? file-object?)
+(define serialize-repo-file-object serialize-repo-string)
+
(define module-link-path? list?)
(define (serialize-module-link-path field-name val)
(if (null? val) ""
(match val
((path text)
- (format #t "repo.~a.~a=~a\n"
- (string-drop-right (uglify-field-name 'module-link-path)
- (string-length "-path"))
- path text)))))
+ (format #f "repo.module-link.~a=~a\n" path text)))))
+
+(define (serialize-project-list _ val)
+ (if (null? val) ""
+ (serialize-field
+ 'project-list
+ (plain-file "project-list" (string-join val "\n")))))
(define repository-directory? string?)
(define (serialize-repository-directory _ val)
- (if (string=? val "") "" (format #t "scan-path=~a\n" val)))
+ (if (string=? val "") "" (format #f "scan-path=~a\n" val)))
(define mimetype-alist? list?)
(define (serialize-mimetype-alist field-name val)
- (format #t "# Mimetypes\n~a"
+ (format #f "# Mimetypes\n~a"
(string-join
(map (match-lambda
((extension mimetype)
@@ -177,13 +191,13 @@
"A mask of snapshot formats for this repo that cgit generates links for,
restricted by the global @code{snapshots} setting.")
(source-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{source-filter}.")
(url
(repo-string "")
"The relative URL used to access the repository.")
(about-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{about-filter}.")
(branch-sort
(repo-string "")
@@ -193,7 +207,7 @@ ref list, and when set to @samp{name} enables ordering by branch name.")
(repo-list '())
"A list of URLs which can be used to clone repo.")
(commit-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{commit-filter}.")
(commit-sort
(repo-string "")
@@ -212,7 +226,7 @@ is no suitable HEAD.")
(repo-string "")
"The value to show as repository homepage.")
(email-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{email-filter}.")
(enable-commit-graph?
(repo-boolean #f)
@@ -246,14 +260,14 @@ repository index.")
(repo-boolean #f)
"Flag which, when set to @samp{#t}, ignores the repository.")
(logo
- (repo-string "")
+ (repo-file-object "")
"URL which specifies the source of an image which will be used as a
logo on this repo’s pages.")
(logo-link
(repo-string "")
"URL loaded when clicking on the cgit logo image.")
(owner-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{owner-filter}.")
(module-link
(repo-string "")
@@ -299,7 +313,7 @@ after this option will inherit the current section name.")
(nginx-server-configuration-list (list %cgit-configuration-nginx))
"NGINX configuration.")
(about-filter
- (string "")
+ (file-object "")
"Specifies a command which will be invoked to format the content of about
pages (both top-level and for each repository).")
(agefile
@@ -307,7 +321,7 @@ pages (both top-level and for each repository).")
"Specifies a path, relative to each repository path, which can be used to
specify the date and time of the youngest commit in the repository.")
(auth-filter
- (string "")
+ (file-object "")
"Specifies a command that will be invoked for authenticating repository
access.")
(branch-sort
@@ -360,7 +374,7 @@ generates valid clone URLs for the repository.")
(list '())
"List of @code{clone-url} templates.")
(commit-filter
- (string "")
+ (file-object "")
"Command which will be invoked to format commit messages.")
(commit-sort
(string "git log")
@@ -368,10 +382,10 @@ generates valid clone URLs for the repository.")
commit log, and when set to @samp{topo} enables strict topological
ordering.")
(css
- (string "/share/cgit/cgit.css")
+ (file-object "/share/cgit/cgit.css")
"URL which specifies the css document to include in all cgit pages.")
(email-filter
- (string "")
+ (file-object "")
"Specifies a command which will be invoked to format names and email
address of committers, authors, and taggers, as represented in various
places throughout the cgit interface.")
@@ -435,7 +449,7 @@ links for plaintext blobs printed in the tree view.")
"Flag which, when set to @samp{#f}, will allow cgit to use Git config to
set any repo specific settings.")
(favicon
- (string "/favicon.ico")
+ (file-object "/favicon.ico")
"URL used as link to a shortcut icon for cgit.")
(footer
(string "")
@@ -451,7 +465,7 @@ verbatim in the HTML HEAD section on all pages.")
"The content of the file specified with this option will be included
verbatim at the top of all pages.")
(include
- (string "")
+ (file-object "")
"Name of a configfile to include before the rest of the current config-
file is parsed.")
(index-header
@@ -467,14 +481,14 @@ verbatim below the heading on the repository index page.")
"Flag which, if set to @samp{#t}, makes cgit print commit and tag times
in the servers timezone.")
(logo
- (string "/share/cgit/cgit.png")
+ (file-object "/share/cgit/cgit.png")
"URL which specifies the source of an image which will be used as a logo
on all cgit pages.")
(logo-link
(string "")
"URL loaded when clicking on the cgit logo image.")
(owner-filter
- (string "")
+ (file-object "")
"Command which will be invoked to format the Owner column of the main
page.")
(max-atom-items
@@ -511,7 +525,7 @@ on the repository index page.")
(svg "image/svg+xml")))
"Mimetype for the specified filename extension.")
(mimetype-file
- (string "")
+ (file-object "")
"Specifies the file to use for automatic mimetype lookup.")
(module-link
(string "")
@@ -528,15 +542,13 @@ disabled.")
(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.")
+ (project-list
+ (list '())
+ "A list of subdirectories inside of @code{repository-directory}, relative
+to it, that should loaded as Git repositories. An empty list means that all
+subdirectories will be loaded.")
(readme
- (string "")
+ (file-object "")
"Text which will be used as default value for @code{cgit-repo-readme}.")
(remove-suffix?
(boolean #f)
@@ -594,7 +606,7 @@ many path elements from each repo path to use as a default section name.")
"If set to @samp{#t} shows side-by-side diffs instead of unidiffs per
default.")
(source-filter
- (string "")
+ (file-object "")
"Specifies a command which will be invoked to format plaintext blobs in the
tree view.")
(summary-branches
@@ -623,6 +635,27 @@ for cgit to allow access to that repository.")
(list '())
"Extra options will be appended to cgitrc file."))
+;; This distinguishes fields whose order matters, and makes sure further
+;; changes won't inadvertently change the order.
+(define (serialize-cgit-configuration config)
+ (define (rest? field)
+ (not (memq (configuration-field-name field)
+ '(project-list
+ repository-directory
+ repositories))))
+ #~(string-append
+ #$(let ((rest (filter rest? cgit-configuration-fields)))
+ (serialize-configuration config rest))
+ #$(serialize-project-list
+ 'project-list
+ (cgit-configuration-project-list config))
+ #$(serialize-repository-directory
+ 'repository-directory
+ (cgit-configuration-repository-directory config))
+ #$(serialize-repository-cgit-configuration-list
+ 'repositories
+ (cgit-configuration-repositories config))))
+
(define-configuration opaque-cgit-configuration
(cgit
(package cgit)
@@ -643,16 +676,14 @@ for cgit to allow access to that repository.")
(config-str
(if opaque-config?
(opaque-cgit-configuration-cgitrc config)
- (with-output-to-string
- (lambda ()
- (serialize-configuration config
- cgit-configuration-fields))))))
+ (serialize-cgit-configuration config))))
#~(begin
(use-modules (guix build utils))
(mkdir-p #$(if opaque-config?
(opaque-cgit-configuration-cache-root config)
(cgit-configuration-cache-root config)))
- (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
+ (copy-file #$(mixed-text-file "cgitrc" config-str)
+ "/etc/cgitrc"))))
(define (cgit-configuration-nginx-config config)
(if (opaque-cgit-configuration? config)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 8972529179..517d5d3efe 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -94,6 +94,8 @@
xfce-desktop-service
xfce-desktop-service-type
+ x11-socket-directory-service
+
%desktop-services))
;;; Commentary:
@@ -882,6 +884,24 @@ with the administrator's password."
;;;
+;;; X11 socket directory service
+;;;
+
+(define x11-socket-directory-service
+ ;; Return a service that creates /tmp/.X11-unix. When using X11, libxcb
+ ;; takes care of creating that directory. However, when using XWayland, we
+ ;; need to create beforehand. Thus, create it unconditionally here.
+ (simple-service 'x11-socket-directory
+ activation-service-type
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (let ((directory "/tmp/.X11-unix"))
+ (mkdir-p directory)
+ (chmod directory #o777))))))
+
+
+;;;
;;; The default set of desktop services.
;;;
@@ -912,6 +932,8 @@ with the administrator's password."
(ntp-service)
+ x11-socket-directory-service
+
%base-services))
;;; desktop.scm ends here