run-program: Don't make pty the process's controlling terminal.

When called without an existing pty, for example in Slime, run-program
will make the created pty as the process's controlling.

(process-close (run-program "cat" () :pty t :search t :wait nil))
was terminated with SIGHUP when called under Slime.

diff --git a/NEWS b/NEWS
index f9085fb..2791c82 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -46,6 +46,8 @@ changes relative to sbcl-1.0.57:
   * bug fix: FORMAT used to loop infinitely in some cases when a COLINC
     parameter was zero, now it signals an error. (lp#905817, fixed since
     1.0.56.19)
+  * bug fix: run-program with :pty t no longer makes the pty as the process's
+    controling terminal.
 
 changes in sbcl-1.0.57 relative to sbcl-1.0.56:
   * RANDOM enhancements and bug fixes:

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 3cc2e85..97d6d55 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -386,14 +386,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 +410,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