diff options
| -rw-r--r-- | src/connection/local.lisp | 18 | ||||
| -rw-r--r-- | src/connection/ssh.lisp | 4 | ||||
| -rw-r--r-- | src/core.lisp | 55 | ||||
| -rw-r--r-- | src/data/asdf.lisp | 6 | ||||
| -rw-r--r-- | src/package.lisp | 28 | ||||
| -rw-r--r-- | src/util.lisp | 6 |
6 files changed, 69 insertions, 48 deletions
diff --git a/src/connection/local.lisp b/src/connection/local.lisp index 82ac410..65dc0bd 100644 --- a/src/connection/local.lisp +++ b/src/connection/local.lisp @@ -31,25 +31,25 @@ root Lisp is running on, as the root Lisp's uid.")) input) ;; assumes a POSIX shell (otherwise we could wrap in 'sh -c') (multiple-value-bind (output _ exit-code) - (uiop:run-program shell-cmd - :force-shell t - :input (and input - (make-string-input-stream input)) - :output :string - :error-output :output - :ignore-error-status t) + (run-program shell-cmd + :force-shell t + :input (and input + (make-string-input-stream input)) + :output :string + :error-output :output + :ignore-error-status t) (declare (ignore _)) (values output exit-code))) (defmethod connection-readfile ((connection local-connection) path) - (uiop:read-file-string path)) + (read-file-string path)) (defmethod connection-writefile ((connection local-connection) path contents) (with-open-file (stream path :direction :output :if-exists :supersede) (write-string contents stream))) (defmethod connection-upload ((connection local-connection) from to) - (uiop:copy-file from to)) + (copy-file from to)) ;; set the root Lisp's connection context now we've defined its value -- other ;; implementations of ESTABLISH-CONNECTION will rely on this when they call diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp index 118e527..e9b49f3 100644 --- a/src/connection/ssh.lisp +++ b/src/connection/ssh.lisp @@ -33,7 +33,7 @@ ;; wrap in 'sh -c' in case the login shell is not POSIX `(list "ssh" (slot-value connection :hostname) - (uiop:escape-sh-command "sh" "-c" ,@args))) + (escape-sh-command "sh" "-c" ,@args))) (defmethod connection-run ((connection ssh-connection) cmd @@ -41,7 +41,7 @@ input environment) (when environment - (loop do (push (uiop:escape-sh-token + (loop do (push (escape-sh-token (strcat (symbol-name (pop environment)) "=" (pop environment))) cmd) diff --git a/src/core.lisp b/src/core.lisp index 2d1d3fa..1387c64 100644 --- a/src/core.lisp +++ b/src/core.lisp @@ -150,14 +150,14 @@ Returns command's stdout, stderr and exit code." (t (push arg cmd))) while args finally (nreversef cmd)) - (setq cmd (if (cdr cmd) (uiop:escape-sh-command cmd) (car cmd))) + (setq cmd (if (cdr cmd) (escape-sh-command cmd) (car cmd))) (loop while env collect (format nil "~A=~A" (symbol-name (pop env)) (pop env)) into accum finally (when accum (setq cmd (format nil "env ~A ~A" - (uiop:escape-sh-command accum) + (escape-sh-command accum) cmd)))) (unwind-protect (multiple-value-bind (out exit) @@ -776,13 +776,12 @@ sources are not expected to be available outside of the root Lisp.")) iden1 iden2)))) (defun try-get-file-mime-type (file) - (handler-case (uiop:stripln - (uiop:run-program (uiop:escape-sh-command - (list "file" "-E" - "--mime-type" "--brief" - (uiop:unix-namestring file))) - :output :string)) - (uiop:subprocess-error () nil))) + (handler-case (stripln (run-program + (escape-sh-command (list "file" "-E" + "--mime-type" "--brief" + (unix-namestring file))) + :output :string)) + (subprocess-error () nil))) (defun sort-prerequisite-data-cache (cache) (sort cache (lambda (x y) (version> (third x) (third y))))) @@ -805,20 +804,19 @@ sources are not expected to be available outside of the root Lisp.")) 'consfigurator.connection.local:local-connection) (error "Attempt to upload data to the root Lisp; this is not allowed")) (let* ((dest (remote-data-pathname iden1 iden2 version))) - (run "mkdir" "-p" (uiop:unix-namestring - (uiop:pathname-directory-pathname dest))) + (run "mkdir" "-p" (unix-namestring (pathname-directory-pathname dest))) (cond ((getf data :file) - (let ((source (uiop:unix-namestring (getf data :file)))) + (let ((source (unix-namestring (getf data :file)))) (if (string-prefix-p "text/" (getf data :mime)) - (let ((dest (strcat (uiop:unix-namestring dest) ".gz"))) - (uiop:with-temporary-file (:pathname tmp) - (uiop:run-program (strcat "gzip --rsyncable -c " - (uiop:escape-sh-token source) - " >" (uiop:unix-namestring tmp))) + (let ((dest (strcat (unix-namestring dest) ".gz"))) + (with-temporary-file (:pathname tmp) + (run-program (strcat "gzip --rsyncable -c " + (escape-sh-token source) + " >" (unix-namestring tmp))) (connection-upload *connection* tmp - (uiop:unix-namestring dest)) + (unix-namestring dest)) (run "gunzip" dest))) (connection-upload *connection* source dest)))) ((getf data :data) @@ -827,17 +825,14 @@ sources are not expected to be available outside of the root Lisp.")) (error "Prerequisite data plist lacks both :file and :data entries"))))) (defun connection-clear-data-cache (iden1 iden2) - (let ((dir (uiop:ensure-directory-pathname - (remote-data-pathname iden1 iden2)))) + (let ((dir (ensure-directory-pathname (remote-data-pathname iden1 iden2)))) (run (strcat "rm -f " - (uiop:unix-namestring - (uiop:pathname-directory-pathname dir)) + (unix-namestring (pathname-directory-pathname dir)) "/*")))) (defun get-local-data-cache-dir () - (uiop:ensure-directory-pathname - (strcat (or (uiop:getenv "XDG_CACHE_HOME") - (strcat (uiop:getenv "HOME") "/.cache")) + (ensure-directory-pathname + (strcat (or (getenv "XDG_CACHE_HOME") (strcat (getenv "HOME") "/.cache")) "/consfigurator/data"))) (defun get-local-cached-prerequisite-data () @@ -845,9 +840,9 @@ sources are not expected to be available outside of the root Lisp.")) process, where each entry is of the form '(iden1 iden2 version)." - (loop for dir in (uiop:subdirectories (get-local-data-cache-dir)) - nconc (loop for subdir in (uiop:subdirectories dir) - nconc (loop for file in (uiop:directory-files subdir) + (loop for dir in (subdirectories (get-local-data-cache-dir)) + nconc (loop for subdir in (subdirectories dir) + nconc (loop for file in (directory-files subdir) collect (mapcar #'filename->string (list (lastcar @@ -857,7 +852,7 @@ process, where each entry is of the form (pathname-name file))))))) (defun get-remote-data-cache-dir () - (uiop:ensure-directory-pathname + (ensure-directory-pathname (car (runlines "echo ${XDG_CACHE_HOME:-$HOME/.cache}/consfigurator/data/")))) @@ -869,5 +864,5 @@ of the current connection, where each entry is of the form (mapcar (lambda (line) (mapcar #'filename->string (split-string line :separator "/"))) (runlines :may-fail "find" - (uiop:unix-namestring (get-remote-data-cache-dir)) + (unix-namestring (get-remote-data-cache-dir)) "-type" "f" "-printf" "%P\\n"))) diff --git a/src/data/asdf.lisp b/src/data/asdf.lisp index 914f242..f6aec08 100644 --- a/src/data/asdf.lisp +++ b/src/data/asdf.lisp @@ -28,9 +28,9 @@ "Try to concatenate all the source code for SYSTEM, store it somewhere and return the filename." (declare (ignore iden1)) - (let ((cache-dir (uiop:ensure-directory-pathname - (strcat (or (uiop:getenv "XDG_CACHE_HOME") - (strcat (uiop:getenv "HOME") "/.cache")) + (let ((cache-dir (ensure-directory-pathname + (strcat (or (getenv "XDG_CACHE_HOME") + (strcat (getenv "HOME") "/.cache")) "/consfigurator/systems"))) (op 'asdf:monolithic-concatenate-source-op) (co (asdf:find-component system nil))) diff --git a/src/package.lisp b/src/package.lisp index df30be8..7531513 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -5,10 +5,36 @@ (:shadowing-import-from #:uiop #:strcat #:string-prefix-p - #:split-string) + #:split-string + #:escape-sh-command + #:escape-sh-token + #:run-program + #:read-file-string + #:subprocess-error + #:stripln + #:unix-namestring + #:pathname-directory-pathname + #:with-temporary-file + #:ensure-directory-pathname + #:getenv + #:subdirectories + #:directory-files) (:export #:strcat #:string-prefix-p #:split-string + #:escape-sh-command + #:escape-sh-token + #:run-program + #:read-file-string + #:subprocess-error + #:stripln + #:unix-namestring + #:pathname-directory-pathname + #:with-temporary-file + #:ensure-directory-pathname + #:getenv + #:subdirectories + #:directory-files #:lines #:unlines diff --git a/src/util.lisp b/src/util.lisp index 5f0b93a..caa551e 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -23,7 +23,7 @@ (values)) (defun lines (text) - (uiop:split-string (uiop:stripln text) :separator '(#\Newline))) + (split-string (stripln text) :separator '(#\Newline))) (defun unlines (lines) (format nil "~{~A~%~}" lines)) @@ -48,8 +48,8 @@ (dpkg-version-compare x ">=" y)) (defun dpkg-version-compare (x r y) - (= 0 (nth-value 2 (uiop:run-program (list "dpkg" "--compare-versions" x r y) - :ignore-error-status t)))) + (= 0 (nth-value 2 (run-program (list "dpkg" "--compare-versions" x r y) + :ignore-error-status t)))) ;;;; Encoding of strings to filenames |