On Wed, May 10, 2017 at 10:51:52PM +0200, Peter Bex wrote: > 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.
A similar thing applies to change-file-owner and change-file-mode: - The "setters" change-file-owner and change-file-mode are in (chicken file), whereas the "getters" file-owner and file-permissions are in (chicken file posix) - The getters and setters aren't named similarly: it makes more sense for change-file-mode to be named set-file-permissions! and for change-file-owner to be named set-file-owner! - The "file-permissions" getter returns the raw _st_mode value, which also includes the file type. It's better to mask out the file type, so that it's symmetric with the values accepted by the setter. - The setter for file ownership sets both the uid AND the gid. If we want to make this consistent with the getter, it makes more sense to set only the uid. - While we can set the gid, we can't get it; "file-group" is missing. - The getters all accept strings, ports and file descriptors; the setter only accepts a string. The attached patches make all of this more consistent. Cheers, Peter
From 64ecffb31e22c1513c6bbfae7551452efbe4a868 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 13 May 2017 20:51:14 +0200
Subject: [PATCH 1/3] Move common change-file-mode and file-*-access? code to
posix-common
The only difference is that in Windows, we don't have [RWX]_OK, but
that we can easily define them in an #ifdef check.
---
posix-common.scm | 37 +++++++++++++++++++++++++++++++++++++
posixunix.scm | 25 -------------------------
posixwin.scm | 30 ------------------------------
3 files changed, 37 insertions(+), 55 deletions(-)
diff --git a/posix-common.scm b/posix-common.scm
index e3e6739..89eeec2 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -47,6 +47,17 @@ static C_TLS struct stat C_statbuf;
# define S_IFSOCK 0140000
#endif
+/* For Windows */
+#ifndef R_OK
+#define R_OK 2
+#endif
+#ifndef W_OK
+#define W_OK 4
+#endif
+#ifndef X_OK
+#define X_OK 2
+#endif
+
#define cpy_tmvec_to_tmstc08(ptm, v) \
((ptm)->tm_sec = C_unfix(C_block_item((v), 0)), \
(ptm)->tm_min = C_unfix(C_block_item((v), 1)), \
@@ -311,6 +322,32 @@ EOF
(eq? 'directory (file-type file #f #f)))
+(define change-file-mode
+ (lambda (fname m)
+ (##sys#check-string fname 'change-file-mode)
+ (##sys#check-fixnum m 'change-file-mode)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname 'change-file-mode) m) 0)
+ (posix-error #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
+
+(define file-read-access?)
+(define file-write-access?)
+(define file-execute-access?)
+
+(define-foreign-variable _r_ok int "R_OK")
+(define-foreign-variable _w_ok int "W_OK")
+(define-foreign-variable _x_ok int "X_OK")
+
+(let ()
+ (define (check filename acc loc)
+ (##sys#check-string filename loc)
+ (let ((r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))))
+ (unless r (##sys#update-errno))
+ r) )
+ (set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
+ (set! file-write-access? (lambda (filename) (check filename _w_ok 'file-write-access?)))
+ (set! file-execute-access? (lambda (filename) (check filename _x_ok 'file-execute-access?))) )
+
+
;;; File position access:
(define-foreign-variable _seek_set int "SEEK_SET")
diff --git a/posixunix.scm b/posixunix.scm
index 40b5b75..6b01857 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -911,13 +911,6 @@ EOF
;;; Permissions and owners:
-(define change-file-mode
- (lambda (fname m)
- (##sys#check-string fname 'change-file-mode)
- (##sys#check-fixnum m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname 'change-file-mode) m) 0)
- (posix-error #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
-
(define change-file-owner
(lambda (fn uid gid)
(##sys#check-string fn 'change-file-owner)
@@ -926,24 +919,6 @@ EOF
(when (fx< (##core#inline "C_chown" (##sys#make-c-string fn 'change-file-owner) uid gid) 0)
(posix-error #:file-error 'change-file-owner "cannot change file owner" fn uid gid) ) ) )
-(define-foreign-variable _r_ok int "R_OK")
-(define-foreign-variable _w_ok int "W_OK")
-(define-foreign-variable _x_ok int "X_OK")
-
-(define file-read-access?)
-(define file-write-access?)
-(define file-execute-access?)
-
-(let ()
- (define (check filename acc loc)
- (##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))])
- (unless r (##sys#update-errno))
- r) )
- (set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
- (set! file-write-access? (lambda (filename) (check filename _w_ok 'file-write-access?)))
- (set! file-execute-access? (lambda (filename) (check filename _x_ok 'file-execute-access?))) )
-
(define (create-session)
(let ([a (##core#inline "C_setsid" #f)])
(when (fx< a 0)
diff --git a/posixwin.scm b/posixwin.scm
index 02fc62f..bd38fb7 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -987,36 +987,6 @@ EOF
signal/segv signal/abrt signal/break))
-;;; Permissions and owners:
-
-(define change-file-mode
- (lambda (fname m)
- (##sys#check-string fname 'change-file-mode)
- (##sys#check-fixnum m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname 'change-file-mode) m) 0)
- (##sys#update-errno)
- (##sys#signal-hook #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
-
-(define-foreign-variable _r_ok int "2")
-(define-foreign-variable _w_ok int "4")
-(define-foreign-variable _x_ok int "2")
-
-(define file-read-access?)
-(define file-write-access?)
-(define file-execute-access?)
-
-(let ()
- (define (check filename acc loc)
- (##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))])
- (unless r (##sys#update-errno))
- r) )
- (set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
- (set! file-write-access? (lambda (filename) (check filename _w_ok 'file-write-access?)))
- (set! file-execute-access? (lambda (filename) (check filename _x_ok 'file-execute-access?))) )
-
-(define-foreign-variable _filename_max int "FILENAME_MAX")
-
;;; Using file-descriptors:
(define-foreign-variable _stdin_fileno int "0")
--
2.1.4
From edec05f131c0377f6c9f62fd1eee2b028e8c5eca Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 13 May 2017 20:53:45 +0200
Subject: [PATCH 2/3] Rename change-file-mode to set-file-permissions! for
consistency
This includes a SRFI-17 setter on file-permissions as well. The new
setter is moved from (chicken file) to (chicken file posix), because
the getter lives in that module too.
file-permissions is changed to return just the permissions, so that
the values used by setter and getter are symmetric.
Before, the getter would also return the file type from stat(), as in
it returned the raw value of st_mode. This makes no sense for the
name "file-permissions", I'd expect only the permissions.
Note that this doesn't remove any functionality: we can still get the
file type or any of the special bits using other getters, and if we
want we can still use "file-stat" to get the raw underlying values.
Finally, the setter is modified to match the getter in accepting both
a string and a fd or port, using fchmod. On Windows, fchmod is
implemented using GetFinalPathNameByHandle() followed by chmod(). To
make this work, the Windows API version has been bumped to Vista.
It's probably better to officially require Windows 7 or newer, though.
---
chicken.h | 4 ++--
file.scm | 1 -
posix-common.scm | 33 +++++++++++++++++++++++----------
posix.scm | 3 ++-
posixunix.scm | 6 ++++--
posixwin.scm | 29 +++++++++++++++++++++++++++--
types.db | 2 +-
7 files changed, 59 insertions(+), 19 deletions(-)
diff --git a/chicken.h b/chicken.h
index d03109a..2fd696c 100644
--- a/chicken.h
+++ b/chicken.h
@@ -110,10 +110,10 @@
# define C_LLP
#endif
-/* Declare base Win32 version for access to Timer Queue functions. */
+/* Declare base Win32 version: we require Vista or later */
#ifdef __MINGW32__
-# define _WIN32_WINNT 0x0500
+# define _WIN32_WINNT 0x0600
#endif
diff --git a/file.scm b/file.scm
index 4eef581..6414109 100644
--- a/file.scm
+++ b/file.scm
@@ -41,7 +41,6 @@
(module chicken.file
(block-device?
- change-file-mode
change-file-owner
character-device?
create-directory
diff --git a/posix-common.scm b/posix-common.scm
index 89eeec2..04e78e6 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -40,6 +40,7 @@ int C_not_implemented() { return -1; }
static C_TLS struct stat C_statbuf;
#define C_stat_type (C_statbuf.st_mode & S_IFMT)
+#define C_stat_perm (C_statbuf.st_mode & ~S_IFMT)
#define C_stat(fn) C_fix(stat((char *)C_data_pointer(fn), &C_statbuf))
#define C_fstat(f) C_fix(fstat(C_unfix(f), &C_statbuf))
@@ -253,7 +254,7 @@ EOF
(##core#inline "C_stat" path) ) ) )
(else
(##sys#signal-hook
- #:type-error loc "bad argument type - not a fixnum or string" file)) ) ) )
+ #:type-error loc "bad argument type - not a fixnum, port or string" file)) ) ) )
(if (fx< r 0)
(if err
(posix-error #:file-error loc "cannot access file" file)
@@ -282,12 +283,32 @@ EOF
"cannot set file modification-time" f t))))
"(file-modification-time f)"))
+(define (set-file-permissions! f p)
+ (##sys#check-fixnum p 'set-file-permissions!)
+ (let ((r (cond ((fixnum? f) (##core#inline "C_fchmod" f p))
+ ((port? f) (##core#inline "C_fchmod" (port->fileno f) p))
+ ((string? f)
+ (##core#inline "C_chmod"
+ (##sys#make-c-string f 'set-file-permissions!) p))
+ (else
+ (##sys#signal-hook
+ #:type-error 'file-permissions
+ "bad argument type - not a fixnum, port or string" f)) ) ) )
+ (when (fx< r 0)
+ (posix-error #:file-error 'set-file-permissions! "cannot change file permissions" f p) ) ))
+
(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 (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)
+(define file-permissions
+ (getter-with-setter
+ (lambda (f)
+ (##sys#stat f #f #t 'file-permissions)
+ (foreign-value "C_stat_perm" unsigned-int))
+ set-file-permissions! ))
+
(define (file-type file #!optional link (err #t))
(and (##sys#stat file link err 'file-type)
(select (foreign-value "C_stat_type" unsigned-int)
@@ -321,14 +342,6 @@ EOF
(define (directory? file)
(eq? 'directory (file-type file #f #f)))
-
-(define change-file-mode
- (lambda (fname m)
- (##sys#check-string fname 'change-file-mode)
- (##sys#check-fixnum m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname 'change-file-mode) m) 0)
- (posix-error #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
-
(define file-read-access?)
(define file-write-access?)
(define file-execute-access?)
diff --git a/posix.scm b/posix.scm
index 96c932a..bcfd052 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-permissions!
+ set-file-position!)
(import chicken chicken.posix))
(module chicken.time.posix
diff --git a/posixunix.scm b/posixunix.scm
index 6b01857..0fb52a1 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -32,7 +32,7 @@
(module chicken.posix
(emergency-exit call-with-input-pipe call-with-output-pipe change-directory
- change-directory* change-file-mode change-file-owner close-input-pipe
+ change-directory* change-file-owner close-input-pipe
close-output-pipe create-directory create-fifo create-pipe
create-session create-symbolic-link current-directory
current-effective-group-id current-effective-user-id
@@ -43,7 +43,8 @@
fifo? file-access-time file-change-time
file-creation-mode file-close file-control file-execute-access?
file-link file-lock file-lock/blocking file-mkstemp
- file-modification-time file-open file-owner file-permissions
+ file-modification-time file-open file-owner
+ file-permissions set-file-permissions!
file-position set-file-position! file-read file-read-access?
file-select file-size file-stat file-test-lock file-truncate
file-type file-unlock file-write file-write-access? fileno/stderr
@@ -186,6 +187,7 @@ static C_TLS struct stat C_statbuf;
#define C_getegid getegid
#define C_chown(fn, u, g) C_fix(chown(C_data_pointer(fn), C_unfix(u), C_unfix(g)))
#define C_chmod(fn, m) C_fix(chmod(C_data_pointer(fn), C_unfix(m)))
+#define C_fchmod(fd, m) C_fix(fchmod(C_unfix(fd), C_unfix(m)))
#define C_setuid(id) C_fix(setuid(C_unfix(id)))
#define C_setgid(id) C_fix(setgid(C_unfix(id)))
#define C_seteuid(id) C_fix(seteuid(C_unfix(id)))
diff --git a/posixwin.scm b/posixwin.scm
index bd38fb7..4683585 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -73,7 +73,9 @@
#include <io.h>
#include <process.h>
#include <signal.h>
+#include <stdio.h>
#include <utime.h>
+#include <windows.h>
#include <winsock2.h>
#define PIPE_BUF 512
@@ -306,6 +308,28 @@ set_last_errno()
return 0;
}
+static C_word C_fchmod(C_word fd, C_word m)
+{
+ TCHAR path[MAX_PATH];
+ DWORD result;
+ HANDLE fh = (HANDLE)_get_osfhandle(C_unfix(fd));
+
+ if (fh == INVALID_HANDLE_VALUE) {
+ set_last_errno();
+ return C_fix(-1);
+ }
+
+ result = GetFinalPathNameByHandle(fh, path, MAX_PATH, VOLUME_NAME_DOS);
+ if (result == 0) {
+ set_last_errno();
+ return C_fix(-1);
+ } else if (result >= MAX_PATH) { /* Shouldn't happen */
+ errno = ENOMEM; /* For lack of anything better */
+ return C_fix(-1);
+ }
+ return C_fix(chmod(path, C_unfix(m)));
+}
+
static int C_fcall
process_wait(C_word h, C_word t)
{
@@ -627,7 +651,7 @@ EOF
(module chicken.posix
(emergency-exit call-with-input-pipe call-with-output-pipe change-directory
- change-directory* change-file-mode change-file-owner close-input-pipe
+ change-directory* change-file-owner close-input-pipe
close-output-pipe create-directory create-fifo create-pipe
create-session create-symbolic-link current-directory
current-effective-group-id current-effective-user-id
@@ -638,7 +662,8 @@ EOF
fifo? file-access-time file-change-time
file-creation-mode file-close file-control file-execute-access?
file-link file-lock file-lock/blocking file-mkstemp
- file-modification-time file-open file-owner file-permissions
+ file-modification-time file-open file-owner
+ file-permissions set-file-permissions!
file-position set-file-position! file-read file-read-access?
file-select file-size file-stat file-test-lock file-truncate
file-type file-unlock file-write file-write-access? fileno/stderr
diff --git a/types.db b/types.db
index 13b911b..2d4b647 100644
--- a/types.db
+++ b/types.db
@@ -1922,7 +1922,6 @@
(chicken.posix#call-with-output-pipe (#(procedure #:enforce) chicken.posix#call-with-output-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
(chicken.posix#change-directory (#(procedure #:clean #:enforce) chicken.posix#change-directory (string) string))
(chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum))
-(chicken.posix#change-file-mode (#(procedure #:clean #:enforce) chicken.posix#change-file-mode (string fixnum) undefined))
(chicken.posix#change-file-owner (#(procedure #:clean #:enforce) chicken.posix#change-file-owner (string fixnum fixnum) undefined))
(chicken.posix#close-input-pipe (#(procedure #:clean #:enforce) chicken.posix#close-input-pipe (input-port) fixnum))
(chicken.posix#close-output-pipe (#(procedure #:clean #:enforce) chicken.posix#close-output-pipe (output-port) fixnum))
@@ -2045,6 +2044,7 @@
(chicken.posix#seek/set fixnum)
(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-permissions! (#(procedure #:clean #:enforce) chicken.posix#set-file-permissions! ((or string fixnum port) 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-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))
--
2.1.4
From 7c001b45f7950a6a80ec523558720ba4acb3e4e5 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sun, 14 May 2017 12:27:05 +0200
Subject: [PATCH 3/3] Split change-file-owner into set-file-{owner,group}!, add
file-group
An accessor for the file's group ownership was missing, so we add
this.
Just like for permissions, it makes more sense to have a symmetric set
of getter & setter procedures, with a matching SRFI-17 setter, so the
setter is renamed and split in two. This is also moved from
(chicken file) to (chicken file posix), where it belongs.
We also use fchmod() if a port or FD is passed in to make it
consistent with the getter.
---
file.scm | 1 -
posix-common.scm | 15 ++++++++++++++-
posix.scm | 15 ++++++++-------
posixunix.scm | 33 +++++++++++++++++++++------------
posixwin.scm | 13 +++++++++----
types.db | 4 +++-
6 files changed, 55 insertions(+), 26 deletions(-)
diff --git a/file.scm b/file.scm
index 6414109..d18aa37 100644
--- a/file.scm
+++ b/file.scm
@@ -41,7 +41,6 @@
(module chicken.file
(block-device?
- change-file-owner
character-device?
create-directory
create-fifo
diff --git a/posix-common.scm b/posix-common.scm
index 04e78e6..5023efa 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -299,9 +299,22 @@ EOF
(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 (file-owner f) (##sys#stat f #f #t 'file-owner) _stat_st_uid)
(define (file-size f) (##sys#stat f #f #t 'file-size) _stat_st_size)
+(define (set-file-owner! f uid)
+ (chown 'set-file-owner! f uid -1))
+(define (set-file-group! f gid)
+ (chown 'set-file-group! f -1 gid))
+
+(define file-owner
+ (getter-with-setter
+ (lambda (f) (##sys#stat f #f #t 'file-owner) _stat_st_uid)
+ set-file-owner!) )
+(define file-group
+ (getter-with-setter
+ (lambda (f) (##sys#stat f #f #t 'file-group) _stat_st_gid)
+ set-file-group!) )
+
(define file-permissions
(getter-with-setter
(lambda (f)
diff --git a/posix.scm b/posix.scm
index bcfd052..f4097c3 100644
--- a/posix.scm
+++ b/posix.scm
@@ -91,18 +91,19 @@
(module chicken.file.posix
(duplicate-fileno fcntl/dupfd fcntl/getfd fcntl/getfl fcntl/setfd
fcntl/setfl file-access-time file-change-time file-modification-time
- file-close file-control file-creation-mode file-link file-lock
- file-lock/blocking file-mkstemp file-open file-owner file-permissions
- file-position file-read file-select file-size file-stat
- file-test-lock file-truncate file-unlock file-write fileno/stderr
- fileno/stdin fileno/stdout open-input-file* open-output-file*
+ file-close file-control file-creation-mode file-group file-link
+ file-lock file-lock/blocking file-mkstemp file-open file-owner
+ file-permissions file-position file-read file-select file-size
+ file-stat file-test-lock file-truncate file-unlock file-write
+ fileno/stderr fileno/stdin fileno/stdout
+ open-input-file* open-output-file*
open/append open/binary open/creat open/excl open/fsync open/noctty
open/nonblock open/rdonly open/rdwr open/read open/sync open/text
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-permissions!
- set-file-position!)
+ port->fileno seek/cur seek/end seek/set set-file-group!
+ set-file-owner! set-file-permissions! set-file-position!)
(import chicken chicken.posix))
(module chicken.time.posix
diff --git a/posixunix.scm b/posixunix.scm
index 0fb52a1..439fe09 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -32,7 +32,7 @@
(module chicken.posix
(emergency-exit call-with-input-pipe call-with-output-pipe change-directory
- change-directory* change-file-owner close-input-pipe
+ change-directory* close-input-pipe
close-output-pipe create-directory create-fifo create-pipe
create-session create-symbolic-link current-directory
current-effective-group-id current-effective-user-id
@@ -43,8 +43,8 @@
fifo? file-access-time file-change-time
file-creation-mode file-close file-control file-execute-access?
file-link file-lock file-lock/blocking file-mkstemp
- file-modification-time file-open file-owner
- file-permissions set-file-permissions!
+ file-modification-time file-open file-owner set-file-owner!
+ file-group set-file-group! file-permissions set-file-permissions!
file-position set-file-position! file-read file-read-access?
file-select file-size file-stat file-test-lock file-truncate
file-type file-unlock file-write file-write-access? fileno/stderr
@@ -186,6 +186,7 @@ static C_TLS struct stat C_statbuf;
#define C_geteuid geteuid
#define C_getegid getegid
#define C_chown(fn, u, g) C_fix(chown(C_data_pointer(fn), C_unfix(u), C_unfix(g)))
+#define C_fchown(fd, u, g) C_fix(fchown(C_unfix(fd), C_unfix(u), C_unfix(g)))
#define C_chmod(fn, m) C_fix(chmod(C_data_pointer(fn), C_unfix(m)))
#define C_fchmod(fd, m) C_fix(fchmod(C_unfix(fd), C_unfix(m)))
#define C_setuid(id) C_fix(setuid(C_unfix(id)))
@@ -911,15 +912,23 @@ EOF
(define (current-effective-user-name)
(car (user-information (current-effective-user-id))) )
-;;; Permissions and owners:
-
-(define change-file-owner
- (lambda (fn uid gid)
- (##sys#check-string fn 'change-file-owner)
- (##sys#check-fixnum uid 'change-file-owner)
- (##sys#check-fixnum gid 'change-file-owner)
- (when (fx< (##core#inline "C_chown" (##sys#make-c-string fn 'change-file-owner) uid gid) 0)
- (posix-error #:file-error 'change-file-owner "cannot change file owner" fn uid gid) ) ) )
+(define chown
+ (lambda (loc f uid gid)
+ (##sys#check-fixnum uid loc)
+ (##sys#check-fixnum gid loc)
+ (let ((r (cond
+ ((port? f)
+ (##core#inline "C_fchown" (port->fileno f) uid gid))
+ ((fixnum? f)
+ (##core#inline "C_fchown" f uid gid))
+ ((string? f)
+ (##core#inline "C_chown"
+ (##sys#make-c-string f loc) uid gid))
+ (else (##sys#signal-hook
+ #:type-error loc
+ "bad argument type - not a fixnum, port or string" f)))))
+ (when (fx< r 0)
+ (posix-error #:file-error loc "cannot change file owner" f uid gid) )) ) )
(define (create-session)
(let ([a (##core#inline "C_setsid" #f)])
diff --git a/posixwin.scm b/posixwin.scm
index 4683585..f135b52 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -651,7 +651,7 @@ EOF
(module chicken.posix
(emergency-exit call-with-input-pipe call-with-output-pipe change-directory
- change-directory* change-file-owner close-input-pipe
+ change-directory* close-input-pipe
close-output-pipe create-directory create-fifo create-pipe
create-session create-symbolic-link current-directory
current-effective-group-id current-effective-user-id
@@ -662,8 +662,8 @@ EOF
fifo? file-access-time file-change-time
file-creation-mode file-close file-control file-execute-access?
file-link file-lock file-lock/blocking file-mkstemp
- file-modification-time file-open file-owner
- file-permissions set-file-permissions!
+ file-modification-time file-open file-owner set-file-owner!
+ file-group set-file-group! file-permissions set-file-permissions!
file-position set-file-position! file-read file-read-access?
file-select file-size file-stat file-test-lock file-truncate
file-type file-unlock file-write file-write-access? fileno/stderr
@@ -1316,8 +1316,10 @@ EOF
(define (?name . _)
(error '?name (##core#immutable '"this function is not available on this platform")) ) ] ) )
+(define (chown loc . _)
+ (error loc (##core#immutable '"this function is not available on this platform")))
+
(define-unimplemented change-directory*)
-(define-unimplemented change-file-owner)
(define-unimplemented create-fifo)
(define-unimplemented create-session)
(define-unimplemented create-symbolic-link)
@@ -1340,6 +1342,9 @@ EOF
(define-unimplemented process-signal)
(define-unimplemented read-symbolic-link)
(define-unimplemented set-alarm!)
+;; Handled by chown above
+;(define-unimplemented set-file-group!)
+;(define-unimplemented set-file-owner!)
(define-unimplemented set-group-id!)
(define-unimplemented set-process-group-id!)
(define-unimplemented set-root-directory!)
diff --git a/types.db b/types.db
index 2d4b647..3d2adc4 100644
--- a/types.db
+++ b/types.db
@@ -1922,7 +1922,6 @@
(chicken.posix#call-with-output-pipe (#(procedure #:enforce) chicken.posix#call-with-output-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
(chicken.posix#change-directory (#(procedure #:clean #:enforce) chicken.posix#change-directory (string) string))
(chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum))
-(chicken.posix#change-file-owner (#(procedure #:clean #:enforce) chicken.posix#change-file-owner (string fixnum fixnum) undefined))
(chicken.posix#close-input-pipe (#(procedure #:clean #:enforce) chicken.posix#close-input-pipe (input-port) fixnum))
(chicken.posix#close-output-pipe (#(procedure #:clean #:enforce) chicken.posix#close-output-pipe (output-port) fixnum))
(chicken.posix#create-directory (#(procedure #:clean #:enforce) chicken.posix#create-directory (string #!optional *) string))
@@ -1963,6 +1962,7 @@
(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-open (#(procedure #:clean #:enforce) chicken.posix#file-open (string fixnum #!optional fixnum) fixnum))
+(chicken.posix#file-group (#(procedure #:clean #:enforce) chicken.posix#file-owner ((or string 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))
(chicken.posix#file-position (#(procedure #:clean #:enforce) chicken.posix#file-position ((or port fixnum)) integer))
@@ -2044,6 +2044,8 @@
(chicken.posix#seek/set fixnum)
(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-group! (#(procedure #:clean #:enforce) chicken.posix#set-file-group! ((or string fixnum port) fixnum) undefined))
+(chicken.posix#set-file-owner! (#(procedure #:clean #:enforce) chicken.posix#set-file-owner! ((or string fixnum port) fixnum) undefined))
(chicken.posix#set-file-permissions! (#(procedure #:clean #:enforce) chicken.posix#set-file-permissions! ((or string fixnum port) 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-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined))
--
2.1.4
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
