Skip to content

Commit

Permalink
Refactor qlot/distify/*.
Browse files Browse the repository at this point in the history
  • Loading branch information
@fukamachi
fukamachi committed Dec 2, 2023
1 parent 674b26e commit 7107618
Show file tree
Hide file tree
Showing 6 changed files with 154 additions and 177 deletions.
22 changes: 7 additions & 15 deletions src/distify/dist.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,22 +16,14 @@
(defun distify-dist (source destination &key distinfo-only)
(declare (ignore distinfo-only))
(check-type source source-dist)
(progress "Determining the distinfo URL.")
(unless (source-distinfo-url source)
(progress "Determining the distinfo URL.")
(setf (source-distinfo-url source)
(get-distinfo-url (source-distribution source)
(slot-value source 'qlot/source/dist::%version))))
(progress "Fetching the distinfo.")
(let* ((destination (truename destination))
(relative-path
;; distribution name may include slashes
;; and can't be used directly as a name
;; of a pathname.
(uiop:parse-unix-namestring (source-project-name source)
:type "txt"))
(target-path (merge-pathnames
relative-path
destination)))
(ensure-directories-exist target-path)
(qlot/http:fetch (source-distinfo-url source) target-path)
destination))
(let ((distinfo.txt (merge-pathnames "distinfo.txt" destination)))
(unless (uiop:file-exists-p distinfo.txt)
(progress "Fetching the distinfo.")
(qlot/http:fetch (source-distinfo-url source) distinfo.txt)))

destination)
84 changes: 40 additions & 44 deletions src/distify/git.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,8 @@
(:import-from #:qlot/utils/distify
#:releases.txt
#:systems.txt
#:write-source-distinfo)
#:write-source-distinfo
#:load-version-from-distinfo)
(:import-from #:qlot/utils/git
#:git-clone
#:git-ref
Expand Down Expand Up @@ -66,52 +67,47 @@
(setf (source-git-remote-url source)
(project-upstream-url (source-project-name source)))))

(progress "Determining the project version.")
(load-source-git-version source)
(let ((distinfo.txt (merge-pathnames "distinfo.txt" destination)))
(progress "Determining the project version.")
(cond
((uiop:file-exists-p distinfo.txt)
(load-version-from-distinfo source distinfo.txt)
(setf (source-git-ref source)
(subseq (source-version source)
(length (source-version-prefix source)))))
(t
(load-source-git-version source)))

(let ((*default-pathname-defaults*
(uiop:ensure-absolute-pathname
(merge-pathnames
(make-pathname :directory `(:relative ,(source-project-name source) ,(source-version source)))
destination))))
(ensure-directories-exist *default-pathname-defaults*)

(progress "Writing the distinfo.")
(write-source-distinfo source destination)
(unless (uiop:file-exists-p distinfo.txt)
(progress "Writing the distinfo.")
(write-source-distinfo source destination))

(when distinfo-only
(return-from distify-git))
(return-from distify-git destination))

(with-tmp-directory (softwares-dir)
(let ((archive-file (merge-pathnames "archive.tar.gz" destination))
(source-directory (uiop:ensure-directory-pathname
(merge-pathnames (format nil "~A-~A"
(source-project-name source)
(source-git-identifier source))
softwares-dir))))
(unless (uiop:file-exists-p archive-file)
(progress "Running git clone.")
(git-clone (source-git-remote-access-url source)
source-directory
:checkout-to (or (source-git-branch source)
(source-git-tag source))
:ref (source-git-ref source))

(let ((archive-file (merge-pathnames "archive.tar.gz")))
(cond
((not (uiop:file-exists-p archive-file))
(with-tmp-directory (softwares-dir)
(let ((source-directory (uiop:ensure-directory-pathname
(merge-pathnames (format nil "~A-~A"
(source-project-name source)
(source-git-identifier source))
softwares-dir))))
(progress "Running git clone.")
(git-clone (source-git-remote-access-url source)
source-directory
:checkout-to (or (source-git-branch source)
(source-git-tag source))
:ref (source-git-ref source))
(progress "Creating a tarball.")
(create-git-tarball source-directory
archive-file
(source-git-ref source)))

(progress "Creating a tarball.")
(create-git-tarball source-directory
archive-file
(source-git-ref source))
(unless (and (uiop:file-exists-p "systems.txt")
(uiop:file-exists-p "releases.txt"))
(progress "Writing metadata files.")
(write-metadata-files source *default-pathname-defaults* source-directory archive-file)))))
((not (and (uiop:file-exists-p "systems.txt")
(uiop:file-exists-p "releases.txt")))
(with-tmp-directory (softwares-dir)
(progress "Extracting a tarball.")
(let ((source-directory (extract-tarball archive-file softwares-dir)))
(progress "Writing metadata files.")
(write-metadata-files source *default-pathname-defaults* source-directory archive-file))))))
(unless (and (uiop:file-exists-p "systems.txt")
(uiop:file-exists-p "releases.txt"))
(progress "Writing metadata files.")
(write-metadata-files source destination source-directory archive-file)))))

*default-pathname-defaults*))
destination)
82 changes: 41 additions & 41 deletions src/distify/github.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,8 @@
(:import-from #:qlot/utils/distify
#:releases.txt
#:systems.txt
#:write-source-distinfo)
#:write-source-distinfo
#:load-version-from-distinfo)
(:import-from #:qlot/utils/archive
#:extract-tarball)
(:import-from #:qlot/utils/tmp
Expand Down Expand Up @@ -80,47 +81,46 @@
(source-github-ref source)))))

(defun distify-github (source destination &key distinfo-only)
(load-source-github-version source)

(let ((*default-pathname-defaults*
(uiop:ensure-absolute-pathname
(merge-pathnames
(make-pathname :directory `(:relative ,(source-project-name source) ,(source-version source)))
destination))))
(ensure-directories-exist *default-pathname-defaults*)

(progress "Writing the distinfo to ~S." destination)
(write-source-distinfo source destination)
(progress "Wrote the distinfo to ~S." destination)
(let ((distinfo.txt (merge-pathnames "distinfo.txt" destination)))
(cond
((uiop:file-exists-p distinfo.txt)
(load-version-from-distinfo source distinfo.txt)
(setf (source-github-ref source)
(subseq (source-version source) (source-version-prefix source))))
(t
(load-source-github-version source)
(progress "Writing the distinfo to ~S." destination)
(write-source-distinfo source destination)
(progress "Wrote the distinfo to ~S." destination))))

(when distinfo-only
(return-from distify-github))
(when distinfo-only
(return-from distify-github destination))

(with-tmp-directory (softwares-dir)
(let ((archive-file (merge-pathnames "archive.tar.gz")))
(unless (uiop:file-exists-p archive-file)
(progress "Downloading ~S." (source-github-url source))
(let ((cred (github-credentials)))
(apply #'qlot/http:fetch (source-github-url source) archive-file
(when cred
`(:basic-auth ,cred))))
(progress "Downloaded ~S." (source-github-url source)))
(with-tmp-directory (softwares-dir)
(let ((archive-file (merge-pathnames "archive.tar.gz" destination)))
(unless (uiop:file-exists-p archive-file)
(progress "Downloading ~S." (source-github-url source))
(let ((cred (github-credentials)))
(apply #'qlot/http:fetch (source-github-url source) archive-file
(when cred
`(:basic-auth ,cred))))
(progress "Downloaded ~S." (source-github-url source)))

(unless (and (uiop:file-exists-p "systems.txt")
(uiop:file-exists-p "releases.txt"))
(progress "Extracting a tarball.")
(let ((source-directory (extract-tarball archive-file softwares-dir)))
(progress "Writing systems.txt.")
(uiop:with-output-file (out "systems.txt" :if-exists :supersede)
(princ (systems.txt (source-project-name source)
source-directory)
out))
(progress "Writing releases.txt.")
(uiop:with-output-file (out "releases.txt" :if-exists :supersede)
(princ (releases.txt (source-project-name source)
(source-version source)
source-directory
archive-file)
out))))))
(unless (and (uiop:file-exists-p "systems.txt")
(uiop:file-exists-p "releases.txt"))
(progress "Extracting a tarball.")
(let ((source-directory (extract-tarball archive-file softwares-dir)))
(progress "Writing systems.txt.")
(uiop:with-output-file (out "systems.txt" :if-exists :supersede)
(princ (systems.txt (source-project-name source)
source-directory)
out))
(progress "Writing releases.txt.")
(uiop:with-output-file (out "releases.txt" :if-exists :supersede)
(princ (releases.txt (source-project-name source)
(source-version source)
source-directory
archive-file)
out))))))

*default-pathname-defaults*))
destination)
87 changes: 36 additions & 51 deletions src/distify/http.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,8 @@
(:import-from #:qlot/utils/distify
#:releases.txt
#:systems.txt
#:write-source-distinfo)
#:write-source-distinfo
#:load-version-from-distinfo)
(:import-from #:qlot/utils/archive
#:extract-tarball)
(:import-from #:qlot/utils/ql
Expand All @@ -32,60 +33,44 @@
destination)))

(defun distify-http (source destination &key distinfo-only)
(let ((distinfo.txt (merge-pathnames
(make-pathname :name (source-project-name source)
:type "txt")
destination)))
(let ((distinfo.txt (merge-pathnames "distinfo.txt" destination))
(archive-file (merge-pathnames #P"archive.tar.gz" destination)))

(when (and (not (ignore-errors (source-version source)))
(uiop:file-exists-p distinfo.txt))
(let ((distinfo (parse-distinfo-file distinfo.txt)))
(setf (source-version source)
(cdr (assoc "version" distinfo :test 'equal)))
(setf (source-http-archive-md5 source)
(subseq (source-version source)
(length (source-version-prefix source)))))))
(cond
((uiop:file-exists-p distinfo.txt)
(load-version-from-distinfo source distinfo.txt)
(setf (source-http-archive-md5 source)
(subseq (source-version source)
(length (source-version-prefix source)))))
(t
(unless (uiop:file-exists-p archive-file)
(uiop:with-temporary-file (:pathname tmp-archive :direction :io)
(progress "Downloading ~S" (source-http-url source))
(qlot/http:fetch (source-http-url source) tmp-archive)

(unless (and (ignore-errors (source-version source))
(uiop:file-exists-p (merge-pathnames "archive.tar.gz"
(source-metadata-destination source destination))))
(uiop:with-temporary-file (:pathname tmp-archive :direction :io)
(progress "Downloading ~S" (source-http-url source))
(qlot/http:fetch (source-http-url source) tmp-archive)
(rename-file tmp-archive archive-file)
(progress "Downloaded ~S." archive-file)))

(progress "Calculating the MD5 of the archive.")
(let ((archive-md5 (byte-array-to-hex-string
(digest-file :md5 tmp-archive))))
(when (and (source-http-archive-md5 source)
(not (string= (source-http-archive-md5 source) archive-md5)))
(cerror "Ignore and continue."
"File MD5 of ~S is different from ~S.~%The content seems to have changed."
(source-http-url source)
archive-md5))
(progress "Calculating the MD5 of the archive.")
(let ((archive-md5 (byte-array-to-hex-string
(digest-file :md5 archive-file))))
(when (and (source-http-archive-md5 source)
(not (string= (source-http-archive-md5 source) archive-md5)))
(cerror "Ignore and continue."
"File MD5 of ~S is different from ~S.~%The content seems to have changed."
(source-http-url source)
archive-md5))

(setf (source-http-archive-md5 source) archive-md5)
(setf (source-version source)
(format nil "~A~A"
(source-version-prefix source)
archive-md5)))

(let ((archive-file (merge-pathnames "archive.tar.gz"
(source-metadata-destination source destination))))
(ensure-directories-exist archive-file)
(unless (uiop:file-exists-p archive-file)
(rename-file tmp-archive archive-file))
(progress "Downloaded ~S." archive-file))))

(let* ((*default-pathname-defaults*
(source-metadata-destination source destination))
(archive-file (merge-pathnames "archive.tar.gz")))
(ensure-directories-exist *default-pathname-defaults*)

(progress "Writing the distinfo to ~S." destination)
(write-source-distinfo source destination)
(setf (source-http-archive-md5 source) archive-md5)
(setf (source-version source)
(format nil "~A~A"
(source-version-prefix source)
archive-md5)))
(progress "Writing the distinfo to ~S." destination)
(write-source-distinfo source destination)))

(when distinfo-only
(return-from distify-http))
(return-from distify-http destination))

(unless (and (uiop:file-exists-p "systems.txt")
(uiop:file-exists-p "releases.txt"))
Expand All @@ -102,6 +87,6 @@
(source-version source)
source-directory
archive-file)
out)))))
out))))))

*default-pathname-defaults*))
destination)
Loading

0 comments on commit 7107618

Please sign in to comment.