+2008-10-03 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el (english): Increase size heading by two places.
+ (erc-dcc-byte-count): Move higher.
+ (erc-dcc-do-LIST-command): Use erc-dcc-byte-count to get accurate
+ count. Coerce byte total to floating point before performing
+ computation, otherwise division will truncate to 0.
+ (erc-dcc-append-contents): Update erc-dcc-byte-count.
+ (erc-dcc-get-filter): Don't update erc-dcc-byte-count, because
+ that will give incorrect size totals. Instead, figure out how
+ much we have by summing byte count and current buffer size.
+ (erc-dcc-get-sentinel): Don't update erc-dcc-byte-count.
+
+2008-10-01 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el (erc-pack-int): Make sure returned string is within 4
+ bytes. Always return a 4-byte string, so that we conform to the
+ CTCP spec.
+ (erc-most-positive-int-bytes): New constant representing the
+ number of bytes that most-positive-fixnum can be stored in.
+ (erc-most-positive-int-msb): New constant representing the
+ contents of the most significant byte of most-positive-fixnum.
+ (erc-unpack-int): Make sure that the integer we get back can be
+ represented in Emacs.
+ (erc-dcc-do-CLOSE-command): Update docstring. Don't use the line
+ variable. Try to disambiguate between type and nick when only one
+ is provided. Validate both type and nick arguments. Allow
+ matching by just nick.
+ (erc-dcc-append-contents): Set inhibit-read-only to t. Prevent
+ auto-compression from triggering when we write the contents to a
+ file.
+ (erc-dcc-get-file): Prevent auto-compression from triggering when
+ we truncate a file.
+
2008-07-27 Dan Nicolaescu <dann@ics.uci.edu>
* erc.el: Remove code for Carbon.
:group 'erc-dcc
:type 'boolean)
+(defconst erc-dcc-connection-types
+ '("CHAT" "GET" "SEND")
+ "List of valid DCC connection types.
+All values of the list must be uppercase strings.")
+
(defvar erc-dcc-list nil
"List of DCC connections. Looks like:
((:nick \"nick!user@host\" :type GET :peer proc :parent proc :size size :file file)
(dcc-get-file-too-long
. "DCC: %f: File longer than sender claimed; aborting transfer")
(dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer")
- (dcc-list-head . "DCC: From Type Active Size Filename")
- (dcc-list-line . "DCC: -------- ---- ------ ------------ --------")
- (dcc-list-item . "DCC: %-8n %-4t %-6a %-12s %f")
+ (dcc-list-head . "DCC: From Type Active Size Filename")
+ (dcc-list-line . "DCC: -------- ---- ------ -------------- --------")
+ (dcc-list-item . "DCC: %-8n %-4t %-6a %-14s %f")
(dcc-list-end . "DCC: End of list.")
(dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q")
(dcc-privileged-port
result))
(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)
+ "Convert an integer into a packed string in network byte order,
+which is big-endian."
+ ;; make sure value is not negative
+ (when (< value 0)
+ (error "ERC-DCC (erc-pack-int): packet size is negative"))
+ ;; make sure size is not larger than 4 bytes
+ (let ((len (if (= value 0) 0
+ (ceiling (/ (ceiling (/ (log value) (log 2))) 8.0)))))
+ (when (> len 4)
+ (error "ERC-DCC (erc-pack-int): packet too large")))
+ ;; pack
+ (let ((str (make-string 4 0))
+ (i 3))
+ (while (and (>= i 0) (> value 0))
(aset str i (% value 256))
(setq value (/ value 256))
(setq i (1- i)))
str))
+(defconst erc-most-positive-int-bytes
+ (ceiling (/ (ceiling (/ (log most-positive-fixnum) (log 2))) 8.0))
+ "Maximum number of bytes for a fixnum.")
+
+(defconst erc-most-positive-int-msb
+ (lsh most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes))))
+ "Content of the most significant byte of most-positive-fixnum.")
+
(defun erc-unpack-int (str)
"Unpack a packed string into an integer."
- (let ((len (length str))
- (num 0)
- (count 0))
- (while (< count len)
- (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
- (setq count (1+ count)))
- num))
+ (let ((len (length str)))
+ ;; strip leading 0-bytes
+ (let ((start 0))
+ (while (and (> len start) (eq (aref str start) 0))
+ (setq start (1+ start)))
+ (when (> start 0)
+ (setq str (substring str start))
+ (setq len (- len start))))
+ ;; make sure size is not larger than Emacs can handle
+ (when (or (> len (min 4 erc-most-positive-int-bytes))
+ (and (eq len erc-most-positive-int-bytes)
+ (> (aref str 0) erc-most-positive-int-msb)))
+ (error "ERC-DCC (erc-unpack-int): packet to send is too large"))
+ ;; unpack
+ (let ((num 0)
+ (count 0))
+ (while (< count len)
+ (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
+ (setq count (1+ count)))
+ num)))
(defconst erc-dcc-ipv4-regexp
(concat "^"
t))))
(defun erc-dcc-do-CLOSE-command (proc &optional type nick)
- "/dcc close type nick
-type and nick are optional."
- ;; FIXME, should also work if only nick is specified
- (when (string-match (concat "^\\s-*\\(\\S-+\\)? *\\("
- erc-valid-nick-regexp "\\)?\\s-*$") line)
- (let ((type (when (match-string 1 line)
- (intern (upcase (match-string 1 line)))))
- (nick (match-string 2 line))
- (ret t))
+ "Close a connection. Usage: /dcc close type nick.
+At least one of TYPE and NICK must be provided."
+ ;; disambiguate type and nick if only one is provided
+ (when (and type (null nick)
+ (not (member (upcase type) erc-dcc-connection-types)))
+ (setq nick type)
+ (setq type nil))
+ ;; validate nick argument
+ (unless (and nick (string-match (concat "\\`" erc-valid-nick-regexp "\\'")
+ nick))
+ (setq nick nil))
+ ;; validate type argument
+ (if (and type (member (upcase type) erc-dcc-connection-types))
+ (setq type (intern (upcase type)))
+ (setq type nil))
+ (when (or nick type)
+ (let ((ret t))
(while ret
- (if nick
- (setq ret (erc-dcc-member :type type :nick nick))
- (setq ret (erc-dcc-member :type type)))
+ (cond ((and nick type)
+ (setq ret (erc-dcc-member :type type :nick nick)))
+ (nick
+ (setq ret (erc-dcc-member :nick nick)))
+ (type
+ (setq ret (erc-dcc-member :type type)))
+ (t
+ (setq ret nil)))
(when ret
;; found a match - delete process if it exists.
(and (processp (plist-get ret :peer))
'dcc-closed
?T (plist-get ret :type)
?n (erc-extract-nick (plist-get ret :nick))))))
- t))
+ t))
(defun erc-dcc-do-GET-command (proc nick &rest file)
"Do a DCC GET command. NICK is the person who is sending the file.
nil '(notice error) 'active
'dcc-get-notfound ?n nick ?f filename))))
+(defvar erc-dcc-byte-count nil)
+(make-variable-buffer-local 'erc-dcc-byte-count)
+
(defun erc-dcc-do-LIST-command (proc)
"This is the handler for the /dcc list command.
It lists the current state of `erc-dcc-list' in an easy to read manner."
(plist-member elt :file)
(buffer-live-p (get-buffer (plist-get elt :file)))
(plist-member elt :size))
- (concat " (" (number-to-string
+ (let ((byte-count (with-current-buffer
+ (get-buffer (plist-get elt :file))
+ (+ (buffer-size) 0.0
+ erc-dcc-byte-count))))
+ (concat " ("
+ (if (= byte-count 0)
+ "0"
+ (number-to-string
+ (truncate
(* 100
- (/ (buffer-size
- (get-buffer (plist-get elt :file)))
- (plist-get elt :size))))
- "%)")))
+ (/ byte-count (plist-get elt :size))))))
+ "%)"))))
?f (or (and (plist-member elt :file) (plist-get elt :file)) "")))
(erc-display-message
nil 'notice 'active
: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)
(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)
+ (let ((inhibit-file-name-handlers
+ (append '(jka-compr-handler image-file-handler)
+ inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'write-region))
+ (write-region (point) (point) erc-dcc-file-name nil 'nomessage))
(setq erc-server-process parent-proc
erc-dcc-entry-data entry)
"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))
+ (let ((coding-system-for-write 'binary)
+ (inhibit-read-only t)
+ (inhibit-file-name-handlers
+ (append '(jka-compr-handler image-file-handler)
+ inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'write-region))
(write-region (point-min) (point-max) erc-dcc-file-name t 'nomessage)
+ (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count))
(erase-buffer))))
(defun erc-dcc-get-filter (proc str)
protocol spec. Well not really. We write back a reply after each read,
rather than every 1024 byte block, but nobody seems to care."
(with-current-buffer (process-buffer proc)
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ received-bytes)
(goto-char (point-max))
(insert (string-make-unibyte str))
- (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count))
(when (> (point-max) erc-dcc-receive-cache)
(erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
+ (setq received-bytes (+ (buffer-size) erc-dcc-byte-count))
(and erc-dcc-verbose
(erc-display-message
nil 'notice erc-server-process
'dcc-get-bytes-received
?f (file-name-nondirectory buffer-file-name)
- ?b (number-to-string erc-dcc-byte-count)))
+ ?b (number-to-string received-bytes)))
(cond
((and (> (plist-get erc-dcc-entry-data :size) 0)
- (> erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))
+ (> received-bytes (plist-get erc-dcc-entry-data :size)))
(erc-display-message
nil '(error notice) 'active
'dcc-get-file-too-long
(delete-process proc))
(t
(process-send-string
- proc (erc-pack-int erc-dcc-byte-count)))))))
+ proc (erc-pack-int received-bytes)))))))
(defun erc-dcc-get-sentinel (proc event)
(delete-process proc)
(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
projects / emacs.git / commitdiff