From 557d9c8d7a843bf06e75b4e1a742654ccf951fa3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Jan 2017 18:47:15 +0100 Subject: etc: Support indentation of whole files. * etc/indent-package.el.in: Rename to... * etc/indent-code.el.in: ... this. Add case for a single argument. * doc/contributing.texi (Formatting Code): Adjust accordingly. * configure.ac: Likewise. --- doc/contributing.texi | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/contributing.texi b/doc/contributing.texi index 9fc1eb54d8..4454df1f98 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -256,12 +256,17 @@ If you do not use Emacs, please make sure to let your editor knows these rules. To automatically indent a package definition, you can also run: @example -./etc/indent-package.el gnu/packages/@var{file}.scm @var{package} +./etc/indent-code.el gnu/packages/@var{file}.scm @var{package} @end example @noindent This automatically indents the definition of @var{package} in -@file{gnu/packages/@var{file}.scm} by running Emacs in batch mode. +@file{gnu/packages/@var{file}.scm} by running Emacs in batch mode. To +indent a whole file, omit the second argument: + +@example +./etc/indent-code.el gnu/services/@var{file}.scm +@end example We require all top-level procedures to carry a docstring. This requirement can be relaxed for simple private procedures in the @@ -374,7 +379,7 @@ or a package update along with fixes to that package. @item Please follow our code formatting rules, possibly running the -@command{etc/indent-package.el} script to do that automatically for you +@command{etc/indent-code.el} script to do that automatically for you (@pxref{Formatting Code}). @end enumerate -- cgit v1.2.3 From 153b62957cd5b08ccc2440854c90b5693ba52eea Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 14 Jan 2017 00:03:32 +0100 Subject: challenge: Add '--verbose'. * guix/scripts/challenge.scm (summarize-report): Add #:verbose? parameter. [report-hashes]: New procedure. Use it. Honor VERBOSE? in the 'match case. (show-help, %options): Add '--verbose'. (guix-challenge): Honor it. --- doc/guix.texi | 5 +++++ guix/scripts/challenge.scm | 48 ++++++++++++++++++++++++++++++---------------- 2 files changed, 37 insertions(+), 16 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index c495e39f42..fa07aba5ad 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6412,6 +6412,11 @@ The one option that matters is: Consider @var{urls} the whitespace-separated list of substitute source URLs to compare to. +@item --verbose +@itemx -v +Show details about matches (identical contents) in addition to +information about mismatches. + @end table @node Invoking guix copy diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index f14e931d74..815bb789c3 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -180,28 +180,35 @@ taken since we do not import the archives." local)))) (define* (summarize-report comparison-report - #:key (hash->string - bytevector->nix-base32-string)) + #:key + (hash->string bytevector->nix-base32-string) + verbose?) "Write to the current error port a summary of REPORT, a -object." +object. When VERBOSE?, display matches in addition to mismatches and +inconclusive reports." + (define (report-hashes item local narinfos) + (if local + (report (_ " local hash: ~a~%") (hash->string local)) + (report (_ " no local build for '~a'~%") item)) + (for-each (lambda (narinfo) + (report (_ " ~50a: ~a~%") + (uri->string (narinfo-uri narinfo)) + (hash->string + (narinfo-hash->sha256 (narinfo-hash narinfo))))) + narinfos)) + (match comparison-report (($ item 'mismatch local (narinfos ...)) (report (_ "~a contents differ:~%") item) - (if local - (report (_ " local hash: ~a~%") (hash->string local)) - (report (_ " no local build for '~a'~%") item)) - (for-each (lambda (narinfo) - (report (_ " ~50a: ~a~%") - (uri->string (narinfo-uri narinfo)) - (hash->string - (narinfo-hash->sha256 (narinfo-hash narinfo))))) - narinfos)) + (report-hashes item local narinfos)) (($ item 'inconclusive #f narinfos) (warning (_ "could not challenge '~a': no local build~%") item)) (($ item 'inconclusive locals ()) (warning (_ "could not challenge '~a': no substitutes~%") item)) - (($ item 'match) - #t))) + (($ item 'match local (narinfos ...)) + (when verbose? + (report (_ "~a contents match:~%") item) + (report-hashes item local narinfos))))) ;;; @@ -214,6 +221,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (display (_ " --substitute-urls=URLS compare build results with those at URLS")) + (display (_ " + -v, --verbose show details about successful comparisons")) (newline) (display (_ " -h, --help display this help and exit")) @@ -237,6 +246,11 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (alist-cons 'substitute-urls (string-tokenize arg) (alist-delete 'substitute-urls result)) + rest))) + (option '("verbose" #\v) #f #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'verbose? #t result) rest))))) (define %default-options @@ -256,7 +270,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (_ #f)) opts)) (system (assoc-ref opts 'system)) - (urls (assoc-ref opts 'substitute-urls))) + (urls (assoc-ref opts 'substitute-urls)) + (verbose? (assoc-ref opts 'verbose?))) (leave-on-EPIPE (with-store store ;; Disable grafts since substitute servers normally provide only @@ -275,7 +290,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (mlet* %store-monad ((items (mapm %store-monad ensure-store-item files)) (reports (compare-contents items urls))) - (for-each summarize-report reports) + (for-each (cut summarize-report <> #:verbose? verbose?) + reports) (exit (cond ((any comparison-report-mismatch? reports) 2) ((every comparison-report-match? reports) 0) -- cgit v1.2.3 From 2be1b4712d362fa9face12a731e75038ae9d59ba Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Sat, 7 Jan 2017 20:16:00 +0100 Subject: gnu: Add openvpn service. * gnu/services/vpn.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (VPN Services): New section. --- doc/guix.texi | 360 +++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/vpn.scm | 491 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 852 insertions(+) create mode 100644 gnu/services/vpn.scm (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index fa07aba5ad..55657ec81c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -208,6 +208,7 @@ Services * Messaging Services:: Messaging services. * Kerberos Services:: Kerberos services. * Web Services:: Web servers. +* VPN Services:: VPN daemons. * Network File System:: NFS related services. * Continuous Integration:: The Cuirass service. * Miscellaneous Services:: Other services. @@ -8120,6 +8121,7 @@ declaration. * Messaging Services:: Messaging services. * Kerberos Services:: Kerberos services. * Web Services:: Web servers. +* VPN Services:: VPN daemons. * Network File System:: NFS related services. * Continuous Integration:: The Cuirass service. * Miscellaneous Services:: Other services. @@ -12354,6 +12356,364 @@ Whether the server should add its configuration to response. @end table @end deftp +@node VPN Services +@subsubsection VPN Services +@cindex VPN (virtual private network) +@cindex virtual private network (VPN) + +The @code{(gnu services vpn)} module provides services related to +@dfn{virtual private networks} (VPNs). It provides a @emph{client} service for +your machine to connect to a VPN, and a @emph{servire} service for your machine +to host a VPN. Both services use @uref{https://openvpn.net/, OpenVPN}. + +@deffn {Scheme Procedure} openvpn-client-service @ + [#:config (openvpn-client-configuration)] + +Return a service that runs @command{openvpn}, a VPN daemon, as a client. +@end deffn + +@deffn {Scheme Procedure} openvpn-server-service @ + [#:config (openvpn-server-configuration)] + +Return a service that runs @command{openvpn}, a VPN daemon, as a server. + +Both can be run simultaneously. +@end deffn + +@c %automatically generated documentation + +Available @code{openvpn-client-configuration} fields are: + +@deftypevr @code{openvpn-client-configuration} parameter package openvpn +The OpenVPN package. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string pid-file +The OpenVPN pid file. + +Defaults to @samp{"/var/run/openvpn/openvpn.pid"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter proto proto +The protocol (UDP or TCP) used to open a channel between clients and +servers. + +Defaults to @samp{udp}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter dev dev +The device type used to represent the VPN connection. + +Defaults to @samp{tun}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string ca +The certificate authority to check connections against. + +Defaults to @samp{"/etc/openvpn/ca.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string cert +The certificate of the machine the daemon is running on. It should be +signed by the authority given in @code{ca}. + +Defaults to @samp{"/etc/openvpn/client.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter string key +The key of the machine the daemon is running on. It must be the key whose +certificate is @code{cert}. + +Defaults to @samp{"/etc/openvpn/client.key"}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter boolean comp-lzo? +Whether to use the lzo compression algorithm. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter boolean persist-key? +Don't re-read key files across SIGUSR1 or --ping-restart. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter boolean persist-tun? +Don't close and reopen TUN/TAP device or run up/down scripts across +SIGUSR1 or --ping-restart restarts. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter number verbosity +Verbosity level. + +Defaults to @samp{3}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter tls-auth-client tls-auth +Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter key-usage verify-key-usage? +Whether to check the server certificate has server usage extension. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter bind bind? +Bind to a specific local port number. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter resolv-retry resolv-retry? +Retry resolving server address. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-client-configuration} parameter openvpn-remote-list remote +A list of remote servers to connect to. + +Defaults to @samp{()}. + +Available @code{openvpn-remote-configuration} fields are: + +@deftypevr @code{openvpn-remote-configuration} parameter string name +Server name. + +Defaults to @samp{"my-server"}. + +@end deftypevr + +@deftypevr @code{openvpn-remote-configuration} parameter number port +Port number the server listens to. + +Defaults to @samp{1194}. + +@end deftypevr + +@end deftypevr +@c %end of automatic openvpn-client documentation + +@c %automatically generated documentation + +Available @code{openvpn-server-configuration} fields are: + +@deftypevr @code{openvpn-server-configuration} parameter package openvpn +The OpenVPN package. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string pid-file +The OpenVPN pid file. + +Defaults to @samp{"/var/run/openvpn/openvpn.pid"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter proto proto +The protocol (UDP or TCP) used to open a channel between clients and +servers. + +Defaults to @samp{udp}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter dev dev +The device type used to represent the VPN connection. + +Defaults to @samp{tun}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string ca +The certificate authority to check connections against. + +Defaults to @samp{"/etc/openvpn/ca.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string cert +The certificate of the machine the daemon is running on. It should be +signed by the authority given in @code{ca}. + +Defaults to @samp{"/etc/openvpn/client.crt"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string key +The key of the machine the daemon is running on. It must be the key whose +certificate is @code{cert}. + +Defaults to @samp{"/etc/openvpn/client.key"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean comp-lzo? +Whether to use the lzo compression algorithm. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean persist-key? +Don't re-read key files across SIGUSR1 or --ping-restart. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean persist-tun? +Don't close and reopen TUN/TAP device or run up/down scripts across +SIGUSR1 or --ping-restart restarts. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter number verbosity +Verbosity level. + +Defaults to @samp{3}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter tls-auth-server tls-auth +Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter number port +Specifies the port number on which the server listens. + +Defaults to @samp{1194}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter ip-mask server +An ip and mask specifying the subnet inside the virtual network. + +Defaults to @samp{"10.8.0.0 255.255.255.0"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter cidr6 server-ipv6 +A CIDR notation specifying the IPv6 subnet inside the virtual network. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string dh +The Diffie-Hellman parameters file. + +Defaults to @samp{"/etc/openvpn/dh2048.pem"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string ifconfig-pool-persist +The file that records client IPs. + +Defaults to @samp{"/etc/openvpn/ipp.txt"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter gateway redirect-gateway? +When true, the server will act as a gateway for its clients. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter boolean client-to-client? +When true, clients are alowed to talk to each other inside the VPN. + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter keepalive keepalive +Causes ping-like messages to be sent back and forth over the link so +that each side knows when the other side has gone down. @code{keepalive} +requires a pair. The first element is the period of the ping sending, +and the second element is the timeout before considering the other side +down. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter number max-clients +The maximum number of clients. + +Defaults to @samp{100}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter string status +The status file. This file shows a small report on current connection. +It is trunkated and rewritten every minute. + +Defaults to @samp{"/var/run/openvpn/status"}. + +@end deftypevr + +@deftypevr @code{openvpn-server-configuration} parameter openvpn-ccd-list client-config-dir +The list of configuration for some clients. + +Defaults to @samp{()}. + +Available @code{openvpn-ccd-configuration} fields are: + +@deftypevr @code{openvpn-ccd-configuration} parameter string name +Client name. + +Defaults to @samp{"client"}. + +@end deftypevr + +@deftypevr @code{openvpn-ccd-configuration} parameter ip-mask iroute +Client own network + +Defaults to @samp{#f}. + +@end deftypevr + +@deftypevr @code{openvpn-ccd-configuration} parameter ip-mask ifconfig-push +Client VPN IP. + +Defaults to @samp{#f}. + +@end deftypevr + +@end deftypevr + + +@c %end of automatic openvpn-server documentation + + @node Network File System @subsubsection Network File System @cindex NFS diff --git a/gnu/local.mk b/gnu/local.mk index d378872372..81d774eb6a 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -424,6 +424,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/spice.scm \ %D%/services/ssh.scm \ %D%/services/version-control.scm \ + %D%/services/vpn.scm \ %D%/services/web.scm \ %D%/services/xorg.scm \ \ diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm new file mode 100644 index 0000000000..c21995453e --- /dev/null +++ b/gnu/services/vpn.scm @@ -0,0 +1,491 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Julien Lepiller +;;; +;;; 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 vpn) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu system shadow) + #:use-module (gnu packages admin) + #:use-module (gnu packages vpn) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export (openvpn-client-service + openvpn-server-service + openvpn-client-service-type + openvpn-server-service-type + openvpn-client-configuration + openvpn-server-configuration + openvpn-remote-configuration + openvpn-ccd-configuration + generate-openvpn-client-documentation + generate-openvpn-server-documentation)) + +;;; +;;; OpenVPN. +;;; + +(define (uglify-field-name name) + (match name + ('verbosity "verb") + (_ (let ((str (symbol->string name))) + (if (string-suffix? "?" str) + (substring str 0 (1- (string-length str))) + str))))) + +(define (serialize-field field-name val) + (if (eq? field-name 'pid-file) + (format #t "") + (format #t "~a ~a\n" (uglify-field-name field-name) val))) +(define serialize-string serialize-field) +(define (serialize-boolean field-name val) + (if val + (serialize-field field-name val) + (format #t ""))) + +(define (ip-mask? val) + (and (string? val) + (if (string-match "^([0-9]+\\.){3}[0-9]+ ([0-9]+\\.){3}[0-9]+$" val) + (let ((numbers (string-tokenize val char-set:digit))) + (all-lte numbers (list 255 255 255 255 255 255 255 255))) + #f))) +(define serialize-ip-mask serialize-string) + +(define-syntax define-enumerated-field-type + (lambda (x) + (define (id-append ctx . parts) + (datum->syntax ctx (apply symbol-append (map syntax->datum parts)))) + (syntax-case x () + ((_ name (option ...)) + #`(begin + (define (#,(id-append #'name #'name #'?) x) + (memq x '(option ...))) + (define (#,(id-append #'name #'serialize- #'name) field-name val) + (serialize-field field-name val))))))) + +(define-enumerated-field-type proto + (udp tcp udp6 tcp6)) +(define-enumerated-field-type dev + (tun tap)) + +(define key-usage? boolean?) +(define (serialize-key-usage field-name value) + (if value + (format #t "remote-cert-tls server\n") + #f)) + +(define bind? boolean?) +(define (serialize-bind field-name value) + (if value + #f + (format #t "nobind\n"))) + +(define resolv-retry? boolean?) +(define (serialize-resolv-retry field-name value) + (if value + (format #t "resolv-retry infinite\n") + #f)) + +(define (serialize-tls-auth role location) + (serialize-field 'tls-auth + (string-append location " " (match role + ('server "0") + ('client "1"))))) +(define (tls-auth? val) + (or (eq? val #f) + (string? val))) +(define (serialize-tls-auth-server field-name val) + (serialize-tls-auth 'server val)) +(define (serialize-tls-auth-client field-name val) + (serialize-tls-auth 'client val)) +(define tls-auth-server? tls-auth?) +(define tls-auth-client? tls-auth?) + +(define (serialize-number field-name val) + (serialize-field field-name (number->string val))) + +(define (all-lte left right) + (if (eq? left '()) + (eq? right '()) + (and (<= (string->number (car left)) (car right)) + (all-lte (cdr left) (cdr right))))) + +(define (cidr4? val) + (if (string? val) + (if (string-match "^([0-9]+\\.){3}[0-9]+/[0-9]+$" val) + (let ((numbers (string-tokenize val char-set:digit))) + (all-lte numbers (list 255 255 255 255 32))) + #f) + (eq? val #f))) + +(define (cidr6? val) + (if (string? val) + (string-match "^([0-9a-f]{0,4}:){0,8}/[0-9]{1,3}$" val) + (eq? val #f))) + +(define (serialize-cidr4 field-name val) + (if (eq? val #f) #f (serialize-field field-name val))) + +(define (serialize-cidr6 field-name val) + (if (eq? val #f) #f (serialize-field field-name val))) + +(define (ip? val) + (if (string? val) + (if (string-match "^([0-9]+\\.){3}[0-9]+$" val) + (let ((numbers (string-tokenize val char-set:digit))) + (all-lte numbers (list 255 255 255 255))) + #f) + (eq? val #f))) +(define (serialize-ip field-name val) + (if (eq? val #f) #f (serialize-field field-name val))) + +(define (keepalive? val) + (and (list? val) + (and (number? (car val)) + (number? (car (cdr val)))))) +(define (serialize-keepalive field-name val) + (format #t "~a ~a ~a\n" (uglify-field-name field-name) + (number->string (car val)) (number->string (car (cdr val))))) + +(define gateway? boolean?) +(define (serialize-gateway field-name val) + (and val + (format #t "push \"redirect-gateway\"\n"))) + + +(define-configuration openvpn-remote-configuration + (name + (string "my-server") + "Server name.") + (port + (number 1194) + "Port number the server listens to.")) + +(define-configuration openvpn-ccd-configuration + (name + (string "client") + "Client name.") + (iroute + (ip-mask #f) + "Client own network") + (ifconfig-push + (ip-mask #f) + "Client VPN IP.")) + +(define (openvpn-remote-list? val) + (and (list? val) + (or (eq? val '()) + (and (openvpn-remote-configuration? (car val)) + (openvpn-remote-list? (cdr val)))))) +(define (serialize-openvpn-remote-list field-name val) + (for-each (lambda (remote) + (format #t "remote ~a ~a\n" (openvpn-remote-configuration-name remote) + (number->string (openvpn-remote-configuration-port remote)))) + val)) + +(define (openvpn-ccd-list? val) + (and (list? val) + (or (eq? val '()) + (and (openvpn-ccd-configuration? (car val)) + (openvpn-ccd-list? (cdr val)))))) +(define (serialize-openvpn-ccd-list field-name val) + #f) + +(define (create-ccd-directory val) + "Create a ccd directory containing files for the ccd configuration option +of OpenVPN. Each file in this directory represents particular settings for a +client. Each file is named after the name of the client." + (let ((files (map (lambda (ccd) + (list (openvpn-ccd-configuration-name ccd) + (with-output-to-string + (lambda () + (serialize-configuration + ccd openvpn-ccd-configuration-fields))))) + val))) + (computed-file "ccd" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (use-modules (ice-9 match)) + (mkdir-p #$output) + (for-each + (lambda (ccd) + (match ccd + ((name config-string) + (call-with-output-file + (string-append #$output "/" name) + (lambda (port) (display config-string port)))))) + '#$files)))))) + +(define-syntax define-split-configuration + (lambda (x) + (syntax-case x () + ((_ name1 name2 (common-option ...) (first-option ...) (second-option ...)) + #`(begin + (define-configuration #,#'name1 + common-option ... + first-option ...) + (define-configuration #,#'name2 + common-option ... + second-option ...)))))) + +(define-split-configuration openvpn-client-configuration + openvpn-server-configuration + ((openvpn + (package openvpn) + "The OpenVPN package.") + + (pid-file + (string "/var/run/openvpn/openvpn.pid") + "The OpenVPN pid file.") + + (proto + (proto 'udp) + "The protocol (UDP or TCP) used to open a channel between clients and +servers.") + + (dev + (dev 'tun) + "The device type used to represent the VPN connection.") + + (ca + (string "/etc/openvpn/ca.crt") + "The certificate authority to check connections against.") + + (cert + (string "/etc/openvpn/client.crt") + "The certificate of the machine the daemon is running on. It should be signed +by the authority given in @code{ca}.") + + (key + (string "/etc/openvpn/client.key") + "The key of the machine the daemon is running on. It must be the whose +certificate is @code{cert}.") + + (comp-lzo? + (boolean #t) + "Whether to use the lzo compression algorithm.") + + (persist-key? + (boolean #t) + "Don't re-read key files across SIGUSR1 or --ping-restart.") + + (persist-tun? + (boolean #t) + "Don't close and reopen TUN/TAP device or run up/down scripts across +SIGUSR1 or --ping-restart restarts.") + + (verbosity + (number 3) + "Verbosity level.")) + ;; client-specific configuration + ((tls-auth + (tls-auth-client #f) + "Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks.") + + (verify-key-usage? + (key-usage #t) + "Whether to check the server certificate has server usage extension.") + + (bind? + (bind #f) + "Bind to a specific local port number.") + + (resolv-retry? + (resolv-retry #t) + "Retry resolving server address.") + + (remote + (openvpn-remote-list '()) + "A list of remote servers to connect to.")) + ;; server-specific configuration + ((tls-auth + (tls-auth-server #f) + "Add an additional layer of HMAC authentication on top of the TLS control +channel to protect against DoS attacks.") + + (port + (number 1194) + "Specifies the port number on which the server listens.") + + (server + (ip-mask "10.8.0.0 255.255.255.0") + "An ip and mask specifying the subnet inside the virtual network.") + + (server-ipv6 + (cidr6 #f) + "A CIDR notation specifying the IPv6 subnet inside the virtual network.") + + (dh + (string "/etc/openvpn/dh2048.pem") + "The Diffie-Hellman parameters file.") + + (ifconfig-pool-persist + (string "/etc/openvpn/ipp.txt") + "The file that records client IPs.") + + (redirect-gateway? + (gateway #f) + "When true, the server will act as a gateway for its clients.") + + (client-to-client? + (boolean #f) + "When true, clients are alowed to talk to each other inside the VPN.") + + (keepalive + (keepalive '(10 120)) + "Causes ping-like messages to be sent back and forth over the link so that +each side knows when the other side has gone down. @code{keepalive} requires +a pair. The first element is the period of the ping sending, and the second +element is the timeout before considering the other side down.") + + (max-clients + (number 100) + "The maximum number of clients.") + + (status + (string "/var/run/openvpn/status") + "The status file. This file shows a small report on current connection. It +is trunkated and rewritten every minute.") + + (client-config-dir + (openvpn-ccd-list '()) + "The list of configuration for some clients."))) + +(define (openvpn-config-file role config) + (let ((config-str + (with-output-to-string + (lambda () + (serialize-configuration config + (match role + ('server + openvpn-server-configuration-fields) + ('client + openvpn-client-configuration-fields)))))) + (ccd-dir (match role + ('server (create-ccd-directory + (openvpn-server-configuration-client-config-dir + config))) + ('client #f)))) + (computed-file "openvpn.conf" + #~(begin + (use-modules (ice-9 match)) + (call-with-output-file #$output + (lambda (port) + (match '#$role + ('server (display "" port)) + ('client (display "client\n" port))) + (display #$config-str port) + (match '#$role + ('server (display + (string-append "client-config-dir " + #$ccd-dir "\n") port)) + ('client (display "" port))))))))) + +(define (openvpn-shepherd-service role) + (lambda (config) + (let* ((config-file (openvpn-config-file role config)) + (pid-file ((match role + ('server openvpn-server-configuration-pid-file) + ('client openvpn-client-configuration-pid-file)) + config)) + (openvpn ((match role + ('server openvpn-server-configuration-openvpn) + ('client openvpn-client-configuration-openvpn)) + config)) + (log-file (match role + ('server "/var/log/openvpn-server.log") + ('client "/var/log/openvpn-client.log")))) + (list (shepherd-service + (documentation (string-append "Run the OpenVPN " + (match role + ('server "server") + ('client "client")) + " daemon.")) + (provision (match role + ('server '(vpn-server)) + ('client '(vpn-client)))) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list (string-append #$openvpn "/sbin/openvpn") + "--writepid" #$pid-file "--config" #$config-file + "--daemon") + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))))) + +(define %openvpn-accounts + (list (user-group (name "openvpn") (system? #t)) + (user-account + (name "openvpn") + (group "openvpn") + (system? #t) + (comment "Openvpn daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define %openvpn-activation + #~(mkdir-p "/var/run/openvpn")) + +(define openvpn-server-service-type + (service-type (name 'openvpn-server) + (extensions + (list (service-extension shepherd-root-service-type + (openvpn-shepherd-service 'server)) + (service-extension account-service-type + (const %openvpn-accounts)) + (service-extension activation-service-type + (const %openvpn-activation)))))) + +(define openvpn-client-service-type + (service-type (name 'openvpn-client) + (extensions + (list (service-extension shepherd-root-service-type + (openvpn-shepherd-service 'client)) + (service-extension account-service-type + (const %openvpn-accounts)) + (service-extension activation-service-type + (const %openvpn-activation)))))) + +(define* (openvpn-client-service #:key (config (openvpn-client-configuration))) + (validate-configuration config openvpn-client-configuration-fields) + (service openvpn-client-service-type config)) + +(define* (openvpn-server-service #:key (config (openvpn-server-configuration))) + (validate-configuration config openvpn-server-configuration-fields) + (service openvpn-server-service-type config)) + +(define (generate-openvpn-server-documentation) + (generate-documentation + `((openvpn-server-configuration + ,openvpn-server-configuration-fields + (ccd openvpn-ccd-configuration)) + (openvpn-ccd-configuration ,openvpn-ccd-configuration-fields)) + 'openvpn-server-configuration)) + +(define (generate-openvpn-client-documentation) + (generate-documentation + `((openvpn-client-configuration + ,openvpn-client-configuration-fields + (remote openvpn-remote-configuration)) + (openvpn-remote-configuration ,openvpn-remote-configuration-fields)) + 'openvpn-client-configuration)) -- cgit v1.2.3 From 6da5bb7b1b7ddf4aa5a5efcb83250506bcd67036 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 15 Jan 2017 22:28:24 +0100 Subject: guix build: Add '--repair'. * guix/scripts/build.scm (show-help, %options): Add '--repair'. * doc/guix.texi (Invoking guix gc): Mention 'guix build --repair'. (Additional Build Options): Document it. --- doc/guix.texi | 13 ++++++++++++- guix/scripts/build.scm | 8 ++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 55657ec81c..bf9dbaa726 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2274,11 +2274,14 @@ traverses @emph{all the files in the store}, this command can take a long time, especially on systems with a slow disk drive. @cindex repairing the store +@cindex corruption, recovering from Using @option{--verify=repair} or @option{--verify=contents,repair} causes the daemon to try to repair corrupt store items by fetching substitutes for them (@pxref{Substitutes}). Because repairing is not atomic, and thus potentially dangerous, it is available only to the -system administrator. +system administrator. A lightweight alternative, when you know exactly +which items in the store are corrupt, is @command{guix build --repair} +(@pxref{Invoking guix build}). @item --optimize @cindex deduplication @@ -4859,6 +4862,14 @@ When used in conjunction with @option{--keep-failed}, the differing output is kept in the store, under @file{/gnu/store/@dots{}-check}. This makes it easy to look for differences between the two results. +@item --repair +@cindex repairing store items +@cindex corruption, recovering from +Attempt to repair the specified store items, if they are corrupt, by +re-downloading or rebuilding them. + +This operation is not atomic and thus restricted to @code{root}. + @item --derivations @itemx -d Return the derivation paths, not the output paths, of the given diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 551275e89f..8326d64f48 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -485,6 +485,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) -d, --derivations return the derivation paths of the given packages")) (display (_ " --check rebuild items to check for non-determinism issues")) + (display (_ " + --repair repair the specified items")) (display (_ " -r, --root=FILE make FILE a symlink to the result, and register it as a garbage collector root")) @@ -535,6 +537,12 @@ must be one of 'package', 'all', or 'transitive'~%") (alist-cons 'build-mode (build-mode check) result) rest))) + (option '("repair") #f #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'build-mode (build-mode repair) + result) + rest))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg -- cgit v1.2.3 From 6cd1059340758669a7d98c4611f5d418b51899f2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 17 Jan 2017 22:58:37 +0100 Subject: doc: Add '--manifest' example using 'specification->package+output'. * doc/guix.texi (Invoking guix package): Add --manifest example using 'specification->package+output'. --- doc/guix.texi | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index bf9dbaa726..a212666af0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1685,6 +1685,20 @@ of packages: (list guile-2.0 "debug"))) @end example +@findex specification->package+output +In this example we have to know which modules define the @code{emacs} +and @code{guile-2.0} variables to provide the right +@code{use-package-modules} line, which can be cumbersome. We can +instead provide regular package specifications and let +@code{specification->package-output} look up the corresponding package +objects, like this: + +@example +(packages->manifest + (map (compose list specification->package+output) + '("emacs" "guile@@2.0" "guile@@2.0:debug"))) +@end example + @item --roll-back @cindex rolling back @cindex undoing transactions -- cgit v1.2.3 From 8a9cffb202414b20081910115ba76402924bdcdd Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Tue, 17 Jan 2017 17:23:58 -0500 Subject: doc: Show how to deploy any version of Guix. * doc/guix.texi (Invoking guix pull): Give some examples of how to deploy arbitrary Guix versions with the --url option. --- doc/guix.texi | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index a212666af0..2687716c6c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -20,7 +20,7 @@ Copyright @copyright{} 2014, 2015, 2016 Alex Kost@* Copyright @copyright{} 2015, 2016 Mathieu Lirzin@* Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* -Copyright @copyright{} 2015, 2016 Leo Famulari@* +Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* Copyright @copyright{} 2015, 2016 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016 Chris Marusich@* @@ -2350,6 +2350,20 @@ Download the source tarball of Guix from @var{url}. By default, the tarball is taken from its canonical address at @code{gnu.org}, for the stable branch of Guix. +With some Git servers, this can be used to deploy any version of Guix. +For example, to download and deploy version 0.12.0 of Guix from the +canonical Git repo: + +@example +guix pull --url=http://git.savannah.gnu.org/cgit/guix.git/snapshot/v0.12.0.tar.gz +@end example + +It can also be used to deploy arbitrary Git revisions: + +@example +guix pull --url=http://git.savannah.gnu.org/cgit/guix.git/snapshot/74d862e8a.tar.gz +@end example + @item --bootstrap Use the bootstrap Guile to build the latest Guix. This option is only useful to Guix developers. -- cgit v1.2.3 From cb341293fa22cdbc4ffb869b9b2a94a0d8c8798b Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 18 Jan 2017 08:08:06 +0000 Subject: services: nginx: Add support the 'upstream' module. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/web.scm (): New record type. (): Add new field upstream-blocks. (nginx-upstream): New function. (default-nginx-config): Add upstream-list parameter. (nginx-service): Add optional upstream list keyword argument. * doc/guix.texi (Web Services): Document the new nginx-upstream-configuration data type and changes to the nginx function. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 26 ++++++++++++++++++++++++-- gnu/services/web.scm | 42 ++++++++++++++++++++++++++++++++++-------- 2 files changed, 58 insertions(+), 10 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 2687716c6c..256e6f55cf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12323,6 +12323,7 @@ The @code{(gnu services web)} module provides the following service: [#:log-directory ``/var/log/nginx''] @ [#:run-directory ``/var/run/nginx''] @ [#:server-list '()] @ + [#:upstream-list '()] @ [#:config-file @code{#f}] Return a service that runs @var{nginx}, the nginx web server. @@ -12334,8 +12335,10 @@ arguments should match what is in @var{config-file} to ensure that the directories are created when the service is activated. As an alternative to using a @var{config-file}, @var{server-list} can be -used to specify the list of @dfn{server blocks} required on the host. For -this to work, use the default value for @var{config-file}. +used to specify the list of @dfn{server blocks} required on the host and +@var{upstream-list} can be used to specify a list of @dfn{upstream +blocks} to configure. For this to work, use the default value for +@var{config-file}. @end deffn @@ -12753,6 +12756,25 @@ Defaults to @samp{#f}. @c %end of automatic openvpn-server documentation +@deftp {Data Type} nginx-upstream-configuration +Data type representing the configuration of an nginx @code{upstream} +block. This type has the following parameters: + +@table @asis +@item @code{name} +Name for this group of servers. + +@item @code{servers} +Specify the addresses of the servers in the group. The address can be +specified as a IP address (e.g. @samp{127.0.0.1}), domain name +(e.g. @samp{backend1.example.com}) or a path to a UNIX socket using the +prefix @samp{unix:}. For addresses using an IP address or domain name, +the default port is 80, and a different port can be specified +explicitly. + +@end table +@end deftp + @node Network File System @subsubsection Network File System @cindex NFS diff --git a/gnu/services/web.scm b/gnu/services/web.scm index db895405a2..1477bf88d6 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015, 2016 Ludovic Courtès ;;; Copyright © 2016 ng0 ;;; Copyright © 2016 Julien Lepiller +;;; Copyright © 2017 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +34,8 @@ nginx-configuration? nginx-server-configuration nginx-server-configuration? + nginx-upstream-configuration + nginx-upstream-configuration? nginx-service nginx-service-type)) @@ -62,6 +65,12 @@ (server-tokens? nginx-server-configuration-server-tokens? (default #f))) +(define-record-type* + nginx-upstream-configuration make-nginx-upstream-configuration + nginx-upstream-configuration? + (name nginx-upstream-configuration-name) + (servers nginx-upstream-configuration-servers)) + (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? @@ -69,6 +78,7 @@ (log-directory nginx-configuration-log-directory) ;string (run-directory nginx-configuration-run-directory) ;string (server-blocks nginx-configuration-server-blocks) ;list + (upstream-blocks nginx-configuration-upstream-blocks) ;list (file nginx-configuration-file)) ;string | file-like (define (config-domain-strings names) @@ -116,11 +126,19 @@ of index files." " index " (config-index-strings (nginx-server-configuration-index server)) ";\n" " server_tokens " (if (nginx-server-configuration-server-tokens? server) "on" "off") ";\n" + " }\n")) + +(define (nginx-upstream-config upstream) + (string-append + " upstream " (nginx-upstream-configuration-name upstream) " {\n" + (string-concatenate + (map (lambda (server) + (simple-format #f " server ~A;\n" server)) + (nginx-upstream-configuration-servers upstream))) " }\n")) -(define (default-nginx-config log-directory run-directory server-list) - (plain-file "nginx.conf" - (string-append +(define (default-nginx-config log-directory run-directory server-list upstream-list) + (mixed-text-file "nginx.conf" "user nginx nginx;\n" "pid " run-directory "/pid;\n" "error_log " log-directory "/error.log info;\n" @@ -131,12 +149,18 @@ of index files." " uwsgi_temp_path " run-directory "/uwsgi_temp;\n" " scgi_temp_path " run-directory "/scgi_temp;\n" " access_log " log-directory "/access.log;\n" + "\n" + (string-join + (filter (lambda (section) (not (null? section))) + (map nginx-upstream-config upstream-list)) + "\n") + "\n" (let ((http (map default-nginx-server-config server-list))) (do ((http http (cdr http)) (block "" (string-append (car http) "\n" block ))) ((null? http) block))) "}\n" - "events {}\n"))) + "events {}\n")) (define %nginx-accounts (list (user-group (name "nginx") (system? #t)) @@ -151,7 +175,7 @@ of index files." (define nginx-activation (match-lambda (($ nginx log-directory run-directory server-blocks - config-file) + upstream-blocks config-file) #~(begin (use-modules (guix build utils)) @@ -169,13 +193,13 @@ of index files." (system* (string-append #$nginx "/sbin/nginx") "-c" #$(or config-file (default-nginx-config log-directory - run-directory server-blocks)) + run-directory server-blocks upstream-blocks)) "-t"))))) (define nginx-shepherd-service (match-lambda (($ nginx log-directory run-directory server-blocks - config-file) + upstream-blocks config-file) (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (nginx-action (lambda args @@ -184,7 +208,7 @@ of index files." (system* #$nginx-binary "-c" #$(or config-file (default-nginx-config log-directory - run-directory server-blocks)) + run-directory server-blocks upstream-blocks)) #$@args)))))) ;; TODO: Add 'reload' action. @@ -216,6 +240,7 @@ of index files." (log-directory "/var/log/nginx") (run-directory "/var/run/nginx") (server-list '()) + (upstream-list '()) (config-file #f)) "Return a service that runs NGINX, the nginx web server. @@ -227,4 +252,5 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY." (log-directory log-directory) (run-directory run-directory) (server-blocks server-list) + (upstream-blocks upstream-list) (file config-file)))) -- cgit v1.2.3 From 9c557a69aebe49bba12009a01cfaabf88ec3f665 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 18 Jan 2017 08:08:07 +0000 Subject: services: nginx: Add support for 'location' blocks. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/web.scm (): Add field 'locations'. (): New record type. (): New record type. (nginx-location-config): New function. (default-nginx-server-config): Include locations. * doc/guix.texi (Web Services): Document the new nginx-location-configuration and nginx-named-location-configuration data types, as well as the changes to the nginx-server-configuration. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 43 +++++++++++++++++++++++++++++++++++++++++++ gnu/services/web.scm | 39 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 81 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 256e6f55cf..7cd9cd046a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12380,6 +12380,11 @@ default server for connections matching no other server. @item @code{root} (default: @code{"/srv/http"}) Root of the website nginx will serve. +@item @code{locations} (default: @code{'()}) +A list of @dfn{nginx-location-configuration} or +@dfn{nginx-named-location-configuration} records to use within this +server block. + @item @code{index} (default: @code{(list "index.html")}) Index files to look for when clients ask for a directory. If it cannot be found, Nginx will send the list of files in the directory. @@ -12775,6 +12780,44 @@ explicitly. @end table @end deftp +@deftp {Data Type} nginx-location-configuration +Data type representing the configuration of an nginx @code{location} +block. This type has the following parameters: + +@table @asis +@item @code{uri} +URI which this location block matches. + +@anchor{nginx-location-configuration body} +@item @code{body} +Body of the location block, specified as a string. This can contain many +configuration directives. For example, to pass requests to a upstream +server group defined using an @code{nginx-upstream-configuration} block, +the following directive would be specified in the body @samp{proxy_pass +http://upstream-name;}. + +@end table +@end deftp + +@deftp {Data Type} nginx-named-location-configuration +Data type representing the configuration of an nginx named location +block. Named location blocks are used for request redirection, and not +used for regular request processing. This type has the following +parameters: + +@table @asis +@item @code{name} +Name to identify this location block. + +@item @code{body} +@xref{nginx-location-configuration body}, as the body for named location +blocks can be used in a similar way to the +@code{nginx-location-configuration body}. One restriction is that the +body of a named location block cannot contain location blocks. + +@end table +@end deftp + @node Network File System @subsubsection Network File System @cindex NFS diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 1477bf88d6..ec308976d7 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -36,6 +36,10 @@ nginx-server-configuration? nginx-upstream-configuration nginx-upstream-configuration? + nginx-location-configuration + nginx-location-configuration? + nginx-named-location-configuration + nginx-named-location-configuration? nginx-service nginx-service-type)) @@ -56,6 +60,8 @@ (default (list 'default))) (root nginx-server-configuration-root (default "/srv/http")) + (locations nginx-server-configuration-locations + (default '())) (index nginx-server-configuration-index (default (list "index.html"))) (ssl-certificate nginx-server-configuration-ssl-certificate @@ -71,6 +77,20 @@ (name nginx-upstream-configuration-name) (servers nginx-upstream-configuration-servers)) +(define-record-type* + nginx-location-configuration make-nginx-location-configuration + nginx-location-configuration? + (uri nginx-location-configuration-uri + (default #f)) + (body nginx-location-configuration-body)) + +(define-record-type* + nginx-named-location-configuration make-nginx-named-location-configuration + nginx-named-location-configuration? + (name nginx-named-location-configuration-name + (default #f)) + (body nginx-named-location-configuration-body)) + (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? @@ -98,6 +118,19 @@ of index files." ((? string? str) (string-append str " "))) names))) +(define nginx-location-config + (match-lambda + (($ uri body) + (string-append + " location " uri " {\n" + " " (string-join body "\n ") "\n" + " }\n")) + (($ name body) + (string-append + " location @" name " {\n" + " " (string-join body "\n ") "\n" + " }\n")))) + (define (default-nginx-server-config server) (string-append " server {\n" @@ -126,7 +159,11 @@ of index files." " index " (config-index-strings (nginx-server-configuration-index server)) ";\n" " server_tokens " (if (nginx-server-configuration-server-tokens? server) "on" "off") ";\n" - " }\n")) + "\n" + (string-join + (map nginx-location-config (nginx-server-configuration-locations server)) + "\n") + " }\n")) (define (nginx-upstream-config upstream) (string-append -- cgit v1.2.3 From b726096bc5fcef1b96554c679b81a34d49265f9c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 20 Jan 2017 21:43:53 +0800 Subject: services: network-manager: Use record for configuration. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/network-manager.scm (): New record type. (network-manager-shpeherd-service): Change to use the network-manager-configuration record, rather than a package. Generate a simple configuration file from the network-manager-configuration record. (network-manager-service-type): Update extensions to take the network-manager-configuration rather than a package. (network-manager-service): Remove function, the network-manager-service-type can be used instead, and this avoids keeping the function signature and value coresponding to the service type in sync. * doc/guix.texi (Networking Services): Remove documentation for the removed network-manager-service procedure, and add documentation of the network-manager-service-type variable and network-manager-configuration record. Signed-off-by: 宋文武 --- doc/guix.texi | 40 ++++++++++++++++++++--- gnu/services/networking.scm | 77 +++++++++++++++++++++++++++++---------------- 2 files changed, 85 insertions(+), 32 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 7cd9cd046a..1f0bd7568d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8758,11 +8758,41 @@ and @command{wicd-curses} user interfaces. @end deffn @cindex NetworkManager -@deffn {Scheme Procedure} network-manager-service @ - [#:network-manager @var{network-manager}] -Return a service that runs NetworkManager, a network connection manager -attempting to keep network connectivity active when available. -@end deffn + +@defvr {Scheme Variable} network-manager-service-type +This is the service type for the +@uref{https://wiki.gnome.org/Projects/NetworkManager, NetworkManager} +service. The value for this service type is a +@code{network-manager-configuration} record. +@end defvr + +@deftp {Data Type} network-manager-configuration +Data type representing the configuration of NetworkManager. + +@table @asis +@item @code{network-manager} (default: @code{network-manager}) +The NetworkManager package to use. + +@item @code{dns} (default: @code{"default"}) +Processing mode for DNS, which affects how NetworkManager uses the +@code{resolv.conf} configuration file. + +@table @samp +@item default +NetworkManager will update @code{resolv.conf} to reflect the nameservers +provided by currently active connections. + +@item dnsmasq +NetworkManager will run @code{dnsmasq} as a local caching nameserver, +using a "split DNS" configuration if you are connected to a VPN, and +then update @code{resolv.conf} to point to the local nameserver. + +@item none +NetworkManager will not modify @code{resolv.conf}. +@end table + +@end table +@end deftp @cindex Connman @deffn {Scheme Procedure} connman-service @ diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index ac011f1286..8f136f0dc1 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -64,7 +64,12 @@ wicd-service-type wicd-service - network-manager-service + + network-manager-configuration + network-manager-configuration? + network-manager-configuration-dns + network-manager-service-type + connman-service wpa-supplicant-service-type)) @@ -679,40 +684,58 @@ and @command{wicd-curses} user interfaces." ;;; NetworkManager ;;; +(define-record-type* + network-manager-configuration make-network-manager-configuration + network-manager-configuration? + (network-manager network-manager-configuration-network-manager + (default network-manager)) + (dns network-manager-configuration-dns + (default "default"))) + (define %network-manager-activation ;; Activation gexp for NetworkManager. #~(begin (use-modules (guix build utils)) (mkdir-p "/etc/NetworkManager/system-connections"))) -(define (network-manager-shepherd-service network-manager) - "Return a shepherd service for NETWORK-MANAGER." - (list (shepherd-service - (documentation "Run the NetworkManager.") - (provision '(networking)) - (requirement '(user-processes dbus-system wpa-supplicant loopback)) - (start #~(make-forkexec-constructor - (list (string-append #$network-manager - "/sbin/NetworkManager") - "--no-daemon"))) - (stop #~(make-kill-destructor))))) +(define network-manager-shepherd-service + (match-lambda + (($ network-manager dns) + (let + ((conf (plain-file "NetworkManager.conf" + (string-append " +[main] +dns=" dns " +")))) + (list (shepherd-service + (documentation "Run the NetworkManager.") + (provision '(networking)) + (requirement '(user-processes dbus-system wpa-supplicant loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$network-manager + "/sbin/NetworkManager") + (string-append "--config=" #$conf) + "--no-daemon"))) + (stop #~(make-kill-destructor)))))))) (define network-manager-service-type - (service-type (name 'network-manager) - (extensions - (list (service-extension shepherd-root-service-type - network-manager-shepherd-service) - (service-extension dbus-root-service-type list) - (service-extension polkit-service-type list) - (service-extension activation-service-type - (const %network-manager-activation)) - ;; Add network-manager to the system profile. - (service-extension profile-service-type list))))) - -(define* (network-manager-service #:key (network-manager network-manager)) - "Return a service that runs NetworkManager, a network connection manager -that attempting to keep active network connectivity when available." - (service network-manager-service-type network-manager)) + (let + ((config->package + (match-lambda + (($ network-manager) + (list network-manager))))) + + (service-type + (name 'network-manager) + (extensions + (list (service-extension shepherd-root-service-type + network-manager-shepherd-service) + (service-extension dbus-root-service-type config->package) + (service-extension polkit-service-type config->package) + (service-extension activation-service-type + (const %network-manager-activation)) + ;; Add network-manager to the system profile. + (service-extension profile-service-type config->package)))))) ;;; -- cgit v1.2.3 From 11b7717deba42b1f8286158e1cf4b58dec533859 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sun, 22 Jan 2017 15:40:57 +0100 Subject: services: cuirass: Add port to cuirass configuration * gnu/services/cuirass.scm (): Add port field. (cuirass-shepherd-service): Honor it. * doc/guix.texi (Continuous Integration): Document it. Signed-off-by: Mathieu Lirzin --- doc/guix.texi | 6 +++++- gnu/services/cuirass.scm | 5 +++++ 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 1f0bd7568d..18ab662823 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -30,7 +30,8 @@ Copyright @copyright{} 2016 ng0@* Copyright @copyright{} 2016 Jan Nieuwenhuizen@* Copyright @copyright{} 2016 Julien Lepiller@* Copyright @copyright{} 2016 Alex ter Weele@* -Copyright @copyright{} 2017 Clément Lassieur +Copyright @copyright{} 2017 Clément Lassieur@* +Copyright @copyright{} 2017 Mathieu Othacehe Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -13032,6 +13033,9 @@ Cuirass jobs. Location of sqlite database which contains the build results and previously added specifications. +@item @code{port} (default: @code{8080}) +Port number used by the HTTP server. + @item @code{specifications} (default: @code{#~'()}) A gexp (@pxref{G-Expressions}) that evaluates to a list of specifications, where a specification is an association list diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index c15a846bad..1194133f63 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Mathieu Lirzin ;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,6 +57,8 @@ (default 60)) (database cuirass-configuration-database ;string (file-name) (default "/var/run/cuirass/cuirass.db")) + (port cuirass-configuration-port ;integer (port) + (default 8080)) (specifications cuirass-configuration-specifications) ;gexp that evaluates to specification-alist (use-substitutes? cuirass-configuration-use-substitutes? ;boolean @@ -74,6 +77,7 @@ (group (cuirass-configuration-group config)) (interval (cuirass-configuration-interval config)) (database (cuirass-configuration-database config)) + (port (cuirass-configuration-port config)) (specs (cuirass-configuration-specifications config)) (use-substitutes? (cuirass-configuration-use-substitutes? config)) (one-shot? (cuirass-configuration-one-shot? config))) @@ -87,6 +91,7 @@ "--specifications" #$(scheme-file "cuirass-specs.scm" specs) "--database" #$database + "--port" #$(number->string port) "--interval" #$(number->string interval) #$@(if use-substitutes? '("--use-substitutes") '()) #$@(if one-shot? '("--one-shot") '())) -- cgit v1.2.3 From fa445d6499f225a4e1c7f575da4f571eb5b7acca Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sat, 21 Jan 2017 18:13:59 -0800 Subject: doc: Fix a typo in guix.texi. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Invoking guix environment): s/the use/use the/ Signed-off-by: Ludovic Courtès --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 18ab662823..4dc65ee45d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6089,7 +6089,7 @@ guix environment --ad-hoc -e '(@@ (gnu) %base-packages)' starts a shell with all the GuixSD base packages available. -The above commands only the use default output of the given packages. +The above commands only use the default output of the given packages. To select other outputs, two element tuples can be specified: @example -- cgit v1.2.3 From d918d79f6070d46a4ee49722cbf85da794b1fe50 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Sun, 22 Jan 2017 20:17:35 +0800 Subject: doc: Mention the need of a BIOS boot partition when using GPT. * doc/guix.text (Preparing for Installation)[Disk Partitioning]: Mention the need of a BIOS boot partition when using GPT with the defualt GRUB. --- doc/guix.texi | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 4dc65ee45d..7093bf7461 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6963,6 +6963,11 @@ the partition layout you want: cfdisk @end example +If your disk uses the GUID Partition Table (GPT) format and you plan to +install BIOS-based GRUB (which is the default), make sure a BIOS Boot +Partition is available (@pxref{BIOS installation,,, grub, GNU GRUB +manual}). + Once you are done partitioning the target hard disk drive, you have to create a file system on the relevant partition(s)@footnote{Currently GuixSD only supports ext4 and btrfs file systems. In particular, code -- cgit v1.2.3 From de322a5d1deaf1414de4c603308333d5da7d28af Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Jan 2017 00:13:43 +0100 Subject: doc: Add 'cups-configuration' example with 'hplip'. * doc/guix.texi (Printing Services): Add example with 'hplip'. --- doc/guix.texi | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 7093bf7461..fef8ac679a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9288,6 +9288,7 @@ makes the good ol' XlockMore usable. @node Printing Services @subsubsection Printing Services +@cindex printer support with CUPS The @code{(gnu services cups)} module provides a Guix service definition for the CUPS printing service. To add printer support to a GuixSD system, add a @code{cups-service} to the operating system definition: @@ -9308,13 +9309,17 @@ as GNOME's printer configuration services. By default, configuring a CUPS service will generate a self-signed certificate if needed, for secure connections to the print server. -One way you might want to customize CUPS is to enable or disable the web -interface. You can do that directly, like this: +Suppose you want to enable the Web interface of CUPS and also add +support for HP printers @i{via} the @code{hplip} package. You can do +that directly, like this (you need to use the @code{(gnu packages cups)} +module): @example (service cups-service-type (cups-configuration - (web-interface? #f))) + (web-interface? #t) + (extensions + (list cups-filters hplip)))) @end example The available configuration parameters follow. Each parameter -- cgit v1.2.3 From 4a780bdf1c9df37656d7f861a52f87e9b027bf3e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Jan 2017 00:18:38 +0100 Subject: doc: Add missing Upstart command for the binary installation. Fixes . Reported by Jason Self . * doc/guix.texi (Binary Installation): Add 'initctl reload-configuration' command for Upstart. --- doc/guix.texi | 1 + 1 file changed, 1 insertion(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index fef8ac679a..88ed6ce1ba 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -452,6 +452,7 @@ If your host distro uses the Upstart init system: @example # ln -s ~root/.guix-profile/lib/upstart/system/guix-daemon.conf /etc/init/ +# initctl reload-configuration # start guix-daemon @end example -- cgit v1.2.3 From d36b8457d04286b4db0543656eed69ae050ac783 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Fri, 27 Jan 2017 05:20:09 -0500 Subject: doc: Fix networking instructions in "Installing GuixSD in a VM". This is a followup to commit c8b543741f422ecf41e7635c6a1c40b3bd55947a. * doc/guix.texi (Installing GuixSD in a VM): Fix typo. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 88ed6ce1ba..e4d0cd0071 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7138,7 +7138,7 @@ Boot the USB installation image in an VM: @example qemu-system-x86_64 -m 1024 -smp 1 \ - -net default -net nic,model=virtio -boot menu=on \ + -net user -net nic,model=virtio -boot menu=on \ -drive file=guixsd.img \ -drive file=guixsd-usb-install-@value{VERSION}.@var{system} @end example -- cgit v1.2.3 From a0885414f9ad9f0401c27497bfb505df13bdff35 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Fri, 27 Jan 2017 05:28:28 -0500 Subject: doc: Clarify "Installing GuixSD in a VM". * doc/guix.texi (Installing GuixSD in a VM): Mention decompressing the installation image. --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index e4d0cd0071..19d7f28dc2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7120,8 +7120,8 @@ disk image, follow these steps: @enumerate @item -First, retrieve the GuixSD installation image as described previously -(@pxref{USB Stick Installation}). +First, retrieve and decompress the GuixSD installation image as +described previously (@pxref{USB Stick Installation}). @item Create a disk image that will hold the installed system. To make a -- cgit v1.2.3 From f31f1acac2efb4bc6558b604a07b56f826423177 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Tue, 24 Jan 2017 16:52:56 +0300 Subject: doc: Fix typos. * doc/guix.texi: Use "@" for package specifications. --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 19d7f28dc2..719ebd917a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4511,7 +4511,7 @@ guix build --quiet --keep-going \ @var{package-or-derivation} may be either the name of a package found in the software distribution such as @code{coreutils} or -@code{coreutils-8.20}, or a derivation such as +@code{coreutils@8.20}, or a derivation such as @file{/gnu/store/@dots{}-coreutils-8.19.drv}. In the former case, a package with the corresponding name (and optionally version) is searched for among the GNU distribution modules (@pxref{Package Modules}). @@ -5671,7 +5671,7 @@ single output for a package that could easily be split (@pxref{Packages with Multiple Outputs}). Such are the typical issues that @command{guix size} can highlight. -The command can be passed a package specification such as @code{gcc-4.8} +The command can be passed a package specification such as @code{gcc@4.8} or @code{guile:debug}, or a file name in the store. Consider this example: -- cgit v1.2.3 From e1a65ae57afb791683fbf70dea094f04bb04a07e Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sat, 28 Jan 2017 13:00:56 +0300 Subject: doc: Fix typos. Fixes a regression introduced in commit f31f1acac2efb4bc6558b604a07b56f826423177. Reported-by roptat on #guix. * doc/guix.texi (Invoking guix build): Use "@@" instead of "@". --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 719ebd917a..8c4067fbd4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4511,7 +4511,7 @@ guix build --quiet --keep-going \ @var{package-or-derivation} may be either the name of a package found in the software distribution such as @code{coreutils} or -@code{coreutils@8.20}, or a derivation such as +@code{coreutils@@8.20}, or a derivation such as @file{/gnu/store/@dots{}-coreutils-8.19.drv}. In the former case, a package with the corresponding name (and optionally version) is searched for among the GNU distribution modules (@pxref{Package Modules}). @@ -5671,7 +5671,7 @@ single output for a package that could easily be split (@pxref{Packages with Multiple Outputs}). Such are the typical issues that @command{guix size} can highlight. -The command can be passed a package specification such as @code{gcc@4.8} +The command can be passed a package specification such as @code{gcc@@4.8} or @code{guile:debug}, or a file name in the store. Consider this example: -- cgit v1.2.3 From 3184f14ad45eb4bdbb6744f4335132481fab7cc1 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Sat, 28 Jan 2017 12:11:42 +0100 Subject: doc: Document ocaml-build-system. * doc/guix.texi (Build Systems) [ocaml-build-system]: New definition. --- doc/guix.texi | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 8c4067fbd4..1fbe446327 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3291,6 +3291,49 @@ specified with the @code{#:glib} parameter. Both phases are executed after the @code{install} phase. @end defvr +@defvr {Scheme Variable} ocaml-build-system +This variable is exported by @code{(guix build-sytem ocaml)}. It implements +a build procedure for @uref{https://ocaml.org, OCaml} packages, which consists +of choosing the correct set of commands to run for each package. OCaml +packages can expect many different commands to be run. This build system will +try some of them. + +When the package has a @file{setup.ml} file present at the top-level, it will +run @code{ocaml setup.ml -configure}, @code{ocaml setup.ml -build} and +@code{ocaml setup.ml -install}. The build system will assume that this file +was generated by @uref{http://oasis.forge.ocamlcore.org/, OASIS} and will take +care of setting the prefix and enabling tests if they are not disabled. You +can pass configure and build flags with the @code{#:configure-flags} and +@code{#:build-flags}. The @code{#:test-flags} key can be passed to change the +set of flags used to enable tests. The @code{#:use-make?} key can be used to +bypass this system in the build and install phases. + +When the package has a @file{configure} file, it is assumed that it is a +hand-made configure script that requires a different argument format than +in the @code{gnu-build-system}. You can add more flags with the +@code{#:configure-flags} key. + +When the package has a @file{Makefile} file (or @code{#:use-make?} is +@code{#t}), it will be used and more flags can be passed to the build and +install phases with the @code{#:make-flags} key. + +Finally, some packages do not have these files and use a somewhat standard +location for its build system. In that case, the build system will run +@code{ocaml pkg/pkg.ml} or @code{ocaml pkg/build.ml} and take care of +providing the path to the required findlib module. Additional flags can +be passed via the @code{#:build-flags} key. Install is taken care of by +@command{opam-installer}. In this case, the @code{opam} package must +be added to the @code{native-inputs} field of the package definition. + +Note that most OCaml packages assume they will be installed in the same +directory as ocaml, which is not what we want in guix. In particular, they +will install @file{.so} files in their module's directory, which is usually +fine because it is in the ocaml compiler directory. In guix though, these +libraries cannot be found and we use @code{CAML_LD_LIBRARY_PATH}. This +variable points to @file{lib/ocaml/site-lib/stubslibs} and this is where +@file{.so} libraries should be installed. +@end defvr + @defvr {Scheme Variable} python-build-system This variable is exported by @code{(guix build-system python)}. It implements the more or less standard build procedure used by Python -- cgit v1.2.3 From 88ba7852d3f8bfde004dd0f51b7abed4dcad1f32 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Sun, 29 Jan 2017 10:13:29 +0100 Subject: doc: Fix typo. * doc/guix.texi (ocaml-build-system): Replace ocaml with OCaml. --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 1fbe446327..4ba101094a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3326,9 +3326,9 @@ be passed via the @code{#:build-flags} key. Install is taken care of by be added to the @code{native-inputs} field of the package definition. Note that most OCaml packages assume they will be installed in the same -directory as ocaml, which is not what we want in guix. In particular, they +directory as OCaml, which is not what we want in guix. In particular, they will install @file{.so} files in their module's directory, which is usually -fine because it is in the ocaml compiler directory. In guix though, these +fine because it is in the OCaml compiler directory. In guix though, these libraries cannot be found and we use @code{CAML_LD_LIBRARY_PATH}. This variable points to @file{lib/ocaml/site-lib/stubslibs} and this is where @file{.so} libraries should be installed. -- cgit v1.2.3 From 8de3e4b35f98571be39f9c0a95bfdc630ac2d266 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 1 Feb 2017 17:09:54 +0100 Subject: services: Make 'static-networking' extensible. This allows users to statically define several interfaces. * gnu/services/networking.scm ()[provision] [name-servers]: Add default values. (static-networking-shepherd-service) (static-networking-etc-files) (static-networking-shepherd-services): New procedures. (static-networking-service-type): Change to extend both SHEPHERD-ROOT-SERVICE-TYPE and ETC-SERVICE-TYPE. (static-networking-service): Remove default value of #:provision. Implement using 'simple-service'. * gnu/services/base.scm (%base-services): Replace 'static-networking-service' call with 'service' form. * doc/guix.texi (Networking Services): Update documentation. --- doc/guix.texi | 10 +++ gnu/services/base.scm | 6 +- gnu/services/networking.scm | 205 ++++++++++++++++++++++++++++---------------- 3 files changed, 145 insertions(+), 76 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 4ba101094a..fb0bbc04bb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8786,11 +8786,21 @@ Return a service that runs @var{dhcp}, a Dynamic Host Configuration Protocol (DHCP) client, on all the non-loopback network interfaces. @end deffn +@defvr {Scheme Variable} static-networking-service-type +This is the type for statically-configured network interfaces. +@c TODO Document data structures. +@end defvr + @deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @ [#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}] Return a service that starts @var{interface} with address @var{ip}. If @var{netmask} is true, use it as the network mask. If @var{gateway} is true, it must be a string specifying the default network gateway. + +This procedure can be called several times, one for each network +interface of interest. Behind the scenes what it does is extend +@code{static-networking-service-type} with additional network interfaces +to handle. @end deffn @cindex wicd diff --git a/gnu/services/base.scm b/gnu/services/base.scm index ecabf78429..d9f3a1445e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1546,8 +1546,10 @@ This service is not part of @var{%base-services}." (mingetty-service (mingetty-configuration (tty "tty6"))) - (static-networking-service "lo" "127.0.0.1" - #:provision '(loopback)) + (service static-networking-service-type + (list (static-networking (interface "lo") + (ip "127.0.0.1") + (provision '(loopback))))) (syslog-service) (urandom-seed-service) (guix-service) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index f7412ff29e..766d979f3e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -42,6 +42,13 @@ #:use-module (ice-9 match) #:export (%facebook-host-aliases static-networking + + static-networking? + static-networking-interface + static-networking-ip + static-networking-netmask + static-networking-gateway + static-networking-service static-networking-service-type dhcp-client-service @@ -121,88 +128,138 @@ fe80::1%lo0 apps.facebook.com\n") (ip static-networking-ip) (netmask static-networking-netmask (default #f)) - (gateway static-networking-gateway) - (provision static-networking-provision) - (name-servers static-networking-name-servers)) + (gateway static-networking-gateway ;FIXME: doesn't belong here + (default #f)) + (provision static-networking-provision + (default #f)) + (name-servers static-networking-name-servers ;FIXME: doesn't belong here + (default '()))) + +(define static-networking-shepherd-service + (match-lambda + (($ interface ip netmask gateway provision + name-servers) + (let ((loopback? (and provision (memq 'loopback provision)))) + (shepherd-service + + ;; Unless we're providing the loopback interface, wait for udev to be up + ;; and running so that INTERFACE is actually usable. + (requirement (if loopback? '() '(udev))) + + (documentation + "Bring up the networking interface using a static IP address.") + (provision (or provision + (list (symbol-append 'networking- + (string->symbol interface))))) + + (start #~(lambda _ + ;; Return #t if successfully started. + (let* ((addr (inet-pton AF_INET #$ip)) + (sockaddr (make-socket-address AF_INET addr 0)) + (mask (and #$netmask + (inet-pton AF_INET #$netmask))) + (maskaddr (and mask + (make-socket-address AF_INET + mask 0))) + (gateway (and #$gateway + (inet-pton AF_INET #$gateway))) + (gatewayaddr (and gateway + (make-socket-address AF_INET + gateway 0)))) + (configure-network-interface #$interface sockaddr + (logior IFF_UP + #$(if loopback? + #~IFF_LOOPBACK + 0)) + #:netmask maskaddr) + (when gateway + (let ((sock (socket AF_INET SOCK_DGRAM 0))) + (add-network-route/gateway sock gatewayaddr) + (close-port sock)))))) + (stop #~(lambda _ + ;; Return #f is successfully stopped. + (let ((sock (socket AF_INET SOCK_STREAM 0))) + (when #$gateway + (delete-network-route sock + (make-socket-address + AF_INET INADDR_ANY 0))) + (set-network-interface-flags sock #$interface 0) + (close-port sock) + #f))) + (respawn? #f)))))) + +(define (static-networking-etc-files interfaces) + "Return a /etc/resolv.conf entry for INTERFACES or the empty list." + (match (delete-duplicates + (append-map static-networking-name-servers + interfaces)) + (() + '()) + ((name-servers ...) + (let ((content (string-join + (map (cut string-append "nameserver " <>) + name-servers) + "\n" 'suffix))) + `(("resolv.conf" + ,(plain-file "resolv.conf" + (string-append "\ +# Generated by 'static-networking-service'.\n" + content)))))))) + +(define (static-networking-shepherd-services interfaces) + "Return the list of Shepherd services to bring up INTERFACES, a list of + objects." + (define (loopback? service) + (memq 'loopback (shepherd-service-provision service))) + + (let ((services (map static-networking-shepherd-service interfaces))) + (match (remove loopback? services) + (() + ;; There's no interface other than 'loopback', so we assume that the + ;; 'networking' service will be provided by dhclient or similar. + services) + ((non-loopback ...) + ;; Assume we're providing all the interfaces, and thus, provide a + ;; 'networking' service. + (cons (shepherd-service + (provision '(networking)) + (requirement (append-map shepherd-service-provision + services)) + (start #~(const #t)) + (stop #~(const #f)) + (documentation "Bring up all the networking interfaces.")) + services))))) (define static-networking-service-type - (shepherd-service-type - 'static-networking - (match-lambda - (($ interface ip netmask gateway provision - name-servers) - (let ((loopback? (memq 'loopback provision))) - (shepherd-service - - ;; Unless we're providing the loopback interface, wait for udev to be up - ;; and running so that INTERFACE is actually usable. - (requirement (if loopback? '() '(udev))) - - (documentation - "Bring up the networking interface using a static IP address.") - (provision provision) - (start #~(lambda _ - ;; Return #t if successfully started. - (let* ((addr (inet-pton AF_INET #$ip)) - (sockaddr (make-socket-address AF_INET addr 0)) - (mask (and #$netmask - (inet-pton AF_INET #$netmask))) - (maskaddr (and mask - (make-socket-address AF_INET - mask 0))) - (gateway (and #$gateway - (inet-pton AF_INET #$gateway))) - (gatewayaddr (and gateway - (make-socket-address AF_INET - gateway 0)))) - (configure-network-interface #$interface sockaddr - (logior IFF_UP - #$(if loopback? - #~IFF_LOOPBACK - 0)) - #:netmask maskaddr) - (when gateway - (let ((sock (socket AF_INET SOCK_DGRAM 0))) - (add-network-route/gateway sock gatewayaddr) - (close-port sock)))) - - #$(if (pair? name-servers) - #~(call-with-output-file "/etc/resolv.conf" - (lambda (port) - (display - "# Generated by 'static-networking-service'.\n" - port) - (for-each (lambda (server) - (format port "nameserver ~a~%" - server)) - '#$name-servers) - #t)) - #t))) - (stop #~(lambda _ - ;; Return #f is successfully stopped. - (let ((sock (socket AF_INET SOCK_STREAM 0))) - (when #$gateway - (delete-network-route sock - (make-socket-address - AF_INET INADDR_ANY 0))) - (set-network-interface-flags sock #$interface 0) - (close-port sock) - #f))) - (respawn? #f))))))) + ;; The service type for statically-defined network interfaces. + (service-type (name 'static-networking) + (extensions + (list + (service-extension shepherd-root-service-type + static-networking-shepherd-services) + (service-extension etc-service-type + static-networking-etc-files))) + (compose concatenate) + (extend append))) (define* (static-networking-service interface ip #:key - netmask gateway - (provision '(networking)) + netmask gateway provision (name-servers '())) "Return a service that starts @var{interface} with address @var{ip}. If @var{netmask} is true, use it as the network mask. If @var{gateway} is true, -it must be a string specifying the default network gateway." - (service static-networking-service-type - (static-networking (interface interface) (ip ip) - (netmask netmask) (gateway gateway) - (provision provision) - (name-servers name-servers)))) +it must be a string specifying the default network gateway. + +This procedure can be called several times, one for each network +interface of interest. Behind the scenes what it does is extend +@code{static-networking-service-type} with additional network interfaces +to handle." + (simple-service 'static-network-interface + static-networking-service-type + (list (static-networking (interface interface) (ip ip) + (netmask netmask) (gateway gateway) + (provision provision) + (name-servers name-servers))))) (define dhcp-client-service-type (shepherd-service-type -- cgit v1.2.3 From 5e2017ed88636b8a163add3403f8978bd5b2a732 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 29 Jan 2017 20:40:34 -0800 Subject: doc: Clarify that 'guix pull' can't be easily rolled back. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Invoking guix pull): Clarify that 'guix pull' can't be easily rolled back. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index fb0bbc04bb..9a657c18f8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2337,7 +2337,9 @@ instance, when user @code{root} runs @command{guix pull}, this has no effect on the version of Guix that user @code{alice} sees, and vice versa@footnote{Under the hood, @command{guix pull} updates the @file{~/.config/guix/latest} symbolic link to point to the latest Guix, -and the @command{guix} command loads code from there.}. +and the @command{guix} command loads code from there. Currently, the +only way to roll back an invocation of @command{guix pull} is to +manually update this symlink to point to the previous Guix.}. The @command{guix pull} command is usually invoked with no arguments, but it supports the following options: -- cgit v1.2.3 From a4ca4362a21e8c917b02c927974b1b4a703fccd8 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 29 Jan 2017 20:40:35 -0800 Subject: doc: Discuss encrypted swap space. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Preparing for Installation): Provide an example of how to set up (encrypted) swap space using a swap file. (operating-system Reference)[swap-devices]: Clarify that swap files are supported, too. (Mapped Devices): Explain how to use a mapped device with a swap file to encrypt swap space. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 9a657c18f8..47456f3cd1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7063,6 +7063,26 @@ mkswap /dev/sda2 swapon /dev/sda2 @end example +Alternatively, you may use a swap file. For example, assuming that in +the new system you want to use the file @file{/swapfile} as a swap file, +you would run@footnote{This example will work for many types of file +systems (e.g., ext4). However, for copy-on-write file systems (e.g., +btrfs), the required steps may be different. For details, see the +manual pages for @command{mkswap} and @command{swapon}.}: + +@example +# This is 10 GiB of swap space. Adjust "count" to change the size. +dd if=/dev/zero of=/mnt/swapfile bs=1MiB count=10240 +# For security, make the file readable and writable only by root. +chmod 600 /mnt/swapfile +mkswap /mnt/swapfile +swapon /mnt/swapfile +@end example + +Note that if you have encrypted the root partition and created a swap +file in its file system as described above, then the encryption also +protects the swap file, just like any other file in that file system. + @node Proceeding with the Installation @subsection Proceeding with the Installation @@ -7516,9 +7536,12 @@ A list of file systems. @xref{File Systems}. @item @code{swap-devices} (default: @code{'()}) @cindex swap devices -A list of strings identifying devices to be used for ``swap space'' -(@pxref{Memory Concepts,,, libc, The GNU C Library Reference Manual}). -For example, @code{'("/dev/sda3")}. +A list of strings identifying devices or files to be used for ``swap +space'' (@pxref{Memory Concepts,,, libc, The GNU C Library Reference +Manual}). For example, @code{'("/dev/sda3")} or @code{'("/swapfile")}. +It is possible to specify a swap file in a file system on a mapped +device, provided that the necessary device mapping and file system are +also specified. @xref{Mapped Devices} and @ref{File Systems}. @item @code{users} (default: @code{%base-user-accounts}) @itemx @code{groups} (default: @var{%base-groups}) @@ -7861,6 +7884,13 @@ and use it as follows: (type luks-device-mapping)) @end example +@cindex swap encryption +It is also desirable to encrypt swap space, since swap space may contain +sensitive data. One way to accomplish that is to use a swap file in a +file system on a device mapped via LUKS encryption. In this way, the +swap file is encrypted because the entire device is encrypted. +@xref{Preparing for Installation,,Disk Partitioning}, for an example. + A RAID device formed of the partitions @file{/dev/sda1} and @file{/dev/sdb1} may be declared as follows: -- cgit v1.2.3 From eb122280a0b79d82ba0d59ac63dfb05cee37812f Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 30 Jan 2017 13:59:35 +0100 Subject: services: cuirass: Add load-path to cuirass configuration MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/cuirass.scm (): Add load-path field. (cuirass-shepherd-service): Honor it. * doc/guix.texi (Continuous Integration): Document it. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 4 ++++ gnu/services/cuirass.scm | 11 ++++++++--- 2 files changed, 12 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 47456f3cd1..6acde6621b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -13146,6 +13146,10 @@ from source. @item @code{one-shot?} (default: @code{#f}) Only evaluate specifications and build derivations once. +@item @code{load-path} (default: @code{'()}) +This allows users to define their own packages and make them visible to +cuirass as in @command{guix build} command. + @item @code{cuirass} (default: @code{cuirass}) The Cuirass package to use. @end table diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 1194133f63..237f71a09b 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -64,7 +64,9 @@ (use-substitutes? cuirass-configuration-use-substitutes? ;boolean (default #f)) (one-shot? cuirass-configuration-one-shot? ;boolean - (default #f))) + (default #f)) + (load-path cuirass-configuration-load-path + (default '()))) (define (cuirass-shepherd-service config) "Return a for the Cuirass service with CONFIG." @@ -80,7 +82,8 @@ (port (cuirass-configuration-port config)) (specs (cuirass-configuration-specifications config)) (use-substitutes? (cuirass-configuration-use-substitutes? config)) - (one-shot? (cuirass-configuration-one-shot? config))) + (one-shot? (cuirass-configuration-one-shot? config)) + (load-path (cuirass-configuration-load-path config))) (list (shepherd-service (documentation "Run Cuirass.") (provision '(cuirass)) @@ -94,7 +97,9 @@ "--port" #$(number->string port) "--interval" #$(number->string interval) #$@(if use-substitutes? '("--use-substitutes") '()) - #$@(if one-shot? '("--one-shot") '())) + #$@(if one-shot? '("--one-shot") '()) + #$@(if (null? load-path) '() + `("--load-path" ,(string-join load-path ":")))) #:user #$user #:group #$group #:log-file #$log-file)) -- cgit v1.2.3 From 387e175492f960d7d86f34f3b2e43938fa72dbf3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 8 Feb 2017 15:32:28 +0100 Subject: services: Add 'special-files-service-type'. * gnu/build/activation.scm (activate-/bin/sh): Remove. (activate-special-files): New procedure. * gnu/services.scm (activation-script): Remove call to 'activate-/bin/sh'. (special-files-service-type): New variable. (extra-special-file): New procedure. * gnu/services/base.scm (%base-services): Add SPECIAL-FILES-SERVICE-TYPE instance. * gnu/tests/base.scm (run-basic-test)[special-files]: New variables. ["special files"]: New test. --- doc/guix.texi | 44 ++++++++++++++++++++++++++++++++++++++++++++ gnu/build/activation.scm | 23 ++++++++++++++++++----- gnu/services.scm | 25 +++++++++++++++++++++---- gnu/services/base.scm | 7 ++++++- gnu/tests/base.scm | 17 +++++++++++++++++ 5 files changed, 106 insertions(+), 10 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 6acde6621b..21082aece4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8272,6 +8272,50 @@ this: @end example @end defvr +@defvr {Scheme Variable} special-files-service-type +This is the service that sets up ``special files'' such as +@file{/bin/sh}; an instance of it is part of @code{%base-services}. + +The value associated with @code{special-files-service-type} services +must be a list of tuples where the first element is the ``special file'' +and the second element is its target. By default it is: + +@cindex @file{/bin/sh} +@cindex @file{sh}, in @file{/bin} +@example +`(("/bin/sh" ,(file-append @var{bash} "/bin/sh"))) +@end example + +@cindex @file{/usr/bin/env} +@cindex @file{env}, in @file{/usr/bin} +If you want to add, say, @code{/usr/bin/env} to your system, you can +change it to: + +@example +`(("/bin/sh" ,(file-append @var{bash} "/bin/sh")) + ("/usr/bin/env" ,(file-append @var{coreutils} "/bin/env"))) +@end example + +Since this is part of @code{%base-services}, you can use +@code{modify-services} to customize the set of special files +(@pxref{Service Reference, @code{modify-services}}). But the simple way +to add a special file is @i{via} the @code{extra-special-file} procedure +(see below.) +@end defvr + +@deffn {Scheme Procedure} extra-special-file @var{file} @var{target} +Use @var{target} as the ``special file'' @var{file}. + +For example, adding the following lines to the @code{services} field of +your operating system declaration leads to a @file{/usr/bin/env} +symlink: + +@example +(extra-special-file "/usr/bin/env" + (file-append coreutils "/bin/env")) +@end example +@end deffn + @deffn {Scheme Procedure} host-name-service @var{name} Return a service that sets the host name to @var{name}. @end deffn diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index e58304e83b..c4ed40e0de 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -28,7 +28,7 @@ activate-user-home activate-etc activate-setuid-programs - activate-/bin/sh + activate-special-files activate-modprobe activate-firmware activate-ptrace-attach @@ -383,10 +383,23 @@ copy SOURCE to TARGET." (for-each make-setuid-program programs)) -(define (activate-/bin/sh shell) - "Change /bin/sh to point to SHELL." - (symlink shell "/bin/sh.new") - (rename-file "/bin/sh.new" "/bin/sh")) +(define (activate-special-files special-files) + "Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES +is a pair where the first element is the name of the special file and the +second element is the name it should appear at, such as: + + ((\"/bin/sh\" \"/gnu/store/…-bash/bin/sh\") + (\"/usr/bin/env\" \"/gnu/store/…-coreutils/bin/env\")) +" + (define install-special-file + (match-lambda + ((target file) + (let ((pivot (string-append target ".new"))) + (mkdir-p (dirname target)) + (symlink file pivot) + (rename-file pivot target))))) + + (for-each install-special-file special-files)) (define (activate-modprobe modprobe) "Tell the kernel to use MODPROBE to load modules." diff --git a/gnu/services.scm b/gnu/services.scm index e645889d30..6ac4f1322d 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -72,6 +72,8 @@ activation-service-type activation-service->script %linux-bare-metal-service + special-files-service-type + extra-special-file etc-service-type etc-directory setuid-program-service-type @@ -336,10 +338,6 @@ ACTIVATION-SCRIPT-TYPE." #~(begin (use-modules (gnu build activation)) - ;; Make sure /bin/sh is valid and current. - (activate-/bin/sh - (string-append #$(canonical-package bash) "/bin/sh")) - ;; Make sure the user accounting database exists. If it ;; does not exist, 'setutxent' does not create it and ;; thus there is no accounting at all. @@ -413,6 +411,25 @@ ACTIVATION-SCRIPT-TYPE." ;; necessary or impossible in a container. (service linux-bare-metal-service-type #f)) +(define special-files-service-type + ;; Service to install "special files" such as /bin/sh and /usr/bin/env. + (service-type + (name 'special-files) + (extensions + (list (service-extension activation-service-type + (lambda (files) + #~(activate-special-files '#$files))))) + (compose concatenate) + (extend append))) + +(define (extra-special-file file target) + "Use TARGET as the \"special file\" FILE. For example, TARGET might be + (file-append coreutils \"/bin/env\") +and FILE could be \"/usr/bin/env\"." + (simple-service (string->symbol (string-append "special-file-" file)) + special-files-service-type + `((,file ,target)))) + (define (etc-directory service) "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE." (files->etc-directory (service-parameters service))) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d9f3a1445e..57601eab85 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -36,6 +36,7 @@ #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools)) #:use-module ((gnu packages base) #:select (canonical-package glibc)) + #:use-module (gnu packages bash) #:use-module (gnu packages package-management) #:use-module (gnu packages lsof) #:use-module (gnu packages terminals) @@ -1558,6 +1559,10 @@ This service is not part of @var{%base-services}." ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is ;; used, so enable them by default. The FUSE and ALSA rules are ;; less critical, but handy. - (udev-service #:rules (list lvm2 fuse alsa-utils crda)))) + (udev-service #:rules (list lvm2 fuse alsa-utils crda)) + + (service special-files-service-type + `(("/bin/sh" ,(file-append (canonical-package bash) + "/bin/sh")))))) ;;; base.scm ends here diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 8a6a7a1568..000a4ddecb 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -77,6 +77,11 @@ When INITIALIZATION is true, it must be a one-argument procedure that is passed a gexp denoting the marionette, and it must return gexp that is inserted before the first test. This is used to introduce an extra initialization step, such as entering a LUKS passphrase." + (define special-files + (service-parameters + (fold-services (operating-system-services os) + #:target-type special-files-service-type))) + (define test (with-imported-modules '((gnu build marionette) (guix build syscalls)) @@ -120,6 +125,18 @@ grep --version info --version") marionette))) + (test-equal "special files" + '#$special-files + (marionette-eval + '(begin + (use-modules (ice-9 match)) + + (map (match-lambda + ((file target) + (list file (readlink file)))) + '#$special-files)) + marionette)) + (test-assert "accounts" (let ((users (marionette-eval '(begin (use-modules (ice-9 match)) -- cgit v1.2.3 From bc5844d14955c09330d47984d930e1e9aa8c0ee0 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Mon, 6 Feb 2017 18:19:26 +0100 Subject: import: Add stackage importer and updater. * guix/import/stackage.scm: New file. * guix/scripts/import/stackage.scm: New file. * Makefile.am (MODULES): Add new files. * guix/scripts/import.scm (importers): Add "stackage". * guix/scripts/refresh.scm (%updaters): Add %stackage-updater. * doc/guix.texi (Invoking 'guix import'): Document the importer. (Invoking 'guix refresh'): Add stackage to option --type valid values. * guix/import/hackage.scm (guix-package->hackage-name, hackage-fetch, hackage-source-url, hackage-cabal-url, hackage-package?): Export them. --- Makefile.am | 2 + doc/guix.texi | 33 +++++++++- guix/import/hackage.scm | 8 ++- guix/import/stackage.scm | 135 +++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 3 +- guix/scripts/import/stackage.scm | 115 +++++++++++++++++++++++++++++++++ guix/scripts/refresh.scm | 1 + 7 files changed, 294 insertions(+), 3 deletions(-) create mode 100644 guix/import/stackage.scm create mode 100644 guix/scripts/import/stackage.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 360c356f10..18501bddfc 100644 --- a/Makefile.am +++ b/Makefile.am @@ -126,6 +126,7 @@ MODULES = \ guix/import/cabal.scm \ guix/import/cran.scm \ guix/import/hackage.scm \ + guix/import/stackage.scm \ guix/import/elpa.scm \ guix/scripts.scm \ guix/scripts/download.scm \ @@ -147,6 +148,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/stackage.scm \ guix/scripts/import/elpa.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 21082aece4..eca2d99487 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -31,7 +31,8 @@ Copyright @copyright{} 2016 Jan Nieuwenhuizen@* Copyright @copyright{} 2016 Julien Lepiller@* Copyright @copyright{} 2016 Alex ter Weele@* Copyright @copyright{} 2017 Clément Lassieur@* -Copyright @copyright{} 2017 Mathieu Othacehe +Copyright @copyright{} 2017 Mathieu Othacehe@* +Copyright @copyright{} 2017 Federico Beffa Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -5340,6 +5341,34 @@ package name by an at-sign and a version number as in the following example: guix import hackage mtl@@2.1.3.1 @end example +@item stackage +@cindex stackage +The @code{stackage} importer is a wrapper around the @code{hackage} one. +It takes a package name, looks up the package version included in a +long-term support (LTS) @uref{https://www.stackage.org, Stackage} +release and uses the @code{hackage} importer to retrieve its metadata. +Note that it is up to you to select an LTS release compatible with the +GHC compiler used by Guix. + +Specific command-line options are: + +@table @code +@item --no-test-dependencies +@itemx -t +Do not include dependencies required only by the test suites. +@item --lts-version=@var{version} +@itemx -r @var{version} +@var{version} is the desired LTS release version. If omitted the latest +release is used. +@end table + +The command below imports metadata for the @code{HTTP} Haskell package +included in the LTS Stackage release version 7.18: + +@example +guix import stackage --lts-version=7.18 HTTP +@end example + @item elpa @cindex elpa Import metadata from an Emacs Lisp Package Archive (ELPA) package @@ -5504,6 +5533,8 @@ the updater for @uref{https://rubygems.org, RubyGems} packages. the updater for @uref{https://github.com, GitHub} packages. @item hackage the updater for @uref{https://hackage.haskell.org, Hackage} packages. +@item stackage +the updater for @uref{https://www.stackage.org, Stackage} packages. @item crate the updater for @uref{https://crates.io, Crates} packages. @end table diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 9af78ea888..4d01ed23ea 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -37,7 +37,13 @@ #:use-module (guix packages) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (hackage->guix-package - %hackage-updater)) + %hackage-updater + + guix-package->hackage-name + hackage-fetch + hackage-source-url + hackage-cabal-url + hackage-package?)) (define ghc-standard-libraries ;; List of libraries distributed with ghc (7.10.2). We include GHC itself as diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm new file mode 100644 index 0000000000..542b718083 --- /dev/null +++ b/guix/import/stackage.scm @@ -0,0 +1,135 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Federico Beffa +;;; +;;; 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 (guix import stackage) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (guix import json) + #:use-module (guix import hackage) + #:use-module (guix memoization) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (guix ui) + #:export (stackage->guix-package + %stackage-updater)) + + +;;; +;;; Stackage info fetcher and access functions +;;; + +(define %stackage-url "http://www.stackage.org") + +(define (lts-info-ghc-version lts-info) + "Retruns the version of the GHC compiler contained in LTS-INFO." + (match lts-info + ((("snapshot" ("ghc" . version) _ _) _) version) + (_ #f))) + +(define (lts-info-packages lts-info) + "Retruns the alist of packages contained in LTS-INFO." + (match lts-info + ((_ ("packages" pkg ...)) pkg) + (_ '()))) + +(define stackage-lts-info-fetch + ;; "Retrieve the information about the LTS Stackage release VERSION." + (memoize + (lambda* (#:optional (version "")) + (let* ((url (if (string=? "" version) + (string-append %stackage-url "/lts") + (string-append %stackage-url "/lts-" version))) + (lts-info (json-fetch url))) + (if lts-info + (reverse lts-info) + (leave (_ "LTS release version not found: ~A~%") version)))))) + +(define (stackage-package-name pkg-info) + (assoc-ref pkg-info "name")) + +(define (stackage-package-version pkg-info) + (assoc-ref pkg-info "version")) + +(define (lts-package-version pkgs-info name) + "Return the version of the package with upstream NAME included in PKGS-INFO." + (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name)) + pkgs-info))) + (stackage-package-version pkg))) + + +;;; +;;; Importer entry point +;;; + +(define (hackage-name-version name version) + (and version (string-append name "@" version))) + +(define* (stackage->guix-package package-name ; upstream name + #:key + (include-test-dependencies? #t) + (lts-version "") + (packages-info + (lts-info-packages + (stackage-lts-info-fetch lts-version)))) + "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved +vesion corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION +release at stackage.org. Return the `package' S-expression corresponding to +that package, or #f on failure. PACKAGES-INFO is the alist with the packages +included in the Stackage LTS release." + (let* ((version (lts-package-version packages-info package-name)) + (name-version (hackage-name-version package-name version))) + (if name-version + (hackage->guix-package name-version + #:include-test-dependencies? + include-test-dependencies?) + (leave (_ "package not found: ~A~%") package-name)))) + + +;;; +;;; Updater +;;; + +(define latest-lts-release + (let ((pkgs-info (mlambda () (lts-info-packages (stackage-lts-info-fetch))))) + (lambda* (package) + "Return an for the latest Stackage LTS release of +PACKAGE or #f it the package is not inlucded in the Stackage LTS release." + (let* ((hackage-name (guix-package->hackage-name package)) + (version (lts-package-version (pkgs-info) hackage-name)) + (name-version (hackage-name-version hackage-name version))) + (match (and=> name-version hackage-fetch) + (#f (format (current-error-port) + "warning: failed to parse ~a~%" + (hackage-cabal-url hackage-name)) + #f) + (_ (let ((url (hackage-source-url hackage-name version))) + (upstream-source + (package (package-name package)) + (version version) + (urls (list url)))))))))) + +(define %stackage-updater + (upstream-updater + (name 'stackage) + (description "Updater for Stackage LTS packages") + (pred hackage-package?) + (latest latest-lts-release))) + +;;; stackage.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 4d07e0fd69..8c2f705738 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,8 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran" "crate")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" + "cran" "crate")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/stackage.scm b/guix/scripts/import/stackage.scm new file mode 100644 index 0000000000..cf47bff259 --- /dev/null +++ b/guix/scripts/import/stackage.scm @@ -0,0 +1,115 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Federico Beffa +;;; +;;; 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 (guix scripts import stackage) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix scripts) + #:use-module (guix import stackage) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-stackage)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + `((lts-version . "") + (include-test-dependencies? . #t))) + +(define (show-help) + (display (_ "Usage: guix import stackage PACKAGE-NAME +Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) + (display (_ " + -r VERSION, --lts-version=VERSION + specify the LTS version to use")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -t, --no-test-dependencies don't include test-only dependencies")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import stackage"))) + (option '(#\t "no-test-dependencies") #f #f + (lambda (opt name arg result) + (alist-cons 'include-test-dependencies? #f + (alist-delete 'include-test-dependencies? + result)))) + (option '(#\r "lts-version") #t #f + (lambda (opt name arg result) + (alist-cons 'lts-version arg + (alist-delete 'lts-version + result)))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-stackage . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (stackage->guix-package + package-name + #:include-test-dependencies? + (assoc-ref opts 'include-test-dependencies?) + #:lts-version (assoc-ref opts 'lts-version)))) + (unless sexp + (leave (_ "failed to download cabal file for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) + +;;; stackage.scm ends here diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 0dd7eee974..4d3c695aaf 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -205,6 +205,7 @@ unavailable optional dependencies such as Guile-JSON." %elpa-updater %cran-updater %bioconductor-updater + ((guix import stackage) => %stackage-updater) %hackage-updater ((guix import cpan) => %cpan-updater) ((guix import pypi) => %pypi-updater) -- cgit v1.2.3 From 65e862d1a2914ad61201236c155058bcf33b5b9c Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Mon, 6 Feb 2017 16:45:08 +0100 Subject: gnu: Add dub-build-system. * guix/build-system/dub.scm: New file. * guix/build/dub-build-system.scm: New file. * Makefile.am (MODULES): Add them. * doc/guix.texi: Add section for dub-build-system. --- Makefile.am | 2 + doc/guix.texi | 10 +++ guix/build-system/dub.scm | 147 ++++++++++++++++++++++++++++++++++++++++ guix/build/dub-build-system.scm | 125 ++++++++++++++++++++++++++++++++++ 4 files changed, 284 insertions(+) create mode 100644 guix/build-system/dub.scm create mode 100644 guix/build/dub-build-system.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 18501bddfc..8fe22d48ad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -64,6 +64,7 @@ MODULES = \ guix/build-system/ant.scm \ guix/build-system/cargo.scm \ guix/build-system/cmake.scm \ + guix/build-system/dub.scm \ guix/build-system/emacs.scm \ guix/build-system/asdf.scm \ guix/build-system/glib-or-gtk.scm \ @@ -88,6 +89,7 @@ MODULES = \ guix/build/download.scm \ guix/build/cargo-build-system.scm \ guix/build/cmake-build-system.scm \ + guix/build/dub-build-system.scm \ guix/build/emacs-build-system.scm \ guix/build/asdf-build-system.scm \ guix/build/git.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index eca2d99487..50cab274af 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3438,6 +3438,16 @@ Which Haskell compiler is used can be specified with the @code{#:haskell} parameter which defaults to @code{ghc}. @end defvr +@defvr {Scheme Variable} dub-build-system +This variable is exported by @code{(guix build-system dub)}. It +implements the Dub build procedure used by D packages, which +involves running @code{dub build} and @code{dub run}. +Installation is done by copying the files manually. + +Which D compiler is used can be specified with the @code{#:ldc} +parameter which defaults to @code{ldc}. +@end defvr + @defvr {Scheme Variable} emacs-build-system This variable is exported by @code{(guix build-system emacs)}. It implements an installation procedure similar to the packaging system diff --git a/guix/build-system/dub.scm b/guix/build-system/dub.scm new file mode 100644 index 0000000000..13c89e8648 --- /dev/null +++ b/guix/build-system/dub.scm @@ -0,0 +1,147 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2016 David Craven +;;; Copyright © 2016 Danny Milosavljevic +;;; +;;; 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 (guix build-system dub) + #:use-module (guix search-paths) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (dub-build-system)) + +(define (default-ldc) + "Return the default ldc package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((ldc (resolve-interface '(gnu packages ldc)))) + (module-ref ldc 'ldc))) + +(define (default-dub) + "Return the default dub package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((ldc (resolve-interface '(gnu packages ldc)))) + (module-ref ldc 'dub))) + +(define (default-pkg-config) + "Return the default pkg-config package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((pkg-config (resolve-interface '(gnu packages pkg-config)))) + (module-ref pkg-config 'pkg-config))) + +(define %dub-build-system-modules + ;; Build-side modules imported by default. + `((guix build dub-build-system) + (guix build syscalls) + ,@%gnu-build-system-modules)) + +(define* (dub-build store name inputs + #:key + (tests? #t) + (test-target #f) + (dub-build-flags ''()) + (phases '(@ (guix build dub-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %dub-build-system-modules) + (modules '((guix build dub-build-system) + (guix build utils)))) + "Build SOURCE using DUB, and with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (dub-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:system ,system + #:test-target ,test-target + #:dub-build-flags ,dub-build-flags + #:tests? ,tests? + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (ldc (default-ldc)) + (dub (default-dub)) + (pkg-config (default-pkg-config)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + + (define private-keywords + '(#:source #:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs)) + + (and (not target) ;; TODO: support cross-compilation + (bag + (name name) + (system system) + (target target) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system' + ,@(standard-packages))) + (build-inputs `(("ldc" ,ldc) + ("dub" ,dub) + ,@native-inputs)) + (outputs outputs) + (build dub-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define dub-build-system + (build-system + (name 'dub) + (description + "DUB build system, to build D packages") + (lower lower))) diff --git a/guix/build/dub-build-system.scm b/guix/build/dub-build-system.scm new file mode 100644 index 0000000000..7c7cd8803c --- /dev/null +++ b/guix/build/dub-build-system.scm @@ -0,0 +1,125 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 David Craven +;;; Copyright © 2017 Danny Milosavljevic +;;; +;;; 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 (guix build dub-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build syscalls) + #:use-module (guix build utils) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 ftw) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + dub-build)) + +;; Commentary: +;; +;; Builder-side code of the DUB (the build tool for D) build system. +;; +;; Code: + +;; FIXME: Needs to be parsed from url not package name. +(define (package-name->d-package-name name) + "Return the package name of NAME." + (match (string-split name #\-) + (("d" rest ...) + (string-join rest "-")) + (_ #f))) + +(define* (configure #:key inputs #:allow-other-keys) + "Prepare one new directory with all the required dependencies. + It's necessary to do this (instead of just using /gnu/store as the + directory) because we want to hide the libraries in subdirectories + lib/dub/... instead of polluting the user's profile root." + (let* ((dir (mkdtemp! "/tmp/dub.XXXXXX")) + (vendor-dir (string-append dir "/vendor"))) + (setenv "HOME" dir) + (mkdir vendor-dir) + (for-each + (match-lambda + ((name . path) + (let* ((d-package (package-name->d-package-name name)) + (d-basename (basename path))) + (when (and d-package path) + (match (string-split (basename path) #\-) + ((_ ... version) + (symlink (string-append path "/lib/dub/" d-basename) + (string-append vendor-dir "/" d-basename)))))))) + inputs) + (zero? (system* "dub" "add-path" vendor-dir)))) + +(define (grep string file-name) + "Find the first occurence of STRING in the file named FILE-NAME. + Return the position of this occurence, or #f if none was found." + (string-contains (call-with-input-file file-name get-string-all) + string)) + +(define (grep* string file-name) + "Find the first occurence of STRING in the file named FILE-NAME. + Return the position of this occurence, or #f if none was found. + If the file named FILE-NAME doesn't exist, return #f." + (catch 'system-error + (lambda () + (grep string file-name)) + (lambda args + #f))) + +(define* (build #:key (dub-build-flags '()) + #:allow-other-keys) + "Build a given DUB package." + (if (or (grep* "sourceLibrary" "package.json") + (grep* "sourceLibrary" "dub.sdl") ; note: format is different! + (grep* "sourceLibrary" "dub.json")) + #t + (let ((status (zero? (apply system* `("dub" "build" ,@dub-build-flags))))) + (system* "dub" "run") ; might fail for "targetType": "library" + status))) + +(define* (check #:key tests? #:allow-other-keys) + (if tests? + (zero? (system* "dub" "test")) + #t)) + +(define* (install #:key inputs outputs #:allow-other-keys) + "Install a given DUB package." + (let* ((out (assoc-ref outputs "out")) + (outbin (string-append out "/bin")) + (outlib (string-append out "/lib/dub/" (basename out)))) + (mkdir-p outbin) + ;; TODO remove "-test-application" + (copy-recursively "bin" outbin) + (mkdir-p outlib) + (copy-recursively "." (string-append outlib)) + #t)) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (replace 'configure configure) + (replace 'build build) + (replace 'check check) + (replace 'install install))) + +(define* (dub-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given DUB package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) -- cgit v1.2.3 From c32d02fe7edc0117c09d3fcd27140c3b149b496c Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 27 Jan 2017 21:37:42 +0800 Subject: services: Add openvswitch-service-type. * gnu/services/networking.scm (): New record type. (openvswitch-activation, openvswitch-shepherd-service): New procedures. (openvswitch-service-type): New variable. * doc/guix.texi (Networking Services): Document it. --- doc/guix.texi | 17 ++++++++++++ gnu/services/networking.scm | 64 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 80 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 50cab274af..6cdb5e592b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9264,6 +9264,23 @@ Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6 sockets. @end deffn +@deffn {Scheme Variable} openvswitch-service-type +This is the type of the @uref{http://www.openvswitch.org, Open vSwitch} +service, whose value should be an @code{openvswitch-configuration} +object. +@end deffn + +@deftp {Data Type} openvswitch-configuration +Data type representing the configuration of Open vSwitch, a multilayer +virtual switch which is designed to enable massive network automation +through programmatic extension. + +@table @asis +@item @code{package} (default: @var{openvswitch}) +Package object of the Open vSwitch. + +@end table +@end deftp @node X Window @subsubsection X Window diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index b63888cadb..18bce2a2b8 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -31,6 +31,7 @@ #:use-module (gnu packages linux) #:use-module (gnu packages tor) #:use-module (gnu packages messaging) + #:use-module (gnu packages networking) #:use-module (gnu packages ntp) #:use-module (gnu packages wicd) #:use-module (gnu packages gnome) @@ -80,7 +81,10 @@ network-manager-service-type connman-service - wpa-supplicant-service-type)) + wpa-supplicant-service-type + + openvswitch-service-type + openvswitch-configuration)) ;;; Commentary: ;;; @@ -885,4 +889,62 @@ configure networking." (service-extension dbus-root-service-type list) (service-extension profile-service-type list))))) + +;;; +;;; Open vSwitch +;;; + +(define-record-type* + openvswitch-configuration make-openvswitch-configuration + openvswitch-configuration? + (package openvswitch-configuration-package + (default openvswitch))) + +(define openvswitch-activation + (match-lambda + (($ package) + (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool"))) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/run/openvswitch") + (mkdir-p "/var/lib/openvswitch") + (let ((conf.db "/var/lib/openvswitch/conf.db")) + (unless (file-exists? conf.db) + (system* #$ovsdb-tool "create" conf.db))))))))) + +(define openvswitch-shepherd-service + (match-lambda + (($ package) + (let ((ovsdb-server (file-append package "/sbin/ovsdb-server")) + (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd"))) + (list + (shepherd-service + (provision '(ovsdb)) + (documentation "Run the Open vSwitch database server.") + (start #~(make-forkexec-constructor + (list #$ovsdb-server "--pidfile" + "--remote=punix:/var/run/openvswitch/db.sock") + #:pid-file "/var/run/openvswitch/ovsdb-server.pid")) + (stop #~(make-kill-destructor))) + (shepherd-service + (provision '(vswitchd)) + (requirement '(ovsdb)) + (documentation "Run the Open vSwitch daemon.") + (start #~(make-forkexec-constructor + (list #$ovs-vswitchd "--pidfile") + #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid")) + (stop #~(make-kill-destructor)))))))) + +(define openvswitch-service-type + (service-type + (name 'openvswitch) + (extensions + (list (service-extension activation-service-type + openvswitch-activation) + (service-extension profile-service-type + (compose list openvswitch-configuration-package)) + (service-extension shepherd-root-service-type + openvswitch-shepherd-service))))) + ;;; networking.scm ends here -- cgit v1.2.3 From 230efa876fea3b38f78502bd759b2943651929de Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 13 Feb 2017 09:56:30 +0100 Subject: doc: Update patch submission instructions. * doc/contributing.texi (Submitting Patches): Add paragraph on guix-patches@gnu.org. --- doc/contributing.texi | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/contributing.texi b/doc/contributing.texi index 4454df1f98..bbc93424b4 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -282,7 +282,19 @@ keyword parameters for procedures that take more than four parameters. Development is done using the Git distributed version control system. Thus, access to the repository is not strictly necessary. We welcome contributions in the form of patches as produced by @code{git -format-patch} sent to the @email{guix-devel@@gnu.org, mailing list}. +format-patch} sent to the @email{guix-patches@@gnu.org} mailing list. + +This mailing list is backed by a Debbugs instance accessible at +@uref{https://bugs.gnu.org/guix-patches}, which allows us to keep track +of submissions. Each message sent to that mailing list gets a new +tracking number assigned; people can then follow up on the submission by +sending email to @code{@var{NNN}@@debbugs.gnu.org}, where @var{NNN} is +the tracking number. When sending a patch series, please first send one +message to @email{guix-patches@@gnu.org}, and then send subsequent +patches to @email{@var{NNN}@@debbugs.gnu.org} to make sure they are kept +together. See @uref{https://debbugs.gnu.org/Advanced.html, the Debbugs +documentation}, for more information. + Please write commit logs in the ChangeLog format (@pxref{Change Logs,,, standards, GNU Coding Standards}); you can check the commit history for examples. -- cgit v1.2.3