;;; duet.el --- Dual-pane file commander over dirvish/dired -*- lexical-binding: t -*- ;; Author: Craig Jennings ;; URL: https://github.com/cjennings/duet ;; Version: 0.1.0 ;; Package-Requires: ((emacs "29.1")) ;; Keywords: files, tools, convenience ;; This file is not part of GNU Emacs. ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;;; Commentary: ;; DUET — "DUET Unifies Endpoint Trees" — is a two-pane orthodox file ;; manager (Midnight Commander / FileZilla style) built on dirvish/dired. ;; Two dired panes show any location, local or remote; single-key actions ;; on the file under point use the opposite pane as the implied target. ;; ;; Transfers route through a pluggable backend registry: rsync for ;; Unix-to-Unix (delta-transfer, faithful metadata, zero remote install), ;; rclone for cloud and the long protocol tail, lftp for FTP/FTPS/HTTP, and ;; unison for bidirectional sync. TRAMP is the universal substrate. ;; ;; dirvish is recommended as the renderer but not required; DUET degrades to ;; plain dired. ;; ;; STATUS: pre-alpha skeleton. See the design document for the full plan and ;; the staged roadmap. ;;; Code: (require 'tramp) (require 'cl-lib) (defgroup duet nil "Dual-pane file commander over dirvish/dired." :group 'files :prefix "duet-") ;;; Path classification (defun duet--classify-path (path) "Classify PATH into a plist describing its locality and components. The returned plist has these keys: :locality `local' or `remote' :method TRAMP method (e.g. \"ssh\"), or nil when local :user remote user, or nil :host remote host (the final hop for a multi-hop path), or nil :port remote port as a string, or nil :localname the path on the target filesystem :hop the leading-hops string for a multi-hop path, or nil TRAMP performs the dissection, so any path `file-remote-p' recognizes is remote and everything else is local. A local PATH has its name expanded \(so a leading ~ resolves to the home directory); a remote localname is kept verbatim because a ~ there is the remote home, not this machine's. Classification is total: a TRAMP-looking string TRAMP does not accept as a remote name (an incomplete \"/ssh:host\") is treated as a local path rather than signaling. Validating raw TRAMP input is the connection reader's job." (if (file-remote-p path) (let ((v (tramp-dissect-file-name path))) (list :locality 'remote :method (tramp-file-name-method v) :user (tramp-file-name-user v) :host (tramp-file-name-host v) :port (tramp-file-name-port v) :localname (tramp-file-name-localname v) :hop (tramp-file-name-hop v))) (list :locality 'local :method nil :user nil :host nil :port nil :localname (expand-file-name path) :hop nil))) ;;; Transport-backend registry (cl-defstruct (duet-backend (:constructor duet-backend-create) (:copier nil)) "A transport backend: a scorer, a command builder, and contract metadata. Slots: name unique symbol; re-registering a name replaces the backend handles (lambda (SRC DST) ...) -> numeric cost (lower preferred) or nil when the backend cannot handle the endpoint pair command (lambda (SRC DST OPTS) ...) -> a process-spec plist (its :argv is an argument list, never a shell string) capabilities plist of advertised flags: :async :resume :bidirectional :progress temp-pattern regexp naming the backend's temp/partial files, or nil cleanup cleanup semantics: `:verifiable', `:best-effort', or `:none' redaction list of regexps whose matches are stripped from logs (each pattern's capture group 1 is the field label kept verbatim), or the symbol `:none' for a backend with no secret surface normalizer failure-normalizer function, or nil to use the minimal one" name handles command capabilities temp-pattern cleanup redaction normalizer) (defvar duet--backend-registry nil "List of registered `duet-backend' structs, most recently registered first.") (defun duet-register-backend (backend) "Register BACKEND, replacing any existing backend of the same name. Re-registering a name is how a user or plugin overrides a built-in. Return BACKEND." (setq duet--backend-registry (cons backend (cl-remove (duet-backend-name backend) duet--backend-registry :key #'duet-backend-name))) backend) (defun duet-backends () "Return the registered backends, most recently registered first." duet--backend-registry) (defun duet-backend-by-name (name) "Return the registered backend named NAME, or nil." (cl-find name duet--backend-registry :key #'duet-backend-name)) (defun duet--select-backend (src dst) "Return the registered backend best suited to transfer SRC to DST. Each backend's scorer is called with the classified endpoints SRC and DST and returns a numeric cost (lower preferred) or nil when it cannot handle the pair. The lowest-cost backend wins; ties resolve to the most recently registered one. Return nil when no backend handles the pair." (let ((best nil) (best-score nil)) (dolist (b duet--backend-registry best) (let ((score (funcall (duet-backend-handles b) src dst))) (when (and (numberp score) (or (null best-score) (< score best-score))) (setq best b best-score score)))))) ;;; Secret redaction (defconst duet--redaction-marker "" "Replacement text substituted for matched secrets in logs and bug reports.") (defun duet--redact (text patterns) "Return TEXT with every regexp in PATTERNS redacted. Each pattern keeps its capture group 1 (the field label) and replaces the rest of the match with the redaction marker, so a log can show that a secret field was present without leaking its value. A pattern with no group 1 redacts the whole match. TEXT is returned unchanged when PATTERNS is nil or the symbol `:none' (a backend declaring it has no secret surface)." (if (or (null patterns) (eq patterns :none)) text (let ((out text)) (dolist (re patterns out) (setq out (replace-regexp-in-string re (lambda (match) (save-match-data (if (and (string-match re match) (match-beginning 1)) (concat (match-string 1 match) duet--redaction-marker) duet--redaction-marker))) out t t)))))) ;;; Failure normalization (defun duet--failure-evidence (context) "Return the evidence lines from a failure CONTEXT as a list of strings." (delq nil (list (plist-get context :launch-error) (plist-get context :stderr)))) (defun duet-backend-minimal-failure-normalizer (context) "Map a generic failure CONTEXT into a normalized explanation plist. CONTEXT is a plist with any of :launch-error, :executable-missing, :timeout, :signal, :exit, and :stderr. The result carries :class, :cause, :evidence, :safety, and :next-actions. Every backend gets this for free; a backend's own normalizer refines the classification for failures it recognizes." (let ((exit (plist-get context :exit)) (signal (plist-get context :signal)) (evidence (duet--failure-evidence context))) (cond ((plist-get context :executable-missing) (list :class 'missing-executable :cause "The backend program was not found on PATH." :evidence evidence :safety "Source unchanged; nothing ran." :next-actions '(run-doctor))) ((plist-get context :launch-error) (list :class 'launch-failure :cause "DUET could not launch the backend process." :evidence evidence :safety "Source unchanged; nothing ran." :next-actions '(run-doctor))) ((plist-get context :timeout) (list :class 'stalled :cause "The transfer produced no output before the stall timeout." :evidence evidence :safety "Source unchanged; the destination may hold a partial." :next-actions '(retry cancel))) (signal (list :class 'cancelled :cause (format "The backend was terminated by signal %s." signal) :evidence evidence :safety "Source unchanged; the destination may hold a partial." :next-actions '(retry))) ((and (integerp exit) (/= exit 0)) (list :class 'backend-unknown-failure :cause (format "The backend exited with status %d." exit) :evidence evidence :safety :generic :next-actions '(retry run-doctor))) (t (list :class 'backend-unknown-failure :cause "The backend failed for an unrecognized reason." :evidence evidence :safety :generic :next-actions '(run-doctor)))))) (defun duet--failure-pattern-match-p (match context) "Return non-nil when MATCH applies to failure CONTEXT. MATCH is a regexp tested against the context's :stderr, or a predicate function called with the whole context." (cond ((functionp match) (funcall match context)) ((stringp match) (let ((stderr (plist-get context :stderr))) (and stderr (string-match-p match stderr)))) (t nil))) (defun duet--apply-failure-pattern (pattern context) "Return a normalized failure for PATTERN if it matches CONTEXT, else nil." (when (duet--failure-pattern-match-p (plist-get pattern :match) context) (list :class (plist-get pattern :class) :cause (plist-get pattern :cause) :evidence (duet--failure-evidence context) :safety (or (plist-get pattern :safety) :generic) :next-actions (plist-get pattern :next-actions)))) (defun duet-define-cli-failure-patterns (patterns) "Return a failure-normalizer function built from PATTERNS. Each entry is a plist with :match (a regexp over stderr or a predicate over the context), :class, :cause, :next-actions, and an optional :safety. The returned function tries each pattern in order and falls back to `duet-backend-minimal-failure-normalizer' when none match." (lambda (context) (or (cl-some (lambda (p) (duet--apply-failure-pattern p context)) patterns) (duet-backend-minimal-failure-normalizer context)))) (defun duet--normalize-failure (backend context) "Normalize a failure CONTEXT for BACKEND into an explanation plist. Consult BACKEND's own normalizer when it has one, otherwise the minimal normalizer." (funcall (or (duet-backend-normalizer backend) #'duet-backend-minimal-failure-normalizer) context)) ;;; Backend contract checks (tiered) (defun duet--check-name (backend) "Return a minimum-tier name violation for BACKEND, or nil." (unless (and (duet-backend-name backend) (symbolp (duet-backend-name backend))) "name must be a non-nil symbol")) (defun duet--check-handles (backend src dst) "Return a minimum-tier scorer violation for BACKEND on SRC/DST, or nil." (if (not (functionp (duet-backend-handles backend))) "handles must be a function" (let ((score (funcall (duet-backend-handles backend) src dst))) (unless (or (null score) (numberp score)) "handles must return a number or nil")))) (defun duet--command-spec-executable-p (spec) "Return non-nil when process SPEC has a recognized, runnable execution shape. A SPEC is runnable when it is a non-empty plist carrying either a non-empty :argv whose elements are all strings (a CLI backend) or an explicit non-argv mode -- :tramp for an in-process copy, or :exec-mode for a route that Phase 6 orchestrates (a both-remote rsync). A nil spec, a bare nil argv, or a shell string is not runnable." (and (listp spec) spec (not (plist-get spec :shell-command)) (or (plist-get spec :tramp) (plist-get spec :exec-mode) (let ((argv (plist-get spec :argv))) (and (consp argv) (cl-every #'stringp argv)))))) (defun duet--check-command (backend src dst opts) "Return a minimum-tier command violation for BACKEND on SRC/DST/OPTS, or nil." (if (not (functionp (duet-backend-command backend))) "command must be a function" (let ((spec (funcall (duet-backend-command backend) src dst opts))) (cond ((not (and (listp spec) spec)) "command must return a non-empty process-spec plist") ((plist-get spec :shell-command) "command must not build a shell string; use :argv") ((not (duet--command-spec-executable-p spec)) "command must return a runnable spec: a non-empty :argv of strings, or a declared in-process mode such as :tramp"))))) (defun duet--check-redaction (backend) "Return a minimum-tier redaction violation for BACKEND, or nil. A backend declares either a non-empty list of regexps or `:none' (no secret surface). An unset slot (nil) is a forgotten declaration and is flagged." (let ((r (duet-backend-redaction backend))) (unless (or (eq r :none) (and (listp r) r)) "redaction metadata must be declared (a non-empty list of regexps, or :none)"))) (defun duet--check-normalizer (backend) "Return a minimum-tier failure-explainer violation for BACKEND, or nil." (let ((n (duet--normalize-failure backend '(:exit 1 :stderr "sample")))) (unless (and (plist-member n :class) (plist-member n :cause) (plist-member n :next-actions)) "failure normalizer must return a class/cause/next-actions plist"))) (defun duet-backend-check-minimum (backend &optional src dst opts) "Return a list of minimum-tier contract violations for BACKEND, or nil. SRC, DST, and OPTS are a sample endpoint pair and options the backend should handle; they default to a local-to-local pair. An empty result means BACKEND is registrable: it names itself, scores and builds an argv command for the sample (never a shell string), declares redaction metadata, and produces a well-formed failure explanation. An author wraps this in an ERT test: (should-not (duet-backend-check-minimum my-backend))." (let ((src (or src '(:locality local :localname "/tmp/a"))) (dst (or dst '(:locality local :localname "/tmp/b")))) (delq nil (list (duet--check-name backend) (duet--check-handles backend src dst) (duet--check-command backend src dst opts) (duet--check-redaction backend) (duet--check-normalizer backend))))) (defun duet-backend-check-publishable (backend &optional src dst opts) "Return minimum-tier violations for BACKEND plus publishable-tier ones. A publishable backend additionally declares cleanup semantics and carries its own failure normalizer, so DUET can recommend it safely." (append (duet-backend-check-minimum backend src dst opts) (delq nil (list (unless (duet-backend-cleanup backend) "cleanup semantics must be declared (:verifiable/:best-effort/:none)") (unless (duet-backend-normalizer backend) "a backend-specific failure normalizer is required to publish"))))) (defun duet-backend-check-capability (backend capability &optional src dst opts) "Return publishable-tier violations for BACKEND plus a CAPABILITY assertion. CAPABILITY (e.g. :resume) must be declared in the backend's `capabilities' before DUET will trust it." (append (duet-backend-check-publishable backend src dst opts) (delq nil (list (unless (plist-get (duet-backend-capabilities backend) capability) (format "capability %s is asserted but not declared" capability)))))) ;;; Endpoint matrix and routing (defconst duet--ssh-methods '("ssh" "sshx" "scp" "rsync") "TRAMP methods rsync can transport over directly.") (defun duet--local-endpoint-p (ep) "Return non-nil when classified endpoint EP is local." (eq (plist-get ep :locality) 'local)) (defun duet--remote-endpoint-p (ep) "Return non-nil when classified endpoint EP is remote." (eq (plist-get ep :locality) 'remote)) (defun duet--ssh-endpoint-p (ep) "Return non-nil when classified endpoint EP is reachable over ssh." (and (duet--remote-endpoint-p ep) (member (plist-get ep :method) duet--ssh-methods))) (defun duet--same-remote-host-p (a b) "Return non-nil when classified endpoints A and B name the same remote host." (and (duet--remote-endpoint-p a) (duet--remote-endpoint-p b) (equal (plist-get a :method) (plist-get b :method)) (equal (plist-get a :user) (plist-get b :user)) (equal (plist-get a :host) (plist-get b :host)) (equal (plist-get a :port) (plist-get b :port)))) (defun duet--transfer-route (src dst opts) "Determine the transfer route between classified SRC and DST given OPTS. :local both endpoints local :local-remote exactly one endpoint remote :remote-same-host both on the same remote host (ssh in once, copy there) :remote-direct different remote hosts, direct host-to-host (override only) :remote-roundtrip different remote hosts, routed through this machine Different-host transfers default to the round-trip; direct mode is never automatic and requires `:direct-remote-to-remote' in OPTS." (let ((s-local (duet--local-endpoint-p src)) (d-local (duet--local-endpoint-p dst))) (cond ((and s-local d-local) :local) ((or s-local d-local) :local-remote) ((duet--same-remote-host-p src dst) :remote-same-host) ((plist-get opts :direct-remote-to-remote) :remote-direct) (t :remote-roundtrip)))) ;;; Built-in backends: rsync (native) and TRAMP (fallback) (defun duet--rsync-handles (src dst) "Score rsync for classified SRC and DST. rsync handles local and ssh-reachable endpoints. A local pair or a local/ssh pair scores 10; an ssh-to-ssh pair scores 20 (it needs routing). Anything not ssh-reachable scores nil so a fallback backend takes it." (let ((s-ok (or (duet--local-endpoint-p src) (duet--ssh-endpoint-p src))) (d-ok (or (duet--local-endpoint-p dst) (duet--ssh-endpoint-p dst)))) (when (and s-ok d-ok) (if (and (duet--remote-endpoint-p src) (duet--remote-endpoint-p dst)) 20 10)))) (defun duet--rsync-endpoint-arg (ep) "Return the rsync path argument for classified endpoint EP. A local endpoint uses its localname; a remote one uses rsync's native \[user@]host:path form (the port travels in the ssh transport flag)." (if (duet--local-endpoint-p ep) (plist-get ep :localname) (concat (when (plist-get ep :user) (concat (plist-get ep :user) "@")) (plist-get ep :host) ":" (plist-get ep :localname)))) (defun duet--rsync-ssh-transport (src dst) "Return rsync's -e ssh transport flags for SRC/DST, honoring a port." (let ((port (or (plist-get src :port) (plist-get dst :port)))) (list "-e" (if port (format "ssh -p %s" port) "ssh")))) (defun duet--rsync-local-command (src dst sources) "Build a single-invocation rsync spec where at most one endpoint is remote. SOURCES are the source paths; SRC and DST are the classified representative endpoints. A remote endpoint adds an ssh transport. File names reach rsync as argv elements, never interpolated into a shell string." (let ((remote (or (duet--ssh-endpoint-p src) (duet--ssh-endpoint-p dst))) (src-args (mapcar (lambda (p) (duet--rsync-endpoint-arg (duet--classify-path p))) sources))) (list :argv (append '("rsync" "-a" "--partial" "--info=progress2") (when remote (duet--rsync-ssh-transport src dst)) src-args (list (duet--rsync-endpoint-arg dst))) :default-directory "/"))) (defun duet--rsync-command (src dst opts) "Build an rsync process spec for SRC to DST with OPTS. rsync moves data in one invocation only when at most one endpoint is remote \(routes :local and :local-remote). It refuses a source and destination that are both remote, so a both-remote pair yields a deferred spec carrying the route and an :exec-mode marker; Phase 6 runs rsync on a host or routes through the local machine per the route. OPTS carries :sources and :route." (if (and (duet--remote-endpoint-p src) (duet--remote-endpoint-p dst)) (list :argv nil :exec-mode 'rsync-remote-to-remote :route (plist-get opts :route)) (duet--rsync-local-command src dst (plist-get opts :sources)))) (defun duet--tramp-handles (_src _dst) "Score TRAMP: the universal fallback, costlier than a native transport." 100) (defun duet--tramp-command (_src _dst opts) "Build the in-process TRAMP transfer spec from OPTS. TRAMP copies in process rather than spawning a CLI, so there is no argv; the :tramp marker tells the executor to use the in-process path." (list :argv nil :tramp t :sources (plist-get opts :sources) :destination (plist-get opts :destination))) (defconst duet--rsync-failure-patterns '((:match "[Pp]ermission denied" :class permission-denied :cause "The destination rejected the write (permission denied)." :next-actions (fix-permissions) :safety "Source unchanged.") (:match "No space left on device" :class destination-full :cause "The destination filesystem is full." :next-actions (free-space retry) :safety "Source unchanged; the destination may hold a partial.") (:match "\\(protocol version mismatch\\|unexpected tag\\|is your shell clean\\)" :class rsync-protocol-mismatch :cause "The remote shell printed text that corrupted rsync's protocol stream." :next-actions (run-doctor) :safety "Source unchanged.")) "Known rsync stderr signatures mapped to DUET failure classes.") (defun duet--register-builtin-backends () "Register the stage-1 built-in backends: rsync, with TRAMP as the fallback. Idempotent: re-registering replaces the prior definitions." (duet-register-backend (duet-backend-create :name 'tramp :handles #'duet--tramp-handles :command #'duet--tramp-command :capabilities '() :redaction '("\\(://[^:@/]+:\\)[^@]+@") :cleanup :none)) (duet-register-backend (duet-backend-create :name 'rsync :handles #'duet--rsync-handles :command #'duet--rsync-command :capabilities '(:async t :resume t :progress t) :redaction :none :cleanup :verifiable :normalizer (duet-define-cli-failure-patterns duet--rsync-failure-patterns)))) (duet--register-builtin-backends) ;;; Transfer-spec assembly (defun duet--transfer-spec (sources destination-directory &optional opts) "Build a transfer-spec plist to copy SOURCES into DESTINATION-DIRECTORY. SOURCES is a list of source paths; the first is representative for backend selection and routing. Classify both endpoints, select the lowest-cost backend, determine the route, and delegate argv construction to that backend's command builder. Return nil when no backend handles the pair." (let* ((src (duet--classify-path (car sources))) (dst (duet--classify-path destination-directory)) (backend (duet--select-backend src dst))) (when backend (let* ((route (duet--transfer-route src dst opts)) (bopts (append (list :sources sources :destination destination-directory :route route) opts)) (cmd (funcall (duet-backend-command backend) src dst bopts))) (list :sources sources :destination-directory destination-directory :destination-name (plist-get opts :destination-name) :backend (duet-backend-name backend) :route route :src-endpoint src :dst-endpoint dst :argv (plist-get cmd :argv) :tramp (plist-get cmd :tramp) :exec-mode (plist-get cmd :exec-mode) :default-directory (plist-get cmd :default-directory) :process-environment (plist-get cmd :process-environment) :async (if (plist-member opts :async) (plist-get opts :async) t)))))) ;;; Conflict and move planning (pure, prompt-free) (defun duet--unique-name (dest existing-p) "Return a free basename near DEST, probing candidates with EXISTING-P. Append \" (N)\" before the extension, incrementing N until EXISTING-P reports the candidate path free. Return the basename only." (let* ((dir (file-name-directory dest)) (base (file-name-base dest)) (ext (file-name-extension dest t)) (n 1) (candidate (concat dir base " (" (number-to-string n) ")" ext))) (while (funcall existing-p candidate) (setq n (1+ n) candidate (concat dir base " (" (number-to-string n) ")" ext))) (file-name-nondirectory candidate))) (defun duet--conflict-entry (src dst action existing-p) "Return a conflict-plan entry for SRC/DST resolved with ACTION. A `rename' action gets a computed free :new-name via EXISTING-P." (if (eq action 'rename) (list :source src :dest dst :action 'rename :new-name (duet--unique-name dst existing-p)) (list :source src :dest dst :action action))) (defun duet--plan-conflicts (items existing-p resolver) "Return a per-item action plan for ITEMS, prompt-free. ITEMS is a list of (SOURCE . DEST). EXISTING-P, called on a DEST, reports whether it already exists. RESOLVER, called on a colliding (SOURCE . DEST), returns an action (`overwrite', `skip', or `rename') or a cons (ACTION . all) to apply ACTION to every remaining collision without being called again. Non-colliding items plan a plain `copy'. Each entry is a plist \(:source :dest :action [:new-name]); no file is touched." (let ((sticky nil) (plan nil)) (dolist (item items (nreverse plan)) (let ((src (car item)) (dst (cdr item))) (if (not (funcall existing-p dst)) (push (list :source src :dest dst :action 'copy) plan) (let ((action (or sticky (funcall resolver item)))) (when (and (consp action) (eq (cdr action) 'all)) (setq sticky (car action) action (car action))) (push (duet--conflict-entry src dst action existing-p) plan))))))) (defun duet--plan-move (sources) "Return a move plan for SOURCES, prompt-free. Each source yields a copy step followed by a delete step gated on that source's copy success, so a source is never deleted before its copy is confirmed. Return a flat list of step plists in execution order." (apply #'append (mapcar (lambda (s) (list (list :op 'copy :source s) (list :op 'delete :source s :gate 'copy-success))) sources))) ;;;###autoload (defun duet () "Launch the DUET dual-pane file commander." (interactive) (user-error "DUET is not yet implemented; see the design document")) (provide 'duet) ;;; duet.el ends here