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