/* Mail Server - DMS - nov 1998 by Patrice FAVRE */

typeof SrvSMTP=S;;
typeof Before=S;;
typeof After=S;;
typeof Port=I;;
var DefaultPort=25;;
typeof Realname=S;;
typeof Host=S;;

struct Uti=[Cli:CLIENT, Id:S, Snd:[I S], Rcp:[I S], Cc:[I S], Bcc:[I S], Sub:[I S], Txt:[I S]] mkUti;;
typeof LstUti=[Uti r1];;

defcom CShow=Show S;;
defcom CSendOK=SendOK;;
defcom CSendKO=SendKO;;


/*-----------------------*/
fun findUti(lst, cli)=
	if lst==nil then nil
	else
		let lst -> [uti nxt] in
			if uti.Cli==cli then uti
			else findUti nxt cli;;

/*-----------------------*/
fun removeUti(lst, cli)=
	if lst==nil then nil
	else
		let lst -> [uti nxt] in
			if uti.Cli==cli then nxt
			else uti::(removeUti nxt cli);;

/*-----------------------*/
fun clidestroyed(cli)=
	set LstUti=removeUti LstUti cli;
	_DMSevent this cli EVT_DESTROYED nil nil;;

/*-----------------------*/
fun _RetSend(res, info)=
	let info -> [cli id subj] in
		if res!=0 then (
			_DMSevent this cli EVT_SENT_OK strbuild (KW_ID::id::nil)::(KW_SUB::subj::nil)::nil nil;
			if (findUti LstUti cli)!=nil then
				_DMSsend this cli CSendOK []
			else nil;
			set LstUti=removeUti LstUti cli;
			nil
		)
		else (
			_DMSevent this cli EVT_SENT_KO strbuild (KW_ID::id::nil)::(KW_SUB::subj::nil)::nil nil;
			if (findUti LstUti cli)!=nil then
				_DMSsend this cli CSendKO []
			else nil
		);
	0;;

/*-----------------------*/
fun _CtrlAdr(adr)=
	strfind "@" adr 0;;

/*-----------------------*/
fun _CtrlLstAdr(lstadr)=
	if lstadr==nil then 0
	else
		let lstadr -> [adr next] in
			if (_CtrlAdr adr)==nil then nil
			else _CtrlLstAdr next;;

/*-----------------------*/
fun _MailTo(cli,id,snd,fro,rcp,cc,bcc,sub,txt)=
  /* ctrl des champs obligatoires */
	if (emptyS snd) || ((emptyS rcp) && (emptyS cc) && (emptyS bcc)) || (emptyS sub) then
		_RetSend 0 [cli id sub]
	else
	/* on controle les paramètres */
	if (_CtrlAdr snd)==nil ||
	   (_CtrlLstAdr mklist rcp)==nil ||
	   (_CtrlLstAdr mklist cc)==nil ||
	   (_CtrlLstAdr mklist bcc)==nil then
		_RetSend 0 [cli id sub]
	else (
/*		SendSMTP (snd,fro,to,defto,cc,bcc,subject,body,realname,host,server,port,endfun)=*/
		SendSMTP snd if fro==nil then snd else fro rcp nil cc bcc sub strcatn Before::"\n"::txt::"\n"::After::nil
		 	       if Realname==nil then _DMSgetLogin cli else Realname
		 	       Host SrvSMTP Port mknode @_RetSend [cli id sub];
		0
	)
;;

/*-----------------------*/
fun __SendMail(send, recp, ecc, ebcc, subj, text)=
	let findUti LstUti DMSsender -> uti in
		if uti==nil then nil
		else
			let uti.Id -> id in
			let uti.Snd -> [isnd snd] in
			let uti.Rcp -> [ircp rcp] in
			let uti.Cc  -> [icc  cc ] in
			let uti.Bcc -> [ibcc bcc] in
			let uti.Sub -> [isub sub] in
			let uti.Txt -> [itxt txt] in (
				if (!emptyS send) && (isnd==Vva0 || isnd==Via0) then
					set snd=strcat send snd
				else
				if (!emptyS send) && (isnd==Vva1 || isnd==Via1) then
					set snd=strcat snd send
				else
				if isnd==Vvm then
					set snd=send
				else nil;
				if (!emptyS recp) && (ircp==Vva0 || ircp==Via0) then
					set rcp=strcatn recp::SEP_ADR::rcp::nil
				else
				if (!emptyS recp) && (ircp==Vva1 || ircp==Via1) then
					set rcp=strcatn rcp::SEP_ADR::recp::nil
				else
				if ircp==Vvm then
					set rcp=recp
				else nil;
				if (!emptyS ecc) && (icc==Vva0 || icc==Via0) then
					set cc=strcatn ecc::SEP_ADR::cc::nil
				else
				if (!emptyS ecc) && (icc==Vva1 || icc==Via1) then
					set cc=strcatn cc::SEP_ADR::ecc::nil
				else
				if icc==Vvm then
					set cc=ecc
				else nil;
				if (!emptyS ebcc) && (ibcc==Vva0 || ibcc==Via0) then
					set bcc=strcatn ebcc::SEP_ADR::bcc::nil
				else
				if (!emptyS ebcc) && (ibcc==Vva1 || ibcc==Via1) then
					set bcc=strcatn bcc::SEP_ADR::ebcc::nil
				else
				if ibcc==Vvm then
					set bcc=ebcc
				else nil;
				if (!emptyS subj) && (isub==Vva0 || isub==Via0) then
					set sub=strcatn subj::" "::sub::nil
				else
				if (!emptyS subj) && (isub==Vva1 || isub==Via1) then
					set sub=strcatn sub::" "::subj::nil
				else
				if isub==Vvm then
					set sub=subj
				else nil;
				if (!emptyS text) && (itxt==Vva0 || itxt==Via0) then
					set txt=strcatn text::"\n"::txt::nil
				else
				if (!emptyS text) && (itxt==Vva1 || itxt==Via1) then
					set txt=strcatn txt::"\n"::text::nil
				else
				if itxt==Vvm then
					set txt=text
				else nil;

				_MailTo DMSsender id snd nil rcp cc bcc sub txt
			);;

/*-----------------------*/
fun _CliMod(t)=
	let t -> [m v] in
		if m==Vno || m==Via0 || m==Via1 then (itoa m)::nil
		else (itoa m)::v::nil;;

/*-----------------------*/
fun action(from,cli,act,param,rep)=
_fooS strcat "ACTIONNNNNNNNNNN" act;
	if !strcmp act ACT_START then
		_DMScreateClientDMI this cli nil
	else
	if !strcmp act ACT_SHOW then (
		set LstUti=removeUti LstUti cli;
		let strextr param -> l in
		let getInfo l KW_ID -> id in
		let getInfos l KW_SND -> [isnd [snd _]] in
		let getInfos l KW_RCP -> [ircp [rcp _]] in
		let getInfos l KW_CC -> [icc [cc _]] in
		let getInfos l KW_BCC -> [ibcc [bcc _]] in
		let getInfos l KW_SUB -> [isub [sub _]] in
		let getInfos l KW_TXT -> [itxt [txt _]] in
		let mkUti [cli id [if isnd==nil then Vvm else atoi isnd snd] [if ircp==nil then Vvm else atoi ircp rcp]
			                [if icc==nil then Vvm else atoi icc cc] [if ibcc==nil then Vvm else atoi ibcc bcc]
			                [if isub==nil then Vvm else atoi isub sub] [if itxt==nil then Vvm else atoi itxt txt]] -> uti in (
			set LstUti=uti::LstUti;
			_DMSsend this cli CShow [_fooS strbuild (KW_SND::(_CliMod uti.Snd))::(KW_RCP::(_CliMod uti.Rcp))::
			                                  (KW_CC::(_CliMod uti.Cc))::(KW_BCC::(_CliMod uti.Bcc))::
			                                  (KW_SUB::(_CliMod uti.Sub))::(KW_TXT::(_CliMod uti.Txt))::nil];
			)
	)
	else
	if !strcmp act ACT_SEND then
		let strextr param -> l in
		let getInfo l KW_ID -> id in
		let getInfo l KW_SND -> snd in
		let getInfo l KW_FROM -> fro in
		let getInfo l KW_RCP -> rcp in
		let getInfo l KW_CC -> cc in
		let getInfo l KW_BCC -> bcc in
		let getInfo l KW_SUB -> sub in
		let getInfo l KW_TXT -> txt in
			_MailTo cli id snd fro rcp cc bcc sub txt
	else
	if !strcmp act ACT_DESTROY then (
		_DMSdelClientDMI this cli;
		clidestroyed cli
	)
	else nil;;

/*-----------------------*/
fun IniDMI(s)=
	_DMSregisterDMI this @action @clidestroyed @clidestroyed nil;
	let strextr _getpack _checkpack s -> l in (
	set SrvSMTP=_gethostbyname getInfo l KW_SMTP;
	set Before=let getInfo l KW_BEFORE -> val in
	           if val==nil then "" else val;
	set After=let getInfo l KW_AFTER -> val in
	          if val==nil then "" else val;
	set Port=let atoi getInfo l KW_PORT -> val in
	         if val==nil then DefaultPort else val;
	set Realname=let getInfos l KW_REALNAME -> [def [val _]] in
	             if (atoi def)==1 then nil else val;
	set Host=let getInfos l KW_HOST -> [def [val _]] in
	         if (atoi def)==1 || (val==nil) then _hostIP else _gethostbyname val
	);;