mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
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.
This commit is contained in:
Andy Wingo
parent
f826a8864a
commit
06bfe276c8
7 changed files with 120 additions and 23 deletions
|
|
@ -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],,,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue