/* SMTP.PKG */
/* By Sebastien Metrot */
/* mod by Patrice Favre */

typedef SMTPstate=
  helo
  |mail
  |rcpt [S r1]
  |data
  |send
  |quit
  |quitted;;

struct OutMail=[
  pass          :SMTPstate,
  sendername    :S,
  fromname      :S,
  realname      :S,
  rcptname      :S,
  rcptdef       :S,
  ccname        :S,
  bccname       :S,
  subject       :S,
  maildata      :S,
  domainname    :S,
  serveraddress :S,
  endfun        :fun [I] I
] mkOutMail;;

fun emptyS(s)=
	if (strlen s)<=0 then 1
	else 0;;

/* transform LF -> CR+LF */
fun mkCRLF(s)=
	let strfind "\n" s 0 -> lf in
		if lf==nil then strdup s
		else if lf==0 then strcat "\13\n" mkCRLF substr s 1 (strlen s)-1
		else if !strcmp substr s lf-1 1 "\13" then strcat substr s 0 lf+1 mkCRLF substr s lf+1 (strlen s)-lf-1
		else strcatn (substr s 0 lf)::"\13\n"::(mkCRLF substr s lf+1 (strlen s)-lf-1)::nil
;;

/* SMTP automaton .................... */
fun SMTPConnected (obj,u)=
{
	_fooS strcat u.serveraddress " SMTP server connected";
  0
};;

/* remove < and > from email address */
fun unbracket (s)=
	let strfind "<" s 0 -> i in
	if (i!=nil) && ((nth_char s (strlen s)-1)=='>) then
		substr s i+1 (strlen s)-i-2
	else s
;;

fun SMTPClosed (obj,u)=
  if (u.pass==nil) then
    exec u.endfun with [1]
  else
    let (match u.pass with
     (helo -> [0])
    |(mail -> [0])
    |(rcpt x-> [0])
    |(data -> [0])
    |(send -> [0])
    |(quit -> [1])
    |(quitted -> [1])) -> result in
    exec u.endfun with result;;

fun mklist(s)=
	if (emptyS s) then nil
	else
		let strfind "," s 0 -> sep in
			if sep==nil then s::nil
			else (substr s 0 sep)::(mklist substr s sep+1 (strlen s)-sep-1);;

fun conc2list(p,q)=
	if p==nil then q
	else (hd p)::conc2list tl p q
;;

fun conc3list(p,q,r)=
	conc2list conc2list p q r
;;

fun mkstr(lst)=
	if (tl lst)==nil then hd lst
	else strcatn (hd lst)::","::(mkstr tl lst)::nil;;

fun SMTPRead (obj,u)=
{
  let (_fooS _TELNETGetBuffer obj) -> s in
  {
    if ((nth_char s 0) != '2) && ((nth_char s 0) != '3) then
    {
      _TELNETClose obj;
      exec u.endfun with [0]
    }
    else
    {
      let (match u.pass with
        (helo -> [strcatn "HELO "::u.domainname::"\n"::nil mail])
        |(mail-> [strcatn "MAIL FROM:<"::(unbracket u.sendername)::">\n"::nil (rcpt conc3list mklist u.rcptname mklist u.ccname mklist u.bccname)])
        |(rcpt x-> if (sizelist x)>1 
                   then [(strcatn "RCPT TO:<"::(unbracket hd x)::">\n"::nil) (rcpt tl x)] 
                   else [(strcatn "RCPT TO:<"::(unbracket hd x)::">\n"::nil) data]
         )
        |(data -> ["DATA\n" send])
        |(send -> [strcatn "Date: "::(ctime time)::"From: "::u.realname::" <"::(unbracket u.fromname)::">\n"::
                           "Subject: "::u.subject::"\n"::
                           "To: "::(if (emptyS u.rcptname) && (!emptyS u.bccname) then u.rcptdef else u.rcptname)::"\n"::
                           (if (emptyS u.ccname) then nil else strcatn "cc: "::u.ccname::"\n"::nil)::
                           u.maildata::"\n.\n"::nil quit])
        |(quit -> ["QUIT\n" quitted])
        |(quitted -> [nil nil])
        )-> [ss next] in
      {
        _TELNETSend _fooS mkCRLF ss obj;
        set u.pass=next;
        nil
      }
    }
  }
};;

fun SendSMTP (snd,fro,to,defto,cc,bcc,subject,body,realname,host,server,port,endfun)=
{
  let _TELNETConnect _channel (strcatn server::":"::(itoa port)::nil) -> tel in
  let mkOutMail [helo _fooS snd _fooS fro _fooS realname _fooS to _fooS defto
                 _fooS cc _fooS bcc _fooS subject _fooS body
                 _fooS host _fooS strcatn server::":"::(itoa port)::nil endfun] -> mail in
  {
    _TELNETrflRead tel @SMTPRead mail;
    _TELNETrflConnect tel @SMTPConnected mail;
    _TELNETrflClose tel @SMTPClosed mail;
  }
};;