< Previous | Next >
September 28, 2010 1:12 AM CDT by psilord in category Lisp

Card Catalog

I ran into a problem with SBCL where not only did I need to save the lisp image into an executable, but I also had to save the shared libraries loaded, via dlopen(), with the lisp image into the current working directory next to the executable. The shared libraries I needed to save were located specifically in the sb-sys:*shared-objects* variable. The reason for this is so I could execute the application on another machine which very likely didn't have all of the shared libraries. The shared libraries were for interfaces from lisp to C generated by CFFI-GROVEL or other specialty libraries not often found on random machines.

There is a chunk of code which implements this mess, but the part which I'm going to show in this post is the portion which calls /sbin/ldconfig -p, parses the output, and returns a hash table that one can query against to convert a bare library to an absolute pathname. The code really isn't spectacular in any way and I'll probably iterate over it some more removing dumb crap I did, but it is very useful, which is good enough for me.

Of course, dlopen() uses other methods to find libraries, like RPATH and crap. This code only implements a library lookup via the /etc/ld.so.cache file.

;; This code snippet is under the Apache Version 2 license and is Copyright
;; 2010 Peter Keller (psilord@cs.wisc.edu). It requires CL-PPCRE and 
;; is SBCL specific.

;; Perform the body, which is assumed to open the stream strm in question
;; and write to it. Ugly, make better...
(defmacro stream->string-list ((strm) &body body)
  (let ((g (gensym))
        (h (gensym)))
    `(let ((,h '()))
       (with-input-from-string
           (,g (with-output-to-string (,strm)
                 (progn
                   ,@body)))
         (loop while (let ((line (read-line ,g nil)))
                       (when line
                         (push line ,h))
                       line))
         (nreverse ,h)))))

;; Convert the machine type to a keyword.
(defun get-machine-type ()
  (let ((mt (machine-type)))
    (cond
      ((equalp "X86" mt)
       :x86)
      ((equalp "X86-64" mt)
       :x86-64)
      (t
       (error "Unknown machine type ~A, please port!~%" mt)))))

;; Given a list of flags associated with a line from ldconfig -p, find me
;; the library type the library is.
(defun find-lib-type (split-flags)
  (if (find "libc6" split-flags :test #'equalp)
      "libc6"
      (if (find "ELF" split-flags :test #'equalp)
          "ELF"
          (assert "Unknown lib type. Please port!~%"))))

;; Given a list of flags associated with a line from the ldconfig -p, find
;; me the specific architecture associated with the library.
(defun find-lib-arch (split-flags)
  (if (find "x86-64" split-flags :test #'equalp)
      :x86-64
      :x86))

;; Take a precut line from the ldconfig -p output and merge it with the rest
;; of the lines in the hash table ht.
(defun merge-ld.so.cache-line (bare-lib split-flags absolute-lib ht)
  ;; Ensure the bare-lib has a hash table entry in the master table.
  (when (null (gethash bare-lib ht))
    (setf (gethash bare-lib ht) (make-hash-table :test #'equalp)))

  ;; The type of the library is either libc6 or ELF, but not both. So
  ;; find out which one it is and set the type in the hash table value
  ;; for the library in question. Ensure the type didn't change!
  (let ((lib-type (find-lib-type split-flags))
        (vht (gethash bare-lib ht)))
    (let ((prev-lib-type (gethash :type vht)))
      (if (null prev-lib-type)
          (setf (gethash :type vht) lib-type)
          (when (not (equal prev-lib-type lib-type))
            (error "~A changed library type!" bare-lib)))))

  ;; For each arch, if the value list doesn't exist, make one and
  ;; insert it, otherwise insert the entry at the end of the list. We
  ;; do it at the end because we're following the search order as
  ;; found in the file.
  (let ((lib-arch (find-lib-arch split-flags))
        (vht (gethash bare-lib ht)))
    (let ((prev-lib-list (gethash lib-arch vht)))
      (if (null prev-lib-list)
          (setf (gethash lib-arch vht) (list absolute-lib))
          (rplacd (last (gethash lib-arch vht)) (list absolute-lib))))))

(defun parse-ld.so.cache (&key (program "/sbin/ldconfig") (args '("-p")))
  ;; Read all of the output of the program as lines.
  (let ((ht (make-hash-table :test #'equalp))
        (lines (stream->string-list
                   (out-stream)
                 (sb-ext:process-close
                  (sb-ext:run-program program args :output out-stream)))))

    ;; Pop the first line off, it is a count of libs and other junk
    (pop lines)

    ;; Assemble the master hash table which condenses the ldconfig -p info
    ;; into a meaningful object upon which I can query.
    (dolist (line lines)
      (register-groups-bind
          (bare-lib flags absolute-lib)
          ("\\s*(.*)\\s+\\((.*)\\)\\s+=>\\s+(.*)\\s*" line)

        (let ((split-flags
               (mapcar #'(lambda (str)
                           (setf str (regex-replace "^\\s+" str ""))
                           (regex-replace "\\s+$" str ""))
                       (split "," flags))))
          (merge-ld.so.cache-line bare-lib split-flags absolute-lib ht))))
    ht))

;; Convert a bare-lib into an absolute path depending upon
;; architecture and whatnot. Either returns an absolute path, or nil.
;;
;; Can specify an ordering of :all, :first (the default), or :last.
;; The ordering of :all will present the libraries in the order found
;; out of the output for ldconfig -p.
(defun query-ld.so.cache (bare-lib ht &key (ordering :first))
  (let ((vht (gethash bare-lib ht)))
    (if (null vht)
        nil
        (let ((all-absolute-libs (gethash (get-machine-type) vht)))
          (ecase ordering
            (:all
             all-absolute-libs)
            (:first
             (car all-absolute-libs))
            (:last
             (last all-absolute-libs)))))))

You'd use it like (suppose in SLIME's REPL):

CL-MW> (setf cache (parse-ld.so.cache))
#<HASH-TABLE :TEST EQUALP :COUNT 1275 {B546831}>
CL-MW> (query-ld.so.cache "libGL.so" cache)
"/usr/lib/mesa/libGL.so"
CL-MW> (query-ld.so.cache "libGL.so" cache :ordering :all)
("/usr/lib/mesa/libGL.so" "/usr/lib/libGL.so")
CL-MW> (query-ld.so.cache "libGL.so" cache :ordering :first)
"/usr/lib/mesa/libGL.so"
CL-MW> (query-ld.so.cache "libGL.so" cache :ordering :last)
("/usr/lib/libGL.so")

End of Line.

< Previous | Next >