home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / irchat-pj / irchat-pj-2.4.24.22.tar.gz / irchat-pj-2.4.24.22.tar / irchat-pj-2.4.24.22 / irchat-dcc.el < prev    next >
Text File  |  1999-12-19  |  17KB  |  468 lines
  1. ;; irchat-dcc.el  (for irchat-2.4jp version)
  2. ;; Copyright (C) 1995,1996 Takahiro Kikuchi
  3.  
  4. ;; Author:   Takahiro Kikuchi <kick@kyoto.wide.ad.jp>
  5. ;; Created:  Mar 19, 1995
  6. ;; Modified: Mar 29, 1995
  7. ;; Bug Fixed: Aug 8, 1996  special thanks to ohm@kyoto.wide.ad.jp
  8.  
  9. (defvar irchat-dcc-list nil)
  10. (defvar irchat-dcc-partner nil)
  11.  
  12. (defun irchat-dcc-request (from to rest)
  13.   "DCC request from user"
  14.   (cond
  15.    ((null rest)
  16.     (irchat-insert0 (format "*** Bad format DCC from %s\n" from))
  17.     (irchat-ctcp-reply from (format "ERRMSG :DCC: bad format")))
  18.    ((string-match "^SEND \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
  19.     (let ((file (matching-substring rest 1))
  20.       (host (matching-substring rest 2))
  21.       (port (matching-substring rest 3))
  22.       (size (matching-substring rest 4)))
  23.       (irchat-dcc-add-object
  24.        (list 'GET 'Offered nil (current-time-string)
  25.          from host port file size file))
  26.       (irchat-insert-special
  27.        (format "*** DCC SEND request from %s: %s (%s bytes)\n"
  28.            from file size) t) ;; GAGA
  29.       (if irchat-dcc-auto-get-file
  30.       (irchat-Command-dcc-get))))
  31.    ((string-match "^CHAT \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
  32.     (let ((file (matching-substring rest 1))
  33.       (host (matching-substring rest 2))
  34.       (port (matching-substring rest 3)))
  35.       (irchat-dcc-add-object
  36.        (list 'CHAT 'Offered nil (current-time-string)
  37.          from host port file))
  38.       (irchat-insert-special (format "*** DCC CHAT request from %s\n"
  39.                  from) t))) ;; GAGA
  40.    ((string-match "^CANCEL \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
  41.     (let ((file (matching-substring rest 1))
  42.       (host (matching-substring rest 2))
  43.       (port (matching-substring rest 3)))
  44.       (irchat-dcc-cancel from host port file)))
  45.    (t
  46.     (irchat-insert0 (format "*** Unknown DCC from %s: %s\n" from rest))
  47.     (irchat-ctcp-reply from (format "ERRMSG :DCC: bad command")))))
  48.  
  49. (defun irchat-dcc-cancel (from host port file)
  50.   "DCC cancel request from user"
  51.   (let ((dcc-list irchat-dcc-list) dcc-object found)
  52.     (while (and dcc-list (not found))
  53.       (setq dcc-object (car dcc-list)
  54.         dcc-list (cdr dcc-list))
  55.       (if (and (string= (nth 4 dcc-object) from)
  56.            (string= (nth 5 dcc-object) host)
  57.            (string= (nth 6 dcc-object) port)
  58.            (string= (nth 7 dcc-object) file))
  59.       (setq found dcc-object)))
  60.     (if found
  61.     (progn
  62.       (irchat-insert0 irchat-dcc-list-header)
  63.       (irchat-insert0 (irchat-dcc-list-object 0 dcc-object))
  64.       (irchat-insert0 (format "*** DCC canceled from %s\n" from))
  65.       (if (nth 2 dcc-object)
  66.           (delete-process (nth 2 dcc-object)))
  67.       (irchat-dcc-delete-object dcc-object)))))
  68.     
  69.  
  70. (defun irchat-Command-dcc-send ()
  71.   "Send file to user via DCC"
  72.   (interactive)
  73.   (let (proc
  74.     (file (expand-file-name
  75.            (read-file-name "File to send: " default-directory nil))))
  76.     (setq irchat-dcc-partner
  77.     (irchat-completing-default-read "To whom: "
  78.      (append irchat-nick-alist irchat-channel-alist)
  79.      '(lambda (s) t) nil irchat-dcc-partner))
  80.     (setq proc (start-process irchat-dcc-program nil irchat-dcc-program
  81.                   "file" "send" file))
  82.     (irchat-pj-set-process-coding-system proc)
  83.     (irchat-dcc-add-object
  84.      (list 'SEND 'Setting proc (current-time-string)
  85.        irchat-dcc-partner nil nil file nil))
  86.     (set-process-buffer proc
  87.             (get-buffer-create (format " DCC:%s" (process-id proc))))
  88.     (set-process-filter proc 'irchat-dcc-filter)
  89.     (set-process-sentinel proc 'irchat-dcc-sentinel)))
  90.  
  91. (defun irchat-dcc-filter (process output)
  92.   (let ((obuf (current-buffer)) (pbuf (process-buffer process)))
  93.     (set-buffer pbuf)
  94.     (goto-char (point-max))
  95.     (insert output)
  96.     (goto-char (point-min))
  97.     (while (looking-at ".*\n")
  98.       (goto-char (match-end 0))
  99.       (setq output (buffer-substring 1 (point)))
  100.       (delete-region 1 (point))
  101.       (set-buffer obuf)
  102.       (irchat-dcc-filter-sub process output)
  103.       (set-buffer pbuf))
  104.     (set-buffer obuf)))
  105.  
  106. (defun irchat-dcc-filter-sub (process output)
  107.   (let* ((dcc-object (irchat-dcc-get-process-object process)) filename
  108.      (nick (nth 4 dcc-object))
  109.      (file (nth 7 dcc-object))
  110.      (size (nth 8 dcc-object)))
  111.     (if (null dcc-object)
  112.     (delete-process process)   ;; garbage process
  113.       (cond
  114.        ((eq (nth 1 dcc-object) 'Active)
  115.     (irchat-dcc-chat-loop-filter-sub process output))
  116.        ((string-match "^DCC GETTING" output)
  117.     ;; 'Connect -> 'Getting
  118.     (setcar (nthcdr 1 dcc-object) 'Getting)
  119.     (irchat-insert0
  120.      (format "*** DCC getting file %s (%s bytes) from %s\n"
  121.          file size nick)))
  122.        ((string-match "^DCC SEND \\([^ ]+\\) \\([^ ]+\\) \\(.+\\)\n" output)
  123.     ;; 'Setting -> 'Waiting
  124.     (let ((host (matching-substring output 1))
  125.           (port (matching-substring output 2))
  126.           (size (matching-substring output 3)))
  127.       (setcar (nthcdr 1 dcc-object) 'Waiting)
  128.       (setcar (nthcdr 5 dcc-object) host)
  129.       (setcar (nthcdr 6 dcc-object) port)
  130.       (setcar (nthcdr 8 dcc-object) size)
  131.       (setq filename (if (string-match ".*/\\(.*\\)" file)
  132.                  (matching-substring file 1) file))
  133.       (irchat-send "PRIVMSG %s :DCC SEND %s %s %s %s"
  134.                nick filename host port size)
  135.       (irchat-insert0
  136.        (format "*** DCC SEND request file %s (%s bytes) to %s\n"
  137.            file size nick))))
  138.        ((string-match "^DCC SENDING" output)
  139.     ;; 'Waiting -> 'Sending
  140.     (setcar (nthcdr 1 dcc-object) 'Sending)
  141.     (irchat-insert0
  142.      (format "*** DCC sending file %s (%s bytes) to %s\n"
  143.          file size nick)))
  144.        ((string-match "^DCC CHAT \\([^ ]+\\) \\([^ ]+\\)\n" output)
  145.     ;; 'Setting -> 'Waiting
  146.     (let ((host (matching-substring output 1))
  147.           (port (matching-substring output 2)))
  148.       (setcar (nthcdr 1 dcc-object) 'Waiting)
  149.       (setcar (nthcdr 5 dcc-object) host)
  150.       (setcar (nthcdr 6 dcc-object) port)
  151.       (irchat-send "PRIVMSG %s :DCC CHAT chat %s %s"
  152.                nick host port)
  153.       (irchat-insert0
  154.        (format "*** DCC CHAT request to %s\n" nick))))
  155.        ((string-match "^DCC CHATTING" output)
  156.     ;; 'Waiting or 'Connect -> 'Active
  157.     (set-process-filter process 'irchat-dcc-chat-loop-filter)
  158.     (setcar (nthcdr 1 dcc-object) 'Active)
  159.     (irchat-insert0
  160.      (format "*** DCC CHAT connection (with %s) established.\n" nick)))
  161.        ((string-match "^DCC REPORT \\(.+\\)" output)
  162.     (message "DCC report: %s" (matching-substring output 1)))
  163.        ((string-match "^DCC ERROR \\(.+\\)" output)
  164.     (irchat-insert0
  165.      (format "*** DCC ERROR: %s\n" (matching-substring output 1))))
  166.        ((string-match "^DCC ERROR1 \\(.+\\)" output)
  167.     (irchat-dcc-add-object 
  168.      (list 'GET 'Offered nil
  169.            (nth 3 dcc-object) (nth 4 dcc-object) (nth 5 dcc-object)
  170.            (nth 6 dcc-object) (nth 9 dcc-object) (nth 8 dcc-object)))
  171.     (irchat-insert0
  172.      (format "*** DCC ERROR: %s\n" (matching-substring output 1))))
  173.        (t
  174.     (irchat-insert0
  175.      (format "*** DCC FATAL ERROR: %s\n" (matching-substring output 1)))
  176.     nil)))))
  177.  
  178. (defun irchat-dcc-sentinel (process output)
  179.   (let* ((dcc-object (irchat-dcc-get-process-object process))
  180.      (type (nth 0 dcc-object))
  181.      (nick (nth 4 dcc-object))
  182.      (file (nth 7 dcc-object))
  183.      (size (nth 8 dcc-object)))
  184.     (if (null dcc-object) 
  185.     (delete-process process)   ;; garbage process
  186.       (cond
  187.        ((and (string-match "^finished" output) (eq type 'SEND))
  188.     ;; 'Sending -> 'Done
  189.     (irchat-insert0
  190.      (format "*** DCC sent file %s (%s bytes) to %s\n" file size nick))
  191.     (message ""))
  192.        ((and (string-match "^finished" output) (eq type 'GET))
  193.     ;; 'Getting -> 'Done
  194.     (irchat-insert0
  195.      (format "*** DCC got file %s (%s bytes) from %s\n" file size nick))
  196.     (message ""))
  197.        ((and (string-match "^finished" output) (eq type 'CHAT))
  198.     ;; 'Active -> 'Done
  199.     (irchat-insert0
  200.      (format "*** DCC CHAT connection (with %s) finished.\n" nick)))
  201.        (t
  202.     (irchat-insert0
  203.      (format "*** DCC ERROR process (%s %s %s %s) is %s\n"
  204.          (prin1-to-string (nth 0 dcc-object)) ; type
  205.          (if (nth 7 dcc-object) (nth 7 dcc-object) "") ; file
  206.          (cond
  207.           ((eq (nth 0 dcc-object) 'SEND) "to")
  208.           ((eq (nth 0 dcc-object) 'GET) "from")
  209.           ((eq (nth 0 dcc-object) 'CHAT) "with"))
  210.          (nth 4 dcc-object) ; nick
  211.          (substring output 0 (1- (length output)))))))
  212.       (irchat-dcc-delete-object dcc-object))))
  213.  
  214.  
  215. (defun irchat-Command-dcc-kill ()
  216.   "Kill DCC process and object"
  217.   (interactive)
  218.   (let (dcc-object number)
  219.     (if (numberp current-prefix-arg)
  220.     (setq number current-prefix-arg)
  221.       (setq number nil))
  222.     (if number
  223.     (setq dcc-object (irchat-dcc-get-object number))
  224.       (setq dcc-object (irchat-dcc-get-offered-object)))
  225.     (if (null dcc-object)
  226.     (if number
  227.         (irchat-insert0 (format "*** DCC No.%d --- not found\n" number))
  228.       (irchat-insert0 (format "*** There is no offered DCC\n")))
  229.       (irchat-insert0 irchat-dcc-list-header)
  230.       (irchat-insert0 (irchat-dcc-list-object number dcc-object))
  231.       (if (y-or-n-p "Kill this DCC? ")
  232.       (if (irchat-dcc-match-object dcc-object) ;;still alive?
  233.           (let ((nick (nth 4 dcc-object))
  234.             (host (nth 5 dcc-object))
  235.             (port (nth 6 dcc-object))
  236.             (file (nth 7 dcc-object)))
  237.         (irchat-send "PRIVMSG %s :DCC CANCEL %s %s %s"
  238.                  nick file host port)
  239.         (if (nth 2 dcc-object)
  240.             (delete-process (nth 2 dcc-object)))
  241.         (irchat-dcc-delete-object dcc-object)
  242.         (irchat-insert0 (format "*** DCC killed.\n"))))))))
  243.  
  244.  
  245. (defun irchat-Command-dcc-get ()
  246.   "Get offered file from list."
  247.   (interactive)
  248.   (let (dcc-object number)
  249.     (if (numberp current-prefix-arg)
  250.     (setq number current-prefix-arg)
  251.       (setq number nil))
  252.     (if number
  253.     (setq dcc-object (irchat-dcc-get-object number))
  254.       (setq dcc-object (irchat-dcc-get-offered-object)))
  255.     (if (null dcc-object)
  256.     (if number
  257.         (irchat-insert0 (format "*** DCC No.%d --- not found\n" number))
  258.       (irchat-insert0 (format "*** There is no offered DCC SEND\n")))
  259.       (if (not (eq (nth 1 dcc-object) 'Offered))
  260.       (irchat-insert0 (format "*** DCC No.%d --- not offered\n" number))
  261.     (cond
  262.      ((eq (nth 0 dcc-object) 'GET)
  263.       (let (proc dir
  264.         ;;(nick (nth 4 dcc-object))
  265.         (host (nth 5 dcc-object))
  266.         (port (nth 6 dcc-object))
  267.         (file (nth 7 dcc-object))
  268.         (size (nth 8 dcc-object)))
  269.         (while (string-match "\\(.*\\)[/~]\\(.*\\)" file)
  270.           (setq file (format "%s-%s"  (matching-substring file 1)
  271.                           (matching-substring file 2))))
  272.         (if (file-directory-p irchat-dcc-directory)
  273.         (setq dir irchat-dcc-directory)
  274.           (irchat-insert0
  275.            (format "*** irchat-dcc-directory [%s] is not directory!!\n"
  276.                irchat-dcc-directory))
  277.           (setq dir "/tmp"))
  278.         (setq file (format "%s/%s" dir file))
  279.         (if (file-attributes (expand-file-name file dir))
  280.         (progn
  281.           (irchat-insert0
  282.            (format "*** file[%s] already exist. Do you overwrite it?\n"
  283.                file))
  284.           (setq file (read-file-name "Write file: " file file))))
  285.         (setcar (nthcdr 7 dcc-object) file)
  286.         (setq file (expand-file-name file dir))
  287.         (setq proc
  288.           (start-process irchat-dcc-program nil irchat-dcc-program 
  289.                  "file" "get" host port size file))
  290.         (irchat-pj-set-process-coding-system proc)
  291.         (setcar (nthcdr 1 dcc-object) 'Connect)
  292.         (setcar (nthcdr 2 dcc-object) proc)
  293.         (set-process-buffer proc
  294.                     (get-buffer-create (format " DCC:%s" (process-id proc))))
  295.         (set-process-sentinel proc 'irchat-dcc-sentinel)
  296.         (set-process-filter proc 'irchat-dcc-filter)))
  297.      ((eq (nth 0 dcc-object) 'CHAT)
  298.       (let (proc
  299.         ;;(nick (nth 4 dcc-object))
  300.         (host (nth 5 dcc-object))
  301.         (port (nth 6 dcc-object)))
  302.         (setq proc
  303.           (start-process irchat-dcc-program nil irchat-dcc-program 
  304.                  "chat" "connect" host port))
  305.         (irchat-pj-set-process-coding-system proc)
  306.         (setcar (nthcdr 1 dcc-object) 'Connect)
  307.         (setcar (nthcdr 2 dcc-object) proc)
  308.         (set-process-buffer proc
  309.                     (get-buffer-create (format " DCC:%s" (process-id proc))))
  310.         (set-process-sentinel proc 'irchat-dcc-sentinel)
  311.         (set-process-filter proc 'irchat-dcc-filter)))
  312.      (t
  313.       (irchat-insert0 "Fatal error! in Command-dcc-get\n")
  314.       nil))))))
  315.  
  316. (defun irchat-Command-dcc-chat ()
  317.   "send DCC CHAT request"
  318.   (interactive)
  319.   (let (proc)
  320.     (setq irchat-dcc-partner
  321.     (irchat-completing-default-read "With whom: "
  322.      (append irchat-nick-alist irchat-channel-alist)
  323.      '(lambda (s) t) nil irchat-dcc-partner))
  324.     (setq proc (start-process irchat-dcc-program nil irchat-dcc-program
  325.                   "chat" "listen"))
  326.     (irchat-pj-set-process-coding-system proc)
  327.     (irchat-dcc-add-object
  328.      (list 'CHAT 'Setting proc (current-time-string)
  329.        irchat-dcc-partner nil nil "chat"))
  330.     (set-process-buffer proc
  331.             (get-buffer-create (format " DCC:%s" (process-id proc))))
  332.     (set-process-filter proc 'irchat-dcc-filter)
  333.     (set-process-sentinel proc 'irchat-dcc-sentinel)))
  334.  
  335. (defun irchat-dcc-chat-send (to xmsg)
  336.   (let ((dcc-list irchat-dcc-list) dcc-object found not-active)
  337.     (while (and dcc-list (not found))
  338.       (setq dcc-object (car dcc-list)
  339.         dcc-list (cdr dcc-list))
  340.       (if (and (eq (nth 0 dcc-object) 'CHAT)
  341.            (string-ci-equal (nth 4 dcc-object) to))
  342.       (if (not (eq (nth 1 dcc-object) 'Active))
  343.           (setq not-active t)
  344.         (process-send-string (nth 2 dcc-object)
  345.                  (format "%s\n" (irchat-string-out xmsg)))
  346.         (setq found t))))
  347.     (if (not found)
  348.     (if not-active
  349.         (irchat-insert0
  350.          (format "*** DCC CHAT with %s is not active\n" to))
  351.       (irchat-insert0
  352.        (format "*** There is no DCC CHAT with %s\n" to))))))
  353.   
  354. (defun irchat-dcc-chat-loop-filter (process output)
  355.   (let ((obuf (current-buffer)) (pbuf (process-buffer process)))
  356.     (set-buffer pbuf)
  357.     (goto-char (point-max))
  358.     (insert output)
  359.     (goto-char (point-min))
  360.     (while (looking-at ".*\n")
  361.       (goto-char (match-end 0))
  362.       (setq output (buffer-substring 1 (point)))
  363.       (delete-region 1 (point))
  364.       (set-buffer obuf)
  365.       (irchat-dcc-chat-loop-filter-sub process output)
  366.       (set-buffer pbuf))
  367.     (set-buffer obuf)))
  368.  
  369. (defun irchat-dcc-chat-loop-filter-sub (process output)
  370.   (let* ((dcc-object (irchat-dcc-get-process-object process))
  371.      (xmsg (irchat-string-in (substring output 0 (1- (length output)))))
  372.      ;;(state (nth 1 dcc-object))
  373.      (nick (nth 4 dcc-object)))
  374.     (if (null dcc-object)
  375.     (delete-process process)   ;; garbage process
  376.       (irchat-insert-private t (format "=%s" nick) xmsg))))
  377.  
  378.  
  379. (defun irchat-Command-dcc-list ()
  380.   "show DCC list"
  381.   (interactive)
  382.   (if (null irchat-dcc-list)
  383.       (irchat-insert0 "*** There is no DCC list.\n")
  384.     (irchat-insert0 irchat-dcc-list-header)
  385.     (let ((dcc-list irchat-dcc-list) (num 0) dcc-object)
  386.       (while dcc-list
  387.     (setq dcc-object (car dcc-list)
  388.           dcc-list (cdr dcc-list))
  389.     (setq num (+ num 1))
  390.     (irchat-insert0 (irchat-dcc-list-object num dcc-object))))))
  391.  
  392. (setq irchat-dcc-list-header
  393.       "*** DCC Received Time Type Status  Nick      filename/chat\n")
  394.      ;"01: [Mar 18 12:34:56] SEND Waiting abcdefghi /hoge/hoge (123 bytes)"
  395.  
  396. (defun irchat-dcc-list-object (num dcc-object)
  397.   (cond
  398.    ((or (eq (car dcc-object) 'SEND) (eq (car dcc-object) 'GET))
  399.     (format "%02d: [%s] %4s %7s %9s %s (%s bytes)\n"
  400.         (if num num (irchat-dcc-match-object dcc-object))
  401.         (substring (nth 3 dcc-object) 4 19) ; time
  402.         (add-space 4 (prin1-to-string (nth 0 dcc-object))) ; type
  403.         (add-space 7 (prin1-to-string (nth 1 dcc-object))) ; status
  404.         (add-space 9 (nth 4 dcc-object)) ; nick
  405.         (nth 7 dcc-object) ; file
  406.         (nth 8 dcc-object))) ; size
  407.    ((eq (car dcc-object) 'CHAT)
  408.     (format "%02d: [%s] %4s %7s %9s <chat>\n"
  409.         (if num num (irchat-dcc-match-object dcc-object))
  410.         (substring (nth 3 dcc-object) 4 19) ; time
  411.         (add-space 4 (prin1-to-string (nth 0 dcc-object))) ; type
  412.         (add-space 7 (prin1-to-string (nth 1 dcc-object))) ; status
  413.         (add-space 9 (nth 4 dcc-object)))) ; nick
  414.    (t
  415.     "00: Unknown\n")))
  416.  
  417.  
  418. (defun irchat-dcc-add-object (dcc-object)
  419.   (setq irchat-dcc-list (append irchat-dcc-list (list dcc-object))))
  420.  
  421. (defun irchat-dcc-delete-object (dcc-object)
  422.   (let ((num (irchat-dcc-match-object dcc-object)))
  423.     (if num
  424.     (let ((nth (1- num)))
  425.       (if (= 0 nth)
  426.           (setq irchat-dcc-list (cdr irchat-dcc-list))
  427.         (setcdr (nthcdr (1- nth) irchat-dcc-list)
  428.             (nthcdr (1+ nth) irchat-dcc-list)))))))
  429.  
  430. (defun irchat-dcc-get-object (num)
  431.   "return object"
  432.   (nth (1- num) irchat-dcc-list))
  433.  
  434. (defun irchat-dcc-get-offered-object ()
  435.   "return the first offered object"
  436.   (let ((dcc-list irchat-dcc-list) (num 0) dcc-object found)
  437.     (while (and dcc-list (not found))
  438.       (setq dcc-object (car dcc-list)
  439.         dcc-list (cdr dcc-list))
  440.       (setq num (1+ num))
  441.       (if (eq (nth 1 dcc-object) 'Offered)
  442.       (setq found dcc-object)))
  443.     found))
  444.  
  445. (defun irchat-dcc-get-process-object (process)
  446.   "return object"
  447.   (let ((dcc-list irchat-dcc-list) (num 0) dcc-object found)
  448.     (while (and dcc-list (not found))
  449.       (setq dcc-object (car dcc-list)
  450.         dcc-list (cdr dcc-list))
  451.       (setq num (+ num 1))
  452.       (if (eq (nth 2 dcc-object) process)
  453.       (setq found dcc-object)))
  454.     found))
  455.  
  456. (defun irchat-dcc-match-object (dcc-object)
  457.   "what number?"
  458.   (let ((dcc-list irchat-dcc-list) (num 0) obj found)
  459.     (while (and dcc-list (not found))
  460.       (setq obj (car dcc-list)
  461.         dcc-list (cdr dcc-list))
  462.       (setq num (1+ num))
  463.       (if (eq dcc-object obj)
  464.       (setq found num)))
  465.     found))
  466.  
  467. (provide 'irchat-dcc)
  468.