/****************************************************************/
/*                                                              */
/* Utility to create FtpServer accounts for all users in the    */
/* tcp/ip configuration notebook who have ftp permissions.      */
/* That is, in effect we are migrating ftp accounts from IBM's  */
/* FTPD to FtpServer.  The original data are left intact, in    */
/* case you want to switch back to the original FTPD.           */
/*                                                              */
/* Note: since passwords are encrypted, this script will not    */
/* succeed in migrating the passwords.  I'm afraid you will     */
/* have to enter the passwords manually.                        */
/*                                                              */
/*       Programmer:      P. Moylan                             */
/*       Last modified:   17 November 2020                      */
/*                                                              */
/*   Usage:    migrate                                          */
/*                      (i.e. there are no parameters)          */
/*                                                              */
/****************************************************************/

call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
CALL CheckPrerequisites SelectTNI INI_get INI_put

/* Open the file that was created by the tcp/ip configuration notebook.  */

srcfile = value('ETC',,'OS2ENVIRONMENT')'\tcpnbk.lst'
SAY ''
SAY 'Adding FtpServer users from the database in 'srcfile
SAY ''

CALL Stream srcfile, 'C', 'OPEN READ'
count = 0
DO FOREVER
    line = LineIn(srcfile)
    IF line = '' THEN LEAVE
    j = POS('(', line)
    IF j > 0 THEN DO
        PARSE VAR line rubbish'('line
        count = count + ProcessUser(srcfile, STRIP(line))
    END
END
CALL Stream srcfile, 'C', 'CLOSE'
SAY count" users migrated"

EXIT 0

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

ProcessUser: PROCEDURE

    /* This is the procedure that processes all data for one    */
    /* user.  On entry we have passed the opening '('.  The     */
    /* first parameter is the source file name, and the second  */
    /* is that part of the input line that comes after the '('. */

    PARSE ARG srcfile, line
    user.active = 0
    DO FOREVER
        IF LINES(srcfile) = 0 THEN LEAVE
        line = line||STRIP(LineIn(srcfile))
        IF line = ')' THEN LEAVE
        ELSE IF line \= '' THEN DO

            /* Pick up a keyword = value line. */

            PARSE VAR line kwd'='val
            kwd = TRANSLATE(kwd)
            val = STRIP(val)

            IF kwd = 'USERID' THEN user.ID = val
            ELSE IF kwd = 'COMMENT' THEN user.comment = val
            ELSE IF kwd = 'FTPD' THEN DO

                PARSE VAR val rubbish'('line

                /* We are now specifically in the FTPD          */
                /* section of the user data.  Pick up the       */
                /* relevant information.                        */

                line = STRIP(line)
                DO FOREVER
                    IF LINES(srcfile) = 0 THEN LEAVE
                    line = line||STRIP(LineIn(srcfile))
                    IF line = ')' THEN LEAVE
                    ELSE IF line \= '' THEN DO

                        /* Pick up a keyword = value line. */

                        PARSE VAR line kwd'='val
                        kwd = TRANSLATE(kwd)
                        val = STRIP(val)

                        IF kwd = 'ACTIVE' THEN user.active = val
                        ELSE IF kwd = 'READ' THEN user.readdirs = val
                        ELSE IF kwd = 'CANREAD' THEN user.canread = val
                        ELSE IF kwd = 'WRITE' THEN user.writedirs = val
                        ELSE IF kwd = 'CANWRITE' THEN user.canwrite = val

                    END /*IF*/
                    line = ''
                END /*DO FOREVER*/
            END /*ELSE IF*/

            ELSE IF LEFT(val,1) = '(' THEN CALL Skip srcfile val

        END /*IF*/
        line = ''

    END /*DO FOREVER*/

    /* We have now picked up all available data for this user.  */
    /* Create the INI file entry.                               */

    found = 0
    IF user.ID \= '' THEN DO

        found = 1
        user.id = TRANSLATE(user.id, 'abcdefghijklmnopqrstuvwxyz',,
                                     'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
        inifile = INIFileFor(user.ID)

        IF user.active = 0 THEN
            CALL INI_put inifile, user.ID, 'Active', '00'X
        ELSE CALL INI_put inifile, user.ID, 'Active', '01'X
        permstring = SortDirs( user.canread, user.readdirs, user.canwrite, user.writedirs)
        IF user.ID = 'anonymous' THEN
            CALL INI_put inifile, user.ID, 'Category', '02'X
        ELSE
            CALL INI_put inifile, user.ID, 'Category', '03'X
        CALL INI_put inifile, user.ID, 'Notes', user.comment
        CALL INI_put inifile, user.ID, 'Volume', permstring
        SAY 'Username: 'user.ID' added'

    END /*IF*/

    RETURN found

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

SortDirs: PROCEDURE EXPOSE tree.

    /* This is the tricky part.  We take the read and write     */
    /* directory information, and turn it into a permission     */
    /* tree.                                                    */

    PARSE UPPER ARG canread, readdirs, canwrite, writedirs
    Drives = SysDriveMap('C', 'USED')

    /* Start with an empty tree.  */

    tree.0 = 0

    /* If canread = 0, insert all drives and then record        */
    /* absence of read permission for the readdirs directories. */
    /* If canread = 1, it's a little simpler.                   */

    IF canread = 0 THEN DO
        CALL InsertList '+*', Drives
        CALL InsertList '-*', readdirs
    END /*IF*/
    ELSE
        CALL InsertList '+*', readdirs

    /* Now the same operation for the write permissions. */

    IF canwrite = 0 THEN DO
        CALL InsertList '*+', Drives
        CALL InsertList '*-', writedirs
    END /*IF*/
    ELSE
        CALL InsertList '*+', writedirs

    topcount = TranslateCodes()

    /* The tree is now complete.  Turn it into a permission     */
    /* string.  There are 'topcount' top-level nodes.           */

    IF topcount = 0 THEN permstring = ''
    ELSE IF topcount = 1 THEN permstring = MakePermString(1)
    ELSE DO
        permstring = '"/"=""('MakePermString(1)')'
    END /*ELSE*/

    RETURN permstring

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

InsertList: PROCEDURE EXPOSE tree.

    /* Inserts a list of directories into the tree. */

    PARSE ARG code, dirlist
    DO WHILE dirlist \= ''
        PARSE VAR dirlist dir dirlist
        CALL Insert code, dir
    END /*DO*/
    RETURN

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

Insert: PROCEDURE EXPOSE tree.

    /* Inserts a top-level directory into the tree. */

    PARSE ARG code, dir
    dir = TRANSLATE(dir, '\', '/')
    IF RIGHT(dir, 1) = '\' THEN dir = LEFT(dir, LENGTH(dir)-1)
    j = 1
    DO WHILE dir \= ''

        M = LENGTH(tree.j.gname)
        N = LENGTH(dir)

        IF j > tree.0 THEN DO
            tree.0 = j
            tree.j.gname = dir
            tree.j.kode = code
            tree.j.level = 1
            dir = ''
        END

        ELSE IF M <= N THEN DO
            IF POS(tree.j.gname, dir) = 1 THEN DO

                /* Current entry is a leading substring of new entry. */

                IF M = N THEN DO
                    CALL UpdateCode j, code
                END
                ELSE IF SUBSTR(dir,M+1,1) = '\' THEN DO
                    CALL InsertBelow j, code, RIGHT(dir, N-M-1)
                END
                dir = ''
            END /* ELSE IF POS ... */
        END /* IF M <= N */

        ELSE IF POS(dir, tree.j.gname) = 1 THEN DO

            /* New entry is a leading substring of current  */
            /* entry.  Swap them.                           */

            IF SUBSTR(tree.j.gname,N+1,1) = '\' THEN DO
                oldname = RIGHT(tree.j.gname, M-N-1)
                oldcode = tree.j.kode
                tree.j.gname = dir
                tree.j.kode = code
                CALL InsertBelow j, oldcode, oldname
                dir = ''
            END

        END /* ELSE IF POS ... */

        j = j+1

    END /*DO*/

    RETURN

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

InsertBelow: PROCEDURE EXPOSE tree.

    PARSE ARG pos, code, dir

    /* Inserts a subtree under the tree node at tree.pos. */

    ourlevel = tree.pos.level + 1

    /* Separate out the name as a first component subdir (to    */
    /* be inserted now), and a remainder to be inserted via a   */
    /* recursive call.                                          */

    PARSE VAR dir subdir'\'dir

    DO FOREVER
        pos = pos + 1

        IF (pos > tree.0) | (tree.pos.level < ourlevel) THEN DO

            /* We have found the correct insertion point.  Create a     */
            /* hole in the tree array, and put the new information into */
            /* that hole.                                               */

            CALL InsertHoleHere pos
            tree.pos.gname = subdir
            tree.pos.level = ourlevel
            IF dir = '' THEN tree.pos.kode = code
            ELSE DO
                tree.pos.kode = '**'
                CALL InsertBelow pos, code, dir
            END /* ELSE */
            LEAVE

        END

        ELSE IF tree.pos.level = ourlevel THEN DO
            IF tree.pos.gname = subdir THEN DO

                /* We have a name match. */

                CALL UpdateCode j, code
                IF dir \= '' THEN CALL InsertBelow pos, code, dir
                LEAVE

            END /*IF*/
        END

    END /*DO*/

    RETURN

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

InsertHoleHere: PROCEDURE EXPOSE tree.

    PARSE ARG pos

    /* Inserts an empty entry at tree.pos.       */

    j = tree.0 + 1
    tree.0 = j
    DO WHILE j > pos
        k = j-1
        tree.j.gname = tree.k.gname
        tree.j.level = tree.k.level
        tree.j.kode = tree.k.kode
        j = k
    END

    RETURN

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

UpdateCode: PROCEDURE EXPOSE tree.

    PARSE ARG pos, NewCode

    /* Merges NewCode into tree.pos.kode.  The new code   */
    /* replaces the old except when the new code is '*'.  */

    oldread = LEFT(tree.pos.kode, 1)
    oldwrite = RIGHT(tree.pos.kode, 1)
    newread = LEFT(NewCode, 1)
    newwrite = LEFT(NewCode, 1)
    IF newread = '*' THEN newread = oldread
    IF newwrite = '*' THEN newwrite = oldread
    tree.pos.kode = newread||newwrite
    RETURN

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

TranslateCodes: PROCEDURE EXPOSE tree.

    /* Up until now, for ease of merging new and old codes, the */
    /* tree.j.kode have been two-character codes where the      */
    /* first character gives read permission and the second     */
    /* gives write permission.  The codes during that phase     */
    /* were '+' for permitted, '-' for denied, and '*' for      */
    /* inherit.  The present function converts these to the     */
    /* R+ etc codes that are used in the INI file.  It also     */
    /* removes top-level entries with '--' or '**' codes, since */
    /* at the top level these imply no access at all.           */
    /* Return value: the number of top-level nodes remaining.   */

    topcount = 0

    /* To simplify some special case checking, add a sentinel   */
    /* record at the end of the tree array.                     */

    j = tree.0 +  1
    tree.j.level = 0
    tree.0 = j
    j = 1

    DO FOREVER

        /* We go once around the outermost loop for each tree,  */
        /* i.e. for each level 1 record and its descendants.    */

        IF tree.j.level = 0 THEN LEAVE
        IF (tree.j.kode = '--') | (tree.j.kode = '**') THEN DO

            /* Special case: a no-access top-level node.        */
            /* Delete it and promote its subordinate nodes.     */

            prefix = tree.j.gname||'\'
            j0 = j
            CALL KillNode j
            DO WHILE tree.j.level = 2
                tree.j.level = 1
                tree.j.gname = prefix||tree.j.gname
                j = j + 1
                DO WHILE tree.j.level > 2
                    tree.j.level = tree.j.level - 1
                    j = j + 1
                END /* while level > 2 */
            END /* while level = 2 */
            j = j0

        END /* special case */

        ELSE DO

            /* Normal case, only the .kode field needs changing. */

            readcode = LEFT(tree.j.kode, 1)
            IF readcode = '*' THEN readcode = '-'
            writecode = RIGHT(tree.j.kode, 1)
            IF writecode = '*' THEN writecode = '-'
            tree.j.kode = 'R'||readcode||'W'||writecode
            j = j + 1
            DO WHILE tree.j.level > 1
                readcode = LEFT(tree.j.kode, 1)
                writecode = RIGHT(tree.j.kode, 1)
                newcode = ''
                IF readcode \= '*' THEN newcode = 'R'||readcode
                IF writecode \= '*' THEN newcode = newcode||'W'||writecode
                tree.j.kode = newcode
                j = j + 1
            END /*DO WHILE*/
            topcount = topcount + 1

        END /* handling one tree */

    END /* outermost loop */

    RETURN topcount

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

MakePermString: PROCEDURE EXPOSE tree.

    /* Walks the tree, and turns it into a permission string. */

    PARSE ARG pos

    ans = ''
    L0 = tree.pos.level
    max = tree.0
    DO WHILE tree.pos.level = L0
        name = '"'||tree.pos.gname||'"'
        ans = ans||name||'='||name||tree.pos.kode
        pos = pos + 1
        IF tree.pos.level > L0 THEN DO
            ans = ans||'('||MakePermString(pos)||')'
            pos = tree.max.gname
        END
        IF tree.pos.level = L0 THEN ans = ans||','
    END /*IF*/

    tree.max.gname = pos

    RETURN ans

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

KillNode: PROCEDURE EXPOSE tree.

    PARSE ARG pos

    /* Deletes the record at tree.pos.       */

    j = tree.0 - 1
    tree.0 = j
    DO WHILE pos <= j
        k = pos+1
        tree.pos.gname = tree.k.gname
        tree.pos.level = tree.k.level
        tree.pos.kode = tree.k.kode
        pos = k
    END

    RETURN

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

DumpTree: PROCEDURE EXPOSE tree.

    /* For debugging: writes out the tree. */

    SAY 'Dumping tree with 'tree.0' nodes.'
    DO j= 1 TO tree.0
        lvl = tree.j.level
        SAY COPIES(' ', lvl+1)||lvl'  'tree.j.kode'  'tree.j.gname
    END /*DO*/
    RETURN

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

Skip: PROCEDURE

    /* On entry, the 'line' argument starts with a '('.  We     */
    /* skip the input until we have passed the matching ')'.    */

    PARSE ARG srcfile line
    nesting = 0
    DO UNTIL nesting = 0
        j = POS('(', line)
        k = POS(')', line)
        IF j = 0 THEN DO
            IF k = 0 THEN DO
                /* No parentheses, get a new line */
                IF LINES(srcfile) = 0 THEN nesting = 0
                ELSE line = STRIP(LineIn(srcfile))
            END /* Case k=0 */
            ELSE DO
                PARSE VAR line rubbish')'line
                nesting = nesting - 1
            END /* Case k>0 */
        END /* Case j=0 */
        ELSE IF (k = 0) | (k > j) THEN DO
            PARSE VAR line rubbish'('line
            nesting = nesting + 1
        END /* Case where left paren comes first */
        ELSE DO
            PARSE VAR line rubbish')'line
            nesting = nesting - 1
        END /* Case where right paren comes first */
    END /*DO*/
    RETURN

/****************************************************************/
/*  Procedure to find the INI or TNI file that contains the     */
/*  data for one user.  In many installations this will turn    */
/*  out to be FTPD.INI or FTPD.TNI, but if the option to use    */
/*  multiple INI files is activated then the file name is based */
/*  on a hash coding of the username.  The file is created if   */
/*  it doesn't already exist.                                   */
/****************************************************************/

IniFileFor:  PROCEDURE

    PARSE UPPER ARG username
    IF SelectTNI("FTPD") THEN extension = "TNI"
    ELSE extension = "INI"
    HashMax = INI_get('FTPD.'extension, '$SYS', 'HashMax')
    IF HashMax = '' THEN HashMax = 0
    ELSE HashMax = C2D(REVERSE(HashMax))
    IF HashMax = 0 THEN code = ''
    ELSE DO
        code = 0
        DO WHILE username <> ''
            ch = LEFT(username,1)
            username = RIGHT(username, LENGTH(username)-1)
            code = (16*code + C2D(ch)) // HashMax
        END
        code = TRANSLATE(FORMAT(code,4), '0', ' ')
    END
    file = 'FTPD'code'.'extension

    /* Create the file if it doesn't already exist. */

    IF STREAM(file, 'C', 'QUERY EXISTS') = '' THEN DO
        CALL STREAM file, 'C', 'OPEN WRITE'
        CALL STREAM file, 'C', 'CLOSE'
    END

    RETURN file

/****************************************************************/
/*                      CHECKING PREREQUISITES                  */
/****************************************************************/

CheckPrerequisites: PROCEDURE

    /* The argument is a space-separated list of prerequisite   */
    /* functions, for example                                   */
    /*      CALL CheckPrerequisites rxu SelectTNI INI_get       */
    /* where (at least in this version) each list item is       */
    /* either 'rxu' or a function from my TNItools package.     */
    /* If any is missing then we exit with an error message.    */

    PARSE UPPER ARG funclist
    funclist = STRIP(funclist)
    needrxu = 0
    needtools = 0
    DO WHILE funclist \= ''
        PARSE VAR funclist func funclist
        funclist = STRIP(funclist)
        IF func = 'RXU' THEN DO

            /* Initialise RXU if not already available, fail if */
            /* the RxFuncAdd operation fails.  We must          */
            /* RxFuncQuery RxuTerm because RxuTerm does not     */
            /* deregister RxuInit.  The RxFuncDrop is needed    */
            /* because RxFuncAdd seems to report failure if the */
            /* function is already registered.                  */

            IF RxFuncQuery('RxuTerm') THEN DO
                CALL RxFuncDrop('RxuInit')
                CALL RxFuncAdd 'RxuInit','RXU','RxuInit'
                IF result THEN DO
                    SAY 'Cannot load RXU'
                    needrxu = 1
                END
                ELSE CALL RxuInit
            END
        END
        ELSE DO
            func = func||'.CMD'
            IF SysSearchPath('PATH', func) = '' THEN DO
                SAY 'ERROR: 'func' must be in your PATH'
                needtools = 1
            END
        END
    END
    IF needrxu THEN SAY 'You can find RXU1a.zip at Hobbes'
    IF needtools THEN SAY 'Please install the GenINI package'
    IF needrxu | needtools THEN EXIT 1
    RETURN

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


