Supports directory listings for files/

dpkg-fs.asd

@@ -20,13 +20,17 @@
                                             "read-file"
                                             "execute-file"))
                  (:file "dir-content" :depends-on ("package"
-                                                   "dpkg-fs"))
-                 (:file "is-directory" :depends-on ("dpkg-fs"))
+                                                   "dpkg-fs"
+                                                   "files"))
+                 (:file "is-directory" :depends-on ("dpkg-fs"
+                                                    "files"))
                  (:file "symlink" :depends-on ("dpkg-fs"))
                  (:file "read-file" :depends-on ("package"
                                                  "dpkg-fs"))
                  (:file "execute-file" :depends-on ("dpkg-fs"))
-                 (:file "package" :depends-on ("dpkg-fs"))
+                 (:file "package" :depends-on ("dpkg-fs"
+                                               "files"))
+                 (:file "files" :depends-on ("dpkg-fs"))
                  (:file "dpkg-fs"))))
   :description "dpkg implementation for pkgfs"
   :long-description

src/dir-content.lisp

@@ -19,13 +19,20 @@
 (defmethod dir-content (path (type (eql :package-info)) &key package)
   (unless path
     (return-from dir-content '("name" "version" "description" "dependencies" "uninstall" "files")))
-  (when (string= (first path) "dependencies")
-    (dir-content (rest path) :deps :package package)))
+  (cond ((string= (first path) "dependencies") (dir-content (rest path)
+                                                            :deps
+                                                            :package package))
+        ((string= (first path) "files") (dir-content (rest path)
+                                                     :files
+                                                     :package package))))
 
 (defmethod dir-content (path (type (eql :deps)) &key package)
   (unless path
     (return-from dir-content (package-deps package))))
 
+(defmethod dir-content (path (type (eql :files)) &key package)
+  (gethash (cat "/" (join path "/")) (package-files package)))
+
 (defmethod dir-content (path (type (eql :index)) &key)
   (unless path
     (return-from dir-content (all-packages)))

src/files.lisp

@@ -0,0 +1,14 @@
+(in-package :dpkg-fs)
+
+;;;; C macros translations
+(defconstant +--s-ifmt+ #o0170000)
+(defun is-type (mode mask)
+  (= (logand mode +--s-ifmt+) mask))
+
+(defmacro define-file-type (type mask)
+  `(defun ,(intern (string-upcase
+                    (concatenate 'string "is-" (symbol-name type)))) (mode)
+     (is-type mode ,mask)))
+
+;; Creates the is-dir function
+(define-file-type dir #o0040000)

src/is-directory.lisp

@@ -21,20 +21,21 @@
   (unless path
     (return-from is-directory t))
   (when (package-available (first path))
-    (is-directory (rest path) :package-info)))
+    (is-directory (rest path) :package-info :package (first path))))
 
-(defmethod is-directory (path (type (eql :package-info)) &key)
+(defmethod is-directory (path (type (eql :package-info)) &key package)
   (unless path
     (return-from is-directory t))
   (cond ((member (first path) '("name" "version" "description" "install" "uninstall") :test #'string=) nil)
         ((string= (first path) "dependencies") (is-directory (rest path) :deps))
-        ((string= (first path) "files") (is-directory (rest path) :files))))
+        ((string= (first path) "files") (is-directory (rest path) :files :package package))))
 
 (defmethod is-directory (path (type (eql :deps)) &key)
   (unless path
     (return-from is-directory t))
   nil)
 
-(defmethod is-directory (path (type (eql :files)) &key)
+(defmethod is-directory (path (type (eql :files)) &key package)
   (unless path
-    (return-from is-directory t)))
+    (return-from is-directory t))
+  (is-dir (sb-posix:stat-mode (sb-posix:stat (cat "/" (join path "/"))))))

src/package.lisp

@@ -5,6 +5,9 @@
     (uiop:run-program command :ignore-error-status t :output s)
     (get-output-stream-string s)))
 
+(defun join (list delimiter)
+  (format nil (cat "~{~A~^" delimiter "~}") list))
+
 (defn installed-packages (list) ()
   (cl-ppcre:split " " (run "dpkg-query --showformat='${Package} ' --show")))
 
@@ -73,3 +76,28 @@
       (cl-ppcre:scan-to-strings "Description-\\w+:\\s(.*)" (run (cat "apt-cache show " name)))
     (declare (ignore _))
     (elt matches 0)))
+
+(defn package-files (string -> hash-table) (name)
+  "Returns a hash table of this form (using pseudo-JSON):
+{
+    '/usr': ['share'],
+    '/usr/share': ['foo'],
+    '/usr/share/foo': ['bar', 'baz']
+}
+
+This way, getting the list of files in a folder is very simple
+with the right key."
+  (let ((files (make-hash-table :test #'equal)))
+    (loop
+       :for file in
+       ;; The first is always "/.", so ignore it
+       (rest
+        (cl-ppcre:split #\Newline (run (cat "dpkg -L " name))))
+       :when (is-dir (sb-posix:stat-mode (sb-posix:stat file)))
+       :do (setf (gethash file files) (or (gethash file files)
+                                          nil))
+       :do (let* ((split-path (cl-ppcre:split #\/ file))
+                  (folder (join (butlast split-path) "/"))
+                  (file (first (last split-path))))
+             (push file (gethash (if (string= folder "") "/" folder) files))))
+    files))