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

Last change on this file since 14743 was 14743, checked in by Mark Evenson, 8 years ago

abcl-asdf: enhancements

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