Commit 38f26d9f3aae17e52819d8244d1606ab64edd73b
2014-11-03T10:27:49
Improve shell logging and debug messages.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
diff --git a/shell/sb-shell.lisp b/shell/sb-shell.lisp
index f380bfa..d999510 100644
--- a/shell/sb-shell.lisp
+++ b/shell/sb-shell.lisp
@@ -1,7 +1,7 @@
;;
;; adams - Remote system administration tools
;;
-;; Copyright 2013 Thomas de Grivel <billitch@gmail.com>
+;; Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
;;
;; Permission to use, copy, modify, and distribute this software for any
;; purpose with or without fee is hereby granted, provided that the above
@@ -68,9 +68,8 @@
(sb-ext:process-close process)))))
(defmethod shell-in :after (data (shell sb-shell))
- (when (find 'sb-shell *debug*)
- (format *debug-io* "~A" data)
- (force-output *debug-io*))
+ (when (debug-p :sb-shell)
+ (debug-out "~A" data))
(force-output (sb-ext:process-input (shell-process shell))))
(defmethod shell-in ((data string)
@@ -80,16 +79,13 @@
(defmethod shell-out/line ((shell sb-shell))
(let ((out (read-line (sb-ext:process-output (shell-process shell)) nil nil)))
(when (and out (debug-p :sb-shell))
- (format *debug-io* "~A~%" out)
- (force-output *debug-io*))
+ (debug-out "~A~%" out))
out))
(defmethod shell-err ((shell sb-shell))
(let ((err (read-string (sb-ext:process-error (shell-process shell)))))
- (when (or (find 'shell *debug*)
- (find 'sb-shell *debug*))
- (format *debug-io* "~A" err)
- (force-output *debug-io*))
+ (when (debug-p (or :sb-shell))
+ (debug-out "~A" err))
err))
(defmethod shell-err/line ((shell sb-shell))
diff --git a/shell/shell.lisp b/shell/shell.lisp
index b268bca..8245745 100644
--- a/shell/shell.lisp
+++ b/shell/shell.lisp
@@ -1,7 +1,7 @@
;;
;; adams - Remote system administration tools
;;
-;; Copyright 2013 Thomas de Grivel <billitch@gmail.com>
+;; Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
;;
;; Permission to use, copy, modify, and distribute this software for any
;; purpose with or without fee is hereby granted, provided that the above
@@ -18,19 +18,19 @@
(in-package :adams)
-(defvar *debug* '(:shell))
(defvar *default-shell-command* "/bin/sh")
(defparameter *shell-signal-errors* nil)
+(setf (debug-p :shell) t)
+
;; String functions
(defun read-string (stream)
(with-output-to-string (out)
- (do ((c #1=(when (listen stream)
- (read-char stream))
- #1#))
- ((null c))
- (write-char c out))))
+ (loop for c = (when (listen stream)
+ (read-char stream))
+ while c
+ do (write-char c out))))
(defun make-random-bytes (length)
(let ((seq (make-array length :element-type '(unsigned-byte 8))))
@@ -44,6 +44,11 @@
:uri t)
0 length))
+(defun debug-out (fmt &rest args)
+ (let ((out *debug-io*))
+ (apply #'format out fmt args)
+ (force-output out)))
+
;; Errors
(define-condition shell-error (error)
@@ -92,7 +97,10 @@ Error: ~S"
:reader shell-command)
(delimiter :type string
:reader shell-delimiter
- :initform (make-delimiter))))
+ :initform (make-delimiter))
+ (log-stream :initarg :log-stream
+ :initform t
+ :reader shell-log-stream)))
(defgeneric shell-pid (shell))
(defgeneric shell-new-delimiter (shell))
@@ -103,6 +111,20 @@ Error: ~S"
(defgeneric shell-status (shell))
(defgeneric shell-close (shell))
(defgeneric shell-closed-p (shell))
+(defgeneric shell-run-command (command shell))
+(defgeneric shell-log (shell fmt &rest args))
+(defgeneric shell-log-p (shell))
+
+(defmethod shell-log-p ((shell shell))
+ (when (shell-log-stream shell)
+ t))
+
+(defmethod shell-log ((shell shell) (fmt string) &rest args)
+ (let ((log (shell-log-stream shell)))
+ (when log
+ (format log "~D" (shell-pid shell))
+ (apply #'format log fmt args)
+ (force-output log))))
(defmethod shell-status ((shell shell))
(let* ((delim (make-delimiter))
@@ -116,31 +138,28 @@ Error: ~S"
(and (< len (length line))
(string= delim line :end2 len)))
(when line
- (when (find 'shell *debug*)
- (format *debug-io* "$ ")
- (force-output *debug-io*))
+ (when (debug-p :shell*)
+ (debug-out "$ "))
(parse-integer line :start len)))
(when prev
- (when (find 'shell *debug*)
- (format *debug-io* "~A~%" prev)
- (force-output *debug-io*))
+ (when (debug-p :shell*)
+ (debug-out "~A~%" prev))
(setf (cdr lines-tail) (cons prev nil)
lines-tail (cdr lines-tail)))))
(out (cdr lines-head))
(err (shell-err/line shell)))
- (when (find :shell *debug*)
+ (when (shell-log-p shell)
(dolist (line out)
- (format t "~D│ ~A~%" (shell-pid shell) line))
+ (shell-log shell "│ ~A~%" line))
(dolist (line err)
- (format t "~D┃ ~A~&" (shell-pid shell) line)))
+ (shell-log shell "┃ ~A~&" line))
+ (shell-log shell " ⇒ ~D~%" status))
(values status out err))))
;; Run command
-(defgeneric shell-run-command (command shell))
-
(defmethod shell-run-command ((command string) (shell shell))
- (when (find :shell *debug*)
+ (when (debug-p :shell)
(format t "~D╭ $ ~A~%" (shell-pid shell) command))
(shell-in command shell)
(shell-status shell))