;;; erc-dcc.el --- CTCP DCC module for ERC
-;; Copyright (C) 1993, 1994, 1995, 1998, 2002, 2003, 2004, 2006, 2007
+;; Copyright (C) 1993, 1994, 1995, 1998, 2002, 2003, 2004, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(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,
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)
(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)))
;;; 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
"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
process)
(while (not process)
(condition-case err
+ (progn
(setq process
(make-network-process :name name
:buffer 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)))
?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
'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
(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"
(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))
((> 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
(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)
(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
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
(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)
(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)
(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
(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
(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)
;; 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))
(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