/*
** $VER: Local2Email.br 1.55 (13.6.97)
** by Eirik Nicolai Synnes
**
** Based on ML2Email.thor by Remco van Hooff
**
** See SortMail.guide for documentation
**
*/

options results

parse arg arguments

/*
** Initialize some variables
*/

template = 'SYSTEM/A'

fromthor = 0; cfgread = 0

EVE_ENTERMSG       =  0  /* Enter message */
EVE_REPLYMSG       =  1  /* Reply message */
EVE_FORWARDMSG     =  9  /* Forward message (only for TCP/SOUP) */

EDB_DELETED        =  0  /* Event is deleted */
EDB_PACKED         =  1  /* Event is packed */
EDB_DONE           =  2  /* Event is done */
EDB_ERROR          =  3  /* Error performing this event */
EDB_UNRECOVERABLE  =  4  /* Event can not be undeleted */
EDB_FREEZE         =  5  /* Event is frozen. Will not be done as long as this flag is set. */

CDB_MAIL           =  1  /* Private mail conference. */
CDB_NOT_ON_BBS     = 15  /* This conference is not on the bbs. */

UDB_DELETED        =  0  /* User is deleted */
UDB_UNRECOVERABLE  =  1  /* User can not be undeleted */

BDB_EVENTS_CHANGED =  5  /* Events changed after last event package was made. */

/*
** Find/open Thor ARexx port
*/

/* See if I'm run from Thor */

if left(address(), 5) = 'THOR.' then do
	thorport = address()
	address(thorport)
	'CURRENTSYSTEM STEM 'cursys
	if rc ~= 0 then do
		say 'CURRENTSYSTEM: 'THOR.LASTERROR
		exit(rc)
		end
	else fromthor = 1
	end

/*
** Find/open BBSREAD ARexx port
*/

if ~show('P', 'BBSREAD') then do
	address(command)
	'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
	if exists('SYS:RexxC/WaitForPort') then 'SYS:RexxC/WaitForPort BBSREAD'
	else 'WaitForPort BBSREAD'
	if (rc = 5) then do; myerr = 'Couldn''t open BBSREAD''s ARexx port.'; rc = 30; signal error; end
	if (rc ~= 0) then do; myerr = 'Could not find SYS:Rexxc/WaitForPort.'; rc = 30; signal error; end
	end

/*
** Parse arguments
*/

address(bbsread)

if ~fromthor then do
	if arguments = '?' | arguments = '' then do
		say 'Usage: 'template
		exit(0)
		end
	'READARGS 'template args' CMDLINE 'arguments
	if rc ~= 0 then do
		say 'READARGS: 'BBSREAD.LASTERROR
		exit(rc)
		end
	cursys.BBSNAME = args.SYSTEM
	end

/*
** Get system info
*/


'GETBBSDATA BBSNAME "'cursys.BBSNAME'" STEM 'bbsdata
if rc ~= 0 then do
	say 'GETBBSDATA: 'BBSREAD.LASTERROR
	exit(rc)
	end
if (right(bbsdata.BBSPATH, 1) ~= ':') & (right(bbsdata.BBSPATH, 1) ~= '/') then bbsdata.BBSPATH = bbsdata.BBSPATH || '/'

/*
** Leave if there are no active changed events
*/

if (bbsdata.NUMEVENTS = 0) | ~bittst(bbsdata.FLAGS, BDB_EVENTS_CHANGED) then exit(0)

/*
** Find name of email conference
*/

'GETCONFLIST BBSNAME "'cursys.BBSNAME'" STEM 'conflist
if rc ~= 0 then do
	say 'GETCONFLIST: 'BBSREAD.LASTERROR
	exit(rc)
	end

mailcount = 0
do i = 1 to conflist.COUNT
	'GETCONFDATA "'cursys.BBSNAME'" "'conflist.i'" 'confdata
	if rc ~= 0 then do
		say 'GETCONFDATA: 'BBSREAD.LASTERROR
		exit(rc)
		end
	if bittst(confdata.FLAGS, CDB_MAIL) then do
		email = confdata.NAME; mailcount = mailcount + 1
		end
	end

if symbol('email') ~= 'VAR' then do
	say 'Couldn''t find Email conference'
	exit(20)
	end

if mailcount > 1 then email = readcfg(1)

/*
** Main loop
*/

do n = bbsdata.FIRSTEVENT to bbsdata.LASTEVENT
	drop eventtags. eventdata.

	changed = 0; crosspost = 0

	/* Read event data */

	'READBREVENT "'cursys.BBSNAME'" EVENTNR 'n' DATASTEM 'eventdata' TAGSSTEM 'eventtags
	if rc ~= 0 then do
		say 'READBREVENT: 'BBSREAD.LASTERROR
		exit(rc)
		end

	/* Skip event if it is not a reply/enter or it is deleted, packed, etc. */

	if ~(eventdata.EVENTTYPE = EVE_ENTERMSG | eventdata.EVENTTYPE = EVE_REPLYMSG | eventdata.EVENTTYPE = EVE_FORWARDMSG) then iterate n
	if bittst(eventdata.FLAGS, EDB_DELETED) | bittst(eventdata.FLAGS, EDB_PACKED) | bittst(eventdata.FLAGS, EDB_DONE) | bittst(eventdata.FLAGS, EDB_ERROR) | bittst(eventdata.FLAGS, EDB_UNRECOVERABLE) | bittst(eventdata.FLAGS, EDB_FREEZE) then iterate n

	/* Split conferences and to-addresses into stems */

	if index(eventtags.CONFERENCE, ',') > 0 then do
		crosspost = 1; confs = eventtags.CONFERENCE; ccnt = 0
		do while index(confs, ',') > 0
			ccnt = ccnt + 1; confs.ccnt = left(confs, (index(confs, ',') - 1))
			confs = substr(confs, index(confs, ',') + 1)
			end
		ccnt = ccnt + 1; confs.ccnt = confs; confs.count = ccnt; drop confs ccnt
		end
	else do; confs.count = 1; confs.1 = eventtags.CONFERENCE; end

	if index(eventtags.TOADDR, ',') > 0 then do
		toaddrs = eventtags.TOADDR; acnt = 0
		do while index(toaddrs, ',') > 0
			acnt = acnt + 1; toaddrs.acnt = left(toaddrs, (index(toaddrs, ',') - 1))
			toaddrs = substr(toaddrs, index(toaddrs, ',') + 1)
			end
		acnt = acnt + 1; toaddrs.acnt = toaddrs; toaddrs.count = acnt; drop toaddrs acnt
		end
	else do; toaddrs.count = 1; toaddrs.1 = eventtags.TOADDR; end

	/* Replace local conferences with email conference and add reply address */

	do i = 1 to confs.count
		drop confdata.; unknown = 0
		'GETCONFDATA "'cursys.BBSNAME'" "'confs.i'" 'confdata
		if rc ~= 0 then do
			if BBSREAD.LASTERROR = 'Unknown conference' then unknown = 1
			else do
				say 'GETCONFDATA: 'BBSREAD.LASTERROR
				exit(rc)
				end
			end

		if (~unknown) & (bittst(confdata.FLAGS, CDB_NOT_ON_BBS)) then do
			if cfgread = 0 then call readcfg(0); addradd = 0

			if trig.count > 0 then do m = 1 to trig.count
				if upper(trig.m.conf) = upper(confs.i) then do
					match = 0
					do j = 1 to toaddrs.count
						if upper(toaddrs.j) = upper(trig.m.addr) then match = 1
						end
					if ~match then do
						acnt = toaddrs.count + 1; toaddrs.acnt = trig.m.addr; toaddrs.count = acnt; addradd = 1
						end
					end
				end

			if (addradd | confs.i ~= email) then confs.i = email
			changed = 1
			end
		end

	/* Recreate conference and to-address strings */

	eventtags.CONFERENCE = ''; mailfound = 0
	do i = 1 to confs.count
		if (upper(confs.i) ~= upper(email)) | (~mailfound) then eventtags.CONFERENCE = eventtags.CONFERENCE || confs.i || ','
		if (~mailfound) & (upper(confs.i) = upper(email)) then mailfound = 1
		end
	eventtags.CONFERENCE = strip(eventtags.CONFERENCE, 'B', ',')

	eventtags.TOADDR = ''
	do i = 1 to toaddrs.count
		eventtags.TOADDR = eventtags.TOADDR || toaddrs.i || ','
		end
	eventtags.TOADDR = strip(eventtags.TOADDR, 'B', ',')

	/* Replace names with corresponding address(es) */

	if (~crosspost) & (symbol('eventtags.TOADDR') = 'VAR') & (strip(eventtags.TOADDR, 'B') ~= '') & (length(eventtags.TOADDR) = length(compress(eventtags.TOADDR, '@#?*()|'))) then do
		drop user.
		'SEARCHBRUSER "'cursys.BBSNAME'" STEM 'user' SEARCH "'addasterix(eventtags.TOADDR)'" NAME'
		if rc ~= 0 then do
			say 'SEARCHBRUSER: 'BBSREAD.LASTERROR
			exit(rc)
			end
		if result > 0 then do
			drop usertags. userdata.
			'READBRUSER BBSNAME "'cursys.BBSNAME'" USERNR 'user.1.USERNR' TAGSSTEM 'usertags' DATASTEM 'userdata
			if rc ~= 0 then do
				say 'READBRUSER: 'BBSREAD.LASTERROR
				exit(rc)
				end
			if ~bittst(userdata.FLAGS, UDB_DELETED) & ~bittst(userdata.FLAGS, UDB_UNRECOVERABLE) then do
				eventtags.TOADDR = usertags.ADDRESS; changed = 1
				end
			end
		end

	if changed then do
		'WRITEBREVENT BBSNAME "'cursys.BBSNAME'" EVENT 'eventdata.EVENTTYPE' STEM 'eventtags 'UPDATEEVENTNR 'n
		if rc ~= 0 then do
			say 'READBRUSER: 'BBSREAD.LASTERROR
			exit(rc)
			end
		end
	end

exit(0)

/*
** Procedures
*/

readcfg: procedure expose cfgread trig. bbsdata.
         parse arg email

foundcfg = 0; trigcnt = 0

cfgpath = bbsdata.BBSPATH
cfgfile = 'SortMail.cfg'

if (right(cfgpath, 1) ~= '/') & (right(cfgpath, 1) ~= ':') then cfgpath = cfgpath || '/'

if ~exists(cfgpath || cfgfile) then do
	say 'Couldn''t find SortMail.cfg'
	exit(30)
	end

cfgopen = open(cf, cfgpath || cfgfile, 'R')

address(bbsread)

if cfgopen then do until eof(cf)
	entry = readln(cf)
	if ~email & upper(subword(entry, 1, 1)) = 'ACTION' then do
		'READARGS TEMPLATE "TYPE/A,DESTSYS/K,DESTCONF/K,REPLYADDR/K,SCRIPTNAME/K,SCRIPTOPTS/K,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S,CHECKDUPES/S,DONTADD/S,NOSTATS/S,SUBJECT/K,SENDTO/K,TEXTFILE/K" STEM 'trigentry' CMDLINE 'subword(entry, 2)
		if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
		if (upper(trigentry.TYPE) = 'COPY' | upper(trigentry.TYPE) = 'SPLITDIGEST') & symbol('trigentry.REPLYADDR') = 'VAR' then do
			trigcnt = trigcnt + 1; trig.trigcnt.conf = trigentry.DESTCONF; trig.trigcnt.addr = trigentry.REPLYADDR
			end
		trig.count = trigcnt; drop trigentry.
		end
	if email & upper(subword(entry, 1, 1)) = 'GLOBAL' then do
		'READARGS TEMPLATE "SYSTEM/K,CONFERENCE/A,STATISTICS/S,NOWARN/S,LOGINSTATE/S" STEM 'trigentry' CMDLINE 'subword(entry, 2)
		if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
		call close(cf)
		return(trigentry.CONFERENCE)
		end
	end

cfgread = 1

call close(cf)

return(0)


addasterix: interpret 'procedure expose 'globals
            parse arg str

if str = '' then return(str)

lastfound = 0; found = index(str, '"')
do while found > lastfound
	secondpart = substr(str, found + length('"'))
	firstpart = substr(str, 1, length(str) - length(substr(str, found)))
	str = firstpart || '*"' || secondpart
	lastfound = found + length('*"')
	found = index(str, '"', lastfound)
	end

return(str)