repos
/
smoke
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Spellcheck
Annotate for file /src/utils/sbcl-bundle.lisp
2009-05-19 tobias
1
(in-package :smoke)
13:59:22 '
2
'
3
(defun strip-foreign-libraries-path ()
'
4
(dolist (library sb-alien::*shared-objects*)
'
5
(setf (slot-value library 'namestring)
'
6
(file-namestring (slot-value library 'pathname)))))
'
7
'
8
(defun make-temporary-directory ()
'
9
(pathname (concatenate 'string (sb-posix:mkdtemp "/tmp/cl-smokeXXXXXX")
'
10
"/")))
'
11
'
12
(defmacro with-temporary-directory ((directory) &body body)
'
13
"Binds DIRECTORY to the pathname of a temporary directory and executes body:"
'
14
`(let ((,directory (make-temporary-directory)))
'
15
(unwind-protect (progn ,@body)
'
16
(unless (zerop
'
17
(sb-ext:process-exit-code
'
18
(sb-ext:run-program "/bin/rm"
'
19
(list "-r" (namestring ,directory)))))
'
20
(cerror "ignore"
2009-07-01 tobias
21
"could not remove temporary directory ~A"
2009-05-19 tobias
22
,directory)))))
13:59:22 '
23
'
24
(defun save-image (file-name &rest options &key &allow-other-keys)
'
25
"Save the lisp image in FILE-NAME."
'
26
(let ((pid (sb-posix:fork)))
'
27
(if (= 0 pid)
'
28
(progn
'
29
(strip-foreign-libraries-path)
'
30
(apply #'sb-ext:save-lisp-and-die file-name :executable t
'
31
options))
'
32
(sb-posix:waitpid pid 0))))
'
33
'
34
(defun write-shell-wrapper (pathname core-name)
'
35
(with-open-file (stream pathname :direction :output)
'
36
(format stream "#!/bin/sh
'
37
cd `dirname \"$0\"`
'
38
LD_LIBRARY_PATH=./ exec -a \"$0\" ./~A $@
'
39
" core-name))
'
40
(sb-posix:chmod pathname #o0755))
'
41
'
42
(defun makeself (run-directory directory-name file-name label
'
43
&optional (startup-script "") &rest args)
'
44
"Make self-extractable archives on Unix
'
45
http://megastep.org/makeself/"
'
46
;; make an absolute pathname sine we change the directory.
'
47
(let ((file-name (merge-pathnames file-name)))
'
48
(flet ((arguments (&rest args)
'
49
(format nil "~{~A ~}" args)))
'
50
(unless (zerop
'
51
(sb-ext:process-exit-code
'
52
(sb-ext:run-program
'
53
"/bin/sh"
'
54
(list "-c"
'
55
(apply #'arguments
'
56
"cd " (namestring run-directory) " && "
'
57
"makeself --nox11" (namestring directory-name)
'
58
(namestring file-name) label
'
59
startup-script args)))))
'
60
(error "Create ~A failed." file-name)))))
'
61
'
62
(defun save-bundle (file-name &optional extra-files &rest options &key &allow-other-keys)
'
63
"Creates a FILE-NAME.tar.bz2 in the current directory.
'
64
This bundle contains a dumped image, the wrapper libraries and a
'
65
script to run in. OPTIONS is passed to SB-EXT:SAVE-LISP-AND-DIE."
'
66
(with-temporary-directory (dir)
'
67
(let ((bundle-dir (merge-pathnames (make-pathname :directory
'
68
(list :relative file-name))
'
69
dir)))
'
70
(sb-posix:mkdir bundle-dir #o0755)
'
71
(dolist (library sb-alien::*shared-objects*)
'
72
(sb-ext:run-program
'
73
"/bin/cp" (list (namestring (slot-value library 'pathname))
'
74
(namestring bundle-dir))))
'
75
(apply #'save-image (namestring (make-pathname :name "sbcl-core"
'
76
:defaults bundle-dir))
'
77
options)
'
78
(write-shell-wrapper (make-pathname :defaults bundle-dir
'
79
:name "run"
'
80
:type "sh")
'
81
"sbcl-core")
'
82
(dolist (file extra-files)
'
83
(copy-file file (merge-pathnames bundle-dir file)))
'
84
(makeself dir bundle-dir file-name "sbcl-bundle"
'
85
"./run.sh"))))