cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-dcc.el

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