+++ /dev/null
-;;; liece-dcc.el --- DCC handlers and commands.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece, DCC
-
-;; This file is part of Liece.
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-
-;;; Commentary:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-intl)
- (require 'liece-inlines)
- (require 'liece-channel)
- (require 'liece-misc))
-
-(eval-when-compile (require 'queue-m))
-
-(require 'liece-coding)
-(require 'liece-misc)
-(require 'liece-minibuf)
-
-(defvar liece-dcc-requests (queue-create))
-(defvar liece-dcc-receive-direct t)
-(defvar liece-dcc-process-alist nil)
-
-(defconst liece-dcc-acceptable-messages '("SEND" "CHAT"))
-
-(defstruct liece-dcc-object type from host port file size)
-
-(defun liece-dcc-start-process (args)
- (let ((program
- (or (car-safe liece-dcc-program)
- liece-dcc-program)))
- (apply #'start-process " *DCC*" nil program args)))
-
-(defun liece-dcc-enqueue-request (type &rest args)
- (let ((request (apply #'make-liece-dcc-object :type type args)))
- (inline (queue-enqueue liece-dcc-requests request))))
-
-(defun liece-dcc-dequeue-request (&optional type)
- (when (or (not type)
- (eq (liece-dcc-object-type
- (queue-first liece-dcc-requests))
- type))
- (inline (queue-dequeue liece-dcc-requests))))
-
-(defmacro liece-dcc-add-to-process-alist (process type &rest args)
- `(push (cons (process-name ,process)
- (make-liece-dcc-object :type ,type ,@args))
- liece-dcc-process-alist))
-
-(defmacro liece-dcc-get-process-object (process)
- `(cdr (assoc (process-name ,process) liece-dcc-process-alist)))
-
-(defmacro liece-dcc-message (&rest msg)
- `(message "DCC %s" (format ,@msg)))
-
-(defun* liece-ctcp-dcc-message (from chnl rest)
- (cond
- ((string-match "^SEND +" rest)
- (multiple-value-bind (filename host port size)
- (split-string (substring rest (match-end 0)))
- (setq filename (file-name-nondirectory filename))
- (liece-insert-dcc
- (append liece-O-buffer liece-D-buffer)
- (format (_ "SEND request from %s: %s (%s bytes)\n")
- from filename size))
- (liece-dcc-enqueue-request
- 'send :from from :host host :port port :file filename :size size)
- (when liece-dcc-receive-direct
- (liece-insert-dcc
- (append liece-O-buffer liece-D-buffer)
- (format (_ "SEND applied autoreceive: %s (%s bytes)\n")
- filename size))
- (liece-command-dcc-receive))))
- ((string-match "^CHAT [^ ]+ +" rest)
- (multiple-value-bind (host port)
- (split-string (substring rest (match-end 0)))
- (liece-dcc-enqueue-request 'chat :from from :host host :port port)
- (liece-insert-dcc
- (append liece-O-buffer liece-D-buffer)
- (concat "CHAT request from " from "\n"))))))
-
-(defun liece-command-dcc-send (filename towhom)
- "Send file to user."
- (interactive
- (list (expand-file-name
- (read-file-name
- (_ "File to send: ")
- default-directory nil))
- (liece-minibuffer-completing-read
- (_ "To whom: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner)))
-
- (setq liece-privmsg-partner towhom)
- (let ((process
- (liece-dcc-start-process
- (list "send" (int-to-string liece-dcc-port) filename))))
- (set-process-filter process #'liece-dcc-send-filter)
- (set-process-sentinel process #'liece-dcc-sentinel))
- (or (zerop liece-dcc-port)
- (incf liece-dcc-port)))
-
-(defun liece-dcc-sentinel (process output)
- (let* ((object (liece-dcc-get-process-object process))
- (type (liece-dcc-object-type object)))
- (if (null object)
- (delete-process process)
- (if (string-match "^finished" output)
- (cond
- ((eq type 'send)
- (liece-dcc-message (_ "Sent file to %s: %s (%s bytes)")
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object)))
- ((eq type 'receive)
- (liece-dcc-message (_ "Received file from %s: %s (%s bytes)")
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object)))
- ((eq type 'chat)
- (liece-dcc-message (_ "Chat connection with %s finished")
- (liece-dcc-object-from object))))
- (liece-dcc-message
- (_ "%s error (%s %s %s) is %s\n")
- (capitalize (downcase (prin1-to-string
- (liece-dcc-object-type object))))
- (or (liece-dcc-object-file object) "")
- (cond ((eq type 'send) "to")
- ((eq type 'receive) "from")
- ((eq type 'chat) "with"))
- (liece-dcc-object-from object)
- (substring output 0 (1- (length output))))))))
-
-(defun liece-dcc-send-filter (process output)
- (if (string-match "DCC send +" output)
- (multiple-value-bind (filename port host size)
- (split-string (substring output (match-end 0)))
- (setq filename (file-name-nondirectory filename))
- (liece-send "PRIVMSG %s :\001DCC SEND %s %s %s %s\001"
- liece-privmsg-partner filename host port size)
- (liece-dcc-message (_ "Sending file to %s: %s (%s bytes)")
- liece-privmsg-partner filename size)
- (liece-dcc-add-to-process-alist process 'send
- :host host
- :port port
- :from liece-privmsg-partner
- :file filename
- :size size))
- (liece-dcc-message (_ "send error to %s: %s")
- liece-privmsg-partner
- (substring output 0 (1- (length output))))))
-
-(defmacro liece-dcc-prepare-directory ()
- '(or (file-directory-p (expand-file-name liece-dcc-directory))
- (and (y-or-n-p (_ "DCC directory does not exist. Create it? "))
- (make-directory (expand-file-name liece-dcc-directory)))))
-
-(defun liece-command-dcc-receive (&optional number)
- "Receive next file from list."
- (interactive "P")
- (let ((object (liece-dcc-dequeue-request 'send)))
- (if (not object)
- (liece-message (_ "DCC No send request has been arrived."))
- (liece-dcc-message (_ "Getting file from %s: %s (%s bytes)")
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object))
- (liece-dcc-prepare-directory)
- (let ((file
- (expand-file-name
- (liece-dcc-object-file object)
- liece-dcc-directory))
- (process
- (liece-dcc-start-process
- (list "receive"
- (liece-dcc-object-host object)
- (liece-dcc-object-port object)
- (liece-dcc-object-size object)
- (expand-file-name
- (liece-dcc-object-file object)
- liece-dcc-directory)))))
- (set-process-filter process #'liece-dcc-receive-filter)
- (set-process-sentinel process #'liece-dcc-sentinel)
- (liece-dcc-add-to-process-alist
- process 'receive
- :from (liece-dcc-object-from object)
- :host (liece-dcc-object-host object)
- :port (liece-dcc-object-port object)
- :file file
- :size (liece-dcc-object-size object))))))
-
-(defun liece-dcc-receive-filter (process output)
- (liece-dcc-message "%s" (substring output 0 (1- (length output)))))
-
-(defun liece-command-dcc-chat-listen (towhom)
- (interactive
- (list (liece-minibuffer-completing-read
- (_ "With whom: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner)))
- (setq liece-privmsg-partner towhom)
- (let ((process
- (as-binary-process
- (liece-dcc-start-process
- (list "chat" "listen" (int-to-string liece-dcc-port))))))
- (set-process-buffer
- process
- (liece-get-buffer-create (format " DCC:%s" (process-id process))))
- (set-process-filter process 'liece-dcc-chat-listen-filter)
- (set-process-sentinel process 'liece-dcc-sentinel))
- (unless (zerop liece-dcc-port)
- (setq liece-dcc-port (1+ liece-dcc-port))))
-
-(defun liece-dcc-chat-listen-filter (process output)
- (cond
- ((string-match "DCC chat +" output)
- (multiple-value-bind (host port)
- (split-string (substring output (match-end 0)))
- (liece-send "PRIVMSG %s :\001DCC CHAT chat %s %s\001"
- liece-privmsg-partner host port)
- (liece-dcc-message (_ "Ringing user %s")
- liece-privmsg-partner)
- (liece-dcc-add-to-process-alist
- process 'chat :from liece-privmsg-partner)))
- ((string-match "^DCC chat established" output)
- (set-process-filter process 'liece-dcc-chat-filter)
- (let* ((object (liece-dcc-get-process-object process))
- (nick (liece-dcc-object-from object)))
- (setq nick (liece-channel-prepare-representation nick 'dcc))
- (liece-channel-prepare-partner nick)
- (liece-dcc-message (_ "Chat connection established with: %s")
- nick))
- (message ""))
- (t
- (liece-dcc-message (_ "listen error to %s: %s")
- liece-privmsg-partner
- (substring output 0 (1- (length output)))))))
-
-(defun liece-command-dcc-chat-connect (&optional number)
- (interactive "P")
- (let* ((object (liece-dcc-dequeue-request 'chat))
- (nick (liece-dcc-object-from object))
- process)
- (if (not object)
- (liece-message (_ "DCC No chat request has been arrived."))
- (liece-dcc-message (_ "Connecting to: %s") nick)
- (setq liece-privmsg-partner nick)
- (setq process
- (as-binary-process
- (liece-dcc-start-process
- (list "chat" "connect"
- (liece-dcc-object-host object)
- (liece-dcc-object-port object)))))
- (set-process-buffer
- process
- (liece-get-buffer-create
- (format " DCC:%s" (process-id process))))
- (set-process-filter process #'liece-dcc-chat-connect-filter)
- (set-process-sentinel process #'liece-dcc-sentinel)
- (liece-dcc-add-to-process-alist
- process 'chat :from liece-privmsg-partner))))
-
-(defun liece-dcc-chat-connect-filter (process output)
- (if (string-match "^DCC chat established" output)
- (let* ((object (liece-dcc-get-process-object process))
- (nick (liece-dcc-object-from object)))
- (set-process-filter process #'liece-dcc-chat-filter)
- (setq nick (liece-channel-prepare-representation nick 'dcc))
- (liece-channel-prepare-partner nick)
- (liece-dcc-message (_ "Chat connection established with: %s")
- nick)
- (message ""))
- (liece-dcc-message
- (_ "connect error to %s: %s")
- liece-privmsg-partner
- (substring output 0 (1- (length output))))))
-
-(defun liece-dcc-chat-filter (process output)
- (save-match-data
- (with-current-buffer (process-buffer process)
- (let* ((object (liece-dcc-get-process-object process))
- (nick (liece-channel-prepare-representation
- (liece-dcc-object-from object) 'dcc)))
- (goto-char (point-max))
- (insert output)
- (goto-char (point-min))
- (while (search-forward "\n\n" (point-max) t)
- (delete-char -1))
- (goto-char (point-min))
- (when (string-match "\n" output)
- (let (st nd line)
- (while (looking-at ".*\n")
- (setq st (match-beginning 0) nd (match-end 0)
- line (liece-coding-decode-charset-string
- (buffer-substring st (1- nd))))
- (delete-region st nd)
- (let ((liece-message-target (liece-current-nickname))
- (liece-message-speaker nick))
- (liece-display-message line)))))))))
-
-(defun liece-dcc-chat-nick-to-process (nick)
- "Convert NICK to process symbol."
- (let ((alist liece-dcc-process-alist)
- pair)
- (catch 'found
- (while alist
- (setq pair (pop alist))
- (if (and (eq 'chat (cadr pair))
- (liece-nick-equal nick (caddr pair)))
- (throw 'found (car pair))))
- nil)))
-
-(defun liece-dcc-chat-send (nick message)
- "Send MSG string to NICK via DCC chat."
- (let ((process (liece-dcc-chat-nick-to-process nick)))
- (if (not process)
- (liece-message (_ "DCC chat has not been started."))
- (with-current-buffer liece-command-buffer
- (setq message (liece-coding-encode-charset-string message)
- message (if (string-match "\r$" message) message
- (concat message "\r\n")))
- (process-send-string process message)))))
-
-(defun liece-command-dcc-accept ()
- "Dispatch one DCC request."
- (interactive)
- (let* ((object (queue-first liece-dcc-requests))
- (type (liece-dcc-object-type object)))
- (cond ((eq type 'send)
- (liece-command-dcc-receive))
- ((eq type 'chat)
- (liece-command-dcc-chat-connect))
- (t
- (liece-message
- (_ "DCC No request has been arrived."))))))
-
-(defun liece-command-dcc-list ()
- "List files in receive queue."
- (interactive)
- (if (queue-empty liece-dcc-requests)
- (liece-dcc-message (_ "No DCC request here"))
- (let ((i 0) (objects (queue-all liece-dcc-requests)) type)
- (dolist (object objects)
- (setq type (liece-dcc-object-type object))
- (cond ((eq type 'send)
- (liece-dcc-message
- (_ "(%d) %s request %s: %s (%s bytes)")
- i (upcase (symbol-name type))
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object)))
- ((eq type 'chat)
- (liece-dcc-message
- (_ "(%d) %s request from %s")
- i (upcase (symbol-name type))
- (liece-dcc-object-from object))))
- (incf i)))))
-
-(defun liece-dcc-compare-hostnames (h1 h2)
- "Compare two internet domain hostnames. Return true iff they resolve to the
-same IP-address."
- (or
- (string-equal-ignore-case h1 h2)
- (if liece-dcc-program
- (let ((pob (liece-get-buffer-create "*IRC DCC resolve*"))
- (output) (domatch nil))
- (save-excursion
- (call-process liece-dcc-program nil pob nil "resolve" h1 h2)
- (set-buffer pob)
- (goto-char (point-min))
- (setq output (buffer-substring (point-min) (point-max)))
- (if (string-match "\\([^ ]+\\)\n\\([^ ]+\\)\n" output)
- (if (string= (match-string 1 output)
- (match-string 2 output))
- (setq domatch t))))
- (kill-buffer pob)
- domatch)
- (string-equal-ignore-case h1 h2))))
-
-(provide 'liece-dcc)
-
-;;; liece-dcc.el ends here
projects / packages / blobdiff