I want to start working on a project that I previously would have done
with Don Libe's Expect but now I would like to use something Lispy
instead. I've found WINTERP
<http://www.cybertribe.com/mayer/winterp/winterp.html> and I'm aware
of Emacs' process-filter and process-sentinel capabilities. I was
hoping that someone might be able to provide a few more pointers to
good starting points for getting the same capailities as Expect into a
Lisp environment. Thanks in advance for any help.
--
Damien Kick
Damien Kick <······@email.mot.com> writes:
> I want to start working on a project that I previously would have
> done with Don Libe's Expect but now I would like to use something
> Lispy instead. [...]
I've been investigating (as a background process of low priority)
using different approaches to this problem since I first posted this
question. Here is the beginning of an attempt to re-implement some of
code in the "Pseudo Terminals" chapter of W. Richard Stevens'
_Advanced Programming in the UNIX Environment_ for CMU CL. I thought
I would post it here as a newbie fishing for some comments, critiques,
suggestions, general direction, etc.
The Lisp code follows this paragraph. The idea being that someone
would do something similiar to the following '(pty-fork
#'drive-prog-in-parent #'exec-prog-in-child)'.
;;;; begin file: apue-pty.lisp
(defpackage advanced-programming-in-the-unix-environment
(:nicknames apue)
(:use common-lisp alien c-call unix))
(in-package apue)
(def-alien-routine call-grantpt int
(fd int))
(def-alien-routine call-ptsname c-string
(fd int))
(def-alien-routine call-unlockpt int
(fd int))
(def-alien-routine call-ioctl-push int
(fd int)
(module-name c-string))
(defun ptym-open ()
"This is a re-write of W. Richard Stevens' C function,
\'ptym_open\', from Advanced Programming in the UNIX Environment."
(let ((fdm (values (unix-open "/dev/ptmx" o_rdwr 0))))
(cond
((not fdm)
(values -1 nil))
((minusp (call-grantpt fdm))
(unix-close fdm)
(values -2 nil))
((minusp (call-unlockpt fdm))
(unix-close fdm)
(values -3 nil))
(t (let ((slave-name (copy-seq (call-ptsname fdm))))
(if (plusp (length slave-name))
(progn (unix-close fdm) (values -4 nil))
(values fdm slave-name)))))))
(defun ptys-open (fdm pts-name)
"This is a re-write of W. Richard Stevens' C function,
\'ptys_open\', from Advanced Programming in the UNIX Environment."
(let ((fds (values (unix-open pts-name o_rdwr 0))))
(cond
((not fds)
(unix-close fdm)
-5)
((minusp (call-ioctl-push fds "ptem"))
(unix-close fdm)
(unix-close fds)
-6)
((minusp (call-ioctl-push fds "ldterm"))
(unix-close fdm)
(unix-close fds)
-7)
((minusp (call-ioctl-push fds "ttcompat"))
(unix-close fdm)
(unix-close fds)
-8)
(t fds))))
(defmacro with-pty-master ((fd slave-name) &body body)
`(let ((,fd (values (unix-open "/dev/ptmx" o_rdwr 0))))
(if ,fd
(unwind-protect
(if (>= (call-grantpt ,fd) 0)
(if (>= (call-unlockpt ,fd) 0)
(let ((,slave-name (copy-seq (call-ptsname ,fd))))
(if (plusp (length ,slave-name))
(progn ,@body)
(values -4 nil)))
(values -3 nil))
(values -2 nil))
(unix-close ,fd))
(values -1 nil))))
(defmacro with-pty-slave ((fds fdm pts-name) &body body)
`(unwind-protect
(let ((,fds (values (unix-open ,pts-name o_rdwr 0))))
(if ,fds
(unwind-protect
(if (>= (call-ioctl-push ,fds "ptem") 0)
(if (>= (call-ioctl-push ,fds "ldterm") 0)
(if (>= (call-ioctl-push ,fds "ttcompat") 0)
(progn ,@body)
-8)
-7)
-6)
(unix-close ,fds))
-5))
(unix-close ,fdm)))
(defun pty-fork
(parent-fn child-fn &optional slave-termios slave-winsize)
"Calls unix:unix-fork with a pty master in the parent and a pty
slave in the child. This is a re-write of W. Richard Stevens' C
function, \'pty_fork\', from Advanced Programming in the UNIX
Environment."
(with-pty-master (master slave-name)
(let ((pid (values (unix-fork))))
(if (not pid)
(values nil nil)
(if (plusp pid)
(values pid
(funcall parent-fn master))
(with-pty-slave (slave master slave-name)
(when slave-termios
(unix-ioctl slave tcsanow slave-termios))
(when slave-winsize
(unix-ioctl slave tiocswinsz slave-winsize))
(let ((stdin (sys:fd-stream-fd sys:*stdin*))
(stdout (sys:fd-stream-fd sys:*stdout*))
(stderr (sys:fd-stream-fd sys:*stderr*)))
(unless (unix-dup2 slave stdin)
(error "dup2 error to stdin"))
(unless (unix-dup2 slave stdout)
(error "dup2 error to stdout"))
(unless (unix-dup2 slave stderr)
(error "dup2 error to stderr"))
(values pid
(funcall child-fn
(when (> slave stderr)
slave))))))))))
;;;; end file: apue-pty.lisp
The C code as not all of the system calls I needed where available in
the UNIX package.
/* begin file: apue-pty.c */
#include "apue-pty.h"
#include <stdlib.h>
#include <stropts.h>
#include <unistd.h>
int call_grantpt(int fd)
{
return grantpt(fd);
}
char* call_ptsname(int fd)
{
return ptsname(fd);
}
int call_unlockpt(int fd)
{
return unlockpt(fd);
}
int call_ioctl_push(int fd, const char* module_name)
{
return ioctl(fd, I_PUSH, module_name);
}
/* end file: apue-pty.c */