source: trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp @ 14905

Last change on this file since 14905 was 14905, checked in by Mark Evenson, 7 years ago

abcl-asdf: introspect Maven exectuable output to find libraries

Fixes usage of CFFI with Quicklisp under FreeBSD RELEASE-11.0.
File size: 23.1 KB
Line 
1;;;; Use the Aether system in a localy installed Maven3 distribution to download
2;;;; and install JVM artifact dependencies.
3
4#|
5
6# Implementation
7
8Not necessarily multi-threaded safe, and unclear how much work that
9would be, as it is unknown how the Maven implementation behaves.
10
11## Installing Maven
12http://maven.apache.org/download.html
13
14## Current Javadoc for Maven Aether connector
15http://sonatype.github.com/sonatype-aether/apidocs/overview-summary.html
16
17## Incomplete, seemingly often wrong
18https://docs.sonatype.org/display/AETHER/Home
19
20Note that this is not an implementation of Maven per se, but the use
21of the Maven Aether connector infrastructure.  Among other things, this means
22that the Maven specific "~/.m2/settings.xml" file is NOT parsed for settings.
23
24|#
25
26;;; N.b. evaluated *after* we load the ABCL specific modifications of
27;;;      ASDF in abcl-asdf.lisp
28
29(in-package :abcl-asdf)
30
31(require :abcl-contrib)
32(require :jss)
33
34#|
35Test:
36(abcl-asdf:resolve "org.slf4j:slf4j-api:1.6.1")
37
38(abcl-asdf:resolve "org.apache.maven:maven-aether-provider:3.0.4")
39
40(abcl-asdf:resolve "com.google.gwt:gwt-user")
41
42|#
43
44(defparameter *maven-verbose* t
45  "Stream to send output from the Maven Aether subsystem to, or NIL to muffle output")
46
47(defparameter *mavens* 
48  (if (find :windows *features*)
49      '("mvn.bat" "mvn3.bat")
50      '("/opt/local/bin/mvn3" "mvn3" "mvn"))
51  "Locations to search for the Maven executable.")
52
53(defun find-mvn () 
54  "Attempt to find a suitable Maven ('mvn') executable on the hosting operating system.
55
56Returns the path of the Maven executable or nil if none are found.
57
58Returns the version of Maven found as the second value.
59
60Emits warnings if not able to find a suitable executable."
61
62  (let ((m2-home (ext:getenv "M2_HOME"))
63        (m2 (ext:getenv "M2"))
64        (mvn-executable (if (find :unix *features*)
65                            "mvn"
66                            "mvn.bat")))
67    (when (and m2-home (probe-file m2-home))
68      (let* ((m2-home (truename m2-home))
69             (mvn-path (merge-pathnames 
70                        (format nil "bin/~A" mvn-executable)
71                        m2-home))
72             (mvn (truename mvn-path)))
73        (if mvn
74            (values (return-from find-mvn mvn)
75                    (ensure-mvn-version))
76            (warn "M2_HOME was set to '~A' in the process environment but '~A' doesn't exist." 
77                  m2-home mvn-path))))
78    (when (and m2 (probe-file m2))
79      (let* ((m2 (truename m2))
80             (mvn-path (merge-pathnames mvn-executable m2))
81             (mvn (truename mvn-path)))
82        (if mvn
83            (values (return-from find-mvn mvn)
84                    (ensure-mvn-version))
85            (warn "M2 was set to '~A' in the process environment but '~A' doesn't exist." 
86                  m2 mvn-path))))
87    (let* ((which-cmd 
88            (if (find :unix *features*)
89                "which" 
90                ;; Starting with Windows Server 2003
91                "where.exe"))
92           (which-cmd-p 
93            (handler-case 
94                (sys:run-program which-cmd nil)
95              (t () nil))))
96      (when which-cmd-p
97        (dolist (mvn-path *mavens*)
98          (let ((mvn 
99                 (handler-case 
100                     (truename (read-line (sys:process-output 
101                                           (sys:run-program 
102                                            which-cmd `(,mvn-path))))) 
103                   (end-of-file () nil)
104                   (t (e) 
105                     (format *maven-verbose* 
106                             "~&Failed to find Maven executable '~A' in PATH because~&~A" 
107                             mvn-path e)))))
108            (when mvn
109              (return-from find-mvn mvn)))))))
110  (warn "Unable to locate Maven executable to find Maven Aether adaptors."))
111
112(defun find-mvn-libs ()
113  (unless (find-mvn)
114    (warn "Failed to find Maven executable to determine Aether library location."))
115  (some 
116   (lambda (d)
117     (when (directory (merge-pathnames "maven-core-*.jar" d))
118       (truename d)))
119   (list (make-pathname :defaults (merge-pathnames "../lib/" (find-mvn))
120                        :name nil :type nil)
121         (ignore-errors
122           (make-pathname :defaults (merge-pathnames "lib/" (mvn-home))
123                          :name nil :type nil))
124         ;; library location for homebrew maven package on OS X
125         (make-pathname :defaults (merge-pathnames "../libexec/lib/" (find-mvn))
126                        :name nil :type nil)
127         #p"/usr/local/share/java/maven3/lib/" ;; FreeBSD ports
128         #p"/usr/local/maven/lib/"))) ;; OpenBSD location suggested by Timo MyyrÀ
129
130(defparameter *mvn-libs-directory*
131  nil
132  "Location of 'maven-core-3.<m>.<p>.jar', 'maven-embedder-3.<m>.<p>.jar' etc.")
133
134(defun mvn-version ()
135  "Return the Maven version used by the Aether connector located by
136  FIND-MVN as a list of (MAJOR MINOR PATHLEVEL) integers.
137
138Signals a simple-error with additional information if this attempt fails."
139  (handler-case 
140      (let* ((process (sys:run-program (truename (find-mvn)) '("-version")))
141             (output (sys:process-output process))
142             (pattern (#"compile"
143                       'regex.Pattern
144                       "Apache Maven ([0-9]+)\\.([0-9]+)\\.([0-9]+)"))
145             lines)
146        (do ((line (read-line output nil :eof) 
147                   (read-line output nil :eof)))
148            ((or (not line) (eq line :eof)) nil)
149          (push line lines)
150          (let ((matcher (#"matcher" pattern line)))
151            (when (#"find" matcher)
152              (return-from mvn-version
153                (mapcar #'parse-integer 
154                        `(,(#"group" matcher 1) 
155                           ,(#"group" matcher 2) 
156                           ,(#"group" matcher 3)))))))
157        (when lines 
158          (signal "No parseable Maven version found in ~{~&  ~A~}" (nreverse lines)))
159        (let ((error (sys:process-error process)))
160          (do ((line (read-line error nil :eof) 
161                     (read-line error nil :eof)))
162              ((or (not line) (eq line :eof)) nil)
163            (push line lines)
164            (signal "Invocation of Maven returned the error ~{~&  ~A~}" (nreverse lines)))))
165    (t (e) 
166      (error "Failed to determine Maven version: ~A." e))))
167
168(defun mvn-home ()
169  "If the Maven executable can be invoked, introspect the value
170  reported as Maven home."
171  (handler-case 
172      (multiple-value-bind (output error-output status)
173          (uiop/run-program:run-program
174           (format nil "~a --version" (truename (find-mvn)))
175           :output :string
176           :error-output :string)
177        (unless (zerop status)
178          (error "Failed to invoke Maven executable to introspect library locations: ~a." error-output))
179        (let ((pattern (#"compile"
180                        'regex.Pattern
181                        "Maven home: (.+)$")))
182          (with-input-from-string (s output)
183            (do ((line (read-line s nil :eof) 
184                       (read-line s nil :eof)))
185                ((or (not line) (eq line :eof)) nil)
186              (let ((matcher (#"matcher" pattern line)))
187                (when (#"find" matcher)
188                  (return-from mvn-home (uiop/pathname:ensure-directory-pathname (#"group" matcher 1)))))))))
189    (subprocess-error (e)
190          (error "Failed to invoke Maven executable to introspect library locations: ~a." e))))
191                       
192(defun ensure-mvn-version ()
193  "Return t if Maven version is 3.0.3 or greater."
194  (let* ((version (mvn-version))
195         (major (first version))
196         (minor (second version))
197         (patch (third version)))
198    (values
199     (or 
200      (and (>= major 3)
201           (>= minor 1))
202      (and (>= major 3)
203           (>= minor 0)
204           (>= patch 3)))
205     (list major minor patch))))
206
207(defparameter *init* nil)
208 
209(defun init (&optional &key (force nil))
210  "Run the initialization strategy to bootstrap a Maven dependency node.
211
212Set *MVN-LIBS-DIRECTORY* to an explicit value before running this
213function in order to bypass the dynamic introspection of the location
214of the mvn executable with an explicit value."
215  (when force
216    (setf *session* nil
217          *repository-system* nil))
218  (unless (or force *mvn-libs-directory*)
219    (setf *mvn-libs-directory* (find-mvn-libs)))
220  (unless (and *mvn-libs-directory*
221               (probe-file *mvn-libs-directory*))
222    (error "Please obtain and install maven-3.0.3 or later locally from <http://maven.apache.org/download.html>, then set ABCL-ASDF:*MVN-LIBS-DIRECTORY* to the directory containing maven-core-3.*.jar et. al."))
223  (unless (ensure-mvn-version)
224    (error "We need maven-3.0.3 or later."))  (add-directory-jars-to-class-path *mvn-libs-directory* nil)
225    (setf *init* t))
226
227(defun find-http-wagon ()
228  "Find an implementation of the object that provides access to http and https resources.
229
230Supposedly configurable with the java.net.protocols (c.f. reference
231maso2000 in the Manual.)"
232  (handler-case 
233      ;; maven-3.0.4
234      (java:jnew "org.apache.maven.wagon.providers.http.HttpWagon") 
235    (error () 
236      ;; maven-3.0.3 reported as not working with all needed functionality
237      (java:jnew  "org.apache.maven.wagon.providers.http.LightweightHttpWagon"))))
238
239(defun make-wagon-provider ()
240  "Returns an implementation of the org.sonatype.aether.connector.wagon.WagonProvider contract.
241
242The implementation is specified as Lisp closures.  Currently, it only
243specializes the lookup() method if passed an 'http' or an 'https' role
244hint."
245  (unless *init* (init))
246  (java:jinterface-implementation 
247   (#"getName" 
248    (or
249     (ignore-errors  ;; Maven 3.2.5+
250       (jss:find-java-class 'aether.transport.wagon.WagonProvider))
251     (ignore-errors  ;; Maven 3.1.0+
252       (jss:find-java-class 'aether.connector.wagon.WagonProvider))
253     (ignore-errors  ;; Maven 3.0.x
254       (jss:find-java-class 'org.sonatype.aether.connector.wagon.WagonProvider))))
255   "lookup"
256   (lambda (role-hint)
257     (cond 
258       ((find role-hint '("http" "https") :test #'string-equal)
259        (find-http-wagon))
260       (t
261        (progn 
262          (format *maven-verbose* 
263                  "~&WagonProvider stub passed '~A' as a hint it couldn't satisfy.~%" role-hint)
264          java:+null+))))
265   "release"
266   (lambda (wagon)
267     (declare (ignore wagon)))))
268
269(defun find-service-locator ()
270  (or 
271   (ignore-errors 
272     (#"newServiceLocator" 'org.apache.maven.repository.internal.MavenRepositorySystemUtils)) ;; maven-3.1.0
273   (ignore-errors
274     (java:jnew "org.apache.maven.repository.internal.MavenServiceLocator")) ;; maven-3.0.4
275   (ignore-errors
276     (java:jnew "org.apache.maven.repository.internal.DefaultServiceLocator"))
277   (ignore-errors  ;; maven-3.1.0 using org.eclipse.aether...
278     (jss:find-java-class 'aether.impl.DefaultServiceLocator))))
279
280(defun make-repository-system ()
281  (unless *init* (init))
282  (let ((locator 
283         (find-service-locator))
284        (wagon-provider-class 
285         (or
286          (ignore-errors ;; Maven-3.3.x
287            (jss:find-java-class 'connector.transport.TransporterFactory))
288          (ignore-errors ;; Maven-3.2.5
289            (jss:find-java-class 'org.eclipse.aether.transport.wagon.WagonProvider))
290          (ignore-errors  ;; Maven-3.1.x
291            (jss:find-java-class 'aether.connector.wagon.WagonProvider))
292          (ignore-errors 
293            (java:jclass "org.sonatype.aether.connector.wagon.WagonProvider"))))
294        (wagon-repository-connector-factory-class
295         (or 
296          (ignore-errors 
297            (jss:find-java-class 'org.eclipse.aether.connector.basic.BasicRepositoryConnectorFactory))
298          (ignore-errors 
299            (jss:find-java-class 'aether.connector.wagon.WagonRepositoryConnectorFactory))
300          (ignore-errors 
301            (java:jclass "org.sonatype.aether.connector.wagon.WagonRepositoryConnectorFactory"))))
302        (repository-connector-factory-class 
303         (or
304          (ignore-errors
305            (jss:find-java-class 'org.eclipse.aether.spi.connector.RepositoryConnectorFactory))
306          (ignore-errors
307            (jss:find-java-class 'aether.spi.connector.RepositoryConnectorFactory))
308          (ignore-errors 
309            (java:jclass "org.sonatype.aether.spi.connector.RepositoryConnectorFactory"))))
310        (repository-system-class
311         (or
312          (ignore-errors 
313            (jss:find-java-class 'org.eclipse.aether.RepositorySystem))
314          (ignore-errors 
315            (jss:find-java-class 'aether.RepositorySystem))
316          (ignore-errors
317            (java:jclass "org.sonatype.aether.RepositorySystem")))))
318
319    (if (equal wagon-provider-class (ignore-errors (jss:find-java-class 'TransporterFactory)))
320        ;;; Maven-3.3.3
321        (let ((wagon-transporter-factory (jss:new 'WagonTransporterFactory)))
322          (#"setWagonProvider" wagon-transporter-factory (make-wagon-provider))
323          (#"setServices" locator
324                          wagon-provider-class
325                          (java:jarray-from-list (list wagon-transporter-factory))))
326        (#"setServices" locator
327                        wagon-provider-class
328                        (java:jarray-from-list
329                         (list (make-wagon-provider)))))
330    (#"addService" locator
331                   repository-connector-factory-class
332                   wagon-repository-connector-factory-class)
333    (values (#"getService" locator
334                           repository-system-class)
335            locator)))
336
337(defun make-session (repository-system)
338  "Construct a new aether.RepositorySystemSession from the specified REPOSITORY-SYSTEM."
339  (let ((session
340         (or 
341          (ignore-errors (#"newSession" 'org.apache.maven.repository.internal.MavenRepositorySystemUtils))
342          (ignore-errors (java:jnew (jss:find-java-class "MavenRepositorySystemSession")))))
343        (local-repository 
344         (java:jnew (jss:find-java-class "LocalRepository")
345                    (namestring (merge-pathnames ".m2/repository/"
346                                                 (user-homedir-pathname))))))
347    (#"setLocalRepositoryManager" 
348     session
349     (or 
350      (ignore-errors      ;; maven-3.1.0
351        (#"newLocalRepositoryManager" 
352         repository-system session local-repository))
353      (ignore-errors 
354        (#"newLocalRepositoryManager" 
355         repository-system local-repository))))))
356
357(defparameter *maven-http-proxy* nil
358  "A string containing the URI of an http proxy for Maven to use.")
359
360(defun make-proxy ()
361  "Return an aether.repository.Proxy instance initialized from *MAVEN-HTTP-PROXY*."
362  (unless *maven-http-proxy*
363    (warn "No proxy specified in *MAVEN-HTTP-PROXY*")
364    (return-from make-proxy nil))
365  (let* ((p (pathname *maven-http-proxy*))
366         (scheme (sys::url-pathname-scheme p))
367         (authority (sys::url-pathname-authority p))
368         (host (if (search ":" authority)
369                   (subseq authority 0 (search ":" authority))
370                   authority))
371         (port (when (search ":" authority)
372                 (parse-integer (subseq authority (1+ (search ":" authority))))))
373         ;; TODO allow specification of authentication
374         (authentication java:+null+))
375    (or 
376     (ignore-errors
377       (jss:new 'org.eclipse.aether.repository.Proxy
378                scheme host port authentication))
379     (ignore-errors
380       (jss:new 'org.sonatype.aether.repository.Proxy
381                scheme host port authentication)))))
382
383(defparameter *repository-system*  nil
384  "The aether.RepositorySystem used by the Maeven Aether connector.")
385(defun ensure-repository-system (&key (force nil))
386  (when (or force (not *repository-system*))
387    (setf *repository-system* (make-repository-system)))
388  *repository-system*)
389
390(defparameter *session* nil
391  "Reference to the Maven RepositorySystemSession")
392(defun ensure-session (&key (force nil))
393  "Ensure that the RepositorySystemSession has been created.
394
395If *MAVEN-HTTP-PROXY* is non-nil, parse its value as the http proxy."
396  (when (or force (not *session*))
397    (ensure-repository-system :force force)
398    (setf *session* (make-session *repository-system*))
399    (#"setRepositoryListener" *session* (make-repository-listener))
400    (when *maven-http-proxy*
401      (let ((proxy (make-proxy)))
402        (#"add" (#"getProxySelector" *session*)
403                proxy 
404                ;; A string specifying non proxy hosts, or null
405                java:+null+))))
406  *session*)
407
408(defun make-artifact (artifact-string)
409  "Return an instance of aether.artifact.DefaultArtifact initialized from ARTIFACT-STRING." 
410  (or
411   (ignore-errors
412     (jss:new 'aether.artifact.DefaultArtifact artifact-string))
413   (ignore-errors
414     (jss:new "org.sonatype.aether.util.artifact.DefaultArtifact" artifact-string))))
415
416(defun make-artifact-request () 
417  "Construct a new aether.resolution.ArtifactRequest."
418  (or 
419   (ignore-errors
420     (java:jnew (jss:find-java-class 'aether.resolution.ArtifactRequest)))
421   (ignore-errors
422     (java:jnew "org.sonatype.aether.resolution.ArtifactRequest"))))
423
424;;; TODO change this to work on artifact strings like log4j:log4j:jar:1.2.16
425(defun resolve-artifact (group-id artifact-id &key (version "LATEST" versionp))
426  "Resolve artifact to location on the local filesystem.
427
428Declared dependencies are not attempted to be located.
429
430If unspecified, the string \"LATEST\" will be used for the VERSION.
431
432Returns the Maven specific string for the artifact "
433  (unless versionp
434    (warn "Using LATEST for unspecified version."))
435  (unless *init* (init))
436  (let* ((artifact-string 
437          (format nil "~A:~A:~A" group-id artifact-id version))
438         (artifact 
439          (make-artifact artifact-string))
440         (artifact-request 
441          (make-artifact-request)))
442    (#"setArtifact" artifact-request artifact)
443    (#"addRepository" artifact-request (ensure-remote-repository))
444    (#"toString" (#"getFile" 
445                  (#"getArtifact" (#"resolveArtifact" (ensure-repository-system) 
446                                                      (ensure-session) artifact-request))))))
447
448(defun make-remote-repository (id type url) 
449  (or 
450   (ignore-errors 
451     (#"build" (jss:new "org.eclipse.aether.repository.RemoteRepository$Builder" id type url)))
452   (ignore-errors
453     (jss:new 'aether.repository.RemoteRepository id type url))))
454
455(defparameter *default-repository* 
456  "http://repo1.maven.org/maven2/")
457
458(defun add-repository (repository)
459  (ensure-remote-repository :repository repository))
460
461(defparameter *maven-remote-repository*  nil
462  "The remote repository used by the Maven Aether embedder.")
463(defun ensure-remote-repository (&key 
464                                   (force nil)
465                                   (repository *default-repository* repository-p))
466  (unless *init* (init))
467  (when (or force 
468            repository-p 
469            (not *maven-remote-repository*))
470    (let ((r (make-remote-repository "central" "default" repository)))
471      (when *maven-http-proxy*
472        (#"setProxy" r (make-proxy)))
473      (setf *maven-remote-repository* r)))
474  *maven-remote-repository*)
475
476
477(defun resolve-dependencies (group-id artifact-id 
478                             &key
479                               (version "LATEST" versionp)
480                               (repository *maven-remote-repository* repository-p))
481  "Dynamically resolve Maven dependencies for item with GROUP-ID and ARTIFACT-ID
482optionally with a VERSION and a REPOSITORY. 
483
484All recursive dependencies will be visited before resolution is successful.
485
486If unspecified, the string \"LATEST\" will be used for the VERSION.
487
488Returns a string containing the necessary jvm classpath entries packed
489in Java CLASSPATH representation."
490  (unless *init* (init))
491  (unless versionp
492    (warn "Using LATEST for unspecified version."))
493  (let* ((coords 
494          (format nil "~A:~A:~A" group-id artifact-id (if versionp version "LATEST")))
495         (artifact 
496          (make-artifact coords))
497         (dependency 
498          (java:jnew (jss:find-java-class 'aether.graph.Dependency)
499                     artifact (java:jfield (jss:find-java-class "JavaScopes") "COMPILE")))
500         (collect-request (java:jnew (jss:find-java-class "CollectRequest"))))
501    (#"setRoot" collect-request dependency)
502     ;; Don't call addRepository if we explicitly specify a NIL repository
503    (unless (and repository-p (not repository))
504      (#"addRepository" collect-request 
505                        (if repository-p
506                            (ensure-remote-repository :repository repository)
507                            (ensure-remote-repository))))
508    (let* ((node 
509            (#"getRoot" (#"collectDependencies" (ensure-repository-system) (ensure-session) collect-request)))
510           (dependency-request
511            ;;; pre Maven-3.3.x
512            #+nil
513            (java:jnew (jss:find-java-class "DependencyRequest")
514                       node java:+null+)
515            (jss:new 'DependencyRequest))
516           (nlg 
517            (java:jnew (jss:find-java-class "PreorderNodeListGenerator"))))
518      (#"setRoot" dependency-request node)
519      (#"resolveDependencies" (ensure-repository-system) (ensure-session) dependency-request)
520      (#"accept" node nlg)
521      (#"getClassPath" nlg))))
522
523(defun make-repository-listener ()
524  (flet ((log (e) 
525           (format *maven-verbose* "~&~A~%" (#"toString" e))))
526    (java:jinterface-implementation 
527     (#"getName" (jss:find-java-class 'aether.RepositoryListener))
528     "artifactDeployed" 
529     #'log
530     "artifactDeploying" 
531     #'log
532     "artifactDescriptorInvalid" 
533     #'log
534     "artifactDescriptorMissing" 
535     #'log
536     "artifactDownloaded" 
537     #'log
538     "artifactDownloading" 
539     #'log
540     "artifactInstalled" 
541     #'log
542     "artifactInstalling" 
543     #'log
544     "artifactResolved" 
545     #'log
546     "artifactResolving" 
547     #'log
548     "metadataDeployed" 
549     #'log
550     "metadataDeploying" 
551     #'log
552     "metadataDownloaded" 
553     #'log
554     "metadataDownloading" 
555     #'log
556     "metadataInstalled"
557     #'log
558     "metadataInstalling" 
559     #'log
560     "metadataInvalid" 
561     #'log
562     "metadataResolved" 
563     #'log
564     "metadataResolving"
565     #'log)))
566
567
568(defmethod resolve ((string string))
569  "Resolve a colon separated GROUP-ID:ARTIFACT-ID[:VERSION] reference to a Maven artifact.
570
571Examples of artifact references: \"log4j:log4j:1.2.14\" for
572'log4j-1.2.14.jar'.  Resolving \"log4j:log4j\" would return the latest
573version of the artifact known to the distributed Maven pom.xml graph.
574
575Returns a string containing the necessary classpath entries for this
576artifact and all of its transitive dependencies."
577  (let ((result (split-string string ":")))
578    (cond 
579      ((= (length result) 3)
580       (resolve-dependencies 
581        (first result) (second result) :version (third result)))
582      ((string= string "com.sun.jna:jna")
583       (warn "Replacing request for no longer available com.sun.jna:jna with net.java.dev.jna:jna")
584       (resolve-dependencies "net.java.dev.jna" "jna" :version "LATEST"))
585      ((= (length result) 2)
586       (resolve-dependencies
587        (first result) (second result)))
588      (t 
589       (destructuring-bind (group-id artifact-id &optional version repository)
590           (split-string string "/")
591         (setf result 
592               (apply #'resolve-dependencies group-id artifact-id
593                      (append (when version
594                                `(:version ,version))
595                              (when repository
596                                `(:repository ,repository))))))))))
597
598;;; Currently the last file listed in ASDF
599(provide 'abcl-asdf)
Note: See TracBrowser for help on using the repository browser.