(require 'sb-bsd-sockets)

(defpackage :repsmtpd
  (:use :cl :sb-bsd-sockets))

(in-package :repsmtpd)

(defconstant +listen-port+ 12345)
(defconstant +listen-addr+ "0.0.0.0")
(defconstant +server-name+ "repsmtpd.org")
(defconstant +mbox-dir+ "lisp/mbox/")

(defstruct conn state stream from to (data ""))

(defvar *server-socket* nil)
(defvar *command-handlers* nil)

(defun split-string (s c)
	(loop for i = 0 then (1+ j) as j = (position c s :start i)
	    collect (subseq s i j) while j))

(defun concat (l)
	(apply 'concatenate 'string l))

(defun intersperse (x l)
	(cdr (loop for i in l collect x collect l)))

(defun get-command (s)
	(string-upcase (car (remove-if (lambda (s) (string= "" s))
	    (split-string s #\space)))))

(defun strip-crlf (s)
	(if (eql s :eof)
		:eof
		(string-right-trim '(#\return #\linefeed) s)))

(defun say (conn code msg)
	(let ((s (conn-stream conn)))
		(format s "~a ~a~a~a" (write-to-string code) msg #\return
		    #\linefeed)
		(format *standard-output* "sending ~a ~a~&"
		    (write-to-string code) msg)
		(finish-output *standard-output*)
		(finish-output s)))

(defun process-ehlo (c args)
	(declare (ignore args))
	(say c 250 (format nil "~a lol hello" +server-name+))
	(setf (conn-state c) 'got-helo))

(defun process-quit (c args)
	(declare (ignore args))
	(say c 221 "bye!")
	(close (conn-stream c)))

(defun process-mail (c args)
	(if (not (eql (conn-state c) 'got-helo))
		(say c 503 "bad command sequence")
		(cond
			((not (search "MAIL FROM:" args :end2 12
			    :test 'char-equal))
			    (say c 500 "unknown command"))
			(t (let ((from (string-left-trim " " (concat
			    (cdr (split-string args #\:)))))) ;XXX intersperse ;
				(setf (conn-from c) from)
				(setf (conn-state c) 'got-mail)
				(say c 250 "OK"))))))

(defun process-rcpt (c args)
	(if (not (or (eql (conn-state c) 'got-mail)
	    (eql (conn-state c) 'got-rcpt)))
		(say c 503 "bad command sequence")
		(cond
			((not (search "RCPT TO:" args :end2 10
			    :test 'char-equal))
			    (say c 500 "unknown command"))
			(t (let ((to (string-left-trim " " (concat
			    (cdr (split-string args #\:)))))) ;XXX intersperse ;
				(setf (conn-to c) (cons to (conn-to c)))
				(setf (conn-state c) 'got-rcpt)
				(say c 250 "OK"))))))

(defun process-data (c args)
	(declare (ignore args))
	(if (not (eql (conn-state c) 'got-rcpt))
		(say c 503 "bad command sequence")
		(progn (say c 354 "go ahead")
			(setf (conn-state c) 'wait-data))))

(defun register-handlers ()
	(setf *command-handlers* '(("EHLO" . process-ehlo) ; XXX
	    ("HELO" . process-ehlo)
	    ("MAIL" . process-mail)
	    ("RCPT" . process-rcpt)
	    ("DATA" . process-data)
	    ("QUIT" . process-quit))))

(defun deliver-one (c to)
	(let ((path (concat (list +mbox-dir+ to))))
		(with-open-file (f path :direction :output :if-exists :append
		    :if-does-not-exist :create)
			(format f "~&~%From blah@blah.com  Sat Jan  3 01:05:34 1996~&")
			(format f "~a" (conn-data c)))))

(defun deliver (c)
	(pprint c)
	(finish-output *standard-output*)
	(mapcar (lambda (to) (deliver-one c to)) (conn-to c)))

(defun get-data (c l)
	(if (string= l ".")
		(progn
			(say c 250 "OK")
			(setf (conn-state c) 'got-data)
			(deliver c))
		(setf (conn-data c) (format nil "~a~a~a" (conn-data c)
		    #\linefeed l))))

(defun process-command (conn l)
	(let* ((command (get-command l))
	    (handler (assoc command *command-handlers* :test 'string=)))
		(format *standard-output* "got ~s~&" l)
		(finish-output *standard-output*)
		(if (eql handler nil)
			(say conn 500 "unknown command")
			(apply (cdr handler) conn (list l)))))

(defun process-connection (s)
	(let ((conn (make-conn :state 'greeting :stream s)))
		(say conn 220 "lol what")
		(loop while (open-stream-p s)
		    for l = (strip-crlf (read-line s nil :eof))
		    while (not (eql l :eof))
		    do (case (conn-state conn)
			('wait-data (get-data conn l))
			(otherwise (process-command conn l))))))

(defun start-server ()
	(setf *server-socket* (make-instance 'inet-socket :type :stream))
	(setf (sockopt-reuse-address *server-socket*) t)
	(socket-bind *server-socket* (make-inet-address +listen-addr+)
	    +listen-port+)
	(socket-listen *server-socket* 0))

(start-server)
(register-handlers)
(loop for socket = (socket-accept *server-socket*)
    for stream = (socket-make-stream socket :input t :output t
    :element-type 'character :external-format :latin-1)
    do
	(process-connection stream)
	(socket-close socket))