ERC: Sync version 5.3, release candidate 1.

1 files changed, 90 insertions, 43 deletions

diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 8158c0999d3..2aca06479f6 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -60,6 +60,12 @@
   (require 'cl)
   (require 'pcomplete))
 
+;;;###autoload (autoload 'erc-dcc-mode "erc-dcc")
+(define-erc-module dcc nil
+  "Provide Direct Client-to-Client support for ERC."
+  ((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))
+  ((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)))
+
 (defgroup erc-dcc nil
   "DCC stands for Direct Client Communication, where you and your
 friend's client programs connect directly to each other,
@@ -70,7 +76,7 @@ Using DCC get and send, you can transfer files directly from and to other
 IRC users."
   :group 'erc)
 
-(defcustom erc-verbose-dcc t
+(defcustom erc-dcc-verbose nil
   "*If non-nil, be verbose about DCC activity reporting."
   :group 'erc-dcc
   :type 'boolean)
@@ -195,20 +201,22 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive."
           (setq list (cdr list)))))
     result))
 
-;; msa wrote this nifty little frob to convert an n-byte integer to a packed
-;; string.
-(defun erc-pack-int (value count)
-  (if (> count 0)
-      (concat (erc-pack-int (/ value 256) (1- count))
-              (char-to-string (% value 256)))
-    ""))
+(defun erc-pack-int (value)
+  "Convert an integer into a packed string."
+  (let* ((len (ceiling (/ value 256.0)))
+         (str (make-string len ?a))
+         (i (1- len)))
+    (while (>= i 0)
+      (aset str i (% value 256))
+      (setq value (/ value 256))
+      (setq i (1- i)))
+    str))
 
 (defun erc-unpack-int (str)
-  "Unpack a 1-4 character packed string into an integer."
+  "Unpack a packed string into an integer."
   (let ((len (length str))
         (num 0)
         (count 0))
-    (erc-assert (<= len 4)) ;; this isn't going to fit in elisp bounds
     (while (< count len)
       (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
       (setq count (1+ count)))
@@ -256,15 +264,24 @@ The result is also a string."
 
 ;;; Server code
 
-(defcustom erc-dcc-host nil
-  "*IP address to use for outgoing DCC offers.
-Should be set to a string or nil, if nil, automatic detection of the
-host interface to use will be attempted."
+(defcustom erc-dcc-listen-host nil
+  "IP address to listen on when offering files.
+Should be set to a string or nil.  If nil, automatic detection of
+the host interface to use will be attempted."
   :group 'erc-dcc
   :type (list 'choice (list 'const :tag "Auto-detect" nil)
               (list 'string :tag "IP-address"
                     :valid-regexp erc-dcc-ipv4-regexp)))
 
+(defcustom erc-dcc-public-host nil
+  "IP address to use for outgoing DCC offers.
+Should be set to a string or nil.  If nil, use the value of
+`erc-dcc-listen-host'."
+  :group 'erc-dcc
+  :type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil)
+              (list 'string :tag "IP-address"
+                    :valid-regexp erc-dcc-ipv4-regexp)))
+
 (defcustom erc-dcc-send-request 'ask
   "*How to treat incoming DCC Send requests.
 'ask - Report the Send request, and wait for the user to manually accept it
@@ -282,7 +299,7 @@ host interface to use will be attempted."
   "Determine the IP address we are using.
 If variable `erc-dcc-host' is non-nil, use it.  Otherwise call
 `erc-dcc-get-host' on the erc-server-process."
-  (or erc-dcc-host (erc-dcc-get-host erc-server-process)
+  (or erc-dcc-listen-host (erc-dcc-get-host erc-server-process)
       (error "Unable to determine local address")))
 
 (defcustom erc-dcc-port-range nil
@@ -311,6 +328,7 @@ created subprocess, or nil."
         process)
     (while (not process)
       (condition-case err
+          (progn
             (setq process
                   (make-network-process :name name
                                         :buffer nil
@@ -322,6 +340,11 @@ created subprocess, or nil."
                                         :sentinel sentinel
                                         :log #'erc-dcc-server-accept
                                         :server t))
+            (when (processp process)
+              (when (fboundp 'set-process-coding-system)
+                (set-process-coding-system process 'binary 'binary))
+              (when (fboundp 'set-process-filter-multibyte)
+                (set-process-filter-multibyte process nil))))
         (file-error
          (unless (and (string= "Cannot bind server socket" (cadr err))
                       (string= "address already in use" (caddr err)))
@@ -698,7 +721,7 @@ bytes sent."
          (confirmed-marker (plist-get elt :sent))
          (sent-marker (plist-get elt :sent)))
     (with-current-buffer (process-buffer proc)
-      (when erc-verbose-dcc
+      (when erc-dcc-verbose
         (erc-display-message
          nil 'notice (erc-dcc-get-parent proc)
          (format "DCC: Confirmed %d, sent %d, sending block now"
@@ -713,8 +736,7 @@ bytes sent."
         (length string)))))
 
 (defun erc-dcc-send-filter (proc string)
-  (erc-assert (= (% (length string) 4) 0))
-  (let* ((size (erc-unpack-int (substring string (- (length string) 4))))
+  (let* ((size (erc-unpack-int string))
          (elt (erc-dcc-member :peer proc))
          (parent (plist-get elt :parent))
          (sent-marker (plist-get elt :sent))
@@ -742,16 +764,21 @@ bytes sent."
        ((> confirmed-marker sent-marker)
         (erc-display-message
          nil 'notice parent
-         (format "DCC: Client confirmed too much!"))
+         (format "DCC: Client confirmed too much (%s vs %s)!"
+                 (marker-position confirmed-marker)
+                 (marker-position sent-marker)))
+        (set-buffer-modified-p nil)
+        (kill-buffer (current-buffer))
         (delete-process proc))))))
 
+(defun erc-dcc-display-send (proc)
+  (erc-display-message
+   nil 'notice (erc-dcc-get-parent proc)
+   (format "DCC: SEND connect from %s"
+           (format-network-address (process-contact proc :remote)))))
+
 (defcustom erc-dcc-send-connect-hook
-  '((lambda (proc)
-      (erc-display-message
-       nil 'notice (erc-dcc-get-parent proc)
-       (format "DCC: SEND connect from %s"
-               (format-network-address (process-contact proc :remote)))))
-    erc-dcc-send-block)
+  '(erc-dcc-display-send erc-dcc-send-block)
   "*Hook run whenever the remote end of a DCC SEND offer connected to your
 listening port."
   :group 'erc-dcc
@@ -762,14 +789,14 @@ listening port."
   (erc-extract-nick (plist-get plist :nick)))
 
 (defun erc-dcc-send-sentinel (proc event)
-  (let* ((elt (erc-dcc-member :peer proc))
-         (buf (marker-buffer (plist-get elt :sent))))
+  (let* ((elt (erc-dcc-member :peer proc)))
     (cond
      ((string-match "^open from " event)
       (when elt
-        (with-current-buffer buf
-          (set-process-buffer proc buf)
-          (setq erc-dcc-entry-data elt))
+        (let ((buf (marker-buffer (plist-get elt :sent))))
+          (with-current-buffer buf
+            (set-process-buffer proc buf)
+            (setq erc-dcc-entry-data elt)))
         (run-hook-with-args 'erc-dcc-send-connect-hook proc))))))
 
 (defun erc-dcc-find-file (file)
@@ -807,15 +834,23 @@ other client."
         (process-send-string
          pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n"
                        nick (erc-dcc-file-to-name file)
-                       (erc-ip-to-decimal (nth 0 contact))
+                       (erc-ip-to-decimal (or erc-dcc-public-host
+                                              (nth 0 contact)))
                        (nth 1 contact)
                        size)))
     (error "`make-network-process' not supported by your Emacs")))
 
 ;;; GET handling
 
+(defcustom erc-dcc-receive-cache (* 1024 512)
+  "Number of bytes to let the receive buffer grow before flushing it."
+  :group 'erc-dcc
+  :type 'integer)
+
 (defvar erc-dcc-byte-count nil)
 (make-variable-buffer-local 'erc-dcc-byte-count)
+(defvar erc-dcc-file-name nil)
+(make-variable-buffer-local 'erc-dcc-file-name)
 
 (defun erc-dcc-get-file (entry file parent-proc)
   "This function does the work of setting up a transfer from the remote client
@@ -825,6 +860,7 @@ filter and a process sentinel, and making the connection."
          proc)
     (with-current-buffer buffer
       (fundamental-mode)
+      (buffer-disable-undo (current-buffer))
       ;; This is necessary to have the buffer saved as-is in GNU
       ;; Emacs.
       ;; XEmacs change: We don't have `set-buffer-multibyte', setting
@@ -835,7 +871,10 @@ filter and a process sentinel, and making the connection."
       (setq mode-line-process '(":%s")
             buffer-file-type t
             buffer-read-only t)
-      (set-visited-file-name file)
+      (setq erc-dcc-file-name file)
+
+      ;; Truncate the given file to size 0 before appending to it.
+      (write-region (point) (point) erc-dcc-file-name nil 'nomessage)
 
       (setq erc-server-process parent-proc
             erc-dcc-entry-data entry)
@@ -847,7 +886,6 @@ filter and a process sentinel, and making the connection."
                      (string-to-number (plist-get entry :port))
                      entry))
       (set-process-buffer proc buffer)
-      ;; The following two lines make saving as-is work under Windows
       (set-process-coding-system proc 'binary 'binary)
       (set-buffer-file-coding-system 'binary t)
 
@@ -856,6 +894,14 @@ filter and a process sentinel, and making the connection."
       (setq entry (plist-put entry :start-time (erc-current-time)))
       (setq entry (plist-put entry :peer proc)))))
 
+(defun erc-dcc-append-contents (buffer file)
+  "Append the contents of BUFFER to FILE.
+The contents of the BUFFER will then be erased."
+  (with-current-buffer buffer
+    (let ((coding-system-for-write 'binary))
+      (write-region (point-min) (point-max) erc-dcc-file-name t 'nomessage)
+      (erase-buffer))))
+
 (defun erc-dcc-get-filter (proc str)
   "This is the process filter for transfers from other clients to this one.
 It reads incoming bytes from the network and stores them in the DCC
@@ -868,8 +914,10 @@ rather than every 1024 byte block, but nobody seems to care."
       (insert (string-make-unibyte str))
 
       (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count))
-      (erc-assert (= erc-dcc-byte-count (1- (point-max))))
-      (and erc-verbose-dcc
+      (when (> (point-max) erc-dcc-receive-cache)
+        (erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
+
+      (and erc-dcc-verbose
            (erc-display-message
             nil 'notice erc-server-process
             'dcc-get-bytes-received
@@ -885,7 +933,7 @@ rather than every 1024 byte block, but nobody seems to care."
         (delete-process proc))
        (t
         (process-send-string
-         proc (erc-pack-int erc-dcc-byte-count 4)))))))
+         proc (erc-pack-int erc-dcc-byte-count)))))))
 
 
 (defun erc-dcc-get-sentinel (proc event)
@@ -895,17 +943,18 @@ transfer is complete."
   ;; FIXME, we should look at EVENT, and also check size.
   (with-current-buffer (process-buffer proc)
     (delete-process proc)
-    (setq buffer-read-only nil)
     (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list))
+    (unless (= (point-min) (point-max))
+      (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count))
+      (erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
     (erc-display-message
      nil 'notice erc-server-process
      'dcc-get-complete
-     ?f (file-name-nondirectory buffer-file-name)
-     ?s (number-to-string (buffer-size))
+     ?f erc-dcc-file-name
+     ?s (number-to-string erc-dcc-byte-count)
      ?t (format "%.0f"
                 (erc-time-diff (plist-get erc-dcc-entry-data :start-time)
-                               (erc-current-time))))
-    (save-buffer))
+                               (erc-current-time)))))
   (kill-buffer (process-buffer proc))
   (delete-process proc))
 
@@ -1126,8 +1175,6 @@ other client."
       (if (processp peer) (delete-process peer)))
     nil))
 
-(add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)
-
 (provide 'erc-dcc)
 
 ;;; erc-dcc.el ends here