On Wed, May 25, 2016 at 06:54:58PM +0200, Ludovic Courtès wrote:
>
> Yes, it’s:
>
> (service TYPE VALUE)
>
> but I think there’s no meaningful value for this service, so you could
> do:
>
> (service urandom-seed-service-type #f)
I'm struggling to make this work. Do I need to alter the definition of
urandom-seed-shepherd-service to accept the boolean?
With the attached diff, building a VM fails like this (full backtrace
attached):
[...]
573: 2 [loop #<<service> type: # parameters: ()>]
In srfi/srfi-1.scm:
578: 1 [map #<procedure 519cc20 at gnu/services.scm:562:4 (service)> (# # # #
...)]
In gnu/services/base.scm:
1217: 0 [urandom-seed-shepherd-service #f]
gnu/services/base.scm:1217:0: In procedure urandom-seed-shepherd-service:
gnu/services/base.scm:1217:0: Wrong number of arguments to #<procedure
urandom-seed-shepherd-service ()>
> Sounds like you’re pretty much there! :-)
Almost, I hope! Thanks for your help :)
Backtrace:
In ice-9/boot-9.scm:
1724: 19 [%start-stack load-stack ...]
1729: 18 [#<procedure 151cea0 ()>]
In unknown file:
?: 17 [primitive-load "/home/leo/work/guix/scripts/guix"]
In guix/ui.scm:
1201: 16 [run-guix-command system "vm" "/home/leo/tmp/bare-bones.scm"]
In ice-9/boot-9.scm:
157: 15 [catch srfi-34 #<procedure 31d2e20 at guix/ui.scm:425:2 ()> ...]
157: 14 [catch system-error ...]
In guix/scripts/system.scm:
882: 13 [#<procedure 3f1f7b0 at guix/scripts/system.scm:874:2 ()>]
788: 12 [process-action vm ("/home/leo/tmp/bare-bones.scm") ...]
In guix/store.scm:
1163: 11 [run-with-store # ...]
In guix/scripts/system.scm:
800: 10 [#<procedure 3f72660 at guix/scripts/system.scm:792:8 (state)> #]
564: 9 [perform-action vm # # ...]
In gnu/system/vm.scm:
496: 8 [system-qemu-image/shared-store-script # # # ...]
In gnu/system.scm:
601: 7 [operating-system-derivation # # #f]
In gnu/services.scm:
573: 6 [loop #]
In srfi/srfi-1.scm:
578: 5 [map #<procedure loop (sink)> (# # #)]
In gnu/services.scm:
573: 4 [loop #<<service> type: # parameters: #>]
In srfi/srfi-1.scm:
578: 3 [map #<procedure loop (sink)> (# # #)]
In gnu/services.scm:
573: 2 [loop #<<service> type: # parameters: ()>]
In srfi/srfi-1.scm:
578: 1 [map #<procedure 2dbfcc0 at gnu/services.scm:562:4 (service)> (# # # #
...)]
In gnu/services/base.scm:
1217: 0 [urandom-seed-shepherd-service #f]
gnu/services/base.scm:1217:0: In procedure urandom-seed-shepherd-service:
gnu/services/base.scm:1217:0: Wrong number of arguments to #<procedure
urandom-seed-shepherd-service ()>
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 96bf8da..041768f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -93,6 +93,8 @@
gpm-service-type
gpm-service
+ urandom-seed-service
+
%base-services))
;;; Commentary:
@@ -1200,6 +1202,57 @@ extra rules from the packages listed in @var{rules}."
"Return a service that uses @var{device} as a swap device."
(service swap-service-type device))
+(define %random-seed-file
+ "/var/run/random-seed")
+
+(define %urandom-seed-activation
+ ;; Activation gexp for the urandom seed
+ #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p (dirname %random-seed-file))
+ (close-port (open-output-file %random-seed-file))
+ (chmod %random-seed-file #o600)))
+
+(define (urandom-seed-shepherd-service)
+ "Return a shepherd service for the /dev/urandom seed."
+ (shepherd-service
+ (documentation "Preserve entropy across reboots for /dev/urandom.")
+ (provision '(urandom-seed))
+ (requirement '(user-processes)) ; whatever provides file-systems /var and /dev
+ (start #~(lambda _
+ (when (file-exists? #$%random-seed-file)
+ (call-with-input-file #$%random-seed-file
+ (lambda (seed)
+ (call-with-output-file "/dev/urandom"
+ (lambda (urandom)
+ (dump-port seed urandom))))))
+ #t))
+ (stop #~(lambda _
+ (let ((buf (make-bytevector 512)))
+ (call-with-input-file "/dev/urandom"
+ (lambda (urandom)
+ (get-bytevector-n! urandom buf 0 512)
+ (call-with-output-file #$%random-seed-file
+ (lambda (seed)
+ (put-bytevector seed buf)))
+ #t)))))
+ (modules `((rnrs bytevectors)
+ (rnrs io ports)
+ ,@%default-modules))))
+
+(define urandom-seed-service-type
+ (service-type (name 'urandom-seed)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ urandom-seed-shepherd-service)
+ (service-extension activation-service-type
+ (const %urandom-seed-activation))
+ ;; Add urandom-seed to the system profile
+ (service-extension profile-service-type list)))))
+
+(define (urandom-seed-service)
+ (service urandom-seed-service-type #f))
(define-record-type* <gpm-configuration>
gpm-configuration make-gpm-configuration gpm-configuration?
@@ -1281,6 +1334,7 @@ This is the GNU operating system, welcome!\n\n")))
(static-networking-service "lo" "127.0.0.1"
#:provision '(loopback))
(syslog-service)
+ (urandom-seed-service)
(guix-service)
(nscd-service)
