lisp/erc/erc-dcc.el

   1 ;;; erc-dcc.el --- CTCP DCC module for ERC
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 1998, 2002, 2003, 2004, 2006, 2007
   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                        nick (erc-dcc-file-to-name file)
 810                        (erc-ip-to-decimal (nth 0 contact))
 811                        (nth 1 contact)
 812                        size)))
 813     (error "`make-network-process' not supported by your Emacs")))
 814
 815 ;;; GET handling
 816
 817 (defvar erc-dcc-byte-count nil)
 818 (make-variable-buffer-local 'erc-dcc-byte-count)
 819
 820 (defun erc-dcc-get-file (entry file parent-proc)
 821   "This function does the work of setting up a transfer from the remote client
 822 to the local one over a tcp connection. This involves setting up a process
 823 filter and a process sentinel, and making the connection."
 824   (let* ((buffer (generate-new-buffer (file-name-nondirectory file)))
 825          proc)
 826     (with-current-buffer buffer
 827       (fundamental-mode)
 828       ;; This is necessary to have the buffer saved as-is in GNU
 829       ;; Emacs.
 830       ;; XEmacs change: We don't have `set-buffer-multibyte', setting
 831       ;; coding system to 'binary below takes care of us.
 832       (when (fboundp 'set-buffer-multibyte)
 833         (set-buffer-multibyte nil))
 834
 835       (setq mode-line-process '(":%s")
 836             buffer-file-type t
 837             buffer-read-only t)
 838       (set-visited-file-name file)
 839
 840       (setq erc-server-process parent-proc
 841             erc-dcc-entry-data entry)
 842       (setq erc-dcc-byte-count 0)
 843       (setq proc
 844             (funcall erc-dcc-connect-function
 845                      "dcc-get" buffer
 846                      (plist-get entry :ip)
 847                      (string-to-number (plist-get entry :port))
 848                      entry))
 849       (set-process-buffer proc buffer)
 850       ;; The following two lines make saving as-is work under Windows
 851       (set-process-coding-system proc 'binary 'binary)
 852       (set-buffer-file-coding-system 'binary t)
 853
 854       (set-process-filter proc 'erc-dcc-get-filter)
 855       (set-process-sentinel proc 'erc-dcc-get-sentinel)
 856       (setq entry (plist-put entry :start-time (erc-current-time)))
 857       (setq entry (plist-put entry :peer proc)))))
 858
 859 (defun erc-dcc-get-filter (proc str)
 860   "This is the process filter for transfers from other clients to this one.
 861 It reads incoming bytes from the network and stores them in the DCC
 862 buffer, and sends back the replies after each block of data per the DCC
 863 protocol spec.  Well not really.  We write back a reply after each read,
 864 rather than every 1024 byte block, but nobody seems to care."
 865   (with-current-buffer (process-buffer proc)
 866     (let ((inhibit-read-only t))
 867       (goto-char (point-max))
 868       (insert (string-make-unibyte str))
 869
 870       (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count))
 871       (erc-assert (= erc-dcc-byte-count (1- (point-max))))
 872       (and erc-verbose-dcc
 873            (erc-display-message
 874             nil 'notice erc-server-process
 875             'dcc-get-bytes-received
 876             ?f (file-name-nondirectory buffer-file-name)
 877             ?b (number-to-string erc-dcc-byte-count)))
 878       (cond
 879        ((and (> (plist-get erc-dcc-entry-data :size) 0)
 880              (> erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))
 881         (erc-display-message
 882          nil '(error notice) 'active
 883          'dcc-get-file-too-long
 884          ?f (file-name-nondirectory buffer-file-name))
 885         (delete-process proc))
 886        (t
 887         (process-send-string
 888          proc (erc-pack-int erc-dcc-byte-count 4)))))))
 889
 890
 891 (defun erc-dcc-get-sentinel (proc event)
 892   "This is the process sentinel for CTCP DCC SEND connections.
 893 It shuts down the connection and notifies the user that the
 894 transfer is complete."
 895   ;; FIXME, we should look at EVENT, and also check size.
 896   (with-current-buffer (process-buffer proc)
 897     (delete-process proc)
 898     (setq buffer-read-only nil)
 899     (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list))
 900     (erc-display-message
 901      nil 'notice erc-server-process
 902      'dcc-get-complete
 903      ?f (file-name-nondirectory buffer-file-name)
 904      ?s (number-to-string (buffer-size))
 905      ?t (format "%.0f"
 906                 (erc-time-diff (plist-get erc-dcc-entry-data :start-time)
 907                                (erc-current-time))))
 908     (save-buffer))
 909   (kill-buffer (process-buffer proc))
 910   (delete-process proc))
 911
 912 ;;; CHAT handling
 913
 914 (defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s"
 915   "*Format to use for DCC Chat buffer names."
 916   :group 'erc-dcc
 917   :type 'string)
 918
 919 (defcustom erc-dcc-chat-mode-hook nil
 920   "*Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
 921   :group 'erc-dcc
 922   :type 'hook)
 923
 924 (defcustom erc-dcc-chat-connect-hook nil
 925   ""
 926   :group 'erc-dcc
 927   :type 'hook)
 928
 929 (defcustom erc-dcc-chat-exit-hook nil
 930   ""
 931   :group 'erc-dcc
 932   :type 'hook)
 933
 934 (defun erc-cmd-CREQ (line &optional force)
 935   "Set or get the DCC chat request flag.
 936 Possible values are: ask, auto, ignore."
 937   (when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
 938     (let ((cmd (match-string 1 line)))
 939       (if (stringp cmd)
 940           (erc-display-message
 941            nil 'notice 'active
 942            (format "Set DCC Chat requests to %S"
 943                    (setq erc-dcc-chat-request (intern cmd))))
 944         (erc-display-message nil 'notice 'active
 945                              (format "DCC Chat requests are set to %S"
 946                                      erc-dcc-chat-request)))
 947       t)))
 948
 949 (defun erc-cmd-SREQ (line &optional force)
 950   "Set or get the DCC send request flag.
 951 Possible values are: ask, auto, ignore."
 952   (when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
 953     (let ((cmd (match-string 1 line)))
 954       (if (stringp cmd)
 955           (erc-display-message
 956            nil 'notice 'active
 957            (format "Set DCC Send requests to %S"
 958                    (setq erc-dcc-send-request (intern cmd))))
 959         (erc-display-message nil 'notice 'active
 960                              (format "DCC Send requests are set to %S"
 961                                      erc-dcc-send-request)))
 962       t)))
 963
 964 (defun pcomplete/erc-mode/CREQ ()
 965   (pcomplete-here '("auto" "ask" "ignore")))
 966 (defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ)
 967
 968 (defvar erc-dcc-chat-filter-hook '(erc-dcc-chat-parse-output)
 969   "*Hook to run after doing parsing (and possible insertion) of DCC messages.")
 970
 971 (defvar erc-dcc-chat-mode-map
 972   (let ((map (make-sparse-keymap)))
 973     (define-key map (kbd "RET") 'erc-send-current-line)
 974     (define-key map "\t" 'erc-complete-word)
 975     map)
 976   "Keymap for `erc-dcc-mode'.")
 977
 978 (defun erc-dcc-chat-mode ()
 979   "Major mode for wasting time via DCC chat."
 980   (interactive)
 981   (kill-all-local-variables)
 982   (setq mode-line-process '(":%s")
 983         mode-name "DCC-Chat"
 984         major-mode 'erc-dcc-chat-mode
 985         erc-send-input-line-function 'erc-dcc-chat-send-input-line
 986         erc-default-recipients '(dcc))
 987   (use-local-map erc-dcc-chat-mode-map)
 988   (run-hooks 'erc-dcc-chat-mode-hook))
 989
 990 (defun erc-dcc-chat-send-input-line (recipient line &optional force)
 991   "Send LINE to the remote end.
 992 Argument RECIPIENT should always be the symbol dcc, and force
 993 is ignored."
 994   ;; FIXME: We need to get rid of all force arguments one day!
 995   (if (eq recipient 'dcc)
 996       (process-send-string
 997        (get-buffer-process (current-buffer)) line)
 998     (error "erc-dcc-chat-send-input-line in %s" (current-buffer))))
 999
1000 (defun erc-dcc-chat (nick &optional pproc)
1001   "Open a socket for incoming connections, and send a chat request to the
1002 other client."
1003   (interactive "sNick: ")
1004   (when (null pproc) (if (processp erc-server-process)
1005                          (setq pproc erc-server-process)
1006                        (error "Can not find parent process")))
1007   (let* ((sproc (erc-dcc-server "dcc-chat-out"
1008                                 'erc-dcc-chat-filter
1009                                 'erc-dcc-chat-sentinel))
1010          (contact (process-contact sproc)))
1011     (erc-dcc-list-add 'OCHAT nick sproc pproc)
1012     (process-send-string pproc
1013      (format "PRIVMSG %s :\C-aDCC CHAT chat %s %d\C-a\n"
1014              nick
1015              (erc-ip-to-decimal (nth 0 contact)) (nth 1 contact)))))
1016
1017 (defvar erc-dcc-from)
1018 (make-variable-buffer-local 'erc-dcc-from)
1019
1020 (defvar erc-dcc-unprocessed-output)
1021 (make-variable-buffer-local 'erc-dcc-unprocessed-output)
1022
1023 (defun erc-dcc-chat-setup (entry)
1024   "Setup a DCC chat buffer, returning the buffer."
1025   (let* ((nick (erc-extract-nick (plist-get entry :nick)))
1026          (buffer (generate-new-buffer
1027                   (format erc-dcc-chat-buffer-name-format nick)))
1028          (proc (plist-get entry :peer))
1029          (parent-proc (plist-get entry :parent)))
1030     (erc-setup-buffer buffer)
1031     ;; buffer is now the current buffer.
1032     (erc-dcc-chat-mode)
1033     (setq erc-server-process parent-proc)
1034     (setq erc-dcc-from nick)
1035     (setq erc-dcc-entry-data entry)
1036     (setq erc-dcc-unprocessed-output "")
1037     (setq erc-insert-marker (set-marker (make-marker) (point-max)))
1038     (setq erc-input-marker (make-marker))
1039     (erc-display-prompt buffer (point-max))
1040     (set-process-buffer proc buffer)
1041     (add-hook 'kill-buffer-hook 'erc-dcc-chat-buffer-killed nil t)
1042     (run-hook-with-args 'erc-dcc-chat-connect-hook proc)
1043     buffer))
1044
1045 (defun erc-dcc-chat-accept (entry parent-proc)
1046   "Accept an incoming DCC connection and open a DCC window"
1047   (let* ((nick (erc-extract-nick (plist-get entry :nick)))
1048          buffer proc)
1049     (setq proc
1050           (funcall erc-dcc-connect-function
1051                    "dcc-chat" nil
1052                    (plist-get entry :ip)
1053                    (string-to-number (plist-get entry :port))
1054                    entry))
1055     ;; XXX: connected, should we kill the ip/port properties?
1056     (setq entry (plist-put entry :peer proc))
1057     (setq entry (plist-put entry :parent parent-proc))
1058     (set-process-filter proc 'erc-dcc-chat-filter)
1059     (set-process-sentinel proc 'erc-dcc-chat-sentinel)
1060     (setq buffer (erc-dcc-chat-setup entry))))
1061
1062 (defun erc-dcc-chat-filter (proc str)
1063   (let ((orig-buffer (current-buffer)))
1064     (unwind-protect
1065         (progn
1066           (set-buffer (process-buffer proc))
1067           (setq erc-dcc-unprocessed-output
1068                 (concat erc-dcc-unprocessed-output str))
1069           (run-hook-with-args 'erc-dcc-chat-filter-hook proc
1070                            erc-dcc-unprocessed-output))
1071       (set-buffer orig-buffer))))
1072
1073 (defun erc-dcc-chat-parse-output (proc str)
1074   (save-match-data
1075     (let ((posn 0)
1076           line)
1077       (while (string-match "\n" str posn)
1078         (setq line (substring str posn (match-beginning 0)))
1079         (setq posn (match-end 0))
1080         (erc-display-message
1081          nil nil proc
1082          'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'face
1083                                               'erc-nick-default-face) ?m line))
1084       (setq erc-dcc-unprocessed-output (substring str posn)))))
1085
1086 (defun erc-dcc-chat-buffer-killed ()
1087   (erc-dcc-chat-close "killed buffer"))
1088
1089 (defun erc-dcc-chat-close (&optional event)
1090   "Close a DCC chat, removing any associated processes and tidying up
1091 `erc-dcc-list'"
1092   (let ((proc (plist-get erc-dcc-entry-data :peer))
1093         (evt (or event "")))
1094     (when proc
1095       (setq erc-dcc-list (delq erc-dcc-entry-data erc-dcc-list))
1096       (run-hook-with-args 'erc-dcc-chat-exit-hook proc)
1097       (delete-process proc)
1098       (erc-display-message
1099        nil 'notice erc-server-process
1100        'dcc-chat-ended ?n erc-dcc-from ?t (current-time-string) ?e evt)
1101       (setq erc-dcc-entry-data (plist-put erc-dcc-entry-data :peer nil)))))
1102
1103 (defun erc-dcc-chat-sentinel (proc event)
1104   (let ((buf (current-buffer))
1105         (elt (erc-dcc-member :peer proc)))
1106     ;; the sentinel is also notified when the connection is opened, so don't
1107     ;; immediately kill it again
1108     ;(message "buf %s elt %S evt %S" buf elt event)
1109     (unwind-protect
1110         (if (string-match "^open from" event)
1111             (erc-dcc-chat-setup elt)
1112           (erc-dcc-chat-close event))
1113       (set-buffer buf))))
1114
1115 (defun erc-dcc-no-such-nick (proc parsed)
1116   "Detect and handle no-such-nick replies from the IRC server."
1117   (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed))
1118                               :parent proc))
1119          (peer (plist-get elt :peer)))
1120     (when (or (and (processp peer) (not (eq (process-status peer) 'open)))
1121               elt)
1122       ;; Since we already created an entry before sending the CTCP
1123       ;; message, we now remove it, if it doesn't point to a process
1124       ;; which is already open.
1125       (setq erc-dcc-list (delq elt erc-dcc-list))
1126       (if (processp peer) (delete-process peer)))
1127     nil))
1128
1129 (add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)
1130
1131 (provide 'erc-dcc)
1132
1133 ;;; erc-dcc.el ends here
1134 ;;
1135 ;; Local Variables:
1136 ;; indent-tabs-mode: nil
1137 ;; End:
1138
1139 ;; arch-tag: cda5a6b3-c510-4dbe-b699-84cccfa04edb