From 33412e55c5926dbed87f8816d22fbf95b12f839a Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Sat, 2 Sep 2006 00:29:56 +0000 Subject: [PATCH] 0.9.16.14: Add support for Unix98-style ptys. (thanks to Sidney Markowitz) --- NEWS | 2 ++ src/code/run-program.lisp | 65 ++++++++++++++++++++++++++++++++------------- version.lisp-expr | 2 +- 3 files changed, 49 insertions(+), 20 deletions(-) diff --git a/NEWS b/NEWS index 1fed6a0..1d13184 100644 --- a/NEWS +++ b/NEWS @@ -16,6 +16,8 @@ changes in sbcl-0.9.17 (0.9.99?) relative to sbcl-0.9.16: Slobodov) * bug fix: better detection of circularities in the file-compiler. (reported by Marco Monteiro) + * bug fix: The :PTY argument for RUN-PROGRAM will now work on + systems with Unix98 pty semantics. changes in sbcl-0.9.16 relative to sbcl-0.9.15: * feature: implemented the READER-METHOD-CLASS and diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index cb6c489..805a92a 100644 --- 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) diff --git a/version.lisp-expr b/version.lisp-expr index 059e465..a7377a2 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.16.13" +"0.9.16.14" -- 1.7.10.4