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

KindCoveredAll%
expression26114 22.8
branch212 16.7
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/cli/env.lisp --- Shell Environments
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (in-package :cli/env)
7
 
8
 (defvar *default-global-env-var-names* 
9
   '("LOG_LEVEL" "CORE_HOME" "PACKY_URL" "VC_URL" "INFRA_HOME" "KRYPT_HOME" "SKEL_HOME" "LISP" "ESHELL" "ORGANIZATION" "TERM"))
10
 (defvar *default-local-env-var-names* 
11
   '("PREFIX" "STASHDIR" "STOREDIR" "BINDIR" "LIBDIR" "DATADIR" "CARGO_TARGET_DIR"))
12
 
13
 (defvar *env-table* (make-hash-table :test 'equal))
14
 
15
 (defun load-env (&optional (scope (append *default-local-env-var-names* 
16
                                           *default-global-env-var-names*)))
17
   "Load the environment variables specified by SCOPE."
18
   (dolist (e scope)
19
     (setf (gethash e *env-table*) (sb-posix:getenv e))))
20
 
21
 (declaim (inline exec-path-list))
22
 (defun exec-path-list ()
23
   "Return a list of all members of PATH"
24
   (let ((var (sb-posix:getenv "PATH")))
25
     (let ((lst (loop for i = 0 then (1+ j)
26
                      as j = (position #\: var :start i)
27
                      when (uiop:directory-exists-p (probe-file (subseq var i j)))
28
                        collect (probe-file (subseq var i j))
29
                      while j)))
30
       (unless (null (car lst))
31
         (mapcar (lambda (x) (car (directory x)))
32
                 lst)))))
33
 
34
 (defun program-list ()
35
   "Return a fresh list of all files in PATH directories."
36
   (loop for p in (exec-path-list)
37
         append (uiop:directory-files p)))
38
 
39
 (defun find-exe (name &optional programs)
40
   "Find NAME in list of PROGRAMS, defaulting to the result of #'program-list."
41
   (let ((name (pathname name)))
42
     (find name (or programs (program-list))
43
           :test (lambda (x y)
44
                   (and (equal (pathname-name x) (pathname-name y))
45
                        (equal (pathname-type x) (pathname-type y)))))))
46
 
47
 (declaim (inline ld-library-path-list))
48
 (defun ld-library-path-list ()
49
   (let ((var (sb-posix:getenv "LD_LIBRARY_PATH")))
50
     (let ((lst (loop for i = 0 then (1+ j)
51
                      as j = (position #\: var :start i)
52
                      collect (subseq var i j)
53
                      while j)))
54
       (unless (null (car lst))
55
         (mapcar (lambda (x) (car (directory x))) lst)))))
56
 
57
 (defun make-env-var (k v)
58
   (concatenate 'string k "=" v))
59
 
60
 (defun concat-env-table (table)
61
   "Concatenate key val pairs in hash-table TABLE to strings of the form
62
   'key=val'. Returns a list which can be passed directly to the :ENVIRONMENT
63
   slot of SB-EXT:RUN-PROGRAM."
64
   (let ((ret))
65
     (flet ((%make (k v) (push (make-env-var k v) ret)))
66
       (maphash #'%make table))
67
     ret))