cl-rw

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

commit ca90a372f4b0738eaf586ed027984bfc2791a02b
parent 5f2eb3a3c1cd0412c8fa8a7709c6692debc738de
Author: Tomas Hlavaty <tom@logand.com>
Date:   Wed, 28 Aug 2013 22:28:16 +0200

rw.os added

Diffstat:
Mcl-rw.asd | 1+
Mnet.lisp | 12++----------
Aos.lisp | 103+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 106 insertions(+), 10 deletions(-)

diff --git a/cl-rw.asd b/cl-rw.asd @@ -40,4 +40,5 @@ (:file "base64") (:file "xml") (:file "email") + (:file "os") (:file "net"))) diff --git a/net.lisp b/net.lisp @@ -27,16 +27,8 @@ (in-package :rw.net) -(defun run-command (cmd args &optional error-plist) - (let ((code - #+ccl(ccl::external-process-%exit-code (ccl:run-program cmd args)) - #-ccl(error "TODO port IPP.WGET::RUN-COMMAND"))) - (unless (zerop code) - (let ((reason (or (cdr (assoc code error-plist)) ""))) - (error (format nil "~a error ~d: ~a ~s" cmd code reason args)))))) - (defun wget (url &key request-file response-file content-type) - (run-command + (rw.os:run-command "wget" `("-q" ,@ (when request-file @@ -59,7 +51,7 @@ ;;(rw.xml:parse-xml #p"/tmp/a.html") (defun curl (url &key request-file response-file content-type) - (run-command + (rw.os:run-command "curl" `("-s" ,@ (when request-file diff --git a/os.lisp b/os.lisp @@ -0,0 +1,103 @@ +;;; Copyright (C) 2013 Tomas Hlavaty <tom@logand.com> +;;; +;;; Permission is hereby granted, free of charge, to any person +;;; obtaining a copy of this software and associated documentation +;;; files (the "Software"), to deal in the Software without +;;; restriction, including without limitation the rights to use, copy, +;;; modify, merge, publish, distribute, sublicense, and/or sell copies +;;; of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;;; DEALINGS IN THE SOFTWARE. + +(defpackage :rw.os + (:use :cl) + (:export :run-command + :sha1sum + :with-program-output)) + +(in-package :rw.os) + +(defun throw-error (cmd args code error-plist) + (when error-plist + (let ((reason (or (cdr (assoc code error-plist)) ""))) + (error (format nil "~a error ~d: ~a ~s" cmd code reason args))))) + +(defun run-command (cmd args &optional error-plist) + #-(or cmu sbcl clisp openmcl) + (error "TODO port RW.OS:RUN-COMMAND") + (let ((p + #+cmu(ext:run-program cmd args) + #+sbcl(sb-ext:run-program cmd args :search t) + #+clisp(ext:run-program cmd :arguments args) + #+openmcl(ccl:run-program cmd args))) + (when p + (unwind-protect + (let ((code #+cmu(ext:process-exit-code p) + #+sbcl(sb-ext:process-exit-code p) + #+clisp 0 + #+openmcl(multiple-value-bind (a b) + (ccl:external-process-status p) + (declare (ignore a)) + b))) + (if (eq 0 code) + t + (throw-error cmd args code error-plist))) + #+cmu(ext:process-close p) + #+sbcl(sb-ext:process-close p) + #+openmcl(flet ((finish (x) (when x (close x)))) + (finish (ccl:external-process-output-stream p)) + (finish (ccl:external-process-input-stream p)) + (finish (ccl:external-process-error-stream p))))))) + +(defun call-with-program-output (cmd args error-plist fn) + #-(or cmu sbcl clisp openmcl) + (error "TODO port RW.OS::CALL-WITH-PROGRAM-OUTPUT") + (let ((p + #+cmu(ext:run-program cmd args :output :stream) + #+sbcl(sb-ext:run-program cmd args :output :stream :search t) + #+clisp(ext:run-program cmd :arguments args :output :stream) + #+openmcl(ccl:run-program cmd args :output :stream))) + (when p + (unwind-protect + (let ((code #+cmu(ext:process-exit-code p) + #+sbcl(sb-ext:process-exit-code p) + #+clisp 0 + #+openmcl(multiple-value-bind (a b) + (ccl:external-process-status p) + (declare (ignore a)) + b))) + (if (eq 0 code) + (funcall fn + #+cmu(ext:process-output p) + #+sbcl(sb-ext:process-output p) + #+clisp p + #+openmcl(ccl:external-process-output-stream p)) + (throw-error cmd args code error-plist))) + #+cmu(ext:process-close p) + #+sbcl(sb-ext:process-close p) + #+openmcl(flet ((finish (x) (when x (close x)))) + (finish (ccl:external-process-output-stream p)) + (finish (ccl:external-process-input-stream p)) + (finish (ccl:external-process-error-stream p))))))) + +(defmacro with-program-output ((var cmd args &optional error-plist) &body body) + `(call-with-program-output ,cmd ,args ,error-plist (lambda (,var) ,@body))) + +(defun sha1sum (file) + (let ((name (format nil "~a" file))) + (with-program-output (s "sha1sum" (list name)) + (rw:till (rw:peek-reader (rw:char-reader s)) '(#\space))))) + +;;(sha1sum "/etc/passwd") +;;(sha1sum "/etc/passwd2")