Hi all, I've tweaked the error reporting in this patch e'er-so-slightly; the previous one simply used ##sys#error to signal errors, whereas I think it should signal a #:file-error specifically. The attached version does that, making the type of error signaled match that of the posixunix.scm version.
This is a minor-but-not-strictly-mechanical change, so I figure it should hit the list again. Here's a signed-off version; happy for anyone else to push it (including to stability, as Peter says). Cheers, Evan
>From 51bcb9d4aa0afc7f810e28af400fd6a626e48545 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sun, 3 Aug 2014 14:52:32 +0200 Subject: [PATCH] Fix file-mkstemp behaviour on Windows (#819). Before, it would return "random" invalid file descriptors. Thanks to Michele La Monaca for the initial patch. Signed-off-by: Evan Hanson <[email protected]> --- NEWS | 2 ++ posixwin.scm | 41 +++++++++++++++++++++++++++++++---------- 2 files changed, 33 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index 71341e8..7a62752 100644 --- a/NEWS +++ b/NEWS @@ -24,6 +24,8 @@ - Unit "posix": - set-file-position! now allows negative positions for seek/cur (thanks to Seth Alves). + - file-mkstemp now works correctly on Windows, it now returns valid + file descriptors (#819, thanks to Michele La Monaca). - Runtime system: - Removed several deprecated, undocumented parts of the C interface: diff --git a/posixwin.scm b/posixwin.scm index c41e18d..0af657d 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -198,7 +198,6 @@ readdir(DIR * dir) #endif /* ifndef __WATCOMC__ */ #ifdef __WATCOMC__ -# define mktemp _mktemp /* there is no P_DETACH in Watcom CRTL */ # define P_DETACH P_NOWAIT #endif @@ -256,7 +255,6 @@ C_free_arg_string(char **where) { #define C_open(fn, fl, m) C_fix(open(C_c_string(fn), C_unfix(fl), C_unfix(m))) #define C_read(fd, b, n) C_fix(read(C_unfix(fd), C_data_pointer(b), C_unfix(n))) #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))) #define C_flushall() C_fix(_flushall()) @@ -778,14 +776,37 @@ EOF (define file-mkstemp (lambda (template) (##sys#check-string template 'file-mkstemp) - (let* ([buf (##sys#make-c-string template 'file-mkstemp)] - [fd (##core#inline "C_mkstemp" buf)] - [path-length (string-length buf)]) - (when (eq? -1 fd) - (##sys#update-errno) - (##sys#signal-hook #:file-error 'file-mkstemp "cannot create temporary file" template) ) - (values fd (##sys#substring buf 0 (fx- path-length 1) ) ) ) ) ) - + (let* ((diz "0123456789abcdefghijklmnopqrstuvwxyz") + (diz-len (string-length diz)) + (max-attempts (* diz-len diz-len diz-len)) + (tmpl (string-copy template)) ; We'll overwrite this later + (tmpl-len (string-length tmpl)) + (first-x (let loop ((i (fx- tmpl-len 1))) + (if (and (fx>= i 0) + (eq? (string-ref tmpl i) #\X)) + (loop (fx- i 1)) + (fx+ i 1))))) + (cond ((not (directory-exists? (or (pathname-directory template) "."))) + ;; Quit early instead of looping needlessly with C_open + ;; failing every time. This is a race condition, but not + ;; a security-critical one. + (##sys#signal-hook #:file-error 'file-mkstemp "non-existent directory" template)) + ((fx= first-x tmpl-len) + (##sys#signal-hook #:file-error 'file-mkstemp "invalid template" template))) + (let loop ((count 1)) + (let suffix-loop ((index (fx- tmpl-len 1))) + (when (fx>= index first-x) + (string-set! tmpl index (string-ref diz (random diz-len))) + (suffix-loop (fx- index 1)))) + (let ((fd (##core#inline "C_open" + (##sys#make-c-string tmpl 'file-open) + (bitwise-ior open/rdwr open/creat open/excl) + (fxior _s_irusr _s_iwusr)))) + (if (eq? -1 fd) + (if (fx< count max-attempts) + (loop (fx+ count 1)) + (posix-error #:file-error 'file-mkstemp "cannot create temporary file" template)) + (values fd tmpl))))))) ;;; Directory stuff: -- 1.7.10.4
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
