From: ueno Date: Sun, 1 Jun 2003 04:36:53 +0000 (+0000) Subject: * riece-ndcc.el: New add-on. X-Git-Tag: riece-0_0_3~15 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b5d372baf12d74c86f2ccba1b4738f71cbcb297e;p=elisp%2Friece.git * riece-ndcc.el: New add-on. * COMPILE (riece-modules): Add riece-ndcc * Makefile.am (EXTRA_DIST): Add riece-ndcc.el --- diff --git a/lisp/COMPILE b/lisp/COMPILE index 153f1fa..cf8a595 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -5,45 +5,48 @@ (cons (if (featurep 'xemacs) 'riece-xemacs 'riece-emacs) - '(riece-globals - riece-options - riece-version - riece-inlines - riece-coding - riece-complete + (append + '(riece-globals + riece-options + riece-version + riece-inlines + riece-coding + riece-complete - ;; riece-identity -+-> riece-channel - ;; +-> riece-user - riece-identity - riece-channel - riece-user + ;; riece-identity -+-> riece-channel + ;; +-> riece-user + riece-identity + riece-channel + riece-user - riece-misc - riece-display - riece-server + riece-misc + riece-display + riece-server - ;; riece-channel -+-> riece-naming - ;; riece-user -+ - riece-naming - riece-message + ;; riece-channel -+-> riece-naming + ;; riece-user -+ + riece-naming + riece-message - ;; riece-filter calls riece-{handle,000,200,300,400,500} - riece-filter - riece-handle - riece-000 - riece-200 - riece-300 - riece-400 - riece-500 + ;; riece-filter calls riece-{handle,000,200,300,400,500} + riece-filter + riece-handle + riece-000 + riece-200 + riece-300 + riece-400 + riece-500 - riece-commands - riece + riece-commands + riece - ;; add-ons - riece-ctcp - riece-highlight - riece-url - riece-unread)))) + ;; add-ons + riece-ctcp + riece-highlight + riece-url + riece-unread) + (if (fboundp 'make-network-process) + '(riece-ndcc)))))) (defun riece-compile-modules (modules) (let ((load-path (cons nil load-path))) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f9a5b62..fd598d2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2003-06-01 Daiki Ueno + + * riece-ndcc.el: New add-on. + * COMPILE (riece-modules): Add riece-ndcc + * Makefile.am (EXTRA_DIST): Add riece-ndcc.el + 2003-05-31 Daiki Ueno * riece-server.el (riece-open-server): Simplify message. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 13fbab3..1c2c10e 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -6,7 +6,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-inlines.el riece-message.el riece-misc.el riece-naming.el \ riece-options.el riece-server.el riece-user.el riece-version.el \ riece-xemacs.el riece.el \ - riece-ctcp.el riece-url.el riece-unread.el + riece-ctcp.el riece-url.el riece-unread.el riece-ndcc.el CLEANFILES = auto-autoloads.el custom-load.el *.elc FLAGS ?= -batch -q -no-site-file diff --git a/lisp/riece-ndcc.el b/lisp/riece-ndcc.el new file mode 100644 index 0000000..0ae4b85 --- /dev/null +++ b/lisp/riece-ndcc.el @@ -0,0 +1,227 @@ +;;; riece-ndcc.el --- elisp native DCC add-on +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; 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. + +;;; Code: + +(require 'calc) + +(defgroup riece-ndcc nil + "Elisp native DCC implementation" + :prefix "riece-" + :group 'riece) + +(defcustom riece-ndcc-server-address "127.0.0.1" + "Local address of the DCC server. +Only used for sending files." + :type 'vector + :group 'riece-ndcc) + +(defvar riece-ndcc-requests nil) + +(defvar riece-ndcc-request-user nil) +(defvar riece-ndcc-request-size nil) + +(defun riece-ndcc-encode-address (address) + (unless (string-match + "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" + address) + (error "% is not an IP address" address)) + (let ((calc-number-radix 10)) + (calc-eval (format "%s * (2 ** 24) + %s * (2 **16) + %s * (2 ** 8) + %s" + (match-string 1 address) + (match-string 2 address) + (match-string 3 address) + (match-string 4 address))))) + +(defun riece-ndcc-decode-address (address) + (format "%d.%d.%d.%d" + (floor (string-to-number + (calc-eval (format "(%s / (2 ** 24)) %% 256" address)))) + (floor (string-to-number + (calc-eval (format "(%s / (2 ** 16)) %% 256" address)))) + (floor (string-to-number + (calc-eval (format "(%s / (2 ** 8)) %% 256" address)))) + (floor (string-to-number + (calc-eval (format "%s %% 256" address)))))) + +(defun riece-ndcc-server-sentinel (process status) + (when (string-match "^open from " status) + (let ((parent-name + (if (string-match " <[^>]+>$" (process-name process)) + (substring (process-name process) 0 (match-beginning 0))))) + (save-excursion + (set-buffer (process-buffer (get-process parent-name))) + (delete-process parent-name) + (goto-char (point-min)) + (while (not (eobp)) + (process-send-region process + (point) + (goto-char (min (+ 1024 (point)) (point-max)))) + (message "Sending %s...(%d/%d)" + (buffer-file-name) (1- (point)) (buffer-size))) + (message "Sending %s...done" + (buffer-file-name)))) + (kill-buffer (process-buffer process)) + (delete-process process))) + +(defun riece-command-dcc-send (user file) + (interactive + (let ((completion-ignore-case t)) + (unless riece-ndcc-server-address + (error "Set riece-ndcc-server-address to your host")) + (list (completing-read + "User: " + (mapcar #'list (riece-get-users-on-server))) + (expand-file-name (read-file-name "File: "))))) + (let* (selective-display + (coding-system-for-read 'binary) + format-alist + jka-compr-compression-info-list + (buffer (find-file-noselect file)) + process) + (with-current-buffer buffer ;To throw an error when the + (setq buffer-read-only t)) ;process has input. + (setq process (make-network-process :name "DCC" :buffer buffer + :host riece-ndcc-server-address + :server t :service t + :coding 'binary + :sentinel 'riece-ndcc-server-sentinel)) + (riece-send-string + (format "PRIVMSG %s :\1DCC SEND %s %s %d %d\1\r\n" + user (file-name-nondirectory file) + (riece-ndcc-encode-address riece-ndcc-server-address) + (nth 1 (process-contact process)) + (nth 7 (file-attributes file)))))) + +(defun riece-ndcc-filter (process input) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert input) + (message "Receiving %s from %s...(%d/%d)" + (file-name-nondirectory buffer-file-name) + riece-ndcc-request-user + (1- (point)) + riece-ndcc-request-size))) + +(defun riece-ndcc-sentinel (process status) + (save-excursion + (set-buffer (process-buffer process)) + (unless (= (buffer-size) riece-ndcc-request-size) + (error "Premature end of file")) + (message "Receiving %s from %s...done" + (file-name-nondirectory buffer-file-name) + riece-ndcc-request-user) + (let ((coding-system-for-write 'binary)) + (save-buffer)))) + +(defun riece-command-dcc-receive (request file) + (interactive + (progn + (unless riece-ndcc-requests + (error "No request")) + (list + (if (= (length riece-ndcc-requests) 1) + (car riece-ndcc-requests) + (with-output-to-temp-buffer "*Help*" + (let ((requests riece-ndcc-requests) + (index 1)) + (while requests + (princ (format "%2d: %s %s (%d bytes)\n" + index + (car (car requests)) + (nth 1 (car requests)) + (nth 4 (car requests)))) + (setq requests (cdr requests))))) + (let ((number (read-string "Request#: "))) + (unless (string-match "^[0-9]+$" number) + (error "Not a number")) + (if (or (> (setq number (string-to-number number)) + (length riece-ndcc-requests)) + (< number 1)) + (error "Invalid number")) + (nth (1- number) riece-ndcc-requests))) + (expand-file-name (read-file-name "Save as: "))))) + (let* (selective-display + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (process (open-network-stream + "DCC" " *DCC*" + (riece-ndcc-decode-address (nth 2 request)) + (nth 3 request)))) + (with-current-buffer (process-buffer process) + (set-buffer-multibyte nil) + (buffer-disable-undo) + (setq buffer-file-name file) + (make-local-variable 'riece-ndcc-request-user) + (setq riece-ndcc-request-user (car request)) + (make-local-variable 'riece-ndcc-request-size) + (setq riece-ndcc-request-size (nth 4 request))) + (set-process-filter process #'riece-ndcc-filter) + (set-process-sentinel process #'riece-ndcc-sentinel))) + +(defun riece-handle-dcc-request (prefix target message) + (let ((case-fold-search t)) + (when (string-match + "SEND \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" + message) + (let ((file (match-string 1 message)) + (address (match-string 2 message)) + (port (string-to-number (match-string 3 message))) + (size (string-to-number (match-string 4 message))) + (buffer (if (riece-channel-p target) + (cdr (riece-identity-assoc-no-server + (riece-make-identity target) + riece-channel-buffer-alist)))) + (user (riece-prefix-nickname prefix))) + (setq riece-ndcc-requests + (cons (list user file address port size) + riece-ndcc-requests)) + (riece-insert-change buffer (format "DCC SEND from %s\n" user)) + (riece-insert-change + (if (and riece-channel-buffer-mode + (not (eq buffer riece-channel-buffer))) + (list riece-dialogue-buffer riece-others-buffer) + riece-dialogue-buffer) + (concat + (riece-concat-server-name + (format "DCC SEND from %s (%s) to %s" + user + (riece-strip-user-at-host + (riece-prefix-user-at-host prefix)) + target)) + "\n"))) + t))) + +(defun riece-ndcc-requires () + '(riece-ctcp)) + +(defvar riece-dialogue-mode-map) +(defun riece-ndcc-insinuate () + (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request) + (define-key riece-dialogue-mode-map "\C-ds" 'riece-command-dcc-send) + (define-key riece-dialogue-mode-map "\C-dr" 'riece-command-dcc-receive)) + +(provide 'riece-ndcc) + +;;; riece-ndcc.el ends here