From 8ea1852ac14710480f2cfe45d4f902a42e3a7f6f Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 19 Aug 2019 23:03:09 +0800 Subject: [PATCH] adding (chibi pty) --- Makefile | 3 +- Makefile.libs | 3 ++ lib/chibi/pty-test.sld | 26 ++++++++++++++++++ lib/chibi/pty.sld | 62 ++++++++++++++++++++++++++++++++++++++++++ lib/chibi/pty.stub | 14 ++++++++++ lib/chibi/stty.sld | 9 +++++- lib/chibi/stty.stub | 1 + tools/chibi-ffi | 2 +- 8 files changed, 117 insertions(+), 3 deletions(-) create mode 100644 lib/chibi/pty-test.sld create mode 100644 lib/chibi/pty.sld create mode 100644 lib/chibi/pty.stub diff --git a/Makefile b/Makefile index 153a6d88..f43e0e9d 100644 --- a/Makefile +++ b/Makefile @@ -41,7 +41,8 @@ CHIBI_COMPILED_LIBS = lib/chibi/filesystem$(SO) lib/chibi/weak$(SO) \ lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO) lib/chibi/ast$(SO) \ lib/chibi/emscripten$(SO) CHIBI_POSIX_COMPILED_LIBS = lib/chibi/process$(SO) lib/chibi/time$(SO) \ - lib/chibi/system$(SO) lib/chibi/stty$(SO) lib/chibi/net$(SO) + lib/chibi/system$(SO) lib/chibi/stty$(SO) lib/chibi/pty$(SO) \ + lib/chibi/net$(SO) CHIBI_WIN32_COMPILED_LIBS = lib/chibi/win32/process-win32$(SO) CHIBI_CRYPTO_COMPILED_LIBS = lib/chibi/crypto/crypto$(SO) CHIBI_IO_COMPILED_LIBS = lib/chibi/io/io$(SO) diff --git a/Makefile.libs b/Makefile.libs index 83b65d87..7a432761 100644 --- a/Makefile.libs +++ b/Makefile.libs @@ -52,6 +52,9 @@ all-libs: $(COMPILED_LIBS) lib/%.c: lib/%.stub $(CHIBI_FFI_DEPENDENCIES) $(CHIBI_FFI) $< +lib/chibi/pty$(SO): lib/chibi/pty.c $(INCLUDES) libchibi-scheme$(SO) + $(CC) $(CLIBFLAGS) $(CLINKFLAGS) $(XCPPFLAGS) $(XCFLAGS) $(LDFLAGS) -o $@ $< -L. $(RLDFLAGS) $(XLIBS) -lchibi-scheme -lutil + lib/%$(SO): lib/%.c $(INCLUDES) libchibi-scheme$(SO) $(CC) $(CLIBFLAGS) $(CLINKFLAGS) $(XCPPFLAGS) $(XCFLAGS) $(LDFLAGS) -o $@ $< -L. $(RLDFLAGS) $(XLIBS) -lchibi-scheme diff --git a/lib/chibi/pty-test.sld b/lib/chibi/pty-test.sld new file mode 100644 index 00000000..02e63ca0 --- /dev/null +++ b/lib/chibi/pty-test.sld @@ -0,0 +1,26 @@ + +(define-library (chibi pty-test) + (import (scheme base) (scheme file) (scheme write) + (chibi io) (chibi pty) (chibi stty) (chibi test)) + (export run-tests) + (begin + (define (run-tests . o) + (when (file-exists? "/usr/bin/units") + (test-begin "pty") + (test '("\t* 3.2808399" "\t/ 0.3048") + (call-with-pty-process-io + '("/usr/bin/units" "-q") + (lambda (pid in out name) + (with-raw-io + out + (lambda () + ;; input with tab completion + (display "mete\t" out) (newline out) + (display "fee\t" out) (newline out) + (display (integer->char 4) out) + (flush-output-port out) + ;; result + (let* ((l1 (read-line in)) + (l2 (read-line in))) + (list l1 l2))))))) + (test-end))))) diff --git a/lib/chibi/pty.sld b/lib/chibi/pty.sld new file mode 100644 index 00000000..2752236a --- /dev/null +++ b/lib/chibi/pty.sld @@ -0,0 +1,62 @@ + +(define-library (chibi pty) + (import (scheme base) + (chibi filesystem) + (chibi process) + (chibi string) + (chibi stty) + (only (chibi) fileno?)) + (export open-pty fork-pty login-tty + open-pty-process call-with-pty-process-io) + (include-shared "pty") + (begin + (define (winsize-arg o) + (cond + ((and (pair? o) (integer? (car o))) + (unless (and (pair? (cdr o)) (integer? (cadr o))) + (error "open-pty expects integer width and height" o)) + (make-winsize (car o) (cadr o))) + ((and (pair? o) (pair? (cdr o))) (cadr o)) + (else #f))) + (define (open-pty . o) + (let ((termios (and (pair? o) (car o))) + (winsize (winsize-arg (if (pair? o) (cdr o) '())))) + (openpty termios winsize))) + (define (fork-pty . o) + (let ((termios (and (pair? o) (car o))) + (winsize (winsize-arg (if (pair? o) (cdr o) '())))) + (forkpty termios winsize))) + (define (open-pty-process command . o) + (let* ((command (if (and (string? command) + (string-find? command #\space)) + (string-split command) + command)) + (pty (apply fork-pty o))) + (cond + ((not (and (pair? pty) (integer? (car pty)) + (not (negative? (car pty))) + (pair? (cdr pty)) (fileno? (cadr pty)))) + (error "failed to fork-pty" pty)) + ((zero? (car pty)) ; child + (execute (car command) command)) + (else ; parent + pty)))) + (define (call-with-pty-process-io command proc . o) + (unless (procedure? proc) + (error "call-with-pty-process-io expected procedure" proc)) + (let ((pty (apply open-pty-process command o))) + (if (and (pair? pty) + (integer? (car pty)) + (not (negative? (car pty))) + (fileno? (cadr pty))) + (let* ((pid (car pty)) + (fd (cadr pty)) + (name (and (pair? (cddr pty)) (car (cddr pty)))) + (in (open-input-file-descriptor fd)) + (out (open-output-file-descriptor fd)) + (res (proc pid in out name))) + (close-input-port in) + (close-output-port out) + (close-file-descriptor fd) + res) + (error "couldn't open-pty-process" command o pty)))))) diff --git a/lib/chibi/pty.stub b/lib/chibi/pty.stub new file mode 100644 index 00000000..5dce198f --- /dev/null +++ b/lib/chibi/pty.stub @@ -0,0 +1,14 @@ + +(c-system-include "pty.h") +(c-system-include "utmp.h") + +(c-link "util") + +(declare-c-struct termios) +(declare-c-struct winsize) + +(define-c errno openpty + ((result fileno) (result fileno) (result (array char 256)) (maybe-null default NULL termios) (maybe-null default NULL winsize))) +(define-c pid_t forkpty + ((result fileno) (result (array char 256)) (maybe-null default NULL termios) (maybe-null default NULL winsize))) +(define-c int (login-tty "login_tty") (fileno)) diff --git a/lib/chibi/stty.sld b/lib/chibi/stty.sld index 77eb4ff3..8aa02b31 100644 --- a/lib/chibi/stty.sld +++ b/lib/chibi/stty.sld @@ -2,7 +2,14 @@ (define-library (chibi stty) (export stty with-stty with-raw-io get-terminal-width get-terminal-dimensions - TCSANOW TCSADRAIN TCSAFLUSH) + TCSANOW TCSADRAIN TCSAFLUSH + winsize winsize? make-winsize winsize-row winsize-col + termios term-attrs? make-term-attrs + ;;term-attrs-iflag term-attrs-iflag-set! + ;;term-attrs-oflag term-attrs-oflag-set! + ;;term-attrs-cflag term-attrs-cflag-set! + ;;term-attrs-lflag term-attrs-lflag-set! + ) (import (chibi) (srfi 69) (srfi 151)) (include-shared "stty") (include "stty.scm")) diff --git a/lib/chibi/stty.stub b/lib/chibi/stty.stub index 421328ba..9973f028 100644 --- a/lib/chibi/stty.stub +++ b/lib/chibi/stty.stub @@ -24,6 +24,7 @@ (define-c-struct winsize predicate: winsize? + constructor: (make-winsize ws_row ws_col) (unsigned-short ws_row winsize-row) (unsigned-short ws_col winsize-col)) diff --git a/tools/chibi-ffi b/tools/chibi-ffi index 7698e3ac..034f67b9 100755 --- a/tools/chibi-ffi +++ b/tools/chibi-ffi @@ -1791,7 +1791,7 @@ (cond (imported? (cat " name = sexp_intern(ctx, \"" scheme-name "\", -1);\n" - " " (type-id-name name) " = sexp_env_ref(env, name, SEXP_FALSE);\n" + " " (type-id-name name) " = sexp_env_ref(ctx, env, name, SEXP_FALSE);\n" " if (sexp_not(" (type-id-name name) ")) {\n" " sexp_warn(ctx, \"couldn't import declared type: \", name);\n" " }\n"))