- reverted code to make a static executable.

- removed hardcoded string in Makefile;
- ensured 'fs:relative-file-path->absolute' adds a trailing slash when converting a directory path.

LICENSES.org

@@ -1,3 +1,52 @@
+- src/os-utils.lisp
+  uses code from osicat
+
+  Copyright © Nikodemus Siivola
+
+  Permission is hereby granted, free of charge, to any person obtaining
+  a copy of this software and associated documentation files (the
+  "Software"), to deal in the Software without restriction, including
+  without limitation the rights to use, copy, modify, merge, publish,
+  distribute, sublicense, and/or sell copies of the Software, and to
+  permit persons to whom the Software is furnished to do so, subject to
+  the following conditions:
+
+  The above copyright notice and this permission notice shall be included
+  in all copies or substantial portions of the Software.
+
+  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+- src/fylesystem-utils
+
+  uses code from osicat
+
+  Copyright © Nikodemus Siivola
+
+  Permission is hereby granted, free of charge, to any person obtaining
+  a copy of this software and associated documentation files (the
+  "Software"), to deal in the Software without restriction, including
+  without limitation the rights to use, copy, modify, merge, publish,
+  distribute, sublicense, and/or sell copies of the Software, and to
+  permit persons to whom the Software is furnished to do so, subject to
+  the following conditions:
+
+  The above copyright notice and this permission notice shall be included
+  in all copies or substantial portions of the Software.
+
+  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
 - src/gemini/dummy-server.lisp
 
   derived from:

Makefile.am

@@ -95,6 +95,7 @@ data/scripts/welcome-bot.lisp
 dist_man1_MANS       = doc/tinmop.man
 
 $(PACKAGE): $(CONF_PATH_FILE) *.asd src/*
+	cd $$(dirname $$($(LISP_COMPILER) --noinform --eval "(format t \"~a\" *core-pathname*)" --eval "(sb-ext:quit)")) && \
 	$(LISP_COMPILER) \
 		--eval "(push \"$$(pwd)/\" asdf:*central-registry*)" \
 		--eval "(asdf:make '$(PACKAGE) :build-pathname \"../$(PACKAGE)\")" \

Makefile.in

@@ -1117,6 +1117,7 @@ uninstall-man: uninstall-man1
 
 
 $(PACKAGE): $(CONF_PATH_FILE) *.asd src/*
+	cd $$(dirname $$($(LISP_COMPILER) --noinform --eval "(format t \"~a\" *core-pathname*)" --eval "(sb-ext:quit)")) && \
 	$(LISP_COMPILER) \
 		--eval "(push \"$$(pwd)/\" asdf:*central-registry*)" \
 		--eval "(asdf:make '$(PACKAGE) :build-pathname \"../$(PACKAGE)\")" \

README.org

@@ -83,7 +83,6 @@
    - log4cl;
    - marshal;
    - nodgui;
-   - osicat;
    - parse-number;
    - percent-encoding;
    - purgatory;

lisp-dependencies

@@ -18,7 +18,6 @@ local-time
 log4cl
 marshal
 nodgui
-osicat
 parse-number
 percent-encoding
 purgatory

src/complete.lisp

@@ -47,10 +47,10 @@ See: complete:directory-complete")
 (defun underlying-directory-p (pathname)
   "Find the actual directory of pathname (i.e. resolve file link"
   (ignore-errors
-   (case (file-kind pathname)
+   (case (fs:file-kind pathname)
      (:directory t)
      (:symbolic-link
-      (file-kind (merge-pathnames (read-link pathname) pathname))))))
+      (fs:file-kind (merge-pathnames (fs:read-link pathname) pathname))))))
 
 ;;; We can't easily do zsh-style tab-completion of ~us into ~user, but
 ;;; at least we can expand ~ and ~user.  The other bug here at the
@@ -67,7 +67,9 @@ to the appropriate home directory."
                                return i))
                (suffix (and slash-index (subseq string slash-index)))
                (uname (subseq string 1 slash-index))
-               (homedir (or (cdr (assoc :home (user-info uname)))
+               (user-info (ignore-errors (os-utils:user-info uname)))
+               (homedir (if user-info
+                            (os-utils:user-info-home user-info)
                             (chop (namestring
                                    (or (probe-file (user-homedir-pathname))
                                        (return-from tilde-expand-string
@@ -79,30 +81,23 @@ to the appropriate home directory."
   "Return  two  values completion  of  'string'  (non  nil if  can  be
 completed) and the common prefix of the completion string."
   (when (text-utils:string-not-empty-p string)
-    (let* ((namestring  (tilde-expand-string string))
-           (name-dir    (if (file-exists-p namestring)
+    (let* ((namestring  (fs:relative-file-path->absolute (tilde-expand-string string)))
+           (name-dir    (if (fs:file-exists-p namestring)
                             (fs:parent-dir-path namestring)
                             namestring))
-           (dir         (pathname->directory-pathname namestring))
-           (namefun     (if (relative-pathname-p string)
-                            #'namestring
-                            (lambda (x) (namestring (merge-pathnames x))))))
+           (dir         (namestring (pathname->directory-pathname namestring)))
+           (absolute-dir-path (fs:relative-file-path->absolute dir)))
       (unless (and (underlying-directory-p dir)
                    (not (wild-pathname-p dir)))
         (return-from directory-complete (values nil 0)))
-      (with-directory-iterator  (next dir)
-        (when-let* ((all        (loop
-                                  for entry = (next)
-                                  while entry collect
-                                  (funcall namefun entry)))
-                    (candidates (sort (remove-if-not (lambda (a)
-                                                       (text-utils:string-starts-with-p name-dir
-                                                                                        a))
-                                                     all)
-                                      (lambda (a b) (< (length a)
-                                                       (length b))))))
-          (values candidates
-                  (reduce-to-common-prefix candidates)))))))
+      (let* ((all        (fs:collect-children absolute-dir-path))
+             (candidates (sort (remove-if-not (lambda (a)
+                                                (text-utils:string-starts-with-p name-dir
+                                                                                 a))
+                                              all)
+                               #'string<)))
+        (values candidates
+                (reduce-to-common-prefix candidates))))))
 
 (defun starts-with-clsr (hint)
   (lambda (a)

src/filesystem-utils.lisp

@@ -73,6 +73,61 @@
                           :if-does-not-exist :create)
     (write-sequence seq stream)))
 
+(defun absolute-pathname-p (pathname)
+  (not (relative-pathname-p pathname)))
+
+(defun relative-pathname-p (pathname)
+  (uiop:relative-pathname-p pathname))
+
+(defun file-kind (namestring &key (follow-p t))
+  (let ((mode (nix:stat-mode (if follow-p
+                                 (nix:stat namestring)
+                                 (nix:lstat namestring)))))
+    (cond
+      ((nix:s-isdir mode)
+       :directory)
+      ((nix:s-ischr mode)
+       :character-device)
+      ((nix:s-isblk mode)
+       :block-device)
+      ((nix:s-isreg mode)
+       :regular-file)
+      ((nix:s-islnk mode)
+       :symbolic-link)
+      ((nix:s-issock mode)
+       :socket)
+      ((nix:s-isfifo mode)
+       :pipe)
+      (t
+       (error "uknown file type for ~a" namestring)))))
+
+(defun current-directory ()
+  (uiop:getcwd))
+
+(defun absolute-pathname (pathspec
+                          &optional (default *default-pathname-defaults*))
+  "Returns an absolute pathname corresponding to PATHSPEC by
+merging it with DEFAULT, and (CURRENT-DIRECTORY) if necessary."
+  (if (relative-pathname-p pathspec)
+      (let ((tmp (merge-pathnames
+                  pathspec
+                  (make-pathname :name nil :type nil :version nil
+                                 :defaults default))))
+        (if (relative-pathname-p tmp)
+            (merge-pathnames tmp (current-directory))
+            tmp))
+      pathspec))
+
+(defun read-link (pathspec)
+  "Returns the pathname pointed to by the symbolic link
+designated by PATHSPEC.  If the link is relative, then the
+returned pathname is relative to the link, not
+*DEFAULT-PATHNAME-DEFAULTS*.
+
+Signals an error if PATHSPEC is wild, or does not designate a
+symbolic link."
+  (pathname (nix:readlink (absolute-pathname pathspec))))
+
 (defun create-file (file &key (skip-if-exists nil))
   "create file and parent dir, if necessary"
   (when (not (and skip-if-exists
@@ -139,25 +194,25 @@
                                   *directory-sep*))))
 
 (defmacro do-directory ((var) root &body body)
-  (with-gensyms (dir dir-name new-path)
+  (with-gensyms (dir dir-name new-path dir-entry-ptr)
     `(let ((,dir (nix:opendir ,root)))
        (unwind-protect
             (handler-case
                 (flet ((read-dir ()
-                         (when-let* ((,dir-name (nix:readdir ,dir))
-                                     (,new-path (cat-parent-dir ,root  ,dir-name)))
-                           ,new-path)))
+                         (let ((,dir-entry-ptr (nix:readdir ,dir)))
+                           (when (not (sb-alien:null-alien ,dir-entry-ptr))
+                             (let* ((,dir-name (nix:dirent-name ,dir-entry-ptr))
+                                    (,new-path (cat-parent-dir ,root  ,dir-name)))
+                               ,new-path)))))
                   (do ((,var (read-dir) (read-dir)))
                       ((not ,var) ())
                     ,@body))
-              (nix::enotdir () 0)
-              (nix:eacces () 0)
-              (nix:eloop () 0))
+              (error () nil))
        (nix:closedir ,dir)))))
 
 (defun collect-children (parent-dir)
   (let ((all-paths '()))
-    (fs:do-directory (path) parent-dir
+    (do-directory (path) parent-dir
       (if (or (backreference-dir-p      path)
               (loopback-reference-dir-p path))
           (push path all-paths)
@@ -247,8 +302,19 @@
       (match root-directory)
       matched)))
 
+(cffi:defcfun (ffi-realpath "realpath")
+  :string
+  (path          :pointer)
+  (resolved-path :pointer))
+
 (defun relative-file-path->absolute (path)
-  (nix:realpath path))
+  (let ((absolute-path (cffi:with-foreign-string (ptr-path path)
+                         (let ((resolved ""))
+                           (cffi:with-foreign-string (ptr-resolved resolved)
+                             (ffi-realpath ptr-path ptr-resolved))))))
+    (if (dirp absolute-path)
+        (cat-parent-dir absolute-path *directory-sep*)
+        absolute-path)))
 
 (defun regular-file-p (path)
   (nix:s-isreg (nix:stat-mode (nix:stat path))))
@@ -345,14 +411,15 @@
   (num:fnv-hash-32 (slurp-file file :convert-to-string nil)))
 
 (defun file-outdated-p (file &rest dependencies)
-  (handler-bind ((nix:enoent #'(lambda (c)
-                                 (declare (ignore c))
-                                 (invoke-restart 'use-value nil))))
+  (handler-case
     (let ((mtime-file  (get-stat-mtime file))
           (mtimes-deps (remove-if #'null (mapcar #'get-stat-mtime dependencies))))
       (if mtime-file
           (remove-if #'(lambda (mtime) (<= mtime mtime-file)) mtimes-deps)
-          t))))
+          t))
+    (nix:syscall-error (e)
+      (declare (ignore e))
+      nil)))
 
 (defun file-exists-p (f)
   (uiop:file-exists-p f))
@@ -371,15 +438,22 @@
     (with-open-file (stream f :element-type '(unsigned-byte 8))
       (file-length stream))))
 
-(defun home-dir (&key (add-separator-ends nil))
-  (let ((home (os-utils:getenv "HOME")))
-    (if add-separator-ends
-        (text-utils:strcat home *directory-sep*)
-        home)))
+(cffi:defcfun ("mkstemps" ffi-mkstemps) :int
+  (template :pointer)
+  (suffix-length :int))
+
+(defun mkstemps (template suffix &optional (filler "XXXXXX"))
+  (let ((actual-template (concatenate 'string
+                                      template
+                                      filler
+                                      suffix)))
+    (cffi:with-foreign-string (ptr-template actual-template)
+      (values (ffi-mkstemps ptr-template (length suffix))
+              (cffi:foreign-string-to-lisp ptr-template)))))
 
 (defun %mkstemp (prefix suffix)
   (multiple-value-bind (fd path)
-      (nix:mkstemps prefix suffix)
+      (mkstemps prefix suffix)
     (nix:close fd)
     path))
 
@@ -466,8 +540,40 @@
   (dolist (temporary-directory *temporary-directories-created*)
     (recursive-delete temporary-directory)))
 
+(define-constant +file-permissions+
+    '((:user-read    . #.nix:s-irusr)
+      (:user-write   . #.nix:s-iwusr)
+      (:user-exec    . #.nix:s-ixusr)
+      (:group-read   . #.nix:s-irgrp)
+      (:group-write  . #.nix:s-iwgrp)
+      (:group-exec   . #.nix:s-ixgrp)
+      (:other-read   . #.nix:s-iroth)
+      (:other-write  . #.nix:s-iwoth)
+      (:other-exec   . #.nix:s-ixoth)
+      (:set-user-id  . #.nix:s-isuid)
+      (:set-group-id . #.nix:s-isgid)
+      (:sticky       . #.nix:s-isvtx))
+  :test #'equalp)
+
+(defun file-permissions (file)
+  (labels ((extract-permissions (mode permissions-mask &optional (accum '()))
+             (if (> mode 0)
+                 (let* ((permission      (first permissions-mask))
+                        (permission-name (car permission))
+                        (permission-mask (cdr permission))
+                        (mode-enabled    (=  (logand permission-mask mode)
+                                             1))
+                        (modes           (if mode-enabled
+                                          (push permission-name accum))))
+                   (extract-permissions (logand permission-mask mode)
+                                        permissions-mask
+                                        modes))
+                 accum)))
+    (let ((modes (nix:stat-mode (nix:stat file))))
+      (extract-permissions modes +file-permissions+))))
+
 (defun has-file-permission-p (file permission)
-  (find permission (osicat:file-permissions file) :test #'eq))
+  (find permission (file-permissions file) :test #'eq))
 
 (defun file-can-write-p (file)
   (has-file-permission-p file :user-write))
@@ -480,8 +586,8 @@
                :test #'eql))))
 
 (gen-permission-files
-   nix:s-irwxu nix:s-irusr nix:s-iwusr nix:s-ixusr nix:s-irwxg nix:s-irgrp nix:s-iwgrp
-   nix:s-ixgrp nix:s-irwxo nix:s-iroth nix:s-iwoth nix:s-ixoth nix:s-isuid nix:s-isgid)
+   nix:s-irusr nix:s-iwusr nix:s-ixusr nix:s-irgrp nix:s-iwgrp
+   nix:s-ixgrp nix:s-iroth nix:s-iwoth nix:s-ixoth nix:s-isuid nix:s-isgid)
 
 (defun set-file-permissions (file mode)
   (nix:chmod file mode))

src/misc-utils.lisp

@@ -933,6 +933,9 @@ to the array"
 (definline make-null-pointer ()
   (cffi:null-pointer))
 
+(defun null-pointer-p (ptr)
+  (cffi:null-pointer-p ptr))
+
 ;; plugins, sort of
 
 (defmacro with-load-forms-in-var ((special-var output-var file) &body body)

src/os-utils.lisp

@@ -50,7 +50,7 @@
     (uiop:launch-program cmd-line :output nil)))
 
 (defun getenv (name &key (default nil))
-  (or (nix:getenv name)
+  (or (uiop:getenv name)
       default))
 
 (defun default-temp-dir ()
@@ -59,6 +59,35 @@
 (defun pwd ()
   (getenv "PWD"))
 
+(defun home-directory (&key (add-separator-ends nil))
+  (let ((home (os-utils:getenv "HOME")))
+    (if add-separator-ends
+        (text-utils:strcat home fs:*directory-sep*)
+        home)))
+
+(defstruct user-info
+  (name)
+  (password)
+  (user-id)
+  (group-id)
+  (gecos)
+  (home)
+  (shell))
+
+(defun user-info (id)
+  "USER-INFO returns the password entry for the given name or
+numerical user ID, as an assoc-list."
+  (a:when-let ((password-struct (etypecase id
+                                  (string  (nix:getpwnam id))
+                                  (integer (nix:getpwuid id)))))
+    (make-user-info :name     (nix:passwd-name password-struct)
+                    :password (nix:passwd-passwd password-struct)
+                    :user-id  (nix:passwd-uid password-struct)
+                    :group-id (nix:passwd-gid password-struct)
+                    :gecos    (nix:passwd-gecos password-struct)
+                    :home     (nix:passwd-dir password-struct)
+                    :shell    (nix:passwd-shell password-struct))))
+
 (defun external-editor ()
   (let* ((editor (or (swconf:external-editor)
                      (and (text-utils:string-not-empty-p (getenv "VISUAL"))

src/package.lisp

@@ -247,6 +247,7 @@
    :gen-trivial-plist-gets
    :gen-vec-comp
    :make-null-pointer
+   :null-pointer-p
    :with-load-forms-in-var
    :time-unix->universal
    :time-seconds-of
@@ -297,17 +298,15 @@
    :cl
    :alexandria)
   (:nicknames :fs)
+  (:local-nicknames (:nix :sb-posix))
   (:export
    :+file-path-regex+
-   :+s-irwxu+
    :+s-irusr+
    :+s-iwusr+
    :+s-ixusr+
-   :+s-irwxg+
    :+s-irgrp+
    :+s-iwgrp+
    :+s-ixgrp+
-   :+s-irwxo+
    :+s-iroth+
    :+s-iwoth+
    :+s-ixoth+
@@ -316,12 +315,18 @@
    :*directory-sep-regexp*
    :*directory-sep*
    :create-a-file
+   :current-directory
+   :absolute-pathname
+   :read-link
    :copy-a-file
    :rename-a-file
    :file-size
    :slurp-file
    :dump-sequence-to-file
    :create-file
+   :absolute-pathname-p
+   :relative-pathname-p
+   :file-kind
    :cat-parent-dir
    :has-extension
    :get-extension
@@ -358,7 +363,6 @@
    :file-length-if-exists
    :delete-file-if-exists
    :file-hash
-   :home-dir
    :*temporary-files-created*
    :temporary-file
    :clean-temporary-files
@@ -393,6 +397,8 @@
    :cl
    :config
    :constants)
+  (:local-nicknames (:nix :sb-posix)
+                    (:a :alexandria))
   (:export
    :+ssl-cert-name+
    :+ssl-key-name+
@@ -401,6 +407,8 @@
    :getenv
    :default-temp-dir
    :pwd
+   :home-directory
+   :user-info
    :run-external-program
    :process-exit-code
    :process-exit-success-p
@@ -421,7 +429,14 @@
    :file->mime-type
    :unzip-file
    :unzip-single-file
-   :copy-to-clipboard))
+   :copy-to-clipboard
+   :user-info
+   :user-info-name
+   :user-info-user-id
+   :user-info-group-id
+   :user-info-gecos
+   :user-info-home
+   :user-info-shell))
 
 (defpackage :text-utils
   (:use
@@ -1609,8 +1624,7 @@
 (defpackage :complete
   (:use
    :cl
-   :alexandria
-   :osicat)
+   :alexandria)
   (:export
    :*complete-function*
    :shortest-candidate

src/software-configuration.lisp

@@ -869,7 +869,8 @@
   (let* ((signature-file (or (access:accesses *software-configuration*
                                               +key-signature-file+)
                              +default-signature-filename+))
-         (signature-path (fs:cat-parent-dir (fs:home-dir) signature-file)))
+         (signature-path (fs:cat-parent-dir (os-utils:home-directory)
+                                            signature-file)))
     (if (fs:file-exists-p signature-path)
         signature-path
         nil)))

tinmop.asd

@@ -22,12 +22,13 @@
   :pathname    "src"
   :serial      t
   :bug-tracker "https://codeberg.org/cage/tinmop/issues"
+  :build-operation "program-op"
+  :entry-point "main::main"
   :depends-on (:alexandria
                :cl-ppcre-unicode
                :tooter
                :croatoan
                :nodgui
-               :osicat
                :flexi-streams
                :cl-spark
                :access
@@ -57,8 +58,6 @@
                :trivial-clipboard
                :yason
                :uiop)
-  :entry-point "main::main"
-  :build-operation program-op
   :components ((:file "package")
                (:file "idn")
                (:file "config")