Hi all, While working on the docs for (chicken file posix), I noticed some discrepancies:
- file-access-time and file-change-time have no associated setter,
but file-modification-time does.
- The setter for file-modification-time sets both mtime AND atime,
even though (set! (file-modification-time f) x) implies that
we're setting ONLY the mtime.
- The getters all accept strings, ports and file descriptors; the
setter only accepts a string.
The first patch improves the situation by getting rid of the generalised
setter, and opting for a simpler approach. There's no (easy) way to
influence the file-change-time, so adding setters to all of them and
making the setter for file-modification-time only change the modification
time is a no-go, so I decided to just add a set-file-times! procedure.
The name of this procedure is taken from MIT Scheme / SCSH. SCSH
doesn't add a bang at the end, but we do for our other set-* procedures
in posix.scm, so I decided to go with the MIT convention.
Other Schemes have kind of inconsistent names like "touch-file"
(Gauche), utime (Guile), or some ridiculously long ones like
"file-last-access-and-modification-times-set!" (Gambit) and
"file-or-directory-modify-seconds" (Racket). Chez doesn't appear
to have anything to change the timestamps (though I really like their
nice consistent naming for the accessors and whether to follow links;
perhaps we can adopt that too?).
For maximum compatibility with both MIT and SCSH, #f means to keep
the original timestamp, but omitting both means to set the timestamp
to the current time. If only one argument is supplied, the second is
assumed to be the same (this keeps it as conveniently like the old
setter). To make it keep the original timestamp, I added an
lstat() call to set_file_mtime; utime() also follows symlinks.
So, to clarify:
- (set-file-times! "file") is a simple "touch" of the file: both times
are set to the current timestamp.
- (set-file-times! "file" 0) will set both atime and mtime to the epoch,
just like (set! (file-modification-time "file") 0) in the original
situation would do.
- (set-file-times! "file" #f 0) will keep the atime unchanged, but set
the mtime to the epoch.
- (set-file-times! "file" 0 #f) will set the atime to the epoch and keep
the mtime unchanged.
- (set-file-times! "file" #f) will not change either timestamp.
- All of the above _will_ (necessarily) touch the ctime.
Finally, the second patch is a simple improvement of the types database
to reflect the fact that the file-*-time accessors all also accept a
port, in addition to a string or fixnum.
We could consider extending set-file-times! to accept these too, but
that's a bit trickier, as there's AFAIK no portable way to change the
times on an FD.
Cheers,
Peter
From 134ff4ce1d4af3ad416874cfada02df485496049 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Wed, 10 May 2017 22:06:13 +0200
Subject: [PATCH] Replace file-modification-time setter with set-file-times!
procedure
This reduces several inconsistencies and any resulting confusion:
- file-access-time and file-change-time have no associated setter
- The setter for file-modification-time sets both mtime AND ctime
- The getters all accept strings, ports and file descriptors; the
setter only accepts a string.
While at it, the new procedure also makes it possible to omit the
timestamps (in which case the current time is assumed), supply only
one (in which case the old behaviour stays: we set both timestamps to
the supplied time) or both (in which case you can set either to a
different value). If #f is supplied, the specific time is unchanged.
This behaviour is maximally compatible with the "specify both or none"
behaviour from SCSH's "set-file-times" procedure (note the missing
bang though), and with MIT Scheme's "set-file-times!" procedure where
passing in #f means to avoid modifying the corresponding time.
---
posix-common.scm | 28 ++++++++++++++--------------
posix.scm | 3 ++-
posixunix.scm | 21 ++++++++++++++++++---
posixwin.scm | 21 ++++++++++++++++++---
types.db | 1 +
5 files changed, 53 insertions(+), 21 deletions(-)
diff --git a/posix-common.scm b/posix-common.scm
index e3e6739..3475dda 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -257,22 +257,22 @@ EOF
_stat_st_dev _stat_st_rdev
_stat_st_blksize _stat_st_blocks) )
-(define file-modification-time
- (getter-with-setter
- (lambda (f)
- (##sys#stat f #f #t 'file-modification-time) _stat_st_mtime)
- (lambda (f t)
- (##sys#check-exact-integer t 'set-file-modification-time)
- (let ((r ((foreign-lambda int "set_file_mtime" c-string scheme-object)
- f t)))
- (when (fx< r 0)
- (posix-error
- #:file-error 'set-file-modification-time
- "cannot set file modification-time" f t))))
- "(file-modification-time f)"))
-
+(define (file-modification-time f) (##sys#stat f #f #t 'file-modification-time) _stat_st_mtime)
(define (file-access-time f) (##sys#stat f #f #t 'file-access-time) _stat_st_atime)
(define (file-change-time f) (##sys#stat f #f #t 'file-change-time) _stat_st_ctime)
+
+(define (set-file-times! f . rest)
+ (let-optionals* rest ((atime (current-seconds)) (mtime atime))
+ (when atime (##sys#check-exact-integer atime 'set-file-times!))
+ (when mtime (##sys#check-exact-integer mtime 'set-file-times!))
+ (let ((r ((foreign-lambda int "set_file_mtime"
+ c-string scheme-object scheme-object)
+ f atime mtime)))
+ (when (fx< r 0)
+ (apply posix-error
+ #:file-error
+ 'set-file-times! "cannot set file times" f rest)))))
+
(define (file-owner f) (##sys#stat f #f #t 'file-owner) _stat_st_uid)
(define (file-permissions f) (##sys#stat f #f #t 'file-permissions) _stat_st_mode)
(define (file-size f) (##sys#stat f #f #t 'file-size) _stat_st_size)
diff --git a/posix.scm b/posix.scm
index 96c932a..2bc058e 100644
--- a/posix.scm
+++ b/posix.scm
@@ -101,7 +101,8 @@
open/trunc open/write open/wronly perm/irgrp perm/iroth perm/irusr
perm/irwxg perm/irwxo perm/irwxu perm/isgid perm/isuid perm/isvtx
perm/iwgrp perm/iwoth perm/iwusr perm/ixgrp perm/ixoth perm/ixusr
- port->fileno seek/cur seek/end seek/set set-file-position!)
+ port->fileno seek/cur seek/end seek/set set-file-position!
+ set-file-times!)
(import chicken chicken.posix))
(module chicken.time.posix
diff --git a/posixunix.scm b/posixunix.scm
index 40b5b75..3c5df86 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -60,7 +60,7 @@
process-group-id process-run process-signal process-sleep process-wait
read-symbolic-link regular-file? seconds->local-time seconds->string
seconds->utc-time seek/cur seek/end seek/set set-alarm!
- set-buffering-mode! set-root-directory!
+ set-buffering-mode! set-file-times! set-root-directory!
set-signal-handler! set-signal-mask! signal-handler
signal-mask signal-mask! signal-masked? signal-unmask! signal/abrt
signal/alrm signal/break signal/chld signal/cont signal/fpe
@@ -352,11 +352,26 @@ static int get_tty_size(int p, int *rows, int *cols)
}
#endif
-static int set_file_mtime(char *filename, C_word tm)
+static int set_file_mtime(char *filename, C_word atime, C_word mtime)
{
+ struct stat sb;
struct utimbuf tb;
- tb.actime = tb.modtime = C_num_to_int(tm);
+ /* Only lstat if needed */
+ if (atime == C_SCHEME_FALSE || mtime == C_SCHEME_FALSE) {
+ if (lstat(filename, &sb) == -1) return -1;
+ }
+
+ if (atime == C_SCHEME_FALSE) {
+ tb.actime = sb.st_atime;
+ } else {
+ tb.actime = C_num_to_int(atime);
+ }
+ if (mtime == C_SCHEME_FALSE) {
+ tb.modtime = sb.st_mtime;
+ } else {
+ tb.modtime = C_num_to_int(mtime);
+ }
return utime(filename, &tb);
}
diff --git a/posixwin.scm b/posixwin.scm
index 02fc62f..7b549e4 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -612,11 +612,26 @@ C_process(const char * app, const char * cmdlin, const char ** env,
return success;
}
-static int set_file_mtime(char *filename, C_word tm)
+static int set_file_mtime(char *filename, C_word atime, C_word mtime)
{
+ struct stat sb;
struct _utimbuf tb;
- tb.actime = tb.modtime = C_num_to_int(tm);
+ /* Only lstat if needed */
+ if (atime == C_SCHEME_FALSE || mtime == C_SCHEME_FALSE) {
+ if (lstat(filename, &sb) == -1) return -1;
+ }
+
+ if (atime == C_SCHEME_FALSE) {
+ tb.actime = sb.st_atime;
+ } else {
+ tb.actime = C_num_to_int(atime);
+ }
+ if (mtime == C_SCHEME_FALSE) {
+ tb.modtime = sb.st_mtime;
+ } else {
+ tb.modtime = C_num_to_int(mtime);
+ }
return _utime(filename, &tb);
}
EOF
@@ -656,7 +671,7 @@ EOF
process-spawn process-wait read-symbolic-link regular-file?
seconds->local-time seconds->string seconds->utc-time seek/cur
seek/end seek/set set-alarm! set-buffering-mode! set-root-directory!
- set-signal-handler! set-signal-mask! signal-handler
+ set-file-times! set-signal-handler! set-signal-mask! signal-handler
signal-mask signal-mask! signal-masked? signal-unmask! signal/abrt
signal/alrm signal/break signal/chld signal/cont signal/fpe
signal/bus signal/hup signal/ill signal/int signal/io signal/kill
diff --git a/types.db b/types.db
index 13b911b..180cae2 100644
--- a/types.db
+++ b/types.db
@@ -2046,6 +2046,7 @@
(chicken.posix#set-alarm! (#(procedure #:clean #:enforce) chicken.posix#set-alarm! (integer) integer))
(chicken.posix#set-buffering-mode! (#(procedure #:clean #:enforce) chicken.posix#set-buffering-mode! (port symbol #!optional fixnum) undefined))
(chicken.posix#set-file-position! (#(procedure #:clean #:enforce) chicken.posix#set-file-position! ((or port fixnum) integer #!optional fixnum) undefined))
+(chicken.posix#set-file-times! (#(procedure #:clean #:enforce) chicken.posix#set-file-times! (string #!optional (or false integer) (or false integer)) undefined))
(chicken.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined))
(chicken.posix#set-signal-handler! (#(procedure #:clean #:enforce) chicken.posix#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined))
(chicken.posix#set-signal-mask! (#(procedure #:clean #:enforce) chicken.posix#set-signal-mask! ((list-of fixnum)) undefined))
--
2.1.4
From 3fb0a48db1b2b487b734ccb51f65c9d3b5bacce6 Mon Sep 17 00:00:00 2001 From: Peter Bex <pe...@more-magic.net> Date: Wed, 10 May 2017 22:34:04 +0200 Subject: [PATCH 2/2] Add "port" to accepted file timestamp argument types --- types.db | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/types.db b/types.db index 180cae2..30791a9 100644 --- a/types.db +++ b/types.db @@ -1952,8 +1952,8 @@ (chicken.posix#fcntl/getfl fixnum) (chicken.posix#fcntl/setfd fixnum) (chicken.posix#fcntl/setfl fixnum) -(chicken.posix#file-access-time (#(procedure #:clean #:enforce) chicken.posix#file-access-time ((or string fixnum)) integer)) -(chicken.posix#file-change-time (#(procedure #:clean #:enforce) chicken.posix#file-change-time ((or string fixnum)) integer)) +(chicken.posix#file-access-time (#(procedure #:clean #:enforce) chicken.posix#file-access-time ((or string port fixnum)) integer)) +(chicken.posix#file-change-time (#(procedure #:clean #:enforce) chicken.posix#file-change-time ((or string port fixnum)) integer)) (chicken.posix#file-close (#(procedure #:clean #:enforce) chicken.posix#file-close (fixnum) undefined)) (chicken.posix#file-control (#(procedure #:clean #:enforce) chicken.posix#file-control (fixnum fixnum #!optional fixnum) fixnum)) (chicken.posix#file-creation-mode (#(procedure #:clean #:enforce) chicken.posix#file-creation-mode (#!optional fixnum) fixnum)) @@ -1962,7 +1962,7 @@ (chicken.posix#file-lock (#(procedure #:clean #:enforce) chicken.posix#file-lock (port #!optional fixnum integer) (struct lock))) (chicken.posix#file-lock/blocking (#(procedure #:clean #:enforce) chicken.posix#file-lock/blocking (port #!optional fixnum integer) (struct lock))) (chicken.posix#file-mkstemp (#(procedure #:clean #:enforce) chicken.posix#file-mkstemp (string) fixnum string)) -(chicken.posix#file-modification-time (#(procedure #:clean #:enforce) chicken.posix#file-modification-time ((or string fixnum)) integer)) +(chicken.posix#file-modification-time (#(procedure #:clean #:enforce) chicken.posix#file-modification-time ((or string fixnum port)) integer)) (chicken.posix#file-open (#(procedure #:clean #:enforce) chicken.posix#file-open (string fixnum #!optional fixnum) fixnum)) (chicken.posix#file-owner (#(procedure #:clean #:enforce) chicken.posix#file-owner ((or string fixnum)) fixnum)) (chicken.posix#file-permissions (#(procedure #:clean #:enforce) chicken.posix#file-permissions ((or string fixnum)) fixnum)) -- 2.1.4
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
