Re: deploying CLG

--=-=-=

"Walter C. Pelissero" <[email protected]> writes:

> I wonder what is the intended way to deploy a CLG-based application.
> 
> Currently, with CMUCL, I'm creating a Lisp image.  All seems to be
> fine if not for a detail: all the shared objects pathnames are wired
> in the image and even assuming the path to libgtk may not vary from
> system to system I certainly don't want to reproduce my home directory
> tree on every installation just for the CLG shared objects.

After having thought about this problem for a while and tried out a few
things, I have come to the conclusion that the best solution would
probably be to modify the initialization code in CMUCL (and SBCL).

The attached code will try to load a shared object from the library
search path before signaling an error, if loading from an absolute path
fails. When installing an clg application the shared object files could
be copied to a common directory and LD_LIBRARY_PATH set in a wrapper
script. To make this possible all the alien.so files are now given unique
names.

What does people think about this solution?


--=-=-=
Content-Disposition: attachment; filename=reinit.lisp

#+scl(in-package "SB-ALIEN")
#+cmu(in-package "SYSTEM")

(defun absolute-namestring-p (namestring)
  (char= (char namestring 0) #\/))

(defun namestring-filename (namestring)
  (subseq namestring (1+ (position #\/ namestring :from-end t))))

#+sbcl
(defun try-reopen-shared-object (obj)
  (declare (type shared-object obj))
  (or
   (ignore-errors (dlopen-or-lose obj))
   (when (absolute-namestring-p (shared-object-file obj))
     (let ((namestring (shared-object-file obj)))
       (setf (shared-object-file obj) (namestring-filename namestring))
       (handler-case (dlopen-or-lose obj)
	 (simple-error (c) (setf (shared-object-file obj) namestring) nil))))
    (tagbody :dlopen 
       (restart-case (dlopen-or-lose obj)
         (continue ()
           :report "Skip this shared object and continue."
	   (setf (shared-object-sap obj) nil))
	 (retry ()
           :report "Retry loading this shared object."
	   (go :dlopen))
	 (load-other ()
           :report "Specify an alternate shared object file to load."
	   (setf (shared-object-file obj)
		 (tagbody :query
		    (format *query-io* "~&Enter pathname (evaluated):~%")
		    (force-output *query-io*)
		    (let ((pathname (ignore-errors (pathname (read *query-io*)))))
		      (unless (pathnamep pathname)
			(format *query-io* "~&Error: invalid pathname.~%")
			(go :query))
		      (unix-namestring pathname))))))))
  obj)

#+cmu
(defun try-dlopen (file)
  (dlerror)
  (let ((sap (dlopen (namestring (convert-object-file-path file))
		     (logior rtld-now rtld-global))))
    (unless (zerop (sap-int sap))
      (format t "Reloaded library ~S~%" file)
      (force-output)
      sap)))

#+cmu
(defun reinitialize-global-table ()
  (loop for lib-entry in (reverse *global-table*)
	for (sap . lib-path) = lib-entry
        as restarted = nil
	when lib-path
     do
       (loop
	  (restart-case 
	      (let ((new-sap (or
			      (try-dlopen lib-path)
			      (when (and 
				     (not restarted)
				     (absolute-namestring-p lib-path))
				(let* ((filename (namestring-filename lib-path))
				       (sap (try-dlopen filename)))
				  (when sap
				    (setf (cdr lib-entry) filename)
				    sap))))))
		(unless new-sap
		  (error "Couldn't open library ~S: ~S" lib-path (dlerror)))
		(setf (car lib-entry) (or new-sap (int-sap 0)))
		(return))
	    (continue ()
	      :report "Ignore library and continue"
	      (return))
	    (try-again ()
	      :report "Try reloading again"
	      )
	    (new-library ()
	      :report "Choose new library path"
	      (format *query-io* "Enter new library path: ")
	      (setf lib-path (read))))
	  (setq restarted t)))
  (alien:alien-funcall (alien:extern-alien "os_resolve_data_linkage"
                                           (alien:function c-call:void))))

--=-=-=


-- 
Espen

--=-=-=
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

-------------------------------------------------------------------------
SF.Net email is sponsored by:
Check out the new SourceForge.net Marketplace.
It's the best place to buy or sell services
for just about anything Open Source.
http://ad.doubleclick.net/clk;164216239;13503038;w?http://sf.net/marketplace
--=-=-=
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
Clg-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/clg-devel

--=-=-=--