leibowitz
Experimental Common Lisp object storage abstraction for Unix file systems
leibowitz/core/collections/homedir.lisp
Download raw file: core/collections/homedir.lisp
;;; The default collection, used for files in the user's home (in-package :leibowitz.core) (defclass collection-homedir (collection) ((root :type pathname :initarg :root :initform (user-homedir-pathname) :accessor collection-homedir-root) (includes :type list :initarg :includes :initform '("*") :accessor collection-homedir-includes :documentation "") (excludes :type list :initarg :excludes :initform '(".*") :accessor collection-homedir-excludes :documentation "")) (:documentation "")) (defmethod print-object ((c collection-homedir) stream) (print-unreadable-object (c stream :type T) (format stream "~A" (collection-homedir-root c)))) (defmethod collection-applicable-p ((c collection-homedir) (id string)) (let* ((id (uiop:parse-unix-namestring id)) (root (uiop:native-namestring (collection-homedir-root c))) ;; Handle the case where some part of our root path is a ;; symlink, like how FreeBSD links /home to /usr/home (root-without-symlinks (uiop:native-namestring (truename (collection-homedir-root c)))) ;; If the file exists on disk, resolve symlinks (id (uiop:native-namestring (if (probe-file id) (truename id) (merge-pathnames id))))) ;; FIXME: As a result of the way we're processing ID through ;; uiop:parse-unix-namestring → merge-pathnames → ;; uiop:native-namestring this will return T for ANY value of ID ;; that doesn't point to an existing file :/ (if (or (eql 0 (search root id)) (eql 0 (search root-without-symlinks id))) c NIL))) (defmethod collection-index ((l library) (c collection-homedir) id) (check-type id (or string pathname)) (add-datum l (make-instance 'datum :id id :collection c))) ;; FIXME: write the knowability method