;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2025 Lilah Tascheter ;;; ;;; 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 home services secrets) #:use-module (gnu home services) #:use-module (gnu home services shepherd) #:use-module (gnu packages password-utils) #:use-module (gnu services) #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (guix gexp) #:use-module (srfi srfi-1) #:export (wrap-himitsu-prompter home-himitsu-configuration home-himitsu-service-type home-himitsu-ssh-configuration home-himitsu-ssh-service-type home-himitsu-secret-service-configuration home-himitsu-secret-service-type)) ;; ;; himitsu ;; (define (wrap-himitsu-prompter prompter) "Wraps a prompter to autodetect DISPLAY and WAYLAND_DISPLAY, necessary since shepherd typically starts before a graphical session." (program-file "himitsu-wrapped-prompter" #~(begin (use-modules (ice-9 ftw) (ice-9 match) (srfi srfi-26)) (unless (or (getenv "DISPLAY") (getenv "WAYLAND_DISPLAY")) (for-each (lambda (dir pat cont) (match (scandir dir (cut regexp-exec pat <>) string)))) (apply execl #$prompter #$prompter (cdr (command-line)))))) (define-maybe string (prefix himitsu-)) (define (string-or-gexp? s) (or (string? s) (gexp? s))) (define list-of-strings-or-gexps? (list-of string-or-gexp?)) (define (himitsu-serialize-string label val) #~(format #f "~a=~a~%" '#$label #$val)) (define himitsu-serialize-file-like himitsu-serialize-string) (define (himitsu-serialize-list-of-strings-or-gexps label vals) #~(string-join (list #$@vals) "\n" 'suffix)) (define-configuration home-himitsu-configuration (package (file-like himitsu) "himitsu package to use." empty-serializer) (notify-reuse maybe-string "Command run to notify the user upon use of a secret it was already authorized to use. Limited shell expansion available.") (prompter (file-like (wrap-himitsu-prompter (file-append hiprompt-gtk "/bin/hiprompt-gtk"))) "himitsu prompter to use to request user authorization for secret access.") (extra-options (list-of-strings-or-gexps '()) "A list of extra options, one per line, to put verbatim into the config file.") (prefix himitsu-)) (define (himitsu-serialize config) (mixed-text-file "himitsu.ini" "[himitsud]\n" (serialize-configuration config home-himitsu-configuration-fields))) (define (himitsu-shepherd-service config) (define start #~(lambda _ (let ((data (or (getenv "XDG_DATA_HOME") (string-append user-homedir "/.local/share")))) (if (directory-exists? (string-append data "/himitsu")) (fork+exec-command (list #$(let ((pkg (home-himitsu-configuration-package config))) (file-append pkg "/bin/himitsud")) "-C" #$(himitsu-serialize config)) #:log-file (string-append %user-log-dir "/himitsu.log")) (error "Himitsu store must exist before the service can run! Try \ running 'himitsu-store -i' first?"))))) (list (shepherd-service (documentation "Run the Himitsu secret service manager.") (provision '(himitsud)) (modules (cons* '(shepherd support) %default-modules)) (start start) (stop #~(make-kill-destructor))))) ;; we need to install the file or else himitsu-store will gen it (define (himitsu-xdg-configuration-service config) `(("himitsu/config.ini" ,(himitsu-serialize config)))) (define home-himitsu-service-type (service-type (name 'himitsu) (extensions (list (service-extension home-shepherd-service-type himitsu-shepherd-service) (service-extension home-xdg-configuration-files-service-type himitsu-xdg-configuration-service) (service-extension home-profile-service-type (const (list himitsu))))) (compose concatenate) (extend (lambda (config exts) (let ((opts (home-himitsu-configuration-extra-options config))) (home-himitsu-configuration (inherit config) (extra-options (append exts opts)))))) (default-value (home-himitsu-configuration)) (description "Run the Himitsu secret storage manager upon login. You should create the Himitsu database in advance."))) ;; ;; himitsu-ssh ;; (define (remember-option? opt) (or (number? opt) (memq opt '(session skip refuse)))) (define list-of-remember-options? (list-of remember-option?)) (define (himitsu-serialize-list-of-remember-options label val) (himitsu-serialize-string label (string-join (map (lambda (x) (cond ((number? x) (number->string x)) ((symbol? x) (symbol->string x)))) val) ","))) (define-configuration home-himitsu-ssh-configuration (package (file-like himitsu-ssh) "himitsu-ssh package to use." empty-serializer) (persist (list-of-remember-options '(session 300 refuse)) "List of options given when prompting to allow himitsu-ssh to see your keys. The option chosen decides how long himitsu-ssh has this access. Options can be either 'session, 'refuse, 'skip, or a timeout in seconds. 'session means until the daemon closes, 'refuse to decline and never ask again, and 'skip means to ask again next use.") (disclose (list-of-remember-options '(skip session 300)) "List of options given when prompting to allow himitsu-ssh use of your keys. The format is the same has persist.") (prefix himitsu-)) (define (himitsu-ssh-shepherd-service config) (let* ((package (home-himitsu-ssh-configuration-package config)) (binary (file-append package "/bin/hissh-agent"))) (list (shepherd-service (documentation "Start the Himitsu ssh-agent implementation.") (provision '(himitsu-ssh ssh-agent)) (requirement '(himitsud)) (start #~(make-forkexec-constructor (list #$binary))) (stop #~(make-kill-destructor)))))) (define (himitsu-ssh-himitsu.ini config) (list "[ssh.remember]" (serialize-configuration config home-himitsu-ssh-configuration-fields))) (define (himitsu-ssh-environment-variables _) '(("SSH_AUTH_SOCK" . "${XDG_RUNTIME_DIR:-/run/user/$UID}/hissh-agent"))) (define home-himitsu-ssh-service-type (service-type (name 'himitsu-ssh) (extensions (list (service-extension home-shepherd-service-type himitsu-ssh-shepherd-service) (service-extension home-himitsu-service-type himitsu-ssh-himitsu.ini) (service-extension home-environment-variables-service-type himitsu-ssh-environment-variables) (service-extension home-profile-service-type (const (list himitsu-ssh))))) (default-value (home-himitsu-ssh-configuration)) (description "Add support for ssh to store keys in Himitsu."))) ;; ;; himitsu-secret-service ;; (define-configuration home-himitsu-secret-service-configuration (package (file-like himitsu-secret-service) "himitsu-secret-service package to use." empty-serializer) (prefix himitsu-)) (define (himitsu-secret-service-shepherd-service config) (let* ((package (home-himitsu-secret-service-configuration-package config)) (binary (file-append package "/bin/hisecrets-agent"))) (list (shepherd-service (documentation "Start the Himitsu secret-service implementation.") (provision '(himitsu-secret-service secret-service)) (requirement '(himitsud dbus)) (start #~(make-forkexec-constructor (list #$binary))) (stop #~(make-kill-destructor)))))) (define home-himitsu-secret-service-type (service-type (name 'himitsu-secret-service) (extensions (list (service-extension home-shepherd-service-type himitsu-secret-service-shepherd-service))) (default-value (home-himitsu-secret-service-configuration)) (description "Add support to Himitsu for the freedesktop.org secret-service protocol.")))