;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; This file is not part of xyzzy.
;;;
; $Id: pop3.l 769 2007-12-14 19:18:39Z torihat $
;
; junk/pop3.l
;
; by Masashi Hattori

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "junk/defs")
  (require "junk/macro"))
(require "junk/lib")
(require "junk/log")

(provide "junk/pop3")

(in-package "junk")

(defconstant *pop3-port* 110)

(defvar *pop3-buffer-prefix* "*Junk:POP3 ")
(defvar *pop3-buffer-output* (concat *pop3-buffer-prefix* "OUTPUT*"))
(defvar *pop3-buffer-temp* (concat *pop3-buffer-prefix* "TEMP*"))

(defvar *pop3-debug* nil)
(defvar *pop3-stream-output* nil)

(defun pop3-open (server &optional (port *pop3-port*))
  (unless port
    (setq port *pop3-port*))
  (let (return)
    (if *pop3-debug*
	(when (or (not *pop3-stream-output*)
		  (not (find-buffer *pop3-buffer-output*)))
	  (setq *pop3-stream-output*
		(log-init *pop3-buffer-output*)))
      (setq *pop3-stream-output* nil))
    (message "Connecting to server: ~A" server)
    (setq stream (connect server port))
    (setq return (pop3-read-line stream))
    (if (pop3-ok-p return)
	(message "~A" return)
      (junk-error "POP3: connect failed: ~A" return))
    (values stream (pop3-apop-key return))
  ))

(defun pop3-apop-key (string)
  (and (string-match "<[^>]+>" string)
       (match-string 0)))

(defun pop3-read-line (stream)
  (let (return)
    (setq return (read-line stream nil))
    (log-output *pop3-stream-output* "~A" return)
    return))

(defun pop3-ok-p (string)
  (values (string-match "^+OK" string) string))

(defun pop3-err-p (string)
  (values (string-match "^-ERR" string) string))

(defun pop3-quit (stream)
  (unless (streamp stream)
    (return-from pop3-quit nil))
  (let ((return ""))
    (message "Quitting ...")
    (format stream "QUIT~%")
    (log-output *pop3-stream-output* "QUIT")
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (setq stream nil)
    (pop3-ok-p return)
  ))

(defun pop3-user (stream user)
  (unless (streamp stream)
    (return-from pop3-user nil))
  (let ((return ""))
    (format stream "USER ~A~%" user)
    (log-output *pop3-stream-output* "USER ~A~%" user)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (pop3-ok-p return)
  ))

(defun pop3-pass (stream pass)
  (unless (streamp stream)
    (return-from pop3-pass nil))
  (let ((return ""))
    (format stream "PASS ~A~%" pass)
    (log-output *pop3-stream-output* "PASS ~A" pass)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (pop3-ok-p return)
  ))

(defun pop3-apop (stream key user pass)
  (unless (streamp stream)
    (return-from pop3-apop nil))
  (let ((return "")
	(digest (pop3-apop-digest key pass)))
    (format stream "APOP ~A ~A~%" user digest)
    (log-output *pop3-stream-output* "APOP ~A ~A" user digest)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (pop3-ok-p return)
  ))

(defun pop3-apop-digest (key pass)
  (si:md5 (concat key pass)))

(defun pop3-auth-cram-md5 (stream user pass)
  (unless (streamp stream)
    (return-from pop3-auth-cram-md5))
  (let ((return ""))
    (format stream "AUTH CRAM-MD5~%")
    (log-output *pop3-stream-output* "AUTH CRAM-MD5")
    (setq return (pop3-read-line stream))
    (when (pop3-err-p return)
      (return-from pop3-auth-cram-md5 (pop3-err-p return)))
    (if (string-match "^+ \\([^ \t]+\\)$" return)
	(let* ((challenge (substring return (match-beginning 1) (match-end 1)))
	       (response (cram-md5-responce user pass challenge)))
	  (format stream "~A~%" response)
	  (log-output *pop3-stream-output* "~A" response)
	  (setq return (pop3-read-line stream))
	  (return-from pop3-auth-cram-md5 (pop3-ok-p return)))
      (return-from pop3-auth-cram-md5 (values nil return)))))

(defun pop3-stat (stream)
  (unless (streamp stream)
    (return-from pop3-stat nil))
  (let ((return "")
	flag
	num
	bytes)
    (format stream "STAT~%")
    (log-output *pop3-stream-output* "STAT")
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (when (setq flag (string-match "^+OK[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" return))
      (setq num (parse-integer (match-string 1)))
      (setq bytes (parse-integer (match-string 2))))
    (values flag num bytes)
    ))

(defun pop3-list (stream)
  (unless (streamp stream)
    (return-from pop3-list nil))
  (let ((return "")
	msgs)
    (format stream "LIST~%")
    (log-output *pop3-stream-output* "LIST")
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (unless (pop3-ok-p return)
      (return-from pop3-list nil))
    (setq return (pop3-read-line stream))
    (while (not (string= "." return))
      (let (num bytes)
	(when (string-match "^\\([0-9]+\\)[ \t]+\\([0-9]+\\)" return)
	  (setq num (parse-integer (substring return (match-beginning 1) (match-end 1))))
	  (setq bytes (parse-integer (substring return (match-beginning 2) (match-end 2))))
	  (push (cons num bytes) msgs))
	(setq return (pop3-read-line stream))
	))
    (nreverse msgs)))

(defun pop3-list-num (stream num)
  (unless (streamp stream)
    (return-from pop3-list-num nil))
  (let ((return ""))
    (format stream "LIST ~D~%" num)
    (log-output *pop3-stream-output* "LIST ~D" num)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (if (string-match "^+OK[ \t]+[0-9]+[ \t]+\\([0-9]+\\)" return)
	(parse-integer (match-string 1))
      nil)))

(defun pop3-uidl (stream)
  (unless (streamp stream)
    (return-from pop3-uidl nil))
  (let ((return "")
	msgs)
    (format stream "UIDL~%")
    (log-output *pop3-stream-output* "UIDL")
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (unless (pop3-ok-p return)
      (return-from pop3-uidl nil))
    (setq return (pop3-read-line stream))
    (while (not (string= "." return))
      (let (num uidl)
	(when (string-match "^\\([0-9]+\\)[ \t]+\\(.*\\)$" return)
	  (setq num (parse-integer (substring return (match-beginning 1) (match-end 1))))
	  (setq uidl (substring return (match-beginning 2) (match-end 2)))
	  (push (cons num uidl) msgs))
	(setq return (pop3-read-line stream))))
    (nreverse msgs)))

(defun pop3-uidl-num (stream num)
  (unless (streamp stream)
    (return-from pop3-uidl-num nil))
  (let ((return "")
	uidl)
    (format stream "UIDL ~D~%" num)
    (log-output *pop3-stream-output* "UIDL ~D" num)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (if (string-match "^+OK[ \t]+[0-9]+[ \t]+\\(.*\\)$" return)
	(match-string 1)
      nil)))

(defun pop3-retr-to-buffer (stream num &optional buffer)
  (unless (socket-stream-p stream)
    (return-from pop3-retr-to-buffer nil))
  (let ((return "")
	(len 0)
	total)
    (format stream "RETR ~D~%" num)
    (log-output *pop3-stream-output* "RETR ~D" num)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (unless (pop3-ok-p return)
      (junk-error "POP3: RETR ~D: ~S" num return))
    (when (string-match "^+OK[ \t]+\\([0-9]+\\)" return)
      (setq total (parse-integer (match-string 1))))
    (when buffer
      (set-buffer (get-buffer-create buffer))
      (erase-buffer buffer))
    (message "Retrieving ~D ..." num)
    (setq return (pop3-read-line stream))
    (save-excursion
      (interval-message (300)
	(while (not (string= "." return))
	  (insert return "\n")
	  (setq len (+ len (string-length return)))
	  (message "Retrieving ~D: ~D~@[/~D~]" num len total)
	  (setq return (pop3-read-line stream))))
      (goto-char (point-min))
      (replace-buffer "^\\." "" :regexp t))
    t))

(defun pop3-top (stream num lines)
  (unless (streamp stream)
    (return-from pop3-top nil))
  (let ((return "")
	(mail nil)
	(bytes 0))
    (format stream "TOP ~D ~D~%" num lines)
    (log-output *pop3-stream-output* "TOP ~D ~D" num lines)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (unless (pop3-ok-p return)
      (junk-error "POP3: TOP ~D ~D: ~S" num lines return))
    (with-output-to-string (s)
      (interval-message (300)
	(setq return (pop3-read-line stream))
	(while (not (string= "." return))
	  (format s "~A~%" return)
	  (incf bytes (1+ (string-length return)))
	  (message "Retrieving ~D: ~D" num bytes)
	  (setq return (pop3-read-line stream))
	  )))))

(defun pop3-dele (stream num)
  (unless (streamp stream)
    (return-from pop3-dele nil))
  (let ((return ""))
    (format stream "DELE ~D~%" num)
    (log-output *pop3-stream-output* "DELE ~D" num)
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (pop3-ok-p return)
    ))

(defun pop3-noop (stream)
  (unless (streamp stream)
    (return-from pop3-noop nil))
  (let ((return "")
	num)
    (format stream "NOOP~%")
    (log-output *pop3-stream-output* "NOOP")
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (pop3-ok-p return)
  ))

(defun pop3-rset (stream)
  (unless (streamp stream)
    (return-from pop3-rset nil))
  (let ((return "")
	num
	first
	last)
    (format stream "RSET~%")
    (log-output *pop3-stream-output* "RSET")
    (setq return (pop3-read-line stream))
    (message "~A" return)
    (pop3-ok-p return)
  ))
