/****************************************************************/
/*                                                              */
/*             Sample code for a Weasel tool                    */
/*                                                              */
/* Works out the Weasel mail directory for a given username.    */
/* This is not intended to be a tool in its own right.  Rather, */
/* it is code that can be copied and reused in other Weasel     */
/* tools and filters.  The point of this code is that it works  */
/* equally well in single-domain or multidomain mode, so that   */
/* the caller of these procedures does not have to worry about  */
/* that distinction.                                            */
/*                                                              */
/*      Author:       Peter Moylan (peter@ee.newcastle.edu.au)  */
/*      Started:      28 October 2003                           */
/*      Last revised: 31 October 2003                           */
/*                                                              */
/*      Usage:                                                  */
/*              userdir user@domain                             */
/*                                                              */
/*         and this program must reside in the same directory   */
/*         as WEASEL.INI                                        */
/*                                                              */
/* That's for standalone use.  For real-life use, however, you  */
/* should throw away the main program and incorporate the       */
/* subroutines into your own code.                              */
/*                                                              */
/* Remark: this code does not check for aliases.  To do that,   */
/* you would have to be prepared for the possibility of         */
/* matching wildcard aliases.                                   */
/*                                                              */
/****************************************************************/

/****************************************************************/
/*                     SAMPLE PROGRAM                           */
/****************************************************************/

parse arg username
IF username = "" THEN
   DO
      SAY "Usage: userdir user@domain"
      EXIT
   END

Globals = "MultiDomain MailRoot Domains."
CALL RxFuncAdd SysLoadFuncs, rexxutil, sysloadfuncs
CALL SysLoadFuncs

/* The initialisation procedure ParseDomainInfo sets some       */
/* global information that will be used by the other procedures.*/

CALL ParseDomainInfo

/* Now we can do the real job. */

dir = UserDirectoryFor(username)
IF dir = "" THEN SAY 'Failed to find a match for that domain'
ELSE DO
    SAY 'Final directory for 'username' is '
    SAY '   'dir
END /*ELSE*/
RETURN 0

/****************************************************************/
/*             FINDING A MAIL USER'S DIRECTORY                  */
/****************************************************************/

UserDirectoryFor: PROCEDURE expose (Globals)

    /* Prerequisite: the global variables MultiDomain, MailRoot */
    /* and Domains. have already been set, for example by       */
    /* calling ParseDomainInfo (see below).                     */

    /* This procedure takes a user@domain argument (as a single */
    /* string) and returns the user directory for this user.    */
    /* If the domain is valid but the user is not, we return    */
    /* the name of the subdirectory 'invalid' for that domain.  */
    /* If the domain is invalid, we return the name of the      */
    /* 'invalid' directory under the main mail root.  Those     */
    /* directories might or might not exist, but we consider    */
    /* that to be the caller's problem.                         */

    parse arg user'@'domain
    dom = IdentifyDomain(domain)
    multi = MultiDomain & (dom \= 0)
    dir = MailRoot
    IF multi THEN DO
        dir = dir||Domains.dom||'\'
        INIFile = dir||'DOMAIN.INI'
    END
    ELSE INIFile = dir||'WEASEL.INI'

    /* Check whether the user exists in this domain. */

    IF SysIni(INIFile, user, 'Password') = 'ERROR:' THEN DO
       SAY "Warning: username "user" does not exist in this domain"
       user = 'invalid'
    END /*IF*/

    RETURN dir||user

/****************************************************************/
/*                                                              */
/*       BUILDING THE MAILROOT AND THE LIST OF DOMAINS          */
/*                                                              */
/*  This is an initialisation procedure that sets the global    */
/*  variables MultiDomain, MailRoot, and Domains.  For the      */
/*  purposes of this program those variables have values that   */
/*  never change, so you should call this procedure once, and   */
/*  then call procedure IdentifyDomain (below) as many times    */
/*  as you need to.                                             */
/*                                                              */
/****************************************************************/

ParseDomainInfo: PROCEDURE expose (Globals)

    /* On exit, Domains.0 contains the number of domains we are */
    /* hosting, and the domain names are in Domains.j for j = 1 */
    /* to Domains.0.  In the single-domain case, Domains.0 = 1  */
    /* and Domains.1 is the empty string.                       */

    /* This procedure also sets the global variables 'MailRoot' */
    /* and 'MultiDomain'.                                       */

    /* Figure out the mail root. */

    INIFile = "WEASEL.INI"
    Nul = '00'X
    MailRoot = SysIni(INIFile, '$SYS', 'MailRoot')
    j = POS(Nul,MailRoot)
    IF j > 0 THEN MailRoot = LEFT(MailRoot, j-1)
    MailRoot = TRANSLATE(STRIP(MailRoot), '\', '/')

    MultiDomain = SysIni(INIFile, '$SYS', 'MultiDomainEnabled') == '01'X
    IF MultiDomain THEN DO
        Domains.0 = 0
        DomainString = SysIni(INIFile, '$SYS', 'Domains')

        DO WHILE DomainString \= ""
            PARSE VALUE DomainString WITH current '00'X DomainString
            current = TRANSLATE(STRIP(current))
            IF current \= "" THEN DO
                k = Domains.0 + 1
                Domains.k = current
                Domains.0 = k
            END /*IF*/
        END /*DO FOREVER*/

    END
    ELSE DO
        Domains.0 = 1
        Domains.1 = ''
    END /*IF*/;
    RETURN

/****************************************************************/
/*                    IDENTIFYING A DOMAIN                      */
/****************************************************************/

IdentifyDomain: PROCEDURE expose (Globals)

    /* This procedure is called with a single parameter, which  */
    /* is the 'domain name' part of an e-mail address.  We      */
    /* return an integer k such that the given name is one of   */
    /* the names for Domain.k.  The result k=0 means "no such   */
    /* domain is hosted here".                                  */

    PARSE UPPER ARG name
    singledomain = (Domains.0 = 1) & (Domains.1 = '')
    Nul = '00'X

    success = 0
    DO k = 1 TO Domains.0

        /* We have a match if name matches the domain name. */

        IF name = Domains.k THEN DO
            success = 1
            LEAVE
        END /*IF*/

        /* Otherwise, we have to look up the "Local" list for  */
        /* this domain.                                        */

        IF singledomain THEN
            INIFile = "WEASEL.INI"
        ELSE
            INIFile = MailRoot||Domains.k||"\DOMAIN.INI"

        LocalList = SysIni(INIFile, '$SYS', 'Local')
        j = POS(Nul||Nul, LocalList)
        IF j > 0 THEN LocalList = LEFT(LocalList, j-1)

        DO FOREVER
            IF LocalList = "" THEN LEAVE
            PARSE VALUE LocalList WITH current '00'X LocalList
            current = TRANSLATE(STRIP(current))
            IF name = current THEN DO
                success = 1
                LEAVE
            END /*IF*/
        END /*DO FOREVER*/

        IF success THEN LEAVE

    END /* DO k = 1 TO ... */

    IF \success THEN k = 0

    RETURN k

/****************************************************************/