diff options
Diffstat (limited to 'lisp/erc/erc-dcc.el')
| -rw-r--r-- | lisp/erc/erc-dcc.el | 147 |
1 files changed, 101 insertions, 46 deletions
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 8158c0999d3..a31f87b4933 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))) @@ -451,7 +474,12 @@ type and nick are optional." ?n (erc-extract-nick (plist-get ret :nick)))))) t)) -(defun erc-dcc-do-GET-command (proc nick &optional file) +(defun erc-dcc-do-GET-command (proc nick &rest file) + "Do a DCC GET command. NICK is the person who is sending the file. +FILE is the filename. If FILE is split into multiple arguments, +re-join the arguments, separated by a space. +PROC is the server process." + (setq file (and file (mapconcat #'identity file " "))) (let* ((elt (erc-dcc-member :nick nick :type 'GET)) (filename (or file (plist-get elt :file) "unknown"))) (if elt @@ -524,8 +552,11 @@ It lists the current state of `erc-dcc-list' in an easy to read manner." 'dcc-list-end) t)) -(defun erc-dcc-do-SEND-command (proc nick file) - "Offer FILE to NICK by sending a ctcp dcc send message." +(defun erc-dcc-do-SEND-command (proc nick &rest file) + "Offer FILE to NICK by sending a ctcp dcc send message. +If FILE is split into multiple arguments, re-join the arguments, +separated by a space." + (setq file (and file (mapconcat #'identity file " "))) (if (file-exists-p file) (progn (erc-display-message @@ -698,7 +729,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 +744,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 +772,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 +797,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 +842,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 +868,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 +879,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 +894,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 +902,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 +922,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 +941,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 +951,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 +1183,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 |