cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 35980a88b773e09e9ab64afbee3161ec3424edec
parent 4e92402f4aa026fb30171b7da76c4506c350b6ed
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sat,  8 Nov 2014 13:20:01 +0100

try clisp port

Diffstat:
Mcl-rw.asd | 4++--
Mhttp.lisp | 2++
Mos.lisp | 65+++++++++++++++++++++++++++++++++++++++++++++--------------------
Msocket.lisp | 15++++++++++++---
Mstring.lisp | 10++++++++--
5 files changed, 69 insertions(+), 27 deletions(-)

diff --git a/cl-rw.asd b/cl-rw.asd @@ -36,7 +36,7 @@ (:file "xml") (:file "email") (:file "os") - (:file "concurrency") + #-clisp(:file "concurrency") (:file "css") (:file "html") (:file "socket") @@ -44,7 +44,7 @@ (:file "http") (:file "net") (:file "calendar") - (:file "ui") + #-clisp(:file "ui") (:file "cas") (:file "zip") (:file "string") diff --git a/http.lisp b/http.lisp @@ -336,6 +336,7 @@ (cons (let ((*standard-output* stream)) (rw.html:html body))) ;; TODO xml, css... (function (funcall body stream)))))))))) +#-clisp (defun server-loop (socket quit handler host port) (do ((q (or quit (rw:reader '(nil t))))) ((funcall q)) @@ -349,6 +350,7 @@ ;; TODO also without threads ;; TODO also thread limit ;; TODO also thread pool +#-clisp (defun server (host port handler &key quit) (let ((s (rw.socket:make-tcp-server-socket host port))) (rw.concurrency:make-thread diff --git a/os.lisp b/os.lisp @@ -42,7 +42,7 @@ (when error-plist (or (cdr (assoc code error-plist)) "")) args))))) - #-(or ccl ecl sbcl cmu #+nil clisp) + #-(or ccl ecl sbcl cmu clisp) (error "RW.OS:MAKE-PROGRAM not ported") #+ccl (let ((p (ccl:run-program cmd @@ -131,25 +131,50 @@ (sb-ext:process-output p))) (:wait (sb-ext:process-wait p)) (:close (ext:process-close p))))) - ;;#+clisp - #+nil - (let ((p (ext:run-program cmd - :arguments args - :input input - :output output - :error nil - :wait nil))) - (let ((status :running)) ;; TODO - (if input - (assert (eq :running status)) - (assert (member status '(:running :exited))))) - (lambda (msg) - (ecase msg - (:fail (fail 0)) ;; TODO - (:status-and-code (values :running 0)) ;; TODO - (:streams (values p p)) - (:wait (ext:process-wait p)) ;; TODO - (:close (close p))))))) + #+clisp ;; TODO how to binary io? how to get exit code? + (cond + ((and input output) + (multiple-value-bind (p i o) + (ext:run-program cmd + :arguments args + :input input + :output output + ;;:error nil + :wait nil) + (when (and p i o) + (close p) + (lambda (msg) + (ecase msg + (:fail (fail 0)) + (:status-and-code (values :running 0)) + (:streams (values i o)) + (:wait) + (:close (close i) + (close o))))))) + ((or input output) + (let ((p (ext:run-program cmd + :arguments args + :input input + :output output + ;;:error nil + :wait nil))) + (when p + (lambda (msg) + (ecase msg + (:fail (fail 0)) + (:status-and-code (values :running 0)) + (:streams (values (when input p) (when output p))) + (:wait) + (:close (close p))))))) + (t + (let (z) + (lambda (msg) + (ecase msg + (:fail (fail z)) + (:status-and-code (values :exited z)) + (:streams) + (:wait (setq z (ext:run-program cmd :arguments args :wait t))) + (:close)))))))) (defun call-with-program (program fn) (unwind-protect diff --git a/socket.lisp b/socket.lisp @@ -36,6 +36,7 @@ (defun close-socket (socket) #-(or ccl ecl sbcl) (error "TODO port RW.SOCKET::CLOSE-SOCKET") + ;; clisp socket:socket-server-close? #+ccl (close socket) #+(or ecl sbcl) @@ -49,8 +50,10 @@ `(call-with-socket ,socket (lambda (,var) ,@body))) (defun make-tcp-server-socket (local-host local-port &key backlog) - #-(or sbcl ecl ccl) + #-(or clisp sbcl ecl ccl) (error "TODO port RW.SOCKET:MAKE-TCP-SERVER-SOCKET") + #+clisp + (socket:socket-server local-port :interface local-host :backlog backlog) #+(or sbcl ecl) (let ((x (make-instance 'sb-bsd-sockets:inet-socket :type :stream @@ -73,8 +76,10 @@ :reuse-address t)) (defun make-tcp-client-socket (remote-host remote-port) - #-(or sbcl ecl ccl) + #-(or clisp sbcl ecl ccl) (error "TODO port RW.SOCKET:MAKE-TCP-CLIENT-SOCKET") + #+clisp + (socket:socket-connect remote-port remote-host) #+(or sbcl ecl) (let ((x (make-instance 'sb-bsd-sockets:inet-socket :type :stream @@ -97,6 +102,8 @@ (defun make-udp-socket (&key local-host local-port remote-host remote-port) #-(or ccl ecl sbcl) (error "TODO port RW.SOCKET:MAKE-PASSIVE-UDP-SOCKET") + ;; #+clisp ;; rawsock not present by default + ;; (rawsock:socket :inet :dgram 0) #+ccl (ccl:make-socket :address-family :internet :type :datagram @@ -128,8 +135,10 @@ ;; fd (defun accept (socket) - #-(or sbcl ecl ccl) + #-(or clisp sbcl ecl ccl) (error "TODO port RW.SOCKET:ACCEPT") + #+clisp + (socket:socket-accept socket) #+(or sbcl ecl) (sb-bsd-sockets:socket-make-stream (sb-bsd-sockets:socket-accept socket) :input t diff --git a/string.lisp b/string.lisp @@ -28,8 +28,11 @@ (in-package :rw.string) (defun octets-to-string (x encoding) - #-(or ecl ccl sbcl) + #-(or clisp ecl ccl sbcl) (error "TODO port RW.STRING:OCTETS-TO-STRING") + #+clisp + (ext:convert-string-from-bytes + x (intern (string encoding) (find-package :charset))) #+ecl (let ((s (ext:make-sequence-input-stream x :external-format encoding))) (coerce (rw:till (rw:peek-reader (rw:char-reader s)) nil nil nil) 'string)) @@ -39,8 +42,11 @@ (sb-ext:octets-to-string x :external-format encoding)) (defun string-to-octets (x encoding) - #-(or ecl ccl sbcl) + #-(or clisp ecl ccl sbcl) (error "TODO port RW.STRING:STRING-TO-OCTETS") + #+clisp + (ext:convert-string-to-bytes + x (intern (string encoding) (find-package :charset))) #+ecl (let ((z (make-array 42 :adjustable t