X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-rdcc.el;h=21fab6fb5c07efd405e2d929450fd624dfcf4236;hb=4a4b0b7ff3b62f77e956dfd4d1d6d32f6c2fdbb7;hp=7d7c95f04ed40c6c50f2b53ee59d256d759c6e9d;hpb=b297443b32ad1a1504a40a2df83db3d47cf001c7;p=riece diff --git a/lisp/riece-rdcc.el b/lisp/riece-rdcc.el index 7d7c95f..21fab6f 100644 --- a/lisp/riece-rdcc.el +++ b/lisp/riece-rdcc.el @@ -23,6 +23,12 @@ ;;; Code: +(require 'riece-globals) +(require 'riece-misc) +(require 'riece-channel) +(require 'riece-identity) +(require 'riece-ctcp) ;for riece-ctcp-additional-clientinfo + (defgroup riece-rdcc nil "DCC implementation using ruby" :prefix "riece-" @@ -49,11 +55,12 @@ unless address 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 session = server.accept if session total = 0 File.open(" file ") {|file| - while (bytes = file.read(4096)) + while (bytes = file.read(" block-size ")) total += bytes.length puts(\"#{total}\") session.write(bytes) @@ -74,12 +81,33 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" :type 'list :group 'riece-rdcc) +(defcustom riece-rdcc-save-directory nil + "Default directory where received files are saved in." + :type 'directory + :group 'riece-rdcc) + +(defcustom riece-rdcc-block-size 4096 + "Number of bytes sent as a block." + :type 'integer + :group 'riece-rdcc) + (defvar riece-rdcc-requests nil) (defvar riece-rdcc-request-user nil) (defvar riece-rdcc-request-file nil) (defvar riece-rdcc-request-size nil) +(defvar riece-rdcc-temp-file nil) +(defvar riece-rdcc-received-size nil) + +(defvar riece-rdcc-enabled nil) + +(defconst riece-rdcc-description + "DCC file sending extension implemented 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)) @@ -107,30 +135,33 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (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)) - (delete-process process)) + (kill-buffer (process-buffer process))) (defun riece-command-dcc-send (user file) (interactive (let ((completion-ignore-case t)) - (list (completing-read + (list (riece-completing-read-identity "User: " - (mapcar #'list (riece-get-users-on-server))) + (riece-get-users-on-server (riece-current-server-name))) (expand-file-name (read-file-name "File: "))))) - (let ((process - (start-process "DCC" " *DCC*" "ruby" "-rsocket"))) + (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-send-program - 'address - (if riece-rdcc-server-address - (concat "'" riece-rdcc-server-address - "'") - "nil")) - 'file - (concat "'" file "'")))) + (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)) @@ -138,10 +169,13 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (progn (goto-char (point-min)) (not (looking-at "\\([0-9]+\\) \\([0-9]+\\)")))) - (accept-process-output)) + (accept-process-output process)) (if (eq (process-status process) 'run) (let ((address (match-string 1)) - (port (match-string 2))) + (port (match-string 2)) + (filename (file-name-nondirectory file))) + (while (string-match "[ \t]+" filename) + (setq filename (replace-match "_" nil nil filename))) (erase-buffer) (make-local-variable 'riece-rdcc-request-size) (setq riece-rdcc-request-file file @@ -151,31 +185,43 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (set-process-sentinel process #'riece-rdcc-server-sentinel) (riece-send-string (format "PRIVMSG %s :\1DCC SEND %s %s %s %d\1\r\n" - user (file-name-nondirectory file) + (riece-identity-prefix user) + filename address port riece-rdcc-request-size))))))) (defun riece-rdcc-filter (process input) (save-excursion (set-buffer (process-buffer process)) - (goto-char (point-max)) + (erase-buffer) (insert input) - (message "Receiving %s from %s...(%d/%d)" - (file-name-nondirectory buffer-file-name) + (let ((coding-system-for-write 'binary) + jka-compr-compression-info-list jam-zcat-filename-list) + (write-region (point-min) (point-max) riece-rdcc-temp-file t 0)) + (message "Receiving %s from %s...(%s/%s)" + (file-name-nondirectory riece-rdcc-request-file) riece-rdcc-request-user - (1- (point)) - riece-rdcc-request-size))) + (riece-rdcc-format-size + (setq riece-rdcc-received-size (+ (buffer-size) + riece-rdcc-received-size))) + (riece-rdcc-format-size riece-rdcc-request-size)))) (defun riece-rdcc-sentinel (process status) (save-excursion (set-buffer (process-buffer process)) - (unless (= (buffer-size) riece-rdcc-request-size) + (unless (= riece-rdcc-received-size riece-rdcc-request-size) (error "Premature end of file")) (message "Receiving %s from %s...done" - (file-name-nondirectory buffer-file-name) + (file-name-nondirectory riece-rdcc-request-file) riece-rdcc-request-user) - (let ((coding-system-for-write 'binary)) - (save-buffer)))) + (condition-case nil + (progn + (rename-file riece-rdcc-temp-file riece-rdcc-request-file) + (delete-directory (file-name-directory riece-rdcc-temp-file))) + (file-already-exists + (error "Can't save %s. Temporarily saved in %s" + riece-rdcc-request-file riece-rdcc-temp-file)))) + (kill-buffer (process-buffer process))) (defun riece-rdcc-decode-address (address) (with-temp-buffer @@ -192,66 +238,117 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (progn (unless riece-rdcc-requests (error "No request")) - (list - (if (= (length riece-rdcc-requests) 1) - (car riece-rdcc-requests) - (with-output-to-temp-buffer "*Help*" - (let ((requests riece-rdcc-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 index (1+ index) - 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-rdcc-requests)) - (< number 1)) - (error "Invalid number")) - (nth (1- number) riece-rdcc-requests))) - (expand-file-name (read-file-name "Save as: "))))) - (let* (selective-display + (let* ((request + (if (= (length riece-rdcc-requests) 1) + (car riece-rdcc-requests) + (with-output-to-temp-buffer "*Help*" + (let ((requests riece-rdcc-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 index (1+ index) + 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-rdcc-requests)) + (< number 1)) + (error "Invalid number")) + (nth (1- number) riece-rdcc-requests)))) + (default-name (expand-file-name + (convert-standard-filename (nth 1 request)) + (or riece-rdcc-save-directory + default-directory)))) + (list request + (expand-file-name + (read-file-name + (concat "Save as (default " + (file-name-nondirectory default-name) ") ") + (file-name-directory default-name) + default-name)))))) + (let* ((temp-file (expand-file-name + (file-name-nondirectory file) + (expand-file-name (make-temp-name "riece-rdcc") + (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)))) + (orig-mode (default-file-modes)) + selective-display (coding-system-for-read 'binary) (coding-system-for-write 'binary) - (process (open-network-stream - "DCC" " *DCC*" + process) + (unwind-protect + (progn + (set-default-file-modes 448) + ;; This may throw an error. + (make-directory (file-name-directory temp-file))) + (set-default-file-modes orig-mode)) + (setq process (open-network-stream + "DCC" (generate-new-buffer " *DCC*") (riece-rdcc-decode-address (nth 2 request)) - (nth 3 request)))) + (nth 3 request))) (setq riece-rdcc-requests (delq request riece-rdcc-requests)) (with-current-buffer (process-buffer process) - (set-buffer-multibyte nil) + (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) (buffer-disable-undo) - (setq buffer-file-name file) + (erase-buffer) (make-local-variable 'riece-rdcc-request-user) (setq riece-rdcc-request-user (car request)) + (make-local-variable 'riece-rdcc-request-file) + (setq riece-rdcc-request-file file) (make-local-variable 'riece-rdcc-request-size) - (setq riece-rdcc-request-size (nth 4 request))) + (setq riece-rdcc-request-size (nth 4 request)) + (make-local-variable 'riece-rdcc-temp-file) + (setq riece-rdcc-temp-file temp-file) + (make-local-variable 'riece-rdcc-received-size) + (setq riece-rdcc-received-size 0)) (set-process-filter process #'riece-rdcc-filter) (set-process-sentinel process #'riece-rdcc-sentinel))) +(defun riece-rdcc-format-size (size) + (if (< size 1024) + (format "%0.1f" size) + (setq size (/ size 1024.0)) + (if (< size 1024) + (format "%0.1fKB" size) + (setq size (/ size 1024.0)) + (if (< size 1024) + (format "%0.1fMB" size) + (format "%0.1fGB" (/ size 1024.0)))))) + (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 riece-rdcc-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) - (cdr (riece-identity-assoc-no-server - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer (riece-make-identity + target riece-server-name)))) (user (riece-prefix-nickname prefix))) (setq riece-rdcc-requests (cons (list user file address port size) riece-rdcc-requests)) - (riece-insert-change buffer (format "DCC SEND from %s\n" user)) + (message "%s" + (with-current-buffer (window-buffer (selected-window)) + (substitute-command-keys + (format + "Type \\[riece-command-dcc-receive] to receive" + user)))) + (riece-insert-change buffer (format "DCC SEND from %s: %s (%s)\n" + user file + (riece-rdcc-format-size size))) (riece-insert-change (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -259,11 +356,13 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" riece-dialogue-buffer) (concat (riece-concat-server-name - (format "DCC SEND from %s (%s) to %s" + (format "DCC SEND from %s (%s) to %s: %s (%s)" user (riece-strip-user-at-host (riece-prefix-user-at-host prefix)) - target)) + (riece-decode-coding-string target) + file + (riece-rdcc-format-size size))) "\n"))) t))) @@ -272,9 +371,18 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (defvar riece-dialogue-mode-map) (defun riece-rdcc-insinuate () - (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request) + (add-to-list 'riece-ctcp-additional-clientinfo "DCC") + (add-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)) + (define-key riece-dialogue-mode-map "\C-dr" 'riece-command-dcc-receive) + (setq riece-rdcc-enabled t)) + +(defun riece-rdcc-disable () + (define-key riece-dialogue-mode-map "\C-ds" nil) + (define-key riece-dialogue-mode-map "\C-dr" nil) + (setq riece-rdcc-enabled nil)) (provide 'riece-rdcc)