New functions utimes, lutimes.

* configure: Detect various functions for setting file
timestamps.

* sysif.c (get_fd): Define this function for use by utimes
also.
(timens, do_utimes): New static functions.
(wrap_utimes, wrap_lutimes): New static functions.
(sysif_init): Register utimes and lutimes intrinsics.

* txr.1: Documented.

3 files changed, 326 insertions, 1 deletions

diff --git a/configure b/configure
index 85336937..c3b84a64 100755
--- a/configure
+++ b/configure
@@ -1708,6 +1708,114 @@ int main(void)
 fi
 
 #
+# utime, utimes, utimensat and futimens
+#
+
+printf "Checking for utime ... "
+
+cat > conftest.c <<!
+#include <utime.h>
+
+int main(void)
+{
+  struct utimbuf utb;
+  int res = utime("path", &utb);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_UTIME 1\n" >> config.h
+else
+  printf "no\n"
+fi
+
+printf "Checking for utimes ... "
+
+cat > conftest.c <<!
+#include <sys/time.h>
+
+int main(void)
+{
+  struct timeval tv[2];
+  int res = utimes("path", tv);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_UTIMES 1\n" >> config.h
+else
+  printf "no\n"
+fi
+
+printf "Checking for futimes ... "
+
+cat > conftest.c <<!
+#include <sys/time.h>
+
+int main(void)
+{
+  struct timeval tv[2];
+  int res = futimes(42, tv);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_FUTIMES 1\n" >> config.h
+else
+  printf "no\n"
+fi
+
+printf "Checking for lutimes ... "
+
+cat > conftest.c <<!
+#include <sys/time.h>
+
+int main(void)
+{
+  struct timeval tv[2];
+  int res = lutimes("path", tv);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_LUTIMES 1\n" >> config.h
+else
+  printf "no\n"
+fi
+
+printf "Checking for utimensat and futimens ... "
+
+cat > conftest.c <<!
+#include <sys/stat.h>
+#include <fcntl.h>
+
+int main(void)
+{
+  struct timespec ts[2];
+  int resu = utimensat(AT_FDCWD, "path", ts, AT_SYMLINK_NOFOLLOW);
+  int resf = futimens(0, ts);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_FUTIMENS 1\n" >> config.h
+else
+  printf "no\n"
+fi
+
+printf "#define HAVE_FILE_STAMP_CHANGE " >> config.h
+printf "(HAVE_UTIMES || HAVE_FUTIMES || HAVE_FUTIMENS)\n" >> config.h
+#
 # environ
 #
 
diff --git a/sysif.c b/sysif.c
index 9e43bed2..669b1863 100644
--- a/sysif.c
+++ b/sysif.c
@@ -52,6 +52,9 @@
 #if HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #endif
+#if HAVE_SYS_TIME
+#include <sys/time.h>
+#endif
 #if HAVE_SYS_SYSMACROS_H
 #include <sys/sysmacros.h>
 #endif
@@ -79,6 +82,9 @@
 #if HAVE_CRYPT_R
 #include <crypt.h>
 #endif
+#if HAVE_UTIME
+#include <utime.h>
+#endif
 #include "alloca.h"
 #include "lib.h"
 #include "stream.h"
@@ -449,7 +455,7 @@ static val mknod_wrap(val path, val mode, val dev)
 
 #endif
 
-#if HAVE_CHMOD || HAVE_SYS_STAT
+#if HAVE_CHMOD || HAVE_SYS_STAT || HAVE_FILE_STAMP_CHANGE
 static int get_fd(val stream, val self)
 {
   val fd_in = if3(integerp(stream), stream, stream_get_prop(stream, fd_k));
@@ -905,6 +911,107 @@ val fstat_wrap(val stream)
   return stat_impl(stream, do_fstat, lit("fstat"), nil);
 }
 
+#if HAVE_FILE_STAMP_CHANGE
+
+#if HAVE_FUTIMENS
+static long timens(val arg, val self)
+{
+  return if3(arg == t, UTIME_NOW, if3(arg, c_long(arg, self), UTIME_OMIT));
+}
+#endif
+
+static val do_utimes(val target, val atime, val atimens,
+                     val mtime, val mtimens,
+                     val symlink_nofollow, val self)
+{
+  int res = -1;
+
+  if (stringp(target)) {
+    char *u8path = utf8_dup_to(c_str(target));
+#if HAVE_FUTIMENS
+    int flags = if3(symlink_nofollow, AT_SYMLINK_NOFOLLOW, 0);
+    struct timespec times[2];
+    times[0].tv_sec = c_time(atime);
+    times[0].tv_nsec = timens(atimens, self);
+    times[1].tv_sec = c_time(mtime);
+    times[1].tv_nsec = timens(mtimens, self);
+    res = utimensat(AT_FDCWD, u8path, times, flags);
+#else
+    errno = -EINVAL;
+    if (integerp(atimens) || integerp(mtimens)) {
+      struct timeval times[2];
+      times[0].tv_sec = c_time(atime);
+      times[0].tv_usec = c_long(trunc(atimens, num_fast(1000)), self);
+      times[1].tv_sec = c_time(mtime);
+      times[1].tv_usec = c_long(trunc(mtimens, num_fast(1000)), self);
+      if (symlink_nofollow) {
+#if HAVE_LUTIMES
+        res = lutimes(u8path, times);
+#endif
+      } else {
+#if HAVE_UTIMES
+        res = utimes(u8path, times);
+#elif HAVE_UTIME
+        struct utimbuf utb;
+        utb.actime = times[0].tv_sec;
+        utb.modtime = times[1].tv_sec;
+        res = utime(u8path, &utb);
+#endif
+      }
+    }
+#endif
+    free(u8path);
+  } else {
+#if HAVE_FUTIMENS
+    struct timespec times[2];
+    int fd = get_fd(target, self);
+    times[0].tv_sec = c_time(atime);
+    times[0].tv_nsec = timens(atimens, self);
+    times[1].tv_sec = c_time(mtime);
+    times[1].tv_nsec = timens(mtimens, self);
+    res = futimens(fd, times);
+#elif HAVE_FUTIMES
+    struct timeval times[2];
+    int fd = get_fd(target, self);
+    errno = -EINVAL;
+    if (integerp(atimens) || integerp(mtimens)) {
+      times[0].tv_sec = c_time(atime);
+      times[0].tv_usec = c_long(trunc(atimens, num_fast(1000)), self);
+      times[1].tv_sec = c_time(mtime);
+      times[1].tv_usec = c_long(trunc(mtimens, num_fast(1000)), self);
+      res = futimes(fd, times);
+    }
+#else
+    errno = -EINVAL;
+#endif
+  }
+
+  if (res == -1) {
+    int eno = errno;
+    uw_throwf(errno_to_file_error(eno), lit("~s: failed: ~d/~s"),
+              self, num(eno), string_utf8(strerror(eno)), nao);
+  }
+
+  return t;
+}
+
+static val wrap_utimes(val target, val atime, val atimens,
+                       val mtime, val mtimens)
+{
+  val self = lit("utimes");
+  return do_utimes(target, atime, atimens, mtime, mtimens, nil, self);
+}
+
+static val wrap_lutimes(val target, val atime, val atimens,
+                        val mtime, val mtimens)
+{
+  val self = lit("lutimes");
+  return do_utimes(target, atime, atimens, mtime, mtimens, t, self);
+}
+
+#endif
+
+
 #if HAVE_SYS_STAT
 
 static val umask_wrap(val mask)
@@ -2018,6 +2125,11 @@ void sysif_init(void)
   reg_fun(intern(lit("fcntl"), user_package), func_n3o(fcntl_wrap, 2));
 #endif
 
+#if HAVE_FILE_STAMP_CHANGE
+  reg_fun(intern(lit("utimes"), user_package), func_n5(wrap_utimes));
+  reg_fun(intern(lit("lutimes"), user_package), func_n5(wrap_lutimes));
+#endif
+
   reg_fun(intern(lit("stat"), user_package), func_n1(stat_wrap));
   reg_fun(intern(lit("lstat"), user_package), func_n1(lstat_wrap));
   reg_fun(intern(lit("fstat"), user_package), func_n1(fstat_wrap));
diff --git a/txr.1 b/txr.1
index 6feee618..950b3eac 100644
--- a/txr.1
+++ b/txr.1
@@ -57982,6 +57982,111 @@ function.
                            s-iroth))
 .brev
 
+.coNP Functions @ utimes and @ lutimes
+.synb
+.mets (utimes < target < atime-s < atime-ns < mtime-s << mtime-ns )
+.mets (lutimes < target < atime-s < atime-ns < mtime-s << mtime-ns )
+.syne
+.desc
+The functions
+.code utimes
+and
+.code lutimes
+change the access and modification timestamps of a file indicated by the
+.meta target
+argument.
+
+The difference between the two functions is that if
+.meta target
+is the path name of a symbolic link, then
+.code lutimes
+operates on the symbolic link itself, whereas
+.code utimes
+resolves the symbolic link.
+
+Note: the full, complete functionality of these functions requires the
+platform to provide the POSIX functions
+.code futimens
+and
+.code utimensat
+functions.  If these functions are not available, then other functions are
+relied on, with some reductions in functionality, that are documented below.
+
+The
+.meta target
+argument specifies the file to operate on. It may be an integer file descriptor,
+an open stream, or a character string representing a path name.
+
+The
+.meta atime-s
+and
+.meta mtime-s
+parameters specify the whole seconds part of the new access and modification
+times, expressed as seconds since the epoch.
+
+The
+.meta atime-ns
+and
+.meta mtime-ns
+parameters specify the fractional part of the access and modification
+times, expressed in nanoseconds. If an integer argument is given to these
+parameters, it must lie in the range 0 to 999999999, or else the symbols
+.code nil
+or
+.code t
+may be passed as arguments.
+
+If the symbol
+.code nil
+is passed as the nanoseconds part of the access or modification time,
+then the access or modification time, respectively, shall not be modified
+by the operation. The corresponding seconds argument is ignored.
+
+If the symbol
+.code t
+is passed as the nanoseconds part of the access or modification time,
+then the access or modification time, respectively, shall be obtained
+from the current system time. The corresponding seconds argument is ignored.
+
+If the
+.code utimensat
+and
+.code futimens
+functions are not available from the host system, then the above
+.code nil
+and
+.code t
+convention in the nanoseconds arguments is not supported; the function
+will fail by throwing an exception if an attempt is made to pass these
+arguments.
+
+If the
+.code utimensat
+and
+.code futimens
+functions are not available from the host system, then operating on
+a symbolic link with
+.code lutimes
+is only possible if the system provides the
+.code lutimes
+C library function, otherwise the operation fails by throwing an exception
+(if given a path argument for
+.metn target ,
+even if that path isn't a symbolic link).
+
+If the implementation falls back on the
+.codn utimes ,
+.codn futimes ,
+and
+.code lutimes
+functions, then the nanoseconds arguments are truncated to microsecond
+precision.
+
+If the implementation falls back on
+.codn utime ,
+then the nanoseconds arguments are ignored; the times are effectively
+truncated to whole seconds.
+
 .coNP Function @ mknod
 .synb
 .mets (mknod < path < mode <> [ dev ])