>From 3da0d33d7c4a7a73f5a419a6ea5f28b175898783 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Fri, 2 May 2014 12:47:22 +0200 Subject: [PATCH] Allow negative arguments to set-file-position! for seek/cur. This is done by ignoring the argument altogether, and letting POSIX handle the error instead. Thanks to Seth Alves for reporting the restriction. Also move several duplicated file position accessor procedures from posixwin and posixunix to posix-common. --- NEWS | 6 ++++++ posix-common.scm | 47 ++++++++++++++++++++++++++++++++++++++++ posixunix.scm | 49 ------------------------------------------ posixwin.scm | 63 ------------------------------------------------------ 4 files changed, 53 insertions(+), 112 deletions(-) diff --git a/NEWS b/NEWS index a750718..cbb39c2 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,9 @@ +4.9.1 + +- Unit "posix": + - set-file-position! now allows negative positions for seek/cur (thanks + to Seth Alves). + 4.9.0 - Security fixes diff --git a/posix-common.scm b/posix-common.scm index 0a04ccc..9bcda4f 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -96,6 +96,11 @@ static char C_time_string [TIME_STRING_MAXLENGTH + 1]; #define C_readdir(h,e) C_set_block_item(e, 0, (C_word) readdir((DIR *)C_block_item(h, 0))) #define C_foundfile(e,b,l) (C_strlcpy(C_c_string(b), ((struct dirent *) C_block_item(e, 0))->d_name, l), C_fix(strlen(((struct dirent *) C_block_item(e, 0))->d_name))) +/* It is assumed that 'int' is-a 'long' */ +#define C_ftell(p) C_fix(ftell(C_port_file(p))) +#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_num_to_int(n), C_unfix(w))) +#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w))) + #ifdef HAVE_SETENV # define C_unsetenv(s) (unsetenv((char *)C_data_pointer(s)), C_SCHEME_TRUE) # define C_setenv(x, y) C_fix(setenv((char *)C_data_pointer(x), (char *)C_data_pointer(y), 1)) @@ -295,6 +300,48 @@ EOF (eq? 'directory (file-type file #f #f))) +;;; File position access: + +(define-foreign-variable _seek_set int "SEEK_SET") +(define-foreign-variable _seek_cur int "SEEK_CUR") +(define-foreign-variable _seek_end int "SEEK_END") + +(define seek/set _seek_set) +(define seek/end _seek_end) +(define seek/cur _seek_cur) + +(define set-file-position! + (lambda (port pos . whence) + (let ((whence (if (pair? whence) (car whence) _seek_set))) + (##sys#check-exact pos 'set-file-position!) + (##sys#check-exact whence 'set-file-position!) + (unless (cond ((port? port) + (and (eq? (##sys#slot port 7) 'stream) + (##core#inline "C_fseek" port pos whence) ) ) + ((fixnum? port) + (##core#inline "C_lseek" port pos whence)) + (else + (##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)) ) + (posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) ) + +(define file-position + (getter-with-setter + (lambda (port) + (let ((pos (cond ((port? port) + (if (eq? (##sys#slot port 7) 'stream) + (##core#inline "C_ftell" port) + -1) ) + ((fixnum? port) + (##core#inline "C_lseek" port 0 _seek_cur) ) + (else + (##sys#signal-hook #:type-error 'file-position "invalid file" port)) ) ) ) + (when (< pos 0) + (posix-error #:file-error 'file-position "cannot retrieve file position of port" port) ) + pos) ) + set-file-position! ; doesn't accept WHENCE + "(file-position port)")) + + ;;; Using file-descriptors: (define-foreign-variable _stdin_fileno int "STDIN_FILENO") diff --git a/posixunix.scm b/posixunix.scm index 224e9b0..7e0a71b 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -266,11 +266,6 @@ static C_TLS sigset_t C_sigset; #define C_write(fd, b, n) C_fix(write(C_unfix(fd), C_data_pointer(b), C_unfix(n))) #define C_mkstemp(t) C_fix(mkstemp(C_c_string(t))) -/* It is assumed that 'int' is-a 'long' */ -#define C_ftell(p) C_fix(ftell(C_port_file(p))) -#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_num_to_int(n), C_unfix(w))) -#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w))) - #define C_ctime(n) (C_secs = (n), ctime(&C_secs)) #if defined(__SVR4) || defined(C_MACOSX) || defined(__ANDROID__) || defined(_AIX) @@ -614,50 +609,6 @@ EOF (and fdsw (if (fixnum? fdsw) (and (memq fdsw wl) fdsw) wl))))))))) -;;; File attribute access: - -(define-foreign-variable _seek_set int "SEEK_SET") -(define-foreign-variable _seek_cur int "SEEK_CUR") -(define-foreign-variable _seek_end int "SEEK_END") - -(define seek/set _seek_set) -(define seek/end _seek_end) -(define seek/cur _seek_cur) - -(define set-file-position! - (lambda (port pos . whence) - (let ((whence (if (pair? whence) (car whence) _seek_set))) - (##sys#check-exact pos 'set-file-position!) - (##sys#check-exact whence 'set-file-position!) - (when (negative? pos) - (##sys#signal-hook #:bounds-error 'set-file-position! "invalid negative port position" pos port)) - (unless (cond ((port? port) - (and (eq? (##sys#slot port 7) 'stream) - (##core#inline "C_fseek" port pos whence) ) ) - ((fixnum? port) - (##core#inline "C_lseek" port pos whence)) - (else - (##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)) ) - (posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) ) - -(define file-position - (getter-with-setter - (lambda (port) - (let ((pos (cond ((port? port) - (if (eq? (##sys#slot port 7) 'stream) - (##core#inline "C_ftell" port) - -1) ) - ((fixnum? port) - (##core#inline "C_lseek" port 0 _seek_cur) ) - (else - (##sys#signal-hook #:type-error 'file-position "invalid file" port)) ) ) ) - (when (< pos 0) - (posix-error #:file-error 'file-position "cannot retrieve file position of port" port) ) - pos) ) - set-file-position! ; doesn't accept WHENCE - "(file-position port)")) - - ;;; Directory stuff: (define-inline (*create-directory loc name) diff --git a/posixwin.scm b/posixwin.scm index 00c86e8..c1778f0 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -258,11 +258,6 @@ C_free_arg_string(char **where) { #define C_write(fd, b, n) C_fix(write(C_unfix(fd), C_data_pointer(b), C_unfix(n))) #define C_mkstemp(t) C_fix(mktemp(C_c_string(t))) -/* It is assumed that 'int' is-a 'long' */ -#define C_ftell(p) C_fix(ftell(C_port_file(p))) -#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_num_to_int(n), C_unfix(w))) -#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w))) - #define C_flushall() C_fix(_flushall()) #define C_umask(m) C_fix(_umask(C_unfix(m))) @@ -792,64 +787,6 @@ EOF (values fd (##sys#substring buf 0 (fx- path-length 1) ) ) ) ) ) -;;; File attribute access: - -(define-foreign-variable _seek_set int "SEEK_SET") -(define-foreign-variable _seek_cur int "SEEK_CUR") -(define-foreign-variable _seek_end int "SEEK_END") - -(define seek/set _seek_set) -(define seek/end _seek_end) -(define seek/cur _seek_cur) - -(define (symbolic-link? fname) - (##sys#check-string fname 'symbolic-link?) - #f) - -(let ((stat-type - (lambda (name) - (lambda (fname) - (##sys#check-string fname name) - #f)))) - (set! character-device? (stat-type 'character-device?)) - (set! block-device? (stat-type 'block-device?)) - (set! fifo? (stat-type 'fifo?)) - (set! socket? (stat-type 'socket?))) - -(define set-file-position! - (lambda (port pos . whence) - (let ((whence (if (pair? whence) (car whence) _seek_set))) - (##sys#check-exact pos 'set-file-position!) - (##sys#check-exact whence 'set-file-position!) - (when (negative? pos) - (##sys#signal-hook #:bounds-error 'set-file-position! "invalid negative port position" pos port)) - (unless (cond ((port? port) - (and (eq? (##sys#slot port 7) 'stream) - (##core#inline "C_fseek" port pos whence) ) ) - ((fixnum? port) - (##core#inline "C_lseek" port pos whence)) - (else - (##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)) ) - (posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) ) - -(define file-position - (getter-with-setter - (lambda (port) - (let ((pos (cond ((port? port) - (if (eq? (##sys#slot port 7) 'stream) - (##core#inline "C_ftell" port) - -1) ) - ((fixnum? port) - (##core#inline "C_lseek" port 0 _seek_cur)) - (else - (##sys#signal-hook #:type-error 'file-position "invalid file" port)) ) ) ) - (when (< pos 0) - (posix-error #:file-error 'file-position "cannot retrieve file position of port" port) ) - pos) ) - set-file-position! - "(file-position port)") ) ; doesn't accept WHENCE - - ;;; Directory stuff: (define-inline (create-directory-helper name) -- 1.7.10.4