X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=fee0dd751dd324b1773dadee110b581a3eba5d25;hb=c712f88b26cd7547ee984b90e18c134401335bc3;hp=d9e00f2679904741daa21fecbfb82fbb1e72228d;hpb=0395c15ff8394bfaaed03050c1a7a131f197a732;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index d9e00f2..fee0dd7 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -145,7 +145,6 @@
   #+sb-doc
   "List of process structures for all active processes.")
 
-#-win32
 (defvar *active-processes-lock*
   (sb-thread:make-mutex :name "Lock for active processes."))
 
@@ -153,11 +152,8 @@
 ;;; mutex is needed. More importantly the sigchld signal handler also
 ;;; accesses it, that's why we need without-interrupts.
 (defmacro with-active-processes-lock (() &body body)
-  #-win32
   `(sb-thread::with-system-mutex (*active-processes-lock*)
-     ,@body)
-  #+win32
-  `(progn ,@body))
+     ,@body))
 
 (defstruct (process (:copier nil))
   pid                 ; PID of child process
@@ -386,14 +382,16 @@ status slot."
     ;; First try to use the Unix98 pty api.
     (let* ((master-name (coerce (format nil "/dev/ptmx") 'base-string))
            (master-fd (sb-unix:unix-open master-name
-                                         sb-unix:o_rdwr
+                                         (logior sb-unix:o_rdwr
+                                                 sb-unix:o_noctty)
                                          #o666)))
       (when master-fd
         (grantpt master-fd)
         (unlockpt master-fd)
         (let* ((slave-name (ptsname master-fd))
                (slave-fd (sb-unix:unix-open slave-name
-                                            sb-unix:o_rdwr
+                                            (logior sb-unix:o_rdwr
+                                                    sb-unix:o_noctty)
                                             #o666)))
           (when slave-fd
             (return-from find-a-pty
@@ -408,13 +406,15 @@ status slot."
         (let* ((master-name (coerce (format nil "/dev/pty~C~X" char digit)
                                     'base-string))
                (master-fd (sb-unix:unix-open master-name
-                                             sb-unix:o_rdwr
+                                             (logior sb-unix:o_rdwr
+                                                     sb-unix:o_noctty)
                                              #o666)))
           (when master-fd
             (let* ((slave-name (coerce (format nil "/dev/tty~C~X" char digit)
                                        'base-string))
                    (slave-fd (sb-unix:unix-open slave-name
-                                                sb-unix:o_rdwr
+                                                (logior sb-unix:o_rdwr
+                                                        sb-unix:o_noctty)
                                                 #o666)))
               (when slave-fd
                 (return-from find-a-pty
@@ -939,6 +939,12 @@ Users Manual for details about the PROCESS structure."#-win32"
         (get-stream-fd-and-external-format
          (two-way-stream-output-stream stream) direction))))))
 
+(defun get-temporary-directory ()
+  #-win32 (or (sb-ext:posix-getenv "TMPDIR")
+              "/tmp")
+  #+win32 (or (sb-ext:posix-getenv "TEMP")
+              "C:/Temp"))
+
 
 ;;; Find a file descriptor to use for object given the direction.
 ;;; Returns the descriptor. If object is :STREAM, returns the created
@@ -957,10 +963,14 @@ Users Manual for details about the PROCESS structure."#-win32"
   ;; run afoul of disk quotas or to choke on small /tmp file systems.
   (flet ((make-temp-fd ()
            (multiple-value-bind (fd name/errno)
-               (sb-unix:sb-mkstemp "/tmp/.run-program-XXXXXX" #o0600)
+               (sb-unix:sb-mkstemp (format nil "~a/.run-program-XXXXXX"
+                                           (get-temporary-directory))
+                                   #o0600)
              (unless fd
                (error "could not open a temporary file: ~A"
                       (strerror name/errno)))
+             ;; Can't unlink an opened file on Windows
+             #-win32
              (unless (sb-unix:unix-unlink name/errno)
                (sb-unix:unix-close fd)
                (error "failed to unlink ~A" name/errno))