source: trunk/abcl/contrib/abcl-build/build/install.lisp

Last change on this file was 15022, checked in by Evenson Not Org, 3 years ago

contrib/abcl-build: now runs on new build download infrastructure

Incomplete implementation of probing for working local exectuables.
Currently we always download and use a private ABCL unzip of binary
archives to the XDG user space allocated to such persistence.

All tests succeed under macOS/Windows.

File size: 2.4 KB
Line 
1#-abcl (error "Sorry, but this only currently works with the Bear.")
2(in-package :abcl/build)
3
4(defun xdg/abcl-install-root (uri)
5  "Return the private xdg rooted installation location for URI."
6  (merge-pathnames
7   (make-pathname :directory `(:relative "abcl" "install" ,(pathname-name uri)))
8   (uiop/configuration:xdg-data-home)))
9
10(defun xdg/abcl-download-root (&key (for-uri nil for-uri-p))
11  (declare (ignore for-uri-p))
12  (let ((root (merge-pathnames
13               (make-pathname :directory '(:relative "abcl" "dist"))
14               (uiop/configuration:xdg-data-home)))) ;; TODO move to proper XDG cache hierarchy
15    (unless for-uri
16      (return-from xdg/abcl-download-root root))
17    (let* ((uri (if (pathnamep for-uri)
18                    for-uri
19                    (pathname for-uri)))
20           (name (pathname-name uri)))
21      (merge-pathnames
22         (make-pathname :directory `(:relative ,name))
23         root))))
24
25(defgeneric xdg/install ((uri pathname) &key type)
26  (:method ((uri pathname) &key (type :unzip))
27    (declare (ignore type))
28    (download-and-unzip uri)))
29
30(defun download-and-unzip (uri)
31  (let ((archive 
32         (download uri))
33        (root
34         (xdg/abcl-install-root uri)))
35    (ensure-directories-exist root)
36    (sys:unzip archive root)
37    (values
38     root
39     (directory (merge-pathnames "**/*" root)))))
40
41(defun download (uri &key (destination
42                           (merge-pathnames
43                            (make-pathname :defaults uri :host nil :device nil :directory nil)
44                            (xdg/abcl-download-root))))
45  "Download the contents of URI to DESTINATION.
46
47Returns the local pathname of the download artifact."
48  (ensure-directories-exist destination)
49  (uiop:copy-file
50   (open uri :direction :input)
51   destination)
52  destination)
53
54(defun xdg/executable (uri relative-path)
55  (let* ((directory (xdg/abcl-install-root uri))
56         (root (let ((name (pathname-name uri)))
57                 (subseq name 0 (- (length name) (length "-bin")))))
58         (home (merge-pathnames (make-pathname :directory `(:relative ,root))
59                                    directory))
60         (path (merge-pathnames relative-path home)))
61    (dolist (p (possible-executable-names path))
62      (when (probe-file p)
63        (return-from xdg/executable
64          (values
65           (probe-file p)
66           path))))
67    ;; failure
68    (values
69     nil
70     path)))
71
72
73 
74
75 
76
77
78
Note: See TracBrowser for help on using the repository browser.