On Sun, Aug 03, 2014 at 11:04:21AM +0200, Michele La Monaca wrote:
> On Sun, Aug 3, 2014 at 3:01 AM, Mario Domenech Goulart
> <[email protected]> wrote:
> > ...
> > If I understand correctly, at this point the code is subject to race
> > conditions, which is one of the things mkstemp prevents.
> 
> Yes, actually a stupid one which can be avoided, I think. Attached a
> revisited patch which should avoid the problem. I also added a few
> sanity checks (some more may be needed). Unfortunately, I can't
> thoroughly test the code right now as I said.

Thanks for your patch!  I've taken it and improved it a little bit:
- Changed file's permission to use 600 instead of 777.
- Converted functional string concatenation code to imperative mutation
   of a copied string to reduce pressure on the GC.
- Considering that the standard says mkstemp returns an error in case
   the file doesn't end in "XXXXXX", I decided to simplify the handling
   of invalid templates by assuming a template with no trailing Xs is
   also invalid.  This also allows us to remove the special case of when
   the template is empty (in which case first-x is also 0).  I've checked
   NetBSD's libc and GNU libc.  NetBSD allows templates with no Xs, but
   GNU libc disallows them (resulting in an error in CHICKEN), so erroring
   on this in Windows too should improve portability of CHICKEN code.
- Various other small cleanups to make the code more compact.
- Made use of fixnum procedures where possible (not terribly important,
   but it improves consistency with the rest of the code)

I've also tested the code on Windows.  Here's the new version.

Cheers,
Peter
-- 
http://www.more-magic.net
>From 91a046e37c18d08cc3c2d9df2feaa0258aaebd0b 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.
---
 NEWS         |    2 ++
 posixwin.scm |   41 +++++++++++++++++++++++++++++++----------
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/NEWS b/NEWS
index 20ece38..d613613 100644
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,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..2f29269 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#error 'mkstemp "non-existent directory"))
+           ((fx= first-x tmpl-len)
+            (##sys#error 'mkstemp "invalid 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))
+                 (##sys#error 'mkstemp "max attempts reached"))
+             (values fd tmpl)))))))
 
 ;;; Directory stuff:
 
-- 
1.7.10.4

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to