Skip to content
Snippets Groups Projects
Commit 3574f2a5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Tweak the debian release script...

parent 7f154f4a
No related branches found
No related tags found
No related merge requests found
...@@ -200,13 +200,11 @@ extract-all-tagged-asdf: build/asdf.lisp ...@@ -200,13 +200,11 @@ extract-all-tagged-asdf: build/asdf.lisp
# Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale, # Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale,
# as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git # as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git
debian-package: mrproper debian-package:
: $${RELEASE:="$$(git tag -l '3.[0-9].[0-9]' | tail -n 1)"} ; echo building package version $$RELEASE ; \ ./bin/asdf-builder debian-package release
git-buildpackage --git-debian-branch=release --git-upstream-branch=release --git-upstream-tag=$$RELEASE --git-tag --git-retag --git-ignore-branch
debian-package-from-master: mrproper debian-package-from-master:
: $${RELEASE:="$$(git tag -l '3.[0-9].[0-9]' | tail -n 1)"} ; echo building package version $$RELEASE ; \ ./bin/asdf-builder debian-package master
git-buildpackage --git-debian-branch=master --git-upstream-branch=master --git-upstream-tag=$$RELEASE --git-tag --git-retag --git-ignore-branch
# Replace SBCL's ASDF with the current one. -- NOT recommended now that SBCL has ASDF2. # Replace SBCL's ASDF with the current one. -- NOT recommended now that SBCL has ASDF2.
......
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
;;; ;;;
;;; Everything is MUCH simpler if you can assume your implementation has a recent-enough ASDF 3: ;;; Everything is MUCH simpler if you can assume your implementation has a recent-enough ASDF 3:
;;; just (require "asdf"), then configure in a subsequent eval-when form, ;;; just (require "asdf"), then configure in a subsequent eval-when form,
;;; so that you may use asdf: and uiop: prefix. ;;; in which you may then use asdf: and uiop: prefix.
;;; ;;;
;;; To use the user-configured ASDF rather than a deterministic self-contained project build, ;;; To use the user-configured ASDF rather than a deterministic self-contained project build,
;;; see instead how cl-launch 4.0.4 loads ASDF. ;;; see instead how cl-launch 4.0.4 loads ASDF.
...@@ -146,29 +146,23 @@ ...@@ -146,29 +146,23 @@
(ensure-pathname (system-relative-pathname :asdf/defsystem ()) (ensure-pathname (system-relative-pathname :asdf/defsystem ())
:want-physical t :want-absolute t :want-physical t :want-absolute t
:want-existing t :truename t)) :want-existing t :truename t))
(defparameter /asdf-dir/ (defun pn (&rest x)
(native-namestring *asdf-dir*)) (subpathname *asdf-dir* (and x (uiop:resolve-relative-location x))))
(defun apath (x &rest keys) (apply 'subpathname *asdf-dir* x keys)) (defun nn (&rest x)
(native-namestring (apply 'pn x)))
;;; UIOP directory ;;; UIOP directory
(defvar *uiop-dir* (subpathname *asdf-dir* "uiop/")) (defvar *uiop-dir* (pn "uiop/"))
(defparameter /uiop-dir/ (native-namestring *uiop-dir*))
(defun upath (x &rest keys) (apply 'subpathname *uiop-dir* x keys))
;;; build directory ;;; build directory
(defparameter *build-dir* (defparameter *build-dir* (pn "build/"))
(ensure-pathname (defparameter /build-dir/ (nn "build/"))
"build/" :defaults *asdf-dir*
:want-relative t :ensure-absolute t
:ensure-subpath t))
(defparameter /build-dir/
(native-namestring *build-dir*))
(defun bpath (x &rest keys) (apply 'subpathname *build-dir* x keys)) (defun bpath (x &rest keys) (apply 'subpathname *build-dir* x keys))
(defparameter *version* (defparameter *version-file*
(safe-read-file-form (pn "version.lisp-expr"))
(subpathname *asdf-dir* "version.lisp-expr")))
(defparameter *version* (safe-read-file-form *version-file*))
(defun enough-namestring! (base pathname) (defun enough-namestring! (base pathname)
(let ((e (enough-namestring base pathname))) (let ((e (enough-namestring base pathname)))
...@@ -201,40 +195,32 @@ ...@@ -201,40 +195,32 @@
(ensure-pathname base :want-absolute t :want-existing t :want-directory t) (ensure-pathname base :want-absolute t :want-existing t :want-directory t)
(dolist (f files) (dolist (f files)
(check-type f string)) (check-type f string))
(let* ((/base/ (let* ((base
(native-namestring (ensure-pathname
(ensure-pathname base
base :want-absolute t :want-directory t
:want-absolute t :want-directory t :want-existing t :truename t))
:want-existing t :truename t)))
(destination (destination
(ensure-pathname (ensure-pathname
name name
:defaults *build-dir* :defaults *build-dir*
:want-relative t :ensure-absolute t :want-relative t :ensure-absolute t
:ensure-subpath t :ensure-directory t)) :ensure-subpath t :ensure-directory t))
(/destination/ (tarball
(native-namestring destination)) (ensure-pathname
(/tarball/ (tarname name)
(native-namestring :defaults *build-dir*
(ensure-pathname :want-relative t :ensure-absolute t
(tarname name) :ensure-subpath t :want-file t
:defaults *build-dir* :ensure-directories-exist t)))
:want-relative t :ensure-absolute t
:ensure-subpath t :want-file t
:ensure-directories-exist t)))
(/files/
(mapcar 'native-namestring files)))
(assert (< 6 (length (pathname-directory destination)))) (assert (< 6 (length (pathname-directory destination))))
(when (probe-file* destination) (when (probe-file* destination)
(error "Destination ~S already exists, not taking chances - you can delete it yourself." (error "Destination ~S already exists, not taking chances - you can delete it yourself."
destination)) destination))
(ensure-directories-exist destination) (ensure-directories-exist destination)
(run (format nil "cd ~S && cp -pHux --parents ~{~S ~} ~S" (run `(cp "-pHux" --parents ,@files ,destination) :directory base :show t)
/base/ /files/ /destination/) :show t) (run `(tar "zcfC" ,tarball ,*build-dir* (,name /)) :show t)
(run (format nil "tar zcfC ~S ~S ~S/" (delete-directory-tree destination :validate (lambda (x) (equal x destination)))
/tarball/ /build-dir/ name) :show t)
(delete-directory-tree destination :validate (lambda (x) (equal (native-namestring x) /destination/)))
(values))) (values)))
(defun driver-files () (defun driver-files ()
...@@ -254,11 +240,12 @@ ...@@ -254,11 +240,12 @@
(make-tarball-under-build (asdf-defsystem-name) *asdf-dir* (asdf-defsystem-files))) (make-tarball-under-build (asdf-defsystem-name) *asdf-dir* (asdf-defsystem-files)))
(defun asdf-git-name () (defun asdf-git-name ()
(format nil "asdf-~A" *version*)) (strcat "asdf-" *version*))
(defun make-git-tarball () (defun make-git-tarball ()
(build-asdf) (build-asdf)
(run (format nil "cd ~S && tar zcf build/~A.tar.gz build/asdf.lisp $(git ls-files)" (with-current-directory ((pn))
/asdf-dir/ (asdf-git-name)) :show t) (run `(tar zcf ("build/" ,(asdf-git-name) ".tar.gz") build/asdf.lisp ,@(run/lines '(git ls-files)))
(asdf-git-name)) :show t)
(values)) (values))
(defun asdf-lisp-name () (defun asdf-lisp-name ()
...@@ -266,8 +253,8 @@ ...@@ -266,8 +253,8 @@
(defun make-asdf-lisp () (defun make-asdf-lisp ()
(build-asdf) (build-asdf)
(concatenate-files (list (apath "build/asdf.lisp")) (concatenate-files (list (pn "build/asdf.lisp"))
(bpath (asdf-lisp-name)))) (pn "build/" (asdf-lisp-name))))
(defun make-archive () (defun make-archive ()
(make-driver-tarball) (make-driver-tarball)
...@@ -278,6 +265,7 @@ ...@@ -278,6 +265,7 @@
(defvar *clnet* "common-lisp.net") (defvar *clnet* "common-lisp.net")
(defvar *clnet-asdf-public* "/project/asdf/public_html/") (defvar *clnet-asdf-public* "/project/asdf/public_html/")
(defun public-path (x) (strcat *clnet-asdf-public* x))
(defun publish-archive () (defun publish-archive ()
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name))))) (let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name)))))
...@@ -291,13 +279,13 @@ ...@@ -291,13 +279,13 @@
(defun link-archive () (defun link-archive ()
(run (format nil "ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S" (run (format nil "ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S"
(tarname (driver-name)) (tarname (driver-name))
(strcat *clnet-asdf-public* "archives/uiop.tar.gz") (public-path "archives/uiop.tar.gz")
(tarname (asdf-defsystem-name)) (tarname (asdf-defsystem-name))
(strcat *clnet-asdf-public* "archives/asdf-defsystem.tar.gz") (public-path "archives/asdf-defsystem.tar.gz")
(tarname (asdf-git-name)) (tarname (asdf-git-name))
(strcat *clnet-asdf-public* "archives/asdf.tar.gz") (public-path "archives/asdf.tar.gz")
(asdf-lisp-name) (asdf-lisp-name)
(strcat *clnet-asdf-public* "archives/asdf.lisp")) (public-path "archives/asdf.lisp"))
:show t :host *clnet*) :show t :host *clnet*)
(values)) (values))
...@@ -312,9 +300,6 @@ ...@@ -312,9 +300,6 @@
("header.lisp" "This is ASDF " ": Another System Definition Facility.") ("header.lisp" "This is ASDF " ": Another System Definition Facility.")
("upgrade.lisp" " (asdf-version \"" "\")"))) ("upgrade.lisp" " (asdf-version \"" "\")")))
(defparameter *version-file*
(apath "version.lisp-expr"))
(defparameter *old-version* nil) (defparameter *old-version* nil)
(defparameter *new-version* nil) (defparameter *new-version* nil)
...@@ -376,13 +361,13 @@ ...@@ -376,13 +361,13 @@
(values new-text foundp))))) (values new-text foundp)))))
(defun transform-file (new-version file prefix suffix) (defun transform-file (new-version file prefix suffix)
(maybe-replace-file (apath file) (version-transformer new-version file prefix suffix))) (maybe-replace-file (pn file) (version-transformer new-version file prefix suffix)))
(defun transform-files (new-version) (defun transform-files (new-version)
(loop :for f :in *versioned-files* :do (apply 'transform-file new-version f))) (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f)))
(defun test-transform-file (new-version file prefix suffix) (defun test-transform-file (new-version file prefix suffix)
(let ((lines (read-file-lines (apath file)))) (let ((lines (read-file-lines (pn file))))
(dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil)) (dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil))
(multiple-value-bind (new-text foundp) (multiple-value-bind (new-text foundp)
(funcall (version-transformer new-version file prefix suffix t) l) (funcall (version-transformer new-version file prefix suffix t) l)
...@@ -402,9 +387,53 @@ ...@@ -402,9 +387,53 @@
(a "Rebuilding ASDF with bumped version") (a "Rebuilding ASDF with bumped version")
(build-asdf))) (build-asdf)))
(defun git-version () (defparameter *version-tag-glob* "[0-9][.][0-9]*")
(first (run/lines '("git" "describe" "--tags" "--match" "[0-9].[0-9][0-9]") :show t)))
(defun version-from-tag (&optional commit)
(first (run/lines `("git" "describe" "--tags" "--match" ,*version-tag-glob*) :show t)))
(defun version-from-file (&optional commit)
(if commit
(run `("git" "show" (,commit":version.lisp-expr")) :output :form)
(read-file-form *version-file*)))
(defun debian-version-from-file (&optional commit)
(let ((line
(if commit
(run `("git" "show" (,commit":debian/changelog")) :output :line)
(read-file-line "debian/changelog"))))
(cl-ppcre:register-groups-bind (ver) ("^cl-asdf [(]([0-9.:-]+)[)] " line)
ver)))
(defun clean ()
(with-current-directory ((pn))
(run '(git clean -xfd)))
(values))
(defun debian-package (&optional (release "release"))
(let* ((debian-version (debian-version-from-file release))
(version (version-from-file release)))
(unless (cl-ppcre:register-groups-bind (x epoch ver rel)
("^(([0-9]+):)?([0-9.]+)-([0-9]+)$" debian-version)
(declare (ignorable x epoch rel))
(equal ver version))
(error "Debian version ~A doesn't match asdf version ~A" debian-version version))
(clean)
(format t "building package version ~A~%" (debian-version-from-file))
(run `(git-buildpackage
;; --git-ignore-new ;; for testing purpose
(--git-debian-branch= ,release)
(--git-upstream-tag="%(version)s")
;;--git-upstream-tree=tag ;; if the changelog says 3.1.2, looks at that tag
;;(--git-upstream-branch= ,version) ;; if the changelog says 3.1.2, looks at that tag
--git-tag --git-retag
;; --git-no-pristine-tar
--git-force-create
--git-ignore-branch)
:directory (pn) :show t)))
(defun re (arg)
(eval (read-from-string arg)))
;;;; Main entry point ;;;; Main entry point
(defun main (args) (defun main (args)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment