master 73b40d8716 5/5: Recognize DCC SSEND when receiving files in erc-dcc

[F. Jason Park]

branch: master
commit 73b40d8716f6416f75689d3e2442f365130f45b9
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Recognize DCC SSEND when receiving files in erc-dcc
    
    * lips/erc/erc-dcc.el (erc-dcc-open-network-stream): Use TLS
    for new connections when :secure flag is set.
    (erc-dcc-do-GET-command): Set secure flag when user explicitly passes
    an "-s" option.
    (erc-dcc-do-LIST-command): Show an "s" to indicate a secure connection
    when applicable.
    (erc-dcc-query-handler-alist): Add extra items for "SSEND", etc.
    (erc-dcc-handle-ctcp-send): Set secure flag when a leading "S" appears
    in the command type.
---
 lisp/erc/erc-dcc.el            | 22 +++++++++++++++++-----
 test/lisp/erc/erc-dcc-tests.el |  3 ++-
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 918ae9dc97..ff486b2d4e 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -43,7 +43,7 @@
 ;;  /dcc chat nick - Either accept pending chat offer from nick, or offer
 ;;                   DCC chat to nick
 ;;  /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick
-;;  /dcc get [-t] nick [file] - Accept DCC offer from nick
+;;  /dcc get [-t][-s] nick [file] - Accept DCC offer from nick
 ;;  /dcc list - List all DCC offers/connections
 ;;  /dcc send nick file - Offer DCC SEND to nick
 
@@ -107,6 +107,8 @@ Looks like:
 
  :size - size of the file, may be nil on incoming DCCs
 
+ :secure - optional item indicating sender support for TLS
+
  :turbo - optional item indicating sender support for TSEND")
 
 (defun erc-dcc-list-add (type nick peer parent &rest args)
@@ -121,12 +123,13 @@ Looks like:
 ;; more: the entry data from erc-dcc-list for this particular process.
 (defvar erc-dcc-connect-function 'erc-dcc-open-network-stream)
 
-(defun erc-dcc-open-network-stream (procname buffer addr port _entry)
+(defun erc-dcc-open-network-stream (procname buffer addr port entry)
   ;; FIXME: Time to try activating this again!?
   (if nil;  (fboundp 'open-network-stream-nowait)  ;; this currently crashes
                                                    ;; cvs emacs
       (open-network-stream-nowait procname buffer addr port)
-    (open-network-stream procname buffer addr port)))
+    (open-network-stream procname buffer addr port
+                         :type (and (plist-get entry :secure) 'tls))))
 
 (erc-define-catalog
  'english
@@ -534,6 +537,9 @@ PROC is the server process."
                     ?n nick ?f filename)))
                 (t
                  (erc-dcc-get-file elt file proc)))
+          (when (member "-s" flags)
+            (setq erc-dcc-list (cons (plist-put elt :secure t)
+                                     (delq elt erc-dcc-list))))
           (when (member "-t" flags)
             (setq erc-dcc-list (cons (plist-put elt :turbo t)
                                      (delq elt erc-dcc-list)))))
@@ -574,6 +580,7 @@ It lists the current state of `erc-dcc-list' in an easy to 
read manner."
               (process-status (plist-get elt :peer))
             "no")
        ?s (concat size
+                  ;; FIXME consider uniquified names, e.g., foo.bin<2>
                   (if (and (eq 'GET (plist-get elt :type))
                            (plist-member elt :file)
                            (buffer-live-p (get-buffer (plist-get elt :file)))
@@ -587,7 +594,7 @@ It lists the current state of `erc-dcc-list' in an easy to 
read manner."
                                        (plist-get elt :size))))))
        ?f (or (and (plist-member elt :file) (plist-get elt :file)) "")
        ?u (if-let* ((flags (concat (and (plist-get elt :turbo) "t")
-                                   (and (plist-get elt :placeholder) "p")))
+                                   (and (plist-get elt :secure) "s")))
                     ((not (string-empty-p flags))))
               (concat " (" flags ")")
             "")))
@@ -618,6 +625,9 @@ separated by a space."
 (defvar erc-dcc-query-handler-alist
   '(("SEND" . erc-dcc-handle-ctcp-send)
     ("TSEND" . erc-dcc-handle-ctcp-send)
+    ("SSEND" . erc-dcc-handle-ctcp-send)
+    ("TSSEND" . erc-dcc-handle-ctcp-send)
+    ("STSEND" . erc-dcc-handle-ctcp-send)
     ("CHAT" . erc-dcc-handle-ctcp-chat)))
 
 ;;;###autoload
@@ -676,6 +686,7 @@ It extracts the information about the dcc request and adds 
it to
              (port (match-string 4 query))
              (size (match-string 5 query))
              (sub (substring (match-string 6 query) 0 -4))
+             (secure (seq-contains-p sub ?S #'eq))
              (turbo (seq-contains-p sub ?T #'eq)))
         ;; FIXME: a warning really should also be sent
         ;; if the ip address != the host the dcc sender is on.
@@ -694,7 +705,8 @@ It extracts the information about the dcc request and adds 
it to
          nil proc
          :ip ip :port port :file filename
          :size (string-to-number size)
-         :turbo (and turbo t))
+         :turbo (and turbo t)
+         :secure (and secure t))
         (if (and (eq erc-dcc-send-request 'auto)
                  (erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host)))
             (erc-dcc-get-file (car erc-dcc-list) filename proc))))
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index 58011201cd..a10cbfc02c 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -75,7 +75,8 @@
                            :port "9899"
                            :file "foo"
                            :size 1405135128
-                           :turbo ,(and turbo t))))
+                           :turbo ,(and turbo t)
+                           :secure nil)))
     (goto-char (point-min))
     (should (search-forward "file foo offered by tester" nil t))
     (erc-dcc-do-LIST-command erc-server-process)