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
   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 2, 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 ;; To use this file, put
  40 ;;  (require 'erc-dcc)
  41 ;; in your .emacs.
  42 ;;
  43 ;; Provided commands
  44 ;;  /dcc chat nick - Either accept pending chat offer from nick, or offer
  45 ;;                   DCC chat to nick
  46 ;;  /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick
  47 ;;  /dcc get nick [file] - Accept DCC offer from nick
  48 ;;  /dcc list - List all DCC offers/connections
  49 ;;  /dcc send nick file - Offer DCC SEND to nick
  50 ;;
  51 ;; Please note that offering DCC connections (offering chats and sending
  52 ;; files) is only supported with Emacs 21.3.50 (CVS).
  53
  54 ;;; Code:
  55
  56 (require 'erc)
  57 (eval-when-compile
  58   (require 'cl)
  59   (require 'pcomplete))
  60
  61 (defgroup erc-dcc nil
  62   "DCC stands for Direct Client Communication, where you and your
  63 friend's client programs connect directly to each other,
  64 bypassing IRC servers and their occasional \"lag\" or \"split\"
  65 problems.  Like /MSG, the DCC chat is completely private.
  66
  67 Using DCC get and send, you can transfer files directly from and to other
  68 IRC users."
  69   :group 'erc)
  70
  71 (defcustom erc-verbose-dcc t
  72   "*If non-nil, be verbose about DCC activity reporting."
  73   :group 'erc-dcc
  74   :type 'boolean)
  75
  76 (defvar erc-dcc-list nil
  77   "List of DCC connections. Looks like:
  78   ((:nick \"nick!user@host\" :type GET :peer proc :parent proc :size size :file file)
  79    (:nick \"nick!user@host\" :type CHAT :peer proc :parent proc)
  80    (:nick \"nick\" :type SEND :peer server-proc :parent parent-proc :file
  81    file :sent <marker> :confirmed <marker>))
  82
  83  :nick - a user or userhost for the peer. combine with :parent to reach them
  84
  85  :type - the type of DCC connection - SEND for outgoing files, GET for
  86          incoming, and CHAT for both directions. To tell which end started
  87          the DCC chat, look at :peer
  88
  89  :peer - the other end of the DCC connection. In the case of outgoing DCCs,
  90          this represents a server process until a connection is established
  91
  92  :parent - the server process where the dcc connection was established.
  93            Note that this can be nil or an invalid process since a DCC
  94            connection is in general independent from a particular server
  95            connection after it was established.
  96
  97  :file - for outgoing sends, the full path to the file. for incoming sends,
  98          the suggested filename or vetted filename
  99
 100  :size - size of the file, may be nil on incoming DCCs")
 101
 102 (defun erc-dcc-list-add (type nick peer parent &rest args)
 103   "Add a new entry of type TYPE to `erc-dcc-list' and return it."
 104   (car
 105    (setq erc-dcc-list
 106          (cons
 107           (append (list :nick nick :type type :peer peer :parent parent) args)
 108           erc-dcc-list))))
 109
 110 ;; This function takes all the usual args as open-network-stream, plus one
 111 ;; more: the entry data from erc-dcc-list for this particular process.
 112 (defvar erc-dcc-connect-function 'erc-dcc-open-network-stream)
 113
 114 (defun erc-dcc-open-network-stream (procname buffer addr port entry)
 115   (if nil;  (fboundp 'open-network-stream-nowait)  ;; this currently crashes
 116                                                    ;; cvs emacs
 117       (open-network-stream-nowait procname buffer addr port)
 118     (open-network-stream procname buffer addr port)))
 119
 120 (erc-define-catalog
 121  'english
 122  '((dcc-chat-discarded
 123     . "DCC: previous chat request from %n (%u@%h) discarded")
 124    (dcc-chat-ended . "DCC: chat with %n ended %t: %e")
 125    (dcc-chat-no-request . "DCC: chat request from %n not found")
 126    (dcc-chat-offered . "DCC: chat offered by %n (%u@%h:%p)")
 127    (dcc-chat-offer . "DCC: offering chat to %n")
 128    (dcc-chat-accept . "DCC: accepting chat from %n")
 129    (dcc-chat-privmsg . "=%n= %m")
 130    (dcc-closed . "DCC: Closed %T from %n")
 131    (dcc-command-undefined
 132     . "DCC: %c undefined subcommand. GET, CHAT and LIST are defined.")
 133    (dcc-ctcp-errmsg . "DCC: `%s' is not a DCC subcommand known to this client")
 134    (dcc-ctcp-unknown . "DCC: unknown dcc command `%q' from %n (%u@%h)")
 135    (dcc-get-bytes-received . "DCC: %f: %b bytes received")
 136    (dcc-get-complete
 137     . "DCC: file %f transfer complete (%s bytes in %t seconds)")
 138    (dcc-get-cmd-aborted . "DCC: Aborted getting %f from %n")
 139    (dcc-get-file-too-long
 140     . "DCC: %f: File longer than sender claimed; aborting transfer")
 141    (dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer")
 142    (dcc-list-head . "DCC: From      Type  Active  Size          Filename")
 143    (dcc-list-line . "DCC: --------  ----  ------  ------------  --------")
 144    (dcc-list-item . "DCC: %-8n  %-4t  %-6a  %-12s  %f")
 145    (dcc-list-end  . "DCC: End of list.")
 146    (dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q")
 147    (dcc-privileged-port
 148     . "DCC: possibly bogus request: %p is a privileged port.")
 149    (dcc-request-bogus . "DCC: bogus dcc `%r' from %n (%u@%h)")
 150    (dcc-send-finished . "DCC: SEND of %f to %n finished (size %s)")
 151    (dcc-send-offered . "DCC: file %f offered by %n (%u@%h) (size %s)")
 152    (dcc-send-offer . "DCC: offering %f to %n")))
 153
 154 ;;; Misc macros and utility functions
 155
 156 (defun erc-dcc-member (&rest args)
 157   "Return the first matching entry in `erc-dcc-list' which satisfies the
 158 constraints given as a plist in ARGS. Returns nil on no match.
 159
 160 The property :nick is treated specially, if it contains a '!' character,
 161 it is treated as a nick!user@host string, and compared with the :nick property
 162 value of the individual elements using string-equal. Otherwise it is
 163 compared with `erc-nick-equal-p' which is IRC case-insensitive."
 164   (let ((list erc-dcc-list)
 165         result test)
 166     ;; for each element in erc-dcc-list
 167     (while (and list (not result))
 168       (let ((elt (car list))
 169             (prem args)
 170             (cont t))
 171         ;; loop through the constraints
 172         (while (and prem cont)
 173           (let ((prop (car prem))
 174                 (val (cadr prem)))
 175             (setq prem (cddr prem)
 176                   ;; plist-member is a predicate in xemacs
 177                   test (and (plist-member elt prop)
 178                             (plist-get elt prop)))
 179             ;; if the property exists and is equal, we continue, else, try the
 180             ;; next element of the list
 181             (or (and (eq prop :nick) (string-match "!" val)
 182                      test (string-equal test val))
 183                 (and (eq prop :nick)
 184                      test val
 185                      (erc-nick-equal-p
 186                       (erc-extract-nick test)
 187                       (erc-extract-nick val)))
 188                 ;; not a nick
 189                 (eq test val)
 190                 (setq cont nil))))
 191         (if cont
 192             (setq result elt)
 193           (setq list (cdr list)))))
 194     result))
 195
 196 ;; msa wrote this nifty little frob to convert an n-byte integer to a packed
 197 ;; string.
 198 (defun erc-pack-int (value count)
 199   (if (> count 0)
 200       (concat (erc-pack-int (/ value 256) (1- count))
 201               (char-to-string (% value 256)))
 202     ""))
 203
 204 (defun erc-unpack-int (str)
 205   "Unpack a 1-4 character packed string into an integer."
 206   (let ((len (length str))
 207         (num 0)
 208         (count 0))
 209     (erc-assert (<= len 4)) ;; this isn't going to fit in elisp bounds
 210     (while (< count len)
 211       (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
 212       (setq count (1+ count)))
 213     num))
 214
 215 (defconst erc-dcc-ipv4-regexp
 216   (concat "^"
 217           (mapconcat #'identity (make-list 4 "\\([0-9]\\{1,3\\}\\)") "\\.")
 218           "$"))
 219
 220 (defun erc-ip-to-decimal (ip)
 221   "Convert IP address to its decimal representation.
 222 Argument IP is the address as a string.  The result is also a string."
 223   (interactive "sIP Address: ")
 224   (if (not (string-match erc-dcc-ipv4-regexp ip))
 225       (error "Not an IP address")
 226     (let* ((ips (mapcar
 227                  (lambda (str)
 228                    (let ((n (string-to-number str)))
 229                      (if (and (>= n 0) (< n 256))
 230                          n
 231                        (error "%d out of range" n))))
 232                  (split-string ip "\\.")))
 233            (res (+ (* (car ips) 16777216.0)
 234                    (* (nth 1 ips) 65536.0)
 235                    (* (nth 2 ips) 256.0)
 236                    (nth 3 ips))))
 237       (if (interactive-p)
 238           (message "%s is %.0f" ip res)
 239         (format "%.0f" res)))))
 240
 241 (defun erc-decimal-to-ip (dec)
 242   "Convert a decimal representation DEC to an IP address.
 243 The result is also a string."
 244   (when (stringp dec)
 245     (setq dec (string-to-number (concat dec ".0"))))
 246   (let* ((first (floor (/ dec 16777216.0)))
 247          (first-rest (- dec (* first 16777216.0)))
 248          (second (floor (/ first-rest 65536.0)))
 249          (second-rest (- first-rest (* second 65536.0)))
 250          (third (floor (/ second-rest 256.0)))
 251          (third-rest (- second-rest (* third 256.0)))
 252          (fourth (floor third-rest)))
 253     (format "%s.%s.%s.%s" first second third fourth)))
 254
 255 ;;; Server code
 256
 257 (defcustom erc-dcc-host nil
 258   "*IP address to use for outgoing DCC offers.
 259 Should be set to a string or nil, if nil, automatic detection of the
 260 host interface to use will be attempted."
 261   :group 'erc-dcc
 262   :type (list 'choice (list 'const :tag "Auto-detect" nil)
 263               (list 'string :tag "IP-address"
 264                     :valid-regexp erc-dcc-ipv4-regexp)))
 265
 266 (defcustom erc-dcc-send-request 'ask
 267   "*How to treat incoming DCC Send requests.
 268 'ask - Report the Send request, and wait for the user to manually accept it
 269        You might want to set `erc-dcc-auto-masks' for this.
 270 'auto - Automatically accept the request and begin downloading the file
 271 'ignore - Ignore incoming DCC Send requests completely."
 272   :group 'erc-dcc
 273   :type '(choice (const ask) (const auto) (const ignore)))
 274
 275 (defun erc-dcc-get-host (proc)
 276   "Returns the local IP address used for an open PROCess."
 277   (format-network-address (process-contact proc :local) t))
 278
 279 (defun erc-dcc-host ()
 280   "Determine the IP address we are using.
 281 If variable `erc-dcc-host' is non-nil, use it.  Otherwise call
 282 `erc-dcc-get-host' on the erc-server-process."
 283   (or erc-dcc-host (erc-dcc-get-host erc-server-process)
 284       (error "Unable to determine local address")))
 285
 286 (defcustom erc-dcc-port-range nil
 287   "If nil, any available user port is used for outgoing DCC connections.
 288 If set to a cons, it specifies a range of ports to use in the form (min . max)"
 289   :group 'erc-dcc
 290   :type '(choice
 291           (const :tag "Any port" nil)
 292           (cons :tag "Port range"
 293                 (integer :tag "Lower port")
 294                 (integer :tag "Upper port"))))
 295
 296 (defcustom erc-dcc-auto-masks nil
 297   "List of regexps matching user identifiers whose DCC send offers should be
 298 accepted automatically.  A user identifier has the form \"nick!login@host\".
 299 For instance, to accept all incoming DCC send offers automatically, add the
 300 string \".*!.*@.*\" to this list."
 301   :group 'erc-dcc
 302   :type '(repeat regexp))
 303
 304 (defun erc-dcc-server (name filter sentinel)
 305   "Start listening on a port for an incoming DCC connection. Returns the newly
 306 created subprocess, or nil."
 307   (let ((port (or (and erc-dcc-port-range (car erc-dcc-port-range)) t))
 308         (upper (and erc-dcc-port-range (cdr erc-dcc-port-range)))
 309         process)
 310     (while (not process)
 311       (condition-case err
 312             (setq process
 313                   (make-network-process :name name
 314                                         :buffer nil
 315                                         :host (erc-dcc-host)
 316                                         :service port
 317                                         :nowait t
 318                                         :noquery nil
 319                                         :filter filter
 320                                         :sentinel sentinel
 321                                         :log #'erc-dcc-server-accept
 322                                         :server t))
 323         (file-error
 324          (unless (and (string= "Cannot bind server socket" (cadr err))
 325                       (string= "address already in use" (caddr err)))
 326            (signal (car err) (cdr err)))
 327          (setq port (1+ port))
 328          (unless (< port upper)
 329            (error "No available ports in erc-dcc-port-range")))))
 330     process))
 331
 332 (defun erc-dcc-server-accept (server client message)
 333   "Log an accepted DCC offer, then terminate the listening process and set up
 334 the accepted connection."
 335   (erc-log (format "(erc-dcc-server-accept): server %s client %s message %s"
 336            server client message))
 337   (when (and (string-match "^accept from " message)
 338              (processp server) (processp client))
 339     (let ((elt (erc-dcc-member :peer server)))
 340       ;; change the entry in erc-dcc-list from the listening process to the
 341       ;; accepted process
 342       (setq elt (plist-put elt :peer client))
 343       ;; delete the listening process, as we've accepted the connection
 344       (delete-process server))))
 345
 346 ;;; Interactive command handling
 347
 348 (defcustom erc-dcc-get-default-directory nil
 349   "*Default directory for incoming DCC file transfers.
 350 If this is nil, then the current value of `default-directory' is used."
 351   :group 'erc-dcc
 352   :type '(choice (const nil :tag "Default directory") directory))
 353
 354 ;;;###autoload
 355 (defun erc-cmd-DCC (cmd &rest args)
 356   "Parser for /dcc command.
 357 This figures out the dcc subcommand and calls the appropriate routine to
 358 handle it.  The function dispatched should be named \"erc-dcc-do-FOO-command\",
 359 where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
 360   (when cmd
 361     (let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command"))))
 362       (if fn
 363           (apply fn erc-server-process args)
 364         (erc-display-message
 365          nil 'notice 'active
 366          'dcc-command-undefined ?c cmd)
 367         (apropos "erc-dcc-do-.*-command")
 368         t))))
 369
 370 ;;;###autoload
 371 (defun pcomplete/erc-mode/DCC ()
 372   "Provides completion for the /DCC command."
 373   (pcomplete-here (append '("chat" "close" "get" "list")
 374                           (when (fboundp 'make-network-process) '("send"))))
 375   (pcomplete-here
 376    (case (intern (downcase (pcomplete-arg 1)))
 377      (chat (mapcar (lambda (elt) (plist-get elt :nick))
 378                    (erc-remove-if-not
 379                     #'(lambda (elt)
 380                         (eq (plist-get elt :type) 'CHAT))
 381                     erc-dcc-list)))
 382      (close (remove-duplicates
 383              (mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
 384                      erc-dcc-list) :test 'string=))
 385      (get (mapcar #'erc-dcc-nick
 386                   (erc-remove-if-not
 387                    #'(lambda (elt)
 388                        (eq (plist-get elt :type) 'GET))
 389                    erc-dcc-list)))
 390      (send (pcomplete-erc-all-nicks))))
 391   (pcomplete-here
 392    (case (intern (downcase (pcomplete-arg 2)))
 393      (get (mapcar (lambda (elt) (plist-get elt :file))
 394                   (erc-remove-if-not
 395                    #'(lambda (elt)
 396                        (and (eq (plist-get elt :type) 'GET)
 397                             (erc-nick-equal-p (erc-extract-nick
 398                                                (plist-get elt :nick))
 399                                               (pcomplete-arg 1))))
 400                    erc-dcc-list)))
 401      (close (mapcar #'erc-dcc-nick
 402                     (erc-remove-if-not
 403                      #'(lambda (elt)
 404                          (eq (plist-get elt :type)
 405                              (intern (upcase (pcomplete-arg 1)))))
 406                      erc-dcc-list)))
 407      (send (pcomplete-entries)))))
 408
 409 (defun erc-dcc-do-CHAT-command (proc &optional nick)
 410   (when nick
 411     (let ((elt (erc-dcc-member :nick nick :type 'CHAT :parent proc)))
 412       (if (and elt (not (processp (plist-get elt :peer))))
 413           ;; accept an existing chat offer
 414           ;; FIXME: perhaps /dcc accept like other clients?
 415           (progn (erc-dcc-chat-accept elt erc-server-process)
 416                  (erc-display-message
 417                   nil 'notice 'active
 418                   'dcc-chat-accept ?n nick)
 419                  t)
 420         (erc-dcc-chat nick erc-server-process)
 421         (erc-display-message
 422          nil 'notice 'active
 423          'dcc-chat-offer ?n nick)
 424         t))))
 425
 426 (defun erc-dcc-do-CLOSE-command (proc &optional type nick)
 427   "/dcc close type nick
 428 type and nick are optional."
 429   ;; FIXME, should also work if only nick is specified
 430   (when (string-match (concat "^\\s-*\\(\\S-+\\)? *\\("
 431                               erc-valid-nick-regexp "\\)?\\s-*$") line)
 432     (let ((type (when (match-string 1 line)
 433                   (intern (upcase (match-string 1 line)))))
 434           (nick (match-string 2 line))
 435           (ret t))
 436       (while ret
 437         (if nick
 438             (setq ret (erc-dcc-member :type type :nick nick))
 439           (setq ret (erc-dcc-member :type type)))
 440         (when ret
 441           ;; found a match - delete process if it exists.
 442           (and (processp (plist-get ret :peer))
 443                (delete-process (plist-get ret :peer)))
 444           (setq erc-dcc-list (delq ret erc-dcc-list))
 445           (erc-display-message
 446            nil 'notice 'active
 447            'dcc-closed
 448            ?T (plist-get ret :type)
 449            ?n (erc-extract-nick (plist-get ret :nick))))))
 450       t))
 451
 452 (defun erc-dcc-do-GET-command (proc nick &optional file)
 453   (let* ((elt (erc-dcc-member :nick nick :type 'GET))
 454          (filename (or file (plist-get elt :file) "unknown")))
 455     (if elt
 456         (let* ((file (read-file-name
 457                       (format "Local filename (default %s): "
 458                               (file-name-nondirectory filename))
 459                       (or erc-dcc-get-default-directory
 460                           default-directory)
 461                       (expand-file-name (file-name-nondirectory filename)
 462                                         (or erc-dcc-get-default-directory
 463                                             default-directory)))))
 464           (cond ((file-exists-p file)
 465                  (if (yes-or-no-p (format "File %s exists.  Overwrite? "
 466                                           file))
 467                      (erc-dcc-get-file elt file proc)
 468                    (erc-display-message
 469                     nil '(notice error) proc
 470                     'dcc-get-cmd-aborted
 471                     ?n nick ?f filename)))
 472                 (t
 473                  (erc-dcc-get-file elt file proc))))
 474       (erc-display-message
 475        nil '(notice error) 'active
 476        'dcc-get-notfound ?n nick ?f filename))))
 477
 478 (defun erc-dcc-do-LIST-command (proc)
 479   "This is the handler for the /dcc list command.
 480 It lists the current state of `erc-dcc-list' in an easy to read manner."
 481   (let ((alist erc-dcc-list)
 482         size elt)
 483     (erc-display-message
 484      nil 'notice 'active
 485      'dcc-list-head)
 486     (erc-display-message
 487      nil 'notice 'active
 488      'dcc-list-line)
 489     (while alist
 490       (setq elt (car alist)
 491             alist (cdr alist))
 492
 493       (setq size (or (and (plist-member elt :size)
 494                           (plist-get elt :size))
 495                      ""))
 496       (setq size
 497             (cond ((null size) "")
 498                  ((numberp size) (number-to-string size))
 499                  ((string= size "") "unknown")))
 500       (erc-display-message
 501        nil 'notice 'active
 502        'dcc-list-item
 503        ?n (erc-dcc-nick elt)
 504        ?t (plist-get elt :type)
 505        ?a (if (processp (plist-get elt :peer))
 506               (process-status (plist-get elt :peer))
 507             "no")
 508        ?s (concat size
 509                   (if (and (eq 'GET (plist-get elt :type))
 510                            (plist-member elt :file)
 511                            (buffer-live-p (get-buffer (plist-get elt :file)))
 512                            (plist-member elt :size))
 513                       (concat " (" (number-to-string
 514                                     (* 100
 515                                        (/ (buffer-size
 516                                            (get-buffer (plist-get elt :file)))
 517                                           (plist-get elt :size))))
 518                               "%)")))
 519        ?f (or (and (plist-member elt :file) (plist-get elt :file)) "")))
 520     (erc-display-message
 521      nil 'notice 'active
 522      'dcc-list-end)
 523     t))
 524
 525 (defun erc-dcc-do-SEND-command (proc nick file)
 526   "Offer FILE to NICK by sending a ctcp dcc send message."
 527   (if (file-exists-p file)
 528       (progn
 529         (erc-display-message
 530          nil 'notice 'active
 531          'dcc-send-offer ?n nick ?f file)
 532         (erc-dcc-send-file nick file) t)
 533     (erc-display-message nil '(notice error) proc "File not found") t))
 534
 535 ;;; Server message handling (i.e. messages from remote users)
 536
 537 ;;;###autoload
 538 (defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC)
 539   "Hook variable for CTCP DCC queries")
 540
 541 (defvar erc-dcc-query-handler-alist
 542   '(("SEND" . erc-dcc-handle-ctcp-send)
 543     ("CHAT" . erc-dcc-handle-ctcp-chat)))
 544
 545 ;;;###autoload
 546 (defun erc-ctcp-query-DCC (proc nick login host to query)
 547   "The function called when a CTCP DCC request is detected by the client.
 548 It examines the DCC subcommand, and calls the appropriate routine for
 549 that subcommand."
 550   (let* ((cmd (cadr (split-string query " ")))
 551          (handler (cdr (assoc cmd erc-dcc-query-handler-alist))))
 552     (if handler
 553         (funcall handler proc query nick login host to)
 554       ;; FIXME: Send a ctcp error notice to the remote end?
 555       (erc-display-message
 556        nil '(notice error) proc
 557        'dcc-ctcp-unknown
 558        ?q query ?n nick ?u login ?h host))))
 559
 560 (defconst erc-dcc-ctcp-query-send-regexp
 561   "^DCC SEND \\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)")
 562
 563 (defun erc-dcc-handle-ctcp-send (proc query nick login host to)
 564   "This is called if a CTCP DCC SEND subcommand is sent to the client.
 565 It extracts the information about the dcc request and adds it to
 566 `erc-dcc-list'."
 567   (unless (eq erc-dcc-send-request 'ignore)
 568     (cond
 569      ((not (erc-current-nick-p to))
 570       ;; DCC SEND requests must be sent to you, and you alone.
 571       (erc-display-message
 572        nil 'notice proc
 573        'dcc-request-bogus
 574        ?r "SEND" ?n nick ?u login ?h host))
 575      ((string-match erc-dcc-ctcp-query-send-regexp query)
 576       (let ((filename (match-string 1 query))
 577             (ip       (erc-decimal-to-ip (match-string 2 query)))
 578             (port     (match-string 3 query))
 579             (size     (match-string 4 query)))
 580         ;; FIXME: a warning really should also be sent
 581         ;; if the ip address != the host the dcc sender is on.
 582         (erc-display-message
 583          nil 'notice proc
 584          'dcc-send-offered
 585          ?f filename ?n nick ?u login ?h host
 586          ?s (if (string= size "") "unknown" size))
 587         (and (< (string-to-number port) 1025)
 588              (erc-display-message
 589               nil 'notice proc
 590               'dcc-privileged-port
 591               ?p port))
 592         (erc-dcc-list-add
 593          'GET (format "%s!%s@%s" nick login host)
 594          nil proc
 595          :ip ip :port port :file filename
 596          :size (string-to-number size))
 597         (if (and (eq erc-dcc-send-request 'auto)
 598                  (erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host)))
 599             (erc-dcc-get-file (car erc-dcc-list) filename proc))))
 600      (t
 601       (erc-display-message
 602        nil 'notice proc
 603        'dcc-malformed
 604        ?n nick ?u login ?h host ?q query)))))
 605
 606 (defun erc-dcc-auto-mask-p (spec)
 607   "Takes a full SPEC of a user in the form \"nick!login@host\" and
 608 matches against all the regexp's in `erc-dcc-auto-masks'. If any
 609 match, returns that regexp and nil otherwise."
 610   (let ((lst erc-dcc-auto-masks))
 611     (while (and lst
 612                 (not (string-match (car lst) spec)))
 613       (setq lst (cdr lst)))
 614     (and lst (car lst))))
 615
 616 (defconst erc-dcc-ctcp-query-chat-regexp
 617   "^DCC CHAT +chat +\\([0-9]+\\) +\\([0-9]+\\)")
 618
 619 (defcustom erc-dcc-chat-request 'ask
 620   "*How to treat incoming DCC Chat requests.
 621 'ask - Report the Chat request, and wait for the user to manually accept it
 622 'auto - Automatically accept the request and open a new chat window
 623 'ignore - Ignore incoming DCC chat requests completely."
 624   :group 'erc-dcc
 625   :type '(choice (const ask) (const auto) (const ignore)))
 626
 627 (defun erc-dcc-handle-ctcp-chat (proc query nick login host to)
 628   (unless (eq erc-dcc-chat-request 'ignore)
 629     (cond
 630      (;; DCC CHAT requests must be sent to you, and you alone.
 631       (not (erc-current-nick-p to))
 632       (erc-display-message
 633        nil '(notice error) proc
 634        'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host))
 635      ((string-match erc-dcc-ctcp-query-chat-regexp query)
 636       ;; We need to use let* here, since erc-dcc-member might clutter
 637       ;; the match value.
 638       (let* ((ip   (erc-decimal-to-ip (match-string 1 query)))
 639              (port (match-string 2 query))
 640              (elt  (erc-dcc-member :nick nick :type 'CHAT)))
 641         ;; FIXME: A warning really should also be sent if the ip
 642         ;; address != the host the dcc sender is on.
 643         (erc-display-message
 644          nil 'notice proc
 645          'dcc-chat-offered
 646          ?n nick ?u login ?h host ?p port)
 647         (and (< (string-to-number port) 1025)
 648              (erc-display-message
 649               nil 'notice proc
 650               'dcc-privileged-port ?p port))
 651         (cond (elt
 652                ;; XXX: why are we updating ip/port on the existing connection?
 653                (setq elt (plist-put (plist-put elt :port port) :ip ip))
 654                (erc-display-message
 655                 nil 'notice proc
 656                 'dcc-chat-discarded ?n nick ?u login ?h host))
 657               (t
 658                (erc-dcc-list-add
 659                 'CHAT (format "%s!%s@%s" nick login host)
 660                 nil proc
 661                 :ip ip :port port)))
 662         (if (eq erc-dcc-chat-request 'auto)
 663             (erc-dcc-chat-accept (erc-dcc-member :nick nick :type 'CHAT)
 664                                  proc))))
 665      (t
 666       (erc-display-message
 667        nil '(notice error) proc
 668        'dcc-malformed ?n nick ?u login ?h host ?q query)))))
 669
 670
 671 (defvar erc-dcc-entry-data nil
 672   "Holds the `erc-dcc-list' entry for this DCC connection.")
 673 (make-variable-buffer-local 'erc-dcc-entry-data)
 674
 675 ;;; SEND handling
 676
 677 (defcustom erc-dcc-block-size 1024
 678   "*Block size to use for DCC SEND sessions."
 679   :group 'erc-dcc
 680   :type 'integer)
 681
 682 (defcustom erc-dcc-pump-bytes nil
 683   "*If set to an integer, keep sending until that number of bytes are
 684 unconfirmed."
 685   :group 'erc-dcc
 686   :type '(choice (const nil) integer))
 687
 688 (defsubst erc-dcc-get-parent (proc)
 689   (plist-get (erc-dcc-member :peer proc) :parent))
 690
 691 (defun erc-dcc-send-block (proc)
 692   "Send one block of data.
 693 PROC is the process-object of the DCC connection.  Returns the number of
 694 bytes sent."
 695   (let* ((elt (erc-dcc-member :peer proc))
 696          (confirmed-marker (plist-get elt :sent))
 697          (sent-marker (plist-get elt :sent)))
 698     (with-current-buffer (process-buffer proc)
 699       (when erc-verbose-dcc
 700         (erc-display-message
 701          nil 'notice (erc-dcc-get-parent proc)
 702          (format "DCC: Confirmed %d, sent %d, sending block now"
 703                  (- confirmed-marker (point-min))
 704                (- sent-marker (point-min)))))
 705       (let* ((end (min (+ sent-marker erc-dcc-block-size)
 706                        (point-max)))
 707              (string (buffer-substring-no-properties sent-marker end)))
 708         (when (< sent-marker end)
 709           (set-marker sent-marker end)
 710           (process-send-string proc string))
 711         (length string)))))
 712
 713 (defun erc-dcc-send-filter (proc string)
 714   (erc-assert (= (% (length string) 4) 0))
 715   (let* ((size (erc-unpack-int (substring string (- (length string) 4))))
 716          (elt (erc-dcc-member :peer proc))
 717          (parent (plist-get elt :parent))
 718          (sent-marker (plist-get elt :sent))
 719          (confirmed-marker (plist-get elt :confirmed)))
 720     (with-current-buffer (process-buffer proc)
 721       (set-marker confirmed-marker (+ (point-min) size))
 722       (cond
 723        ((and (= confirmed-marker sent-marker)
 724              (= confirmed-marker (point-max)))
 725         (erc-display-message
 726          nil 'notice parent
 727          'dcc-send-finished
 728          ?n (plist-get elt :nick)
 729          ?f buffer-file-name
 730          ?s (number-to-string (- sent-marker (point-min))))
 731         (setq erc-dcc-list (delete elt erc-dcc-list))
 732         (set-buffer-modified-p nil)
 733         (kill-buffer (current-buffer))
 734         (delete-process proc))
 735        ((<= confirmed-marker sent-marker)
 736         (while (and (< (- sent-marker confirmed-marker)
 737                        (or erc-dcc-pump-bytes
 738                            erc-dcc-block-size))
 739                     (> (erc-dcc-send-block proc) 0))))
 740        ((> confirmed-marker sent-marker)
 741         (erc-display-message
 742          nil 'notice parent
 743          (format "DCC: Client confirmed too much!"))
 744         (delete-process proc))))))
 745
 746 (defcustom erc-dcc-send-connect-hook
 747   '((lambda (proc)
 748       (erc-display-message
 749        nil 'notice (erc-dcc-get-parent proc)
 750        (format "DCC: SEND connect from %s"
 751                (format-network-address (process-contact proc :remote)))))
 752     erc-dcc-send-block)
 753   "*Hook run whenever the remote end of a DCC SEND offer connected to your
 754 listening port."
 755   :group 'erc-dcc
 756   :type 'hook)
 757
 758 (defun erc-dcc-nick (plist)
 759   "Extract the nickname portion of the :nick property value in PLIST."
 760   (erc-extract-nick (plist-get plist :nick)))
 761
 762 (defun erc-dcc-send-sentinel (proc event)
 763   (let* ((elt (erc-dcc-member :peer proc))
 764          (buf (marker-buffer (plist-get elt :sent))))
 765     (cond
 766      ((string-match "^open from " event)
 767       (when elt
 768         (with-current-buffer buf
 769           (set-process-buffer proc buf)
 770           (setq erc-dcc-entry-data elt))
 771         (run-hook-with-args 'erc-dcc-send-connect-hook proc))))))
 772
 773 (defun erc-dcc-find-file (file)
 774   (with-current-buffer (generate-new-buffer (file-name-nondirectory file))
 775     (insert-file-contents-literally file)
 776     (setq buffer-file-name file)
 777     (current-buffer)))
 778
 779 (defun erc-dcc-file-to-name (file)
 780   (with-temp-buffer
 781     (insert (file-name-nondirectory file))
 782     (subst-char-in-region (point-min) (point-max) ?  ?_ t)
 783     (buffer-string)))
 784
 785 (defun erc-dcc-send-file (nick file &optional pproc)
 786   "Open a socket for incoming connections, and send a CTCP send request to the
 787 other client."
 788   (interactive "sNick: \nfFile: ")
 789   (when (null pproc) (if (processp erc-server-process)
 790                          (setq pproc erc-server-process)
 791                        (error "Can not find parent process")))
 792   (if (featurep 'make-network-process)
 793       (let* ((buffer (erc-dcc-find-file file))
 794              (size (buffer-size buffer))
 795              (start (with-current-buffer buffer
 796                       (set-marker (make-marker) (point-min))))
 797              (sproc (erc-dcc-server "dcc-send"
 798                                     'erc-dcc-send-filter
 799                                     'erc-dcc-send-sentinel))
 800              (contact (process-contact sproc)))
 801         (erc-dcc-list-add
 802          'SEND nick sproc pproc
 803          :file file :size size
 804          :sent start :confirmed (copy-marker start))
 805         (process-send-string
 806          pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n"
 807                        nick (erc-dcc-file-to-name file)
 808                        (erc-ip-to-decimal (nth 0 contact))
 809                        (nth 1 contact)
 810                        size)))
 811     (error "`make-network-process' not supported by your emacs.")))
 812
 813 ;;; GET handling
 814
 815 (defvar erc-dcc-byte-count nil)
 816 (make-variable-buffer-local 'erc-dcc-byte-count)
 817
 818 (defun erc-dcc-get-file (entry file parent-proc)
 819   "This function does the work of setting up a transfer from the remote client
 820 to the local one over a tcp connection. This involves setting up a process
 821 filter and a process sentinel, and making the connection."
 822   (let* ((buffer (generate-new-buffer (file-name-nondirectory file)))
 823          proc)
 824     (with-current-buffer buffer
 825       (fundamental-mode)
 826       ;; This is necessary to have the buffer saved as-is in GNU
 827       ;; Emacs.
 828       ;; XEmacs change: We don't have `set-buffer-multibyte', setting
 829       ;; coding system to 'binary below takes care of us.
 830       (when (fboundp 'set-buffer-multibyte)
 831         (set-buffer-multibyte nil))
 832
 833       (setq mode-line-process '(":%s")
 834             buffer-file-type t
 835             buffer-read-only t)
 836       (set-visited-file-name file)
 837
 838       (setq erc-server-process parent-proc
 839             erc-dcc-entry-data entry)
 840       (setq erc-dcc-byte-count 0)
 841       (setq proc
 842             (funcall erc-dcc-connect-function
 843                      "dcc-get" buffer
 844                      (plist-get entry :ip)
 845                      (string-to-number (plist-get entry :port))
 846                      entry))
 847       (set-process-buffer proc buffer)
 848       ;; The following two lines make saving as-is work under Windows
 849       (set-process-coding-system proc 'binary 'binary)
 850       (set-buffer-file-coding-system 'binary t)
 851
 852       (set-process-filter proc 'erc-dcc-get-filter)
 853       (set-process-sentinel proc 'erc-dcc-get-sentinel)
 854       (setq entry (plist-put entry :start-time (erc-current-time)))
 855       (setq entry (plist-put entry :peer proc)))))
 856
 857 (defun erc-dcc-get-filter (proc str)
 858   "This is the process filter for transfers from other clients to this one.
 859 It reads incoming bytes from the network and stores them in the DCC
 860 buffer, and sends back the replies after each block of data per the DCC
 861 protocol spec.  Well not really.  We write back a reply after each read,
 862 rather than every 1024 byte block, but nobody seems to care."
 863   (with-current-buffer (process-buffer proc)
 864     (setq buffer-read-only nil) ;; FIXME
 865     (goto-char (point-max))
 866     (insert (string-make-unibyte str))
 867
 868     (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count))
 869     (erc-assert (= erc-dcc-byte-count (1- (point-max))))
 870     (and erc-verbose-dcc
 871          (erc-display-message
 872           nil 'notice erc-server-process
 873           'dcc-get-bytes-received
 874           ?f (file-name-nondirectory buffer-file-name)
 875           ?b (number-to-string erc-dcc-byte-count)))
 876     (cond
 877      ((and (> (plist-get erc-dcc-entry-data :size) 0)
 878            (> erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))
 879       (erc-display-message
 880        nil '(error notice) 'active
 881        'dcc-get-file-too-long
 882        ?f (file-name-nondirectory buffer-file-name))
 883       (delete-process proc))
 884      (t
 885       (process-send-string
 886        proc (erc-pack-int erc-dcc-byte-count 4))))))
 887
 888
 889 (defun erc-dcc-get-sentinel (proc event)
 890   "This is the process sentinel for CTCP DCC SEND connections.
 891 It shuts down the connection and notifies the user that the
 892 transfer is complete."
 893   ;; FIXME, we should look at EVENT, and also check size.
 894   (with-current-buffer (process-buffer proc)
 895     (delete-process proc)
 896     (setq buffer-read-only nil)
 897     (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list))
 898     (erc-display-message
 899      nil 'notice erc-server-process
 900      'dcc-get-complete
 901      ?f (file-name-nondirectory buffer-file-name)
 902      ?s (number-to-string (buffer-size))
 903      ?t (format "%.0f"
 904                 (erc-time-diff (plist-get erc-dcc-entry-data :start-time)
 905                                (erc-current-time))))
 906     (save-buffer))
 907   (kill-buffer (process-buffer proc))
 908   (delete-process proc))
 909
 910 ;;; CHAT handling
 911
 912 (defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s"
 913   "*Format to use for DCC Chat buffer names."
 914   :group 'erc-dcc
 915   :type 'string)
 916
 917 (defcustom erc-dcc-chat-mode-hook nil
 918   "*Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
 919   :group 'erc-dcc
 920   :type 'hook)
 921
 922 (defcustom erc-dcc-chat-connect-hook nil
 923   ""
 924   :group 'erc-dcc
 925   :type 'hook)
 926
 927 (defcustom erc-dcc-chat-exit-hook nil
 928   ""
 929   :group 'erc-dcc
 930   :type 'hook)
 931
 932 (defun erc-cmd-CREQ (line &optional force)
 933   "Set or get the DCC chat request flag.
 934 Possible values are: ask, auto, ignore."
 935   (when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
 936     (let ((cmd (match-string 1 line)))
 937       (if (stringp cmd)
 938           (erc-display-message
 939            nil 'notice 'active
 940            (format "Set DCC Chat requests to %S"
 941                    (setq erc-dcc-chat-request (intern cmd))))
 942         (erc-display-message nil 'notice 'active
 943                              (format "DCC Chat requests are set to %S"
 944                                      erc-dcc-chat-request)))
 945       t)))
 946
 947 (defun erc-cmd-SREQ (line &optional force)
 948   "Set or get the DCC send request flag.
 949 Possible values are: ask, auto, ignore."
 950   (when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
 951     (let ((cmd (match-string 1 line)))
 952       (if (stringp cmd)
 953           (erc-display-message
 954            nil 'notice 'active
 955            (format "Set DCC Send requests to %S"
 956                    (setq erc-dcc-send-request (intern cmd))))
 957         (erc-display-message nil 'notice 'active
 958                              (format "DCC Send requests are set to %S"
 959                                      erc-dcc-send-request)))
 960       t)))
 961
 962 (defun pcomplete/erc-mode/CREQ ()
 963   (pcomplete-here '("auto" "ask" "ignore")))
 964 (defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ)
 965
 966 (defvar erc-dcc-chat-filter-hook '(erc-dcc-chat-parse-output)
 967   "*Hook to run after doing parsing (and possible insertion) of DCC messages.")
 968
 969 (defvar erc-dcc-chat-mode-map
 970   (let ((map (make-sparse-keymap)))
 971     (define-key map (kbd "RET") 'erc-send-current-line)
 972     (define-key map "\t" 'erc-complete-word)
 973     map)
 974   "Keymap for `erc-dcc-mode'.")
 975
 976 (defun erc-dcc-chat-mode ()
 977   "Major mode for wasting time via DCC chat."
 978   (interactive)
 979   (kill-all-local-variables)
 980   (setq mode-line-process '(":%s")
 981         mode-name "DCC-Chat"
 982         major-mode 'erc-dcc-chat-mode
 983         erc-send-input-line-function 'erc-dcc-chat-send-input-line
 984         erc-default-recipients '(dcc))
 985   (use-local-map erc-dcc-chat-mode-map)
 986   (run-hooks 'erc-dcc-chat-mode-hook))
 987
 988 (defun erc-dcc-chat-send-input-line (recipient line &optional force)
 989   "Send LINE to the remote end.
 990 Argument RECIPIENT should always be the symbol dcc, and force
 991 is ignored."
 992   ;; FIXME: We need to get rid of all force arguments one day!
 993   (if (eq recipient 'dcc)
 994       (process-send-string
 995        (get-buffer-process (current-buffer)) line)
 996     (error "erc-dcc-chat-send-input-line in %s" (current-buffer))))
 997
 998 (defun erc-dcc-chat (nick &optional pproc)
 999   "Open a socket for incoming connections, and send a chat request to the
1000 other client."
1001   (interactive "sNick: ")
1002   (when (null pproc) (if (processp erc-server-process)
1003                          (setq pproc erc-server-process)
1004                        (error "Can not find parent process")))
1005   (let* ((sproc (erc-dcc-server "dcc-chat-out"
1006                                 'erc-dcc-chat-filter
1007                                 'erc-dcc-chat-sentinel))
1008          (contact (process-contact sproc)))
1009     (erc-dcc-list-add 'OCHAT nick sproc pproc)
1010     (process-send-string pproc
1011      (format "PRIVMSG %s :\C-aDCC CHAT chat %s %d\C-a\n"
1012              nick
1013              (erc-ip-to-decimal (nth 0 contact)) (nth 1 contact)))))
1014
1015 (defvar erc-dcc-from)
1016 (make-variable-buffer-local 'erc-dcc-from)
1017
1018 (defvar erc-dcc-unprocessed-output)
1019 (make-variable-buffer-local 'erc-dcc-unprocessed-output)
1020
1021 (defun erc-dcc-chat-setup (entry)
1022   "Setup a DCC chat buffer, returning the buffer."
1023   (let* ((nick (erc-extract-nick (plist-get entry :nick)))
1024          (buffer (generate-new-buffer
1025                   (format erc-dcc-chat-buffer-name-format nick)))
1026          (proc (plist-get entry :peer))
1027          (parent-proc (plist-get entry :parent)))
1028     (erc-setup-buffer buffer)
1029     ;; buffer is now the current buffer.
1030     (erc-dcc-chat-mode)
1031     (setq erc-server-process parent-proc)
1032     (setq erc-dcc-from nick)
1033     (setq erc-dcc-entry-data entry)
1034     (setq erc-dcc-unprocessed-output "")
1035     (setq erc-insert-marker (set-marker (make-marker) (point-max)))
1036     (erc-display-prompt buffer (point-max))
1037     (set-process-buffer proc buffer)
1038     (add-hook 'kill-buffer-hook 'erc-dcc-chat-buffer-killed nil t)
1039     (run-hook-with-args 'erc-dcc-chat-connect-hook proc)
1040     buffer))
1041
1042 (defun erc-dcc-chat-accept (entry parent-proc)
1043   "Accept an incoming DCC connection and open a DCC window"
1044   (let* ((nick (erc-extract-nick (plist-get entry :nick)))
1045          buffer proc)
1046     (setq proc
1047           (funcall erc-dcc-connect-function
1048                    "dcc-chat" nil
1049                    (plist-get entry :ip)
1050                    (string-to-number (plist-get entry :port))
1051                    entry))
1052     ;; XXX: connected, should we kill the ip/port properties?
1053     (setq entry (plist-put entry :peer proc))
1054     (setq entry (plist-put entry :parent parent-proc))
1055     (set-process-filter proc 'erc-dcc-chat-filter)
1056     (set-process-sentinel proc 'erc-dcc-chat-sentinel)
1057     (setq buffer (erc-dcc-chat-setup entry))))
1058
1059 (defun erc-dcc-chat-filter (proc str)
1060   (let ((orig-buffer (current-buffer)))
1061     (unwind-protect
1062         (progn
1063           (set-buffer (process-buffer proc))
1064           (setq erc-dcc-unprocessed-output
1065                 (concat erc-dcc-unprocessed-output str))
1066           (run-hook-with-args 'erc-dcc-chat-filter-hook proc
1067                            erc-dcc-unprocessed-output))
1068       (set-buffer orig-buffer))))
1069
1070 (defun erc-dcc-chat-parse-output (proc str)
1071   (save-match-data
1072     (let ((posn 0)
1073           line)
1074       (while (string-match "\n" str posn)
1075         (setq line (substring str posn (match-beginning 0)))
1076         (setq posn (match-end 0))
1077         (erc-display-message
1078          nil nil proc
1079          'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'face
1080                                               'erc-nick-default-face) ?m line))
1081       (setq erc-dcc-unprocessed-output (substring str posn)))))
1082
1083 (defun erc-dcc-chat-buffer-killed ()
1084   (erc-dcc-chat-close "killed buffer"))
1085
1086 (defun erc-dcc-chat-close (&optional event)
1087   "Close a DCC chat, removing any associated processes and tidying up
1088 `erc-dcc-list'"
1089   (let ((proc (plist-get erc-dcc-entry-data :peer))
1090         (evt (or event "")))
1091     (when proc
1092       (setq erc-dcc-list (delq erc-dcc-entry-data erc-dcc-list))
1093       (run-hook-with-args 'erc-dcc-chat-exit-hook proc)
1094       (delete-process proc)
1095       (erc-display-message
1096        nil 'notice erc-server-process
1097        'dcc-chat-ended ?n erc-dcc-from ?t (current-time-string) ?e evt)
1098       (setq erc-dcc-entry-data (plist-put erc-dcc-entry-data :peer nil)))))
1099
1100 (defun erc-dcc-chat-sentinel (proc event)
1101   (let ((buf (current-buffer))
1102         (elt (erc-dcc-member :peer proc)))
1103     ;; the sentinel is also notified when the connection is opened, so don't
1104     ;; immediately kill it again
1105     ;(message "buf %s elt %S evt %S" buf elt event)
1106     (unwind-protect
1107         (if (string-match "^open from" event)
1108             (erc-dcc-chat-setup elt)
1109           (erc-dcc-chat-close event))
1110       (set-buffer buf))))
1111
1112 (defun erc-dcc-no-such-nick (proc parsed)
1113   "Detect and handle no-such-nick replies from the IRC server."
1114   (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed))
1115                               :parent proc))
1116          (peer (plist-get elt :peer)))
1117     (when (or (and (processp peer) (not (eq (process-status peer) 'open)))
1118               elt)
1119       ;; Since we already created an entry before sending the CTCP
1120       ;; message, we now remove it, if it doesn't point to a process
1121       ;; which is already open.
1122       (setq erc-dcc-list (delq elt erc-dcc-list))
1123       (if (processp peer) (delete-process peer)))
1124     nil))
1125
1126 (add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)
1127
1128 (provide 'erc-dcc)
1129
1130 ;;; erc-dcc.el ends here
1131 ;;
1132 ;; Local Variables:
1133 ;; indent-tabs-mode: nil
1134 ;; End:
1135
1136 ;; arch-tag: cda5a6b3-c510-4dbe-b699-84cccfa04edb