;-*- Mode:LISP; Package:MAIL; Base:8 -*-
;;; Mail server for the local file system

;;; For now only allow mail from one place at a time.
(DEFVAR *MAIL-SERVER-LOCK* NIL)

(DEFUN MAIL-SERVER (&AUX LOCK CONN STREAM (USER-ID USER-ID))
  (SETQ LOCK (LOCF *MAIL-SERVER-LOCK*))
  (CATCH-ERROR
    (UNWIND-PROTECT
      (PROG TOP ()
	    (AND (EQUAL USER-ID "") (SETQ USER-ID "Mail-server"))
	    (PROCESS-LOCK LOCK)
	    (SETQ CONN (CHAOS:LISTEN "MAIL"))
	    (CHAOS:ACCEPT CONN)
	    (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':ADD-SERVER CONN "MAIL")
	    (SETQ STREAM (CHAOS:STREAM CONN))
	    (LET* ((RECIPIENTS (GET-MAIL-RECIPIENTS STREAM))
		   (TEXT (GET-MAIL-TEXT STREAM)))
	      (DOLIST (RECIPIENT RECIPIENTS)
		(WITH-OPEN-FILE (OUTFILE (FS:MAKE-PATHNAME ':HOST "LM"
							   ':DIRECTORY RECIPIENT
							   ':NAME RECIPIENT
							   ':TYPE "MAIL"
							   ':VERSION 0)
					 '(:OUT :NOERROR))
		  (COND ((STRINGP OUTFILE)
			 (FORMAT STREAM "-Unexpected error for ~A: ~A~%" RECIPIENT OUTFILE)
			 (FUNCALL STREAM ':FORCE-OUTPUT)
			 (RETURN-FROM TOP)))
		  ;; This always appends new mail.  ZMail knows how to reverse it after all.
		  (WITH-OPEN-FILE (INFILE (FS:MAKE-PATHNAME ':HOST "LM"
							    ':DIRECTORY RECIPIENT
							    ':NAME RECIPIENT
							    ':TYPE "MAIL"
							    ':VERSION ':NEWEST)
					  '(:IN :NOERROR))
		    (OR (STRINGP INFILE)
			(STREAM-COPY-UNTIL-EOF INFILE OUTFILE)))
		  (FUNCALL OUTFILE ':STRING-OUT TEXT)
		  (FUNCALL OUTFILE ':LINE-OUT ""))))
	    (FORMAT STREAM "+Message sent successfully.~%")
	    (FUNCALL STREAM ':FORCE-OUTPUT)
	    (FUNCALL STREAM ':FINISH)
	    (FUNCALL STREAM ':CLOSE))
      (AND CONN (CHAOS:REMOVE-CONN CONN))
      (PROCESS-UNLOCK LOCK))))

(DEFUN GET-MAIL-RECIPIENTS (STREAM)
  (DO ((LINE)
       (RECIPIENTS NIL))
      (NIL)
    (SETQ LINE (FUNCALL STREAM ':LINE-IN))
    (AND (EQUAL LINE "") (RETURN (NREVERSE RECIPIENTS)))
    (IF (NOT (FS:LM-DIRECTORY-EXISTS-P LINE))
	(FORMAT STREAM "-Unknown user ~A.~%" LINE)
	(PUSH LINE RECIPIENTS)
	(FORMAT STREAM "+Recipient name ~A ok.~%" LINE))
    (FUNCALL STREAM ':FORCE-OUTPUT)))

(DEFUN GET-MAIL-TEXT (STREAM)
  (WITH-OUTPUT-TO-STRING (SSTREAM)
    (STREAM-COPY-UNTIL-EOF STREAM SSTREAM)
    (FUNCALL SSTREAM ':FRESH-LINE)))

(ADD-INITIALIZATION "MAIL"
                    '(PROCESS-RUN-TEMPORARY-FUNCTION "MAIL Server" 'MAIL-SERVER)
                    NIL
                    'CHAOS:SERVER-ALIST)