changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/cli/env.lisp

changeset 698: 96958d3eb5b0
parent: 6359b351657a
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     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_ROOT" "PACKY_ROOT" "INFRA_ROOT" "KRYPT_ROOT" "SKEL_ROOT" "LISP" "ESHELL" "ORGANIZATION" "TERM"))
    10 (defvar *default-local-env-var-names* 
    11   '("PREFIX" "STASHDIR" "STOREDIR" "BINDIR" "LIBDIR" "DATADIR" "CARGO_TARGET_DIR"))
    12 
    13 (declaim (inline exec-path-list))
    14 (defun exec-path-list ()
    15   "Return a list of all members of PATH"
    16   (let ((var (sb-posix:getenv "PATH")))
    17     (let ((lst (loop for i = 0 then (1+ j)
    18 		     as j = (position #\: var :start i)
    19                      when (uiop:directory-exists-p (probe-file (subseq var i j)))
    20 		       collect (probe-file (subseq var i j))
    21 		     while j)))
    22       (unless (null (car lst))
    23         (mapcar (lambda (x) (car (directory x)))
    24                 lst)))))
    25 
    26 (defun program-list ()
    27   "Return a fresh list of all files in PATH directories."
    28   (loop for p in (exec-path-list)
    29         append (uiop:directory-files p)))
    30 
    31 (defun find-exe (name &optional programs)
    32   "Find NAME in list of PROGRAMS, defaulting to the result of #'program-list."
    33   (let ((name (pathname name)))
    34     (find name (or programs (program-list))
    35           :test (lambda (x y)
    36                   (and (equal (pathname-name x) (pathname-name y))
    37                        (equal (pathname-type x) (pathname-type y)))))))
    38 
    39 (declaim (inline ld-library-path-list))
    40 (defun ld-library-path-list ()
    41   (let ((var (sb-posix:getenv "LD_LIBRARY_PATH")))
    42     (let ((lst (loop for i = 0 then (1+ j)
    43 		     as j = (position #\: var :start i)
    44 		     collect (subseq var i j)
    45 		     while j)))
    46       (unless (null (car lst))
    47         (mapcar (lambda (x) (car (directory x))) lst)))))
    48 
    49 (defun make-env-var (k v)
    50   (concatenate 'string k "=" v))
    51 
    52 (defun concat-env-table (table)
    53   "Concatenate key val pairs in hash-table TABLE to strings of the form
    54   'key=val'. Returns a list which can be passed directly to the :ENVIRONMENT
    55   slot of SB-EXT:RUN-PROGRAM."
    56   (let ((ret))
    57     (flet ((%make (k v) (push (make-env-var k v) ret)))
    58       (maphash #'%make table))
    59     ret))