Commit 39fe1d4a authored by Daniel Barlow's avatar Daniel Barlow
Browse files

Deleted obsolete Debian packaging stuff, in case anyone tries to use

it.  If it was useful for anything, it's still in cvs history

New function cclan:write-package is a 1.5-stop function to do all
the packaging stuff given a cvs repository.

(.5?  Doesn't do gpg signing on its own, because
asdf:run-shell-sommand doesn't work for commands that need input)
parent a4f8169b
Loading
Loading
Loading
Loading
+0 −6
Original line number Diff line number Diff line
@@ -22,12 +22,6 @@ a) gpg signature checking would be better if it actually checked against
a list of "trusted to write Lisp" keys, instead of just "trusted to be
who they say they are"

c) error handling and stuff.  one obvious problem with in-place compilation is
that no backout is possible after upgrading to a package that turns out to be
buggy or for which dependencies are missing.  That said, this would be simpler
if packages unpacked into a directory with the version number in their name
(yes, like clx does)

d) in sbcl 0.8.1 we'll have a run-program that knows about $PATH and so
won't need to hardcode gpgpgpgp and tar locations.

+1 −1
Original line number Diff line number Diff line
(in-package :cl-user)

(defpackage :cclan (:use #:cl #:asdf)
	    (:export #:all-components #:cvs-tag #:make-tar-file))
	    (:export #:all-components #:write-package))
+1 −1
Original line number Diff line number Diff line
@@ -3,6 +3,6 @@
(in-package :cclan-system)

(defsystem cclan
    :version "0.0"
    :version "0.1"
    :components ((:file "cclan-package")
		 (:file "cclan" :depends-on ("cclan-package"))))
+46 −273
Original line number Diff line number Diff line
@@ -25,13 +25,17 @@
(defmethod all-components ((module symbol))
  (all-components (find-system module)))

(defun cvs-tag (system)
(defun cvs-tag-name (system)
  (let* ((system (find-system system))
	 (directory (component-pathname system))
	 (version (component-version system)))
    (run-shell-command "cd ~A && cvs tag -F cclan_version_~A"
		       (namestring directory)
		       (substitute #\_ #\. version))))
    (format nil "release_~A"  (substitute #\_ #\. version))))
  
(defun cvs-tag (system)
  (let* ((system (find-system system))
	 (directory (component-pathname system)))
    (run-shell-command "cd ~A && cvs tag -F ~A"
		       (namestring directory)  (cvs-tag-name system))))


(defun write-readme-file (stream suggested-registry system-name)
  "Write a README.install file detailing a possible sequence of commands to use the newly-untarred system."
@@ -39,7 +43,7 @@
1.  Make a symlink in ~W[*] pointing to the .asd file
2.  Start your asdf-enabled lisp
2a. Ensure that ~W[*] is in asdf:*central-registry*
3.  At the lisp prompt, type '(asdf:oos 'asdf:load-op ~W)'. This
3.  At the lisp prompt, type '(asdf:operate 'asdf:load-op ~W)'. This
    will compile and load the system into your running lisp.

[*] This path (~W) is only a suggestion; the important
@@ -50,275 +54,44 @@ definitions.
These instructions were automatically generated by cCLan software. Use
at your own peril.~%" suggested-registry suggested-registry system-name suggested-registry))


(defun make-tar-file (system)
  "Make a tar file named SYSTEM-NAME_VERSION.tar containing all the files in SYSTEM.  The file is created in the directory containing the system directory.  Returns T on success"
  (let* ((system (find-system system))
	 (sys-path  (component-pathname system))
	 (base-path (make-pathname
		     :directory (butlast (pathname-directory sys-path))
		     :defaults sys-path))
	 (readme-path (make-pathname 
		       :directory (pathname-directory sys-path)
		       :name "README"
		       :type "cCLan-install"))
	 (files
	  (mapcar (lambda (x) (enough-namestring x base-path))
		  (list*
		   readme-path
		   (truename (system-definition-pathname system))
		   (mapcar #'component-pathname (all-components system))))))
    (with-open-file (s readme-path :direction :output :if-exists :supersede)
      (write-readme-file s "~/lisp-systems/" (component-name system)))
    (= 0
       (run-shell-command "cd ~A && tar cf ~A_~A.tar  ~{~D ~}"
			  (namestring base-path)
			  (component-name system)
			  (component-version system)			  
			  (remove-if-not #'pathname-name files)))))
(defun write-package (system)
  (let* ((parent-dir
	  (parse-namestring
	   (format nil "/tmp/~A.~A/"
		   (sb-unix:unix-getpid) (get-internal-run-time))))
	 (system (find-system system))
	 (sub-dir-name
	  (format nil "~A-~A"
		  (component-name system) (component-version system)))
	 (cvsroot-file
	  (merge-pathnames "CVS/Root" (component-pathname system)))
	 (old-pwd *default-pathname-defaults*)
	 (*default-pathname-defaults* parent-dir))
    (ensure-directories-exist parent-dir)
    (cvs-tag system)
    (and
     (zerop (asdf:run-shell-command
	     "cd ~A && cvs -d `cat ~A` checkout -d ~A -r ~A -kv ~A"
	     (namestring parent-dir)
	     (namestring cvsroot-file)
	     sub-dir-name
	     (cvs-tag-name system)
	     (component-name system)))
     (with-open-file (o (format nil "~A/INSTALL.asdf" sub-dir-name)
			:direction :output)
       (write-readme-file o "$HOME/lisp/systems/" (component-name system))
       t)
     (zerop (asdf:run-shell-command "cd ~A && tar cf ~A~A.tar ~A"
				    (namestring parent-dir)
				    (namestring old-pwd) sub-dir-name
				    sub-dir-name))
     (zerop (asdf:run-shell-command
	     "gzip -f9  ~A~A.tar"
	     (namestring old-pwd) sub-dir-name))
     (format t "Now run~%  gpg -b -a  ~A~A.tar.gz~%in a shell with a tty"
	     (namestring old-pwd) sub-dir-name))))

(defun class-name-of (x)
  (class-name (class-of x)))

(defun write-debian-rules (stream system)
  (let ((changelog-file-name (enough-namestring
			      (component-pathname (find 'changelog-source-file (all-components system) :key #'class-name-of :test #'string=))
			      (component-pathname system))))
    (format stream "#!/usr/bin/make -f
# debian/rules generated by cCLan tools

# This is the debhelper compatibility version to use.
export DH_COMPAT=3

configure: configure-stamp
configure-stamp:
	dh_testdir
	touch configure-stamp

build: build-stamp
build-stamp:
	dh_testdir
	touch build-stamp

clean:
	dh_testdir
	dh_testroot
	rm -f build-stamp configure-stamp
	dh_clean

install: build
	dh_testdir
	dh_testroot
	dh_clean -k
	dh_installdirs

	$(MAKE) -f Makefile.cCLan-deb install DESTDIR=$(CURDIR)/debian/~A

binary-indep: build install

binary-arch: build install
	dh_testdir
	dh_testroot
	dh_installdocs
	dh_installexamples
	dh_installman
	dh_installinfo
	dh_installchangelogs ~A
	dh_link
	dh_strip
	dh_compress
	dh_fixperms
	dh_installdeb
	dh_shlibdeps
	dh_gencontrol
	dh_md5sums
	dh_builddeb

binary: binary-indep binary-arch
.PHONY: build clean binary-indep binary-arch binary install configure
" (component-name system) changelog-file-name)))

#+infix
(defun write-debian-control (stream system)
  (format stream "Source: ~A
Section: devel
Priority: optional
Maintainer: ~A
Build-Depends: debhelper (>> 3.0.0)
Standards-Version: 3.5.2

Package: ~A
Architecture: all
Depends: common-lisp-controller~{~^, ~A~}
Description: ~A
 ~{~<~% ~1:;~A ~>~}
"
	  ;; FIXME: Clearly this argument list is not
	  ;; sustainable. Also the split should be split-sequence,
	  ;; clearly.
	  (component-name system) (infix-system::debian-maintainer system) (component-name system) (infix-system::debian-dependencies system) (infix-system::short-description system) (asdf::split (infix-system::long-description system))))

(defun write-debian-prerm (stream system)
  (format stream "#! /bin/sh
# prerm script for ~A.
set -e
case \"$1\" in
  remove|upgrade|deconfigure)
    unregister-common-lisp-source ~A
    ;;
  failed-upgrade)
    ;;
  *)
    echo \"prerm called with unknown argument \\`$1'\" >&2
    exit 1
    ;;
esac
# dh_installdeb will replace this with shell code automatically
# generated by other debhelper scripts.

#DEBHELPER#

exit 0
"
    (component-name system) (component-name system)))

(defun write-debian-postrm (stream system)
  (format stream "#! /bin/sh
# postrm for ~A.
set -e
case \"$1\" in
  purge|remove|upgrade|failed-upgrade|abort-install|abort-upgrade|disappear)
    rm -f /usr/share/common-lisp/source/~A
    ;;
  *)
    echo \"postrm called with unknown argument \\`$1'\" >&2
    exit 1

esac

# dh_installdeb will replace this with shell code automatically
# generated by other debhelper scripts.

#DEBHELPER#

exit 0
" (component-name system) (component-name system)))

(defun write-debian-postinst (stream system)
  (format stream "#! /bin/sh
# postinst script for ~A.
set -e
case \"$1\" in
  configure)
    ln -sf /usr/share/common-lisp/repositories/~:*~A \\
      /usr/share/common-lisp/source/~:*~A
    register-common-lisp-source ~:*~A
  ;;
  abort-upgrade|abort-remove|abort-deconfigure)
    unregister-common-lisp-source ~:*~A
    rm -f /usr/share/common-lisp/source/~:*~A
  ;;
  *)
    echo \"postinst called with unknown argument \\`$1'\" >&2
    exit 1
  ;;
esac

#DEBHELPER#
exit 0
" (component-name system)))

(defun print-debian-date (stream arg colonp atsignp &rest params)
  (declare (ignore colonp atsignp params))
  (multiple-value-bind (sec min hr day mon year dow dst tz)
      (decode-universal-time arg)
    (format stream "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~
~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~
~2,'0d:~2,'0d:~2,'0d ~:[+~;-~]~4,'0d"
	    dow
	    day
	    (1- mon)
	    year
	    hr min sec
	    (minusp tz)
	    ;; FIXME: I'm sure this is wrong
	    (+ (* (truncate tz) 100) (mod (* tz 60) 60)))))
		     
#+infix
(defun write-debian-changelog (stream system)
  (format stream "~A (~A-1) cclan; urgency=low

  * Package generated by cCLan scripts

 -- ~A  ~/cclan:print-debian-date/
" (component-name system) (component-version system) (infix-system::debian-maintainer system) (get-universal-time)))

(defun write-debian-dirs (stream system)
  (format stream "~
/usr/share/doc/~A
/usr/share/common-lisp/systems
/usr/share/common-lisp/repositories/~:*~A
" (component-name system)))

(defun write-deb-install-makefile (stream system)
  (let ((components (all-components system))
	(*default-pathname-defaults* (component-pathname system)))
    (format stream "install:
	install -m 644 ~A $(DESTDIR)/usr/share/common-lisp/systems/
~{	install -m 644 ~A $(DESTDIR)/usr/share/common-lisp/repositories/~A~%~}"
	    (enough-namestring (component-pathname (find 'mk-defsystem-source-file components :key #'class-name-of :test #'string=)))
	    (loop for x in components
		  when (typep x 'cl-source-file)
		    collect (enough-namestring (component-pathname x))
		    and collect (format nil "~A/~A" (component-name system) (enough-namestring (component-pathname x)))))))

(defun make-debian-package (system)
  "Make a Debian package, compliant with Debian policy in as much as
that is possible, containing the system named in SYSTEM.  The file will be produced in the directory containing the system directory."
  (let* ((system (find-system system))
	 (components (all-components system))
	 (path (component-pathname system))
	 (debian-directory (merge-pathnames (make-pathname :directory '(:relative "debian"))
					    path)))
    (ensure-directories-exist debian-directory)
    (with-open-file (s (merge-pathnames "rules" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-rules s system))
    (with-open-file (s (merge-pathnames "control" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-control s system))
    (with-open-file (s (merge-pathnames "postinst" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-postinst s system))
    (with-open-file (s (merge-pathnames "prerm" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-prerm s system))
    (with-open-file (s (merge-pathnames "postrm" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-postrm s system))
    (with-open-file (s (merge-pathnames "changelog" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-changelog s system))
    (with-open-file (s (merge-pathnames "dirs" debian-directory)
		       :direction :output
		       :if-exists :supersede)
      (write-debian-dirs s system))
    (with-open-file (s (merge-pathnames "Makefile.cCLan-deb" path)
		       :direction :output
		       :if-exists :supersede)
      (write-deb-install-makefile s system))
    (run-shell-command "cd ~A && chmod +x rules"
		       (directory-namestring debian-directory))
    (run-shell-command "cd ~A && ln -s ~A copyright"
		       (directory-namestring debian-directory)
		       (namestring (component-pathname (find 'licence-source-file components :key #'class-name-of :test #'string=))))
    (run-shell-command "cd ~A && dpkg-buildpackage -us -uc -rfakeroot -b"
		       (directory-namestring path))
    ))