X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Friece-rdcc.el;h=3c109ae48e29a4dca73bac4ece260e035b1eb987;hb=f102033747fc016c4a8929607a818f84e943d79e;hp=55eccc52451904b123139dadd5592db58763513e;hpb=b106b5693b95a3be7f0d6dceef245afb1701f60a;p=elisp%2Friece.git diff --git a/lisp/riece-rdcc.el b/lisp/riece-rdcc.el index 55eccc5..3c109ae 100644 --- a/lisp/riece-rdcc.el +++ b/lisp/riece-rdcc.el @@ -1,4 +1,4 @@ -;;; riece-rdcc.el --- ruby implementation of DCC add-on +;;; riece-rdcc.el --- DCC file sending protocol support (written in Ruby) ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -18,8 +18,12 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; NOTE: This is an add-on module for Riece. ;;; Code: @@ -28,9 +32,10 @@ (require 'riece-channel) (require 'riece-identity) (require 'riece-ctcp) ;for riece-ctcp-additional-clientinfo +(require 'riece-ruby) (defgroup riece-rdcc nil - "DCC implementation using ruby" + "DCC written in Ruby." :prefix "riece-" :group 'riece) @@ -40,13 +45,9 @@ Only used for sending files." :type 'string :group 'riece-rdcc) -(defcustom riece-rdcc-ruby-command "ruby" - "Command name for Ruby interpreter." - :type 'string - :group 'riece-rdcc) - (defcustom riece-rdcc-send-program '("\ +require 'socket' address = " address " unless address sock = UDPSocket.new @@ -54,16 +55,18 @@ unless address address = sock.getsockname[4 .. 7].unpack('CCCC').join('.') end server = TCPServer.new(address, 0) -puts(\"#{server.addr[3].split(/\\./).collect{|c| c.to_i}.pack('CCCC').unpack('N')[0]} #{server.addr[1]}\") -$stdout.flush +output(\"#{server.addr[3].split(/\\./).collect{|c| c.to_i}.pack('CCCC').unpack('N')[0]} #{server.addr[1]}\") session = server.accept if session total = 0 File.open(" file ") {|file| while (bytes = file.read(" block-size ")) total += bytes.length - puts(\"#{total}\") + output(total) session.write(bytes) + begin + buf = session.read(4) + end until buf.unpack('N')[0] == total end } session.close @@ -74,9 +77,8 @@ end :group 'riece-rdcc) (defcustom riece-rdcc-decode-address-program - '("\ -puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" - address " >> 8 & 0xFF}.#{" address " & 0xFF}\")") + '("\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" + address " >> 8 & 0xFF}.#{" address " & 0xFF}\"") "Ruby program to numeric IP address." :type 'list :group 'riece-rdcc) @@ -86,7 +88,7 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" :type 'directory :group 'riece-rdcc) -(defcustom riece-rdcc-block-size 4096 +(defcustom riece-rdcc-block-size 1024 "Number of bytes sent as a block." :type 'integer :group 'riece-rdcc) @@ -100,37 +102,36 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (defvar riece-rdcc-temp-file nil) (defvar riece-rdcc-received-size nil) +(defconst riece-rdcc-description + "DCC file sending protocol support (written in Ruby.)") + (defvar temporary-file-directory) (defvar jka-compr-compression-info-list) (defvar jam-zcat-filename-list) -(defun riece-rdcc-substitute-variables (program variable value) - (setq program (copy-sequence program)) - (let ((pointer program)) - (while pointer - (setq pointer (memq variable program)) - (if pointer - (setcar pointer value))) - program)) - -(defun riece-rdcc-server-filter (process input) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert input) - (goto-char (point-min)) - (while (and (not (eobp)) - (looking-at "\\([0-9]+\\)\n")) - (message "Sending %s...(%s/%d)" - riece-rdcc-request-file - (match-string 1) riece-rdcc-request-size) - (forward-line)) - (unless (eobp) - (delete-region (point-min) (point))))) - -(defun riece-rdcc-server-sentinel (process status) - (with-current-buffer (process-buffer process) - (message "Sending %s...done" riece-rdcc-request-file)) - (kill-buffer (process-buffer process))) + +(defun riece-rdcc-output-handler (name output time) + (if (string-match "\\([0-9]+\\) \\([0-9]+\\)" output) + (let ((address (match-string 1 output)) + (port (match-string 2 output))) + (riece-send-string + (format "PRIVMSG %s :\1DCC SEND %s %s %s %d\1\r\n" + (riece-identity-prefix + (riece-ruby-property name 'riece-rdcc-request-user)) + (file-name-nondirectory + (riece-ruby-property name 'riece-rdcc-request-file)) + address port + (riece-ruby-property name 'riece-rdcc-request-size))))) + (riece-ruby-set-output-handler name #'riece-rdcc-output-handler-2)) + +(defun riece-rdcc-output-handler-2 (name output time) + (message "Sending %s...(%s/%d)" + (riece-ruby-property name 'riece-rdcc-request-file) + (string-to-number output) + (riece-ruby-property name 'riece-rdcc-request-size))) + +(defun riece-rdcc-exit-handler (name) + (message "Sending %s...done" + (riece-ruby-property name 'riece-rdcc-request-file))) (defun riece-command-dcc-send (user file) (interactive @@ -139,48 +140,25 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" "User: " (riece-get-users-on-server (riece-current-server-name))) (expand-file-name (read-file-name "File: "))))) - (let* ((process-connection-type nil) - (process (start-process "DCC" (generate-new-buffer " *DCC*") - "ruby" "-rsocket"))) - (process-send-string process - (apply #'concat - (riece-rdcc-substitute-variables - (riece-rdcc-substitute-variables - (riece-rdcc-substitute-variables - riece-rdcc-send-program - 'address - (if riece-rdcc-server-address - (concat "'" riece-rdcc-server-address - "'") - "nil")) - 'file - (concat "'" file "'")) - 'block-size - (number-to-string riece-rdcc-block-size)))) - (process-send-eof process) - (save-excursion - (set-buffer (process-buffer process)) - (while (and (eq (process-status process) 'run) - (progn - (goto-char (point-min)) - (not (looking-at "\\([0-9]+\\) \\([0-9]+\\)")))) - (accept-process-output process)) - (if (eq (process-status process) 'run) - (let ((address (match-string 1)) - (port (match-string 2))) - (erase-buffer) - (make-local-variable 'riece-rdcc-request-size) - (setq riece-rdcc-request-file file - riece-rdcc-request-size (nth 7 (file-attributes file))) - (set-buffer-modified-p nil) - (set-process-filter process #'riece-rdcc-server-filter) - (set-process-sentinel process #'riece-rdcc-server-sentinel) - (riece-send-string - (format "PRIVMSG %s :\1DCC SEND %s %s %s %d\1\r\n" - (riece-identity-prefix user) - (file-name-nondirectory file) - address port - riece-rdcc-request-size))))))) + (let ((name (riece-ruby-execute + (riece-ruby-substitute-variables + riece-rdcc-send-program + (list (cons 'address + (if riece-rdcc-server-address + (concat "'" riece-rdcc-server-address + "'") + "nil")) + (cons 'file + (concat "'" file "'")) + (cons 'block-size + (number-to-string + riece-rdcc-block-size))))))) + (riece-ruby-set-property name 'riece-rdcc-request-user user) + (riece-ruby-set-property name 'riece-rdcc-request-file file) + (riece-ruby-set-property name 'riece-rdcc-request-size + (nth 7 (file-attributes file))) + (riece-ruby-set-output-handler name #'riece-rdcc-output-handler) + (riece-ruby-set-exit-handler name #'riece-rdcc-exit-handler))) (defun riece-rdcc-filter (process input) (save-excursion @@ -189,14 +167,22 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (insert input) (let ((coding-system-for-write 'binary) jka-compr-compression-info-list jam-zcat-filename-list) - (append-to-file (point-min) (point-max) riece-rdcc-temp-file)) + (write-region (point-min) (point-max) riece-rdcc-temp-file t 0)) + (setq riece-rdcc-received-size (+ (buffer-size) riece-rdcc-received-size)) + (process-send-string + process + (format "%c%c%c%c" + (lsh riece-rdcc-received-size -24) + (logand (lsh riece-rdcc-received-size -16) 255) + (logand (lsh riece-rdcc-received-size -8) 255) + (logand riece-rdcc-received-size 255))) (message "Receiving %s from %s...(%s/%s)" (file-name-nondirectory riece-rdcc-request-file) riece-rdcc-request-user - (riece-rdcc-format-size - (setq riece-rdcc-received-size (+ (buffer-size) - riece-rdcc-received-size))) - (riece-rdcc-format-size riece-rdcc-request-size)))) + (riece-rdcc-format-size riece-rdcc-received-size) + (riece-rdcc-format-size riece-rdcc-request-size)) + (if (= riece-rdcc-received-size riece-rdcc-request-size) + (set-process-filter process nil)))) (defun riece-rdcc-sentinel (process status) (save-excursion @@ -216,14 +202,15 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (kill-buffer (process-buffer process))) (defun riece-rdcc-decode-address (address) - (with-temp-buffer - (call-process riece-rdcc-ruby-command nil t nil "-e" - (apply #'concat - (riece-rdcc-substitute-variables - riece-rdcc-decode-address-program - 'address - address))) - (buffer-substring (point-min) (1- (point-max))))) + (let ((name (riece-ruby-execute + (riece-ruby-substitute-variables + riece-rdcc-decode-address-program + (list (cons 'address address))))) + response) + (while (equal (nth 2 (setq response (riece-ruby-inspect name))) "running") + (accept-process-output riece-ruby-process)) + (riece-ruby-clear name) + (nth 1 response))) (defun riece-command-dcc-receive (request file) (interactive @@ -253,8 +240,9 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (error "Invalid number")) (nth (1- number) riece-rdcc-requests)))) (default-name (expand-file-name - (nth 1 request) (or riece-rdcc-save-directory - default-directory)))) + (convert-standard-filename (nth 1 request)) + (or riece-rdcc-save-directory + default-directory)))) (list request (expand-file-name (read-file-name @@ -315,13 +303,15 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (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))) + (when (and (get 'riece-rdcc 'riece-addon-enabled) + (string-match + "SEND \\(\\([^ ]+\\)\\|\"\\(.+\\)\"\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" + message)) + (let ((file (or (match-string 2 message) + (match-string 3 message))) + (address (match-string 4 message)) + (port (string-to-number (match-string 5 message))) + (size (string-to-number (match-string 6 message))) (buffer (if (riece-channel-p target) (riece-channel-buffer (riece-make-identity target riece-server-name)))) @@ -361,10 +351,21 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (defvar riece-dialogue-mode-map) (defun riece-rdcc-insinuate () (add-to-list 'riece-ctcp-additional-clientinfo "DCC") - (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request) + (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request)) + +(defun riece-rdcc-uninstall () + (setq riece-ctcp-additional-clientinfo + (delete "DCC" riece-ctcp-additional-clientinfo)) + (remove-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request)) + +(defun riece-rdcc-enable () (define-key riece-dialogue-mode-map "\C-ds" 'riece-command-dcc-send) (define-key riece-dialogue-mode-map "\C-dr" 'riece-command-dcc-receive)) +(defun riece-rdcc-disable () + (define-key riece-dialogue-mode-map "\C-ds" nil) + (define-key riece-dialogue-mode-map "\C-dr" nil)) + (provide 'riece-rdcc) ;;; riece-rdcc.el ends here