/*
** $VER: SortMail.br 3.1 (13.6.96)
** by Eirik Nicolai Synnes
**
** Some code borrowed from AddSOUP.thor     by Magne Østlyngen
**                     and AddAmiNetList.br by Petter Nilsen
**
** See SortMail.guide for documentation
**
*/

options results
options failat 31

/*signal on error*/
signal on syntax
signal on break_c
signal on halt

parse arg arguments

/*
** Initialize some variables
*/

version         = subword(sourceline(2), 4)

cfgfile         = 'SortMail.cfg'
cfgpath         = 'ENV:Thor/'

template        = 'ALL/S,QUIET/S,MSGNO/K/N/M,SHANGHAI/S,LOGINSTATE/S,NOWARN/S,NOCOUNTER/S'

args.all        = 0; args.quiet      = 0; args.shanghai    = 0;
args.loginstate = 0; args.nowarn     = 0; args.nocounter   = 0;

fromthor        = 0; delnewfiles      = 0
logcount        = 0; aminetlogcount  = 0; errlogcount      = 0

MDB_READ                =  1  /* Message is read. */
MDB_DELETED             =  5  /* Message is deleted. */
MDB_MARKED              = 10  /* Message is marked. */
MDB_SUPERMARKED         = 13  /* Message will not be unmarked as long as this flag is set. */

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

globals = 'thorport fromthor progwin thorpath cfgpath cfgfile log. logcount delnewfiles aminetlog. aminetlogcount errlog. errlogcount counter data. head. text. textread globalcfg. args. trigger. newmsg. bbsdata. conflist. curbbs. fileopen BBSREAD.LASTERROR THOR.LASTERROR globals'

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

if left(address(), 5) = 'THOR.' then do
	thorport = address()
	address(thorport)
	GETGLOBALCONFIG STEM globcfg
	if rc ~= 0 then call displayerror(30, 'SortMail', 'GETGLOBALCONFIG: 'THOR.LASTERROR)
	else do
		pubscreen = globcfg.PUBSCREENNAME
		fromthor = 1
		end
	end

/* Find/open BBSREAD ARexx port */

if ~show('P', 'BBSREAD') then do
	address(command)
	'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
	'WaitForPort BBSREAD'
	if rc ~= 0 then displayerror(30, 'SortMail', 'Couldn''t open BBSREAD''s ARexx port.')
	end

/*
** Give template if arguments = '?'
*/

if arguments = '?' then do
	say 'Usage: 'template
	signal cleanup
	end

/*
** See if another copy of SortMail is already running
*/

if getclip('SM_Active') ~= '' then call notify("Another copy of SortMail is probably running.\nDo you want to continue?", "Yes|No")
if result = 0 then exit(0)
call setclip('SM_Active', 'True')

/*
** Find the configuration file (SortMail.cfg)
*/

call open(pn, 'ENV:Thor/THORPATH', 'R')
thorpath = readln(pn)
call close(pn)

if ~exists(cfgpath || cfgfile) then call displayerror(30, 'SortMail', 'Couldn''t find configuration file.')

/*
** See if user has entered a system or is in the startup window
*/

if fromthor then do
	address(thorport)
	CURRENTSYSTEM STEM curbbs
	if rc = 1 then call displayerror(30, 'SortMail', 'Enter your configured system\nbefore running this script.')
	else if rc > 1 then call displayerror(30, 'SortMail', 'CURRENTSYSTEM: 'THOR.LASTERROR)
	end
else if arguments ~= '' then do
	address(bbsread)
	READARGS template args arguments
	if rc ~= 0 then do
		say BBSREAD.LASTERROR
		say 'Template: 'template
		signal cleanup
		end

	/* Some cmd line checking */
	if args.SHANGHAI & symbol('args.MSGNO.COUNT') = 'VAR' then call displayerror(30, 'SortMail', 'You can''t specify both SHANGHAI/S and MSGNO/K/N at the same time.')
	if args.LOGINSTATE & ~args.SHANGHAI then call displayerror(30, 'SortMail', 'LOGINSTATE/S can only be used together with SHANGHAI/S.')
	end

if fromthor then do
	address(thorport)
	OPENPROGRESS TITLE '"SortMail.br 'version'"' PT '"Reading configuration..."' AT '"_Abort"' PCW 40
	if rc = 0 then progwin = result
	else call displayerror(30, 'SortMail', 'OPENPROGRESS: 'THOR.LASTERROR)
	end
else if ~args.QUIET then do
	say 'SortMail 'version' by Eirik Nicolai Synnes'
	say 'Reading configuration...'
  end

/*
** Read configuration
*/

call readcfg()

if args.NOWARN then globalcfg.NOWARN = 1

/*
** Get some system info
*/

address(bbsread)
GETCONFLIST BBSNAME '"'globalcfg.system'"' STEM conflist
if rc ~= 0 then call displayerror(30, 'SortMail', 'GETCONFLIST: 'BBSREAD.LASTERROR)

GETBBSDATA '"'globalcfg.system'"' bbsdata
if rc ~= 0 then call displayerror(30, 'SortMail', 'GETBBSDATA: 'BBSREAD.LASTERROR)

if ~fromthor then do
	GETCONFDATA '"'globalcfg.system'"' '"'globalcfg.conference'"' STEM confdata
	if rc ~= 0 then call displayerror(30, 'SortMail', 'GETCONFDATA: 'BBSREAD.LASTERROR)
	end

/*
** Exit if there's no marked messages in email conference
*/

if args.LOGINSTATE & confdata.MSGMARKED = 0 then signal cleanup

/*
** Get a list of the messages to process
*/

if fromthor then do
	/* Get message array from Thor */

	if globalcfg.LOGINSTATE then lstate = 'LOGINSTATE'
	else lstate = ''
	address(thorport)
	GETMESSAGEARRAY '"'globalcfg.conference'"' msgs lstate
	if rc = 5 then signal cleanup
	else if rc ~= 0 then call displayerror(30, 'SortMail', 'GETMESSAGEARRAY: 'THOR.LASTERROR)
	end
else do
	select
		when symbol('args.MSGNO.COUNT') = 'VAR' then do
			/* Create message array from msg number given on cmd line */

			argcnt = 0
			do i = 1 to args.MSGNO.COUNT
				if (args.MSGNO.i > confdata.FIRSTMSG - 1) & (args.MSGNO.i < confdata.LASTMSG + 1) then do
					argcnt = argcnt + 1
					msgs.argcnt = args.MSGNO.i
					end
				end

			msgs.count = argcnt
			args.ALL = 1
			end

		when args.SHANGHAI then do
			/* Get message array from an available Thor port */

			ports = show('P')
			do i = 1 to words(ports)
				if left(subword(ports, i), 5) = 'THOR.' then thorport = subword(ports, i, 1)
				end
			if thorport ~= 'THORPORT' then do
				address(thorport)
				CURRENTSYSTEM STEM curbbs
				if rc = 0 & curbbs.BBSNAME = globalcfg.system then do
					if args.LOGINSTATE then lstate = 'LOGINSTATE'; else lstate = ''
					GETMESSAGEARRAY '"'globalcfg.conference'"' msgs lstate
					if rc = 5 then signal cleanup
					else if rc ~= 0 then call displayerror(30, 'SortMail', 'GETMESSAGEARRAY: 'THOR.LASTERROR)
					end
				args.ALL = 1
				end
			else displayerror(30, 'SortMail', 'Couldn''t find Thor''s ARexx port.')
			end

		otherwise do
			/* Just do 'em all */

			if ~args.NOCOUNTER & exists('ENV:Thor/SortMail.count') then do
				call open(cn, 'ENV:Thor/SortMail.count', 'R')
				counter = readln(cn)
				call close(cn)
				if counter > confdata.FIRSTMSG then confdata.FIRSTMSG = counter
				if counter >= confdata.LASTMSG then signal cleanup
				end

			msgs.count = confdata.LASTMSG - confdata.FIRSTMSG + 1

			if msgs.count > 0 then do i = 1 to (confdata.LASTMSG - confdata.FIRSTMSG) + 1
				msgs.i = confdata.FIRSTMSG + (i - 1)
				end
			end
		end
	end

/*
** Exit if there are no messages to process
*/

if msgs.count = 0 then signal cleanup

/*
** Set ARexx clips
*/

call setclip('SM_System', globalcfg.SYSTEM)
call setclip('SM_Conference', globalcfg.CONFERENCE)

/*
** Utilize BBSRead's copyback buffer
*/

address(bbsread)
BUFMODE COPYBACK

/*
** Start processing messages
*/

processed = 0; totfound = 0; totfail = 0

do i = 1 to msgs.count
	msgfini = 0; textread = 0; failed = 0; dodelmsg = 0; dodeluser = 0
	drop data. head. text.

	/* Update progressreport */
	if fromthor then do
		progtext = 'Processing message 'i' of 'msgs.count' (#'msgs.i')'
		address(thorport)
		UPDATEPROGRESS REQ progwin TOTAL msgs.count CURRENT i PT '"'progtext'"'
		if rc = 5 then signal writelog
		else if rc > 0 then call displayerror(rc, 'SortMail', 'UPDATEPROGRESS: 'THOR.LASTERROR, msgs.i)
		end
	else if (~args.QUIET) then do
		say '1B'x'[1A' || '1B'x'[K' || 'Message 'msgs.i' ('i' of 'msgs.count')' || '1B'x'[0m'
		say '1B'x'[1A' || '1B'x'[32CType: '
		end

	processed = processed + 1

	/* Read message data */
	address(bbsread)
	READBRMESSAGE '"'globalcfg.system'"' '"'globalcfg.conference'"' msgs.i DATASTEM data
	if rc ~= 0 then do
		call displayerror(10, 'SortMail', 'READBRMESSAGE, data stem: 'BBSREAD.LASTERROR, msgs.i)
		iterate i
		end

	counter = msgs.i

	/* If messsage is marked as deleted or superunread then skip it */
	if ~fromthor & ~bittst(data.FLAGS, MDB_MARKED) & ~args.all then msgfini = 1
	if bittst(data.FLAGS, MDB_SUPERMARKED) then msgfini = 1
	if bittst(data.FLAGS, MDB_DELETED)     then msgfini = 1
	if msgfini = 1 then iterate i

	READBRMESSAGE '"'globalcfg.system'"' '"'globalcfg.conference'"' msgs.i HEADSTEM head
	if rc ~= 0 then do
		call displayerror(10, 'SortMail', 'READBRMESSAGE, head stem: 'BBSREAD.LASTERROR, msgs.i)
		iterate i
		end

	/* Trigger loop */
	address(bbsread)
	do j = 1 to trigger.count
		foundmsg = 0; foundcrits = 0

		/* Search loop */
		do k = 1 to trigger.j.search.count while foundmsg = 0
			/* Search in names, addresses and subject */
			select
				when trigger.j.search.k.type = 'FROMADDR' then if index(upper(head.FROMADDR), upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
				when trigger.j.search.k.type = 'FROMNAME' then if index(upper(head.FROMNAME), upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
				when trigger.j.search.k.type = 'TOADDR'   then if index(upper(head.TOADDR),   upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
				when trigger.j.search.k.type = 'TONAME'   then if index(upper(head.TONAME),   upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
				when trigger.j.search.k.type = 'SUBJECT'  then if index(upper(head.SUBJECT),  upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
				otherwise if trigger.j.search.k.type ~= 'HEADER' then do
					if symbol('trigger.j.search.k.type') = 'VAR' then call displayerror(5, 'SortMail', 'Unsupported SEARCH type: 'trigger.j.search.type, msgs.i)
					else call displayerror(5, 'SortMail', 'Trigger contains invalid search entry', msgs.i)
					end
				end
			if trigger.j.matchall & foundmsg then do; foundcrits = foundcrits + 1; foundmsg = 0; end
			end

		do k = 1 to trigger.j.search.count while foundmsg = 0
			/* Search in header */
			if trigger.j.search.k.type = 'HEADER' then do
				if textread = 0 then do
					READBRMESSAGE '"'globalcfg.system'"' '"'globalcfg.conference'"' msgs.i TEXTSTEM text
					if rc ~= 0 then do
						call displayerror(10, 'SortMail', 'READBRMESSAGE, text stem: 'BBSREAD.LASTERROR, msgs.i)
						iterate i
						end
					textread = 1
					end
				if symbol('text.COMMENT.COUNT') = 'VAR' & text.COMMENT.COUNT > 0 then do l = 1 to text.COMMENT.COUNT
					if upper(left(text.COMMENT.l, length(trigger.j.search.k.keyword))) = upper(trigger.j.search.k.keyword) & index(upper(text.COMMENT.l), upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
					end
				end
			if trigger.j.matchall & foundmsg then do; foundcrits = foundcrits + 1; foundmsg = 0; end
			end

		if trigger.j.matchall & foundcrits = trigger.j.search.count then foundmsg = 1

		if foundmsg = 0 then iterate j

		totfound = totfound + 1

		if ~fromthor & ~args.QUIET then do
			say '1B'x'[1A' || '1B'x'[K' || 'Message 'msgs.i' ('i' of 'msgs.count')' || '1B'x'[0m'
			say '1B'x'[1A' || '1B'x'[32CType: 'trigger.j.name
			end

		trigger.j.hitcount = trigger.j.hitcount + 1

		/* Set ARexx msgno clip */

		call setclip('SM_MsgNo', msgs.i)

		/* Action loop */
		if trigger.j.action.count > 0 then do k = 1 to trigger.j.action.count while failed = 0
			/* Execute internal functions */
			returned = 0

			select
				when trigger.j.action.k.type = 'COPY' then do
					call copymsg(globalcfg.system, globalcfg.conference, msgs.i, trigger.j.action.k.destconf, trigger.j.action.k.replyaddr)
					returned = result
					trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
					end

				when trigger.j.action.k.type = 'RECENT' then do
					call parseaminet(globalcfg.system, globalcfg.conference, msgs.i, trigger.j.action.k.checkdupes)
					returned = result
					trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
					end

				when trigger.j.action.k.type = 'SAVEMESSAGE' then do
					if symbol('trigger.j.action.k.substitute') = 'VAR' then do; subst = trigger.j.action.k.substitute; with =  trigger.j.action.k.with; end
					else do; subst = ''; with = ''; end

					if symbol('trigger.j.action.k.directory') = 'VAR' then call savemessage(msgs.i, 1, trigger.j.action.k.directory, trigger.j.action.k.header, trigger.j.action.k.append, trigger.j.action.k.nobin, subst, with)
					else call savemessage(msgs.i, 0, trigger.j.action.k.filename, trigger.j.action.k.header, trigger.j.action.k.append, trigger.j.action.k.nobin, subst, with)
					returned = result
					trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
					drop subst with
					end

				when trigger.j.action.k.type = 'SPLITDIGEST' then do
					call splitdigest(msgs.i, trigger.j.action.k.destconf, trigger.j.action.k.replyaddr)
					returned = result
					trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
					end

				otherwise if trigger.j.action.k.type ~= 'EXTERNAL' then do
					returned = 5
					if symbol('trigger.j.action.type') = 'VAR' then call displayerror(returned, 'SortMail', 'Unsupported ACTION type: 'trigger.j.action.type, msgs.i)
					else call displayerror(returned, 'SortMail', 'Trigger contains invalid action entry', msgs.i)
					end
				end

			if returned ~= 0 then do
				trigger.j.failcount = trigger.j.failcount + 1; failed = 1; totfail = totfail + 1
				end
			else do
				if trigger.j.delmsg = 1 then dodelmsg = 1
				if trigger.j.deluser = 1 then dodeluser = 1
				end
			end

		if trigger.j.action.count > 0 then do k = 1 to trigger.j.action.count while failed = 0
			/* Execute external scripts */
			returned = 0
			if trigger.j.action.k.type = 'EXTERNAL' then do
				call runexternal(trigger.j.action.k.scriptname, trigger.j.action.k.scriptopts, msgs.i)
				returned = result
				trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1

				if returned ~= 0 then do
					trigger.j.failcount = trigger.j.failcount + 1; failed = 1; totfail = totfail + 1
					end
				else do
					if trigger.j.delmsg = 1 then dodelmsg = 1
					if trigger.j.deluser = 1 then dodeluser = 1
					end
				end
			end

		leave
		end

	/* Remove ARexx msgno clip */

	call setclip('SM_MsgNo')

	if failed ~= 0 then iterate i

	address(bbsread)

	/* Delete user? */
	if dodeluser = 1 then do
		drop suser.
		SEARCHBRUSER BBSNAME '"'globalcfg.system'"' STEM suser SEARCH '"'head.FROMADDR'"' ADDRESS
		if rc ~= 0 then call displayerror(10, 'SortMail', 'SEARCHBRUSER: 'BBSREAD.LASTERROR, msgs.i)
		if result > 0 then do n = 1 to suser.COUNT
			if suser.n.FOUNDINTAG = 1 then do
				drop duser. tuser.
				READBRUSER BBSNAME '"'globalcfg.system'"' USERNR suser.n.USERNR DATASTEM duser TAGSSTEM tuser
				if rc ~= 0 then call displayerror(10, 'SortMail', 'READBRUSER: 'BBSREAD.LASTERROR, msgs.i)
				if ~bittst(duser.FLAGS, UDB_DELETED) & (data.MSGDATE < duser.USERDATE + 2) & (data.MSGDATE > duser.USERDATE - 2) & (head.FROMNAME = tuser.NAME) then do
					WRITEBRUSER BBSNAME '"'globalcfg.system'"' UPDATEUSERNR suser.n.USERNR DELETEUSER
					if rc ~= 0 then call displayerror(30, 'SortMail', 'WRITEBRUSER: 'BBSREAD.LASTERROR, msgs.i)
					end
				end
			end
		end

	/* Delete original message? */
	if dodelmsg = 1 then do
		UPDATEBRMESSAGE '"'globalcfg.system'"' '"'globalcfg.conference'"' msgs.i SETDELETED
		if rc ~= 0 then displayerror(30, 'SortMail', 'UPDATEBRMESSAGE: 'BBSREAD.LASTERROR, msgs.i)
		end
	end

signal writelog

/*
** Some error detection stuff
*/

error:
syntax:

select
	when symbol('BBSREAD.LASTERROR') = 'VAR' then displayerror(rc, 'SortMail', 'Line 'sigl' in SortMail.br: 'BBSREAD.LASTERROR)
	when symbol('THOR.LASTERROR') = 'VAR' then displayerror(rc, 'SortMail', 'Line 'sigl' in SortMail.br: 'THOR.LASTERROR)
	otherwise displayerror(rc, 'SortMail', 'Error 'rc' in line 'sigl': 'errortext(rc))
	end

/*
** Write log message
*/

writelog:

if fromthor then do
	address(thorport)
	UPDATEPROGRESS REQ progwin TOTAL 2 CURRENT 2 PT '"Writing log message..."'
	if rc = 5 then signal cleanup
	if rc > 0 then call displayerror(rc, 'SortMail', 'UPDATEPROGRESS: 'THOR.LASTERROR)
	end
else say '1B'x'[1A' || '1B'x'[K' || 'Writing log...' || '1B'x'[0m'

if globalcfg.STATISTICS & totfound > 0 then do
	logcount = logcount + 1; log.TEXT.logcount = 'SortMail processed 'msgs.count' messages and was triggered 'totfound' times, giving 'totfail' warnings/errors.'
	logcount = logcount + 1; log.TEXT.logcount = ''
	logcount = logcount + 1; log.TEXT.logcount = '*Trigger* *name*                          *Hits*      *Fails*'
	do i = 1 to trigger.count
		if trigger.i.hitcount > 0 then do
			logcount = logcount + 1; log.TEXT.logcount = left(trigger.i.name, 39)' 'left(trigger.i.hitcount, 9)' 'trigger.i.failcount
			end
		end
	logcount = logcount + 1; log.TEXT.logcount = ''

	do i = 1 to trigger.count
		if symbol('trigger.i.log.count') = 'VAR' & trigger.i.log.count > 0 then do
			do j = 1 to trigger.i.log.count
				logcount = logcount + 1; log.TEXT.logcount = trigger.i.log.j
				end
			logcount = logcount + 1; log.TEXT.logcount = ''
			end
		end
	end

if aminetlogcount > 0 then do
	do i = 1 to aminetlogcount
		logcount = logcount + 1;  log.TEXT.logcount = aminetlog.TEXT.i
		end
	logcount = logcount + 1;  log.TEXT.logcount = ''
	end

if errlogcount > 0 then do
	logcount = logcount + 1; log.TEXT.logcount = '*Warnings* *and* *errors*'
	logcount = logcount + 1; log.TEXT.logcount = ''
	do i = 1 to errlogcount
		logcount = logcount + 1; log.TEXT.logcount = errlog.TEXT.i
		end
	end

if logcount ~= 0 then do
	log.fromname   = 'SortMail'
	log.toname     = bbsdata.USERNAME
	log.toaddr     = bbsdata.EMAILADDR
	log.subject    = 'SortMail results'
	log.text.count = logcount

	call writemessage('"'globalcfg.SYSTEM'"' '"'globalcfg.CONFERENCE'"' log)
	if result ~= 0 then do
		if bbsdata.DNLOADPATH = '' then do
			address(bbsread)
			GETGLOBALDATA globaldata
			if rc = 0 then logpath = globaldata.DNLOADPATH
			end
		else logpath = bbsdata.DNLOADPATH

		if symbol('logpath') = 'VAR' then do
			if right(logpath, 1) ~= '/' & right(logpath, 1) ~= ':' then logpath = logpath'/'
			call notify('SortMail couldn''t write the log as a message.\nDo you want to save it to 'logpath'SortMail.log?', 'Yes|No')
			if result = 1 then do
				lfopen = open(lf, logpath'SortMail.log', 'W')
				if lfopen then do
					dtg = date('E')' at 'time('N'); call writeln(lf, 'SortMail results on 'dtg'.'); call writeln(lf, '')
					do i = 1 to log.text.count; call writeln(lf, log.text.i); end
					call close(lf)
					end
				else displayerror(30, 'SortMail', 'Couldn''t open 'logpath'SortMail.log for writing.')
				end
			end
		else displayerror(30, 'SortMail',' Couldn''t write log to file.')
		end
	drop log.
	end

break_c:
halt:
cleanup:

if exists('T:SortMail.result') then 'Delete T:SortMail.result QUIET'

/*
** Turn off copyback buffer
*/

address(bbsread)
BUFMODE ENDCOPYBACK

/*
** Update message counter
*/

if symbol('counter') = 'VAR' & symbol('args.MSGNO.COUNT') ~= 'VAR' & ~args.SHANGHAI then do
	cnopen = open(cn, 'ENV:Thor/SortMail.count', 'W')
	if cnopen then do
		call writeln(cn, counter)
		call close(cn)
		end
	address command 'Copy ENV:Thor/SortMail.count ENVARC:Thor/SortMail.count QUIET'
	end

/*
** Close progressbar if open
*/

if (progwin ~= 0) & symbol('progwin') = 'VAR' then do
	address(thorport)
	CLOSEPROGRESS REQ progwin
	progwin = 0

	CURRENTSYSTEM STEM curbbs
	if rc > 1 then call displayerror(30, 'SortMail', 'CURRENTSYSTEM: 'THOR.LASTERROR)
	if (upper(curbbs.CONFNAME) = upper(globalcfg.CONFERENCE)) & (totfound ~= 0) then SHOWCONFERENCE '"'globalcfg.CONFERENCE'"'
	UPDATECONFWINDOW
	end

/*
** Remove ARexx clips
*/

call setclip('SM_System')
call setclip('SM_Conference')
call setclip('SM_MsgNo')
call setclip('SM_Active')

/*
** Have a nice day
*/

exit(0)


 /****************************************************************************
**************************** Run an external script ***************************
 ****************************************************************************/

runexternal: interpret 'procedure expose 'globals
             parse arg scriptname, scriptopts, msgno

scriptopts = substitute(scriptopts, "%s", '"'globalcfg.system'"')
scriptopts = substitute(scriptopts, "%c", '"'globalcfg.conference'"')
scriptopts = substitute(scriptopts, "%n", msgno)
if fromthor then scriptopts = substitute(scriptopts, "%p", '"'thorport'"')
else scriptopts = substitute(scriptopts, "%p", '"NONE"')

if index(scriptname, ':') > 0 then scriptpath = scriptname
else scriptpath = thorpath || scriptname

address(command)
'rx >T:SortMail.result 'scriptpath' 'scriptopts
returned = rc

if returned > 0 then do
	resopen = open(rf, 'T:SortMail.result', 'R')
	if resopen then do
		res = readln(rf)
		if left(res, 20) = 'rx failed returncode' then do
			res2 = readln(rf)
			if res2 ~= '' then res = res2
			end
		call close(rf)
		end
	else res = 'Unknown error'

	call displayerror(returned, 'External script 'scriptpath, res, msgno)
	end

if exists('T:SortMail.result') then 'Delete T:SortMail.result QUIET'

return(returned)


 /****************************************************************************
************************* Parse AmiNet RECENT updates *************************
 ****************************************************************************/

parseaminet: interpret 'procedure expose 'globals
             parse arg system, conference, number, checkdupes

curline = 1; res = 0

/*
** Compensate for a bug in bbsread on OS2.x systems
*/

if right(bbsdata.BBSPATH, 1) ~= ':' & right(bbsdata.BBSPATH, 1) ~= '/' then bbsdata.BBSPATH = bbsdata.BBSPATH'/'

/*
** Read message text if it isn't already read
*/

address(bbsread)
if textread = 0 then do
	READBRMESSAGE '"'system'"' '"'conference'"' number TEXTSTEM text
	if rc ~= 0 then do
		call displayerror(10, 'AmiNet RECENT parser', 'READBRMESSAGE, text stem: 'BBSREAD.LASTERROR, number)
		return(10)
		end
	textread = 1
	end

/*
** Exit if it doesn't start with "|" (then it's probably not a RECENT msg)
*/

if left(text.TEXT.curline, 1) ~= '|' then do
	call displayerror(5, 'AmiNet RECENT parser', 'Not a AmiNet RECENT message.', number)
	return(5)
	end

/*
** Read exclude file
*/

openexcl = open(ef, cfgpath || 'SortMail.excl', 'R')
if openexcl then do
	cnt = 0
	do until eof(ef)
		cnt = cnt + 1
		excldir.cnt = readln(ef)
		end
	excldir.count = cnt
	call close(ef)
	end

/*
** Skip all lines beginning with an "|"
*/

do while(left(text.TEXT.curline, 1) = '|'); curline = curline + 1; end

if curline = text.TEXT.COUNT then do
	call displayerror(5, 'AmiNet RECENT parser', 'No new files in message.', number)
	return(5)
	end

/*
** Update NewFiles.txt, delete it first if there's a old one there already
*/

if (delnewfiles = 0) & (exists(bbsdata.BBSPATH'Newfiles.txt')) then do
	address(command)
	'Delete "'bbsdata.BBSPATH'Newfiles.txt" QUIET'
	delnewfiles = 1
	end

if exists(bbsdata.BBSPATH'Newfiles.txt') then call open(ar, bbsdata.BBSPATH'Newfiles.txt', 'A')
else call open(ar, bbsdata.BBSPATH'Newfiles.txt', 'W')

/*
** Process the RECENT message
*/

address(bbsread)

do until curline = text.TEXT.COUNT
	aline = text.TEXT.curline
	if left(aline, 1) = '|' then signal writestats
	if aline ~= "" then do
		addfile = 1; delfile = 0
		drop found. filetags.

		if aline = 'Message of the day:' then signal writemotd

		farea = word(aline, 2)

		if openexcl then do i = 1 to excldir.count
			if farea = excldir.i then addfile = 0
			end

		if addfile then do
			fname = word(aline, 1)
			fdesc = right(aline, length(aline) - 35)

			fsize = right(left(aline, 34), 5)
			if right(fsize, 1) = 'M' then mega = 1
			else mega = 0
			fsize = compress(fsize, 'KM .')

			if ~datatype(fsize, 'W') then fsize = 0
			fsize = fsize * 1024
			if mega = 1 then fsize = trunc((fsize * 1024) / 10)

			if checkdupes then do
				SEARCHBRFILE BBSNAME '"'system'"' FAREANAME '"'farea'"' SEARCH '"'fname'"' NAME STEM found
				if rc = 6 then drop BBSREAD.LASTERROR
				else if rc ~= 0 then do
					res = rc
					call displayerror(res, 'AmiNet RECENT parser', 'SEARCHBRFILE: 'BBSREAD.LASTERROR, number)
					end
				else if result > 0 then do i = 1 to found.FILE.1.COUNT
					READBRFILE BBSNAME '"'system'"' FAREANAME '"'farea'"' FILENR found.FILE.1.i TAGSSTEM filetags
					if rc ~= 0 then  do
						res = rc
						call displayerror(res, 'AmiNet RECENT parser', 'READBRFILE: 'BBSREAD.LASTERROR, number)
						end
					else if filetags.DESCRIPTION.1 ~= fdesc & (fsize > filetags.SIZE + 1023 | fsize < filetags.SIZE - 1024) then do
						WRITEBRFILE BBSNAME '"'system'"' FAREANAME '"'farea'"' UPDATEFILENR found.FILE.1.1 DELETEFILE
						if rc ~= 0 then do
							res = rc
							call displayerror(res, 'AmiNet RECENT parser', 'WRITEBRFILE: 'BBSREAD.LASTERROR, number)
							end
						delfile = 1
						end
					if delfile = 0 then addfile = 0
					end
				end
			end

		if addfile & fdesc ~= '' then do
			CONFIGFAREA '"'system'"' '"'farea'"'
			if rc ~= 0 then call displayerror(rc, 'AmiNet RECENT parser', 'CONFIGFAREA: 'BBSREAD.LASTERROR, number)

			drop brfile.
			brfile.NAME = fname
			brfile.SIZE = fsize
			brfile.DATE = head.CREATIONDATE
			brfile.DESCRIPTION.COUNT = 1
			brfile.DESCRIPTION.1 = strip(fdesc)

			WRITEBRFILE '"'system'"' '"'farea'"' STEM brfile
			if rc ~= 0 then do
				call displayerror(rc, 'AmiNet RECENT parser', 'WRITEBRFILE: 'BBSREAD.LASTERROR, number)
				res = rc
				end
			end

		call writeln(ar, aline)
		end
	curline = curline + 1
	end

signal amifini

/*
** Write statistics from AmiNet
*/

writestats:

aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = '*AmiNet* *Statistics*'
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

do i = curline to text.TEXT.COUNT
	aline = text.TEXT.i
	if aline = 'Message of the day:' then do
		curline = i
		signal writemotd
		end
	aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = aline
	end
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

curline = i

signal amifini

/*
** Write AmiNet Message of the Day
*/

writemotd:

address(bbsread)
AMIGA2DATE SECONDS head.CREATIONDATE STEM time
if rc ~= 0 then displayerror(5, 'AmiNet Message of the Day', BBSREAD.LASTERROR, number)

aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = '*AmiNet* *Message* *of* *the* *Day*: 'time.MDAY'.'time.MONTH'.'time.YEAR
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

do i = curline to text.TEXT.COUNT
	aline = text.TEXT.i
	if left(aline, 1) = '|' then do
		curline = i
		signal writestats
		end
	aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = aline
	end
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

/*
** Clean up and return
*/

amifini:
call close(ar)

return(res)


 /****************************************************************************
******************************** Copy messages ********************************
 *****************************************************************************/

copymsg: interpret 'procedure expose 'globals
         parse arg system, mailconf, number, toconf, repaddr

/*
** Read text stem if it's not already read
*/

address(bbsread)
if textread = 0 then do
	READBRMESSAGE '"'system'"' '"'mailconf'"' number TEXTSTEM text
	if rc ~= 0 then do
		call displayerror(10, 'Message copy', BBSREAD.LASTERROR, number)
		return(10)
		end
	textread = 1
	end

if text.TEXT.COUNT = 0 & (text.PART.COUNT = 0 | symbol('text.PART.COUNT') ~= 'VAR') then do
	text.TEXT.1 = ' '; text.TEXT.COUNT = 1
	end

if head.fromname        ~= "HEAD.FROMNAME"        then text.fromname        = head.fromname
if head.fromaddr        ~= "HEAD.FROMADDR"        then text.fromaddr        = head.fromaddr
if head.toname          ~= "HEAD.TONAME"          then text.toname          = head.toname
if head.toaddr          ~= "HEAD.TOADDR"          then text.toaddr          = head.toaddr
if head.msgid           ~= "HEAD.MSGID"           then text.msgid           = head.msgid
if head.refid           ~= "HEAD.REFID"           then text.refid           = head.refid
if head.creationdate    ~= "HEAD.CREATIONDATE"    then text.creationdate    = head.creationdate
if head.creationdatetxt ~= "HEAD.CREATIONDATETXT" then text.creationdatetxt = head.creationdatetxt
if head.subject         ~= "HEAD.SUBJECT"         then text.subject         = head.subject

text.replyconf = mailconf

drop text.replyname
if (repaddr = '') | (right(repaddr, 9) = 'REPLYADDR') then do
	if symbol('text.replyaddr') ~= 'VAR' then do
		text.replyaddr = head.fromaddr
		if symbol('head.fromname') = 'VAR' then text.replyname = head.fromname
		end
	end
else text.replyaddr = repaddr

repl = ""; priv = ""; kep = ""; urg = ""; imp = ""; conf = ""
if bittst(data.flags,  1) then repl = "REPLIED"
if bittst(data.flags,  2) then priv = "PRIVATE"
if bittst(data.flags,  7) then kep  = "KEEP"
if bittst(data.flags, 11) then urg  = "URGENT"
if bittst(data.flags, 12) then imp  = "IMPORTANT"
if bittst(data.flags, 17) then conf = "CONFIDENTIAL"

call writemessage('"'system'"' '"'toconf'"' text repl priv kep urg imp conf HAZELEVEL data.HAZELEVEL)

return(result)


 /****************************************************************************
***************************** Save message to disk ****************************
 ****************************************************************************/

savemessage: interpret 'procedure expose 'globals
             parse arg msgno, desttype, destname, header, append, nobin, subst, with

/*
** Find download path
*/

address(bbsread)
if symbol('bbsdata.DNLOADPATH') ~= 'VAR' | bbsdata.DNLOADPATH = '' then do
	GETGLOBALDATA globaldata
	if rc ~= 0 then signal error
	downloadpath = globaldata.DNLOADPATH
	end
else downloadpath = bbsdata.DNLOADPATH

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

/*
** Find path, filename and mode of output file
*/

select
	when desttype = 0 then do
		destfile = destname
		if (append) & (exists(fileame)) then filemode = 'A'
		else filemode = 'W'
		end

	when desttype = 1 then do
		destfile = head.SUBJECT

		if subst ~= '' then do
			if with ~= '' then destfile = substitute(destfile, subst, with)
			else do
				call displayerror(20, 'Save message', 'SUBSTITUTE/K needs WITH/K.', msgno)
				return(20)
				end
			end

		/* Strip unwanted characters and "Re: " from subject */
		destfile = compress(destfile, '*')
		destfile = compress(destfile, '#')
		destfile = compress(destfile, '?')
		destfile = compress(destfile, '`')
		destfile = compress(destfile, '/')
		destfile = compress(destfile, ':')
		do while upper(left(destfile, 3)) = 'RE '
			if upper(left(destfile, 3)) = 'RE ' then destfile = substr(destfile, 4)
			end

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

		destfile = destname || destfile

		if (append) & (exists(destfile)) then filemode = 'A'
		else filemode = 'W'
		end

	otherwise do
		call displayerror(20, 'Save Message', 'Neither DIRECTORY/K nor FILENAME/K were specified.', msgno)
		return(20)
		end
	end

fileopen = 0

if symbol('thorport') = 'VAR' & thorport ~= 'NONE' then do
	if ~nobin then do
		address(bbsread)
		if ~textread then do
			READBRMESSAGE '"'globalcfg.SYSTEM'"' '"'globalcfg.CONFERENCE'"' msgno TEXTSTEM text
			returned = rc
			if rc > 0 then do
				call displayerror(returned, 'Save message', 'READBRMESSAGE: 'BBSREAD.LASTERROR, msgno)
				return(returned)
				end
			textread = 1
			end
		call checkbin('text', msgno, downloadpath)
		returned = result
		end

	saveargs = ''
	if ~header then saveargs = saveargs' NOHEADER'
	if ~append then saveargs = saveargs' OVERWRITE'

	address(thorport)
	SAVEMESSAGE '"'globalcfg.SYSTEM'"' '"'globalcfg.CONFERENCE'"' MSGNR msgno FILE '"'destfile'"' saveargs
	smreturned = rc
	if rc ~= 0 then do
		call displayerror(smreturned, 'Save Message', 'SAVEMESSAGE: 'THOR.LASTERROR, msgno)
		end
	if symbol('returned') ~= 'VAR' then returned = 0
	if smreturned > returned then returned = smreturned; drop smreturned
	end
else do
	if textread = 0 then do
		address(bbsread)
		READBRMESSAGE '"'globalcfg.SYSTEM'"' '"'globalcfg.CONFERENCE'"' msgno TEXTSTEM text
		returned = rc
		if rc > 0 then do
			call displayerror(returned, 'Save message', 'READBRMESSAGE: 'BBSREAD.LASTERROR, msgno)
			return(returned)
			end
		textread = 1
		end

	call savemsg('head', 'text', destfile, filemode, header, nobin, msgno, downloadpath)
	if result ~= 0 then returned = rc
	end

if fileopen then do
	call close(of)
	fileopen = 0
	end

return(returned)


 /****************************************************************************
******************* Check if a message contains binary parts ******************
 ****************************************************************************/

checkbin: interpret 'procedure expose 'globals
          parse arg tstem, msgno, downloadpath

/*
** Check for message parts
*/

if symbol(tstem'.PART.COUNT') = 'VAR' then do
	parts = value(tstem'.PART.COUNT')
	if parts > 0 then do i = 1 to parts
		select
		 when symbol(tstem'.PART.'i'.BINARY') = 'VAR' then do
				if exists(value(tstem'.PART.'i'.BINARY')) then do
					address(command)
					'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
					if rc ~= 0 then do
						call displayerror(20, 'Save message', 'Failed to copy binary part to download directory.', msgno)
						return(20)
						end
					address(bbsread)
					end
				end

			otherwise do
				usestem = tstem'.PART.'i'.MSG'
				call checkbin(usestem, msgno, downloadpath)
				end
			end
		end
	end

return(0)


 /****************************************************************************
*************** Recursive procedure for writing message to file ***************
 ****************************************************************************/

savemsg: interpret 'procedure expose 'globals
         parse arg hstem, tstem, filename, filemode, header, nobin, msgno, downloadpath

/*
** Open file for writing/appending
*/

if ~fileopen then do
	fileopen = open(of, filename, filemode)
	if fileopen & filemode = 'A' then call writeln(of, copies('=', 79))
	end

if ~fileopen then do
	call displayerror(20, 'Save Message', 'Couldn''t open "'filename'" for writing.', msgno)
	return(20)
	end

/*
** Write to/from names/addresses, subject and header
*/

if header then do
	if symbol(hstem.'FROMNAME') = 'VAR' then do
		from = value(hstem'.FROMNAME')
		if symbol(hstem'.FROMADDR') = "VAR" then from = from || ' <' || value(hstem'.FROMADDR') || '>'
		end
	else do
		from = head.FROMNAME
		if symbol('head.FROMADDR') = "VAR" then from = from || ' <' || head.FROMADDR || '>'
		end
	call writeln(of, 'From: 'from)

	if symbol(hstem'.TONAME') = "VAR" then do
		to = value(hstem'.TONAME')
		if symbol(hstem'.TOADDR') = "VAR" then to = to || ' <' || value(hstem'.TOADDR') || '>'
		call writeln(of, 'To: 'to)
		end

	if symbol(hstem'.SUBJECT') = 'VAR' then call writeln(of, 'Subject: 'value(hstem'.SUBJECT'))
	else call writeln(of, 'Subject: 'head.SUBJECT)

	if symbol(tstem'.COMMENT.COUNT') = "VAR" then do
		cnt = value(tstem'.COMMENT.COUNT')
		if cnt > 0 then do
			do i = 1 to cnt; call writeln(of, value(tstem'.COMMENT.'i)); end
			end
		end
	end

/*
** Write body text
*/

if symbol(tstem'.TEXT.COUNT') = "VAR" then do
	cnt = value(tstem'.TEXT.COUNT')
	if cnt > 0 then do
		call writeln(of, '')
		do i = 1 to cnt; call writeln(of, value(tstem'.TEXT.'i)); end
		end
	end

/*
** Check for message parts
*/

if symbol(tstem'.PART.COUNT') = "VAR" then do

	parts = value(tstem'.PART.COUNT')
	if parts > 0 then do i = 1 to parts
		select
			when symbol(tstem'.PART.'i'.BINARY') = "VAR" then do
				call writeln(of, '')

				cnt = 0
				if symbol(tstem'.PART.'i'.BINARY.COMMENT.COUNT') = VAR & header then cnt = value(tstem'.PART.'i'.BINARY.COMMENT.COUNT')
				if cnt > 0 then do
					call writeln(of, '')
					do j = 1 to cnt
						call writeln(of, value(tstem'.PART.'i'.BINARY.COMMENT.'j))
						end
					end

				call writeln(of, '[Binary part: 'value(tstem'.PART.'i'.BINARY')']')

				if ~nobin then do
					if exists(value(tstem'.PART.'i'.BINARY')) then do
						address(command)
						'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
						if rc ~= 0 then do
							call displayerror(20, 'Save message', 'Failed to copy binary part to download directory.', msgno)
							return(20)
							end
						address(bbsread)
						call writeln(of, '[Binary part copied to: 'downloadpath']')
						end
					else call writeln(of, '[Binary part "'value(tstem'.PART.'i'.BINARY')'" was already deleted]')
					end
				end

			when symbol(tstem'.PART.'i'.COMMENT.COUNT') = "VAR" & header then do
				cnt = value(tstem'.PART.'i'.COMMENT.COUNT')
				if cnt > 0 then do
					do j = 1 to cnt
						call writeln(of, value(tstem'.PART.'i'.COMMENT.'j))
						end
					end
				end

			when symbol(tstem'.PART.'i'.TEXT.COUNT') = "VAR" then do
				cnt = value(tstem'.PART.'i'.TEXT.COUNT')
				if cnt > 0 then do
					call writeln(of, '')
					do j = 1 to cnt
						call writeln(of, value(tstem'.PART.'i'.TEXT.'j))
						end
					end
				end

			otherwise do
				call writeln(of, copies('=', 79))
				usestem = tstem'.PART.'i'.MSG'
				call savemsg(usestem, usestem, filename, filemode, header, nobin, msgno, downloadpath)
				end
			end
		end
	end

return(0)


 /****************************************************************************
************************** Write message to database **************************
 ****************************************************************************/

writemessage: interpret 'procedure expose 'globals
              parse arg wmarguments

/*
** Initialize arguments and parse them
*/

wmtemplate = 'SYSTEM/A,CONFERENCE/A,MSGSTEM/A,DONTMARKMESSAGE/S,REPLIED/S,PRIVATE/S,KEEP/S,READ/S,URGENT/S,IMPORTANT/S,CONFIDENTIAL/S,HAZELEVEL/K/N'

CDB_MARK_OWN_MSGS      = 22  /* Also mark messages from user when adding messages. */
CDF_NOT_ON_BBS         = '00008000'x  /* This conference is not on the bbs. */

wmargs.DONTMARKMESSAGE = 0; wmargs.PRIVATE      = 0; wmargs.READ = 0;    wmargs.URGENT  = 0
wmargs.IMPORTANT       = 0; wmargs.CONFIDENTIAL = 0; wmargs.KEEP = 0;    wmargs.REPLIED = 0
wmargs.HAZELEVEL       = 0

address(bbsread)
READARGS wmtemplate wmargs CMDLINE wmarguments
if rc ~= 0 then do
	call displayerror(10, 'Write message', 'READARGS: 'BBSREAD.LASTERROR)
	return(10)
	end

/*
** See if the conference the msg will be written to exists
*/

do n = 1 to conflist.COUNT + 1 while upper(wmargs.CONFERENCE) ~= upper(conflist.n)
	if n = conflist.COUNT + 1 then do
		/* Create the new conference */
		address(bbsread)
		CONFIGCONF '"'wmargs.SYSTEM'"' '"'wmargs.CONFERENCE'"' SET c2x(CDF_NOT_ON_BBS)
		if rc ~= 0 then do
			call displayerror(30, 'Write message', 'CONFIGCONF: 'BBSREAD.LASTERROR)
			return(30)
			end
		conflist.n = toconf
		conflist.COUNT = conflist.COUNT + 1
		end
	end

/*
** If Show own messages isn't activated in conference mark then don't
** mark message as unread.
*/

GETCONFDATA '"'wmargs.SYSTEM'"' '"'wmargs.CONFERENCE'"' STEM confdata
if rc ~= 0 then do
	returned = rc
	call displayerror(returned, 'Write message', 'GETCONFDATA: 'BBSREAD.LASTERROR)
	return(returned)
	end

if ~bittst(confdata.FLAGS, CDB_MARK_OWN_MSGS) & (value(wmargs.msgstem'.fromaddr') = bbsdata.EMAILADDR) then wmargs.DONTMARKMESSAGE = 1

/*
** Set the selected message flags
*/

writeflags = ''
if wmargs.DONTMARKMESSAGE then writeflags = writeflags'DONTMARKMESSAGE '
if wmargs.PRIVATE         then writeflags = writeflags'PRIVATE '
if wmargs.READ            then writeflags = writeflags'READ '
if wmargs.URGENT          then writeflags = writeflags'URGENT '
if wmargs.IMPORTANT       then writeflags = writeflags'IMPORTANT '
if wmargs.CONFIDENTIAL    then writeflags = writeflags'CONFIDENTIAL '

updateflags = ''
if wmargs.KEEP            then updateflags = updateflags'SETKEEP '
if wmargs.REPLIED         then updateflags = updateflags'SETREPLIED '
if wmargs.HAZELEVEL > 0   then updateflags = updateflags'HAZELEVEL 'wmargs.HAZELEVEL' '

/*
** Write the message
*/

address(bbsread)
WRITEBRMESSAGE '"'wmargs.SYSTEM'"' '"'wmargs.CONFERENCE'"' STEM wmargs.MSGSTEM
msgnr = result

if rc ~= 0 then do
	returned = rc
	call displayerror(returned, 'Write message', 'WRITEBRMESSAGE: 'BBSREAD.LASTERROR)
	return(returned)
	end

/*
** Give the new message it's flags
*/

if updateflags ~= '' then do
	UPDATEBRMESSAGE '"'wmargs.SYSTEM'"' '"'wmargs.CONFERENCE'"' msgnr updateflags
	if rc ~= 0 then do
		returned = rc
		call displayerror(returned, 'Write message', 'UPDATEBRMESSAGE: 'BBSREAD.LASTERROR, msgnr)
		return(returned)
		end
	end

return(0)


 /****************************************************************************
*********************** Open and read configuration file **********************
 ****************************************************************************/

readcfg: interpret 'procedure expose 'globals

triggers = 0

address(bbsread)

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

if cfgopen then do
	cfglength = seek(cf, 0, 'E'); call seek(cf, 0, 'B')

	cfgline = 0

	do until seek(cf, 0) = cfglength
		entry = readln(cf); cfgline = cfgline + 1

		if symbol('progwin') = 'VAR' then do
			address(thorport)
			UPDATEPROGRESS progwin CURRENT seek(cf, 0) TOTAL cfglength
			if rc = 5 then signal cleanup
			if rc ~= 0 then displayerror(rc, 'Read config', 'UPDATEPROGRESS: 'THOR.LASTERROR)
			address(bbsread)
			end

		select
			when upper(subword(entry, 1, 1)) = "SYSTEM" then displayerror(30, 'Read config', 'Found old 2.x configuration file.  SortMail has\nchanged the configuration file format in version\n3.0.  Please create a new one with CfgSortMail.thor.')

			when upper(subword(entry, 1, 1)) = "GLOBAL" then do
				globalcfg.STATISTICS = 0; globalcfg.NOWARN = 0; globalcfg.LOGINSTATE = 0
				READARGS TEMPLATE '"SYSTEM/A,CONFERENCE/A,STATISTICS/S,NOWARN/S,LOGINSTATE/S"' STEM globalcfg CMDLINE subword(entry, 2)
				if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)

				/*
				** Exit of user's in the wrong system or there's no marked msgs
				*/

				if fromthor then do
					if globalcfg.SYSTEM ~= curbbs.BBSNAME then call displayerror(30, 'SortMail', 'Enter your configured system\nbefore running this script.')
					GETCONFDATA '"'globalcfg.system'"' '"'globalcfg.conference'"' STEM confdata
					if rc ~= 0 then call displayerror(30, 'SortMail', 'GETCONFDATA: 'BBSREAD.LASTERROR)
					if confdata.MSGMARKED = 0 then signal cleanup
					end
				end

			when upper(subword(entry, 1, 1)) = "TRIGGER" then do
				triggers = triggers + 1
				trigger.triggers.cmdline = subword(entry, 2)
				trigger.triggers.DELMSG = 0; trigger.triggers.DELUSER = 0; trigger.triggers.MATCHALL = 0; trigger.triggers.hitcount = 0; trigger.triggers.failcount = 0
				READARGS TEMPLATE '"NAME/A,DELMSG/S,DELUSER/S,MATCHALL/S"' STEM trigger.triggers CMDLINE trigger.triggers.cmdline
				if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)

				do
					searches = 0; actions = 0

					do until upper(subentry) = 'ENDTRIGGER'
						subentry = readln(cf); cfgline = cfgline + 1

						select
							when upper(subword(subentry, 1, 1)) = 'ACTION' then do
								actions = actions + 1
								trigger.triggers.action.actions.checkdupes = 0; trigger.triggers.action.actions.header = 0; trigger.triggers.action.actions.append = 0; trigger.triggers.action.actions.nobin = 0; trigger.triggers.action.actions.hitcount = 0; trigger.triggers.action.actions.failcount = 0
								READARGS TEMPLATE '"TYPE/A,DESTCONF/K,REPLYADDR/K,SCRIPTNAME/K,SCRIPTOPTS/K,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S,CHECKDUPES/S"' STEM trigger.triggers.action.actions CMDLINE subword(subentry, 2)
								trigger.triggers.action.actions.type = upper(trigger.triggers.action.actions.type)
								if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)
								end

							when upper(subword(subentry, 1, 1)) = 'SEARCH' then do
								searches = searches + 1
								READARGS TEMPLATE '"TYPE/A,CRITERIA/A,KEYWORD/K"' STEM trigger.triggers.search.searches CMDLINE subword(subentry, 2)
								trigger.triggers.search.searches.type = upper(trigger.triggers.search.searches.type)
								if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)
								end

							otherwise nop
							end
						end
					end

				trigger.triggers.action.count = actions
				trigger.triggers.search.count = searches
				end

			otherwise nop
			end

		trigger.count = triggers
		end
	end
else do
	call displayerror(30, 'Read config', 'Couldn''t open ' || cfgpath || cfgfile || ' for reading.')
	end

if trigger.count = 0 then signal cleanup

call close(cf)

return(0)


 /****************************************************************************
*********************** Display requester / type message **********************
 ****************************************************************************/

notify: interpret 'procedure expose 'globals
        parse arg message, choices

seperator = index(choices, '|')
if seperator > 0 then do
	firstchoice = substr(choices, 1, seperator - 1)
	secondchoice = substr(choices, seperator + 1)
	end

address(bbsread)
BUFMODE ENDCOPYBACK

if ~fromthor then do
	message = substitute(message, '\n', ' ')

	if seperator > 0 then do
		say message
		options prompt firstchoice' or 'secondchoice': '
		parse pull choice
		options prompt

		select
			when upper(left(choice, 1)) = upper(left(firstchoice, 1)) then reqres = 1
			when upper(left(choice, 1)) = upper(left(secondchoice, 1)) then reqres = 0
			otherwise reqres = 0
			end
		say
		end
	else do
		say message
		say
		reqres = 0
		end
	end
else do
	message = substitute(message, '"', '*"')
	address(thorport)
	REQUESTNOTIFY '"'message'"' '"'choices'"'
	reqres = result
	end

address(bbsread)
BUFMODE COPYBACK

return(reqres)


 /****************************************************************************
*********************** Display error and return or quit **********************
 ****************************************************************************/

displayerror: interpret 'procedure expose 'globals
              parse arg returned, caller, errmsg, msgno

if msgno ~= '' then errhead = caller' returned 'returned' on message #'msgno':'
else errhead = caller' returned 'returned':'

select
	when returned > 0 & returned < 6 then do
		if ~globalcfg.NOWARN then do
			call notify(errhead || '\n' || errmsg, 'Continue|Abort')
			if result = 0 then signal cleanup
			end

		errlogcount = errlogcount + 1; errlog.text.errlogcount = errhead
		errlogcount = errlogcount + 1; errlog.text.errlogcount = errmsg
		errlogcount = errlogcount + 1; errlog.text.errlogcount = ''
		end

	when returned > 5 & returned < 20 then do
		call notify(errhead || '\n' || errmsg, 'Continue|Abort')
		if result = 0 then signal cleanup

		errlogcount = errlogcount + 1; errlog.text.errlogcount = errhead
		errlogcount = errlogcount + 1; errlog.text.errlogcount = errmsg
		errlogcount = errlogcount + 1; errlog.text.errlogcount = ''
		end

	when returned > 19 then do
		call notify(errhead || '\n' || errmsg, 'Abort')
		signal cleanup
		end

	otherwise nop
	end

drop THOR.LASTERROR BBSREAD.LASTERROR

return(0)


 /****************************************************************************
********************* Substitute a string within a string *********************
******** Shamelessly ripped from Troels Walsted Hansen's UUDecode.thor ********
 ****************************************************************************/

substitute: interpret 'procedure expose 'globals
            parse arg str, org, new

lastfound = 0

found = index(str, org)

do while found > lastfound
	secondpart = substr(str, found + length(org))
	firstpart = substr(str, 1, length(str) - length(substr(str, found)))
	str = firstpart || new || secondpart
	lastfound = found + length(new)
	found = index(str, org, lastfound)
	end

return(str)


 /****************************************************************************
******************************** Split digests ********************************
 ****************************************************************************/

splitdigest: interpret 'procedure expose 'globals
             parse arg msgno, destconf, repaddr

/*
** Read message's header and text stems
*/

if textread = 0 then do
	READBRMESSAGE '"'globalcfg.SYSTEM'"' '"'globalcfg.CONFERENCE'"' msgno TEXTSTEM text
	if rc ~= 0 then do
		call displayerror(10, 'Split digest', 'READBRMESSAGE, text stem: 'BBSREAD.LASTERROR, msgno)
		return(10)
		end
	end

if symbol('text.TEXT.COUNT') = 'VAR' & text.TEXT.COUNT > 0 & symbol('text.PART.COUNT') = 'VAR' & text.PART.COUNT > 0 then do
	call displayerror(5, 'Split digest', 'Message contains both a text body and message parts.', msgno)
	return(5)
	end

if symbol('text.PART.COUNT') = 'VAR' & text.PART.COUNT > 0 then do
	returned = 0
	do i = 1 to text.PART.COUNT
		if (symbol('text.PART.'i'.TEXT.COUNT') = 'VAR' | symbol('text.PART.'i'.COMMENT.COUNT') = 'VAR' | symbol('text.PART.'i'.BINARY') = 'VAR') & returned ~= 5 = 'VAR' then do
			call displayerror(5, 'Split digest', 'MIME digest contains a non-message part.', msgno)
			returned = 5
			end
		if symbol('text.PART.'i'.MSG.FROMNAME')        ~= 'VAR' then text.PART.i.MSG.fromname          = head.FROMNAME
		if symbol('text.PART.'i'.MSG.FROMADDR')        ~= 'VAR' then text.PART.i.MSG.fromaddr          = head.FROMADDR
		if symbol('text.PART.'i'.MSG.TONAME')          ~= 'VAR' then text.PART.i.MSG.toname            = head.TONAME
		if symbol('text.PART.'i'.MSG.TOADDR')          ~= 'VAR' then text.PART.i.MSG.toaddr            = head.TOADDR
/*	if symbol('text.PART.'i'.MSG.MSGID')           ~= 'VAR' then text.PART.i.MSG.msgid             = head.MSGID*/
		if symbol('text.PART.'i'.MSG.REFID')           ~= 'VAR' then text.PART.i.MSG.refid             = head.REFID
		if symbol('text.PART.'i'.MSG.CREATIONDATE')    ~= 'VAR' then text.PART.i.MSG.creationdate      = head.CREATIONDATE
		if symbol('text.PART.'i'.MSG.CREATIONDATETXT') ~= 'VAR' then text.PART.i.MSG.creationdatetxt   = head.CREATIONDATETXT
		if symbol('text.PART.'i'.MSG.SUBJECT')         ~= 'VAR' then text.PART.i.MSG.subject           = head.SUBJECT

		if (repaddr = '') | (right(repaddr, 9) = 'REPLYADDR') then do
			if symbol('text.replyaddr') = 'VAR' then do
				text.PART.i.MSG.replyaddr = text.replyaddr
				if symbol('text.replyname') = 'VAR' then text.PART.i.MSG.replyname = text.replyname
				end
			else do
				text.PART.i.MSG.replyaddr = head.fromaddr
				if symbol('head.fromname') = 'VAR' then text.PART.i.MSG.replyname = head.fromname
				end
			end
		else text.PART.i.MSG.replyaddr = repaddr

		call writemessage(SYSTEM '"'globalcfg.SYSTEM'"' CONFERENCE '"'destconf'"' MSGSTEM value(text.PART.'i'.MSG))
		if result ~= 0 then do
			if returned > 0 and returned > result then return(returned)
			else return(result)
			end
		end
	end
else do
	line = 1; parsed = 0

	do forever
		newmsg.text.count = 0

		fromline = 0; subjline = 0; dateline = 0; msgoffset = 0

		do until (text.text.line = '') & (fromline ~= 0)
			select
				when upper(subword(text.text.line, 1, 1)) = "FROM:" then fromline = line
				when upper(subword(text.text.line, 1, 1)) = "SUBJECT:" then subjline = line
				when msgoffset > 100 then do
					call displayerror(5, 'Parse digest', 'Couldn''t find sub-message, no from: line.', msgno)
					return(5)
					end
				when line > text.text.count then do
					if ~parsed then do
						call displayerror(5, 'Parse digest', 'Unexpected end of message.', msgno)
						return(5)
						end
					else return(0)
					end
				otherwise nop
				end

			line = line + 1; msgoffset = msgoffset + 1
			end

		/* Pick up date line and skip blank lines */

		do forever
			if line = text.text.count then do
				call displayerror(5, 'Parse digest', 'Failed to find start of first submessage''s text body.', msgno)
				return(5)
				end
			if upper(subword(text.text.line, 1, 1)) = "DATE:" then dateline = line
			else if text.text.line ~= '' then break
			line = line + 1
			end
 
		/* Search for 'End of message' line or the end of the digest */

		newmsg.text.count = 0; msgline = 0
		do forever
			if (symbol('endsubmsg') = 'VAR' & compare(upper(endsubmsg), upper(text.text.line)) = 0) | (line = text.text.count) then break
			if symbol('endsubmsg') ~= 'VAR' & (left(text.text.line, 1) = '-') & (length(text.text.line) > 29) & (length(text.text.line) = length(compress(text.text.line))) & (text.text.line = copies(left(text.text.line, 1), length(text.text.line))) then break
			if upper(subword(text.text.line, 1, 1)) = "FROM:" then do
					call displayerror(5, 'Parse digest', 'Couldn''t find end of sub message.', msgno)
					return(5)
					end
			msgline = msgline + 1; newmsg.text.msgline = text.text.line
			newmsg.text.count = newmsg.text.count + 1
			line = line + 1
			end

		if symbol('endsubmsg') ~= 'VAR' then endsubmsg = text.text.line

		/* Some magic to find name, address and subject */

		newmsg.subject = "<no subject>"
		newmsg.fromname = "Unknown"
		newmsg.fromaddr = "<no address>"

		from = strip(substr(text.text.fromline, 6))
		from = translate(from, '<>', '()')
		i = pos("<", from)
		if i ~= 0 then do
			checkaddr = strip(substr(from, i, pos('>', from) - i), B, ' <>"')
			if pos("@", checkaddr) = 0 then do
				newmsg.fromname = checkaddr
				newmsg.fromaddr = strip(delstr(from, i, pos('>', from) - i), B, ' >')
				end
			else do
				newmsg.fromaddr = checkaddr
				newmsg.fromname = strip(delstr(from, i, pos('>', from) - i), B, ' ">')
				end
			end
		else do
			if pos("@", from) = 0 then do
				newmsg.fromname = strip(from, B, ' "')
				end
			else do
				newmsg.fromaddr = strip(from, B, ' "')
				end
			end

		if subjline ~= 0 then newmsg.subject = strip(subword(text.text.subjline, 2))
		if dateline ~= 0 then newmsg.creationdatetxt = strip(subword(text.text.dateline, 2))

/*	if symbol('head.MSGID')           ~= 'VAR' then newmsg.msgid             = head.MSGID*/

		/* Find correct reply address */

		if (repaddr = '') | (right(repaddr, 9) = 'REPLYADDR') then do
			if symbol('text.replyaddr') = 'VAR' then do
				newmsg.replyaddr = text.replyaddr
				if symbol('text.replyname') = 'VAR' then newmsg.replyname = text.replyname
				end
			else do
				newmsg.replyaddr = head.fromaddr
				if symbol('head.fromname') = 'VAR' then newmsg.replyname = head.fromname
				end
			end
		else newmsg.replyaddr = repaddr

		call writemessage(SYSTEM '"'globalcfg.SYSTEM'"' CONFERENCE '"'destconf'"' MSGSTEM newmsg)
		if result ~= 0 then return(result)
		drop newmsg.; parsed = 1
		end
	end

return(0)