;;; elmo-nntp-feed.el -- Direct feed to news server

;; Copyright (C) 2001  Kenichi OKADA <okada@opaopa.org>

;; Author: Kenichi OKADA <okada@opaopa.org>
;; Keywords: NNTP, IHAVE, TAKETHIS

;; This file is not part of any package.

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

;; user options

;; (setq elmo-nntp-posting-method
;;      '((",?\\(ku\\|nihon\\)" .
;;	 (elmo-nntp-post-orig wl-nntp-posting-server))
;;	(",?fj" .
;;	 (elmo-nntp-takethis "newsfeed.media.kyoto-u.ac.jp"))
;;	(",?japan" .
;;	 (elmo-nntp-ihave "news.media.kyoto-u.ac.jp"))
;;	(".*" . (elmo-nntp-post-orig)
;;	 ;; original posting method
;;	 )))

;;

;;; Code:
;; 

(require 'elmo-nntp)

;;
;; internal variables
;;

(defvar elmo-nntp-posting-method
  '(".*" . (elmo-nntp-post-orig)))
 
(unless (fboundp 'elmo-nntp-post-orig)
  (fset 'si:elmo-nntp-post (symbol-function 'elmo-nntp-post))
  (defun elmo-nntp-post-orig (hostname content-buf &optional reconnect)
    (si:elmo-nntp-post hostname content-buf)))

(defun elmo-nntp-post (hostname content-buf)
  (let (newsgroups ret host)
    (save-excursion
     (set-buffer content-buf)
     (setq newsgroups (std11-field-body "newsgroups"))
     (if (null
	  (setq ret (cdr (elmo-string-matched-assoc
			  newsgroups elmo-nntp-posting-method))))
	 (elmo-nntp-post hostname content-buf)
       (setq host
	     (if (nth 1 ret)
		 (if (symbolp (nth 1 ret))
		     (symbol-value (nth 1 ret))
		   (nth 1 ret))
	     hostname))
       (funcall (car ret) host content-buf
		(string= host elmo-default-nntp-server))))))

(defun elmo-nntp-ihave (hostname content-buf &optional reconnect)
  (let ((elmo-nntp-send-mode-reader nil)
	(spec (list 'nntp nil elmo-default-nntp-user
		    hostname elmo-default-nntp-port
		    elmo-default-nntp-stream-type))
	session response message-id err)
    (setq session
	  (elmo-nntp-get-session spec reconnect))
    (if reconnect
	(progn
	  (if session
	      (progn
		(elmo-nntp-send-command session "quit")
		(elmo-network-close-session session)))
	  (setq session (elmo-nntp-get-session spec))))
    (if (null session)
	(error "Can't get session"))
    (save-excursion
      (setq err
	    (catch 'err
	      (set-buffer content-buf)
	      (goto-char (point-min))
	      (if (search-forward mail-header-separator nil t)
		  (delete-region (match-beginning 0)(match-end 0)))
	      (setq message-id (std11-field-body "message-id"))
	      (unless message-id
		(throw 'err "no message-id"))
	      (goto-char (point-min))
	      (insert "Path: wanderlust\n")
	      (insert "NNTP-Posting-Method: ihave\n")
	      (elmo-nntp-send-command session
				      (concat "ihave " message-id))
	      (if (null (string-match "^335" (setq response
						   (elmo-nntp-read-raw-response session))))
		  (throw 'err response))
	      (run-hooks 'elmo-nntp-post-pre-hook)
	      (elmo-nntp-send-buffer session content-buf)
	      (elmo-nntp-send-command session ".")
	      (if (null (string-match
			 "^2" (setq response (elmo-nntp-read-raw-response
					      session))))
		  (throw 'err response))
	      nil))
      (if err
	  (error (concat "NNTP error: " response)))
      (if reconnect
	  (elmo-nntp-send-mode-reader session)))))

(defun elmo-nntp-takethis (hostname content-buf &optional reconnect)
  (let ((elmo-nntp-send-mode-reader nil)
	(spec (list 'nntp nil elmo-default-nntp-user
		    hostname elmo-default-nntp-port
		    elmo-default-nntp-stream-type))
	session response message-id err)
    (setq session
	  (elmo-nntp-get-session spec reconnect))
    (if reconnect
	(progn
	  (if session
	      (progn
		(elmo-nntp-send-command session "quit")
		(elmo-network-close-session session)))
	  (setq session (elmo-nntp-get-session spec))))
    (if (null session)
	(error "Can't get session"))
    (save-excursion
      (setq err
	    (catch 'err
	      (elmo-nntp-send-command session "mode stream")
	      (if (null (string-match "^203" (setq response
						   (elmo-nntp-read-raw-response session))))
		  (throw 'err response))
	      (set-buffer content-buf)
	      (goto-char (point-min))
	      (if (search-forward mail-header-separator nil t)
		  (delete-region (match-beginning 0)(match-end 0)))
	      (setq message-id (std11-field-body "message-id"))
	      (unless message-id
		(throw 'err "no message-id"))
	      (goto-char (point-min))
	      (insert "Path: wanderlust\n")
	      (insert "NNTP-Posting-Method: takethis\n")
	      (elmo-nntp-send-command session
				      (concat "takethis " message-id))
	      (run-hooks 'elmo-nntp-post-pre-hook)
	      (elmo-nntp-send-buffer session content-buf)
	      (elmo-nntp-send-command session ".")
	      (if (null (string-match
			 "^2" (setq response (elmo-nntp-read-raw-response
					      session))))
		  (throw 'err response))
	      nil))
      (if err
	  (error (concat "NNTP error: " response)))
      (if reconnect
	  (elmo-nntp-send-mode-reader session)))))

(require 'product)
(product-provide (provide 'elmo-nntp-feed) (require 'elmo-version))

;;; elmo-nntp-feed.el ends here