nanosecond timestamp support in stat and utime

* libguile/posix.h:
* libguile/posix.c (scm_utime): Add optional nanosecond arguments. This
  is an incompatible change on the C level, but it's unlikely people are
  using this POSIX wrapper function, because they would just use the
  POSIX function directly. Hopefully, anyway.

* module/system/base/compile.scm (call-with-output-file/atomic):
  Propagate source timestamps to targets with nanosecond precision, if
  available. Fixes build on systems with ext4 filesystems.

* libguile/filesys.c (scm_stat2scm):
* module/ice-9/posix.scm (stat:atimensec, stat:mtimensec)
  (stat:ctimensec): Add three new elements to Scheme stat structures,
  for nanosecond-level timestamps.

* configure.ac: Add checks for utimensat, and for nanosecond fields in
  struct stat. We should switch to using Gnulib things for these,
  though.

* doc/ref/posix.texi (File System): Add documentation for utime's
  additional arguments, and nanosecond stat timestamp accessors.

7 files changed, 120 insertions, 23 deletions

diff --git a/configure.ac b/configure.ac
index 5143dcc13..baac33d74 100644
--- a/configure.ac
+++ b/configure.ac
@@ -764,8 +764,9 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
 #   nl_langinfo - X/Open, not available on Windows.
+#   utimensat: posix.1-2008
 #
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo utimensat])
 
 # Reasons for testing:
 #   netdb.h - not in mingw
@@ -1157,7 +1158,10 @@ int main () { return (isnan(x) != 0); }]]),
 # Note AC_STRUCT_ST_BLOCKS is not used here because we don't want the
 # AC_LIBOBJ(fileblocks) replacement which that macro gives.
 #
-AC_CHECK_MEMBERS([struct stat.st_rdev, struct stat.st_blksize, struct stat.st_blocks])
+AC_CHECK_MEMBERS([struct stat.st_rdev, struct stat.st_blksize, struct stat.st_blocks, struct stat.st_atim, struct stat.st_mtim, struct stat.st_ctim],,,
+                 [#define _GNU_SOURCE
+AC_INCLUDES_DEFAULT
+])
 
 AC_STRUCT_TIMEZONE
 AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 287045983..6ff7109fd 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -687,13 +687,21 @@ case @code{stat:rdev} returns @code{#f}.
 The size of a regular file in bytes.
 @end deffn
 @deffn {Scheme Procedure} stat:atime st
-The last access time for the file.
+The last access time for the file, in seconds.
 @end deffn
 @deffn {Scheme Procedure} stat:mtime st
-The last modification time for the file.
+The last modification time for the file, in seconds.
 @end deffn
 @deffn {Scheme Procedure} stat:ctime st
-The last modification time for the attributes of the file.
+The last modification time for the attributes of the file, in seconds.
+@end deffn
+@deffn {Scheme Procedure} stat:atimensec st
+@deffnx {Scheme Procedure} stat:mtimensec st
+@deffnx {Scheme Procedure} stat:ctimensec st
+The fractional part of a file's access, modification, or attribute modification
+time, in nanoseconds. Nanosecond timestamps are only available on some operating
+systems and filesystems. If Guile cannot retrieve nanosecond-level timestamps
+for a file, these fields will be set to 0.
 @end deffn
 @deffn {Scheme Procedure} stat:blksize st
 The optimal block size for reading or writing the file, in bytes.  On
@@ -763,14 +771,18 @@ the new permissions as a decimal number, e.g., @code{(chmod "foo" #o755)}.
 The return value is unspecified.
 @end deffn
 
-@deffn {Scheme Procedure} utime pathname [actime [modtime]]
-@deffnx {C Function} scm_utime (pathname, actime, modtime)
-@cindex file times
+@deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]]
+@deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags)
 @code{utime} sets the access and modification times for the
 file named by @var{path}.  If @var{actime} or @var{modtime} is
 not supplied, then the current time is used.  @var{actime} and
 @var{modtime} must be integer time values as returned by the
 @code{current-time} procedure.
+
+The optional @var{actimens} and @var{modtimens} are nanoseconds
+to add @var{actime} and @var{modtime}. Nanosecond precision is
+only supported on some combinations of filesystems and operating
+systems.
 @lisp
 (utime "foo" (- (current-time) 3600))
 @end lisp
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 3a2a47ed1..37b45deff 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -405,7 +405,7 @@ SCM_SYMBOL (scm_sym_unknown, "unknown");
 static SCM 
 scm_stat2scm (struct stat_or_stat64 *stat_temp)
 {
-  SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
+  SCM ans = scm_c_make_vector (18, SCM_UNSPECIFIED);
   
   SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
   SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ino_t_or_ino64_t (stat_temp->st_ino));
@@ -490,6 +490,21 @@ scm_stat2scm (struct stat_or_stat64 *stat_temp)
        
        */
   }  
+#ifdef HAVE_STRUCT_STAT_ST_ATIM
+  SCM_SIMPLE_VECTOR_SET(ans, 15, scm_from_long (stat_temp->st_atim.tv_nsec));
+#else
+  SCM_SIMPLE_VECTOR_SET(ans, 15, SCM_I_MAKINUM (0));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_MTIM
+  SCM_SIMPLE_VECTOR_SET(ans, 16, scm_from_long (stat_temp->st_mtim.tv_nsec));
+#else
+  SCM_SIMPLE_VECTOR_SET(ans, 16, SCM_I_MAKINUM (0));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_CTIM
+  SCM_SIMPLE_VECTOR_SET(ans, 17, scm_from_ulong (stat_temp->st_ctim.tv_sec));
+#else
+  SCM_SIMPLE_VECTOR_SET(ans, 17, SCM_I_MAKINUM (0));
+#endif
 
   return ans;
 }
diff --git a/libguile/posix.c b/libguile/posix.c
index ef52c38f6..f386fdfcf 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1373,13 +1373,18 @@ SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
-            (SCM pathname, SCM actime, SCM modtime),
+SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
+            (SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM modtimens,
+             SCM flags),
 	    "@code{utime} sets the access and modification times for the\n"
 	    "file named by @var{path}.  If @var{actime} or @var{modtime} is\n"
 	    "not supplied, then the current time is used.  @var{actime} and\n"
 	    "@var{modtime} must be integer time values as returned by the\n"
-	    "@code{current-time} procedure.\n"
+	    "@code{current-time} procedure.\n\n"
+            "The optional @var{actimens} and @var{modtimens} are nanoseconds\n"
+            "to add @var{actime} and @var{modtime}. Nanosecond precision is\n"
+            "only supported on some combinations of filesystems and operating\n"
+            "systems.\n"
 	    "@lisp\n"
 	    "(utime \"foo\" (- (current-time) 3600))\n"
 	    "@end lisp\n"
@@ -1388,20 +1393,75 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
 #define FUNC_NAME s_scm_utime
 {
   int rv;
-  struct utimbuf utm_tmp;
-
+  time_t atim_sec, mtim_sec;
+  long atim_nsec, mtim_nsec;
+  int f;
+  
   if (SCM_UNBNDP (actime))
-    SCM_SYSCALL (time (&utm_tmp.actime));
+    {
+#if HAVE_UTIMENSAT
+      atim_sec = 0;
+      atim_nsec = UTIME_NOW;
+#else
+      SCM_SYSCALL (time (&atim_sec));
+      atim_nsec = 0;
+#endif
+    }
   else
-    utm_tmp.actime = SCM_NUM2ULONG (2, actime);
-
+    {
+      atim_sec = SCM_NUM2ULONG (2, actime);
+      if (SCM_UNBNDP (actimens))
+        atim_nsec = 0;
+      else
+        atim_nsec = SCM_NUM2LONG (4, actimens);
+    }
+  
   if (SCM_UNBNDP (modtime))
-    SCM_SYSCALL (time (&utm_tmp.modtime));
+    {
+#if HAVE_UTIMENSAT
+      mtim_sec = 0;
+      mtim_nsec = UTIME_NOW;
+#else
+      SCM_SYSCALL (time (&mtim_sec));
+      mtim_nsec = 0;
+#endif
+    }
   else
-    utm_tmp.modtime = SCM_NUM2ULONG (3, modtime);
+    {
+      mtim_sec = SCM_NUM2ULONG (3, modtime);
+      if (SCM_UNBNDP (modtimens))
+        mtim_nsec = 0;
+      else
+        mtim_nsec = SCM_NUM2LONG (5, modtimens);
+    }
+  
+  if (SCM_UNBNDP (flags))
+    f = 0;
+  else
+    f = SCM_NUM2INT (6, flags);
+
+#if HAVE_UTIMENSAT
+  {
+    struct timespec times[2];
+    times[0].tv_sec = atim_sec;
+    times[0].tv_nsec = atim_nsec;
+    times[1].tv_sec = mtim_sec;
+    times[1].tv_nsec = mtim_nsec;
+
+    STRING_SYSCALL (pathname, c_pathname,
+                    rv = utimensat (AT_FDCWD, c_pathname, &times, f));
+  }
+#else
+  {
+    struct utimbuf utm;
+    utm.actime = atim_sec;
+    utm.modtime = mtim_sec;
+
+    STRING_SYSCALL (pathname, c_pathname,
+                    rv = utime (c_pathname, &utm));
+  }
+#endif
 
-  STRING_SYSCALL (pathname, c_pathname,
-		  rv = utime (c_pathname, &utm_tmp));
   if (rv != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
diff --git a/libguile/posix.h b/libguile/posix.h
index 430d75b7f..420311e5d 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -70,7 +70,8 @@ SCM_API SCM scm_tmpnam (void);
 SCM_API SCM scm_mkstemp (SCM tmpl);
 SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
 SCM_API SCM scm_close_pipe (SCM port);
-SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime);
+SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime,
+                       SCM actimens, SCM modtimens, SCM flags);
 SCM_API SCM scm_access (SCM path, SCM how);
 SCM_API SCM scm_getpid (void);
 SCM_API SCM scm_putenv (SCM str);
diff --git a/module/ice-9/posix.scm b/module/ice-9/posix.scm
index a1be33c19..b00267665 100644
--- a/module/ice-9/posix.scm
+++ b/module/ice-9/posix.scm
@@ -33,6 +33,9 @@
 (define (stat:ctime f) (vector-ref f 10))
 (define (stat:blksize f) (vector-ref f 11))
 (define (stat:blocks f) (vector-ref f 12))
+(define (stat:atimensec f) (vector-ref f 15))
+(define (stat:mtimensec f) (vector-ref f 16))
+(define (stat:ctimensec f) (vector-ref f 17))
 
 ;; derived from stat mode.
 (define (stat:type f) (vector-ref f 13))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0caa24809..977536f64 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -88,7 +88,9 @@
            (close-port tmp)
            (if reference
                (let ((st (stat reference)))
-                 (utime template (stat:atime st) (stat:mtime st))))
+                 (utime template
+                        (stat:atime st) (stat:mtime st)
+                        (stat:atimensec st) (stat:mtimensec st))))
            (rename-file template filename))
          (lambda args
            (delete-file template)))))))