path: root/duet.el

;;; duet.el --- Dual-pane file commander over dirvish/dired -*- lexical-binding: t -*-

;; Author: Craig Jennings <c@cjennings.net>
;; 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 "<redacted>"
  "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--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 (listp spec)) "command must return a process-spec plist")
       ((plist-get spec :shell-command) "command must not build a shell string; use :argv")
       ((not (listp (plist-get spec :argv))) "command :argv must be an argument list")))))

(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))))))

;;;###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