diff options
-rw-r--r-- | whispers/services/whispers/finance.scm | 57 | ||||
-rw-r--r-- | whispers/services/whispers/ssh.scm | 115 |
2 files changed, 89 insertions, 83 deletions
diff --git a/whispers/services/whispers/finance.scm b/whispers/services/whispers/finance.scm index 1ce7e5b..1c1fb0e 100644 --- a/whispers/services/whispers/finance.scm +++ b/whispers/services/whispers/finance.scm @@ -224,31 +224,31 @@ used by the bitcoin node daemon.") (procedure #~(lambda (running) (unless (not #$bitcoin?) - (action '#$user-sym - 'make-directory - #$(log-folder user-str) - #$user - #$group - #$(number->string #o755 8)) - (action '#$user-sym - 'make-tmpfs - #$(pid-folder user) - #$user - #$group - #$(number->string #o755 8))) + (perform-service-action (lookup-service '#$user-sym) + 'make-directory + #$(log-folder user-str) + #$user + #$group + #$(number->string #o755 8)) + (perform-service-action (lookup-service '#$user-sym) + 'make-tmpfs + #$(pid-folder user) + #$user + #$group + #$(number->string #o755 8))) (unless (not #$monero?) - (action '#$user-sym - 'make-directory - #$(rightwing-log-folder user-str) - #$user - #$group - #$(number->string #o755 8)) - (action '#$user-sym - 'make-tmpfs - #$(rightwing-pid-folder user) - #$user - #$group - #$(number->string #o755 8)))))) + (perform-service-action (lookup-service '#$user-sym) + 'make-directory + #$(rightwing-log-folder user-str) + #$user + #$group + #$(number->string #o755 8)) + (perform-service-action (lookup-service '#$user-sym) + 'make-tmpfs + #$(rightwing-pid-folder user) + #$user + #$group + #$(number->string #o755 8)))))) (shepherd-action (name 'post-stop) (documentation "Unmount the tmpfs mounts used by the bitcoin @@ -256,13 +256,14 @@ node daemon.") (procedure #~(lambda (running) (unless (not #$bitcoin?) - (action '#$user-sym + (perform-service-action (lookup-service '#$user-sym) 'clear-tmpfs #$(pid-folder user))) (unless (not #$monero?) - (action '#$user-sym - 'clear-tmpfs - #$(rightwing-pid-folder user))))))))) + (perform-service-action (lookup-service '#$user-sym) + 'clear-tmpfs + #$(rightwing-pid-folder + user))))))))) (define (node-lieutenants user nodes) "Returns a list of zero to two crypto node guix shepherd services diff --git a/whispers/services/whispers/ssh.scm b/whispers/services/whispers/ssh.scm index a5ff1d1..8cf73ff 100644 --- a/whispers/services/whispers/ssh.scm +++ b/whispers/services/whispers/ssh.scm @@ -424,13 +424,14 @@ used by a tunneler connection.") (procedure #~(lambda (running) `#$(map (lambda (conn) - (list #~,(action 'tunneler - 'make-directory - #$(log-folder-forwarding user - conn) - #$user - #$group - #$(number->string #o755 + (list #~,(perform-service-action + (lookup-service 'tunneler) + 'make-directory + #$(log-folder-forwarding user + conn) + #$user + #$group + #$(number->string #o755 8)) ;; The let form is insuring that the ;; parent folder is created before its @@ -438,24 +439,26 @@ used by a tunneler connection.") ;; possibly go wrong with this ;; clusterfuck? #~,(let ((dummy - (action 'tunneler - 'make-tmpfs - #$(base-folder-forwarding - user - conn) - #$user - #$group - #$(number->string #o755 - 8)))) - (action 'tunneler - 'make-tmpfs - #$(socket-folder-forwarding - user - conn) - #$user - #$group - #$(number->string #o700 - 8))))) + (perform-service-action + (lookup-service 'tunneler) + 'make-tmpfs + #$(base-folder-forwarding + user + conn) + #$user + #$group + #$(number->string #o755 + 8)))) + (perform-service-action + (lookup-service 'tunneler) + 'make-tmpfs + #$(socket-folder-forwarding + user + conn) + #$user + #$group + #$(number->string #o700 + 8))))) conn-list)))) (shepherd-action (name 'post-stop) @@ -468,16 +471,18 @@ used by a tunneler connection.") ;; folder is deleted after its ;; sub-folder. Ditto. (list #~,(let ((dummy - (action 'tunneler - 'clear-tmpfs - #$(socket-folder-forwarding - user - conn)))) - (action 'tunneler - 'clear-tmpfs - #$(base-folder-forwarding - user - conn))))) + (perform-service-action + (lookup-service 'tunneler) + 'clear-tmpfs + #$(socket-folder-forwarding + user + conn)))) + (perform-service-action + (lookup-service 'tunneler) + 'clear-tmpfs + #$(base-folder-forwarding + user + conn))))) conn-list)))))) (define (tunnelers ssh-package user group forwardings) @@ -515,22 +520,22 @@ by the string GROUP." used by the ssh-agent.") (procedure #~(lambda (running) - (action '#$user-sym - 'make-directory - #$(log-folder-agent user-str) + (perform-service-action (lookup-service '#$user-sym) + 'make-directory + #$(log-folder-agent user-str) + #$user + #$group + #$(number->string #o755 8)) + (perform-service-action (lookup-service '#$user-sym) + 'make-tmpfs + (string-append "/run/whispers/" + "ssh/" + #$user-str + "/ssh-agent/") #$user #$group #$(number->string #o755 8)) - (action '#$user-sym - 'make-tmpfs - (string-append "/run/whispers/" - "ssh/" - #$user-str - "/ssh-agent/") - #$user - #$group - #$(number->string #o755 8)) - (action '#$user-sym + (perform-service-action (lookup-service '#$user-sym) 'make-tmpfs #$(socket-folder-agent user) #$user @@ -541,15 +546,15 @@ used by the ssh-agent.") (documentation "Unmount the tmpfs mounts used by the ssh-agent.") (procedure #~(lambda (running) - (action '#$user-sym + (perform-service-action (lookup-service '#$user-sym) 'clear-tmpfs #$(socket-folder-agent user)) - (action '#$user-sym - 'clear-tmpfs - (string-append "/run/whispers/" - "ssh/" - #$user-str - "/ssh-agent")))))))) + (perform-service-action (lookup-service '#$user-sym) + 'clear-tmpfs + (string-append "/run/whispers/" + "ssh/" + #$user-str + "/ssh-agent")))))))) (define (user-lieutenant agent? tunneler? |