Binary pipes with SBCL

Question

How do I set up binary pipes on the stdin and stdout of the subprocess using sb-ext:run-program? I'd like to have streams with element-type (unsigned-byte 8) to talk to the subprocess in Lisp.

run-program takes an :external-format argument but as far as I can tell it's only about text encodings, not binary. SBCL ships with a test program that does binary I/O but it defines a custom stream class using Gray streams, which seems advanced enough that there has to be an easier way.

coredump coredump · Accepted Answer · 2019-09-23T16:04:49

Normally, sb-ext:run-program is responsible for creating intermediate streams when you pass the :stream option. The other answer shows that you can directly write bytes to it if you want to. But If you inspect how run-program is implemented, you can build the streams yourself by using the same functions called by run-program to generate an intermediate unix pipe, and read/write to it using binary streams.

(defpackage :so (:use :cl :alexandria))
(in-package :so)

Define an auxiliary function that closes a file descriptor while handling errors as warnings:

(defun unix-close/warn-on-error (file-descriptor)
  (multiple-value-bind (status error) (sb-unix:unix-close file-descriptor)
    (prog1 status
      (unless (eql error 0)
        (warn "Unix close error: ~S" error)))))

Then, a macro that temporarily create a unix pipe:

(defmacro with-unix-pipe ((read-fd write-fd) &body body)
  (with-gensyms (first second)
    `(multiple-value-bind (,first ,second) (sb-unix:unix-pipe)
       (if ,first
           (unwind-protect
                (multiple-value-bind (,read-fd ,write-fd)
                    (values ,first ,second)
                  ,@body)
             (unix-close/warn-on-error ,first)
             (unix-close/warn-on-error ,second))
           (error "Unix pipe error: ~s" ,second)))))

However, run-program expects streams, not file descriptors. Here you have a macro that binds a variable to a stream tied to a file descriptor:

(defmacro with-fd-stream% ((var fd direction &rest fd-args) &body body)
  (check-type direction (member :output :input))
  (with-gensyms (in%)
    `(let ((,in% (sb-sys:make-fd-stream ,fd ,direction t ,@fd-args)))
       (unwind-protect (let ((,var ,in%))
                         (declare (dynamic-extent ,var))
                         ,@body)
         (close ,in%)))))

And the macro that does the same for a pair if in/out file descriptors:

(defmacro with-fd-streams (((in read-fd &rest read-args)
                            (out write-fd &rest write-args))
                           &body body)
  `(with-fd-stream% (,in ,read-fd :input ,@read-args)
     (with-fd-stream% (,out ,write-fd :output ,@write-args)
       ,@body)))

Finally, you can test your code with the following:

(let ((ub8 '(unsigned-byte 8)))
  (with-unix-pipe (read write)
    (with-fd-streams ((in read :element-type ub8)
                      (out write :element-type ub8))
      (fresh-line)
      (sb-ext:run-program "dd"
                          '("if=/dev/random" "count=1" "bs=64")
                          :search t
                          :output out
                          :error nil
                          :wait nil
                          :status-hook (lambda (p)
                                         (unless (sb-ext:process-alive-p p)
                                           (close out))))
      (sb-ext:run-program "hd"
                          '()
                          :search t
                          :input in
                          :output *standard-output*
                          :wait t))))

Binary pipes with SBCL

2 Answers