├── README.md ├── clexec.lisp ├── clsh-addons.lisp ├── clsh-tests.asd ├── clsh-tests.lisp ├── clsh.asd ├── defpackage.lisp ├── example.lisp ├── quicklisp.lisp ├── unix-streams.lisp └── utils.lisp /README.md: -------------------------------------------------------------------------------- 1 | # Clsh 2 | 3 | Clsh is a set of Lispy bindings for running and composing *nix processes. 4 | 5 | ## Rationale 6 | 7 | Common Lisp is amazing, but unfortunately sometimes libraries are not present that we need. More often than not, we have access to a command line tool that we can use to perform a given task. 8 | 9 | ## Example 10 | ```lisp 11 | (in-package :clsh-user) 12 | 13 | (in-readtable :clsh-syntax) 14 | 15 | ;; outputs "hello world" 16 | (with-programs ("echo") 17 | (to *standard-output* 18 | (echo :arguments '("hello world")))) 19 | 20 | ;; outputs lines that match "bin" 21 | (with-programs ("ls" "grep") 22 | (to *standard-output* 23 | (pipe ls 24 | (grep "bin")))) 25 | 26 | ;; outputs computer's hostname 27 | (with-programs ("echo") 28 | (to *standard-output* 29 | (echo :arguments (list $HOSTNAME)))) 30 | 31 | ;; creates an environment variable FOO set to "val" 32 | (setf $FOO "val") 33 | 34 | ;; outputs "val" 35 | (with-programs ("echo") 36 | (to *standard-output* 37 | (echo :arguments (list $FOO)))) 38 | ``` 39 | 40 | For more example usage, see `example.lisp` 41 | 42 | ## CL Extensions 43 | Common Lisp functions can arbitrarily be mixed with shell functions. 44 | To do this, one might try something like: 45 | ```lisp 46 | (in-package :clsh-user) 47 | 48 | (use-package :unix-streams) 49 | 50 | (defun my-outputter (&key stdin arguments) 51 | (declare (ignore arguments)) 52 | (when (not stdin) 53 | (error "ERROR missing stdin in call to my-outputter")) 54 | (loop for x = (read-line stdin nil) 55 | while x 56 | do (format t "~a~%" x) 57 | finally (unix-close (unix-stream-file-descriptor stdin)))) 58 | 59 | (with-programs ("echo") 60 | (pipe (echo "hello world") my-outputter)) 61 | ``` 62 | 63 | This way, it is possible to parse complex data structure (e.g. JSON, etc) returned from external processes. 64 | 65 | ## License and Copyright 66 | Copyright 2018, Maxwell Taylor. Provided under the terms specified in the MIT license. 67 | -------------------------------------------------------------------------------- /clexec.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clexec) 2 | 3 | (defcvar "errno" :int) 4 | 5 | (defcfun ("fork" unix-fork) :long 6 | "forks a process") 7 | 8 | (defcfun ("pipe" unix-pipe) :int 9 | "pipefd is a int[2]. pipefd[0] is the read-end, pipefd[1] is write-end" 10 | (pipefd :pointer)) 11 | 12 | (defun lisp-pipe () 13 | (with-foreign-object (pipe-array :int 2) 14 | (when (not (zerop (unix-pipe pipe-array))) 15 | (error "FATAL ERROR! Unable to create pipe @ lisp-pipe")) 16 | (values (translate-from-foreign (mem-aref pipe-array :int 0) :int) 17 | (translate-from-foreign (mem-aref pipe-array :int 1) :int)))) 18 | 19 | (defcfun ("execve" unix-execve) :int 20 | "filename, argv, envp" 21 | (filename :string) 22 | (argv :pointer) 23 | (envp :pointer)) 24 | 25 | (defcfun "dup2" :int 26 | (oldfd :int) 27 | (newfd :int)) 28 | 29 | (defun parentp (pid) 30 | "returns T when a pid obtained from fork indicates this is the parent" 31 | (not (zerop pid))) 32 | 33 | (defun childp (pid) 34 | "returns T when a pid obtained from fork indicates this is the child" 35 | (zerop pid)) 36 | 37 | (defun lisp-execve (filename arguments environment) 38 | "Executes execve. 39 | Filename must be an absolute path to an executable. 40 | Arguments are the executable's argv. 41 | Environment is the environment list for the program." 42 | (let ((argv (string-list-to-array arguments)) 43 | (envp (string-list-to-array environment))) 44 | (unix-execve filename argv envp))) 45 | 46 | (defun path-search-list () 47 | "returns the PATH environment variable string" 48 | (environment-variable "PATH")) 49 | 50 | (defun search-for-program-in-directory (program-name directory) 51 | (check-type directory string) 52 | (loop for file in (directory (concatenate 'string 53 | directory 54 | "/*")) 55 | when (string= (file-namestring file) program-name) 56 | do (return (truename file)))) 57 | 58 | (defun search-for-program (program-name) 59 | "returns the absolute path to program-name or nil" 60 | (let ((paths (split-sequence #\: (path-search-list)))) 61 | (if (probe-file program-name) 62 | program-name 63 | (loop for path in paths 64 | for maybe-program = (search-for-program-in-directory 65 | program-name path) 66 | when maybe-program do (return maybe-program))))) 67 | 68 | (defun execute-program (name &key arguments environment execute-thunk) 69 | (let* ((program-path (namestring 70 | (or (search-for-program name) 71 | (error "Cannot find ~S in PATH" name)))) 72 | (pid (unix-fork))) 73 | (cond ((parentp pid) pid) 74 | ((childp pid) 75 | (when execute-thunk 76 | (funcall execute-thunk)) 77 | (lisp-execve program-path 78 | (cons program-path arguments) 79 | environment))))) 80 | 81 | (defun execute-as-shell (name &rest arguments ) 82 | (multiple-value-bind (stdin stdout) (lisp-pipe) 83 | (execute-program name 84 | :arguments arguments 85 | :environment (environment-simple-list) 86 | :execute-thunk 87 | #'(lambda () 88 | (dup2 stdin 0) 89 | (dup2 stdout 1) 90 | (unix-close stdin) 91 | (unix-close stdout))) 92 | (values stdin stdout))) 93 | 94 | (defun make-dup-handle (input-fd output-fd) 95 | #'(lambda () 96 | (when (not (= input-fd 0)) 97 | (dup2 input-fd 0) 98 | (unix-close input-fd)) 99 | (when (not (= output-fd 1)) 100 | (dup2 output-fd 1) 101 | (unix-close output-fd)))) 102 | 103 | (defmacro with-programs (program-list &rest body) 104 | (let ((input-stream-var (gensym "input-stream")) 105 | (read-end-var (gensym "read-end")) 106 | (write-end-var (gensym "write-end"))) 107 | `(let ((,input-stream-var (make-instance 'unix-input-stream 108 | :file-descriptor 0))) 109 | (labels 110 | ,(loop for program in program-list 111 | collecting 112 | (list (string-as-symbol program) 113 | `(&key (stdin ,input-stream-var) 114 | arguments) 115 | `(multiple-value-bind (,read-end-var ,write-end-var) 116 | (lisp-pipe) 117 | (check-string-list arguments) 118 | (execute-program ,program 119 | :arguments arguments 120 | :environment 121 | (environment-simple-list) 122 | :execute-thunk 123 | (make-dup-handle 124 | (unix-stream-file-descriptor 125 | stdin) 126 | ,write-end-var)) 127 | (unix-close ,write-end-var) 128 | (make-instance 'unix-input-stream 129 | :file-descriptor ,read-end-var)))) 130 | ,@body)))) 131 | 132 | (defun to (destination-stream source-stream &optional (close-on-eof t)) 133 | "Directs the output of stream-b to stream-a, closing source-stream 134 | on end of file when close-on-eof is enabled (default)." 135 | (loop for line = (read-line source-stream nil) 136 | while line 137 | do (format destination-stream "~a~%" line) 138 | finally 139 | (when close-on-eof 140 | (unix-close (unix-stream-file-descriptor source-stream))))) 141 | 142 | (defun pipe-lines-to-fn (&key stdin arguments) 143 | "Returns a unix-input-stream. Each line read from stdin 144 | is supplied to the car of arguments and the resulting value made 145 | available in the input-stream. 146 | (car arguments) is executed in a separate thread." 147 | (when (null stdin) 148 | (error "missing stdin argument at pipe-lines-to-fn")) 149 | (when (null arguments) 150 | (error "missing function argument at pipe-lines-to-fn")) 151 | (multiple-value-bind (read-end write-end) (lisp-pipe) 152 | (let ((istream (make-instance 'unix-input-stream :file-descriptor read-end)) 153 | (ostream (make-instance 'unix-output-stream :file-descriptor write-end)) 154 | (lisp-handler (car arguments))) 155 | (make-thread 156 | #'(lambda () 157 | (loop for x = (read-line stdin nil) 158 | while x 159 | do (format ostream "~a~%" (funcall lisp-handler x))))) 160 | istream))) 161 | 162 | (defmacro pipe-helper (previous-form-result &rest forms) 163 | (cond ((null forms) previous-form-result) 164 | ((consp (car forms)) 165 | `(pipe-helper 166 | ,(append (list (caar forms) :arguments `(list ,@(cdar forms))) 167 | (list :stdin previous-form-result)) 168 | ,@(cdr forms))) 169 | ((atom (car forms)) 170 | `(pipe-helper 171 | ,(append (list (car forms)) (list :stdin previous-form-result)) 172 | ,@(cdr forms))))) 173 | 174 | (defmacro pipe (&rest forms) 175 | "Pipes stdout of the first form to stdin of the next form. 176 | The first form can be either an atom or a function-call." 177 | (cond ((consp (car forms)) 178 | `(pipe-helper ,(list (caar forms) 179 | :arguments 180 | `(list ,@(cdar forms))) 181 | ,@(cdr forms))) 182 | ((atom (car forms)) 183 | `(pipe-helper ,(list (car forms)) ,@(cdr forms))))) 184 | -------------------------------------------------------------------------------- /clsh-addons.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clsh-addons) 2 | 3 | (defun read-env-variable (stream char) 4 | (declare (ignore char)) 5 | `(environment-variable 6 | ,(let ((*readtable* (copy-readtable))) 7 | (setf (readtable-case *readtable*) :preserve) 8 | (SYMBOL-NAME (READ STREAM))))) 9 | 10 | 11 | (defreadtable :clsh-syntax 12 | (:merge :standard) 13 | (:macro-char #\$ #'read-env-variable)) 14 | -------------------------------------------------------------------------------- /clsh-tests.asd: -------------------------------------------------------------------------------- 1 | (defpackage :clsh-tests-asd 2 | (:use :cl 3 | :asdf)) 4 | 5 | (in-package :clsh-tests-asd) 6 | 7 | (defsystem clsh-tests 8 | :depends-on ("clsh" 9 | "prove") 10 | :defsystem-depends-on (:prove-asdf) 11 | :components ((:test-file "clsh-tests")) 12 | :perform (test-op :after (op c) 13 | (funcall (intern #.(string :run) :prove) c))) 14 | -------------------------------------------------------------------------------- /clsh-tests.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :clsh-tests 2 | (:use :cl 3 | :clexec 4 | :prove 5 | :unix-streams)) 6 | 7 | (in-package :clsh-tests) 8 | 9 | (defparameter *file-fd* nil) 10 | (defparameter *file-output-stream* nil) 11 | (defparameter *file-input-stream* nil) 12 | 13 | (subtest "Testing unix-streams" 14 | (plan 8) 15 | 16 | (setf *file-fd* (lisp-open "clsh:test" '(:create :output))) 17 | 18 | (ok (and (integerp *file-fd*) (not (zerop *file-fd*))) 19 | "File opened with create and output mode") 20 | 21 | (setf *file-output-stream* 22 | (make-instance 'unix-output-stream :file-descriptor *file-fd*)) 23 | 24 | (is (format *file-output-stream* "hello world~%") nil 25 | "`format` call looks normal") 26 | 27 | (is (unix-close *file-fd*) 0 28 | "`unix-close` call looks normal") 29 | 30 | (setf *file-fd* (lisp-open "clsh:test" '(:input))) 31 | 32 | (ok (and (integerp *file-fd*) (not (zerop *file-fd*))) 33 | "File opened with input mode") 34 | 35 | (setf *file-input-stream* 36 | (make-instance 'unix-input-stream :file-descriptor *file-fd*)) 37 | 38 | (is (read-line *file-input-stream* nil) "hello world" :test #'string=) 39 | 40 | (is (read-line *file-input-stream* nil :eof) :eof) 41 | 42 | (is (unix-close *file-fd*) 0 43 | "`unix-close` call looks normal") 44 | 45 | (delete-file "clsh:test") 46 | 47 | (is-error (lisp-open "clsh:test" nil) 'simple-error) 48 | 49 | (finalize)) 50 | 51 | (subtest "Testing clexec" 52 | (plan 5) 53 | 54 | (is (childp 0) t 55 | "a pid of 0 is a child's") 56 | 57 | (is (childp 1) nil 58 | "a pid not 0 is not a child's") 59 | 60 | (is (parentp 0) nil 61 | "a pid of 0 is not a parent's") 62 | 63 | (is (parentp 1) t 64 | "a pid of not 0 is a parent's") 65 | 66 | ;; `echo` should be findable in $PATH 67 | (isnt (search-for-program "echo") nil) 68 | (finalize)) 69 | -------------------------------------------------------------------------------- /clsh.asd: -------------------------------------------------------------------------------- 1 | (defpackage :clsh-asd 2 | (:use :cl 3 | :asdf)) 4 | 5 | (in-package :clsh-asd) 6 | 7 | (defsystem clsh 8 | :name "clsh" 9 | :version "0.5.0" 10 | :maintainer "Max Taylor" 11 | :author "Max Taylor" 12 | :license "MIT" 13 | :description "Provides the ability to run and compose UNIX programs" 14 | :serial t 15 | :depends-on ("bordeaux-threads" 16 | "cffi" 17 | "named-readtables" 18 | "osicat" 19 | "prove" 20 | "split-sequence" 21 | "trivial-gray-streams") 22 | :components ((:file "defpackage") 23 | (:file "utils") 24 | (:file "unix-streams") 25 | (:file "clexec") 26 | (:file "clsh-addons")) 27 | :in-order-to ((test-op (test-op clsh-test)))) 28 | 29 | (defsystem clsh-test 30 | :depends-on ("clsh" 31 | "prove") 32 | :defsystem-depends-on (:prove-asdf) 33 | :components ((:test-file "clsh-tests")) 34 | :perform (test-op :after (op c) 35 | (funcall (intern #.(string :run) :prove) c))) 36 | -------------------------------------------------------------------------------- /defpackage.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :unix-streams 2 | (:use :cffi 3 | :cl 4 | :trivial-gray-streams) 5 | (:export lisp-open 6 | make-unix-io-stream 7 | unix-close 8 | unix-input-stream 9 | unix-output-stream 10 | unix-stream-file-descriptor 11 | with-file-descriptor-as-ostream)) 12 | 13 | (defpackage :utils 14 | (:use :cffi 15 | :cl 16 | :osicat) 17 | (:export check-string-list 18 | environment-simple-list 19 | free-array-strings 20 | string-as-symbol 21 | string-list-to-array)) 22 | 23 | (defpackage :clexec 24 | (:use :bordeaux-threads 25 | :cffi 26 | :cl 27 | :osicat 28 | :split-sequence 29 | :unix-streams 30 | :utils) 31 | (:export childp 32 | execute-program 33 | lisp-execve 34 | make-dup-handle 35 | parentp 36 | pipe 37 | pipe-lines-to-fn 38 | search-for-program 39 | to 40 | unix-fork 41 | with-programs)) 42 | 43 | (defpackage :clsh-addons 44 | (:use :cl 45 | :named-readtables 46 | :osicat 47 | :utils) 48 | (:export enable-var-reader)) 49 | 50 | (defpackage :clsh-user 51 | (:use :cl 52 | :clsh-addons 53 | :clexec 54 | :named-readtables 55 | :osicat)) 56 | -------------------------------------------------------------------------------- /example.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clsh-user) 2 | 3 | (in-readtable :clsh-syntax) 4 | 5 | ;; lists the contents of the directory and outputs to *standard-output* 6 | (with-programs ("ls") 7 | (to *standard-output* (ls))) 8 | 9 | ;; echoes the HOSTNAME environment variable 10 | (with-programs ("echo") 11 | (to *standard-output* 12 | (echo :arguments (list $HOSTNAME)))) 13 | 14 | ;; lists the contents of the directory and finds contents containing "bin" 15 | ;; notice in a pipe context, you dont specify arguments as a list 16 | (with-programs ("ls" "grep") 17 | (to *standard-output* 18 | (pipe ls 19 | (grep "bin")))) 20 | 21 | ;; creates an environment variable named MY_ENV_VAR set to "foo" 22 | (setf $MY_ENV_VAR "foo") 23 | (with-programs ("echo") 24 | (to *standard-output* 25 | (echo :arguments (list $MY_ENV_VAR)))) 26 | -------------------------------------------------------------------------------- /quicklisp.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload :bordeaux-threads) 2 | (ql:quickload :cffi) 3 | (ql:quickload :named-readtables) 4 | (ql:quickload :osicat) 5 | (ql:quickload :prove) 6 | (ql:quickload :split-sequence) 7 | (ql:quickload :trivial-gray-streams) 8 | -------------------------------------------------------------------------------- /unix-streams.lisp: -------------------------------------------------------------------------------- 1 | (in-package :unix-streams) 2 | 3 | (defconstant +line-buffer-size+ 16) 4 | 5 | (defclass unix-stream () ()) 6 | 7 | (defcvar "errno" :int) 8 | 9 | (defclass unix-output-stream (unix-stream 10 | fundamental-character-output-stream) 11 | ((file-descriptor :initarg :file-descriptor 12 | :accessor unix-stream-file-descriptor))) 13 | 14 | (defmethod stream-output-type ((stream unix-output-stream)) 15 | 'standard-char) 16 | 17 | (defmethod output-stream-p ((stream unix-output-stream)) 18 | t) 19 | 20 | (defmethod input-stream-p ((stream unix-output-stream)) 21 | nil) 22 | 23 | (defcfun ("write" unix-write) :long 24 | "writes count bytes of buf to a fd" 25 | (fd :int) 26 | (buf :pointer) 27 | (count :long)) 28 | 29 | (defun lisp-write-string (fd str) 30 | (with-foreign-string (c-str str) 31 | (unix-write fd c-str (length str)))) 32 | 33 | (defmethod stream-write-char ((stream unix-output-stream) char) 34 | (lisp-write-string (unix-stream-file-descriptor stream) (string char))) 35 | 36 | (defmethod stream-write-string ((stream unix-output-stream) string 37 | &optional (start 0) (end (length string))) 38 | (lisp-write-string (unix-stream-file-descriptor stream) 39 | (subseq string start end))) 40 | 41 | (defmacro with-file-descriptor-as-ostream ((stream-name fd) &rest body) 42 | `(let ((,stream-name (make-instance 'unix-output-stream 43 | :file-descriptor ,fd))) 44 | ,@body)) 45 | 46 | (defclass unix-input-stream (unix-stream 47 | fundamental-character-output-stream) 48 | ((file-descriptor :initarg :file-descriptor 49 | :accessor unix-stream-file-descriptor))) 50 | 51 | (defmethod stream-input-type ((stream unix-input-stream)) 52 | 'standard-char) 53 | 54 | (defmethod output-stream-p ((stream unix-input-stream)) 55 | nil) 56 | 57 | (defmethod input-stream-p ((stream unix-input-stream)) 58 | t) 59 | 60 | (defcfun ("read" unix-read) :long 61 | "reads up to count bytes into buf from fd" 62 | (fd :int) 63 | (buf :pointer) 64 | (count :long)) 65 | 66 | (defun lisp-read-char (fd) 67 | (with-foreign-object (char :char) 68 | (let ((read-result (unix-read fd char 1))) 69 | (cond ((zerop read-result) :eof) 70 | ((= read-result -1) (error "read error: ~a" *errno*)) 71 | (t (char (foreign-string-to-lisp char :count 1) 0)))))) 72 | 73 | (defmethod stream-read-char ((stream unix-input-stream)) 74 | (lisp-read-char (unix-stream-file-descriptor stream))) 75 | 76 | (defmethod stream-read-line ((stream unix-input-stream)) 77 | (let ((char-buffer (make-array +line-buffer-size+ 78 | :element-type 'character 79 | :adjustable t 80 | :fill-pointer 0))) 81 | (loop for x = (lisp-read-char (unix-stream-file-descriptor stream)) 82 | if (eq x :eof) 83 | do (return (values (coerce char-buffer 'string) t)) 84 | else if (eql x #\newline) 85 | do (return (values (coerce char-buffer 'string) nil)) 86 | else do (vector-push-extend x char-buffer +line-buffer-size+)))) 87 | 88 | (defmacro with-file-descriptor-as-istream ((stream-name fd) &rest body) 89 | `(let ((,stream-name (make-instance 'unix-input-stream 90 | :file-descriptor ,fd))) 91 | ,@body)) 92 | 93 | ;;; NOTE - this section is just here for testing! DO NOT USE ELSEWHERE! 94 | 95 | (defconstant +read-only+ 0) 96 | (defconstant +write-only+ 1) 97 | (defconstant +read-write+ 2) 98 | (defconstant +append+ 2000) 99 | (defconstant +create+ 100) 100 | 101 | (defcfun ("open" unix-open) :int 102 | "Opens pathname with flags" 103 | (pathname :string) 104 | (flags :int)) 105 | 106 | (defun parse-lisp-flags (flag-list) 107 | (logior 108 | ;; read or write access 109 | (or (and (member :input flag-list) 110 | (member :output flag-list) 111 | +read-write+) 112 | (and (member :output flag-list) +write-only+) 113 | +read-only+) 114 | (or (and (member :create flag-list) +create+) 0) 115 | (or (and (member :append flag-list) +append+) 0))) 116 | 117 | (defun lisp-open (path flags) 118 | "opens path for reading. flags are a list of file open flags, 119 | containing possibly :input, :output, :append, :create." 120 | (let ((fd (unix-open path (parse-lisp-flags flags)))) 121 | (if (< fd 0) 122 | (error "Error opening ~S" path) fd))) 123 | 124 | (defmacro with-open-fd ((name path mode) &rest body) 125 | (let ((body-result-var (gensym "body-result"))) 126 | `(let* ((,name (lisp-open ,path ,mode)) 127 | (,body-result-var (progn ,@body))) 128 | (unix-close ,name) 129 | ,body-result-var))) 130 | 131 | ;;; END TEST SUPPORT SECTION 132 | 133 | (defcfun ("close" unix-close) :int 134 | "closes fd" 135 | (fd :int)) 136 | 137 | (defun make-unix-io-stream (input-fd output-fd) 138 | (make-two-way-stream 139 | (make-instance 'unix-input-stream :file-descriptor input-fd) 140 | (make-instance 'unix-output-stream :file-descriptor output-fd))) 141 | -------------------------------------------------------------------------------- /utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :utils) 2 | 3 | (defun string-list-to-array (string-list) 4 | (if string-list 5 | (let ((array (foreign-alloc :pointer :count (1+ (length string-list))))) 6 | (dotimes (i (length string-list)) 7 | (setf (mem-aref array :pointer i) 8 | (foreign-string-alloc (nth i string-list)))) 9 | (setf (mem-aref array :pointer (length string-list)) (null-pointer)) 10 | array) 11 | (null-pointer))) 12 | 13 | (defun free-array-strings (array-strings length) 14 | "frees a char** of length `length`" 15 | (dotimes (i length (foreign-free array-strings)) 16 | (foreign-string-free (mem-aref array-strings :pointer i)))) 17 | 18 | (defun string-as-symbol (string) 19 | "returns string read as a symbol" 20 | (check-type string string) 21 | (with-input-from-string (stream string) 22 | (read stream))) 23 | 24 | (defun environment-simple-list () 25 | "returns the environment variable as a simple list" 26 | (loop for (k . v) in (environment) 27 | collecting (concatenate 'string k "=" v))) 28 | 29 | (defun check-string-list (string-list) 30 | (check-type string-list list) 31 | (dolist (x string-list) 32 | (check-type x string))) 33 | 34 | --------------------------------------------------------------------------------