PC Online 1997 August/PCO0897.ISO/filesbbs/os2/rxcht10a.arj/RXCHT10A.ZIP/chatd.cmd

Text File | 1997-06-17 | 37.5 KB | 851 lines

/*┌─────────────────────────────────────────────────────────────────────────┐*\
 ┌┘ CHATD.CMD  Server layer of REXXchat, an Internet chat system for OS/2.  └┐
 │                                                                           │
 │      Product :       REXXchat Server                                      │
 │      Author  :       Kevin Yank ([e-mail])                           │
 │      Version :       1.0                                                  │
 │      Date    :       17 June 1997                                         │
 │      Revision:       First Version                                        │
 │                                                                           │
 └┐    FOR LICENSING, DISCLAIMER AND OTHER INFORMATION SEE REXXCHAT.INF     ┌┘
\*└─────────────────────────────────────────────────────────────────────────┘*/

SIGNAL ON HALT
SIGNAL ON SYNTAX

START:

    CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    CALL SysLoadFuncs
    CALL RxFuncAdd 'PopSleep', 'POPPLAY', 'PopSleep'

SERVERSTART:

    CALL SysCls

    SAY "REXXchat server starting up..."

    /* Check if another server is already running */
    /* by checking for the existance of a queue   */
    /* called REXXCHAT_MAINT.                     */
    MaintenanceQueue = RxQueue('CREATE', 'REXXCHAT_MAINT')
    IF MaintenanceQueue = 'REXXCHAT_MAINT' THEN DO
        SAY "Maintenance queue created."
        END
    ELSE DO
        SAY "Existing REXXchat server queue detected!"
        /* Excess queue used in test is deleted as part */
        /* of the SERVEREND process                     */
        SIGNAL SERVEREND
        END

    SAY "Server started. Press CTRL-C to close server."

    clients.0 = 0
    channels.0 = 0

    /* Go into main server loop */
    DO FOREVER

        /* Check for queued messages in the maintenance queue */
        CALL RxQueue 'SET', MaintenanceQueue
        IF Queued() > 0 THEN DO
            PARSE PULL MaintenanceMessage MaintArg1 MaintArg2
            /* Say "Got Message: "MaintenanceMessage MaintArg1 MaintArg2 MaintArg3 */
            SELECT
                WHEN MaintenanceMessage = "NewClientRequest" THEN DO
                    NewQueueToClient = MaintArg1
                    NewNick = MaintArg2
                    CALL RxQueue 'SET', NewQueueToClient
                    IF NickIndex(NewNick) THEN
                        QUEUE "BADNICK"
                    ELSE DO
                        /* NEW CLIENT REQUEST APPROVED!    */
                        /* Create a Client -> Server Queue */
                        NewQueueToServer = RxQueue('CREATE')
                        QUEUE NewQueueToServer
                        Index = ( clients.0 ) + 1
                        clients.0 = Index
                        clients.Index.Q2Server = NewQueueToServer
                        clients.Index.Q2Client = NewQueueToClient
                        clients.Index.Nick = NewNick
                        clients.Index.Channel = ''
                        CALL PostSystemMessage(NewNick "has entered REXXchat")
                        DROP NewQueueToServer Index
                        END
                    DROP NewQueueToClient NewNick
                    END
                OTHERWISE DO
                    SAY "Invalid Message in Server Maintenance Queue!"
                    SIGNAL SERVEREND
                    END
                END
            DROP MaintenanceMessage MaintArg1 MaintArg2
            END

        IF clients.0 > 0 THEN
            /* Check for queued messages in each client queue */
            DO index = 1 to clients.0
                CALL RxQueue 'SET', clients.index.Q2Server
                IF Queued() > 0 THEN DO
                    PARSE PULL ClientMessage ClientArg1
                    /*Say "Got Message: "ClientMessage ClientArg1*/
                    SELECT
                        WHEN ClientMessage = "PRIVMSG" THEN DO
                            PARSE VAR ClientArg1 TargetNick ' ' Msg
                            /*SAY "Received private message for '"TargetNick"' from '"clients.index.Nick"'."*/
                            CALL ClientPrivMsg clients.index.Nick TargetNick Msg
                            DROP TargetNick Msg
                            END
                        WHEN ClientMessage = "PRIVDO" THEN DO
                            PARSE VAR ClientArg1 TargetNick ' ' Msg
                            /*SAY "Received private action for '"TargetNick"' from '"clients.index.Nick"'."*/
                            CALL ClientPrivDo clients.index.Nick TargetNick Msg
                            DROP TargetNick Msg
                            END
                        WHEN ClientMessage = "SAY" THEN DO
                            CALL ClientSay index ClientArg1
                            END
                        WHEN ClientMessage = "DO" THEN DO
                            CALL ClientDo index ClientArg1
                            END
                        WHEN ClientMessage = "JOINCHANNEL" THEN DO
                            CALL ClientJoinChannel index ClientArg1
                            END
                        WHEN ClientMessage = "LEAVECHANNEL" THEN DO
                            CALL ClientLeaveChannel index ClientArg1
                            END
                        WHEN ClientMessage = "CHANGETOPIC" THEN DO
                            CALL ClientChangeTopic index ClientArg1
                            END
                        WHEN ClientMessage = "NICKCHANGEREQUEST" THEN DO
                            CALL ClientChangeNick index ClientArg1
                            END
                        WHEN ClientMessage = "LISTUSERS" THEN DO
                            Call ListUsers index
                            END
                        WHEN ClientMessage = "LISTCHANNELUSERS" THEN DO
                            CALL ListChannelUsers index
                            END
                        WHEN ClientMessage = "LISTCHANNELS" THEN DO
                            Call ListChannels index
                            END
                        WHEN ClientMessage = "HELP" THEN DO
                            CALL SendClientHelp index
                            END
                        WHEN ClientMessage = "QUIT" THEN DO
                            CALL ClientQuit index ClientArg1
                            END
                        OTHERWISE DO
                            SAY "Invalid Message in Server Maintenance Queue!"
                            SIGNAL SERVEREND
                            END
                        END
                    DROP ClientMessage ClientArg1
                    END
                END

        CALL PopSleep 250
        END

    SIGNAL SERVEREND

NickIndex: PROCEDURE EXPOSE clients.
/* Search for and return index of a nickname in the client array */
/* Returns zero if nick not found                                */
    PARSE UPPER ARG nickname
    index = 0
    IF clients.0 > 0 THEN DO i = 1 TO clients.0
        if TRANSLATE(clients.i.Nick) = nickname THEN DO
            index = i
            LEAVE
            END
        END
    RETURN index

ChannelIndex: PROCEDURE EXPOSE channels.
/* Search for and return index of a channel in the channel array */
/* Returns zero if channel not found                             */
    PARSE UPPER ARG searchname
    index = 0
    IF channels.0 > 0 THEN DO i = 1 TO channels.0
        if TRANSLATE(channels.i.channelname) = searchname THEN DO
            index = i
            LEAVE
            END
        END
    RETURN index

PostSystemMessage: PROCEDURE EXPOSE clients.
/* A system event or message must be sent to all clients */
    PARSE ARG message
    SAY "System Message: """Message"""."
    IF CLIENTS.0 > 0 THEN DO i = 1 TO clients.0
        CALL RxQueue 'SET', clients.i.Q2Client
        QUEUE "OUTPUT *** "message
        END
    RETURN

ClientPrivMsg: PROCEDURE EXPOSE clients.
/* A client sends a private message to another client */
    PARSE ARG SourceNick TargetNick Msg
    TargetIndex = NickIndex(TargetNick)
    SourceIndex = NickIndex(SourceNick)
    IF TargetIndex > 0 THEN DO
        TargetNick = clients.Targetindex.nick /* Fixes case mismatches */
        /* Message to Source */
        headerlength = LENGTH('-> ' || TargetNick || ' ')
        maxlinelength = 80 - headerlength
        currentline = 0
        message = Msg
        DO UNTIL LENGTH(message) = 0
            /* BUILD A LINE */
            currentline = currentline + 1
            messageline.currentline = message
            if LENGTH( messageline.currentline ) < maxlinelength THEN DO
                message = ''
                END
            ELSE DO
                BreakColumn = MaxLineLength + 1
                CharacterAtBreak = ''
                DO UNTIL CharacterAtBreak = ' '
                    BreakColumn = BreakColumn - 1
                    IF BreakColumn = 1 THEN DO
                        BreakColumn = MaxLineLength + 1
                        LEAVE
                        END
                    CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
                    END
                messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
                message = STRIP(SUBSTR(message,BreakColumn),'Leading')
                END
            /* FINISH BUILDING A LINE */
            END
        messagelines.0 = currentline
        CALL RxQueue 'SET', clients.SourceIndex.Q2Client
        DO j = 1 to messagelines.0
        /* OUTPUT A LINE */
            IF j = 1 THEN
                header = '-> ' || TargetNick || ' '
            ELSE
                header = LEFT('',headerlength)
            QUEUE "OUTPUT" header || messageline.j
            /* FINISH OUTPUTTING A LINE */
            END
        /* Message to Target */
        headerlength = LENGTH( '[' || SourceNick || '] ')
        maxlinelength = 80 - headerlength
        currentline = 0
        message = Msg
        DO UNTIL LENGTH(message) = 0
            /* BUILD A LINE */
            currentline = currentline + 1
            messageline.currentline = message
            if LENGTH( messageline.currentline ) < maxlinelength THEN DO
                message = ''
                END
            ELSE DO
                BreakColumn = MaxLineLength + 1
                CharacterAtBreak = ''
                DO UNTIL CharacterAtBreak = ' '
                    BreakColumn = BreakColumn - 1
                    IF BreakColumn = 1 THEN DO
                        BreakColumn = MaxLineLength + 1
                        LEAVE
                        END
                    CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
                    END
                messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
                message = STRIP(SUBSTR(message,BreakColumn),'Leading')
                END
            /* FINISH BUILDING A LINE */
            END
        messagelines.0 = currentline
        CALL RxQueue 'SET', clients.TargetIndex.Q2Client
        DO j = 1 to messagelines.0
        /* OUTPUT A LINE */
            IF j = 1 THEN
                header = '[' || SourceNick || '] '
            ELSE
                header = LEFT('',headerlength)
            QUEUE "OUTPUT" header || messageline.j
            /* FINISH OUTPUTTING A LINE */
            END
        END
    ELSE DO
        CALL RxQueue 'SET', clients.SourceIndex.Q2Client
        IF LENGTH("*** No such user as" TargetNick) > 80 THEN
            TargetNick = SUBSTR(TargetNick,1,57) || '...'
        QUEUE "OUTPUT *** No such user as" TargetNick
        END
    RETURN

ClientPrivDo: PROCEDURE EXPOSE clients.
/* A client sends a private action to another client */
    PARSE ARG SourceNick TargetNick Msg
    TargetIndex = NickIndex(TargetNick)
    SourceIndex = NickIndex(SourceNick)
    IF TargetIndex > 0 THEN DO
        TargetNick = clients.Targetindex.nick /* Fixes case mismatches */
        /* Message to Source */
        headerlength = LENGTH('-> ' || TargetNick || ' * ' || SourceNick || ' ')
        maxlinelength = 80 - headerlength
        currentline = 0
        message = Msg
        DO UNTIL LENGTH(message) = 0
            /* BUILD A LINE */
            currentline = currentline + 1
            messageline.currentline = message
            if LENGTH( messageline.currentline ) < maxlinelength THEN DO
                message = ''
                END
            ELSE DO
                BreakColumn = MaxLineLength + 1
                CharacterAtBreak = ''
                DO UNTIL CharacterAtBreak = ' '
                    BreakColumn = BreakColumn - 1
                    IF BreakColumn = 1 THEN DO
                        BreakColumn = MaxLineLength + 1
                        LEAVE
                        END
                    CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
                    END
                messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
                message = STRIP(SUBSTR(message,BreakColumn),'Leading')
                END
            /* FINISH BUILDING A LINE */
            END
        messagelines.0 = currentline
        CALL RxQueue 'SET', clients.SourceIndex.Q2Client
        DO j = 1 to messagelines.0
        /* OUTPUT A LINE */
            IF j = 1 THEN
                header = '-> ' || TargetNick || ' * ' || SourceNick || ' '
            ELSE
                header = LEFT('',headerlength)
            QUEUE "OUTPUT" header || messageline.j
            /* FINISH OUTPUTTING A LINE */
            END
        /* Message to Target */
        headerlength = LENGTH( '* [' || SourceNick || '] ')
        maxlinelength = 80 - headerlength
        currentline = 0
        message = Msg
        DO UNTIL LENGTH(message) = 0
            /* BUILD A LINE */
            currentline = currentline + 1
            messageline.currentline = message
            if LENGTH( messageline.currentline ) < maxlinelength THEN DO
                message = ''
                END
            ELSE DO
                BreakColumn = MaxLineLength + 1
                CharacterAtBreak = ''
                DO UNTIL CharacterAtBreak = ' '
                    BreakColumn = BreakColumn - 1
                    IF BreakColumn = 1 THEN DO
                        BreakColumn = MaxLineLength + 1
                        LEAVE
                        END
                    CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
                    END
                messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
                message = STRIP(SUBSTR(message,BreakColumn),'Leading')
                END
            /* FINISH BUILDING A LINE */
            END
        messagelines.0 = currentline
        CALL RxQueue 'SET', clients.TargetIndex.Q2Client
        DO j = 1 to messagelines.0
        /* OUTPUT A LINE */
            IF j = 1 THEN
                header = '* [' || SourceNick || '] '
            ELSE
                header = LEFT('',headerlength)
            QUEUE "OUTPUT" header || messageline.j
            /* FINISH OUTPUTTING A LINE */
            END
        END
    ELSE DO
        CALL RxQueue 'SET', clients.SourceIndex.Q2Client
        IF LENGTH("*** No such user as" TargetNick) > 80 THEN
            TargetNick = SUBSTR(TargetNick,1,57) || '...'
        QUEUE "OUTPUT *** No such user as" TargetNick
        END
    RETURN

ClientSay: PROCEDURE EXPOSE clients.
/* A client says something, so it is broadcast to the public */
    PARSE ARG index message
    nickname = clients.index.nick
    if clients.index.channel = '' THEN DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
        END
    ELSE IF CLIENTS.0 > 0 THEN DO
        headerlength = LENGTH('<' || nickname || '> ')
        maxlinelength = 80 - headerlength
        currentline = 0
        DO UNTIL LENGTH(message) = 0
            /* BUILD A LINE */
            currentline = currentline + 1
            messageline.currentline = message
            if LENGTH( messageline.currentline ) < maxlinelength THEN DO
                message = ''
                END
            ELSE DO
                BreakColumn = MaxLineLength + 1
                CharacterAtBreak = ''
                DO UNTIL CharacterAtBreak = ' '
                    BreakColumn = BreakColumn - 1
                    IF BreakColumn = 1 THEN DO
                        BreakColumn = MaxLineLength + 1
                        LEAVE
                        END
                    CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
                    END
                messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
                message = STRIP(SUBSTR(message,BreakColumn),'Leading')
                END
            /* FINISH BUILDING A LINE */
            END
        messagelines.0 = currentline
        DO i = 1 TO clients.0
            IF clients.i.channel = clients.index.channel THEN DO
                CALL RxQueue 'SET', clients.i.Q2Client
                DO j = 1 to messagelines.0
                    /* OUTPUT A LINE */
                    IF j = 1 THEN DO
                        if nickname = clients.i.nick THEN
                            header = '<' || nickname || '> '
                        ELSE
                            header = '<' || nickname || '> '
                        END
                    ELSE
                        header = LEFT('',headerlength)
                    QUEUE "OUTPUT" header || messageline.j
                    /* FINISH OUTPUTTING A LINE */
                    END
                END
            END
        END
    RETURN

ClientDo: PROCEDURE EXPOSE clients.
/* A client does something, so it is broadcast to the public */
    PARSE ARG index message
    nickname = clients.index.nick
    if clients.index.channel = '' THEN DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
        END
    ELSE IF CLIENTS.0 > 0 THEN DO
        headerlength = LENGTH('* ' || nickname || ' ')
        maxlinelength = 80 - headerlength
        currentline = 0
        DO UNTIL LENGTH(message) = 0
            /* BUILD A LINE */
            currentline = currentline + 1
            messageline.currentline = ''
            messageline.currentline = message
            if LENGTH( messageline.currentline ) < maxlinelength THEN DO
                message = ''
                END
            ELSE DO
                BreakColumn = MaxLineLength + 1
                CharacterAtBreak = ''
                DO UNTIL CharacterAtBreak = ' '
                    BreakColumn = BreakColumn - 1
                    IF BreakColumn = 1 THEN DO
                        BreakColumn = MaxLineLength + 1
                        LEAVE
                        END
                    CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
                    END
                messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
                message = STRIP(SUBSTR(message,BreakColumn),'Leading')
                END
            /* FINISH BUILDING A LINE */
            END
        messagelines.0 = currentline
        DO i = 1 TO clients.0
            IF clients.i.channel = clients.index.channel THEN DO
                CALL RxQueue 'SET', clients.i.Q2Client
                DO j = 1 to messagelines.0
                    /* OUTPUT A LINE */
                    IF j = 1 THEN DO
                        if nickname = clients.i.nick THEN
                            header = '* ' || nickname || ' '
                        ELSE
                            header = '* ' || nickname || ' '
                        END
                    ELSE
                        header = LEFT('',headerlength)
                    QUEUE "OUTPUT" header || messageline.j
                    /* FINISH OUTPUTTING A LINE */
                    END
                END
            END
        END
    RETURN

ClientJoinChannel: PROCEDURE EXPOSE clients. channels.
/* A client has requested to join a channel                  */
    PARSE ARG index targetchannel
    IF clients.index.channel <> '' THEN  /* Implicitly leave other channel */
        call ClientLeaveChannel( index )
    channelindex = ChannelIndex( targetchannel )
    IF channelindex = 0 THEN DO
        channels.0 = ( channels.0 ) + 1
        channelindex = channels.0
        channels.channelindex.channelname = targetchannel
        channels.channelindex.users = 1
        channels.channelindex.topic = 'No topic defined'
        clients.index.channel = targetchannel
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT *** You have created channel" targetchannel
        END
    ELSE DO
        targetchannel = channels.channelindex.channelname
        channels.channelindex.users = ( channels.channelindex.users ) + 1
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT *** You have joined channel" targetchannel
        QUEUE "OUTPUT *** Topic for" targetchannel || ":" channels.channelindex.topic
        DO i = 1 TO clients.0
            IF clients.i.channel = targetchannel THEN DO
                CALL RxQueue 'SET', clients.i.Q2Client
                QUEUE 'OUTPUT *** ' || clients.index.nick || ' has joined channel' targetchannel
                END
            END
        END
    clients.index.channel = targetchannel
    RETURN

ClientLeaveChannel: PROCEDURE EXPOSE clients. channels.
/* A client has requested to leave its present channel       */
    PARSE ARG index partingmessage
    if clients.index.channel = '' THEN DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
        END
    ELSE DO
        IF partingmessage = '' THEN partingmessage = 'Leaving'
        ChannelToLeave = clients.index.channel
        /*SAY "User number" index "(" || clients.index.nick || ") leaving channel" ChannelToLeave || "."*/
        DO i = 1 TO clients.0
            IF clients.i.channel = ChannelToLeave THEN DO
                if i = index THEN
                    message = '*** You have left channel' ChannelToLeave '(' || partingmessage || ')'
                ELSE
                    message = '*** ' || clients.index.nick || ' has left channel' ChannelToLeave '(' || partingmessage || ')'
                CALL RxQueue 'SET', clients.i.Q2Client
                QUEUE "OUTPUT" message
                END
            END
        clients.index.channel = ''
        ChannelIndex = ChannelIndex( ChannelToLeave )
        IF Channels.ChannelIndex.users = 1 THEN DO
        /* Delete Channel */
            IF ChannelIndex = channels.0 THEN DO
                DROP Channels.ChannelIndex.topic
                DROP Channels.ChannelIndex.users
                DROP Channels.ChannelIndex.channelname
                END
            ELSE DO
                DO i = ChannelIndex to Channels.0
                    j = i + 1
                    Channels.i.users       = Channels.j.users
                    Channels.i.ChannelName = Channels.j.ChannelName
                    Channels.i.topic       = Channels.j.topic
                    END
                DROP Channels.i.users Channels.i.ChannelName Channels.i.topic
                DROP Channels.j.users Channels.j.ChannelName Channels.j.topic
                DROP i j
                END
            channels.0 = ( channels.0 ) - 1
            END
        ELSE DO
            /* Remove user from channel */
            Channels.ChannelIndex.users = ( Channels.ChannelIndex.users ) - 1
            END
        END
    RETURN

ClientChangeTopic: PROCEDURE EXPOSE clients. channels.
/* A client has changed the topic for a channel              */
    PARSE ARG index newtopic
    if clients.index.channel = '' THEN DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
        END
    ELSE DO
        channelindex = ChannelIndex( clients.index.channel )
        if newtopic = '' THEN DO
            CALL RxQueue 'SET', clients.index.Q2Client
            QUEUE "OUTPUT *** Topic for " || clients.index.channel || ": " || channels.channelindex.topic
            END
        ELSE DO
            channels.channelindex.topic = newtopic
            DO i = 1 TO clients.0
                IF clients.i.channel = clients.index.channel THEN DO
                    if i = index THEN DO
                    message1 = '*** New topic set for channel ' || clients.index.channel
                        END
                    ELSE DO
                        message1 = '*** ' || clients.index.nick || ' has set a new topic for channel ' || clients.index.channel
                        END
                    message2 = '*** Topic: ' || LEFT(channels.channelindex.topic,48)
                CALL RxQueue 'SET', clients.i.Q2Client
                    QUEUE "OUTPUT" message1
                    QUEUE "OUTPUT" message2
                    END
                END
            END
        END
    RETURN

ClientChangeNick: PROCEDURE EXPOSE clients. channels.
/* A client has requested a new nickname                     */
    PARSE ARG index newnick
    IF newnick = clients.index.nick THEN DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT * That is already your nickname!"
        END
    ELSE IF NickIndex(newnick) THEN DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "OUTPUT * Nickname" newnick "is already in use."
        END
    ELSE DO
        CALL RxQueue 'SET', clients.index.Q2Client
        QUEUE "NICKCHANGED" NewNick
        CALL PostSystemMessage( clients.index.nick "is now known as" newnick"." )
        clients.index.nick = newnick
        END
    RETURN

ListUsers: PROCEDURE EXPOSE clients.
/* A client has requested a list of all users                */
    PARSE ARG index
    CALL RxQueue 'SET', clients.index.Q2client
    QUEUE "OUTPUT ***  ,----------------------."
    QUEUE "OUTPUT *** | User List - ALL USERS  `---------------------------------------------."
    QUEUE "OUTPUT *** | Nick       In Channel | Nick       In Channel | Nick       In Channel |"
    QUEUE "OUTPUT *** |=======================|=======================|=======================|"
    SELECT
        WHEN ( clients.0 - 3 * TRUNC(clients.0 / 3) ) = 0 THEN DO
            i = 1
            IF clients.0 > 0 THEN DO UNTIL i = clients.0 + 1
                j = i + 1
                k = i + 2
                QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " | " || LEFT(clients.j.nick,9) || "  " || LEFT(clients.j.channel,10) || " | " || LEFT(clients.k.nick,9) || "  " || LEFT(clients.k.channel,10) || " |"
                i = i + 3
                drop j k
                END
            QUEUE "OUTPUT *** `-----------------------------------------------------------------------'"
            DROP i
            END
        WHEN ( clients.0 - 3 * TRUNC(clients.0 / 3) ) = 1 THEN DO
            i = 1
            IF clients.0 > 3 THEN DO
                DO UNTIL i = clients.0
                    j = i + 1
                    k = i + 2
                    QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " | " || LEFT(clients.j.nick,9) || "  " || LEFT(clients.j.channel,10) || " | " || LEFT(clients.k.nick,9) || "  " || LEFT(clients.k.channel,10) || " |"
                    i = i + 3
                    drop j k
                    END
                i = i - 2
                END
            QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " |-----------------------------------------------'"
            QUEUE "OUTPUT *** `-----------------------'"
            DROP i
            END
        WHEN ( clients.0 - 3 * TRUNC(clients.0 / 3) ) = 2 THEN DO
            i = 1
            IF clients.0 > 3 THEN DO
                DO UNTIL i = clients.0 - 1
                    j = i + 1
                    k = i + 2
                    QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " | " || LEFT(clients.j.nick,9) || "  " || LEFT(clients.j.channel,10) || " | " || LEFT(clients.k.nick,9) || "  " || LEFT(clients.k.channel,10) || " |"
                    i = i + 3
                    drop k
                    END
                i = i - 2
                END
            j = i + 1
            QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " | " || LEFT(clients.j.nick,9) || "  " || LEFT(clients.j.channel,10) || " |-----------------------'"
            QUEUE "OUTPUT *** `-----------------------------------------------'"
            DROP i j
            END
        END
    RETURN

ListChannelUsers: PROCEDURE EXPOSE clients.
/* A client has requested a list of users in current channel */
    PARSE ARG index
    CALL RxQueue 'SET', clients.index.Q2client
    if clients.index.channel = '' THEN DO
        QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
        END
    ELSE DO
        QUEUE "OUTPUT ***  ,----------------------."
        QUEUE "OUTPUT *** | User List - " || LEFT(clients.index.channel,10) || " `---------."
        QUEUE "OUTPUT *** | Nick      | Nick      | Nick      |"
        QUEUE "OUTPUT *** |===========|===========|===========|"

        /* Build a list of users in current channel */
        TempClientArray.0 = 0
        DO i = 1 to clients.0
            if clients.i.channel = clients.index.channel THEN DO
                TempClientArray.0 = ( TempClientArray.0 ) + 1
                newindex = TempClientArray.0
                TempClientArray.newindex = clients.i.nick
                drop newindex
                END
            END

        SELECT
            WHEN ( TempClientArray.0 - 3 * TRUNC(TempClientArray.0 / 3) ) = 0 THEN DO
                i = 1
                IF TempClientArray.0 > 0 THEN DO UNTIL i = TempClientArray.0 + 1
                    j = i + 1
                    k = i + 2
                    QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " | " || LEFT(TempClientArray.k,9) || " |"
                    i = i + 3
                    drop j k
                    END
                QUEUE "OUTPUT *** `-----------------------------------'"
                DROP i
                END
            WHEN ( TempClientArray.0 - 3 * TRUNC(TempClientArray.0 / 3) ) = 1 THEN DO
                i = 1
                IF TempClientArray.0 > 3 THEN DO
                    DO UNTIL i = TempClientArray.0
                        j = i + 1
                        k = i + 2
                        QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " | " || LEFT(TempClientArray.k,9) || " |"
                        i = i + 3
                        drop j k
                        END
                    i = i - 2
                    END
                QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " |-----------------------'"
                QUEUE "OUTPUT *** `-----------'"
                DROP i
                END
            WHEN ( TempClientArray.0 - 3 * TRUNC(TempClientArray.0 / 3) ) = 2 THEN DO
                i = 1
                IF TempClientArray.0 > 3 THEN DO
                    DO UNTIL i = TempClientArray.0 - 1
                        j = i + 1
                        k = i + 2
                        QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " | " || LEFT(TempClientArray.k,9) || " |"
                        i = i + 3
                        drop k
                        END
                    i = i - 2
                    END
                j = i + 1
                QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " |-----------'"
                QUEUE "OUTPUT *** `-----------------------'"
                DROP i j
                END
            END
        END
    RETURN

ListChannels: PROCEDURE EXPOSE clients. channels.
/* A client has requested a list of all users                */
    PARSE ARG index
    CALL RxQueue 'SET', clients.index.Q2client
    QUEUE "OUTPUT ***  ,-------------."
    QUEUE "OUTPUT *** | Channel List  `------------------------------------------------------."
    QUEUE "OUTPUT *** | Channel    | Topic                                            | Users |"
    QUEUE "OUTPUT *** |============|==================================================|=======|"
    IF channels.0 > 0 THEN DO i = 1 to channels.0
    QUEUE "OUTPUT *** | " || LEFT(channels.i.channelname,10) || " | " || LEFT(channels.i.topic,48) || " | " || LEFT(channels.i.users,5) || " |"
        END
    QUEUE "OUTPUT *** `-----------------------------------------------------------------------'"
    RETURN

SendClientHelp: PROCEDURE EXPOSE clients.
/* A client has requested help for commands                  */
    PARSE ARG index
    CALL RxQueue 'SET', clients.index.Q2client
    QUEUE "OUTPUT ***       ,----------------------------------------------------------."
    QUEUE "OUTPUT ***      |         REXXchat 1.0 alpha -- HELP FOR COMMANDS            |"
    QUEUE "OUTPUT ***      |============================================================|"
    QUEUE "OUTPUT ***      | <message>                 say something publically         |"
    QUEUE "OUTPUT ***      | /me <action>              do something (eg `/me jumps!')   |"
    QUEUE "OUTPUT ***      |                                                            |"
    QUEUE "OUTPUT ***      | /msg <nick> <message>     send a private message to <nick> |"
    QUEUE "OUTPUT ***      | /describe <nick> <action> send a private action to <nick>  |"
    QUEUE "OUTPUT ***      |                                                            |"
    QUEUE "OUTPUT ***      | /list                     list channels                    |"
    QUEUE "OUTPUT ***      | /join <channel>           join a channel (leaves current)  |"
    QUEUE "OUTPUT ***      | /leave [parting message]  leave current channel            |"
    QUEUE "OUTPUT ***      | /names                    list users in current channel    |"
    QUEUE "OUTPUT ***      | /topic [new topic]        show/set current channel's topic |"
    QUEUE "OUTPUT ***      |                                                            |"
    QUEUE "OUTPUT ***      | /nick <nickname>          change your nickname             |"
    QUEUE "OUTPUT ***      | /users                    list all users                   |"
    QUEUE "OUTPUT ***      | /clear                    clear screen                     |"
    QUEUE "OUTPUT ***      | /quit [parting message]   quit REXXchat                    |"
    QUEUE "OUTPUT ***      `------------------------------------------------------------'"
    RETURN

ClientQuit: PROCEDURE EXPOSE clients. channels.
/* A client wishes to quit, and must be removed from the     */
/* array of clients.                                         */
    PARSE ARG index partingmessage
    IF partingmessage = '' THEN partingmessage = 'Leaving'
    /*SAY "User number" index "(" || clients.index.nick || ") requests to leave REXXchat."*/
    IF clients.index.channel <> '' THEN
        /*SAY "User number" index "(" || clients.index.nick || ") must leave channel" clients.index.channel "first."*/
        CALL ClientLeaveChannel index partingmessage
    CALL RxQueue 'SET', clients.index.Q2Client
    QUEUE 'OUTPUT *** You have quit ('partingmessage').'
    QUEUE 'ENDSESSION'
    CALL RxQueue 'DELETE', clients.index.Q2Server
    nickname = clients.index.nick
    IF index = clients.0 THEN DO
        DROP clients.index.Q2Client clients.index.Q2Server clients.index.Nick clients.index.channel
        END
    ELSE DO
        DO i = index to clients.0
            j = i + 1
            clients.i.Q2Client = clients.j.Q2Client
            clients.i.Q2Server = clients.j.Q2Server
            clients.i.Nick     = clients.j.Nick
            clients.i.channel  = clients.j.channel
            END
        DROP clients.i.Q2Client clients.i.Q2Server clients.i.Nick clients.i.channel
        DROP clients.j.Q2Client clients.j.Q2Server clients.j.Nick clients.j.channel
        DROP i j
        END
    clients.0 = ( clients.0 ) - 1
    CALL PostSystemMessage nickname 'has left REXXchat ('partingmessage')'

    RETURN

SYNTAX:
    /*CALL RxQueue 'DELETE', MaintenanceQueue
    CALL PostSystemMessage 'SERVER CRASH! KILL YOUR TELNET SESSION NOW.'*/
    SAY
    SAY "Abnormal program interruption!"
    SAY 'A SYNTAX condition was raised on line' sigl'!'
    SAY '  The error number is' rc', which means "'Errortext(rc)'"'
    SAY '  That line is "'Sourceline(sigl)'"'
    SAY '  Entering DEBUG mode.'
    TRACE ?R
    Nop
    SIGNAL END
HALT:
SERVEREND:
    SAY "Server Closing."
    CALL RxQueue 'DELETE', MaintenanceQueue

    SIGNAL END

END:
    EXIT(0)