/* 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,
  realname      :S,
  rcptname      :[S r1],
  ccname        :[S r1],
  bccname       :[S r1],
  subject       :S,
  maildata      :S,
  domainname    :S,
  serveraddress :S,
  endfun        :fun [I] I
] mkOutMail;;

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

fun unbracket (s)=
{
  let strlen s -> len in
  let 0->i in
  {
    while ((nth_char s i)!='<) && i<len do set i=i+1;
    if ((nth_char s i)=='<) then
      substr s i (strlen s)-i
    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 (strlen s)<=0 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:"::u.sendername::"\n"::nil (rcpt conc3list u.rcptname u.ccname 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::" <"::u.sendername::">\nSubject: "::u.subject::"\nTo: "::(mkstr u.rcptname)::"\ncc: "::(mkstr u.ccname)::"\n"::u.maildata::"\n.\n"::nil quit])
        |(quit -> ["QUIT\n" quitted])
        |(quitted -> [nil nil])
        )-> [ss next] in
      {
        _fooS ss;
        _TELNETSend ss obj;
        set u.pass=next;
        nil
      }
    }
  }
};;

fun SendSMTP (from,to,cc,bcc,subject,body,realname,host,server,port,endfun)=
{
  let _TELNETConnect _channel (strcatn server::":"::(itoa port)::nil) -> tel in
  let mkOutMail [helo _fooS from _fooS realname _fooSList mklist to _fooSList mklist cc _fooSList mklist 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;
  }
};;