From 051f9dc4daa2bd652c76d7d4b2bece0e1fc3d05c Mon Sep 17 00:00:00 2001 From: Alan Ruttenberg Date: Fri, 5 Nov 2021 02:42:08 -0400 Subject: [PATCH 1/6] Add OSGI functionality to JSS Other minor fixes in invoke.lisp Engage the #1".." reader, which allows java expressions e.g. #1"System.out.printLn("foo")" --- contrib/abcl-asdf/abcl-asdf.asd | 26 +- contrib/abcl-asdf/asdf-osgi-bundle.lisp | 25 ++ contrib/abcl-asdf/osgi.lisp | 368 ++++++++++++++++++++++++ contrib/jss/invoke.lisp | 92 +++--- contrib/jss/packages.lisp | 20 ++ 5 files changed, 489 insertions(+), 42 deletions(-) create mode 100644 contrib/abcl-asdf/asdf-osgi-bundle.lisp create mode 100644 contrib/abcl-asdf/osgi.lisp diff --git a/contrib/abcl-asdf/abcl-asdf.asd b/contrib/abcl-asdf/abcl-asdf.asd index 6b6c7bc81..7be93ce96 100644 --- a/contrib/abcl-asdf/abcl-asdf.asd +++ b/contrib/abcl-asdf/abcl-asdf.asd @@ -7,17 +7,23 @@ :depends-on (jss abcl-build) :components ((:module package - :pathname "" - :components ((:file "package"))) + :pathname "" + :components ((:file "package"))) (:module base - :pathname "" - :components ((:file "abcl-asdf") - (:file "asdf-jar" :depends-on ("abcl-asdf"))) - :depends-on (package maven)) + :pathname "" + :components ((:file "abcl-asdf") + (:file "asdf-jar" :depends-on ("abcl-asdf"))) + :depends-on (package maven)) (:module maven - :pathname "" - :components ((:file "maven") - (:file "mvn-module")) - :depends-on (package))) + :pathname "" + :components ((:file "maven") + (:file "mvn-module")) + :depends-on (package)) + (:module osgi + :pathname "" + :components ((:file "osgi") + (:file "asdf-osgi-bundle")) + :depends-on (base maven) + :serial t)) :in-order-to ((test-op (test-op abcl-asdf-tests)))) diff --git a/contrib/abcl-asdf/asdf-osgi-bundle.lisp b/contrib/abcl-asdf/asdf-osgi-bundle.lisp new file mode 100644 index 000000000..316a4e0ae --- /dev/null +++ b/contrib/abcl-asdf/asdf-osgi-bundle.lisp @@ -0,0 +1,25 @@ +(in-package :asdf) + +(defclass bundle (jar-file) + ;; bootdelegation and system-packages correspond to the framework + ;; config vars org.osgi.framework.bootdelegation and + ;; org.osgi.framework.system.packages.extra implementation is to + ;; restart OSGI with the values appended to the existing + ;; configuration in *osgi-configuration* I thought I understood the + ;; difference but I don't - only system-packages has worked for me. + ;; These should be lists of strings . What these accomplish might + ;; better be done with "extension bundles" but I haven't tried them + ;; yet. + ((bootdelegation :initarg :bootdelegation :initform nil) + (system-packages :initarg :system-packages :initform nil))) + +(defmethod perform ((operation load-op) (c bundle)) + (let ((extra-bootdelegation (slot-value c 'bootdelegation)) + (extra-system-packages (slot-value c 'system-packages))) + (if (or extra-bootdelegation extra-system-packages) + (warn "not handling :bootdelegation and :system-packages args yet")) + (jss:add-bundle (component-pathname c)))) + +(defmethod perform ((operation compile-op) (c bundle)) + (jss:add-bundle (component-pathname c))) + diff --git a/contrib/abcl-asdf/osgi.lisp b/contrib/abcl-asdf/osgi.lisp new file mode 100644 index 000000000..6b33fa4b6 --- /dev/null +++ b/contrib/abcl-asdf/osgi.lisp @@ -0,0 +1,368 @@ +(in-package :jss) + +;; This is the start of an extension of JSS to be able to use OSGI +;; Bundles. Currently one can, at least, take advantage of the class +;; hiding aspect - with the visible packages listed in a JAR manifest +;; "Exported-Packages", those classes can be accessed while the others +;; can't. + +;; General use: +;; (add-bundle path-to-jar-file) +;; (find-java-class ) +;; Do stuff + +;; The current implementation assumes you aren't aiming to have +;; multiple version of the same class exported from different bundles +;; in that find-java-class will try to complain when a class name is +;; ambiguous, but once a class is found it will continue to be found, +;; even if another version of the class becomes available in another +;; bundle. For finer control use: +;; (find-bundle-class bundle classname) +;; Class name can be abbreviated as with find-java-class + +;; bundle arguments can either be a string result of +;; (#"getSymbolicName" bundle) or a bundle object loaded bundles are +;; in an association list in *loaded-osgi-bundles*, with each element +;; being (name object class-lookup-hash) + +;; My primary use is to use a project with dependencies that conflict +;; with the jars I'm using. Here's an example of how I package that +;; using maven. It is from module-bundle/pom.xml from the project +;; https://github.com/alanruttenberg/pagoda (that project uses maven +;; modules in order to also be able to run the usual packaging) +;; +;; +;; boilerplate. The maven-bundle-plugin takes over the package phase from the default assembly plugin +;; org.apache.felix +;; maven-bundle-plugin +;; true +;; +;; +;; This will be the prefix for the jar that is created. It will be prefix-.jar +;; pagoda-bundle +;; +;; +;; These are the packages that I want to be visible +;; uk.ac.ox.cs.pagoda.*,uk.ac.ox.cs.JRDFox.* +;; This says to put absolutely every class/jar that they depend on in the created bundle +;; *;scope=compile +;; true +;; This avoids having the bundle plugin write dependencies that imply +;; the jars of the dependency are also bundles. If they aren't then +;; you get link errors when trying to install the bundle. (sheesh!) +;; +;; +;; +;; + + +(defvar *osgi-framework* nil) + +;; Beware the cache. Bundles are installed in a cache folder and +;; reinstalling them without clearing that will cause a conflict - an +;; error about duplicates. (Among other things, the installation +;; unpacks the jars in the bundle and arranges the classpath to use +;; them). While I believe that the cache will be refreshed if the +;; version number on the bundle is changed, it's annoying to do that +;; during development. Instead, if the bundle is already installed +;; (available via #"getBundles") then we compare the modification +;; dates of the installed verison and file-write-date of the jar, and +;; if the jar is newer uninstall the old bundle and install the new +;; one. + +;; The cache location is taken from *osgi-cache-location*. The current +;; location can be had by (osgi-cache-path) You can ensure a clean +;; cache by calling (ensure-osgi-framework :clean-cache t) before +;; calling add-bundle, or set *osgi-clean-cache-on-start* to t + +;; arg name is used to identify the bundle among the loaded bundles. If +;; not supplied then the "symbolic name" is used, the value of the +;; manifest header "Bundle-SymbolicName". + +(defvar *osgi-cache-location* (namestring (merge-pathnames + (make-pathname :directory '(:relative "abcl-felix-cache")) + (user-homedir-pathname))) + "Where bundle jars are copied to and unpacked if necessary. Default is to have it distinct from the default, since who knows what's been put there") + +;;http://felix.apache.org/documentation/subprojects/apache-felix-framework/apache-felix-framework-configuration-properties.html + +(defvar *osgi-configuration* `(;; Where the cache should live + ("org.osgi.framework.storage" ,*osgi-cache-location*) + ;; So that imported system classes are loaded using ABCL's classloader + ("org.osgi.framework.bundle.parent" "framework") + ;; sounds good even though I'm not understanding bootdelegation yet + ("felix.bootdelegation.implicit" "true") + ;; just in case + ("org.osgi.framework.library.extensions" "jnilib,dylib") + )) + +(defvar *osgi-clean-cache-on-start* t "Clear the cache on startup. First add-bundle has this set as t and then flips to nil (so you don't lose the rest of your packages)") + +(defvar *osgi-native-libraries* nil "Alist of bundles -> native libraries they're to load. Informative - not prescriptive") + +(defvar *before-osgi-starting-hooks* nil "A list of functions to call before before OSGI starts, for example to modify *osgi-configuration*") + +(defvar *loaded-osgi-bundles* nil) + +;; Why is the native library not being loaded with system.load()? + +;; Because system.load looks up the stack for a caller and that +;; caller's classloader is used to findLibrary, and the classloader +;; is the wrong one. +;; Proof: The call to loadlibary on the *right* classloader works. +;; The class in question is FactPlusPlus which calls System.load() in its init. +;; FaCTPlusPlusReasonerFactory is loaded by the same (osgi) classloader so we get *that* classloader +;; and then call the loadLibrary method on it. It takes another class (which classloader is used for findLibrary +;; (jstatic (find "loadLibrary" (#"getDeclaredMethods" (find-java-class 'lang.classloader)) :key #"getName" :test 'equal) c (find-java-class 'FaCTPlusPlusReasonerFactory) "FaCTPlusPlusJNI" +false+) + +;; However in the context, when system.load is called, it doesn't have +;; a class to look the classloader up with, so it looks down the stack +;; and grabs a class and uses its classloaer. Apparently that's *not* +;; the osgi classloader, presumably because it's called from the +;; framework, and the framework's classloader is not the same as the +;; classloader that the framework uses to load bundle classes. + +;; here's a guess. If calling with felix.main, the framework gets an +;; osgi classloader and subsequently all is happy. +;; +;; Could be fixed in code by not calling system.load but rather +;; speaking to the classloader directly as above. +;; A theory: If a class in another bundle loaded factpp then it would work. +;; THIS DOESN'T HAPPEN IF felix.main is used rather than felix.framework!!! + +;; configuration properties are set last to first, so you can prepend overrides to *osgi-configuration* + +(eval-when (:load-toplevel :execute) + (loop for function in *before-osgi-starting-hooks* do (funcall function))) + +(defun ensure-osgi-initialized (&key (empty-cache *osgi-clean-cache-on-start*)) + (unless *osgi-framework* + (loop for function in *before-osgi-starting-hooks* do (funcall function)) + (let ((map (new 'java.util.properties)) + (configuration *osgi-configuration*)) + (loop for (prop val) in (reverse configuration) do (#"setProperty" map prop val)) + (when empty-cache + (#"setProperty" map "org.osgi.framework.storage.clean" "onFirstInit")) + (flet ((resolve (artifact) + (funcall (intern "RESOLVE" 'abcl-asdf) artifact))) + (add-to-classpath ;; sometimes resolve returns ":" separated pathnames of both main and framework jars. Only need the first. + ;; 5.6.1 current as of Jan/17 + (car (uiop/utility:split-string (resolve "org.apache.felix/org.apache.felix.main/5.6.1") :separator '(#\:))))) + (let* ((framework-factory-class (find-java-class 'org.osgi.framework.launch.FrameworkFactory)) + (ffs (#"load" 'ServiceLoader framework-factory-class (#"getClassLoader" framework-factory-class))) + (factory (#"next" (#"iterator" ffs))) + (framework (#"newFramework" factory map))) + (#"start" framework) + (setq *osgi-framework* framework))))) + +(defun force-unpack-native-libraries (bundle jar) + "Not used unless OSGI misbehaves again" + (let ((wiring (#"adapt" bundle (find-java-class 'BundleWiring)))) + (loop for native in (jss::j2list (#"getNativeLibraries" wiring)) + for entry = (#"getEntryName" native) + for library-path = (#"getEntryAsNativeLibrary" (#"getContent" (#"getRevision" wiring)) entry) + do (pushnew (list jar library-path) *osgi-native-libraries* :test 'equalp) + ;;(#"load" 'system library-path) + ))) + +(defun stop-osgi () + (#"stop" *osgi-framework*) + (setq *osgi-framework* nil) + ;; should *loaded-osgi-bundles* be set to nil here? + ) + +(defun reset-osgi () + "Restart OSGI after emptying the cache, and reload bundles that were loaded" + (stop-osgi) + (ensure-osgi-initialized :empty-cache t) + (loop for (name nil nil jar) in (copy-list *loaded-osgi-bundles*) + do (add-bundle jar :name name))) + +(defun get-osgi-framework-property (property) + (ensure-osgi-initialized) + (#"getProperty" (#"getBundleContext" *osgi-framework*) property)) + +(defun add-to-comma-separated-osgi-config (config-parameter elements) + (let* ((entry (find config-parameter *osgi-configuration* :test 'equal :key 'car)) + (value (if entry (second entry) "")) + (new-value (format nil "~{~a~^,~}" + (sort (union elements (if (equal value "") nil (uiop/utility:::split-string value :separator '(#\,))) + :test 'equalp) + 'string-lessp)))) + (if entry + (setf (second entry) new-value) + (push (list config-parameter new-value) *osgi-configuration*)))) + +(defun osgi-cache-path () + (ensure-osgi-initialized) + (get-osgi-framework-property "org.osgi.framework.storage")) + +;; this: http://lisptips.com/post/11649360174/the-common-lisp-and-unix-epochs is wrong! +;; Compute the offset using (#"currentTimeMillis" 'system) +(defun universal-to-bundle-time (universal-time) + "Convert from lisp time to unix time in milliseconds, used by osgi" + (let ((offset (- (get-universal-time) (floor (#"currentTimeMillis" 'system) 1000)))) + (* 1000 (- universal-time offset)))) + +(defun add-bundle (jar &key name) + (ensure-osgi-initialized) + (setq *osgi-clean-cache-on-start* nil) + (setq jar (namestring (translate-logical-pathname jar))) + (let* ((bundle-context (#"getBundleContext" *osgi-framework*)) + (bundle (find jar (#"getBundles" bundle-context) :key #"getLocation" :test 'search))) + (when (or (not bundle) + (< (#"getLastModified" bundle) + (universal-to-bundle-time (file-write-date jar)))) + (when bundle + (warn "reinstalling bundle ~a" jar) + (#"uninstall" bundle)) + (unless (member :scheme (pathname-host jar)) + (setq jar (concatenate 'string "file:" jar))) + (setq bundle (#"installBundle" bundle-context jar))) + + (#"start" bundle) + (let ((name (or name (#"getSymbolicName" bundle)))) + (let* ((index (index-class-names (bundle-exports bundle)))) + (setq *loaded-osgi-bundles* (remove name *loaded-osgi-bundles* :test 'equalp :key 'car)) + (push (list name bundle index jar) *loaded-osgi-bundles*) +; (force-unpack-native-libraries bundle jar) + bundle)))) + +(defun index-class-names (names &key (table (make-hash-table :test 'equalp))) + (with-constant-signature ((matcher "matcher" t) (substring "substring") + (jreplace "replace" t) (jlength "length") + (matches "matches") + (group "group")) + (loop for name in names + with class-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*\\.class{0,1}$") + with name-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*?([^.]*)$") + when (matches (matcher class-pattern name)) + do + (let* ((fullname (substring (jreplace name #\/ #\.) 0 (- (jlength name) 6))) + (matcher (matcher name-pattern fullname)) + (name (progn (matches matcher) (group matcher 1)))) + (pushnew fullname (gethash name table) + :test 'equal)))) + table) + + + +(defun bundle-headers (bundle) + (loop with headers = (#"getHeaders" bundle) + for key in (j2list (#"keys" headers)) + collect (list key (#"get" headers key) (#"get" headers key)))) + +(defun bundle-header (bundle key) + (#"get" (#"getHeaders" bundle) key)) + +;; Not useful yet +(defun bundle-capabilities (bundle) + (let ((bundleWiring (#"adapt" bundle (find-java-class 'BundleWiring)))) + (loop with i = (#"iterator" (#"getCapabilities" bundlewiring +null+)) + while (#"hasNext" i) + for cap = (#"next" i) + for namespace = (#"getNamespace" cap) + for es = (#"entrySet" (#"getAttributes" cap)) + collect (list* namespace cap (mapcar #"getValue" (set-to-list es)))))) + +;; This is ugly but will do until there's a better way The exported +;; packages are listed as the value of the header "Export-Package" The +;; format is a concatenation of entries like the below + +;; package;key="...","..";key2="", +;; package2, +;; package3;.., + +;; i.e. for each package there are some optional key values pairs +;; which we're not going to attend to now, + +;; Step 1: Since there are "," inside the string we take this apart by +;; first emptying the strings, then splitting by ",", then tossing +;; anything past a ";" + +;; Step 2: There may or may not be subpackages. Since we're going to +;; match on the prefix, we throw away everything but the prefix. This +;; is done by first sorting, then taking an element and comparing it +;; to subsequent ones. When the first start the other we toss the other. +;; Not really necessary - not doing it would just be wasted work. + +;; Step 3: The bundlewiring interface lets one iterate over all +;; 'resources', which are like entries in a jar, some of which are +;; class files. We only want the exported class files, so we only keep +;; those that start with our prefix (.->/ to make it a path) + +;; Step 4: Extract the class name from the path (keep ".class" at the end) + +;; Learned about bundle wiring at +;; http://stackoverflow.com/questions/22688997/how-i-can-get-list-of-all-classes-from-given-bundle + +;; Spun my wheels a while looking for a cleaner way to do this, but +;; its confusing. This should do for now. + +(defun bundle-exports (bundle) + (let ((entry (bundle-header bundle "Export-Package")) + (bundleWiring (#"adapt" bundle (find-java-class 'BundleWiring)))) + ;; if there's an "Export-package" then respect it + (if entry + (loop for package-prefix + in + (loop with candidates = (sort (mapcar (lambda(el) (#"replaceAll" el ";.*$" "")) + (uiop/utility::split-string (#"replaceAll" entry "(\\\".*?\\\")" "") :separator '(#\,))) + 'string-lessp) + for first = (pop candidates) + until (null candidates) + do (loop for next = (car candidates) + while (and next (eql 0 (search first next))) do (pop candidates)) + collect first) + for path = (substitute #\/ #\. package-prefix) + append + (loop for entry in (set-to-list (#"listResources" bundlewiring (concatenate 'string "/" path) + "*.*" (jfield (find-java-class 'BundleWiring) "FINDENTRIES_RECURSE"))) + for url = (#"toString" (#"getEntry" bundle entry)) + collect + (substitute #\. #\/ (subseq + (#"toString" (#"getEntry" bundle entry)) + (search path url :test 'char=))))) + ;; otherwise it's all good + (loop for entry in (set-to-list (#"listResources" + bundlewiring "/" + "*.*" (jfield (find-java-class 'BundleWiring) "FINDENTRIES_RECURSE"))) + for url = (#"toString" (#"getEntry" bundle entry)) + when (#"matches" url ".*\\.class$") + collect + (substitute #\. #\/ (subseq (subseq url 9) (1+ (search "/" (subseq url 9))))))))) + +(defun dwim-find-bundle-entry (name) + (let ((string (string name))) + (let ((candidates (remove-if-not (lambda(e) (search string (car e) :test 'string-equal)) jss::*loaded-osgi-bundles*))) + (cond ((= (length candidates) 0) (error "Bundle ~a not found" name)) + ((= (length candidates) 1) (car candidates)) + (t (error "Ambiguous \"~a\" could mean ~{~a~^, ~}" (mapcar 'car candidates))))))) + +;; Like find java class, but looks in a bundle. no-cache means don't +;; look for it like find-java-class and don't cache it for +;; find-java-class. Default currently is to do so, but I might change +;; the default, as it could lead to confusion in the case where both +;; find-java-class and find-bundle-class are used and there are two +;; versions of the same class in the environment. + +(defun find-bundle-class (bundle classname &key no-cache &aux bundle-entry) + (cond ((or (stringp bundle) (symbolp bundle) ) + (setq bundle-entry (dwim-find-bundle-entry bundle)) + (setq bundle (second bundle-entry))) + ((java-object-p bundle) + (setq bundle-entry (find bundle *loaded-osgi-bundles* :key 'second)))) + (assert bundle () "No bundle named ~a" bundle) + ;; we'll allow one bundle to be in the cache. Check if we're the one. + (or (let ((found (and (not no-cache) (gethash (string classname) *imports-resolved-classes*)))) + (and (consp found) (eq (car found) bundle) (second found))) + (let ((found (lookup-class-name classname :table (third bundle-entry)))) + (if found + (progn + (unless no-cache + (unless (gethash classname *imports-resolved-classes*) + (setf (gethash classname *imports-resolved-classes*) (cons bundle found)))) + (#"loadClass" bundle found)) + (#"loadClass" bundle (string classname)))))) + + diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp index 06f0faf87..71b3227f7 100644 --- a/contrib/jss/invoke.lisp +++ b/contrib/jss/invoke.lisp @@ -147,12 +147,22 @@ NAME can either string or a symbol according to the usual JSS conventions." (defun maybe-resolve-class-against-imports (classname) (or (gethash (string classname) *imports-resolved-classes*) - (let ((found (lookup-class-name classname))) - (if found - (progn - (setf (gethash classname *imports-resolved-classes*) found) - found) - (string classname))))) + (let ((found (lookup-class-name classname :muffle-warning t))) + (if found + (progn + (setf (gethash classname *imports-resolved-classes*) found) + found) + (let ((choices + (loop for bundle-entry in *loaded-osgi-bundles* + for found = (lookup-class-name classname :table (third bundle-entry) :muffle-warning t) + when found collect (list bundle-entry found)))) + (cond ((zerop (length choices)) (string classname)) + ((= (length choices) 1) + (unless (gethash classname *imports-resolved-classes*) + (setf (gethash classname *imports-resolved-classes*) (list (second (caar choices)) (second (car choices))))) + (list (second (caar choices)) (second (car choices)))) + (t (error "Ambiguous class name: ~{~a~^, ~}" + (mapcar (lambda(el) (format "~a in bundle ~a" (second el) (caar el))) choices))))))))) (defvar *class-name-to-full-case-insensitive* (make-hash-table :test 'equalp)) @@ -172,7 +182,7 @@ NAME can either string or a symbol according to the usual JSS conventions." (object-as-class (if object-as-class-name (find-java-class object-as-class-name)))) (if (eq method 'new) - (apply #'jnew (or object-as-class-name object) args) + (apply #'jnew (or object-as-class-name object-as-class object) args) (if raw? (if (symbolp object) (apply #'jstatic-raw method object-as-class args) @@ -206,14 +216,18 @@ NAME can either string or a symbol according to the usual JSS conventions." (eval-when (:compile-toplevel :load-toplevel :execute) (defun read-invoke (stream char arg) - (unread-char char stream) - (let ((name (read stream))) - (if (or (find #\. name) (find #\{ name)) - (jss-transform-to-field name arg) - (let ((object-var (gensym)) - (args-var (gensym))) - `(lambda (,object-var &rest ,args-var) - (invoke-restargs ,name ,object-var ,args-var ,(eql arg 0))))))) + (if (eql arg 1) + (progn (require 'javaparser) + (read-sharp-java-expression stream)) + (progn + (unread-char char stream) + (let ((name (read stream))) + (if (or (find #\. name) (find #\{ name)) + (jss-transform-to-field name arg) + (let ((object-var (gensym)) + (args-var (gensym))) + `(lambda (,object-var &rest ,args-var) + (invoke-restargs ,name ,object-var ,args-var ,(eql arg 0))))))))) (set-dispatch-macro-character #\# #\" 'read-invoke)) (defmacro with-constant-signature (fname-jname-pairs &body body) @@ -292,7 +306,7 @@ want to avoid the overhead of the dynamic dispatch." (error "Ambiguous class name: ~a can be ~{~a~^, ~}" name choices)))) (if (zerop bucket-length) (progn (unless muffle-warning (warn "can't find class named ~a" name)) nil) - (let ((matches (loop for el in bucket when (matches-end name el 'char=) collect el))) + (let ((matches (loop for el in bucket when (matches-end name el 'char-equal) collect el))) (if (= (length matches) 1) (car matches) (if (= (length matches) 0) @@ -304,6 +318,15 @@ want to avoid the overhead of the dynamic dispatch." (ambiguous matches)))) (ambiguous matches)))))))))) +;; Interactive use: Give a full class name as a string, return the shortest unique abbreviation +(defun shortest-unambiguous-java-class-abbreviation(name &optional as-string?) + (let ((components (mapcar (if as-string? 'identity 'string-upcase) (uiop/utility:split-string name :separator '(#\.))))) + (loop for size from 1 to (length components) + for abbreviation = (funcall (if as-string? 'identity (lambda(e) (intern (string-upcase e)))) + (format nil "~{~a~^.~}" (subseq components (- (length components) size) (length components)))) + for possible = (jss::lookup-class-name abbreviation :return-ambiguous t) + when (not (listp possible)) do (return-from shortest-unambiguous-java-class-abbreviation abbreviation)))) + #+(or) (defun get-all-jar-classnames (jar-file-name) (let* ((jar (jnew (jconstructor "java.util.jar.JarFile" (jclass "java.lang.String")) (namestring (truename jar-file-name)))) @@ -541,28 +564,33 @@ associated is used to look up the static FIELD." (when *do-auto-imports* (do-auto-imports))) -(defun japropos (string) +(defun japropos (string &optional (fn (lambda(match type bundle?) (format t "~a: ~a~a~%" match type bundle?)))) "Output the names of all Java class names loaded in the current process which match STRING.." - (setq string (string string)) - (let ((matches nil)) - (maphash (lambda(key value) - (declare (ignore key)) - (loop for class in value - when (search string class :test 'string-equal) - do (pushnew (list class "Java Class") matches :test 'equal))) - *class-name-to-full-case-insensitive*) - (loop for (match type) in (sort matches 'string-lessp :key 'car) - do (format t "~a: ~a~%" match type)) - )) + (flet ((searchit (table &optional bundle-name) + (let ((bundle? (if bundle-name (format nil ", Bundle: ~a" bundle-name) ""))) + (setq string (string string)) + (let ((matches nil)) + (maphash (lambda(key value) + (declare (ignore key)) + (loop for class in value + when (search string class :test 'string-equal) + do (pushnew (list class "Java Class") matches :test 'equal))) + table) + (loop for (match type) in (sort matches 'string-lessp :key 'car) + do (funcall fn match type bundle?)))))) + (searchit *class-name-to-full-case-insensitive*) + (loop for (name nil table) in *loaded-osgi-bundles* + do (searchit table name)))) (defun jclass-method-names (class &optional full) (if (java-object-p class) (if (equal (jclass-name (jobject-class class)) "java.lang.Class") - (setq class (jclass-name class)) - (setq class (jclass-name (jobject-class class))))) + nil + (setq class (jobject-class class))) + (setq class (find-java-class class))) (union - (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getMethods" (find-java-class class))) :test 'equal) - (ignore-errors (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getConstructors" (find-java-class class))) :test 'equal)))) + (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getMethods" class)) :test 'equal) + (ignore-errors (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getConstructors" class)) :test 'equal)))) (defun java-class-method-names (class &optional stream) "Return a list of the public methods encapsulated by the JVM CLASS. diff --git a/contrib/jss/packages.lisp b/contrib/jss/packages.lisp index ec935cc1b..78e1b1c22 100644 --- a/contrib/jss/packages.lisp +++ b/contrib/jss/packages.lisp @@ -1,6 +1,11 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar cl-user::*before-osgi-starting-hooks* nil) + (export 'cl-user::*before-osgi-starting-hooks* 'cl-user)) + (defpackage :jss (:nicknames "java-simple-syntax" "java-syntax-sucks") (:use :common-lisp :extensions :java) + (:import-from "CL-USER" cl-user::*before-osgi-starting-hooks*) (:export #:*inhibit-add-to-classpath* #:*added-to-classpath* @@ -12,10 +17,25 @@ #:invoke-add-imports #:find-java-class + + #:add-bundle + #:find-bundle-class + #:ensure-osgi-initialized + #:*osgi-cache-location* + #:*osgi-configuration* + #:*osgi-clean-cache-on-start* + #:jcmn #:java-class-method-names #:japropos #:new + #:add-bundle + #:find-bundle-class + #:ensure-osgi-initialized + #:*osgi-cache-location* + #:*osgi-configuration* + #:*osgi-clean-cache-on-start* + #:jar-import #:classfiles-import From 45c1262772c81222372131d9a9087bcee3050568 Mon Sep 17 00:00:00 2001 From: Alan Ruttenberg Date: Fri, 5 Nov 2021 19:49:16 -0400 Subject: [PATCH 2/6] Typo 3 colons instead of 2 for package name. Added osgi versions of find-java-class and lookup-class-name that I missed in the earlier merge --- contrib/abcl-asdf/osgi.lisp | 2 +- contrib/jss/invoke.lisp | 27 ++++++++++++++++----------- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/contrib/abcl-asdf/osgi.lisp b/contrib/abcl-asdf/osgi.lisp index 6b33fa4b6..031a9c3b5 100644 --- a/contrib/abcl-asdf/osgi.lisp +++ b/contrib/abcl-asdf/osgi.lisp @@ -186,7 +186,7 @@ (let* ((entry (find config-parameter *osgi-configuration* :test 'equal :key 'car)) (value (if entry (second entry) "")) (new-value (format nil "~{~a~^,~}" - (sort (union elements (if (equal value "") nil (uiop/utility:::split-string value :separator '(#\,))) + (sort (union elements (if (equal value "") nil (uiop/utility::split-string value :separator '(#\,))) :test 'equalp) 'string-lessp)))) (if entry diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp index 71b3227f7..0e18fc3e0 100644 --- a/contrib/jss/invoke.lisp +++ b/contrib/jss/invoke.lisp @@ -128,11 +128,7 @@ (defvar *imports-resolved-classes* (make-hash-table :test 'equalp) "Hashtable of all resolved imports by the current process.")) -(defun find-java-class (name) - "Returns the java.lang.Class representation of NAME. -NAME can either string or a symbol according to the usual JSS conventions." - (jclass (maybe-resolve-class-against-imports name))) (defmacro invoke-add-imports (&rest imports) "Push these imports onto the search path. If multiple, earlier in list take precedence" @@ -277,9 +273,10 @@ want to avoid the overhead of the dynamic dispatch." (defun lookup-class-name (name &key - (table *class-name-to-full-case-insensitive*) + (table *class-name-to-full-case-insensitive*) (muffle-warning *muffle-warnings*) - (return-ambiguous nil)) + (return-ambiguous nil) + &aux (symbol? (symbolp name))) (let ((overridden (maybe-found-in-overridden name))) (when overridden (return-from lookup-class-name overridden))) (setq name (string name)) @@ -293,7 +290,7 @@ want to avoid the overhead of the dynamic dispatch." (let ((matcher (#0"matcher" last-name-pattern name))) (#"matches" matcher) (#"group" matcher 1)))) - (let* ((bucket (gethash last-name *class-name-to-full-case-insensitive*)) + (let* ((bucket (gethash last-name table)) (bucket-length (length bucket))) (or (find name bucket :test 'equalp) (flet ((matches-end (end full test) @@ -306,7 +303,7 @@ want to avoid the overhead of the dynamic dispatch." (error "Ambiguous class name: ~a can be ~{~a~^, ~}" name choices)))) (if (zerop bucket-length) (progn (unless muffle-warning (warn "can't find class named ~a" name)) nil) - (let ((matches (loop for el in bucket when (matches-end name el 'char-equal) collect el))) + (let ((matches (loop for el in bucket when (matches-end name el (if symbol? 'char-equal 'char=)) collect el))) (if (= (length matches) 1) (car matches) (if (= (length matches) 0) @@ -476,9 +473,17 @@ associated is used to look up the static FIELD." (jmethod "java.lang.Class" "forName" "java.lang.String" "boolean" "java.lang.ClassLoader")) (defun find-java-class (name) - (or (jstatic +for-name+ "java.lang.Class" - (maybe-resolve-class-against-imports name) +true+ java::*classloader*) - (ignore-errors (jclass (maybe-resolve-class-against-imports name))))) + (if (consp name) ;; invoke-restargs first calls maybe-resolve-class-against-imports, and this on the result. + (jcall "loadClass" (car name) (second name)) + (let ((maybe (maybe-resolve-class-against-imports name))) + (or (and (atom maybe) (not (null maybe)) + (jstatic +for-name+ "java.lang.Class" maybe +true+ java::*classloader*)) + (ignore-errors + (let ((resolved (maybe-resolve-class-against-imports name))) + (if (consp resolved) + (jcall "loadClass" (car resolved) (second resolved)) + (jclass resolved)))) + )))) (defmethod print-object ((obj (jclass "java.lang.Class")) stream) (print-unreadable-object (obj stream :identity nil) From 1eb8baee97af9f935c1583e0f540d700a73d86aa Mon Sep 17 00:00:00 2001 From: Alan Ruttenberg Date: Mon, 3 Jan 2022 12:23:06 -0500 Subject: [PATCH 3/6] Some OSGI bugs. Check for boundp in jss, for bootstrapping. fix asdf-jar and asdj-osgi-bundle to avoid re-adding bundle and always thinking the asdf operation succeeded. --- contrib/abcl-asdf/asdf-jar.lisp | 22 ++++------------------ contrib/abcl-asdf/asdf-osgi-bundle.lisp | 9 ++++++--- contrib/jss/invoke.lisp | 4 ++-- 3 files changed, 12 insertions(+), 23 deletions(-) diff --git a/contrib/abcl-asdf/asdf-jar.lisp b/contrib/abcl-asdf/asdf-jar.lisp index 4bcc0d5a7..4588ed507 100644 --- a/contrib/abcl-asdf/asdf-jar.lisp +++ b/contrib/abcl-asdf/asdf-jar.lisp @@ -47,12 +47,9 @@ (unless abcl-asdf:*inhibit-add-to-classpath* (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t))) -(defmethod operation-done-p ((operation load-op) (c jar-directory)) - (or abcl-asdf:*inhibit-add-to-classpath* - (not (abcl-asdf:need-to-add-directory-jar? (component-pathname c) t)))) -(defmethod operation-done-p ((operation compile-op) (c jar-directory)) - t) + + (defclass jar-file (static-file) ((type :initform "jar"))) @@ -83,21 +80,10 @@ (defmethod perform :before ((operation load-op) (c jar-file)) (normalize-jar-name c)) -(defmethod operation-done-p :before ((operation load-op) (c jar-file)) - (normalize-jar-name c)) - -(defmethod operation-done-p ((operation load-op) (c jar-file)) - (or abcl-asdf:*inhibit-add-to-classpath* - (member (namestring (truename (component-pathname c))) - abcl-asdf:*added-to-classpath* :test 'equal))) - -(defmethod operation-done-p ((operation compile-op) (c jar-file)) - t) - (defclass class-file-directory (static-file) ()) -(defmethod perform ((operation compile-op) (c class-file-directory)) - (java:add-to-classpath (component-pathname c))) +(defmethod perform ((operation compile-op) (c class-file-directory))) +(defmethod perform ((operation prepare-op) (c class-file-directory))) (defmethod perform ((operation load-op) (c class-file-directory)) (java:add-to-classpath (component-pathname c))) diff --git a/contrib/abcl-asdf/asdf-osgi-bundle.lisp b/contrib/abcl-asdf/asdf-osgi-bundle.lisp index 316a4e0ae..e7b6ab83e 100644 --- a/contrib/abcl-asdf/asdf-osgi-bundle.lisp +++ b/contrib/abcl-asdf/asdf-osgi-bundle.lisp @@ -18,8 +18,11 @@ (extra-system-packages (slot-value c 'system-packages))) (if (or extra-bootdelegation extra-system-packages) (warn "not handling :bootdelegation and :system-packages args yet")) - (jss:add-bundle (component-pathname c)))) + (unless (find (component-name c) jss::*loaded-osgi-bundles* :test 'equalp :key 'car) + (jss:add-bundle (component-pathname c))))) + + + + -(defmethod perform ((operation compile-op) (c bundle)) - (jss:add-bundle (component-pathname c))) diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp index 0e18fc3e0..93346cc47 100644 --- a/contrib/jss/invoke.lisp +++ b/contrib/jss/invoke.lisp @@ -149,7 +149,7 @@ (setf (gethash classname *imports-resolved-classes*) found) found) (let ((choices - (loop for bundle-entry in *loaded-osgi-bundles* + (loop for bundle-entry in (and (symbol-boundp '*loaded-osgi-bundles*) *loaded-osgi-bundles*) for found = (lookup-class-name classname :table (third bundle-entry) :muffle-warning t) when found collect (list bundle-entry found)))) (cond ((zerop (length choices)) (string classname)) @@ -584,7 +584,7 @@ associated is used to look up the static FIELD." (loop for (match type) in (sort matches 'string-lessp :key 'car) do (funcall fn match type bundle?)))))) (searchit *class-name-to-full-case-insensitive*) - (loop for (name nil table) in *loaded-osgi-bundles* + (loop for (name nil table) in (and (boundp '*loaded-osgi-bundles*) *loaded-osgi-bundles*) do (searchit table name)))) (defun jclass-method-names (class &optional full) From ae66d454cc47b92857dacc691dbdfefd8a516c7c Mon Sep 17 00:00:00 2001 From: Alan Ruttenberg Date: Wed, 5 Jan 2022 23:46:24 -0500 Subject: [PATCH 4/6] Fix buggy call to symbol-boundp. How did this ever work?? Add in-package to jss.asd --- contrib/jss/invoke.lisp | 2 +- contrib/jss/jss.asd | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp index 93346cc47..d83f7a8ab 100644 --- a/contrib/jss/invoke.lisp +++ b/contrib/jss/invoke.lisp @@ -149,7 +149,7 @@ (setf (gethash classname *imports-resolved-classes*) found) found) (let ((choices - (loop for bundle-entry in (and (symbol-boundp '*loaded-osgi-bundles*) *loaded-osgi-bundles*) + (loop for bundle-entry in (and (boundp '*loaded-osgi-bundles*) *loaded-osgi-bundles*) for found = (lookup-class-name classname :table (third bundle-entry) :muffle-warning t) when found collect (list bundle-entry found)))) (cond ((zerop (length choices)) (string classname)) diff --git a/contrib/jss/jss.asd b/contrib/jss/jss.asd index 79f505d01..096f32038 100644 --- a/contrib/jss/jss.asd +++ b/contrib/jss/jss.asd @@ -1,4 +1,5 @@ ;;;; -*- Mode: LISP -*- +(in-package :asdf) (defsystem jss :author "Alan Ruttenberg, Mark Evenson" :long-description "" From 055d6ca976f04a8a838233550886e1670b767867 Mon Sep 17 00:00:00 2001 From: Alan Ruttenberg Date: Mon, 24 Jan 2022 17:54:54 -0500 Subject: [PATCH 5/6] Fix OSGI, which wasn't even working on java 8. When calling jnew, prefer the class over the class name so that the right classloader is used. For the bundle, don't inherit the compile-op method which was adding the bundle jar to the classpath too, which confused find-java-class. Verified to work in java 11 --- contrib/abcl-asdf/asdf-osgi-bundle.lisp | 3 +++ contrib/jss/invoke.lisp | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/contrib/abcl-asdf/asdf-osgi-bundle.lisp b/contrib/abcl-asdf/asdf-osgi-bundle.lisp index e7b6ab83e..e211a9954 100644 --- a/contrib/abcl-asdf/asdf-osgi-bundle.lisp +++ b/contrib/abcl-asdf/asdf-osgi-bundle.lisp @@ -21,6 +21,9 @@ (unless (find (component-name c) jss::*loaded-osgi-bundles* :test 'equalp :key 'car) (jss:add-bundle (component-pathname c))))) +(defmethod perform ((operation compile-op) (c jar-file)) + nil) + diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp index d83f7a8ab..525bc8a59 100644 --- a/contrib/jss/invoke.lisp +++ b/contrib/jss/invoke.lisp @@ -178,7 +178,7 @@ (object-as-class (if object-as-class-name (find-java-class object-as-class-name)))) (if (eq method 'new) - (apply #'jnew (or object-as-class-name object-as-class object) args) + (apply #'jnew (or object-as-class object-as-class-name object) args) (if raw? (if (symbolp object) (apply #'jstatic-raw method object-as-class args) From 43a70e7367c8eb6d2d2fbe7b3b73fc5401eb8d55 Mon Sep 17 00:00:00 2001 From: Alan Ruttenberg Date: Tue, 25 Jan 2022 18:25:33 -0500 Subject: [PATCH 6/6] update apache felix, which makes it not break java.net.URL in Java 17 --- contrib/abcl-asdf/osgi.lisp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/contrib/abcl-asdf/osgi.lisp b/contrib/abcl-asdf/osgi.lisp index 031a9c3b5..32b202ece 100644 --- a/contrib/abcl-asdf/osgi.lisp +++ b/contrib/abcl-asdf/osgi.lisp @@ -146,8 +146,10 @@ (flet ((resolve (artifact) (funcall (intern "RESOLVE" 'abcl-asdf) artifact))) (add-to-classpath ;; sometimes resolve returns ":" separated pathnames of both main and framework jars. Only need the first. - ;; 5.6.1 current as of Jan/17 - (car (uiop/utility:split-string (resolve "org.apache.felix/org.apache.felix.main/5.6.1") :separator '(#\:))))) + ;; 7.0.3 current as of Jan/22. Works with Java17 + (car (uiop/utility:split-string (resolve "org.apache.felix/org.apache.felix.main/7.0.3") :separator '(#\:))) + )) + (let* ((framework-factory-class (find-java-class 'org.osgi.framework.launch.FrameworkFactory)) (ffs (#"load" 'ServiceLoader framework-factory-class (#"getClassLoader" framework-factory-class))) (factory (#"next" (#"iterator" ffs)))