Pipes and processes, stdin, stdout and stderr

Pipes and processes, stdin, stdout and stderr

[Christopher Allan Webber]

Hello all,

Last night I was trying to do the equivalent of this:

  bash$ echo "foo" | sha512sum

in guile.  But I was unable to find a clear way to do it.

I tried something like:

(let* ((port (open-pipe*
              OPEN_BOTH
              "sha256sum" "--binary")))
  (display "test me\n" port)
  (force-output port)
  (let ((result (drain-input port)))
    (close-port port)
    (car (string-split result #\space))))

Unfortunately, this just hangs forever at the drain-input.  I get the
same issue if I do (read-line port).

What I expected was that Guile would provide a way to access stdin,
stdout, stderr in a process as separate ports.  Python provides an API
more or less like this:

>>> from subprocess import Popen, PIPE
>>> proc = Popen("sha256sum", stdin=PIPE, stdout=PIPE)                          
>>> proc.stdin.write(b"foo")
3
>>> proc.stdin.close()
>>> proc.stdout.read()
b'2c26b46b68ffc68ff99b453c1d30413413422d706483bfa0f98a5e886266e7ae  -\n'

It looks like in the past there were discussions about doing something
similar:

http://comments.gmane.org/gmane.lisp.guile.user/9300

It might be really nice if there was a way to access stdin, stdout, and
stderr as separate ports.  I might be willing to write some code for it,
if someone could point me in the right direction.  But I really don't
know where to look.

Is there a way to do this that I don't know?

Thanks for the help!
 - Chris

Re: Pipes and processes, stdin, stdout and stderr

[Vladimir Zhbanov]

[-- Attachment #1: Type: text/plain, Size: 144 bytes --]

Hi, Chris.

In geda-gaf, I modified open-pipe* to solve a similar issue.
See the procedure code and comments in attachment.

Cheers,
  Vladimir

[-- Attachment #2: open-io-pipe.scm --]
[-- Type: text/plain, Size: 3544 bytes --]

;; run a child process and return a pair of input and output ports.
;; Executes the program 'command' with optional arguments 'args'
;; (all strings) in a subprocess.
;; Two ports to the process (based on pipes) are created and
;; returned.
;; The procedure is a modified version of the popen open-pipe*
;; procedure. Its functionality is close to that of
;; open-input-output-pipe. Changes are made to make it return two
;; ports instead of one in order to have a possibility to close
;; each one separately. This allows closing of the input pipe by
;; using (close-port port) when needed and emit EOF to the running
;; child process.
(define (gsch2pcb:open-io-pipe command . args)
  (let* ((c2p (pipe))  ; child to parent
         (p2c (pipe))) ; parent to child

    (setvbuf (cdr c2p) _IONBF)
    (setvbuf (cdr p2c) _IONBF)
    (let ((pid (primitive-fork)))
      (if (= pid 0)
        (begin
         ;; child process
         (ensure-batch-mode!)

         ;; select the three file descriptors to be used as
         ;; standard descriptors 0, 1, 2 for the new
         ;; process. They are pipes to/from the parent or taken
         ;; from the current Scheme input/output/error ports if
         ;; possible.

         (let ((input-fdes (fileno (car p2c)))
           (output-fdes (fileno (cdr c2p)))
           (error-fdes
             (or (false-if-exception (fileno (current-error-port)))
                 (open-fdes *null-device* O_WRONLY))))

           ;; close all file descriptors in ports inherited from
           ;; the parent except for the three selected above.
           ;; this is to avoid causing problems for other pipes in
           ;; the parent.

           ;; use low-level system calls, not close-port or the
           ;; scsh routines, to avoid side-effects such as
           ;; flushing port buffers or evicting ports.

           (port-for-each (lambda (pt-entry)
                (false-if-exception
                 (let ((pt-fileno (fileno pt-entry)))
                   (if (not (or (= pt-fileno input-fdes)
                        (= pt-fileno output-fdes)
                        (= pt-fileno error-fdes)))
                       (close-fdes pt-fileno))))))

           ;; Copy the three selected descriptors to the standard
           ;; descriptors 0, 1, 2, if not already there

           (if (not (= input-fdes 0))
             (begin
               (if (= output-fdes 0) (set! output-fdes (dup->fdes 0)))
               (if (= error-fdes  0) (set! error-fdes  (dup->fdes 0)))
               (dup2 input-fdes 0)
               ;; it's possible input-fdes is error-fdes
               (if (not (= input-fdes error-fdes))
                 (close-fdes input-fdes))))

           (if (not (= output-fdes 1))
             (begin
               (if (= error-fdes 1) (set! error-fdes (dup->fdes 1)))
               (dup2 output-fdes 1)
               ;; it's possible output-fdes is error-fdes
               (if (not (= output-fdes error-fdes))
                 (close-fdes output-fdes))))

           (if (not (= error-fdes 2))
             (begin
               (dup2 error-fdes 2)
               (close-fdes error-fdes)))

           (apply execlp command command args)))
        (begin
          ;; parent process
          ;; the forked child process should use these ports so
          ;; the parent process doesn't need them any more
          (close-port (cdr c2p))
          (close-port (car p2c))
          ;; return input and output ports
          (cons (car c2p) (cdr p2c))
          )))))

Re: Pipes and processes, stdin, stdout and stderr

[Christopher Allan Webber]

Thanks Vladimir!  I will look through this.

Vladimir Zhbanov writes:

> Hi, Chris.
>
> In geda-gaf, I modified open-pipe* to solve a similar issue.
> See the procedure code and comments in attachment.
>
> Cheers,
>   Vladimir

Re: Pipes and processes, stdin, stdout and stderr

[Thien-Thi Nguyen]

[-- Attachment #1: Type: text/plain, Size: 1335 bytes --]

() Christopher Allan Webber <cwebber@dustycloud.org>
() Mon, 13 Apr 2015 19:17:41 -0500

   It might be really nice if there was a way to access stdin,
   stdout, and stderr as separate ports.  I might be willing to
   write some code for it, if someone could point me in the
   right direction.  But I really don't know where to look.

IIRC, ttn-do (http://www.gnuvola.org/software/ttn-do/) has a
child process module ‘(ttn-do zzz subprocess)’ that supports
such access.  It is not as automagic as ‘(ice-9 popen)’, but
maybe that's the right level for you.  If you look at the code
of both modules (highly encouraged :-D), you will see a fairly
similar pattern.  I think the best way forward is if Someone
migrates the (common) pattern into Guile proper, and exposes it
under a suitably coherent design.

Too many buzzwords, i know.  But i hope you understand anyway.

   Is there a way to do this that I don't know?

Only you know what you do not know, so who else can answer that?
Next question!  :-D

-- 
Thien-Thi Nguyen -----------------------------------------------
  (if you're human and you know it) read my lisp:
    (defun responsep (type via)
      (case type
        (technical (eq 'mailing-list via))
        ...))
---------------------------------------------- GPG key: 4C807502

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 197 bytes --]

Re: Pipes and processes, stdin, stdout and stderr

[Christopher Allan Webber]

Thien-Thi Nguyen writes:

> () Christopher Allan Webber <cwebber@dustycloud.org>
> () Mon, 13 Apr 2015 19:17:41 -0500
>
>    It might be really nice if there was a way to access stdin,
>    stdout, and stderr as separate ports.  I might be willing to
>    write some code for it, if someone could point me in the
>    right direction.  But I really don't know where to look.
>
> IIRC, ttn-do (http://www.gnuvola.org/software/ttn-do/) has a
> child process module ‘(ttn-do zzz subprocess)’ that supports
> such access.  It is not as automagic as ‘(ice-9 popen)’, but
> maybe that's the right level for you.  If you look at the code
> of both modules (highly encouraged :-D), you will see a fairly
> similar pattern.  I think the best way forward is if Someone
> migrates the (common) pattern into Guile proper, and exposes it
> under a suitably coherent design.
>
> Too many buzzwords, i know.  But i hope you understand anyway.
>
>    Is there a way to do this that I don't know?
>
> Only you know what you do not know, so who else can answer that?
> Next question!  :-D

Thank you!  I'll look at it.

Btw, what is ttn-do?  I looked through the source and it seems to be a
collection of utilities.  Is this right?

 - cwebb

Re: Pipes and processes, stdin, stdout and stderr

[Thien-Thi Nguyen]

[-- Attachment #1: Type: text/plain, Size: 639 bytes --]

() Christopher Allan Webber <cwebber@dustycloud.org>
() Thu, 16 Apr 2015 10:34:32 -0500

   Btw, what is ttn-do?  I looked through the source and it
   seems to be a collection of utilities.  Is this right?

It's a collection of programs and modules w/o any particular
theme.  Some of the programs can be used as modules, as well.

-- 
Thien-Thi Nguyen -----------------------------------------------
  (if you're human and you know it) read my lisp:
    (defun responsep (type via)
      (case type
        (technical (eq 'mailing-list via))
        ...))
---------------------------------------------- GPG key: 4C807502

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 197 bytes --]

Re: Pipes and processes, stdin, stdout and stderr

[Mark H Weaver]

Christopher Allan Webber <cwebber@dustycloud.org> writes:

> Last night I was trying to do the equivalent of this:
>
>   bash$ echo "foo" | sha512sum
>
> in guile.  But I was unable to find a clear way to do it.
>
> I tried something like:
>
> (let* ((port (open-pipe*
>               OPEN_BOTH
>               "sha256sum" "--binary")))
>   (display "test me\n" port)
>   (force-output port)
>   (let ((result (drain-input port)))
>     (close-port port)
>     (car (string-split result #\space))))
>
> Unfortunately, this just hangs forever at the drain-input.  I get the
> same issue if I do (read-line port).
>
> What I expected was that Guile would provide a way to access stdin,
> stdout, stderr in a process as separate ports.

Indeed, this is exactly what we need.  It's been on my TODO list
for a while.

     Mark

Re: Pipes and processes, stdin, stdout and stderr -- ./configure in Guile

[Jan Nieuwenhuizen]

Mark H Weaver writes:

In a somewhat related effort I've been fighting with reading stderr for
./configure and reverted to using redirection in the shell.

Greetings, Jan


-- ./configure
#! /usr/bin/guile \
-e main
!#

(define (main . args)
  ((@@ (configure) main) (command-line)))

(read-set! keywords 'prefix)

(define-module (configure)
  :use-module (ice-9 curried-definitions)
  :use-module (ice-9 and-let-star)
  :use-module (ice-9 getopt-long)
  :use-module (ice-9 optargs)
  :use-module (ice-9 match)

  :use-module (ice-9 rdelim)
  :use-module (os process))

(define (logf port string . rest)
  (apply format (cons* port string rest))
  (force-output port)
  #t)

(define (stderr string . rest)
  (apply logf (cons* (current-error-port) string rest)))

(define (stdout string . rest)
  (apply logf (cons* (current-output-port) string rest)))

(define* (gulp-port :optional (port (current-input-port)))
  (or (and-let* ((result (read-delimited "" port))
                 ((string? result)))
                result)
      ""))

(define (gulp-pipe command)
  (gulp-port (cdr (apply run-with-pipe (list "r" "/bin/bash" "-c" command)))))

(define (parse-opts args)
  (let* ((option-spec
	  '((help (single-char #\h))))
         (options (getopt-long args option-spec
                               :stop-at-first-non-option #t))
         (help? (option-ref options 'help #f))
         (files (option-ref options '() '()))
         (usage? (and (not help?) (not (null? files))))
         (version? (option-ref options 'version #f)))
    (or
     (and version?
          (stdout "0.1\n")
          (exit 0))
     (and (or help? usage?)
          ((or (and usage? stderr) stdout) "\
Usage: ./configure [OPTION]...
  -h, --help           display this help
")
          (exit (or (and usage? 2) 0)))
     options)))

(define (tuple< a b)
  (cond
   ((and (null? a) (null? b)) #t)
   ((null? a) (not (null? b)))
   ((null? b) #f)
   ((and (not (< (car a) (car b)))
         (not (< (car b) (car a))))
    (tuple< (cdr a) (cdr b)))
   (else (< (car a) (car b)))))

(define (tuple<= a b)
  (or (equal? a b) (tuple< a b)))

(define* ((->string :optional (infix "")) h . t)
  (let ((src (if (pair? t) (cons h t) h)))
    (match src
      ((? char?) (make-string 1 src))
      ((? string?) src)
      ((? symbol?) (symbol->string src))
      ((? number?) (number->string src))
      ((h ... t) (string-join (map (->string) src) ((->string) infix)))
      (_ ""))))

(define (version->string version)
  ((->string '.) version))

(define (string->version string)
  (and-let* ((version (string-tokenize string (char-set-adjoin char-set:digit #\.)))
             ((pair? version))
             (version (car version))
             (version (string-tokenize version (char-set-complement (char-set #\.)))))  (map string->number version)))

(define required '())
(define* (check-version command expected :optional (deb #f) (version-option '--version) (compare tuple<=))
  (stderr "checking for ~a~a..." command (if (pair? expected) (format #f " [~a]" (version->string expected)) ""))
  (let* ((actual (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
         (actual (string->version actual))
         (pass? (and actual (compare expected actual))))
    (stderr "~a ~a\n" (if pass? (if (pair? actual) "" " yes") (if actual " no, found" "")) (version->string actual))
    (if (not pass?)
        (set! required (cons (or deb command) required)))
    pass?))

(define* (check-pkg-config package expected :optional (deb #f))
  (check-version (format #f "pkg-config --modversion ~a" package) expected deb))

(define (check-compile-header-c++ header)
  (and (= 0 (system (format #f "echo '#include \"~a\"' | gcc --language=c++ --std=c++11 -E - > /dev/null 2>&1" header)))
       'yes))

(define* (check-header-c++ header deb :optional (check check-compile-header-c++))
  (stderr "checking for ~a..." header)
  (let ((result (check header)))
    (stderr " ~a\n" (if result result "no"))
    (if (not result)
        (set! required (cons deb required)))))

(define (main args)
  (let* ((verum? (file-exists? "/verum"))
         (options (parse-opts args)))
    (check-version 'gcc '(4 8))
    (check-version 'g++ '(4 8))
    (check-version 'bison '())
    (check-version 'flex '())
    (check-version 'guile '(2 0) 'guile-2.0)
    (check-version 'guild '(2 0) 'guile-2.0-dev)
    (check-version 'java '(1 8) 'openjdk-8-jre-headless '-version)
    (check-version 'javac '(1 8) 'openjdk-8-jdk '-version)
    (check-version 'mcs '(3) 'mono-mcs)
    (check-version 'npm '())
    (check-version 'pkg-config '(0 25))
    (check-pkg-config 'gtk+-3.0 '())
    (check-pkg-config 'gtkmm-3.0 '())
    (check-version 'psql '(9 3) 'postgresql)
    (check-header-c++ 'boost/algorithm/string.hpp 'libboost-dev))
  (when (pair? required)
    (stderr "\nMissing dependencies, run\n\n")
    (stderr "    sudo apt-get install ~a\n" ((->string " ") required))
    (exit 1))
  (stdout "\nRun:
  make            to build Dezyne
  make help       for help on other targets\n"))


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl