;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; 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 herd) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-
aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to 'nix/libutil/gcrypt-hash.cc')
0 files changed, 0 insertions, 0 deletions
(service service) (action action))))) (('error ('version 0 x ...) 'action-exception action service key (args ...)) (raise (condition (&action-exception-error (service service) (action action) (key key) (args args))))) (('error . _) (raise (condition (&unknown-shepherd-error (sexp error))))) (#f ;not an error #t))) (define (display-message message) (format (current-error-port) "shepherd: ~a~%" message)) (define* (invoke-action service action arguments cont) "Invoke ACTION on SERVICE with ARGUMENTS. On success, call CONT with the list of results (one result per instance with the name SERVICE). Otherwise return #f." (with-shepherd sock (write `(shepherd-command (version 0) (action ,action) (service ,service) (arguments ,arguments) (directory ,(getcwd))) sock) (force-output sock) (match (read sock) (('reply ('version 0 _ ...) ('result result) ('error #f) ('messages messages)) (for-each display-message messages) (cont result)) (('reply ('version 0 x ...) ('result y) ('error error) ('messages messages)) (for-each display-message messages) (raise-shepherd-error error) #f) (x ;; invalid reply #f)))) (define-syntax-rule (with-shepherd-action service (action args ...) result body ...) "Invoke ACTION on SERVICE with the given ARGS, and evaluate BODY with RESULT bound to the action's result." (invoke-action service action (list args ...) (lambda (result) body ...))) (define-syntax alist-let* (syntax-rules () "Bind the given KEYs in EXP to the corresponding items in ALIST. ALIST is assumed to be a list of two-element tuples rather than a traditional list of pairs." ((_ alist (key ...) exp ...) (let ((key (and=> (assoc-ref alist 'key) car)) ...) exp ...)))) ;; Information about live Shepherd services. (define-record-type (live-service provision requirement running) live-service? (provision live-service-provision) ;list of symbols (requirement live-service-requirement) ;list of symbols (running live-service-running)) ;#f | object (define (current-services) "Return the list of currently defined Shepherd services, represented as objects. Return #f if the list of services could not be obtained." (with-shepherd-action 'root ('status) results ;; We get a list of results, one for each service with the name 'root'. ;; In practice there's only one such service though. (match results ((services _ ...) (match services ((('service ('version 0 _ ...) _ ...) ...) (map (lambda (service) (alist-let* service (provides requires running) (live-service provides requires running))) services)) (x #f)))))) (define (unload-service service) "Unload SERVICE, a symbol name; return #t on success." (with-shepherd-action 'root ('unload (symbol->string service)) result (first result))) (define (%load-file file) "Load FILE in the Shepherd." (with-shepherd-action 'root ('load file) result (first result))) (define (eval-there exp) "Eval EXP in the Shepherd." (with-shepherd-action 'root ('eval (object->string exp)) result (first result))) (define (load-services files) "Load and register the services from FILES, where FILES contain code that returns a shepherd object." (eval-there `(register-services ,@(map (lambda (file) `(primitive-load ,file)) files)))) (define (load-services/safe files) "This is like 'load-services', but make sure only the subset of FILES that can be safely reloaded is actually reloaded. This is done to accommodate the Shepherd < 0.15.0 where services lacked the 'replacement' slot, and where 'register-services' would throw an exception when passed a service with an already-registered name." (eval-there `(let* ((services (map primitive-load ',files)) (slots (map slot-definition-name (class-slots ))) (can-replace? (memq 'replacement slots))) (define (registered? service) (not (null? (lookup-services (canonical-name service))))) (apply register-services (if can-replace? services (remove registered? services)))))) (define* (start-service name #:optional (arguments '())) (invoke-action name 'start arguments (lambda (result) result))) (define (stop-service name) (with-shepherd-action name ('stop) result result)) ;; Local Variables: ;; eval: (put 'alist-let* 'scheme-indent-function 2) ;; eval: (put 'with-shepherd 'scheme-indent-function 1) ;; eval: (put 'with-shepherd-action 'scheme-indent-function 3) ;; End: ;;; herd.scm ends here