>From b362ac2ced9d297583be55a3de7d1f3002c3a676 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Tue, 20 Feb 2018 17:46:50 +1300 Subject: [PATCH 2/2] Move `file-{read,write,execute}-access?' to chicken.file --- file.scm | 32 ++++++++++++++++++++++++++++++++ posix-common.scm | 32 -------------------------------- posix.scm | 6 +++--- posixunix.scm | 1 - posixwin.scm | 1 - types.db | 7 +++---- 6 files changed, 38 insertions(+), 41 deletions(-) diff --git a/file.scm b/file.scm index a720acd6..63969fbd 100644 --- a/file.scm +++ b/file.scm @@ -41,6 +41,19 @@ (foreign-declare #< +#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m))) + +/* 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 C_rmdir(str) C_fix(rmdir(C_c_string(str))) #ifndef _WIN32 @@ -223,6 +236,25 @@ EOF new) +;;; Permissions: + +(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 (test-access filename acc loc) + (##sys#check-string filename loc) + (let ((r (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))) + (or (fx= r 0) + (if (fx= (##sys#update-errno) (foreign-value "EACCES" int)) + #f + (posix-error #:file-error loc "cannot access file" filename))))) + +(define (file-read-access? filename) (test-access filename _r_ok 'file-read-access?)) +(define (file-write-access? filename) (test-access filename _w_ok 'file-write-access?)) +(define (file-execute-access? filename) (test-access filename _x_ok 'file-execute-access?)) + + ;;; Directories: (define (directory #!optional (spec (current-directory)) show-dotfiles?) diff --git a/posix-common.scm b/posix-common.scm index 98ffe85c..d3f1c751 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -44,17 +44,6 @@ 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)), \ @@ -317,27 +306,6 @@ EOF (define (directory? file) (eq? 'directory (file-type file #f #f))) -(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 (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))) - (if (fx= r -1) - (if (fx= (##sys#update-errno) _eacces) - #f - (posix-error #:file-error loc "cannot access file" filename)) - #t))) - (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: diff --git a/posix.scm b/posix.scm index d973f9ec..eb27a30a 100644 --- a/posix.scm +++ b/posix.scm @@ -50,11 +50,11 @@ directory? duplicate-fileno fcntl/dupfd fcntl/getfd fcntl/getfl fcntl/setfd fcntl/setfl fifo? fifo? file-access-time file-change-time file-close file-control file-creation-mode - file-execute-access? file-group file-link file-lock + file-group file-link file-lock file-lock/blocking file-mkstemp file-modification-time file-open - file-owner file-permissions file-position file-read file-read-access? + file-owner file-permissions file-position file-read file-select file-size file-stat file-test-lock file-truncate - file-type file-unlock file-write file-write-access? fileno/stderr + file-type file-unlock file-write fileno/stderr fileno/stdin fileno/stdout local-time->seconds local-timezone-abbreviation open-input-file* open-input-pipe open-output-file* open-output-pipe diff --git a/posixunix.scm b/posixunix.scm index 124c6b6e..7607854d 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -134,7 +134,6 @@ static C_TLS struct stat C_statbuf; #define C_truncate(f, n) C_fix(truncate((char *)C_data_pointer(f), C_num_to_int(n))) #define C_ftruncate(f, n) C_fix(ftruncate(C_unfix(f), C_num_to_int(n))) #define C_alarm alarm -#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m))) #define C_close(fd) C_fix(close(C_unfix(fd))) #define C_umask(m) C_fix(umask(C_unfix(m))) diff --git a/posixwin.scm b/posixwin.scm index 31bcb9f3..d0dad8b8 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -111,7 +111,6 @@ static C_TLS TCHAR C_username[255 + 1] = ""; #define close_pipe(p) C_fix(_pclose(C_port_file(p))) #define C_chmod(fn, m) C_fix(chmod(C_data_pointer(fn), C_unfix(m))) -#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m))) #define C_pipe(d, m) C_fix(_pipe(C_pipefds, PIPE_BUF, C_unfix(m))) #define C_close(fd) C_fix(close(C_unfix(fd))) diff --git a/types.db b/types.db index 050feff1..0e410a67 100644 --- a/types.db +++ b/types.db @@ -1576,7 +1576,9 @@ (chicken.file#find-files (#(procedure #:enforce) chicken.file#find-files (string #!rest) list)) (chicken.file#glob (#(procedure #:clean #:enforce) chicken.file#glob (#!rest string) list)) (chicken.file#rename-file (#(procedure #:clean #:enforce) chicken.file#rename-file (string string) string)) - +(chicken.file#file-read-access? (#(procedure #:clean #:enforce) chicken.file#file-read-access? (string) boolean)) +(chicken.file#file-write-access? (#(procedure #:clean #:enforce) chicken.file#file-write-access? (string) boolean)) +(chicken.file#file-execute-access? (#(procedure #:clean #:enforce) chicken.file#file-execute-access? (string) boolean)) ;; pathname @@ -1953,7 +1955,6 @@ (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)) -(chicken.posix#file-execute-access? (#(procedure #:clean #:enforce) chicken.posix#file-execute-access? (string) boolean)) (chicken.posix#file-link (#(procedure #:clean #:enforce) chicken.posix#file-link (string string) undefined)) (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))) @@ -1965,7 +1966,6 @@ (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)) (chicken.posix#file-read (#(procedure #:clean #:enforce) chicken.posix#file-read (fixnum fixnum #!optional *) list)) -(chicken.posix#file-read-access? (#(procedure #:clean #:enforce) chicken.posix#file-read-access? (string) boolean)) (chicken.posix#file-select (#(procedure #:clean #:enforce) chicken.posix#file-select ((or (list-of fixnum) fixnum false) (or (list-of fixnum) fixnum false) #!optional fixnum) * *)) (chicken.posix#file-size (#(procedure #:clean #:enforce) chicken.posix#file-size ((or string fixnum)) integer)) (chicken.posix#file-stat (#(procedure #:clean #:enforce) chicken.posix#file-stat ((or string fixnum) #!optional *) (vector-of integer))) @@ -1974,7 +1974,6 @@ (chicken.posix#file-type (#(procedure #:clean #:enforce) chicken.posix#file-type ((or string fixnum) #!optional * *) symbol)) (chicken.posix#file-unlock (#(procedure #:clean #:enforce) chicken.posix#file-unlock ((struct lock)) undefined)) (chicken.posix#file-write (#(procedure #:clean #:enforce) chicken.posix#file-write (fixnum * #!optional fixnum) fixnum)) -(chicken.posix#file-write-access? (#(procedure #:clean #:enforce) chicken.posix#file-write-access? (string) boolean)) (chicken.posix#fileno/stderr fixnum) (chicken.posix#fileno/stdin fixnum) (chicken.posix#fileno/stdout fixnum) -- 2.11.0