;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.124
;;; Reason:
;;;  SMTP connections now start off by sending a HELO message.
;;; Written 23-Nov-87 18:43:13 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.123, Experimental Local-File 73.2, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.USER; SMTP.LISP#17 at 23-Nov-87 18:44:32
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; SMTP  "


(defun smtp-send-it (locf-to-plist interval template)
  "a function that can be the value of the variable ZWEI:*MAIL-SENDING-MODE*"
  template
  (zwei:canonicalize-headers locf-to-plist)
  (let ((recipients (zwei:get-mail-recipients locf-to-plist))
	(plist (cdr locf-to-plist))
	(possible-hosts)
	(winning-host))
    ;; the recipients will be a plist with important keys :NAME and :HOST
    ;; (:NAME "gjc" :HOST ("angel"))
    ;; The PLIST will have such items as
    ;; :FROM ((:PERSONAL-NAME "" :NAME "GJC" :HOST ("LMI-LAMBDA-3")))
    ;; :DATE 2695327073
    ;; :SUBJECT "foo"
    ;; Since we dont have any host table with server information
    ;; in it, just try hard to win.
    (dolist (r recipients)
      (let ((h (si:parse-host (car (getf r :host)) t)))
	(and h
	     (send h :network-address :internet)
	     (member h zwei:*mail-smtp-hosts* :test #'eq)
	     (push h possible-hosts))))
    (setq possible-hosts (append zwei:*mail-smtp-hosts* possible-hosts))
    (or possible-hosts
	(error "no possible hosts to send to"))
    (let ((k 0))
      (dolist (w possible-hosts)
	(let ((m (count w possible-hosts)))
	  (when (> m k)
	    (setq k m)
	    (setq winning-host w)))))
    (with-open-stream (u (make-smtp-user *smtp-send-it-debug*))
      (send u :connect (send winning-host :name))
      (or (= 250 (nth-value 1
		   (send u :command "HELO ~A" (send si:local-host :name))))
	  (error "our host name ~S unacceptable because ~A"
		 (send si:local-host :name)
		 (send u :last-reply)))
      (or (= 250 (nth-value 1
		   (send u :command
			 "MAIL FROM:~A" (smtp-rcpt (car (getf plist :from))))))
	  (error "can't accept mail from: ~S because ~A"
		 (car (getf plist :from))
		 (send u :last-reply)))
      (dolist (r recipients)
	(or (= 250 (nth-value 1
		     (send u :command
			   "RCPT TO:~A" (smtp-rcpt r))))
	  (cerror "ignore this recipient"
		  "can't send mail to: ~S because ~A"
		  r
		  (send u :last-reply))))
      (or (= 354 (nth-value 1
		   (send u :command "DATA")))
	  (error "can't send the mail text data because ~A"
		 (send u :last-reply)))
      (send u :funcall-on-data-stream
	    #'zwei:output-header-and-msg
	    locf-to-plist interval template)
      (or (= 250 (nth-value 1 (send u :end-message)))
	  (error "some problem in ending message data: ~A"
		 (send u :last-reply))))))


))

; From modified file DJ: L.NETWORK.IP-TCP.USER; SMTP.LISP#17 at 23-Nov-87 18:44:34
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; SMTP  "


(defun send-terminal-message (host from to message-generator)
  (with-open-stream (u (make-smtp-user *smtp-send-it-debug*))
    (send u :connect (send host :name))
    (cond ((not (= 250 (nth-value 1  (send u :command "HELO ~A" (send si:local-host :name)))))
	   (error "our host name ~S unacceptable because ~A"
		  (send si:local-host :name)
		  (send u :last-reply)))
	  ((not (= 250 (nth-value 1  (send u :command "SEND FROM:<~A>" from))))
	   (merror "cant accept message from: ~S because ~A" 
		   from
		   (send u :last-reply)))
	  ((not (= 250 (nth-value 1 (send u :command "RCPT TO:<~A>" to))))
	   (merror "cant send message to: ~S because ~A" to (send u :last-reply)))
	  ((not (= 354 (nth-value 1 (send u :command "DATA"))))
	   (merror "cant send the terminal message text data because ~A"
		   (send u :last-reply)))
	  ((progn (send u :funcall-on-data-stream (if (stringp message-generator)
						      #'(lambda (stream)
							  (format stream "~A" message-generator))
						    message-generator))
		  (not (= 250 (nth-value 1 (send u :end-message)))))
	   (merror "some problem in ending message data: ~A" (send u :last-reply))))))

))