erc-dcc.el 49 KB

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