;;; pure-irc-dcc.el --- Generic function and loader for PURE DCC module

;; Copyright (C) 2000 by Project Pure.

;; Author: SHIMADA Mitsunobu <simm@pure.fan.gr.jp>
;; Keywords: PURE, IRC, DCC

;; $Id: pure-irc-dcc.el,v 1.4 2001/04/30 15:12:36 simm Exp $

;; This file 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 file 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:

;; PURE means "Primitive Universal Relay-chat Environment"

;;; Code:

(require 'pure-bl)
(require 'pure-ds)
(require 'pure-pr-filter)
(require 'pure-pr-server)
(require 'pure-irc-send)
(require 'pure-irc-dcc-info)

(defconst pure-irc-dcc-local-variables
  '([pure-irc-dcc-info nil
     "PURE-DS structured DCC information set, consists in below:
PROC BUFFER METHOD NICK HOST PORT FILE SIZE XPOS TIME STATUS PARENT CODING"])
  "List of buffer-local variables.")

(defconst pure-irc-dcc-parent-local-variables
  '([pure-irc-dcc-offer-list nil
     "DCC offered list. Format of each element is PURE-IRC-DCC-INFO object."]
    [pure-irc-dcc-process-list nil
     "DCC process list. Each element is PURE-IRC-DCC-INFO object."]
    [pure-irc-dcc-chat-partner nil
     "DCC partner association list. Each element consists '(nick . dinfo)"])
  "List of process-local variables.")

(defvar pure-irc-dcc-log-interface nil
  "Interface function to output log message.
Set function symbol, whose arg is message.")

(defvar pure-irc-dcc-auto-get-file nil
  "*If non-nil, get a file automatically when DCC request received.")

(defvar pure-irc-dcc-use-dcc-cancel nil
  "If non-nil, send DCC CANCEL message when kill DCC offer.")

(defvar pure-irc-dcc-default-method 'pure
  "DCC default method, symbol or string.

This variable is used when called DCC process starting method,
with METHOD argument is nil.

When this variable is nil, use \"pure\".")

;; Initialize DCC information
(defun pure-irc-dcc-initialize (logif dccif)
  "Initialize DCC information:
* Define interface functions
* Define buffer-local variables"
  (setq pure-irc-dcc-log-interface  logif
	pure-irc-dcc-chat-interface dccif)
  (pure-bl-defvar pure-irc-dcc-local-variables)
  (pure-bl-defvar pure-irc-dcc-parent-local-variables))

(defun pure-irc-dcc-process-kill-all (&optional proc quit)
  "Kill all DCC process listed in `pure-irc-dcc-process-list'"
  (save-excursion
    (if proc (set-buffer (process-buffer proc)))
    (mapcar
     (function
      (lambda (item)
	(if quit
	    (set-process-sentinel (pure-irc-dcc-info-get-proc item) nil))
	(delete-process (pure-irc-dcc-info-get-proc item))))
     pure-irc-dcc-process-list)
    (setq pure-irc-dcc-chat-partner nil
	  pure-irc-dcc-process-list nil)))

(defun pure-irc-dcc-process-kill-nick (nick &optional proc)
  "Kill all DCC with NICK process,
listed in `pure-irc-dcc-process-list' and `pure-irc-dcc-offer-list'"
  (let (delete-list)
    (save-excursion
      (if proc (set-buffer (process-buffer proc)))
      (setq pure-irc-dcc-chat-partner (delete nick pure-irc-dcc-chat-partner))
      ;; pure-irc-dcc-process-list
      (mapcar
       (function
	(lambda (item)
	  (if (string= nick (pure-irc-dcc-info-get-nick item))
	      (setq delete-list (cons item delete-list)))))
       pure-irc-dcc-process-list)
      (while delete-list
	(delete-process (pure-irc-dcc-info-get-proc (car delete-list)))
	(pure-ds-del-list (car delete-list) pure-irc-dcc-process-list)
	(setq delete-list (cdr delete-list)))
      ;; pure-irc-dcc-offer-list
      (mapcar
       (function
	(lambda (item)
	  (if (string= nick (pure-irc-dcc-info-get-nick item))
	      (setq delete-list (cons item delete-list)))))
       pure-irc-dcc-offer-list)
      (while delete-list
	(pure-ds-del-list (car delete-list) pure-irc-dcc-offer-list)
	(setq delete-list (cdr delete-list))))))

;;
;; from pure-irc-dcc-chat.el
;;

(defvar pure-irc-dcc-chat-interface nil
  "Interface function for DCC CHAT.
Set function symbol, whose args are nick and message.")

(defsubst pure-irc-dcc-chat-listen (&optional proc)
  "Function called when PURE server is ready to listen to client DCC CHAT connection."
  (save-excursion
    (if proc (set-buffer (process-buffer proc)))
    (pure-irc-dcc-info-send-server-info pure-irc-dcc-info pure-pr-my-addr pure-pr-my-port)))

(defun pure-irc-dcc-chat-connect (proc &optional kind)
  "Function called when PURE server is ready to DCC CHAT."
  (save-excursion
    (set-buffer (process-buffer proc))
    (pure-irc-dcc-info-chat-established pure-irc-dcc-info (or kind 'server))))

;; parser function for DCC CHAT filter
(defun pure-irc-dcc-chat-parser (proc)
  "Parser function for DCC CHAT filter."
  (pure-cs-decode-region (point-min) (point-max)
			 (pure-cs-detect-region (point-min) (point-max)))
  (funcall pure-irc-dcc-chat-interface
	   (pure-irc-dcc-info-get-nick pure-irc-dcc-info)
	   (buffer-substring (point-min) (point-max))))

;; sentinel function for DCC CHAT
(defun pure-irc-dcc-chat-sentinel (proc msg)
  "DCC CHAT sentinel function."
  (let ((stat (process-status proc))
	(buf  (process-buffer proc))
	dinfo)
    (save-excursion
      (set-buffer buf)
      (setq dinfo pure-irc-dcc-info))
    (if (or (eq stat 'open) (eq stat 'run))
	(message "DCC CHAT with %s established." (pure-irc-dcc-info-get-nick dinfo))
      (if (eq stat 'stop) nil
	(funcall pure-irc-dcc-log-interface
		 "DCC CHAT with %s is disconnected." (pure-irc-dcc-info-get-nick dinfo))
	(setq pure-irc-dcc-chat-partner
	      (delete (rassoc dinfo pure-irc-dcc-chat-partner) pure-irc-dcc-chat-partner))
	(pure-ds-del-list dinfo pure-irc-dcc-process-list)
	(set-process-buffer proc nil)
	(set-process-filter proc nil)
	(set-process-sentinel proc nil)
	(kill-buffer buf)))))

;;
;; from pure-irc-dcc-file.el
;;

;; find DCC-INFO from PLIST, which has NICK and PORT
(defun pure-irc-dcc-find-nickport (plist nick port)
  "Find DCC process information, whose NICK and PORT corresponds."
  (let (result)
    (while plist
      (setq result (car plist))
      (if (and (string= nick (pure-irc-dcc-info-get-nick result))
	       (string= port (pure-irc-dcc-info-get-port result)))
	  (sestq plist nil)
	(setq plist (cdr plist) result nil)))
    result))

;; Sentinel function
(defun pure-irc-dcc-file-sentinel (proc msg)
  "DCC file put/get sentinel function."
  (let ((stat (process-status proc))
	(buf  (process-buffer proc))
	dinfo)
    (if (or (eq stat 'run) (eq stat 'stop)) nil
      (save-excursion
	(set-buffer buf)
	(setq dinfo pure-irc-dcc-info)
	(if (string-match "^finished" msg)
	    (cond ((eq 'server (pure-irc-dcc-info-get-status dinfo))
		   ;; dccput finished
		   (funcall pure-irc-dcc-log-interface "Finished dcc put %s to %s"
			    (pure-irc-dcc-info-get-file dinfo)
			    (pure-irc-dcc-info-get-nick dinfo)))
		  ((eq 'client (pure-irc-dcc-info-get-status dinfo))
		   ;; dccget finished
		   (funcall pure-irc-dcc-log-interface "Finished dcc get %s from %s"
			    (pure-irc-dcc-info-get-file dinfo)
			    (pure-irc-dcc-info-get-nick dinfo)))
		  ((eq 'connect (pure-irc-dcc-info-get-status dinfo))
		   ;; DCC RESUME is canceled
		   (pure-irc-dcc-resume-cancel
		    (pure-irc-dcc-info-get-nick dinfo) (pure-irc-dcc-info-get-port dinfo))
		   (funcall pure-irc-dcc-log-interface
			    "DCC RESUME %s refused, so fall back to offer list."
			    (pure-irc-dcc-info-get-file dinfo)))
		  (t
		   ;; unknown status
		   (funcall pure-irc-dcc-log-interface "DCC status error : %s"
			    (pure-irc-dcc-info-get-status dinfo))))
	  (if (string-match "[\r\n]+$" msg)
	      (setq msg (substring msg 0 (match-beginning 0))))
	  (if (or (string-match "terminated" msg) (string-match "interrupt" msg))
	      (funcall pure-irc-dcc-log-interface "DCC SEND %s to %s is canceled."
		       (pure-irc-dcc-info-get-file dinfo) (pure-irc-dcc-info-get-nick dinfo))
	    (funcall pure-irc-dcc-log-interface "DCC ERROR and stop DCC %s with %s: %s"
		     (pure-irc-dcc-info-get-file dinfo)
		     (pure-irc-dcc-info-get-nick dinfo) msg))))
      (pure-ds-del-list dinfo pure-irc-dcc-process-list)
      (set-process-buffer proc nil)
      (set-process-filter proc nil)
      (set-process-sentinel proc nil)
      (kill-buffer buf))))

;; That's all
(provide 'pure-irc-dcc)

;;; pure-irc-dcc.el ends here