diff options
Diffstat (limited to 'duet.el')
| -rw-r--r-- | duet.el | 135 |
1 files changed, 135 insertions, 0 deletions
@@ -586,6 +586,141 @@ confirmed. Return a flat list of step plists in execution order." (list :op 'delete :source s :gate 'copy-success))) sources))) +;;; Data-safety planning (pure, prompt-free) + +;; The category's recurring data-loss traps are decided here, before any byte +;; moves. Every check is pure: filesystem facts (a path's lstat type, the +;; names already at a destination, whether the destination filesystem folds +;; case, its path-length limit, its reserved names) are injected, so the +;; planner is testable without touching a file. Each problem is a plist +;; (:class :severity :file :message); `error' severity blocks, `warning' +;; surfaces a decision (follow-vs-preserve a symlink). + +(defun duet--norm (path) + "Lexically normalize PATH: expand it and strip a trailing slash." + (directory-file-name (expand-file-name path))) + +(defun duet--trailing-slash-p (path) + "Return non-nil when PATH ends with a slash." + (and (> (length path) 0) + (eq (aref path (1- (length path))) ?/))) + +(defun duet--check-same-file (source destination) + "Flag a transfer whose SOURCE and DESTINATION are the same file." + (when (string= (duet--norm source) (duet--norm destination)) + (list :class 'same-file :severity 'error :file source + :message "Source and destination are the same file."))) + +(defun duet--check-dir-into-itself (source destination) + "Flag a transfer whose DESTINATION is inside the SOURCE directory." + (let ((s (file-name-as-directory (duet--norm source))) + (d (file-name-as-directory (duet--norm destination)))) + (when (and (not (string= s d)) + (string-prefix-p s d)) + (list :class 'destination-within-source :severity 'error :file destination + :message "The destination is inside the source directory.")))) + +(defun duet--resolved-destination (source destination-directory) + "Return the path SOURCE lands at when copied into DESTINATION-DIRECTORY. +A SOURCE with a trailing slash copies its contents, landing in the +destination directory itself; without one, SOURCE lands as a named child. +Making the resolved path explicit defuses the trailing-slash \"into vs +contents\" footgun." + (let ((dest (file-name-as-directory (expand-file-name destination-directory)))) + (if (duet--trailing-slash-p source) + (directory-file-name dest) + (concat dest (file-name-nondirectory (duet--norm source)))))) + +(defun duet--check-special-file (path type) + "Flag PATH when its lstat TYPE is a device/fifo/socket DUET will not transfer. +TYPE is a symbol from an lstat-based classifier: `file', `directory', +`symlink', or a special type; nil means the type is unknown. Regular files, +directories, symlinks, and unknown types are allowed." + (unless (memq type '(file directory symlink nil)) + (list :class 'unsupported-special-file :severity 'error :file path + :message (format "%s is a special file (%s) DUET will not transfer." + path type)))) + +(defun duet--check-symlink (path type) + "Surface PATH as a warning when its lstat TYPE is a symlink. +A symlink is transferable, but follow-versus-preserve is a decision the user +must make, so it is surfaced rather than silently chosen." + (when (eq type 'symlink) + (list :class 'symlink :severity 'warning :file path + :message "Source is a symlink; choose follow or preserve before transfer."))) + +(defun duet--check-case-collision (destination existing-names case-insensitive) + "Flag a case-only collision at DESTINATION on a case-insensitive filesystem. +EXISTING-NAMES are the basenames already at the destination directory, and +CASE-INSENSITIVE says whether that filesystem folds case. An exact match is +an ordinary conflict, not a case collision, so it is not flagged here." + (when case-insensitive + (let ((base (file-name-nondirectory (duet--norm destination)))) + (when (cl-some (lambda (n) + (and (not (string= n base)) + (string-equal-ignore-case n base))) + existing-names) + (list :class 'case-collision :severity 'error :file destination + :message (format "%s collides with an existing name by case only." + base)))))) + +(defun duet--check-path-length (destination max-length) + "Flag DESTINATION when it is longer than MAX-LENGTH. +MAX-LENGTH is the destination filesystem's limit, or nil when unknown." + (when (and max-length (> (length destination) max-length)) + (list :class 'path-too-long :severity 'error :file destination + :message (format "Destination path is %d chars; the limit is %d." + (length destination) max-length)))) + +(defun duet--check-reserved-name (destination reserved-p) + "Flag DESTINATION when its basename is reserved on the target filesystem. +RESERVED-P is a predicate called with the basename, or nil when the +destination has no reserved names." + (let ((base (file-name-nondirectory (duet--norm destination)))) + (when (and reserved-p (funcall reserved-p base)) + (list :class 'reserved-name :severity 'error :file destination + :message (format "%s is a reserved name on the destination." base))))) + +(defun duet--plan-safety (source destination &optional caps) + "Return the data-safety problems for moving SOURCE to DESTINATION. +Pure: every filesystem fact comes from CAPS, so no file is touched. CAPS +keys: :file-type (fn PATH -> lstat type symbol), :existing-names (fn DEST -> +basenames), :case-insensitive (fn DEST -> bool), :max-path-length (int), and +:reserved-name (fn BASENAME -> bool). Each problem is a plist +\(:class :severity :file :message)." + (let ((type (let ((f (plist-get caps :file-type))) (and f (funcall f source)))) + (existing (let ((f (plist-get caps :existing-names))) (and f (funcall f destination)))) + (ci (let ((f (plist-get caps :case-insensitive))) (and f (funcall f destination))))) + (delq nil + (list (duet--check-same-file source destination) + (duet--check-dir-into-itself source destination) + (duet--check-special-file source type) + (duet--check-symlink source type) + (duet--check-case-collision destination existing ci) + (duet--check-path-length destination (plist-get caps :max-path-length)) + (duet--check-reserved-name destination (plist-get caps :reserved-name)))))) + +(defun duet--plan-move-safe (sources destination-directory &optional caps) + "Return a move plan for SOURCES into DESTINATION-DIRECTORY with safety gating. +Each source is resolved to its destination and run through `duet--plan-safety' +with CAPS. A source carrying a blocking (`error' severity) problem is skipped +\(no copy, no delete) as an :op skip recording its :problems; a safe source +gets a copy followed by a delete gated on copy success. No delete is ever +ungated." + (apply #'append + (mapcar + (lambda (s) + (let* ((dest (duet--resolved-destination s destination-directory)) + (problems (duet--plan-safety s dest caps)) + (errors (cl-remove-if-not + (lambda (p) (eq 'error (plist-get p :severity))) + problems))) + (if errors + (list (list :op 'skip :source s :destination dest :problems problems)) + (list (list :op 'copy :source s :destination dest :problems problems) + (list :op 'delete :source s :gate 'copy-success))))) + sources))) + ;;;###autoload (defun duet () "Launch the DUET dual-pane file commander." |