0.9.16.22:

[sbcl.git] / src / code / run-program.lisp

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index cb6c489..88982f8 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -392,25 +392,52 @@ status slot."
 ;;; the master side of the pty, the file descriptor for the slave side
 ;;; of the pty, and the name of the tty device for the slave side.
 #-win32
-(defun find-a-pty ()
-  (dolist (char '(#\p #\q))
-    (dotimes (digit 16)
-      (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
-                                           #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
-                                              #o666)))
-            (when slave-fd
-              (return-from find-a-pty
-                (values master-fd
-                        slave-fd
-                        slave-name)))
-            (sb-unix:unix-close master-fd))))))
-  (error "could not find a pty"))
+(progn
+  (define-alien-routine ptsname c-string (fd int))
+  (define-alien-routine grantpt boolean (fd int))
+  (define-alien-routine unlockpt boolean (fd int))
+
+  (defun find-a-pty ()
+    ;; 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
+                                         #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
+                                            #o666)))
+          (when slave-fd
+            (return-from find-a-pty
+              (values master-fd
+                      slave-fd
+                      slave-name)))
+          (sb-unix:unix-close master-fd))
+        (error "could not find a pty")))
+    ;; No dice, try using the old-school method.
+    (dolist (char '(#\p #\q))
+      (dotimes (digit 16)
+        (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
+                                             #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
+                                                #o666)))
+              (when slave-fd
+                (return-from find-a-pty
+                  (values master-fd
+                          slave-fd
+                          slave-name)))
+              (sb-unix:unix-close master-fd))))))
+    (error "could not find a pty")))
 
 #-win32
 (defun open-pty (pty cookie)
@@ -504,7 +531,7 @@ status slot."
 
 ;;; Is UNIX-FILENAME the name of a file that we can execute?
 (defun unix-filename-is-executable-p (unix-filename)
-  (let ((filename (coerce unix-filename 'base-string)))
+  (let ((filename (coerce unix-filename 'string)))
     (values (and (eq (sb-unix:unix-file-kind filename) :file)
                  #-win32
                  (sb-unix:unix-access filename sb-unix:x_ok)))))
@@ -812,7 +839,17 @@ Common Lisp Users Manual for details about the PROCESS structure.
         proc
         ;; It's friendly to allow the caller to pass any string
         ;; designator, but internally we'd like SIMPLE-STRINGs.
-        (simple-args (mapcar (lambda (x) (coerce x 'simple-string)) args)))
+        (simple-args
+          (mapcar
+            (lambda (x)
+              (coerce
+                ;; Apparently any spaces or double quotes in the arguments
+                ;; need to be escaped on win32.
+                (if (position-if (lambda (c) (find c '(#\" #\Space))) x)
+                    (write-to-string x)
+                    x)
+                'simple-string))
+            args)))
     (unwind-protect
          (let ((pfile
                 (if search