Common Lisp and Gentoo have a packaging incompatibility: Common Lisp
has its own package installation system (asdf-install), and this can
cause conflicts and confusion with Lisp packages installed via
portage. Furthermore, there are many Lisp packages that are stable
and useful, but which have not yet made it into portage. (Gentoo's
Common Lisp herd is quite thin these days.) Of course, the same sort
of conflict existed between Perl cpan-install and portage, and this
conflict has been resolved by the beautiful "g-cpan" program.
I offer below some baby steps towards the development of a "g-asdf"
program that might be Common Lisp's answer to g-cpan. I would be very
grateful for any feedback that Gentoo developers might have.
Sincerely,
Hans
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
; (in-package :g-asdf)
;;; WARNING: Please use this program with caution, and only if you
;;; know what you are doing. It modifies files on your hard drive.
;;; you must either run this program as root, or make sure that you
;;; have write permission for your portage overlay directories.
;;; Usage: instead of (asdf:install 'install 'cliki) do (ebuild
;;; "cliki"), and it will create an ebuild of the form
;;; "cl-cliki-N.ebuild", where N is the version number, in your local
;;; portage overlay. Then make a digest (ebuild ... digest), and you
;;; can emerge the thing. Hopefully, in the future the digest-making
;;; and emerging can also be automated.
(require :asdf)
(require :asdf-install)
;; helper functions
(defun split-by-one-space (string)
"Returns a list of substrings of string
divided by ONE space each.
Note: Two consecutive spaces will be seen as
if there were an empty string between them."
(loop for i = 0 then (1+ j)
as j = (position #\Space string :start i)
collect (subseq string i j)
while j))
(defun clp (string)
"Check if string is prefixed by 'cl-'."
(string-equal string (concatenate 'string "cl-" (subseq string 3))))
(defun prefix-cl (string)
"Ensure that string is prefixed by 'cl-'."
(if (clp string) string (concatenate 'string "cl-" string)))
(defun escape-quotes (string)
(let ((escaped (with-output-to-string (o)
(prin1 string o))))
(subseq escaped 1 (- (length escaped) 1))))
;; currently we get portage information by invoking 'portageq' from a
;; shell. Would it be preferable to have lisp parse /etc/make.conf
;; and /etc/make.globals?
(defparameter *portageq* "/usr/bin/portageq"
"Gentoo portage information query tool.")
(defparameter *portage-overlays*
(let* ((string (with-output-to-string (o)
(sb-ext:run-program *portageq* '("portdir_overlay") :output
o) o))
(foo (split-by-one-space string)))
(loop for x in foo do
(setf x (string-trim '(#\Space #\Tab #\Newline) x))
collect x))
"A list of Gentoo portage overlay directories.")
;; we will put ebuilds in the first portage overlay, unless otherwise specified
;; convention: directory strings do not have final "/"
(defparameter *ebuild-dir*
(concatenate 'string (car *portage-overlays*) "/dev-lisp"))
(defparameter *workdir* "/var/tmp/g-asdf"
"Where we unpack and work on lisp systems in order to generate an ebuild.")
(defvar *temporary-files* nil
"Files we can discard after ebuild construction is complete.")
;; we will put system tarballs in the Gentoo DISTDIR; then we will not
;; have to download again when we emerge
(defparameter *distdir*
(string-trim '(#\Space #\Tab #\Newline)
(with-output-to-string (o)
(sb-ext:run-program *portageq*
'("distdir") :output o) o))
"Gentoo portage DISTDIR.")
;;; load-time dependencies
;; question: does this always give every parent that would also be
;; fetched by asdf-install in the case of no previously installed
;; systems?
;; we always prefix a dependency's name with "cl-", assuming that
;; portage will always use this prefix for the names of
;; asdf-installable systems. (I know of at least one exception:
;; stumpwm.)
(defun dependencies (systemname)
(mapcar #'string-downcase (cdr (mapcar #'string (cadr
(asdf:component-depends-on (make-instance 'asdf:load-op) (asdf:find-component
nil systemname)))))))
;; following does not work until package can be found by asdf.
(defun version-number (systemname)
(asdf::component-version (asdf:find-system systemname)))
(defun tar-save-name (packagename)
"Full name of the downloaded tarball (in *distdir*)."
(concatenate 'string *distdir* "/" packagename "-tmp.tar.gz"))
;; Caution: asdf-install has an internal symbol 'untar-package'. Our
;; usage is slightly different.
(defun untar-file (filename destdir)
"Untar file to destdir."
(with-output-to-string (o)
(or
(sb-ext:run-program asdf-install::*tar-program*
(list "-xzvf" filename "-C" destdir)
:output o
:search t
:wait t)
(error "can't untar"))))
(defun get-tar-directory (filename)
"Check *distdir* for the relative name of folder to which files
will be unpacked."
(let* ((tar (with-output-to-string (o)
(or
(sb-ext:run-program asdf-install::*tar-program*
(list "-tzf" filename)
:output o
:search t
:wait t)
(error "can't list archive"))))
(first-line (subseq tar 0 (position #\newline tar))))
(if (find #\/ first-line)
(subseq first-line 0 (position #\/ first-line))
first-line)))
; this is the external entry point
(defun ebuild (systemname)
; download tarball to file called "systemname-tmp.tar.gz" in DISTDIR
; (will later replace 'tmp' with version number extracted from .asd file)
; TO DO: make sure this tarball is deleted if subsequent stages are not
successful
(let* ((filename (tar-save-name systemname))
(old-pathspec (pathname filename)))
(asdf-install::download-files-for-package systemname filename)
(let* ((unpackd (get-tar-directory filename))
(workdir (concatenate 'string *workdir* "/" unpackd))) ; the
resulting unpacked directory
(untar-file filename *workdir*) ; unpack the file into *workdir*
(push (make-pathname :directory (subseq workdir 1))
asdf:*central-registry*) ; TO DO: make sure this goes away later, even in event
of error
(let* ((system-depends (dependencies systemname))
(version (version-number systemname))
(asd-files (mapcar 'pathname-name (loop for asd in (directory
(make-pathname :directory `(:absolute
,workdir) :name :wild :type "asd"))
collect asd)))
;; some system dependencies might be in the original tarball; so
we don't need them
(ebuild-depends (mapcar #'prefix-cl (set-difference system-depends
asd-files :test #'equal)))
(portage-systemname (prefix-cl systemname))
(ebuild-name (concatenate 'string portage-systemname "-" version
".ebuild"))
(ebuild-dir (concatenate 'string *ebuild-dir* "/"
portage-systemname))
;; move the tarball
(new-tarball (rename-file old-pathspec
(make-pathname :defaults old-pathspec
:type "gz"
:name (prefix-cl
(concatenate 'string systemname "-" version ".tar"))))))
(ensure-directories-exist (make-pathname :directory ebuild-dir))
(with-open-file (out (concatenate 'string ebuild-dir "/" ebuild-name)
:direction :output
:if-exists :supersede)
(format out
"# Copyright 1999-2006 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
# $Header: $
inherit common-lisp
DESCRIPTION=\"~A\"
HOMEPAGE=\"http://www.cliki.net/~A\";
SRC_URI=\"http://www.cliki.net/~A\"; # fake URI, because \"ebuild foo
digest\" needs this
RESTRICT=\" fetch mirror \"
LICENSE=\"\~A\"
SLOT=\"0\"
KEYWORDS=\" ~~amd64 ~~ppc ~~sparc ~~x86 \"
IUSE=\"\"
VERSION=\"~A\"
DEPENDS=\" virtual/commonlisp ~{ dev-lisp/~A ~} \"
S=${WORKDIR}/~A
CLPACKAGE=~A
src_unpack() {
unpack ${A}
}
src_install() {
common-lisp-install -r * # just install all files into
${CLSOURCEROOT}; this is what asdf-install would do
~{ common-lisp-system-symlink ~A~%~}
}
"
(or (asdf:system-description (asdf:find-system systemname)) "") ; description
of system
systemname ; cliki homepage
(file-namestring new-tarball) ; tarball name
(or (escape-quotes (asdf:system-license (asdf:find-system systemname))) "") ;
license (TO DO - truncate if too long, escape quotation marks)
version
ebuild-depends ; list of ebuild dependencies
unpackd ; directory to which the tarball unpacks files
systemname
asd-files ))))))
;; TO DO: how to ignore or fill in empty slots in package description:
;; license, etc..?
;; TO DO: (version-number ...) only gives one decimal place. But some
;; packages (e.g. Gary King's asdf-system-connections) need two
;; places, e.g. 0.8.3
;; TO DO: ask the user if she wants to make ebuilds
;; for all of the dependencies; the smart way to do this (see g-cpan)
;; would be to search the portage tree, and ask only if the system is
;; not already in the portage tree
;; TO DO: download chokes if the tarball already exists. Since asdf
;; packagers do not always include version numbers in their tarball
;; names, we have to do some manual comparison to check for updates
;; (e.g. compare checksums).
;; TO DO: be careful that the system has not already been loaded into
;; memory (e.g. if we are upgrading versions).
;; TO DO: make digests (ebuild foo.ebuild digest) for each new ebuild
;;; end of file g-asdf.lisp
--
[email protected] mailing list
