Add native UUID generator.

While not necessary, since we barely use UUID:s, it's still WAY faster,
and nice to not depend on the system providing `uuidgen'.

For comparison, number of UUID:s generated by different settups in 1
second:

   65.000 :: guile native
      700 :: guile shell-out
3.500.000 :: c native
  100.000 :: libuuid - guile bindings
  650.000 :: libuuid

Tests where run with either
    (call-with-time-limit
      1
      (lambda ()
	(let loop ()
	 (uuid)
	 (set! count (1+ count))
	 (loop)))
      (lambda _ (display count)))
or
    volatile unsigned long long count = 0;
    sigaction(SIGALARM, ...);
    alarm(1);
    for (;;) {
	uuid();
	count++;
    }

(let ((count 0))
  (call-with-time-limit
   1
   (lambda ()
     (let loop ()
       ((@ (hnh util) uuidgen))
       (set! count (1+ count))
       (loop)))
   (lambda _ (format #t "exec count = ~:d~%" count))))

5 files changed, 32 insertions, 10 deletions

diff --git a/doc/ref/guile/util.texi b/doc/ref/guile/util.texi
index 71e3f93a..2cf1070b 100644
--- a/doc/ref/guile/util.texi
+++ b/doc/ref/guile/util.texi
@@ -338,7 +338,14 @@ Similar to @var{let}, but sets environment variables for the code in
 body. Restores the old values once we leave.
 @end defmac
 
+@subsection UUID generation
 
-@defun uuidgen
-Generates a UUID.
+Provided by module @code{(hnh util uuid)}.
+
+@defun uuid-v4
+Generates a UUID-v4 string.
+@end defun
+
+@defun uuid
+Generates an implementation defined (but guaranteed valid) UUID.
 @end defun
diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index 8cbc8c8d..1b5ceeab 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -575,9 +575,3 @@
          (lambda ()
            (for-each (lambda (pair) (setenv (car pair) (caddr pair)))
                      env-pairs))))]))
-
-
-(define-public (uuidgen)
-  ((@ (rnrs io ports) call-with-port)
-   ((@ (ice-9 popen) open-input-pipe) "uuidgen")
-   (@ (ice-9 rdelim) read-line)))
diff --git a/module/hnh/util/uuid.scm b/module/hnh/util/uuid.scm
new file mode 100644
index 00000000..68455243
--- /dev/null
+++ b/module/hnh/util/uuid.scm
@@ -0,0 +1,19 @@
+(define-module (hnh util uuid)
+  :use-module (ice-9 format)
+  :export (uuid uuid-v4))
+
+(define %seed (random-state-from-platform))
+
+(define (uuid-v4)
+  (define version 4)
+  (define variant #b10)
+  (format #f "~8'0x-~4'0x-~4'0x-~4'0x-~12'0x"
+          (random (ash 1 (* 4 8)) %seed)
+          (random (ash 1 (* 4 4)) %seed)
+          (logior (ash version (* 4 3))
+                  (random (1- (ash 1 (* 4 3))) %seed))
+          (logior (ash variant (+ 2 (* 4 3)))
+                  (random (ash 1 (+ 2 (* 4 3))) %seed))
+          (random (ash 1 (* 4 12)) %seed)))
+
+(define uuid uuid-v4)
diff --git a/module/vcomponent/formats/vdir/save-delete.scm b/module/vcomponent/formats/vdir/save-delete.scm
index 6068e34c..7de9379b 100644
--- a/module/vcomponent/formats/vdir/save-delete.scm
+++ b/module/vcomponent/formats/vdir/save-delete.scm
@@ -11,6 +11,7 @@
 
 (define-module (vcomponent formats vdir save-delete)
   :use-module (hnh util)
+  :use-module (hnh util uuid)
   :use-module ((hnh util path) :select (path-append))
   :use-module ((hnh util exceptions) :select (assert))
   :use-module (vcomponent formats ical output)
@@ -24,7 +25,7 @@
 
   (assert (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE)))
 
-  (let* ((uid (or (prop event 'UID) (uuidgen))))
+  (let* ((uid (or (prop event 'UID) (uuid))))
     (set! (prop event 'UID) uid
       ;; TODO use existing filename if present?
       (prop event '-X-HNH-FILENAME) (path-append
diff --git a/module/vcomponent/util/instance/methods.scm b/module/vcomponent/util/instance/methods.scm
index 120ab2fe..926f9bb8 100644
--- a/module/vcomponent/util/instance/methods.scm
+++ b/module/vcomponent/util/instance/methods.scm
@@ -1,5 +1,6 @@
 (define-module (vcomponent util instance methods)
   :use-module (hnh util)
+  :use-module (hnh util uuid)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-41)
   :use-module (srfi srfi-41 util)
@@ -93,7 +94,7 @@
 
   (add-child! calendar event)
   (unless (prop event 'UID)
-    (set! (prop event 'UID) (uuidgen)))
+    (set! (prop event 'UID) (uuid)))