Бинарные трубы с SBCL - PullRequest
Новая
       70

Бинарные трубы с SBCL

2 голосов
/ 23 сентября 2019

Как настроить двоичные каналы на стандартном вводе и выводе подпроцесса, используя sb-ext:run-program?Я хотел бы иметь потоки с типом элемента (unsigned-byte 8) для связи с подпроцессом в Лиспе.

run-program принимает аргумент :external-format, но, насколько я могу судить, речь идет только о кодировках текста,не бинарныйSBCL поставляется с тестовой программой , которая выполняет бинарный ввод / вывод, но она определяет собственный класс потока с использованием потоков Грея, который кажется достаточно продвинутым, чтобы существовал более простой способ.

Ответы [ 2 ]

4 голосов
/ 23 сентября 2019

Обычно sb-ext:run-program отвечает за создание промежуточных потоков, когда вы передаете опцию :stream.Другой ответ показывает, что вы можете напрямую записать байты в него, если хотите.Но если вы посмотрите, как реализовано run-program, вы можете самостоятельно построить потоки, используя те же функции, которые вызываются run-program, для генерации промежуточного канала Unix и чтения / записи в него с использованием двоичных потоков. 

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

Определите вспомогательную функцию, которая закрывает дескриптор файла при обработке ошибок как предупреждения: 

(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)))))

Затем макрос, который временно создает канал Unix: 

(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)))))

Однако выполните-program ожидает потоки, а не файловые дескрипторы.Здесь у вас есть макрос, который привязывает переменную к потоку, связанному с дескриптором файла: 

(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%)))))

И макрос, который делает то же самое для пары, если дескрипторы файлов ввода / вывода: 

(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)))

Наконец, вы можете проверить свой код следующим образом: 

(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))))
3 голосов
/ 23 сентября 2019

Первый тест, который вы связали, похоже, уже показывает, что вы можете просто отправлять байты в потоки, созданные с помощью :input :stream и :output :stream.

Я бы предложил вместо этого использовать uiop:launch-program для переносимости:

(let ((pri (uiop:launch-program "cat" :input :stream :output :stream)))
  (write-byte 43 (uiop:process-info-input pri))
  (force-output (uiop:process-info-input pri))
  (read-byte (uiop:process-info-output pri)))

=> 43

...