Add `random-state-from-platform' and `scm_i_random_bytes_from_platform'

* libguile/random.c (scm_random_state_from_platform): New procedure.
  (scm_i_random_bytes_from_platform): New internal function.

* libguile/random.h (scm_random_state_from_platform,
  scm_i_random_bytes_from_platform): Add prototypes.

* doc/ref/api-data.texi (Random): Add documentation.

3 files changed, 117 insertions, 19 deletions

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 60a214872..bcfbae365 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1865,6 +1865,16 @@ Return a datum representation of @var{state} that may be written out and
 read back with the Scheme reader.
 @end deffn
 
+@deffn {Scheme Procedure} random-state-from-platform
+@deffnx {C Function} scm_random_state_from_platform ()
+Construct a new random state seeded from a platform-specific source of
+entropy, appropriate for use in non-security-critical applications.
+Currently @file{/dev/urandom} is tried first, or else the seed is based
+on the time, date, process ID, an address from a freshly allocated heap
+cell, an address from the local stack frame, and a high-resolution timer
+if available.
+@end deffn
+
 @defvar *random-state*
 The global random state used by the above functions when the
 @var{state} parameter is not given.
@@ -1887,29 +1897,13 @@ Guile started up, will always give:
 (0 1 1 2 2 2 1 2 6 7 10 0 5 3 12 5 5 12)
 @end lisp
 
-To use the time of day as the random seed, you can use code like this:
-
-@lisp
-(let ((time (gettimeofday)))
-  (set! *random-state*
-        (seed->random-state (+ (car time)
-                               (cdr time)))))
-@end lisp
-
-@noindent
-And then (depending on the time of day, of course):
+To seed the random state in a sensible way for non-security-critical
+applications, do this during initialization of your program:
 
 @lisp
-(map random (cdr (iota 19)))
-@result{}
-(0 0 1 0 2 4 5 4 5 5 9 3 10 1 8 3 14 17)
+(set! *random-state* (random-state-from-platform))
 @end lisp
 
-For security applications, such as password generation, you should use
-more bits of seed.  Otherwise an open source password generator could
-be attacked by guessing the seed@dots{} but that's a subject for
-another manual.
-
 
 @node Characters
 @subsection Characters
diff --git a/libguile/random.c b/libguile/random.c
index 8bc0d8764..2db19f729 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -653,6 +653,107 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+/* Return a new random-state seeded from the time, date, process ID, an
+   address from a freshly allocated heap cell, an address from the local
+   stack frame, and a high-resolution timer if available.  This is only
+   to be used as a last resort, when no better source of entropy is
+   available. */
+static SCM
+random_state_of_last_resort (void)
+{
+  SCM state;
+  SCM time_of_day = scm_gettimeofday ();
+  SCM sources = scm_list_n
+    (scm_from_unsigned_integer (SCM_UNPACK (time_of_day)),  /* heap addr */
+     scm_getpid (),         /* process ID */
+     scm_get_internal_real_time (), /* high-resolution process timer */
+     scm_from_unsigned_integer ((scm_t_bits) &time_of_day), /* stack addr */
+     scm_car (time_of_day), /* seconds since midnight 1970-01-01 UTC */
+     scm_cdr (time_of_day), /* microsecond component of the above clock */
+     SCM_UNDEFINED);
+
+  /* Concatenate the sources bitwise to form the seed */
+  SCM seed = SCM_INUM0;
+  while (scm_is_pair (sources))
+    {
+      seed = scm_logxor (seed, scm_ash (scm_car (sources),
+                                        scm_integer_length (seed)));
+      sources = scm_cdr (sources);
+    }
+
+  /* FIXME The following code belongs in `scm_seed_to_random_state',
+     and here we should simply do:
+
+       return scm_seed_to_random_state (seed);
+
+     Unfortunately, `scm_seed_to_random_state' only preserves around 32
+     bits of entropy from the provided seed.  I don't know if it's okay
+     to fix that in 2.0, so for now we have this workaround. */
+  {
+    int i, len;
+    unsigned char *buf;
+    len = scm_to_int (scm_ceiling_quotient (scm_integer_length (seed),
+                                            SCM_I_MAKINUM (8)));
+    buf = (unsigned char *) malloc (len);
+    for (i = len-1; i >= 0; --i)
+      {
+        buf[i] = scm_to_int (scm_logand (seed, SCM_I_MAKINUM (255)));
+        seed = scm_ash (seed, SCM_I_MAKINUM (-8));
+      }
+    state = make_rstate (scm_c_make_rstate ((char *) buf, len));
+    free (buf);
+  }
+  return state;
+}
+
+/* Attempt to fill buffer with random bytes from /dev/urandom.
+   Return 1 if successful, else return 0. */
+static int
+read_dev_urandom (unsigned char *buf, size_t len)
+{
+  size_t res = 0;
+  FILE *f = fopen ("/dev/urandom", "r");
+  if (f)
+    {
+      res = fread(buf, 1, len, f);
+      fclose (f);
+    }
+  return (res == len);
+}
+
+/* Fill a buffer with random bytes seeded from a platform-specific
+   source of entropy.  /dev/urandom is used if available.  Note that
+   this function provides no guarantees about the amount of entropy
+   present in the returned bytes. */
+void
+scm_i_random_bytes_from_platform (unsigned char *buf, size_t len)
+{
+  if (read_dev_urandom (buf, len))
+    return;
+  else  /* FIXME: support other platform sources */
+    {
+      /* When all else fails, use this (rather weak) fallback */
+      SCM random_state = random_state_of_last_resort ();
+      int i;
+      for (i = len-1; i >= 0; --i)
+        buf[i] = scm_to_int (scm_random (SCM_I_MAKINUM (256), random_state));
+    }
+}
+
+SCM_DEFINE (scm_random_state_from_platform, "random-state-from-platform", 0, 0, 0,
+            (void),
+            "Construct a new random state seeded from a platform-specific\n\
+source of entropy, appropriate for use in non-security-critical applications.")
+#define FUNC_NAME s_scm_random_state_from_platform
+{
+  unsigned char buf[32];
+  if (read_dev_urandom (buf, sizeof(buf)))
+    return make_rstate (scm_c_make_rstate ((char *) buf, sizeof(buf)));
+  else
+    return random_state_of_last_resort ();
+}
+#undef FUNC_NAME
+
 void
 scm_init_random ()
 {
diff --git a/libguile/random.h b/libguile/random.h
index 2f1f0f69a..109969e01 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -86,6 +86,7 @@ SCM_API SCM scm_copy_random_state (SCM state);
 SCM_API SCM scm_seed_to_random_state (SCM seed);
 SCM_API SCM scm_datum_to_random_state (SCM datum);
 SCM_API SCM scm_random_state_to_datum (SCM state);
+SCM_API SCM scm_random_state_from_platform (void);
 SCM_API SCM scm_random_uniform (SCM state);
 SCM_API SCM scm_random_solid_sphere_x (SCM v, SCM state);
 SCM_API SCM scm_random_hollow_sphere_x (SCM v, SCM state);
@@ -94,6 +95,8 @@ SCM_API SCM scm_random_normal_vector_x (SCM v, SCM state);
 SCM_API SCM scm_random_exp (SCM state);
 SCM_INTERNAL void scm_init_random (void);
 
+SCM_INTERNAL void scm_i_random_bytes_from_platform (unsigned char *buf, size_t len);
+
 #endif  /* SCM_RANDOM_H */
 
 /*