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, ×, 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)))))))