├── Makefile.am ├── .gitignore ├── src ├── async-process.asd ├── async-process.h ├── async-process.c ├── async-process.lisp └── async-process_windows.lisp ├── LICENSE ├── GNUmakefile ├── configure.ac ├── README.md └── .github └── workflows └── build.yml /Makefile.am: -------------------------------------------------------------------------------- 1 | lib_LTLIBRARIES = libasyncprocess.la 2 | libasyncprocess_la_LDFLAGS = -version-info @LT_VERSION_INFO@ -no-undefined 3 | libasyncprocess_la_SOURCES = src/async-process.c 4 | 5 | include_HEADERS = src/async-process.h 6 | 7 | install-exec-hook: 8 | rm -f $(DESTDIR)$(libdir)/libasyncprocess.la 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.o 3 | *.lo 4 | *.la 5 | .deps 6 | .libs 7 | 8 | Makefile 9 | Makefile.in 10 | configure 11 | config.status 12 | config.guess 13 | config.sub 14 | config.h 15 | config.h.in 16 | install-sh 17 | missing 18 | compile 19 | aclocal.m4 20 | autom4te.cache 21 | stamp-h1 22 | depcomp 23 | config.log 24 | libtool 25 | ltmain.sh 26 | 27 | -------------------------------------------------------------------------------- /src/async-process.asd: -------------------------------------------------------------------------------- 1 | (defsystem "async-process" 2 | :description "asynchronous process execution for common lisp" 3 | :author "cxxxr " 4 | :version "0.0.1" 5 | :license "MIT" 6 | :depends-on ("cffi") 7 | :serial t 8 | :components ((:file "async-process_windows" 9 | :if-feature (:or :win32 :windows)) 10 | (:file "async-process" 11 | :if-feature (:not (:or :win32 :windows))))) 12 | -------------------------------------------------------------------------------- /src/async-process.h: -------------------------------------------------------------------------------- 1 | #ifndef _ASYNC_PROCESS_H_ 2 | #define _ASYNC_PROCESS_H_ 3 | 4 | #ifdef HAVE_CONFIG_H 5 | # include "config.h" 6 | #endif 7 | 8 | #define _GNU_SOURCE 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | 21 | struct process { 22 | char buffer[1024*4]; 23 | int fd; 24 | char *pty_name; 25 | pid_t pid; 26 | }; 27 | 28 | struct process* create_process(char *const command[], bool nonblock, const char *path); 29 | void delete_process(struct process *process); 30 | int process_pid(struct process *process); 31 | void process_send_input(struct process *process, const char *string); 32 | const char* process_receive_output(struct process *process); 33 | int process_alive_p(struct process *process); 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 cxxxr 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /GNUmakefile: -------------------------------------------------------------------------------- 1 | PREFIX ?= /usr/local 2 | 3 | GENERATED_MAKEFILE := $(wildcard Makefile) 4 | 5 | .PHONY: distclean 6 | distclean: 7 | @if [ -f Makefile ]; then \ 8 | echo "Running make distclean..."; \ 9 | $(MAKE) -f Makefile distclean 2>/dev/null || true; \ 10 | fi 11 | @echo "Removing autotools generated files..." 12 | @rm -rf Makefile Makefile.in configure config.* libtool aclocal.m4 stamp-h1 autom4te.cache 13 | @rm -rf compile config.guess config.sub depcomp install-sh ltmain.sh missing 14 | @rm -rf .libs .deps src/.libs src/.deps 15 | @rm -f *.lo *.la src/*.lo src/*.la 16 | @echo "All generated files removed. Run 'make' to rebuild." 17 | 18 | # If Makefile exists, delegate to it 19 | ifneq ($(GENERATED_MAKEFILE),) 20 | 21 | .DEFAULT_GOAL := all 22 | 23 | %: 24 | $(MAKE) -f Makefile $@ 25 | 26 | else 27 | 28 | # No Makefile - need to generate build system 29 | .DEFAULT_GOAL := all 30 | 31 | configure: configure.ac Makefile.am 32 | @echo "Generating build system..." 33 | @which glibtoolize > /dev/null 2>&1 && glibtoolize --copy --force --quiet || libtoolize --copy --force --quiet 34 | @aclocal 35 | @autoheader 36 | @automake --add-missing --copy --foreign 37 | @autoconf 38 | @echo "" 39 | 40 | Makefile: configure 41 | @echo "Running configure..." 42 | @./configure --prefix=$(PREFIX) 43 | @echo "" 44 | 45 | .PHONY: all 46 | all: Makefile 47 | @$(MAKE) -f Makefile all 48 | @echo "" 49 | @echo "Build complete. Install with: make install" 50 | @echo "" 51 | 52 | .PHONY: build 53 | build: all 54 | 55 | .PHONY: install 56 | install: Makefile 57 | @$(MAKE) -f Makefile install 58 | 59 | .PHONY: clean 60 | clean: Makefile 61 | @$(MAKE) -f Makefile clean 62 | 63 | endif 64 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | dnl Get the version number from async-process.asd 2 | m4_define([ASD_VERSION], 3 | m4_esyscmd_s([grep :version src/async-process.asd | cut -d\" -f2])) 4 | AC_INIT([async-process], 5 | [ASD_VERSION]) 6 | AC_CONFIG_HEADERS([config.h]) 7 | 8 | # Library versioning (current:revision:age) 9 | AC_SUBST([LT_VERSION_INFO], [0:0:0]) 10 | 11 | # Set default prefix based on platform if not specified 12 | AC_PREFIX_DEFAULT([/usr/local]) 13 | 14 | AM_INIT_AUTOMAKE([foreign subdir-objects]) 15 | 16 | # Must detect C compiler before initializing libtool 17 | AC_PROG_CC 18 | 19 | # Initialize libtool (disable static by default, enable with --enable-static) 20 | LT_INIT([disable-static]) 21 | 22 | AC_CANONICAL_HOST 23 | test "$prefix" = NONE && prefix=/usr/local 24 | 25 | AC_CHECK_HEADERS([fcntl.h stdlib.h string.h unistd.h]) 26 | 27 | AC_CHECK_HEADER_STDBOOL 28 | AC_TYPE_PID_T 29 | 30 | AC_FUNC_FORK 31 | AC_FUNC_MALLOC 32 | AC_CHECK_FUNCS([dup2 strerror]) 33 | 34 | AC_CONFIG_FILES([Makefile]) 35 | AC_OUTPUT 36 | 37 | # Print configuration summary 38 | AC_MSG_NOTICE([ 39 | async-process configuration summary: 40 | 41 | Installation prefix: $prefix 42 | Library directory: $libdir 43 | Include directory: $includedir 44 | C Compiler: $CC 45 | Host system: $host_os 46 | Build shared: $enable_shared 47 | Build static: $enable_static 48 | 49 | Note: This C library is for Unix-like systems only (Linux, FreeBSD, macOS). 50 | Windows support is provided via pure Lisp CFFI implementation and does not 51 | require C compilation. 52 | 53 | You can now run 'make' to build the library. 54 | After building, run 'make install' to install to the prefix. 55 | 56 | To install to a different location, reconfigure with: 57 | ./configure --prefix=/your/custom/path 58 | 59 | To build static library: 60 | ./configure --enable-static 61 | 62 | To build only static (no shared): 63 | ./configure --enable-static --disable-shared 64 | ]) 65 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # async-process 2 | 3 | A Common Lisp library for creating and managing asynchronous processes with PTY support. 4 | 5 | ## Platform Support 6 | 7 | - **Linux**: Full support via C library using PTY 8 | - **BSD**: Full support via C library using PTY 9 | - **macOS**: Full support via C library using PTY 10 | - **Windows**: Full support via pure Lisp CFFI implementation (no C compilation required) 11 | 12 | ## Installation 13 | 14 | The build system is GNU Autotools, with a somewhat non-standard 15 | setup. 16 | 17 | The default goal `all` in `GNUmakefile` can perform the following 18 | sequence in one go: 19 | 1. Run `autoconf` using `configure.ac` and `Makefile.am` as inputs. 20 | 2. Run `configure` (generated in step 1) to produce a `Makefile`. 21 | 3. Build and compile using the generated `Makefile`. 22 | 23 | ### Unix-like Systems (Linux, FreeBSD, macOS) 24 | using GNU make, `gmake` on Freebsd and macOS. 25 | 26 | ```bash 27 | git clone https://github.com/lem-project/async-process.git 28 | cd async-process 29 | make 30 | sudo make install 31 | ``` 32 | 33 | The library installs to `/usr/local` by default. To install elsewhere: 34 | 35 | To install to a different destination, the `make` command should 36 | be substituted with another similar to the examples below, passing 37 | an explicitly-set `PREFIX` environment variable. 38 | 39 | ```bash 40 | PREFIX=/your/custom/path make 41 | PREFIX=/usr make 42 | PREFIX=$HOME/.local make 43 | ``` 44 | 45 | Alternatively, you can run the Autotools toolchain sequence 46 | as follows, with a slightly different method of setting the 47 | destination prefix: 48 | 49 | ```bash 50 | autoreconf -i 51 | ./configure --prefix=/your/custom/path 52 | make 53 | make install 54 | ``` 55 | 56 | #### Configuration options 57 | Build as a static library as follows 58 | 59 | ```bash 60 | make 61 | ./configure --enable-static 62 | make all 63 | sudo make install 64 | ``` 65 | 66 | ### Windows 67 | 68 | On Windows, no C compilation is required. The library uses a pure Lisp implementation via CFFI: 69 | 70 | ```bash 71 | git clone https://github.com/lem-project/async-process.git 72 | cd async-process 73 | ``` 74 | 75 | Then simply load the library in your Lisp environment: 76 | 77 | ```lisp 78 | (ql:quickload :async-process) 79 | ``` 80 | 81 | The ASDF system will automatically load the Windows-specific implementation (`src/async-process_windows.lisp`) when on Windows platforms. 82 | 83 | ## Usage 84 | 85 | ``` 86 | CL-USER> (ql:quickload :async-process) 87 | To load "async-process": 88 | Load 1 ASDF system: 89 | async-process 90 | ; Loading "async-process" 91 | .................................................. 92 | [package async-process]. 93 | (:ASYNC-PROCESS) 94 | CL-USER> (in-package async-process) 95 | # 96 | ASYNC-PROCESS> (create-process "python") 97 | #.(SB-SYS:INT-SAP #X7FFFEC002830) 98 | ASYNC-PROCESS> (defparameter p *) 99 | #.(SB-SYS:INT-SAP #X7FFFEC002830) 100 | ASYNC-PROCESS> (process-receive-output p) 101 | "Python 2.7.13 (default, Nov 24 2017, 17:33:09) 102 | [GCC 6.3.0 20170516] on linux2 103 | Type \"help\", \"copyright\", \"credits\" or \"license\" for more information. 104 | >>> " 105 | ASYNC-PROCESS> (process-send-input p "1+1 106 | ") 107 | ; No value 108 | ASYNC-PROCESS> (process-receive-output p) 109 | "1+1 110 | 2 111 | >>> " 112 | ``` 113 | 114 | ## LICENSE 115 | MIT 116 | -------------------------------------------------------------------------------- /src/async-process.c: -------------------------------------------------------------------------------- 1 | #include "async-process.h" 2 | 3 | static const char* open_pty(int *out_fd) 4 | { 5 | int fd = posix_openpt(O_RDWR | O_CLOEXEC | O_NOCTTY); 6 | if (fd < 0) return NULL; 7 | if (grantpt(fd) == -1 || unlockpt(fd) == -1) return NULL; 8 | fcntl(fd, F_SETFD, FD_CLOEXEC); 9 | const char *name = ptsname(fd); 10 | if (name == NULL) { 11 | close(fd); 12 | return NULL; 13 | } 14 | *out_fd = fd; 15 | return name; 16 | } 17 | 18 | static struct process* allocate_process(int fd, const char *pts_name, int pid) 19 | { 20 | struct process *process = malloc(sizeof(struct process)); 21 | if (process == NULL) 22 | return NULL; 23 | process->fd = fd; 24 | process->pty_name = malloc(strlen(pts_name) + 1); 25 | process->pid = pid; 26 | strcpy(process->pty_name, pts_name); 27 | return process; 28 | } 29 | 30 | void my_exit(int status) { 31 | // exitを使うとatexitで動作に影響を与えられる、これが原因でプロセスを終了できなくなる事があるので使うのを避ける 32 | // 例えばSDL2はat_exitを使っているせいか、lemのSDL2 frontendでasync_processが動作しなくなっていた 33 | _exit(status); 34 | } 35 | 36 | struct process* create_process(char *const command[], bool nonblock, const char *path) 37 | { 38 | int pty_master; 39 | const char *pts_name = open_pty(&pty_master); 40 | if (pts_name == NULL) 41 | return NULL; 42 | 43 | if (nonblock) 44 | fcntl(pty_master, F_SETFL, O_NONBLOCK); 45 | 46 | int pipefd[2]; 47 | 48 | if (pipe(pipefd) == -1) return NULL; 49 | 50 | pid_t pid = fork(); 51 | 52 | if (pid == 0) { 53 | close(pipefd[0]); 54 | pid = fork(); 55 | if (pid == 0) { 56 | close(pipefd[1]); 57 | setsid(); 58 | int pty_slave = open(pts_name, O_RDWR | O_NOCTTY); 59 | close(pty_master); 60 | 61 | // Set raw mode 62 | struct termios tty; 63 | tcgetattr(pty_slave, &tty); 64 | cfmakeraw(&tty); 65 | tcsetattr(pty_slave, TCSANOW, &tty); 66 | 67 | dup2(pty_slave, STDIN_FILENO); 68 | dup2(pty_slave, STDOUT_FILENO); 69 | dup2(pty_slave, STDERR_FILENO); 70 | close(pty_slave); 71 | if (path != NULL) chdir(path); 72 | execvp(command[0], command); 73 | int error_status = errno; 74 | if (error_status == ENOENT) { 75 | char str[128]; 76 | sprintf(str, "%s: command not found", command[0]); 77 | write(STDIN_FILENO, str, strlen(str)); 78 | } else { 79 | char *str = strerror(error_status); 80 | write(STDIN_FILENO, str, strlen(str)); 81 | } 82 | my_exit(error_status); 83 | } else { 84 | char buf[12]; 85 | sprintf(buf, "%d", pid); 86 | write(pipefd[1], buf, strlen(buf)+1); 87 | close(pipefd[1]); 88 | my_exit(0); 89 | } 90 | } else { 91 | close(pipefd[1]); 92 | if (waitpid(pid, NULL, 0) == -1) 93 | return NULL; 94 | char buf[12]; 95 | read(pipefd[0], buf, sizeof(buf)); 96 | close(pipefd[0]); 97 | return allocate_process(pty_master, pts_name, atoi(buf)); 98 | } 99 | 100 | return NULL; 101 | } 102 | 103 | void delete_process(struct process *process) 104 | { 105 | kill(process->pid, 9); 106 | close(process->fd); 107 | free(process->pty_name); 108 | free(process); 109 | } 110 | 111 | int process_pid(struct process *process) 112 | { 113 | return process->pid; 114 | } 115 | 116 | void process_send_input(struct process *process, const char *string) 117 | { 118 | write(process->fd, string, strlen(string)); 119 | } 120 | 121 | const char* process_receive_output(struct process *process) 122 | { 123 | int n = read(process->fd, process->buffer, sizeof(process->buffer)-1); 124 | if (n == -1) 125 | return NULL; 126 | process->buffer[n] = '\0'; 127 | return process->buffer; 128 | } 129 | 130 | int process_alive_p(struct process *process) 131 | { 132 | return kill(process->pid, 0) == 0; 133 | } 134 | -------------------------------------------------------------------------------- /src/async-process.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :async-process 2 | (:use :cl) 3 | (:export 4 | :delete-process 5 | :process-send-input 6 | :process-receive-output 7 | :process-alive-p 8 | :create-process)) 9 | (in-package :async-process) 10 | 11 | (eval-when (:compile-toplevel :load-toplevel :execute) 12 | (defun system (cmd) 13 | (ignore-errors (string-right-trim '(#\Newline) (uiop:run-program cmd :output :string)))) 14 | (defun muslp () 15 | (ignore-errors 16 | (not (zerop (length (uiop:run-program 17 | "ldd /bin/ls |grep musl" 18 | :ignore-error-status t 19 | :output :string))))))) 20 | 21 | (pushnew (asdf:system-relative-pathname 22 | :async-process 23 | (format nil "../static/~A/" 24 | (cond 25 | ;; Windows 26 | ((uiop/os:featurep '(:and :windows :x86-64)) 27 | "x86_64/windows") 28 | ((uiop/os:featurep :windows) 29 | "x86/windows") 30 | ;; macOS (Darwin) 31 | ((uiop/os:featurep :os-macosx) 32 | (format nil "~A/darwin" 33 | (uiop:run-program '("uname" "-m") :output '(:string :stripped t)))) 34 | ;; Linux / Generic Unix 35 | ((uiop/os:featurep :unix) 36 | (format nil "~A/~A" 37 | (uiop:run-program '("uname" "-m") :output '(:string :stripped t)) 38 | (let ((os (uiop:run-program '("uname") :output '(:string :stripped t)))) 39 | (cond ((and (equal os "Linux") 40 | (ignore-errors (funcall (read-from-string "muslp")))) 41 | "Linux-musl") 42 | (t os)))))))) 43 | cffi:*foreign-library-directories* 44 | :test #'uiop:pathname-equal) 45 | 46 | (cffi:define-foreign-library async-process 47 | (:darwin "libasyncprocess.dylib") 48 | (:unix "libasyncprocess.so") 49 | (:windows "libasyncprocess.dll")) 50 | 51 | (cffi:use-foreign-library async-process) 52 | 53 | (defclass process () 54 | ((process :reader process-process :initarg :process) 55 | (encode :accessor process-encode :initarg :encode))) 56 | 57 | (cffi:defcfun ("create_process" %create-process) :pointer 58 | (command :pointer) 59 | (nonblock :boolean) 60 | (path :string)) 61 | 62 | (cffi:defcfun ("delete_process" %delete-process) :void 63 | (process :pointer)) 64 | 65 | (cffi:defcfun ("process_pid" %process-pid) :int 66 | (process :pointer)) 67 | 68 | (cffi:defcfun ("process_send_input" %process-send-input) :void 69 | (process :pointer) 70 | (string :string)) 71 | 72 | (cffi:defcfun ("process_receive_output" %process-receive-output) :pointer 73 | (process :pointer)) 74 | 75 | (cffi:defcfun ("process_alive_p" %process-alive-p) :boolean 76 | (process :pointer)) 77 | 78 | (defun create-process (command &key nonblock (encode cffi:*default-foreign-encoding*) directory) 79 | (when (and directory (not (uiop:directory-exists-p directory))) 80 | (error "Directory ~S does not exist" directory)) 81 | (let* ((command (uiop:ensure-list command)) 82 | (length (length command))) 83 | (cffi:with-foreign-object (argv :string (1+ length)) 84 | (loop :for i :from 0 85 | :for c :in command 86 | :do (setf (cffi:mem-aref argv :string i) c)) 87 | (setf (cffi:mem-aref argv :string length) (cffi:null-pointer)) 88 | (let ((p (%create-process argv nonblock (if directory 89 | (namestring directory) 90 | (cffi:null-pointer))))) 91 | (if (cffi:null-pointer-p p) 92 | (error "create-process failed: ~S" command) 93 | (make-instance 'process :process p :encode encode)))))) 94 | 95 | (defun delete-process (process) 96 | (%delete-process (process-process process))) 97 | 98 | (defun process-pid (process) 99 | (%process-pid (process-process process))) 100 | 101 | (defun process-send-input (process string) 102 | (let ((cffi:*default-foreign-encoding* (process-encode process))) 103 | (%process-send-input (process-process process) string))) 104 | 105 | (defun pointer-to-string (pointer) 106 | (unless (cffi:null-pointer-p pointer) 107 | (let* ((bytes (loop :for i :from 0 108 | :for code := (cffi:mem-aref pointer :unsigned-char i) 109 | :until (zerop code) 110 | :collect code)) 111 | (octets (make-array (length bytes) 112 | :element-type '(unsigned-byte 8) 113 | :initial-contents bytes))) 114 | (handler-case (babel:octets-to-string octets) 115 | (error () 116 | ;; Fallback when an error occurs with UTF-8 encoding 117 | (map 'string #'code-char octets)))))) 118 | 119 | (defun process-receive-output (process) 120 | (let ((cffi:*default-foreign-encoding* (process-encode process))) 121 | (pointer-to-string (%process-receive-output (process-process process))))) 122 | 123 | (defun process-alive-p (process) 124 | (%process-alive-p (process-process process))) 125 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | 3 | on: 4 | push: 5 | pull_request: 6 | 7 | jobs: 8 | build-linux-x86_64: 9 | runs-on: ubuntu-latest 10 | timeout-minutes: 90 11 | env: 12 | OS_NAME: Linux 13 | ARCH_NAME: x86_64 14 | LIB_NAME: libasyncprocess.a 15 | RESULT_NAME: result-linux-x86_64 16 | RESULT_PATH: result-linux-x86_64 17 | RESULT_PATH_SUB: result-async/static 18 | steps: 19 | - uses: actions/checkout@v4 20 | - name: Install 21 | run: | 22 | sudo apt-get update 23 | sudo apt-get install libtool automake 24 | - name: Build 25 | run: | 26 | gcc -v 27 | # Generate build system 28 | libtoolize --copy --force --quiet 29 | aclocal 30 | autoheader 31 | automake --add-missing --copy --foreign 32 | autoconf 33 | # Configure for static library build 34 | ./configure --enable-static --disable-shared 35 | make 36 | - name: Verify static library 37 | run: | 38 | file .libs/$LIB_NAME 39 | ls -lh .libs/$LIB_NAME 40 | - name: Copy Result 41 | if: always() 42 | run: | 43 | mkdir -p $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME 44 | cp .libs/$LIB_NAME $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME/ 45 | - name: Upload Result 46 | if: always() 47 | uses: actions/upload-artifact@v4 48 | with: 49 | name: ${{ env.RESULT_NAME }} 50 | path: ${{ env.RESULT_PATH }} 51 | 52 | build-linux-aarch64: 53 | runs-on: ubuntu-latest 54 | timeout-minutes: 90 55 | env: 56 | OS_NAME: Linux 57 | ARCH_NAME: aarch64 58 | LIB_NAME: libasyncprocess.a 59 | RESULT_NAME: result-linux-aarch64 60 | RESULT_PATH: result-linux-aarch64 61 | RESULT_PATH_SUB: result-async/static 62 | steps: 63 | - uses: actions/checkout@v4 64 | - name: Build on aarch64 (arm64) 65 | uses: uraimo/run-on-arch-action@v2 66 | with: 67 | arch: aarch64 68 | distro: ubuntu22.04 69 | githubToken: ${{ github.token }} 70 | install: | 71 | apt-get update -q -y 72 | apt-get install -q -y build-essential automake libtool file 73 | run: | 74 | pwd 75 | uname -a 76 | gcc --version 77 | # Generate build system 78 | libtoolize --copy --force --quiet 79 | aclocal 80 | autoheader 81 | automake --add-missing --copy --foreign 82 | autoconf 83 | # Configure for static library build 84 | ./configure --enable-static --disable-shared 85 | make 86 | # Verify static library 87 | file .libs/libasyncprocess.a 88 | ls -lh .libs/libasyncprocess.a 89 | - name: Copy Result 90 | if: always() 91 | run: | 92 | mkdir -p $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME 93 | cp .libs/$LIB_NAME $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME/ 94 | - name: Upload Result 95 | if: always() 96 | uses: actions/upload-artifact@v4 97 | with: 98 | name: ${{ env.RESULT_NAME }} 99 | path: ${{ env.RESULT_PATH }} 100 | 101 | build-osx-aarch64: 102 | runs-on: macos-14 # macOS 14 runs on Apple Silicon (aarch64/arm64) 103 | timeout-minutes: 90 104 | env: 105 | OS_NAME: Darwin 106 | ARCH_NAME: aarch64 107 | LIB_NAME: libasyncprocess.a 108 | RESULT_NAME: result-osx-aarch64 109 | RESULT_PATH: result-osx-aarch64 110 | RESULT_PATH_SUB: result-async/static 111 | steps: 112 | - uses: actions/checkout@v4 113 | - name: Install tools 114 | run: | 115 | brew install automake 116 | brew install libtool 117 | - name: Build 118 | run: | 119 | gcc -v 120 | # Generate build system 121 | glibtoolize --copy --force --quiet 122 | aclocal 123 | autoheader 124 | automake --add-missing --copy --foreign 125 | autoconf 126 | # Configure for static library build 127 | ./configure --enable-static --disable-shared 128 | make 129 | - name: Verify static library 130 | run: | 131 | file .libs/$LIB_NAME 132 | ls -lh .libs/$LIB_NAME 133 | lipo -info .libs/$LIB_NAME 134 | - name: Copy Result 135 | if: always() 136 | run: | 137 | mkdir -p $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME 138 | cp .libs/$LIB_NAME $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME/ 139 | - name: Upload Result 140 | if: always() 141 | uses: actions/upload-artifact@v4 142 | with: 143 | name: ${{ env.RESULT_NAME }} 144 | path: ${{ env.RESULT_PATH }} 145 | 146 | build-osx-x86_64: 147 | runs-on: macos-13 # macOS 13 runs on Intel (x86_64) 148 | timeout-minutes: 90 149 | env: 150 | OS_NAME: Darwin 151 | ARCH_NAME: x86_64 152 | LIB_NAME: libasyncprocess.a 153 | RESULT_NAME: result-osx-x86_64 154 | RESULT_PATH: result-osx-x86_64 155 | RESULT_PATH_SUB: result-async/static 156 | steps: 157 | - uses: actions/checkout@v4 158 | - name: Install tools 159 | run: | 160 | brew install automake 161 | brew install libtool 162 | - name: Build 163 | run: | 164 | gcc -v 165 | # Generate build system 166 | glibtoolize --copy --force --quiet 167 | aclocal 168 | autoheader 169 | automake --add-missing --copy --foreign 170 | autoconf 171 | # Configure for static library build 172 | ./configure --enable-static --disable-shared 173 | make 174 | - name: Verify static library 175 | run: | 176 | file .libs/$LIB_NAME 177 | ls -lh .libs/$LIB_NAME 178 | lipo -info .libs/$LIB_NAME 179 | - name: Copy Result 180 | if: always() 181 | run: | 182 | mkdir -p $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME 183 | cp .libs/$LIB_NAME $RESULT_PATH/$RESULT_PATH_SUB/$ARCH_NAME/$OS_NAME/ 184 | - name: Upload Result 185 | if: always() 186 | uses: actions/upload-artifact@v4 187 | with: 188 | name: ${{ env.RESULT_NAME }} 189 | path: ${{ env.RESULT_PATH }} 190 | 191 | release: 192 | runs-on: ubuntu-latest 193 | needs: [build-linux-x86_64, build-linux-aarch64, build-osx-aarch64, build-osx-x86_64] 194 | if: startsWith(github.ref, 'refs/tags/') 195 | steps: 196 | - name: Download all artifacts 197 | uses: actions/download-artifact@v4 198 | with: 199 | path: artifacts 200 | 201 | - name: Prepare release files 202 | run: | 203 | mkdir -p release-files 204 | echo "Finding all .a files in artifacts..." 205 | find artifacts -name "*.a" -type f 206 | echo "" 207 | echo "Creating uniquely named release files..." 208 | # Find and rename all library files with their arch and os 209 | find artifacts -name "*.a" -type f | while read file; do 210 | # Extract the directory structure to get arch and os 211 | dir=$(dirname "$file") 212 | arch=$(basename "$(dirname "$dir")") 213 | os=$(basename "$dir") 214 | # Normalize OS name to lowercase for consistency 215 | os_lower=$(echo "$os" | tr '[:upper:]' '[:lower:]') 216 | # Create a unique filename: libasyncprocess.{os}.{arch}.a 217 | output_name="libasyncprocess.${os_lower}.${arch}.a" 218 | echo " $file -> release-files/$output_name" 219 | cp "$file" "release-files/$output_name" 220 | done 221 | echo "" 222 | echo "Release files ready for upload:" 223 | ls -lh release-files/ 224 | 225 | - name: Create Release 226 | uses: softprops/action-gh-release@v1 227 | with: 228 | files: release-files/* -------------------------------------------------------------------------------- /src/async-process_windows.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :async-process 2 | (:use :cl) 3 | (:export 4 | :delete-process 5 | :process-send-input 6 | :process-receive-output 7 | :process-alive-p 8 | :create-process)) 9 | (in-package :async-process) 10 | 11 | ;; Windows API definitions via CFFI 12 | (cffi:define-foreign-library kernel32 13 | (:windows "kernel32.dll")) 14 | 15 | (cffi:use-foreign-library kernel32) 16 | 17 | ;; Constants 18 | (defconstant +invalid-handle-value+ #xFFFFFFFF) 19 | (defconstant +create-no-window+ #x08000000) 20 | (defconstant +startf-usestdhandles+ #x00000100) 21 | (defconstant +startf-useshowwindow+ #x00000001) 22 | (defconstant +sw-hide+ 0) 23 | (defconstant +duplicate-same-access+ #x00000002) 24 | (defconstant +still-active+ 259) 25 | 26 | ;; Structures 27 | (cffi:defcstruct security-attributes 28 | (length :uint32) 29 | (security-descriptor :pointer) 30 | (inherit-handle :boolean)) 31 | 32 | (cffi:defcstruct startup-info 33 | (cb :uint32) 34 | (reserved :pointer) 35 | (desktop :pointer) 36 | (title :pointer) 37 | (x :uint32) 38 | (y :uint32) 39 | (x-size :uint32) 40 | (y-size :uint32) 41 | (x-count-chars :uint32) 42 | (y-count-chars :uint32) 43 | (fill-attribute :uint32) 44 | (flags :uint32) 45 | (show-window :uint16) 46 | (cb-reserved2 :uint16) 47 | (reserved2 :pointer) 48 | (std-input :pointer) 49 | (std-output :pointer) 50 | (std-error :pointer)) 51 | 52 | (cffi:defcstruct process-information 53 | (process :pointer) 54 | (thread :pointer) 55 | (process-id :uint32) 56 | (thread-id :uint32)) 57 | 58 | ;; Windows API functions 59 | (cffi:defcfun ("CreatePipe" create-pipe) :boolean 60 | (read-pipe (:pointer :pointer)) 61 | (write-pipe (:pointer :pointer)) 62 | (pipe-attributes (:pointer (:struct security-attributes))) 63 | (size :uint32)) 64 | 65 | (cffi:defcfun ("CreateProcessW" create-process-w) :boolean 66 | (application-name :pointer) 67 | (command-line :pointer) 68 | (process-attributes :pointer) 69 | (thread-attributes :pointer) 70 | (inherit-handles :boolean) 71 | (creation-flags :uint32) 72 | (environment :pointer) 73 | (current-directory :pointer) 74 | (startup-info (:pointer (:struct startup-info))) 75 | (process-information (:pointer (:struct process-information)))) 76 | 77 | (cffi:defcfun ("DuplicateHandle" duplicate-handle) :boolean 78 | (source-process :pointer) 79 | (source-handle :pointer) 80 | (target-process :pointer) 81 | (target-handle (:pointer :pointer)) 82 | (desired-access :uint32) 83 | (inherit-handle :boolean) 84 | (options :uint32)) 85 | 86 | (cffi:defcfun ("GetCurrentProcess" get-current-process) :pointer) 87 | 88 | (cffi:defcfun ("CloseHandle" close-handle) :boolean 89 | (object :pointer)) 90 | 91 | (cffi:defcfun ("WriteFile" write-file) :boolean 92 | (file :pointer) 93 | (buffer :string) 94 | (number-of-bytes-to-write :uint32) 95 | (number-of-bytes-written (:pointer :uint32)) 96 | (overlapped :pointer)) 97 | 98 | (cffi:defcfun ("ReadFile" read-file) :boolean 99 | (file :pointer) 100 | (buffer :pointer) 101 | (number-of-bytes-to-read :uint32) 102 | (number-of-bytes-read (:pointer :uint32)) 103 | (overlapped :pointer)) 104 | 105 | (cffi:defcfun ("PeekNamedPipe" peek-named-pipe) :boolean 106 | (pipe :pointer) 107 | (buffer :pointer) 108 | (buffer-size :uint32) 109 | (bytes-read (:pointer :uint32)) 110 | (total-bytes-avail (:pointer :uint32)) 111 | (bytes-left-this-message (:pointer :uint32))) 112 | 113 | (cffi:defcfun ("GetExitCodeProcess" get-exit-code-process) :boolean 114 | (process :pointer) 115 | (exit-code (:pointer :uint32))) 116 | 117 | (cffi:defcfun ("TerminateProcess" terminate-process) :boolean 118 | (process :pointer) 119 | (exit-code :uint32)) 120 | 121 | ;; Process class 122 | (defclass process () 123 | ((process-info :accessor process-process-info :initarg :process-info) 124 | (input-handle :accessor process-input-handle :initarg :input-handle) 125 | (output-handle :accessor process-output-handle :initarg :output-handle) 126 | (nonblock :accessor process-nonblock :initarg :nonblock) 127 | (encode :accessor process-encode :initarg :encode))) 128 | 129 | (defun create-process (command &key nonblock (encode cffi:*default-foreign-encoding*) directory) 130 | "Create a new process with the given command" 131 | (when (and directory (not (uiop:directory-exists-p directory))) 132 | (error "Directory ~S does not exist" directory)) 133 | 134 | (let ((command-string (if (listp command) 135 | (format nil "~{~A~^ ~}" command) 136 | command))) 137 | 138 | (cffi:with-foreign-objects ((sa '(:struct security-attributes)) 139 | (output-read-tmp :pointer) 140 | (output-write :pointer) 141 | (input-read :pointer) 142 | (input-write-tmp :pointer) 143 | (output-read :pointer) 144 | (input-write :pointer) 145 | (si '(:struct startup-info)) 146 | (pi- '(:struct process-information))) 147 | 148 | ;; Initialize security attributes 149 | (setf (cffi:foreign-slot-value sa '(:struct security-attributes) 'length) 150 | (cffi:foreign-type-size '(:struct security-attributes))) 151 | (setf (cffi:foreign-slot-value sa '(:struct security-attributes) 'security-descriptor) 152 | (cffi:null-pointer)) 153 | (setf (cffi:foreign-slot-value sa '(:struct security-attributes) 'inherit-handle) 154 | t) 155 | 156 | ;; Create pipes 157 | (unless (create-pipe output-read-tmp output-write sa 0) 158 | (error "Failed to create output pipe")) 159 | 160 | (unless (create-pipe input-read input-write-tmp sa 0) 161 | (error "Failed to create input pipe")) 162 | 163 | (let ((curr-process (get-current-process))) 164 | ;; Duplicate handles 165 | (unless (duplicate-handle curr-process 166 | (cffi:mem-ref output-read-tmp :pointer) 167 | curr-process 168 | output-read 169 | 0 nil +duplicate-same-access+) 170 | (error "Failed to duplicate output read handle")) 171 | 172 | (unless (duplicate-handle curr-process 173 | (cffi:mem-ref input-write-tmp :pointer) 174 | curr-process 175 | input-write 176 | 0 nil +duplicate-same-access+) 177 | (error "Failed to duplicate input write handle"))) 178 | 179 | ;; Close temporary handles 180 | (close-handle (cffi:mem-ref output-read-tmp :pointer)) 181 | (close-handle (cffi:mem-ref input-write-tmp :pointer)) 182 | 183 | ;; Initialize startup info 184 | (cffi:foreign-funcall "memset" :pointer si :int 0 :uint32 185 | (cffi:foreign-type-size '(:struct startup-info)) :void) 186 | (setf (cffi:foreign-slot-value si '(:struct startup-info) 'cb) 187 | (cffi:foreign-type-size '(:struct startup-info))) 188 | (setf (cffi:foreign-slot-value si '(:struct startup-info) 'flags) 189 | (logior +startf-usestdhandles+ +startf-useshowwindow+)) 190 | (setf (cffi:foreign-slot-value si '(:struct startup-info) 'show-window) 191 | +sw-hide+) 192 | (setf (cffi:foreign-slot-value si '(:struct startup-info) 'std-input) 193 | (cffi:mem-ref input-read :pointer)) 194 | (setf (cffi:foreign-slot-value si '(:struct startup-info) 'std-output) 195 | (cffi:mem-ref output-write :pointer)) 196 | (setf (cffi:foreign-slot-value si '(:struct startup-info) 'std-error) 197 | (cffi:mem-ref output-write :pointer)) 198 | 199 | ;; Create process 200 | (cffi:with-foreign-strings ((cmd-wide command-string :encoding :utf-16le) 201 | (dir-wide (if directory (namestring directory) ""))) 202 | (unless (create-process-w (cffi:null-pointer) 203 | cmd-wide 204 | (cffi:null-pointer) 205 | (cffi:null-pointer) 206 | t 207 | +create-no-window+ 208 | (cffi:null-pointer) 209 | (if directory dir-wide (cffi:null-pointer)) 210 | si 211 | pi-) 212 | (error "Failed to create process: ~A" command-string))) 213 | 214 | ;; Close handles we don't need 215 | (close-handle (cffi:mem-ref output-write :pointer)) 216 | (close-handle (cffi:mem-ref input-read :pointer)) 217 | 218 | ;; Create and return process object 219 | (make-instance 'process 220 | :process-info pi- 221 | :input-handle (cffi:mem-ref input-write :pointer) 222 | :output-handle (cffi:mem-ref output-read :pointer) 223 | :nonblock nonblock 224 | :encode encode)))) 225 | 226 | (defun delete-process (process) 227 | "Terminate and clean up the process" 228 | (let ((pi- (process-process-info process))) 229 | (terminate-process (cffi:foreign-slot-value pi- '(:struct process-information) 'process) 2) 230 | (close-handle (process-input-handle process)) 231 | (close-handle (process-output-handle process)) 232 | (close-handle (cffi:foreign-slot-value pi- '(:struct process-information) 'thread)) 233 | (close-handle (cffi:foreign-slot-value pi- '(:struct process-information) 'process)))) 234 | 235 | (defun process-pid (process) 236 | "Get the process ID" 237 | (cffi:foreign-slot-value (process-process-info process) '(:struct process-information) 'process-id)) 238 | 239 | (defun process-send-input (process string) 240 | "Send input to the process" 241 | (cffi:with-foreign-object (bytes-written :uint32) 242 | (let ((cffi:*default-foreign-encoding* (process-encode process))) 243 | (write-file (process-input-handle process) 244 | string 245 | (length string) 246 | bytes-written 247 | (cffi:null-pointer))))) 248 | 249 | (defun process-receive-output (process) 250 | "Receive output from the process" 251 | (let ((buffer-size 4096)) 252 | (cffi:with-foreign-objects ((buffer :char buffer-size) 253 | (bytes-read :uint32) 254 | (bytes-avail :uint32)) 255 | 256 | ;; Check if data is available (for non-blocking mode) 257 | (when (process-nonblock process) 258 | (unless (peek-named-pipe (process-output-handle process) 259 | (cffi:null-pointer) 0 260 | (cffi:null-pointer) 261 | bytes-avail 262 | (cffi:null-pointer)) 263 | (return-from process-receive-output nil)) 264 | (when (zerop (cffi:mem-ref bytes-avail :uint32)) 265 | (return-from process-receive-output nil))) 266 | 267 | ;; Read data 268 | (when (read-file (process-output-handle process) 269 | buffer 270 | (1- buffer-size) 271 | bytes-read 272 | (cffi:null-pointer)) 273 | (let ((num-bytes (cffi:mem-ref bytes-read :uint32))) 274 | (when (> num-bytes 0) 275 | (setf (cffi:mem-aref buffer :char num-bytes) 0) 276 | (let ((cffi:*default-foreign-encoding* (process-encode process))) 277 | (cffi:foreign-string-to-lisp buffer :count num-bytes)))))))) 278 | 279 | (defun process-alive-p (process) 280 | "Check if the process is still running" 281 | (cffi:with-foreign-object (exit-code :uint32) 282 | (let ((pi- (process-process-info process))) 283 | (when (get-exit-code-process (cffi:foreign-slot-value pi- '(:struct process-information) 'process) 284 | exit-code) 285 | (= (cffi:mem-ref exit-code :uint32) +still-active+))))) --------------------------------------------------------------------------------