From: Damien Kick
Subject: Migrating from Expect to something Lispy
Date: 
Message-ID: <m3n0ovvds5.fsf@IL27-5850.cig.mot.com>
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
From: Damien Kick
Subject: Re: Migrating from Expect to something Lispy
Date: 
Message-ID: <m3znro2enx.fsf@IL27-5850.cig.mot.com>
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 */