~ chicken-core (chicken-5) 32c535fe6e7b089865cbbc9ba89d34dda107cc87
commit 32c535fe6e7b089865cbbc9ba89d34dda107cc87
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun May 14 12:27:05 2017 +0200
Commit: Kooda <kooda@upyum.com>
CommitDate: Mon Jun 5 23:08:30 2017 +0200
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.
Signed-off-by: Kooda <kooda@upyum.com>
diff --git a/file.scm b/file.scm
index b85f1cce..c1768afa 100644
--- a/file.scm
+++ b/file.scm
@@ -52,7 +52,6 @@ EOF
(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 b22947f8..23fce65f 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -299,9 +299,22 @@ EOF
#: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-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 026a8595..2e881a65 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! set-file-times!)
+ port->fileno seek/cur seek/end seek/set set-file-group!
+ set-file-owner! set-file-permissions! set-file-position! set-file-times!)
(import chicken chicken.posix))
(module chicken.time.posix
diff --git a/posixunix.scm b/posixunix.scm
index 5381cc02..82cbe742 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
@@ -187,6 +187,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)))
@@ -927,15 +928,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 4f37581a..c6002a15 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -665,7 +665,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
@@ -676,8 +676,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
@@ -1331,8 +1331,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)
@@ -1355,6 +1357,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 ee326de4..2095b9c7 100644
--- a/types.db
+++ b/types.db
@@ -1925,7 +1925,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))
@@ -1966,6 +1965,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 port)) 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))
@@ -2047,6 +2047,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-file-times! (#(procedure #:clean #:enforce) chicken.posix#set-file-times! (string #!optional (or false integer) (or false integer)) undefined))
Trap