erc-dcc.el

Revision 4220, 43.7 kB (checked in by miyoshi, 9 months ago)
Sync up with Emacs22.2.

Line
1	;;; erc-dcc.el --- CTCP DCC module for ERC
2
3	;; Copyright (C) 1993, 1994, 1995, 1998, 2002, 2003, 2004, 2006, 2007, 2008
4	;; Free Software Foundation, Inc.
5
6	;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
7	;; Noah Friedman <friedman@prep.ai.mit.edu>
8	;; Per Persson <pp@sno.pp.se>
9	;; Maintainer: mlang@delysid.org
10	;; Keywords: comm, processes
11	;; Created: 1994-01-23
12
13	;; This file is part of GNU Emacs.
14
15	;; GNU Emacs is free software; you can redistribute it and/or modify
16	;; it under the terms of the GNU General Public License as published by
17	;; the Free Software Foundation; either version 3, or (at your option)
18	;; any later version.
19
20	;; GNU Emacs is distributed in the hope that it will be useful,
21	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23	;; GNU General Public License for more details.
24
25	;; You should have received a copy of the GNU General Public License
26	;; along with GNU Emacs; see the file COPYING. If not, write to the
27	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28	;; Boston, MA 02110-1301, USA.
29
30	;;; Commentary:
31
32	;; This file provides Direct Client-to-Client support for ERC.
33	;;
34	;; The original code was taken from zenirc-dcc.el, heavily mangled and
35	;; rewritten to support the way how ERC operates. Server socket support
36	;; was added for DCC CHAT and SEND afterwards. Thanks
37	;; to the original authors for their work.
38
39	;;; Usage:
40
41	;; To use this file, put
42	;; (require 'erc-dcc)
43	;; in your .emacs.
44	;;
45	;; Provided commands
46	;; /dcc chat nick - Either accept pending chat offer from nick, or offer
47	;; DCC chat to nick
48	;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick
49	;; /dcc get nick [file] - Accept DCC offer from nick
50	;; /dcc list - List all DCC offers/connections
51	;; /dcc send nick file - Offer DCC SEND to nick
52	;;
53	;; Please note that offering DCC connections (offering chats and sending
54	;; files) is only supported with Emacs 22.
55
56	;;; Code:
57
58	(require 'erc)
59	(eval-when-compile
60	(require 'cl)
61	(require 'pcomplete))
62
63	(defgroup erc-dcc nil
64	"DCC stands for Direct Client Communication, where you and your
65	friend's client programs connect directly to each other,
66	bypassing IRC servers and their occasional \"lag\" or \"split\"
67	problems. Like /MSG, the DCC chat is completely private.
68
69	Using DCC get and send, you can transfer files directly from and to other
70	IRC users."
71	:group 'erc)
72
73	(defcustom erc-verbose-dcc t
74	*"If non-nil, be verbose about DCC activity reporting."**
75	:group 'erc-dcc
76	:type 'boolean)
77
78	(defvar erc-dcc-list nil
79	"List of DCC connections. Looks like:
80	((:nick \"nick!user@host\" :type GET :peer proc :parent proc :size size :file file)
81	(:nick \"nick!user@host\" :type CHAT :peer proc :parent proc)
82	(:nick \"nick\" :type SEND :peer server-proc :parent parent-proc :file
83	file :sent <marker> :confirmed <marker>))
84
85	:nick - a user or userhost for the peer. combine with :parent to reach them
86
87	:type - the type of DCC connection - SEND for outgoing files, GET for
88	incoming, and CHAT for both directions. To tell which end started
89	the DCC chat, look at :peer
90
91	:peer - the other end of the DCC connection. In the case of outgoing DCCs,
92	this represents a server process until a connection is established
93
94	:parent - the server process where the dcc connection was established.
95	Note that this can be nil or an invalid process since a DCC
96	connection is in general independent from a particular server
97	connection after it was established.
98
99	:file - for outgoing sends, the full path to the file. for incoming sends,
100	the suggested filename or vetted filename
101
102	:size - size of the file, may be nil on incoming DCCs")
103
104	(defun erc-dcc-list-add (type nick peer parent &rest args)
105	"Add a new entry of type TYPE to `erc-dcc-list' and return it."
106	(car
107	(setq erc-dcc-list
108	(cons
109	(append (list :nick nick :type type :peer peer :parent parent) args)
110	erc-dcc-list))))
111
112	;; This function takes all the usual args as open-network-stream, plus one
113	;; more: the entry data from erc-dcc-list for this particular process.
114	(defvar erc-dcc-connect-function 'erc-dcc-open-network-stream)
115
116	(defun erc-dcc-open-network-stream (procname buffer addr port entry)
117	(if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes
118	;; cvs emacs
119	(open-network-stream-nowait procname buffer addr port)
120	(open-network-stream procname buffer addr port)))
121
122	(erc-define-catalog
123	'english
124	'((dcc-chat-discarded
125	. "DCC: previous chat request from %n (%u@%h) discarded")
126	(dcc-chat-ended . "DCC: chat with %n ended %t: %e")
127	(dcc-chat-no-request . "DCC: chat request from %n not found")
128	(dcc-chat-offered . "DCC: chat offered by %n (%u@%h:%p)")
129	(dcc-chat-offer . "DCC: offering chat to %n")
130	(dcc-chat-accept . "DCC: accepting chat from %n")
131	(dcc-chat-privmsg . "=%n= %m")
132	(dcc-closed . "DCC: Closed %T from %n")
133	(dcc-command-undefined
134	. "DCC: %c undefined subcommand. GET, CHAT and LIST are defined.")
135	(dcc-ctcp-errmsg . "DCC: `%s' is not a DCC subcommand known to this client")
136	(dcc-ctcp-unknown . "DCC: unknown dcc command `%q' from %n (%u@%h)")
137	(dcc-get-bytes-received . "DCC: %f: %b bytes received")
138	(dcc-get-complete
139	. "DCC: file %f transfer complete (%s bytes in %t seconds)")
140	(dcc-get-cmd-aborted . "DCC: Aborted getting %f from %n")
141	(dcc-get-file-too-long
142	. "DCC: %f: File longer than sender claimed; aborting transfer")
143	(dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer")
144	(dcc-list-head . "DCC: From Type Active Size Filename")
145	(dcc-list-line . "DCC: -------- ---- ------ ------------ --------")
146	(dcc-list-item . "DCC: %-8n %-4t %-6a %-12s %f")
147	(dcc-list-end . "DCC: End of list.")
148	(dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q")
149	(dcc-privileged-port
150	. "DCC: possibly bogus request: %p is a privileged port.")
151	(dcc-request-bogus . "DCC: bogus dcc `%r' from %n (%u@%h)")
152	(dcc-send-finished . "DCC: SEND of %f to %n finished (size %s)")
153	(dcc-send-offered . "DCC: file %f offered by %n (%u@%h) (size %s)")
154	(dcc-send-offer . "DCC: offering %f to %n")))
155
156	;;; Misc macros and utility functions
157
158	(defun erc-dcc-member (&rest args)
159	"Return the first matching entry in `erc-dcc-list' which satisfies the
160	constraints given as a plist in ARGS. Returns nil on no match.
161
162	The property :nick is treated specially, if it contains a '!' character,
163	it is treated as a nick!user@host string, and compared with the :nick property
164	value of the individual elements using string-equal. Otherwise it is
165	compared with `erc-nick-equal-p' which is IRC case-insensitive."
166	(let ((list erc-dcc-list)
167	result test)
168	;; for each element in erc-dcc-list
169	(while (and list (not result))
170	(let ((elt (car list))
171	(prem args)
172	(cont t))
173	;; loop through the constraints
174	(while (and prem cont)
175	(let ((prop (car prem))
176	(val (cadr prem)))
177	(setq prem (cddr prem)
178	;; plist-member is a predicate in xemacs
179	test (and (plist-member elt prop)
180	(plist-get elt prop)))
181	;; if the property exists and is equal, we continue, else, try the
182	;; next element of the list
183	(or (and (eq prop :nick) (string-match "!" val)
184	test (string-equal test val))
185	(and (eq prop :nick)
186	test val
187	(erc-nick-equal-p
188	(erc-extract-nick test)
189	(erc-extract-nick val)))
190	;; not a nick
191	(eq test val)
192	(setq cont nil))))
193	(if cont
194	(setq result elt)
195	(setq list (cdr list)))))
196	result))
197
198	;; msa wrote this nifty little frob to convert an n-byte integer to a packed
199	;; string.
200	(defun erc-pack-int (value count)
201	(if (> count 0)
202	(concat (erc-pack-int (/ value 256) (1- count))
203	(char-to-string (% value 256)))
204	""))
205
206	(defun erc-unpack-int (str)
207	"Unpack a 1-4 character packed string into an integer."
208	(let ((len (length str))
209	(num 0)
210	(count 0))
211	(erc-assert (<= len 4)) ;; this isn't going to fit in elisp bounds
212	(while (< count len)
213	(setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
214	(setq count (1+ count)))
215	num))
216
217	(defconst erc-dcc-ipv4-regexp
218	(concat "^"
219	(mapconcat #'identity (make-list 4 "\$[0-9]\\{1,3\\}\$") "\\.")
220	"$"))
221
222	(defun erc-ip-to-decimal (ip)
223	"Convert IP address to its decimal representation.
224	Argument IP is the address as a string. The result is also a string."
225	(interactive "sIP Address: ")
226	(if (not (string-match erc-dcc-ipv4-regexp ip))
227	(error "Not an IP address")
228	(let* ((ips (mapcar
229	(lambda (str)
230	(let ((n (string-to-number str)))
231	(if (and (>= n 0) (< n 256))
232	n
233	(error "%d out of range" n))))
234	(split-string ip "\\.")))
235	(res (+ (* (car ips) 16777216.0)
236	(* (nth 1 ips) 65536.0)
237	(* (nth 2 ips) 256.0)
238	(nth 3 ips))))
239	(if (interactive-p)
240	(message "%s is %.0f" ip res)
241	(format "%.0f" res)))))
242
243	(defun erc-decimal-to-ip (dec)
244	"Convert a decimal representation DEC to an IP address.
245	The result is also a string."
246	(when (stringp dec)
247	(setq dec (string-to-number (concat dec ".0"))))
248	(let* ((first (floor (/ dec 16777216.0)))
249	(first-rest (- dec (* first 16777216.0)))
250	(second (floor (/ first-rest 65536.0)))
251	(second-rest (- first-rest (* second 65536.0)))
252	(third (floor (/ second-rest 256.0)))
253	(third-rest (- second-rest (* third 256.0)))
254	(fourth (floor third-rest)))
255	(format "%s.%s.%s.%s" first second third fourth)))
256
257	;;; Server code
258
259	(defcustom erc-dcc-host nil
260	*"IP address to use for outgoing DCC offers.**
261	Should be set to a string or nil, if nil, automatic detection of the
262	host interface to use will be attempted."
263	:group 'erc-dcc
264	:type (list 'choice (list 'const :tag "Auto-detect" nil)
265	(list 'string :tag "IP-address"
266	:valid-regexp erc-dcc-ipv4-regexp)))
267
268	(defcustom erc-dcc-send-request 'ask
269	*"How to treat incoming DCC Send requests.**
270	'ask - Report the Send request, and wait for the user to manually accept it
271	You might want to set `erc-dcc-auto-masks' for this.
272	'auto - Automatically accept the request and begin downloading the file
273	'ignore - Ignore incoming DCC Send requests completely."
274	:group 'erc-dcc
275	:type '(choice (const ask) (const auto) (const ignore)))
276
277	(defun erc-dcc-get-host (proc)
278	"Returns the local IP address used for an open PROCess."
279	(format-network-address (process-contact proc :local) t))
280
281	(defun erc-dcc-host ()
282	"Determine the IP address we are using.
283	If variable `erc-dcc-host' is non-nil, use it. Otherwise call
284	`erc-dcc-get-host' on the erc-server-process."
285	(or erc-dcc-host (erc-dcc-get-host erc-server-process)
286	(error "Unable to determine local address")))
287
288	(defcustom erc-dcc-port-range nil
289	"If nil, any available user port is used for outgoing DCC connections.
290	If set to a cons, it specifies a range of ports to use in the form (min . max)"
291	:group 'erc-dcc
292	:type '(choice
293	(const :tag "Any port" nil)
294	(cons :tag "Port range"
295	(integer :tag "Lower port")
296	(integer :tag "Upper port"))))
297
298	(defcustom erc-dcc-auto-masks nil
299	"List of regexps matching user identifiers whose DCC send offers should be
300	accepted automatically. A user identifier has the form \"nick!login@host\".
301	For instance, to accept all incoming DCC send offers automatically, add the
302	*string \".!.@.\" to this list."**
303	:group 'erc-dcc
304	:type '(repeat regexp))
305
306	(defun erc-dcc-server (name filter sentinel)
307	"Start listening on a port for an incoming DCC connection. Returns the newly
308	created subprocess, or nil."
309	(let ((port (or (and erc-dcc-port-range (car erc-dcc-port-range)) t))
310	(upper (and erc-dcc-port-range (cdr erc-dcc-port-range)))
311	process)
312	(while (not process)
313	(condition-case err
314	(setq process
315	(make-network-process :name name
316	:buffer nil
317	:host (erc-dcc-host)
318	:service port
319	:nowait t
320	:noquery nil
321	:filter filter
322	:sentinel sentinel
323	:log #'erc-dcc-server-accept
324	:server t))
325	(file-error
326	(unless (and (string= "Cannot bind server socket" (cadr err))
327	(string= "address already in use" (caddr err)))
328	(signal (car err) (cdr err)))
329	(setq port (1+ port))
330	(unless (< port upper)
331	(error "No available ports in erc-dcc-port-range")))))
332	process))
333
334	(defun erc-dcc-server-accept (server client message)
335	"Log an accepted DCC offer, then terminate the listening process and set up
336	the accepted connection."
337	(erc-log (format "(erc-dcc-server-accept): server %s client %s message %s"
338	server client message))
339	(when (and (string-match "^accept from " message)
340	(processp server) (processp client))
341	(let ((elt (erc-dcc-member :peer server)))
342	;; change the entry in erc-dcc-list from the listening process to the
343	;; accepted process
344	(setq elt (plist-put elt :peer client))
345	;; delete the listening process, as we've accepted the connection
346	(delete-process server))))
347
348	;;; Interactive command handling
349
350	(defcustom erc-dcc-get-default-directory nil
351	*"Default directory for incoming DCC file transfers.**
352	If this is nil, then the current value of `default-directory' is used."
353	:group 'erc-dcc
354	:type '(choice (const nil :tag "Default directory") directory))
355
356	;;;###autoload
357	(defun erc-cmd-DCC (cmd &rest args)
358	"Parser for /dcc command.
359	This figures out the dcc subcommand and calls the appropriate routine to
360	handle it. The function dispatched should be named \"erc-dcc-do-FOO-command\",
361	where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
362	(when cmd
363	(let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command"))))
364	(if fn
365	(apply fn erc-server-process args)
366	(erc-display-message
367	nil 'notice 'active
368	'dcc-command-undefined ?c cmd)
369	(apropos *"erc-dcc-do-.-command"**)
370	t))))
371
372	;;;###autoload
373	(defun pcomplete/erc-mode/DCC ()
374	"Provides completion for the /DCC command."
375	(pcomplete-here (append '("chat" "close" "get" "list")
376	(when (fboundp 'make-network-process) '("send"))))
377	(pcomplete-here
378	(case (intern (downcase (pcomplete-arg 1)))
379	(chat (mapcar (lambda (elt) (plist-get elt :nick))
380	(erc-remove-if-not
381	#'(lambda (elt)
382	(eq (plist-get elt :type) 'CHAT))
383	erc-dcc-list)))
384	(close (remove-duplicates
385	(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
386	erc-dcc-list) :test 'string=))
387	(get (mapcar #'erc-dcc-nick
388	(erc-remove-if-not
389	#'(lambda (elt)
390	(eq (plist-get elt :type) 'GET))
391	erc-dcc-list)))
392	(send (pcomplete-erc-all-nicks))))
393	(pcomplete-here
394	(case (intern (downcase (pcomplete-arg 2)))
395	(get (mapcar (lambda (elt) (plist-get elt :file))
396	(erc-remove-if-not
397	#'(lambda (elt)
398	(and (eq (plist-get elt :type) 'GET)
399	(erc-nick-equal-p (erc-extract-nick
400	(plist-get elt :nick))
401	(pcomplete-arg 1))))
402	erc-dcc-list)))
403	(close (mapcar #'erc-dcc-nick
404	(erc-remove-if-not
405	#'(lambda (elt)
406	(eq (plist-get elt :type)
407	(intern (upcase (pcomplete-arg 1)))))
408	erc-dcc-list)))
409	(send (pcomplete-entries)))))
410
411	(defun erc-dcc-do-CHAT-command (proc &optional nick)
412	(when nick
413	(let ((elt (erc-dcc-member :nick nick :type 'CHAT :parent proc)))
414	(if (and elt (not (processp (plist-get elt :peer))))
415	;; accept an existing chat offer
416	;; FIXME: perhaps /dcc accept like other clients?
417	(progn (erc-dcc-chat-accept elt erc-server-process)
418	(erc-display-message
419	nil 'notice 'active
420	'dcc-chat-accept ?n nick)
421	t)
422	(erc-dcc-chat nick erc-server-process)
423	(erc-display-message
424	nil 'notice 'active
425	'dcc-chat-offer ?n nick)
426	t))))
427
428	(defun erc-dcc-do-CLOSE-command (proc &optional type nick)
429	"/dcc close type nick
430	type and nick are optional."
431	;; FIXME, should also work if only nick is specified
432	(when (string-match (concat *"^\\s-\$\\S-+\$? \\("*
433	erc-valid-nick-regexp *"\\)?\\s-$"**) line)
434	(let ((type (when (match-string 1 line)
435	(intern (upcase (match-string 1 line)))))
436	(nick (match-string 2 line))
437	(ret t))
438	(while ret
439	(if nick
440	(setq ret (erc-dcc-member :type type :nick nick))
441	(setq ret (erc-dcc-member :type type)))
442	(when ret
443	;; found a match - delete process if it exists.
444	(and (processp (plist-get ret :peer))
445	(delete-process (plist-get ret :peer)))
446	(setq erc-dcc-list (delq ret erc-dcc-list))
447	(erc-display-message
448	nil 'notice 'active
449	'dcc-closed
450	?T (plist-get ret :type)
451	?n (erc-extract-nick (plist-get ret :nick))))))
452	t))
453
454	(defun erc-dcc-do-GET-command (proc nick &optional file)
455	(let* ((elt (erc-dcc-member :nick nick :type 'GET))
456	(filename (or file (plist-get elt :file) "unknown")))
457	(if elt
458	(let* ((file (read-file-name
459	(format "Local filename (default %s): "
460	(file-name-nondirectory filename))
461	(or erc-dcc-get-default-directory
462	default-directory)
463	(expand-file-name (file-name-nondirectory filename)
464	(or erc-dcc-get-default-directory
465	default-directory)))))
466	(cond ((file-exists-p file)
467	(if (yes-or-no-p (format "File %s exists. Overwrite? "
468	file))
469	(erc-dcc-get-file elt file proc)
470	(erc-display-message
471	nil '(notice error) proc
472	'dcc-get-cmd-aborted
473	?n nick ?f filename)))
474	(t
475	(erc-dcc-get-file elt file proc))))
476	(erc-display-message
477	nil '(notice error) 'active
478	'dcc-get-notfound ?n nick ?f filename))))
479
480	(defun erc-dcc-do-LIST-command (proc)
481	"This is the handler for the /dcc list command.
482	It lists the current state of `erc-dcc-list' in an easy to read manner."
483	(let ((alist erc-dcc-list)
484	size elt)
485	(erc-display-message
486	nil 'notice 'active
487	'dcc-list-head)
488	(erc-display-message
489	nil 'notice 'active
490	'dcc-list-line)
491	(while alist
492	(setq elt (car alist)
493	alist (cdr alist))
494
495	(setq size (or (and (plist-member elt :size)
496	(plist-get elt :size))
497	""))
498	(setq size
499	(cond ((null size) "")
500	((numberp size) (number-to-string size))
501	((string= size "") "unknown")))
502	(erc-display-message
503	nil 'notice 'active
504	'dcc-list-item
505	?n (erc-dcc-nick elt)
506	?t (plist-get elt :type)
507	?a (if (processp (plist-get elt :peer))
508	(process-status (plist-get elt :peer))
509	"no")
510	?s (concat size
511	(if (and (eq 'GET (plist-get elt :type))
512	(plist-member elt :file)
513	(buffer-live-p (get-buffer (plist-get elt :file)))
514	(plist-member elt :size))
515	(concat " (" (number-to-string
516	(* 100
517	(/ (buffer-size
518	(get-buffer (plist-get elt :file)))
519	(plist-get elt :size))))
520	"%)")))
521	?f (or (and (plist-member elt :file) (plist-get elt :file)) "")))
522	(erc-display-message
523	nil 'notice 'active
524	'dcc-list-end)
525	t))
526
527	(defun erc-dcc-do-SEND-command (proc nick file)
528	"Offer FILE to NICK by sending a ctcp dcc send message."
529	(if (file-exists-p file)
530	(progn
531	(erc-display-message
532	nil 'notice 'active
533	'dcc-send-offer ?n nick ?f file)
534	(erc-dcc-send-file nick file) t)
535	(erc-display-message nil '(notice error) proc "File not found") t))
536
537	;;; Server message handling (i.e. messages from remote users)
538
539	;;;###autoload
540	(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC)
541	"Hook variable for CTCP DCC queries")
542
543	(defvar erc-dcc-query-handler-alist
544	'(("SEND" . erc-dcc-handle-ctcp-send)
545	("CHAT" . erc-dcc-handle-ctcp-chat)))
546
547	;;;###autoload
548	(defun erc-ctcp-query-DCC (proc nick login host to query)
549	"The function called when a CTCP DCC request is detected by the client.
550	It examines the DCC subcommand, and calls the appropriate routine for
551	that subcommand."
552	(let* ((cmd (cadr (split-string query " ")))
553	(handler (cdr (assoc cmd erc-dcc-query-handler-alist))))
554	(if handler
555	(funcall handler proc query nick login host to)
556	;; FIXME: Send a ctcp error notice to the remote end?
557	(erc-display-message
558	nil '(notice error) proc
559	'dcc-ctcp-unknown
560	?q query ?n nick ?u login ?h host))))
561
562	(defconst erc-dcc-ctcp-query-send-regexp
563	*"^DCC SEND \$[^ ]+\$ \$[0-9]+\$ \$[0-9]+\$ \$[0-9]\$"*)
564
565	(defun erc-dcc-handle-ctcp-send (proc query nick login host to)
566	"This is called if a CTCP DCC SEND subcommand is sent to the client.
567	It extracts the information about the dcc request and adds it to
568	`erc-dcc-list'."
569	(unless (eq erc-dcc-send-request 'ignore)
570	(cond
571	((not (erc-current-nick-p to))
572	;; DCC SEND requests must be sent to you, and you alone.
573	(erc-display-message
574	nil 'notice proc
575	'dcc-request-bogus
576	?r "SEND" ?n nick ?u login ?h host))
577	((string-match erc-dcc-ctcp-query-send-regexp query)
578	(let ((filename (match-string 1 query))
579	(ip (erc-decimal-to-ip (match-string 2 query)))
580	(port (match-string 3 query))
581	(size (match-string 4 query)))
582	;; FIXME: a warning really should also be sent
583	;; if the ip address != the host the dcc sender is on.
584	(erc-display-message
585	nil 'notice proc
586	'dcc-send-offered
587	?f filename ?n nick ?u login ?h host
588	?s (if (string= size "") "unknown" size))
589	(and (< (string-to-number port) 1025)
590	(erc-display-message
591	nil 'notice proc
592	'dcc-privileged-port
593	?p port))
594	(erc-dcc-list-add
595	'GET (format "%s!%s@%s" nick login host)
596	nil proc
597	:ip ip :port port :file filename
598	:size (string-to-number size))
599	(if (and (eq erc-dcc-send-request 'auto)
600	(erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host)))
601	(erc-dcc-get-file (car erc-dcc-list) filename proc))))
602	(t
603	(erc-display-message
604	nil 'notice proc
605	'dcc-malformed
606	?n nick ?u login ?h host ?q query)))))
607
608	(defun erc-dcc-auto-mask-p (spec)
609	"Takes a full SPEC of a user in the form \"nick!login@host\" and
610	matches against all the regexp's in `erc-dcc-auto-masks'. If any
611	match, returns that regexp and nil otherwise."
612	(let ((lst erc-dcc-auto-masks))
613	(while (and lst
614	(not (string-match (car lst) spec)))
615	(setq lst (cdr lst)))
616	(and lst (car lst))))
617
618	(defconst erc-dcc-ctcp-query-chat-regexp
619	"^DCC CHAT +chat +\$[0-9]+\$ +\$[0-9]+\$")
620
621	(defcustom erc-dcc-chat-request 'ask
622	*"How to treat incoming DCC Chat requests.**
623	'ask - Report the Chat request, and wait for the user to manually accept it
624	'auto - Automatically accept the request and open a new chat window
625	'ignore - Ignore incoming DCC chat requests completely."
626	:group 'erc-dcc
627	:type '(choice (const ask) (const auto) (const ignore)))
628
629	(defun erc-dcc-handle-ctcp-chat (proc query nick login host to)
630	(unless (eq erc-dcc-chat-request 'ignore)
631	(cond
632	(;; DCC CHAT requests must be sent to you, and you alone.
633	(not (erc-current-nick-p to))
634	(erc-display-message
635	nil '(notice error) proc
636	'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host))
637	((string-match erc-dcc-ctcp-query-chat-regexp query)
638	;; We need to use let here, since erc-dcc-member might clutter*
639	;; the match value.
640	(let* ((ip (erc-decimal-to-ip (match-string 1 query)))
641	(port (match-string 2 query))
642	(elt (erc-dcc-member :nick nick :type 'CHAT)))
643	;; FIXME: A warning really should also be sent if the ip
644	;; address != the host the dcc sender is on.
645	(erc-display-message
646	nil 'notice proc
647	'dcc-chat-offered
648	?n nick ?u login ?h host ?p port)
649	(and (< (string-to-number port) 1025)
650	(erc-display-message
651	nil 'notice proc
652	'dcc-privileged-port ?p port))
653	(cond (elt
654	;; XXX: why are we updating ip/port on the existing connection?
655	(setq elt (plist-put (plist-put elt :port port) :ip ip))
656	(erc-display-message
657	nil 'notice proc
658	'dcc-chat-discarded ?n nick ?u login ?h host))
659	(t
660	(erc-dcc-list-add
661	'CHAT (format "%s!%s@%s" nick login host)
662	nil proc
663	:ip ip :port port)))
664	(if (eq erc-dcc-chat-request 'auto)
665	(erc-dcc-chat-accept (erc-dcc-member :nick nick :type 'CHAT)
666	proc))))
667	(t
668	(erc-display-message
669	nil '(notice error) proc
670	'dcc-malformed ?n nick ?u login ?h host ?q query)))))
671
672
673	(defvar erc-dcc-entry-data nil
674	"Holds the `erc-dcc-list' entry for this DCC connection.")
675	(make-variable-buffer-local 'erc-dcc-entry-data)
676
677	;;; SEND handling
678
679	(defcustom erc-dcc-block-size 1024
680	*"Block size to use for DCC SEND sessions."**
681	:group 'erc-dcc
682	:type 'integer)
683
684	(defcustom erc-dcc-pump-bytes nil
685	*"If set to an integer, keep sending until that number of bytes are**
686	unconfirmed."
687	:group 'erc-dcc
688	:type '(choice (const nil) integer))
689
690	(defsubst erc-dcc-get-parent (proc)
691	(plist-get (erc-dcc-member :peer proc) :parent))
692
693	(defun erc-dcc-send-block (proc)
694	"Send one block of data.
695	PROC is the process-object of the DCC connection. Returns the number of
696	bytes sent."
697	(let* ((elt (erc-dcc-member :peer proc))
698	(confirmed-marker (plist-get elt :sent))
699	(sent-marker (plist-get elt :sent)))
700	(with-current-buffer (process-buffer proc)
701	(when erc-verbose-dcc
702	(erc-display-message
703	nil 'notice (erc-dcc-get-parent proc)
704	(format "DCC: Confirmed %d, sent %d, sending block now"
705	(- confirmed-marker (point-min))
706	(- sent-marker (point-min)))))
707	(let* ((end (min (+ sent-marker erc-dcc-block-size)
708	(point-max)))
709	(string (buffer-substring-no-properties sent-marker end)))
710	(when (< sent-marker end)
711	(set-marker sent-marker end)
712	(process-send-string proc string))
713	(length string)))))
714
715	(defun erc-dcc-send-filter (proc string)
716	(erc-assert (= (% (length string) 4) 0))
717	(let* ((size (erc-unpack-int (substring string (- (length string) 4))))
718	(elt (erc-dcc-member :peer proc))
719	(parent (plist-get elt :parent))
720	(sent-marker (plist-get elt :sent))
721	(confirmed-marker (plist-get elt :confirmed)))
722	(with-current-buffer (process-buffer proc)
723	(set-marker confirmed-marker (+ (point-min) size))
724	(cond
725	((and (= confirmed-marker sent-marker)
726	(= confirmed-marker (point-max)))
727	(erc-display-message
728	nil 'notice parent
729	'dcc-send-finished
730	?n (plist-get elt :nick)
731	?f buffer-file-name
732	?s (number-to-string (- sent-marker (point-min))))
733	(setq erc-dcc-list (delete elt erc-dcc-list))
734	(set-buffer-modified-p nil)
735	(kill-buffer (current-buffer))
736	(delete-process proc))
737	((<= confirmed-marker sent-marker)
738	(while (and (< (- sent-marker confirmed-marker)
739	(or erc-dcc-pump-bytes
740	erc-dcc-block-size))
741	(> (erc-dcc-send-block proc) 0))))
742	((> confirmed-marker sent-marker)
743	(erc-display-message
744	nil 'notice parent
745	(format "DCC: Client confirmed too much!"))
746	(delete-process proc))))))
747
748	(defcustom erc-dcc-send-connect-hook
749	'((lambda (proc)
750	(erc-display-message
751	nil 'notice (erc-dcc-get-parent proc)
752	(format "DCC: SEND connect from %s"
753	(format-network-address (process-contact proc :remote)))))
754	erc-dcc-send-block)
755	*"Hook run whenever the remote end of a DCC SEND offer connected to your**
756	listening port."
757	:group 'erc-dcc
758	:type 'hook)
759
760	(defun erc-dcc-nick (plist)
761	"Extract the nickname portion of the :nick property value in PLIST."
762	(erc-extract-nick (plist-get plist :nick)))
763
764	(defun erc-dcc-send-sentinel (proc event)
765	(let* ((elt (erc-dcc-member :peer proc))
766	(buf (marker-buffer (plist-get elt :sent))))
767	(cond
768	((string-match "^open from " event)
769	(when elt
770	(with-current-buffer buf
771	(set-process-buffer proc buf)
772	(setq erc-dcc-entry-data elt))
773	(run-hook-with-args 'erc-dcc-send-connect-hook proc))))))
774
775	(defun erc-dcc-find-file (file)
776	(with-current-buffer (generate-new-buffer (file-name-nondirectory file))
777	(insert-file-contents-literally file)
778	(setq buffer-file-name file)
779	(current-buffer)))
780
781	(defun erc-dcc-file-to-name (file)
782	(with-temp-buffer
783	(insert (file-name-nondirectory file))
784	(subst-char-in-region (point-min) (point-max) ? ?_ t)
785	(buffer-string)))
786
787	(defun erc-dcc-send-file (nick file &optional pproc)
788	"Open a socket for incoming connections, and send a CTCP send request to the
789	other client."
790	(interactive "sNick: \nfFile: ")
791	(when (null pproc) (if (processp erc-server-process)
792	(setq pproc erc-server-process)
793	(error "Can not find parent process")))
794	(if (featurep 'make-network-process)
795	(let* ((buffer (erc-dcc-find-file file))
796	(size (buffer-size buffer))
797	(start (with-current-buffer buffer
798	(set-marker (make-marker) (point-min))))
799	(sproc (erc-dcc-server "dcc-send"
800	'erc-dcc-send-filter
801	'erc-dcc-send-sentinel))
802	(contact (process-contact sproc)))
803	(erc-dcc-list-add
804	'SEND nick sproc pproc
805	:file file :size size
806	:sent start :confirmed (copy-marker start))
807	(process-send-string
808	pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n"
809