commit ca90a372f4b0738eaf586ed027984bfc2791a02b
parent 5f2eb3a3c1cd0412c8fa8a7709c6692debc738de
Author: Tomas Hlavaty <tom@logand.com>
Date: Wed, 28 Aug 2013 22:28:16 +0200
rw.os added
Diffstat:
| M | cl-rw.asd | | | 1 | + |
| M | net.lisp | | | 12 | ++---------- |
| A | os.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")
