ambrevar/shell: Add file-type, match-executable, match-elf-binary, match-elf-library.
parent
17c30e0903
commit
852cf2f9f9
|
@ -14,6 +14,15 @@
|
||||||
(delete-if #'sera:resolve-executable (cons program more-programs))))
|
(delete-if #'sera:resolve-executable (cons program more-programs))))
|
||||||
(error "Missing programs: ~{~a~,^, ~}" missing-programs)))
|
(error "Missing programs: ~{~a~,^, ~}" missing-programs)))
|
||||||
|
|
||||||
|
(export-always 'file-type)
|
||||||
|
(defun file-type (file)
|
||||||
|
"Return the file type, as per the `file' program."
|
||||||
|
;; TODO: This is too slow, is there a pure Common Lisp equivalent?
|
||||||
|
(let ((type-string (second (str:split ": "
|
||||||
|
(run* "file" file)
|
||||||
|
:limit 2))))
|
||||||
|
(str:split ", " type-string)))
|
||||||
|
|
||||||
(export-always 'file-extension)
|
(export-always 'file-extension)
|
||||||
(defun file-extension (file)
|
(defun file-extension (file)
|
||||||
"Return the file extension.
|
"Return the file extension.
|
||||||
|
@ -62,6 +71,24 @@ Useful for `walk'."
|
||||||
files-or-dirs?)))
|
files-or-dirs?)))
|
||||||
files?)))
|
files?)))
|
||||||
|
|
||||||
|
(export-always 'match-executable)
|
||||||
|
(defun match-executable ()
|
||||||
|
(lambda (file)
|
||||||
|
(intersection
|
||||||
|
(osicat:file-permissions file)
|
||||||
|
'(:user-exec :group-exec :other-exec))))
|
||||||
|
|
||||||
|
(export-always 'match-elf-binary)
|
||||||
|
(defun match-elf-binary ()
|
||||||
|
(lambda (file)
|
||||||
|
;; (ppcre:scan "ELF.*executable" (first (file-type file)))
|
||||||
|
(string= "ELF 64-bit LSB executable" (first (file-type file)))))
|
||||||
|
|
||||||
|
(export-always 'match-elf-library)
|
||||||
|
(defun match-elf-library ()
|
||||||
|
(lambda (file)
|
||||||
|
(ppcre:scan "ELF.*shared object" (first (file-type file)))))
|
||||||
|
|
||||||
(export-always '*finder-include-directories*)
|
(export-always '*finder-include-directories*)
|
||||||
(defvar *finder-include-directories* t
|
(defvar *finder-include-directories* t
|
||||||
"When non-nil `walk' include directories.")
|
"When non-nil `walk' include directories.")
|
||||||
|
@ -293,4 +320,4 @@ INTERFACE is a string in the form of `wlp2s0'."
|
||||||
|
|
||||||
(export-always 'current-ip)
|
(export-always 'current-ip)
|
||||||
(defun current-ip ()
|
(defun current-ip ()
|
||||||
(ipv4 (default-interface)))
|
(ipv4 (current-interface)))
|
||||||
|
|
Loading…
Reference in New Issue