;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for Mailer version 2.1
;;; Reason:
;;;  Simplify MAIL server, add better error-catching macro that doesn't catch
;;;   CERROR (!).
;;; Written 3-Jul-86 19:17:26 by RpK (Robert P. Krajewski) at site LMI Cambridge
;;; while running on Lambda Four from band 2
;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Gateway 4.15, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.2, System Revision Level 3.94, Experimental Window-Maker 2.0, Experimental Mailer 2.0, microcode 1563, SDU Boot Tape 3.13, SDU ROM 102, Beta II, lmi-site.



; From modified file DJ: L.NETWORK.MAILER; MAIN.LISP#4 at 3-Jul-86 19:17:27
#10R MAILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "MAILER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; MAILER; MAIN  "

(defmacro ignoring-errors (&body body)
  `(condition-call-if (not *debug-server*) (.condition.) (progn ,@body t)
     ((and (condition-typep .condition. 'error)
	   (not (or (send .condition. :debugging-condition-p)
		    (send .condition. :dangerous-condition-p)
		    (condition-typep .condition. 'cerror))))
      nil)))

))

; From modified file DJ: L.NETWORK.MAILER; CHAOS.LISP#5 at 3-Jul-86 19:18:09
#10R MAILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "MAILER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; MAILER; CHAOS  "

(defun mail-server-chaos (&aux final-ok qfile)
  (let ((user-id "Mail-Server"))
    (ignoring-errors
      (as-mail-server (stream (chaos:open-stream nil "MAIL"))
	(send stream :add-as-server "MAIL")
	(ignoring-errors ; catch network lossage
	  (with-text-buffer (text stream)
	    (let ((recipients (expand-addresses (get-mail-recipients stream))))
	      (with-output-to-string (s text)
		(write-line (reception-line stream) s))
	      (get-mail-text stream text)
	      (finish-output stream)
	      (let ((result
		      (write-queue-file (setq qfile (qfile-name))
					recipients `(:failures 0
						     :source-network-type :chaos
						     :source-protocol :chaos-mail
						     :source-host ,(send stream :foreign-host))
					      TEXT STREAM)))
		(cond ((errorp result)
		       (setq final-ok ())
		       (if (probef qfile) (deletef qfile)))
		      (t
		       (setq final-ok :queued-ok))))))
	  (if final-ok (format stream "+Message sent successfully.~%"))
	  (force-output stream)))
	(when (and (eq final-ok :queued-ok)
		   (not *delay-delivery*))
	  (mail-deliver-qfile qfile)))))

))