Amiga Format CD 2/amigaformatcd02.iso/comms/firstnet/part06.lha/rexx/SortMail.thor

Text File | 1996-01-01 | 23.6 KB | 764 lines

/*
** $VER: SortMail.thor 2.2b (29.11.95)
** by Eirik Nicolai Synnes
**
** Some code borrowed from  AddSOUP.thor      by Magne Østlyngen
**                     and  AddAmiNetList.br  by Petter Nilsen
**
**
** Todo:  Finish SortMail 3.0 :^)
**
*/

options results

signal on break_c
signal on halt
signal on syntax

/* Initialize some variables */

system = ""; mailconf = ""
aminet = ""; delaminet = 0; amirep = ""; amilink = ""; checkcc= 0; stats = 0; delusers = 0
mlcount = 0; dgcount = 0
mlfound = 0; dgparsed = 0 ; dgsubmsgs = 0; rparsed = 0; rfiles = 0; aruu = 0; aluu = 0;
progwin = 0; delnew = 0

MDB_DELETED             =  5  /* Message is deleted. */
MDB_SUPERMARKED         = 13  /* Message will not be unmarked as long as this flag is set. */


/* Find Thor and BBSREAD ARexx ports' */

p=address()||' '||show('P',,);if pos('THOR.',p)>0 then thorport=word(substr(p,pos('THOR.',p)),1);else do;say 'No THOR port found!';exit(0);end
if ~show('p', 'BBSREAD') then do; address command; "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"; "WaitForPort BBSREAD"; end

address(thorport)

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

if exists("T:SortMail.tmp") then do
    REQUESTNOTIFY '"Another copy of SortMail\nis probably running."' '"Continue|Abort"'
    if result = 0 then exit(0)
    end

call open(tmp, "T:SortMail.tmp", 'W'); call close(tmp)

/* Get the path of the configuration file */

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

if ~exists(thorpath'rexx') then cfgfile = 'ENV:Thor/SortMail.cfg'
else do
 if exists(thorpath'rexx/SortMail.cfg') then cfgfile = thorpath'rexx/SortMail.cfg'
 else cfgfile = 'ENV:Thor/SortMail.cfg'
 end

if ~exists(cfgfile) then do
    REQUESTNOTIFY '"Couldn''t find config file ('cfgfile').\nPlease run CfgSortMail.thor and try again."' '"Abort"'
    signal cleanup
    end

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

CURRENTSYSTEM STEM bbs
if rc = 1 then do
    REQUESTNOTIFY '"Enter your configured system\nbefore running this script."' '"Abort"'
    signal cleanup
    end
else if rc ~= 0 then do
    REQUESTNOTIFY '"CURRENTBBS:\n'THOR.LASTERROR'"' '"Abort"'
    signal cleanup
    end

/* Read configuration */

call readcfg

/* Get conference list */

address(bbsread)
GETCONFLIST BBSNAME '"'system'"' STEM conflist
if rc ~= 0 then do
    address(thorport)
    REQUESTNOTIFY '"GETCONFLIST:\n'BBSREAD.LASTERROR'"' '"Abort"'
    signal cleanup
    end

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

if msgs.count = 0 then signal cleanup

/* Open progressbar */

address(thorport)
OPENPROGRESS TITLE '"Sorting messages..."' TOTAL msgs.count AT "_Abort" PROGRESSCHARWIDTH 38
if rc = 0 then progwin = result
else do
    REQUESTNOTIFY '"OPENPROGRESS:\n'THOR.LASTERROR'"' '"Abort"'
    signal cleanup
    end

/* Turn on copyback buffer */

address(bbsread)
BUFMODE COPYBACK

/***************************** Start of main loop ****************************/

do curr = 1 to msgs.count
    msgfini = 0; textread = 0

    /* Update progressbar */
    address(thorport)
    UPDATEPROGRESS REQ progwin CURRENT curr PT '"Message 'curr' of 'msgs.count' (OrgMsg: 'msgs.curr')"'
    if rc ~= 0 then signal cleanup

    /* Read message data */
    address(bbsread)
    drop data. head.
    READBRMESSAGE '"'system'"' '"'mailconf'"' msgs.curr DATASTEM data HEADSTEM head
    if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"Couldn''t read msg #'msgs.curr':\n'BBSREAD.LASTERROR'"' '"Ok"'
        signal cleanup
        end

    /* If messsage is marked as deleted or superunread then skip it */

    if bittst(data.FLAGS, MDB_SUPERMARKED) then msgfini = 1
    if bittst(data.FLAGS, MDB_DELETED) then msgfini = 1
    if msgfini = 1 then iterate curr

    /* Check if message is part of a mailing list */

    if mlcount > 0 then do
        do m = 1 to mlcount until msgfini = 1
            searchaddr = upper(compress(head.TOADDR, ',<>()"'))
            do n = 1 to mlist.m.addrcount until msgfini = 1
                if find(searchaddr, upper(mlist.m.toaddr.n)) > 0 then do
                    call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
                    mlfound = mlfound + 1
                    mlist.m.found = mlist.m.found + 1
                    msgfini = 1
                    end
                end
            if msgfini = 0 then do n = 1 to mlist.m.namecount until msgfini = 1
                if upper(head.TONAME) = upper(mlist.m.toname.n) then do
                    call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
                    mlfound = mlfound + 1
                    mlist.m.found = mlist.m.found + 1
                    msgfini = 1
                    end
                end
            end
        end

    if msgfini = 1 then iterate curr

    /* Check if message is a digest */

    if dgcount > 0 then do
        do m = 1 to dgcount until msgfini = 1
            do n = 1 to digest.m.addrcount until msgfini = 1
                if find(upper(head.TOADDR), upper(digest.m.toaddr.n)) > 0 then do
                    call parsedigest(msgs.curr, digest.m.name, digest.m.replyaddr, digest.m.endsubmsg, digest.m.enddigest, digest.m.deldigest, m)
                    dgparsed = dgparsed + 1
                    msgfini = 1
                    end
                end
            if msgfini = 0 then do n = 1 to digest.m.namecount until msgfini = 1
                if upper(head.TONAME) = upper(digest.m.toname.n) then do
                    call parsedigest(msgs.curr, digest.m.name, digest.m.replyaddr, digest.m.endsubmsg, digest.m.enddigest, digest.m.deldigest, m)
                    dgparsed = dgparsed + 1
                    msgfini = 1
                    end
                end
            end
        end

    if msgfini = 1 then iterate curr

    select
        /* Check if message is a aminet recent message */
        when upper(head.TOADDR) = upper(aminet) then call parseaminet(msgs.curr)

        /* Check if message contains amiga report */
        when upper(head.FROMADDR) = upper(amirep) then do
            if exists(thorpath'rexx/UUDecode.thor') then do
                address(thorport)
                SAVEMESSAGE BBSNAME '"'system'"' CONFNAME '"'mailconf'"' MSGNUMBER msgs.curr NOHEADER NOANSI FILENAME '"T:AmiRep.uu"'
                address(command)
                'rx 'thorpath'rexx/UUDecode.thor T:AmiRep.uu'
                aruu = aruu + 1
                end
            else do
                address(thorport)
                REQUESTNOTIFY '"Couldn''t uudecode Amiga Report:\n'thorpath'rexx/UUDecode.thor not found."' '"I see."'
                end
            end

        /* Check if message contains amiga link */
        when upper(head.FROMADDR) = upper(amilink) then do
            if exists(thorpath'rexx/UUDecode.thor') then do
                address(thorport)
                SAVEMESSAGE BBSNAME '"'system'"' CONFNAME '"'mailconf'"' MSGNUMBER msgs.curr NOHEADER NOANSI FILENAME '"T:AmiLink.uu"'
                address(command)
                'rx 'thorpath'rexx/UUDecode.thor T:AmiLink.uu'
                aluu = aluu + 1
                end
            else do
                address(thorport)
                REQUESTNOTIFY '"Couldn''t uudecode Amiga Link:\n'thorpath'rexx/UUDecode.thor not found."' '"I see."'
                end
            end

        otherwise if msgfini = 0 then do
            if checkcc = 1 then do
                /* <sigh> Apparently we'll have to check the COMMENT. too... */

                drop text.
                address(bbsread)
                READBRMESSAGE '"'system'"' '"'mailconf'"' msgs.curr TEXTSTEM text
                textread = 1

                if text.COMMENT.COUNT ~= 'TEXT.COMMENT.COUNT' then if text.COMMENT.COUNT > 0 then do n = 1 to text.COMMENT.COUNT until msgfini = 1
                    if upper(left(text.COMMENT.n, 4)) = 'FROM' then do m = 1 to mlcount until msgfini = 1
                            if index(upper(text.COMMENT.n), upper(mlist.m.fromf)) > 0 then do
                                call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
                                mlfound = mlfound + 1
                                mlist.m.found = mlist.m.found + 1
                                msgfini = 1
                                end
                            end
                    if upper(left(text.COMMENT.n, 3)) = 'CC:' | upper(left(text.COMMENT.n, 4)) = 'BCC:' | upper(left(text.COMMENT.n, 14)) = 'APPARENTLY-TO:' | upper(left(text.COMMENT.n, 10)) = 'RESENT-TO:' then do m = 1 to mlcount until msgfini = 1
                        ccs = upper(compress(subword(text.COMMENT.n, 2), ',<>()'))
                        do o = 1 to mlist.m.addrcount until msgfini = 1
                            if index(ccs, upper(mlist.m.toaddr.o)) > 0 then do
                                call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
                                mlfound = mlfound + 1
                                mlist.m.found = mlist.m.found + 1
                                msgfini = 1
                                end
                            end
                        end
                    end
                end
            end
        end
    end

cnt = 1
if mlfound > 0 | dgparsed > 0 | rparsed > 0 then if stats = 1 then do
    msgstem.TEXT.cnt = 'Sortmail processed 'msgs.count' message(s) and found:'; cnt = cnt + 1
    msgstem.TEXT.cnt = ''; cnt = cnt + 1
    if mlfound > 0 then do
        msgstem.TEXT.cnt = mlfound' maillist message(s):'; cnt = cnt + 1
        do n = 1 to mlcount
            if mlist.n.found > 0 then do
                msgstem.TEXT.cnt = '  'mlist.n.found' message(s) from "'mlist.n.name'"'; cnt = cnt + 1
                end
            end
        end
    if dgparsed > 0 then do
        msgstem.TEXT.cnt = dgparsed' digest message(s) containing 'dgsubmsgs' sub-message(s):'; cnt = cnt + 1
        do n = 1 to dgcount
            if digest.n.found > 0 then do
                msgstem.TEXT.cnt = '  'digest.n.found' digest(s) from "'digest.n.name'"'; cnt = cnt + 1
                end
            end
        end
    if rparsed > 0 then do; msgstem.TEXT.cnt = rparsed' AmiNet RECENT message(s) reporting 'rfiles' new files'; cnt = cnt + 1; end
    end
if amirep ~= '' then if aruu > 0 then do; msgstem.TEXT.cnt = 'AmigaReport uudecoded and put in your download directory'; cnt = cnt + 1; end
if amilink ~= '' then if aluu > 0 then do; msgstem.TEXT.cnt = 'AmigaLink uudecoded and put in your download directory'; cnt = cnt + 1; end

msgstem.TEXT.COUNT = cnt - 1
if msgstem.TEXT.COUNT > 0 then call writemsg

/* Update message list in Thor if the user is in the E-Mail conference */

address(thorport)
CURRENTSYSTEM STEM bbs
if bbs.CONFNAME = mailconf then SHOWCONFERENCE '"'mailconf'"'
UPDATECONFWINDOW

signal cleanup

/* Some experimental error detection stuff */

error:
syntax:
if rc > 30 then say 'Error in line 'sigl': 'errortext(rc)
else say 'Line 'sigl' returned 'rc
say sourceline(sigl)
if THOR.LASTERROR ~= 'THOR.LASTERROR' then say THOR.LASTERROR
if BBSREAD.LASTERROR ~= 'BBSREAD.LASTERROR' then say BBSREAD.LASTERROR

/* Turn off copyback buffer */

break_c:
halt:
cleanup:
address(bbsread)
BUFMODE ENDCOPYBACK

/* Close progressbar if open */

if progwin ~= 0 then if progwin ~= 'PROGWIN' then do
    address(thorport)
    CLOSEPROGRESS REQ progwin
    progwin = 0
    end

/* Delete "Sortmail is running" file */

if exists("T:SortMail.tmp") then do
    address(command)
    "Delete T:SortMail.tmp QUIET"
    end

exit(0)

/******************************************************************************
********************************** PROCEDURES *********************************
******************************************************************************/

/************************** Experimental writemsg() **************************/

writemsg: procedure expose thorport system mailconf msgstem. progwin
address(bbsread)
GETBBSDATA '"'system'"' bbsdata
msgstem.FROMNAME = 'SortMail'
msgstem.TONAME = bbsdata.USERNAME
msgstem.SUBJECT = 'SortMail results'
WRITEBRMESSAGE '"'system'"' '"'mailconf'"' STEM msgstem
return


/*************************** Parse digest messages ***************************/

parsedigest: procedure expose thorport system mailconf conflist. data. head. dgsubmsgs delusers progwin digest.
             parse arg number, toconf, repaddr, endsubmsg, enddigest, deldigest, dgno

/* Read message text stem (head and data stem is already read) */

address(bbsread)
READBRMESSAGE '"'system'"' '"'mailconf'"' number TEXTSTEM text
if rc ~= 0 then do
    address(thorport)
    REQUESTNOTIFY '"Couldn''t read msg #'msgs.curr':\n'BBSREAD.LASTERROR'"' '"Ok"'
    return
    end

line = 1

do forever
    drop newmsg.
    newmsg.msgid = head.msgid
    newmsg.replyconf = mailconf
    newmsg.replyaddr = repaddr
    newmsg.text.count = 0
    fromline = 0; subjline = 0; dateline = 0
    counted = 0; msgoffset = 0

    do until counted = 3
        select
            when upper(left(text.text.line, 5)) = "FROM:" then do
                counted = counted + 1 ; fromline = line ; end
            when upper(left(text.text.line, 8)) = "SUBJECT:" then do
                counted = counted + 1 ; subjline = line ; end
            when upper(left(text.text.line, 5)) = "DATE:" then do
                counted = counted + 1 ; dateline = line; end
            when msgoffset > 100 then do
                address(thorport); REQUESTNOTIFY '"Failed to parse digest.\nOrgMsg: 'number'"' '"Ok"'; return; end

            when line > text.text.count then do
                drop data. head. text.
                if deldigest = 1 then do
                    address(bbsread); UPDATEBRMESSAGE '"'system'"' '"'mailconf'"' number SETDELETED
                    if rc ~= 0 then do
                        address(thorport); REQUESTNOTIFY '"Couldn''t delete message #'number':\n'BBSREAD.LASTERROR'"' '"Ok"'; end
                    end
                return
                end

            otherwise nop
            end

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

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

    /* Some magic to find most name and address formats */

    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

    newmsg.subject = strip(substr(text.text.subjline, 9))
    newmsg.creationdatetxt = strip(substr(text.text.dateline, 6))

    do until text.text.line ~= ''
        line = line + 1
        end

    firstline = line
    newmsg.text.count = 0
    msgline = 0

    /* Search for 'End of message' line or the end of the digest */

    do until compare(upper(endsubmsg), upper(text.text.line)) = 0
        if line = text.text.count then break
        msgline = msgline + 1
        newmsg.text.count = newmsg.text.count + 1
        newmsg.text.msgline = text.text.line
        line = line + 1
        end

    address(bbsread)
    WRITEBRMESSAGE '"'system'"' '"'toconf'"' STEM newmsg
    if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"WRITEBRMESSAGE:\n'BBSREAD.LASTERROR'"' '"Ok"'
        end
    else do
        dgsubmsgs = dgsubmsgs + 1
        digest.dgno.found = digest.dgno.found + 1
        end
    end


/************************* Move mailing list mssages ************************/

movemsg: procedure expose thorport system mailconf conflist. data. head. text. textread delusers progwin
         parse arg number, toconf, repaddr

CDF_NOT_ON_BBS          = '00008000'x  /* This conference is not on the bbs. */

priv = ""; urg = ""; imp = ""; kep = ""; repl = ""

/* 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 return
    end

if (text.PART.COUNT = 0 | text.PART.COUNT = 'TEXT.PART.COUNT') & text.TEXT.COUNT = 0 then return

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

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

do n = 1 to conflist.COUNT+1 while toconf ~= conflist.n
    if n = conflist.COUNT+1 then do
        /* Yikes! It doesn't exist! */
        address(thorport)
        REQUESTNOTIFY '"Non-existant conference: 'toconf'\nDo you want to create it?"' '"Yes|No"'
        if result = 1 then do
            /* Create the new conference */
            address(bbsread)
            CONFIGCONF '"'system'"' '"'toconf'"' SET c2x(CDF_NOT_ON_BBS)
            /* Add the new conference to the conference list */
            conflist.n = toconf
            conflist.COUNT = conflist.COUNT + 1
            end
        else return
        end
    end

text.replyconf = mailconf
if repaddr = '' | right(repaddr,7) = 'REPADDR' then text.replyaddr = head.replyaddr

if bittst(data.flags,2) then priv = "PRIVATE"
if bittst(data.flags,11) then urg = "URGENT"
if bittst(data.flags,12) then imp = "IMPORTANT"

/* Write the message to it's mailing list conference */

WRITEBRMESSAGE '"'system'"' '"'toconf'"' STEM text priv urg imp
if rc ~= 0 then do
    address(thorport)
    REQUESTNOTIFY '"WRITEBRMESSAGE:\n'BBSREAD.LASTERROR'"' '"Ok"'
    return
    end
mnr = result

if delusers = 1 then do
    /* Delete the new user added by ParseSOUP/UUCP */
    SEARCHBRUSER BBSNAME '"'system'"' STEM suser SEARCH '"'text.fromaddr'"' ADDRESS
    if result > 0 then do n = 1 to suser.COUNT
        if suser.n.FOUNDINTAG = 1 then do
            READBRUSER BBSNAME '"'system'"' USERNR suser.n.USERNR DATASTEM duser TAGSSTEM tuser
            if rc ~= 0 then break
            if value(data.msgdate) + 10 > duser.USERDATE then do
                if text.fromname = tuser.name then do
                    WRITEBRUSER BBSNAME '"'system'"' UPDATEUSERNR suser.n.USERNR DELETEUSER
                    end
                end
            end
        end
    end

if bittst(data.flags, 7) then kep = "SETKEEP"
if bittst(data.flags, 1) then repl = "SETREPLIED"

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

UPDATEBRMESSAGE '"'system'"' '"'toconf'"' mnr kep repl HAZELEVEL data.HAZELEVEL

/* Delete the old message */

UPDATEBRMESSAGE '"'system'"' '"'mailconf'"' number SETDELETED
if rc ~= 0 then do
    address(thorport)
    REQUESTNOTIFY '"Couldn''t delete message #'number':\n'BBSREAD.LASTERROR'"' '"Ok"'
    address(bbsread)
    end

drop data. head. text.
return


/*********************** Parse AmiNet RECENT messages ************************/

parseaminet: procedure expose thorport delnew system mailconf head. rparsed rfiles progwin delaminet bbsdata.
             parse arg number

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

motd = 0

/* Save the message to a temporary file */

address(thorport)
SAVEMESSAGE BBS '"'system'"' CONFNAME '"'mailconf'"' MSGNUMBER number FILENAME '"T:ParseAminet.tmp"' NOHEADER NOANSI
if rc ~= 0 then return

call open(rf, "T:ParseAminet.tmp")

/* Delete the file and exit if it doesn't start with '|' (it's probably not a RECENT file) */

if left(readln(rf), 1) ~= '|' then do
    address command
    call close(rf)
    'Delete T:ParseAminet.tmp QUIET'
    return
    end

rparsed = rparsed + 1

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

if delnew = 0 then if exists(bbsdata.BBSPATH'Newfiles.txt') then do
    address(command)
    'Delete "'bbsdata.BBSPATH'Newfiles.txt" QUIET'
    delnew = 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 eof(rf)
    aline = readln(rf)
    do while(left(aline, 1) = '|'); aline = readln(rf); end
    if aline ~= "" then do
        if aline = 'Message of the day:' then motd = 1
        if motd = 1 then signal amifini
        farea = word(aline, 2)
        CONFIGFAREA '"'system'"' '"'farea'"'

        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(fdesc ~= '') then do
            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
            rfiles = rfiles + 1
            call writeln(ar, aline)
            end
        end
    end

amifini:
call close(ar)
call close(rf)

address(bbsread)
GETBBSDATA '"'system'"' bbsdata

/* Delete the message and temporary file and return */

if delaminet = 1 & motd = 0 then do
    address(bbsread)
    UPDATEBRMESSAGE '"'system'"' '"'mailconf'"' number SETDELETED
    if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"Couldn''t delete message #'number':\n'BBSREAD.LASTERROR'"' '"Ok"'
        address(bbsread)
        end
    end

address(command)
'Delete T:ParseAminet.tmp QUIET'

drop head. data. text.

return


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

readcfg: procedure expose cfgfile system mailconf aminet delaminet amirep amilink checkcc mlist. digest. mlcount dgcount stats delusers progwin msgs. bbs. thorport

call open(cf, cfgfile, 'R')
do until eof(cf)
subentry = ""
    entry = readln(cf)
    select
        when upper(entry) = "SYSTEM" then do
            do until upper(subentry) = "END"
                subentry = readln(cf)
                select
                    when upper(subword(subentry, 1, 1)) = 'BBS:' then system = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'CONF:' then mailconf = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'AMINET:' then aminet = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'DELAMINET:' then if upper(subword(subentry, 2, 1)) = 'YES' then delaminet = 1
                    when upper(subword(subentry, 1, 1)) = 'AMIREP:' then amirep = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'AMILINK:' then amilink = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'CHECKCC:' then if upper(subword(subentry, 2, 1)) = 'YES' then checkcc = 1
                    when upper(subword(subentry, 1, 1)) = 'STATISTICS:' then if upper(subword(subentry, 2, 1)) = 'YES' then stats = 1
                    when upper(subword(subentry, 1, 1)) = 'DELUSERS:' then if upper(subword(subentry, 2, 1)) = 'YES' then delusers = 1
                    otherwise nop
                    end
                end

            /* Exit if we're on the wrong system */

            if system ~= bbs.BBSNAME then signal cleanup

            /* See if there's any messages to sort, exit if there isn't */

            address(thorport)
            GETMESSAGEARRAY '"'mailconf'"' msgs LS
            if rc = 5 then do
                signal cleanup
                end
            else if rc ~= 0 then do
                REQUESTNOTIFY '"GETMESSAGEARRAY:\n'THOR.LASTERROR'"' '"Abort"'
                signal cleanup
                end
            end

        when upper(entry) = "MAILLIST" then do
            /* Read mailing list configuration */
            mlcount = mlcount + 1
            addrs = 0; names = 0
            do until upper(subentry) = "END"
                subentry = readln(cf)
                select
                    when upper(subword(subentry, 1, 1)) = 'LISTNAME:' then mlist.mlcount.name = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'TOADDR:' then do
                        addrs = addrs + 1
                        mlist.mlcount.toaddr.addrs = subword(subentry, 2)
                        end
                    when upper(subword(subentry, 1, 1)) = 'TONAME:' then do
                        names = names + 1
                        mlist.mlcount.toname.names = subword(subentry, 2)
                        end
                    when upper(subword(subentry, 1, 1)) = 'FROMFIELD:' then mlist.mlcount.fromf = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'REPLYADDR:' then mlist.mlcount.replyaddr = subword(subentry, 2)
                    otherwise nop
                    end
                mlist.mlcount.addrcount = addrs
                mlist.mlcount.namecount = names
                mlist.mlcount.found = 0
                end
            end

        when upper(entry) = "DIGEST" then do
            /* Read digest configuration */
            dgcount = dgcount + 1
            addrs = 0; names = 0
            digest.dgcount.deldigest = 0
            do until upper(subentry) = "END"
                subentry = readln(cf)
                select
                    when upper(subword(subentry, 1, 1)) = 'DIGESTNAME:' then digest.dgcount.name = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'TOADDR:' then do
                        addrs = addrs + 1
                        digest.dgcount.toaddr.addrs = subword(subentry, 2)
                        end
                    when upper(subword(subentry, 1, 1)) = 'TONAME:' then do
                        names = names + 1
                        digest.dgcount.toname.names = subword(subentry, 2)
                        end
                    when upper(subword(subentry, 1, 1)) = 'REPLYADDR:' then digest.dgcount.replyaddr = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'ENDSUBMSG:' then digest.dgcount.endsubmsg = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'ENDDIGEST:' then digest.dgcount.enddigest = subword(subentry, 2)
                    when upper(subword(subentry, 1, 1)) = 'DELDIGEST:' then if upper(subword(subentry, 2, 1)) = 'YES' then digest.dgcount.deldigest = 1
                    otherwise nop
                    end
                digest.dgcount.addrcount = addrs
                digest.dgcount.namecount = names
                digest.dgcount.found = 0
                end
            end
        otherwise nop
        end
    end
call close(cf)
return