From 026784e8c5a77821e6942625004a64029130e752 Mon Sep 17 00:00:00 2001 From: cage Date: Tue, 7 Dec 2021 10:48:37 +0100 Subject: [PATCH] - added download of lisp libraries. --- src/command-line.lisp | 2 +- src/main.lisp | 2 +- src/misc-utils.lisp | 109 ++++++++++++++++++++++++------------------ 3 files changed, 65 insertions(+), 48 deletions(-) diff --git a/src/command-line.lisp b/src/command-line.lisp index f5ecf14..016619e 100644 --- a/src/command-line.lisp +++ b/src/command-line.lisp @@ -80,7 +80,7 @@ :arg-parser #'identity :long "load-module") (:name :print-lisp-dependencies - :description "Print lisp's libraries locations" + :description "Download lisp libraries (useful for packaging only)." :short #\X :long "lisp-dependencies-uris"))) diff --git a/src/main.lisp b/src/main.lisp index f093bf6..5b06774 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -209,7 +209,7 @@ etc.) happened" (command-line:manage-opts) (cond (command-line:*print-lisp-dependencies* - (misc:all-program-dependencies)) + (misc:all-program-dependencies t)) (command-line:*script-file* (load-script-file)) (t diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp index 24f9a2d..a7c4286 100644 --- a/src/misc-utils.lisp +++ b/src/misc-utils.lisp @@ -940,6 +940,12 @@ to the array" :external-format-out :utf8) (values stream response-code))) +(defun get-url-content-body (url) + (drakma:http-request url + :want-stream nil + :verify :required + :external-format-out :utf8)) + ;; profiling (defmacro with-profile-time (&body body) @@ -956,20 +962,9 @@ to the array" (string= (ql::short-description a) (ql::short-description b))) -(defun remove-system-duplicates-test (ql-systems) - (remove-duplicates (alexandria:flatten ql-systems) - :test #'ql-system-equals)) - -(defun all-dependencies (system-name) - (flet ((get-direct-dependencies (system-name) - (remove-system-duplicates-test (ql::dependency-tree system-name)))) - (let* ((direct (get-direct-dependencies system-name)) - (results (copy-list direct))) - (loop for i in direct do - (let ((dependencies (get-direct-dependencies i))) - (loop for j in dependencies do - (pushnew j results :test #'ql-system-equals)))) - results))) +(defun remove-system-duplicates-test (systems) + (remove-duplicates systems + :test #'string=)) (alexandria:define-constant +github-quicklisp-source-url-template+ "https://raw.githubusercontent.com/quicklisp/quicklisp-projects/master/projects/~a/source.txt" @@ -986,37 +981,59 @@ to the array" (fields (text-utils:split-words line))) fields)))) -(defun asdf-depends-on () - (let ((symbol-system (alexandria:symbolicate (string-upcase config:+program-name+)))) +(defun asdf-depends-on (&optional (system-name config:+program-name+)) + (let ((symbol-system (alexandria:symbolicate (string-upcase system-name)))) (asdf:system-depends-on (asdf:find-system symbol-system)))) -(defun all-program-dependencies () - (let* ((starting-system-names (asdf-depends-on)) - (dependencies (alexandria:flatten (mapcar #'all-dependencies - starting-system-names))) - (clean-dependencies (mapcar #'ql::short-description - (remove-system-duplicates-test dependencies)))) - (setf clean-dependencies - (mapcar (lambda (a) - (cond - ((string= a "sqlite") - "cl-sqlite") - ((string= a "marshal") - "cl-marshal") - (t - a))) - clean-dependencies)) - (loop for system-name in (sort clean-dependencies #'string<) do - (let ((fields (get-quicklisp-original-file system-name))) - (sleep 1) - (if fields - (cond - ((string= (first fields) "ediware-http") - (format t "~a ~a ~a~%" system-name "git" - (format nil "https://github.com/edicl/~a.git" system-name))) - ((string= (first fields) "kmr-git") - (format t "~a ~a ~a~%" system-name "git" - (format nil "http://git.kpe.io/~a.git" system-name))) - (t - (format t "~a ~a ~a~%" system-name (first fields) (second fields)))) - (format t "!error: ~a~%" system-name)))))) +(defun all-dependencies (system-name) + (flet ((get-direct-dependencies (system-name) + (remove-system-duplicates-test (asdf-depends-on system-name)))) + (let* ((direct (get-direct-dependencies system-name)) + (results (copy-list direct))) + (loop for i in direct do + (let ((dependencies (get-direct-dependencies i))) + (loop for j in dependencies do + (pushnew j results :test #'string=) + (all-dependencies i)))) + (sort results #'string<)))) + +(defun all-program-dependencies (&optional download) + (let* ((dependencies (all-dependencies config:+program-name+)) + (clean-dependencies (mapcar (lambda (a) + (cond + ((string= a "sqlite") + "cl-sqlite") + ((string= a "marshal") + "cl-marshal") + (t + a))) + dependencies))) + (flet ((download-package (fields) + (if (cl-ppcre:scan "git" (first fields)) + (os-utils:run-external-program "git" + (list "clone" (second fields)) + :search t) + (let ((data (get-url-content-body (second fields)))) + (with-open-file (out-stream (fs:path-last-element (second fields)) + :direction :output + :element-type '(unsigned-byte 8)) + (write-sequence data out-stream)))))) + (loop for system-name in (sort clean-dependencies #'string<) do + (let ((fields (get-quicklisp-original-file system-name))) + (if fields + (cond + ((string= (first fields) "ediware-http") + (let ((url (format nil "https://github.com/edicl/~a.git" system-name))) + (format t "~a ~a ~a~%" system-name "git" url) + (when download + (download-package (list "git" url))))) + ((string= (first fields) "kmr-git") + (let ((url (format nil "http://git.kpe.io/~a.git" system-name))) + (format t "~a ~a ~a~%" system-name "git" url) + (when download + (download-package (list (first fields) url))))) + (t + (format t "~a ~a ~a~%" system-name (first fields) (second fields)) + (when download + (download-package fields)))) + (format t "!error: ~a~%" system-name)))))))