Coverage report: /home/ellis/comp/core/lib/cli/cli.lisp

KindCoveredAll%
expression085 0.0
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; cli.lisp --- CLI Top-level Packages
2
 
3
 ;; 
4
 
5
 ;;; Code:
6
 (in-package :std-user)
7
 
8
 (defpkg :cli
9
   (:use :cl :std :log)
10
   (:import-from :time :format-timestring :timestamp)
11
   #.`(:use-reexport ,@cli/int:*cli-packages*)
12
   (:export :sudop :call-with-sudo :with-sudo :pretty-log-message :*sudo-output* :ensure-sudo))
13
 
14
 (defpkg :cli/tools
15
   (:nicknames :tools)
16
   (:use :cl :std)
17
   #.`(:use-reexport ,@cli/int:*cli-tool-packages*))
18
 
19
 (defpkg :cli/clap
20
   (:nicknames :clap)
21
   (:prelude :clap* 
22
    :defcmd :defopt
23
    :*argc* :*args* :*optc* :*opts* 
24
    :args :arg0
25
    :getopt :find-opt
26
    :*cli* :define-cli)
27
   #.`(:use-reexport ,@cli/int:*cli-clap-packages*))
28
 
29
 (defpkg :cli-user 
30
   (:use :cl :std :cli :tools :clap))
31
 
32
 (in-package :cli)
33
 (pushnew :cli *features*)
34
 
35
 (in-readtable :shell)
36
 
37
 ;;; Sudo
38
 (definline sudop () 
39
   "Return T if effective user appears to be root."
40
   (zerop (sb-posix:geteuid)))
41
 
42
 (defvar *sudo-output* t)
43
 
44
 (defun call-with-sudo (str &optional (output *sudo-output*))
45
   (sb-ext:run-program (find-exe "sudo") `("-S" ,@(split-sequence #\space str)) :input t :output output))
46
 
47
 (defun ensure-sudo ()
48
   "Run sudo with input from *standard-input*, validating the credential cache
49
 only."
50
   (unless (sudop) (sb-ext:run-program (find-exe "sudo") '("-v") :input t :output *sudo-output*)))
51
     
52
 (defmacro with-sudo (&body body)
53
   "Eval BODY, a list of shell command strings, with sudo privileges."
54
   `(progn ,@(mapcar (lambda (x) `(call-with-sudo ,x)) body)))
55
 
56
 ;;; Pretty Log Messages
57
 (defclass pretty-log-message (simple-log-message) ())
58
 
59
 (defmethod format-message (stream (message pretty-log-message))
60
   (let ((*standard-output* stream))
61
     (format stream log::*simple-log-message-formatter*
62
             (with-output-to-string (*standard-output*)
63
               (.sgr 48 5 7)
64
               (format-timestring *standard-output* 
65
                                  (timestamp message) 
66
                                  :format log::*log-timestamp-format*)
67
               (.sgr 0))
68
             (with-output-to-string (*standard-output*)
69
               (.sgr 48 5 7)
70
               (print (level message) *standard-output*)
71
               (.sgr 0))
72
             (with-output-to-string (*standard-output*)
73
               (.sgr 48 5 7)
74
               (print (log::tags message) *standard-output*)
75
               (.sgr 0))
76
             (format-message nil (log::content message)))))