;;; sendmail.mhtml: -*- Meta-HTML -*-  Send mail.
;;;
;;;  Copyright (c) 1995 Brian J. Fox
;;;  Author: Brian J. Fox (bfox@ai.mit.edu) Fri Sep 29 09:07:41 1995.

;;; <sendmail from to subject> body </sendmail>
<defmacro sendmail mail::from mail::to mail::subject
		   mail::headers[0] mail::headers[1] mail::headers[2]
		   whitespace=delete>
  <subst-in-var mail::from "[ \t\n]" ".">
  <with-open-stream stream localhost:25 type=tcp mode=read-write>
    <stream-put stream "HELO\r\n">
    <stream-put stream "MAIL FROM: \<<get-var mail::from>\>\r\n">
    <stream-put stream "RCPT TO: <get-var mail::to>\r\n">
    <stream-put stream "DATA\r\n">
    <stream-put stream "From <get-var mail::from>\r\n">
    <stream-put stream "To: <get-var mail::to>\r\n">
    <if <get-var mail::subject>
	<stream-put stream "Subject: <get-var mail::subject>\r\n">>
    <foreach mail::addr mail::headers>
      <stream-put stream "<get-var mail::addr>\r\n">
    </foreach>
    <stream-put stream "X-Mailer: Meta-HTML mailto.mhtml\r\n\r\n">
    <stream-put stream %qbody>
    <stream-put stream "\r\n.\r\n">
    <stream-put stream "QUIT\r\n">
    <stream-get-contents stream ignore>
  </with-open-stream>
</defmacro>

<defun mailable-address addr>
  <match <get-var-once addr> "^[^@ \t\r\n]+@[-_0-9a-zA-Z]+\\.[^@ \t\r\n]+*$">
</defun>

<defun e-mail::mailhost name>
  <if <get-var name>
      <set-var e-mail::mailhost=<get-var name>>
    <get-var e-mail::mailhost>>
</defun>

<defun e-mail::sendmail from to[] cc[] bcc[] headers[] message>
  <set-var result="">
  <defvar e-mail::mailhost localhost>
  <with-open-stream stream <e-mail::mailhost>:25 type=tcp mode=write-create>
    <stream-put stream "HELO <get-var env::server_name>\r\n">
    <set-var ignore=<stream-get stream>>
    <while <string-eq <substring <get-var ignore> 3 4> "-">>
      <set-var ignore=<stream-get stream>>
    </while>

    <stream-put stream "MAIL FROM: \<<get-var from>\>\r\n">
    <set-var ignore=<stream-get stream>>

    ;;; Put the TO addresses.
    <foreach addr to>
      <stream-put stream "RCPT TO: <get-var addr>\r\n">
      <set-var ignore=<stream-get stream>>
    </foreach>

    ;;; Put the CC addresses.
    <foreach addr cc>
      <stream-put stream "RCPT TO: <get-var addr>\r\n">
      <set-var ignore=<stream-get stream>>
    </foreach>

    ;;; Put the BCC addresses.
    <foreach addr bcc>
      <stream-put stream "RCPT TO: <get-var addr>\r\n">
      <set-var ignore=<stream-get stream>>
    </foreach>

    ;;; Start sending the body.
    <stream-put stream "DATA\r\n">
    <set-var ignore=<stream-get stream>>

    <stream-put stream "From <get-var from>\r\n">

    ;;; Mention all of the TO addresses here.
    <stream-put stream "To: <get-var to[0]>">
    <set-var i=1>
    <while <get-var to[i]>>
      ;;; Don't put more than 3 addresses per line.
      <if <eq <mod i 3> 0>
	  <stream-put stream ",\r\n\t<get-var to[i]>">
	<stream-put stream ", <get-var to[i]>">>
      <increment i>
    </while>
    <stream-put stream "\r\n">

    ;;; Mention all of the CC addresses here.
    <when <get-var cc[0]>>
      <stream-put stream "Cc: <get-var cc[0]>">
      <set-var i=1>
      <while <get-var cc[i]>>
	;;; Don't put more than 3 addresses per line.
	<if <eq <mod i 3> 0>
	    <stream-put stream ",\r\n\t<get-var cc[i]>">
	  <stream-put stream ", <get-var cc[i]>">>
	<increment i>
      </while>
      <stream-put stream "\r\n">
    </when>

    ;;; If there are any headers, put them here now.
    <foreach header headers>
      <stream-put stream "<get-var header>\r\n">
    </foreach>

    ;;; Put the subject if there is one.
    <if <get-var subject>
	<stream-put stream "Subject: <get-var subject>\r\n">>

    ;;; Tell the rest of world who to blame.
    <stream-put stream "X-Mailer: Meta-HTML Sendmail 1.0\r\n">

    ;;; End of headers.
    <stream-put stream "\r\n">

    ;;; Put the message body.
    <stream-put stream <get-var message>>

    ;;; End the message data.
    <stream-put stream "\r\n.\r\n">
    <set-var ignore=<stream-get stream>>

    ;;; Quit using sendmail.
    <stream-put stream "QUIT\r\n">
  </with-open-stream>
</defun>
