Commit 74761f6a authored by Eric Timmons's avatar Eric Timmons
Browse files

cli less work: exec

parent 8d708b8b
......@@ -6,19 +6,12 @@
(uiop:define-package #:clpm-cli/commands/exec
(:use #:cl
#:clpm-cli/common-args
#:clpm-cli/interface-defs
#:clpm/client
#:clpm/config
#:clpm/context
#:clpm/execvpe
#:clpm/log
#:clpm/source)
(:import-from #:adopt))
#:clpm-cli/interface-defs)
(:import-from #:adopt)
(:import-from #:clpm))
(in-package #:clpm-cli/commands/exec)
(setup-logger)
(defparameter *option-with-client*
(adopt:make-option
:exec-with-client
......@@ -37,29 +30,4 @@
*option-with-client*)))
(define-cli-command (("exec") *exec-ui*) (args options)
(let* ((context-name (config-value :context))
(context (get-context context-name))
(with-client (gethash :exec-with-client options))
(ignore-inherited (config-value :contexts context-name :ignore-inherited-source-registry))
(splice-inherited (uiop:getenvp "CL_SOURCE_REGISTRY"))
(source-registry (context-to-asdf-source-registry-form
context
:with-client with-client
:ignore-inherited ignore-inherited
:splice-inherited splice-inherited))
(output-translations (context-output-translations context))
(installed-system-names (sort (mapcar #'system-name (context-installed-systems context)) #'string<))
(visible-primary-system-names (sort (context-visible-primary-system-names context) #'string<)))
(with-standard-io-syntax
(execvpe (first args) (rest args)
`(("CL_SOURCE_REGISTRY" . ,(prin1-to-string source-registry))
,@(when output-translations
`(("ASDF_OUTPUT_TRANSLATIONS" . ,(prin1-to-string output-translations))))
("CLPM_EXEC_CONTEXT" . ,context-name)
("CLPM_EXEC_INSTALLED_SYSTEMS" . ,(format nil "~{~A~^ ~}" installed-system-names))
("CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS" . ,(format nil "~{~A~^ ~}" visible-primary-system-names))
,@(when ignore-inherited
'(("CLPM_EXEC_IGNORE_INHERITED_SOURCE_REGISTRY" . "t")))
,@(when (and (not ignore-inherited) splice-inherited)
`(("CLPM_EXEC_SPLICE_INHERITED_SOURCE_REGISTRY" . ,splice-inherited))))
t))))
(clpm:exec (first args) (rest args) :with-client-p (gethash :exec-with-client options)))
......@@ -10,6 +10,7 @@
#:clpm/config
#:clpm/context
#:clpm/context-diff
#:clpm/exec
#:clpm/install
#:clpm/source
#:clpm/sync
......@@ -17,12 +18,10 @@
#:clpm/version)
;; From config
(:export #:config-value)
;; From exec
(:export #:exec)
;; From install
(:export #:install)
;; From source
(:export #:source-name
#:sources
#:sync-source)
;; From sync
(:export #:sync)
;; From update
......
;;;; Exec'ing commands in a context
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpm/exec
(:use #:cl
#:clpm/config
#:clpm/context
#:clpm/execvpe
#:clpm/session
#:clpm/source)
(:export #:exec))
(in-package #:clpm/exec)
(defun exec (command args &key context
with-client-p)
"exec(3) (or approximate if system doesn't have exec) a COMMAND in a CONTEXT.
COMMAND must be a string naming the command to run.
ARGS must be a list of strings containing the arguments to pass to the command.
If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
(unless (stringp command)
(error "COMMAND must be a string."))
(with-clpm-session ()
(let* ((context (get-context context))
(context-name (context-name context))
(ignore-inherited-source-registry
(config-value :contexts context-name :ignore-inherited-source-registry))
(splice-inherited (uiop:getenvp "CL_SOURCE_REGISTRY"))
(source-registry (context-to-asdf-source-registry-form
context
:with-client with-client-p
:ignore-inherited ignore-inherited-source-registry
:splice-inherited splice-inherited))
(output-translations (context-output-translations context))
(installed-system-names (sort (mapcar #'system-name (context-installed-systems context)) #'string<))
(visible-primary-system-names (sort (context-visible-primary-system-names context) #'string<)))
(with-standard-io-syntax
(execvpe command args
`(("CL_SOURCE_REGISTRY" . ,(format nil "~S" source-registry))
,@(when output-translations
`(("ASDF_OUTPUT_TRANSLATIONS" . (format nil "~S" output-translations))))
("CLPM_EXEC_CONTEXT" . ,context-name)
("CLPM_EXEC_INSTALLED_SYSTEMS" . ,(format nil "~{~A~^ ~}" installed-system-names))
("CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS" . ,(format nil "~{~A~^ ~}" visible-primary-system-names))
,@(when ignore-inherited-source-registry
'(("CLPM_EXEC_IGNORE_INHERITED_SOURCE_REGISTRY" . "t")))
,@(when (and (not ignore-inherited-source-registry) splice-inherited)
`(("CLPM_EXEC_SPLICE_INHERITED_SOURCE_REGISTRY" . ,splice-inherited))))
t)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment