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

cli less work: exec

parent 8d708b8b

cli/commands/exec.lisp

+4 −36
Original line number Diff line number Diff line
@@ -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)))

clpm/clpm.lisp

+3 −4
Original line number Diff line number Diff line
@@ -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

clpm/exec.lisp

0 → 100644
+54 −0
Original line number Diff line number Diff line 
;;;; 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)))))