;;; pure-irc-dcc-info.el --- Definition of DCC information object.

;; Copyright (C) 2001  Project Pure.

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

;; 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-ds)

;; dcc-info management
(pure-ds-define pure-irc-dcc-info
		proc buffer method nick host port file size xpos time status parent coding)

(defsubst pure-irc-dcc-info-create
  (&optional nick host port file size xpos time status parent coding)
  (pure-irc-dcc-info-make nil nil nil nick host port file size xpos time status parent coding))

(defun pure-irc-dcc-info-put-current-time (dinfo)
  (pure-irc-dcc-info-put-time dinfo (current-time-string)))
(defsubst pure-irc-dcc-info-chatp (dinfo)
  (null (pure-irc-dcc-info-get-size dinfo)))
(defsubst pure-irc-dcc-info-get-file-nondir (dinfo)
  (file-name-nondirectory (pure-irc-dcc-info-get-file dinfo)))

;;
;; search DCC-INFO member from list
;;
(defun pure-irc-dcc-info-search (dinfo dlist &rest args)
  "Search member that corresponds with DINFO from DLIST."
  (eval
   (macroexpand
    (cons 'or
	  (mapcar
	   (function
	    (lambda (item)
	      (if (pure-ds-compare-args 'pure-irc-dcc-info dinfo item 'equal args)
		  item)))
	   dlist)))))

;;
;; kill DCC offer / process
;;
(defun pure-irc-dcc-info-kill (dinfo)
  "Remove dcc-info from `pure-irc-dcc-offer-list' or `pure-irc-dcc-process-list'.
 If `pure-irc-dcc-use-dcc-cancel' is non-nil, send DCC CANCEL message."
  (if (member dinfo pure-irc-dcc-offer-list)
      (progn
	(if pure-irc-dcc-use-dcc-cancel
	    (pure-irc-dcc-info-send-control dinfo "CANCEL" 'file 'host 'port))
	(pure-ds-del-list dinfo pure-irc-dcc-offer-list))
    (if (not (member dinfo pure-irc-dcc-process-list))
	(funcall pure-irc-dcc-error-function "no such DCC object")
      (interrupt-process (pure-irc-dcc-info-get-proc dinfo))
      (if (eq 'resume (pure-irc-dcc-info-get-status dinfo))
	  (progn
	    (pure-irc-dcc-info-put-file dinfo (pure-irc-dcc-info-get-file-nondir dinfo))
	    (pure-ds-add-list dinfo pure-irc-dcc-offer-list))))))

;;
;; for process starting
;;

(defun pure-irc-dcc-info-start (dinfo clientp &optional method parent coding)
  "Start DCC process.
CLIENTP is nil if server process, t if client process.
If you want DCC resume request, set 'resume."
  (if (and clientp
	   (not (pure-irc-dcc-info-search
		 dinfo pure-irc-dcc-offer-list 'nick 'host 'port 'file 'size)))
      (funcall pure-irc-dcc-error-function "not offered")
    (or (pure-irc-dcc-info-get-method dinfo)
	(pure-irc-dcc-info-put-method
	 dinfo (or method pure-irc-dcc-default-method 'pure)))
    (let ((prefix (format "pure-pr-dcc-%s" (pure-irc-dcc-info-get-method dinfo)))
	  (kind (if clientp "client" "server"))
	  (nick (pure-irc-dcc-info-get-nick dinfo))
	  (file (pure-irc-dcc-info-get-file dinfo))
	  (size (pure-irc-dcc-info-get-size dinfo))
	  filep proc)
      (require (intern prefix))
      (pure-irc-dcc-info-put-buffer
       dinfo (generate-new-buffer (format " pure:DCC:%s:%s:%s" kind (or file "CHAT") nick)))
      (setq filep (if clientp size file)
	    proc (funcall (intern
			   (format "%s-start-%s-%s" prefix (if filep "file" "chat") kind))
			  dinfo (eq clientp 'resume)))
      (pure-irc-dcc-info-put-proc dinfo proc)
      (when proc
	(set-process-sentinel
	 proc (if filep 'pure-irc-dcc-file-sentinel 'pure-irc-dcc-chat-sentinel))
	(if clientp
	    (pure-ds-del-list dinfo pure-irc-dcc-offer-list))
	(pure-ds-add-list dinfo pure-irc-dcc-process-list)
	(save-excursion
	  (set-buffer (pure-irc-dcc-info-get-buffer dinfo))
	  (pure-bl-make-current pure-irc-dcc-local-variables t)
	  (pure-irc-dcc-info-put-status dinfo (if clientp 'connect 'set))
	  (pure-irc-dcc-info-put-parent dinfo parent)
	  (pure-irc-dcc-info-put-coding dinfo coding)
	  (setq pure-irc-dcc-info dinfo)
	  ;; If process is made by `open-network-stream', set some infomations.
	  (when (eq 'open (process-status proc))
	    (pure-irc-dcc-info-chat-established dinfo (intern kind)))) ;; KIND must be 'client
	proc))))

;;
;; set DCC information and send DCC SEND / DCC CHAT message to peer
;;
(defun pure-irc-dcc-info-send-server-info (dinfo host port &optional size)
  "Set DCC information for server, and send DCC SEND / DCC CHAT message to peer.
If SIZE is non-nil, send DCC FILE, otherwise DCC CHAT"
  (pure-irc-dcc-info-put-host
   dinfo (if (string-match "\\." host) (pure-pr-ipaddr-encode host) host))
  (pure-irc-dcc-info-put-port dinfo port)
  (pure-irc-dcc-info-put-size dinfo size)
  (pure-irc-dcc-info-put-status dinfo 'wait)
  (if size
      (let ((file (pure-irc-dcc-info-get-file-nondir dinfo)))
	(pure-irc-dcc-info-send-control dinfo "SEND" file 'host 'port 'size)
	(pure-irc-dcc-info-putlog dinfo "DCC SEND to %s: %s (%s bytes)" 'nick 'file 'size))
    (pure-irc-dcc-info-send-control dinfo "CHAT chat" 'host 'port)
    (pure-irc-dcc-info-putlog dinfo "DCC CHAT request %s" 'nick)))

;;
;; for DCC CHAT
;;

;; called when DCC CHAT connection established
(defun pure-irc-dcc-info-chat-established (dinfo kind)
  "Set some item and announce some information, when DCC CHAT connection established."
  (or (assoc (pure-irc-dcc-info-get-nick dinfo) pure-irc-dcc-chat-partner)
      (setq pure-irc-dcc-chat-partner
	    (cons (cons (pure-irc-dcc-info-get-nick dinfo) dinfo)
		  pure-irc-dcc-chat-partner)))
  (pure-irc-dcc-info-putlog dinfo "DCC CHAT to %s established." 'nick)
  (pure-irc-dcc-info-put-status dinfo kind))

;; send DCC control message / put DCC control log

(defun pure-irc-dcc-info-send-control (dinfo cmd &rest args)
  "Send message to peer"
  (let ((msg (format "PRIVMSG %s :\001DCC %s"
		     (pure-irc-dcc-info-get-nick dinfo) (upcase cmd))))
    (while args
      (setq msg (concat msg " " (pure-ds-get-item dinfo (car args)))
	    args (cdr args)))
    (setq msg (concat msg "\001\n"))
    (pure-irc-send-register
     (pure-irc-dcc-info-get-parent dinfo) (pure-irc-dcc-info-get-coding dinfo) msg)))

(defun pure-irc-dcc-info-putlog (dinfo fmt &rest args)
  "Put log message to me"
  (apply pure-irc-dcc-log-interface fmt
	 (mapcar (function (lambda (item) (pure-ds-get-item dinfo item))) args)))

;; send DCC CHAT message
(defun pure-irc-dcc-info-send-message (dinfo msg)
  "DCC CHAT message sending."
  (and dinfo
       (pure-irc-dcc-info-chatp dinfo)
       (or (eq (pure-irc-dcc-info-get-status dinfo) 'client)
	   (eq (pure-irc-dcc-info-get-status dinfo) 'server))
       (prog1 (pure-irc-dcc-info-get-nick dinfo)
	 (process-send-string
	  (pure-irc-dcc-info-get-proc dinfo)
	  (concat (pure-cs-encode-string msg (pure-irc-dcc-info-get-coding dinfo)) "\n")))))

;;
;; for DCC resume
;;

;;
;; pure-irc-dcc-process-list management (for DCC RESUME)
;;
(defsubst pure-irc-dcc-info-search-resume (dinfo dlist)
  "Search DCC offered list."
  (pure-irc-dcc-info-search dinfo dlist 'nick 'port 'status))

;; check if resumable
(defun pure-irc-dcc-info-resumep (dinfo &optional method)
  "If DINFO is resumable, returns non-nil, non-resumable, returns nil."
  (if method
      (pure-irc-dcc-info-put-method dinfo method)
    (setq method (pure-irc-dcc-info-get-method dinfo)))
  (funcall (intern (format "pure-pr-dcc-%s-resumep" method)) dinfo))

;; for client: DCC RESUME request
(defun pure-irc-dcc-info-resume-request (dinfo)
  "Send DCC RESUME message to peer."
  (if (bufferp (pure-irc-dcc-info-get-buffer dinfo))
      (save-excursion
	(set-buffer (pure-irc-dcc-info-get-buffer dinfo))
	(pure-irc-dcc-info-put-status dinfo 'resume)
	(let ((file (pure-irc-dcc-info-get-file-nondir dinfo)))
	  (pure-irc-dcc-info-send-control dinfo "RESUME" file 'port 'xpos)
	  (pure-irc-dcc-info-putlog
	   dinfo "DCC RESUME request to %s: %s (at %s bytes)" 'nick file 'xpos)))))

;; for server: DCC RESUME accept
(defun pure-irc-dcc-info-resume-accept (dinfo)
  "Send DCC ACCEPT message to peer."
  (if (bufferp (pure-irc-dcc-info-get-buffer dinfo))
      (save-excursion
	(set-buffer (pure-irc-dcc-info-get-buffer dinfo))
	(let ((file (pure-irc-dcc-info-get-file-nondir dinfo)))
	  (pure-irc-dcc-info-send-control dinfo "ACCEPT" file 'port 'xpos)
	  (pure-irc-dcc-info-putlog
	   dinfo "DCC RESUME accepted from %s: %s (at %s bytes)" 'nick file 'xpos)))))

;; for client: cancel DCC RESUME
(defun pure-irc-dcc-info-resume-cancel (dinfo)
  "Cancel DCC RESUME and send request back to `pure-irc-dcc-offer-list'."
  (if (eq 'resume (pure-irc-dcc-info-get-status dinfo))
      (progn
	(pure-irc-dcc-info-put-file
	 dinfo (pure-irc-dcc-info-get-file-nondir dinfo))
	(pure-ds-del-list dinfo pure-irc-dcc-process-list)
	(pure-ds-add-list dinfo pure-irc-dcc-offer-list)
	(pure-ir-dcc-info-putlog
	 dinfo "DCC RESUME \"%s\" disabled, so send it back to offer list." 'file)
	(delete-process (pure-irc-dcc-info-get-proc dinfo)))))

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

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