home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rxcht10a.zip / chatd.cmd < prev    next >
OS/2 REXX Batch file  |  1997-06-17  |  38KB  |  851 lines
  1. /*┌─────────────────────────────────────────────────────────────────────────┐*\
  2.  ┌┘ CHATD.CMD  Server layer of REXXchat, an Internet chat system for OS/2.  └┐
  3.  │                                                                           │
  4.  │      Product :       REXXchat Server                                      │
  5.  │      Author  :       Kevin Yank (kyank@ibm.net)                           │
  6.  │      Version :       1.0                                                  │
  7.  │      Date    :       17 June 1997                                         │
  8.  │      Revision:       First Version                                        │
  9.  │                                                                           │
  10.  └┐    FOR LICENSING, DISCLAIMER AND OTHER INFORMATION SEE REXXCHAT.INF     ┌┘
  11. \*└─────────────────────────────────────────────────────────────────────────┘*/
  12.  
  13. SIGNAL ON HALT
  14. SIGNAL ON SYNTAX
  15.  
  16. START:
  17.  
  18.     CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  19.     CALL SysLoadFuncs
  20.     CALL RxFuncAdd 'PopSleep', 'POPPLAY', 'PopSleep'
  21.  
  22. SERVERSTART:
  23.     
  24.     CALL SysCls
  25.     
  26.     SAY "REXXchat server starting up..."
  27.     
  28.     /* Check if another server is already running */
  29.     /* by checking for the existance of a queue   */
  30.     /* called REXXCHAT_MAINT.                     */
  31.     MaintenanceQueue = RxQueue('CREATE', 'REXXCHAT_MAINT')
  32.     IF MaintenanceQueue = 'REXXCHAT_MAINT' THEN DO
  33.         SAY "Maintenance queue created."
  34.         END
  35.     ELSE DO
  36.         SAY "Existing REXXchat server queue detected!"
  37.         /* Excess queue used in test is deleted as part */
  38.         /* of the SERVEREND process                     */
  39.         SIGNAL SERVEREND
  40.         END
  41.     
  42.     SAY "Server started. Press CTRL-C to close server."
  43.  
  44.     clients.0 = 0
  45.     channels.0 = 0
  46.     
  47.     /* Go into main server loop */
  48.     DO FOREVER
  49.         
  50.         /* Check for queued messages in the maintenance queue */
  51.         CALL RxQueue 'SET', MaintenanceQueue
  52.         IF Queued() > 0 THEN DO
  53.             PARSE PULL MaintenanceMessage MaintArg1 MaintArg2
  54.             /* Say "Got Message: "MaintenanceMessage MaintArg1 MaintArg2 MaintArg3 */
  55.             SELECT
  56.                 WHEN MaintenanceMessage = "NewClientRequest" THEN DO
  57.                     NewQueueToClient = MaintArg1
  58.                     NewNick = MaintArg2
  59.                     CALL RxQueue 'SET', NewQueueToClient
  60.                     IF NickIndex(NewNick) THEN
  61.                         QUEUE "BADNICK"
  62.                     ELSE DO
  63.                         /* NEW CLIENT REQUEST APPROVED!    */
  64.                         /* Create a Client -> Server Queue */
  65.                         NewQueueToServer = RxQueue('CREATE')
  66.                         QUEUE NewQueueToServer
  67.                         Index = ( clients.0 ) + 1
  68.                         clients.0 = Index
  69.                         clients.Index.Q2Server = NewQueueToServer
  70.                         clients.Index.Q2Client = NewQueueToClient
  71.                         clients.Index.Nick = NewNick
  72.                         clients.Index.Channel = ''
  73.                         CALL PostSystemMessage(NewNick "has entered REXXchat")
  74.                         DROP NewQueueToServer Index
  75.                         END
  76.                     DROP NewQueueToClient NewNick
  77.                     END
  78.                 OTHERWISE DO
  79.                     SAY "Invalid Message in Server Maintenance Queue!"
  80.                     SIGNAL SERVEREND
  81.                     END
  82.                 END
  83.             DROP MaintenanceMessage MaintArg1 MaintArg2
  84.             END
  85.         
  86.         IF clients.0 > 0 THEN
  87.             /* Check for queued messages in each client queue */
  88.             DO index = 1 to clients.0
  89.                 CALL RxQueue 'SET', clients.index.Q2Server
  90.                 IF Queued() > 0 THEN DO
  91.                     PARSE PULL ClientMessage ClientArg1
  92.                     /*Say "Got Message: "ClientMessage ClientArg1*/
  93.                     SELECT                        
  94.                         WHEN ClientMessage = "PRIVMSG" THEN DO
  95.                             PARSE VAR ClientArg1 TargetNick ' ' Msg
  96.                             /*SAY "Received private message for '"TargetNick"' from '"clients.index.Nick"'."*/
  97.                             CALL ClientPrivMsg clients.index.Nick TargetNick Msg
  98.                             DROP TargetNick Msg                            
  99.                             END
  100.                         WHEN ClientMessage = "PRIVDO" THEN DO
  101.                             PARSE VAR ClientArg1 TargetNick ' ' Msg
  102.                             /*SAY "Received private action for '"TargetNick"' from '"clients.index.Nick"'."*/
  103.                             CALL ClientPrivDo clients.index.Nick TargetNick Msg
  104.                             DROP TargetNick Msg                            
  105.                             END
  106.                         WHEN ClientMessage = "SAY" THEN DO
  107.                             CALL ClientSay index ClientArg1
  108.                             END
  109.                         WHEN ClientMessage = "DO" THEN DO
  110.                             CALL ClientDo index ClientArg1
  111.                             END
  112.                         WHEN ClientMessage = "JOINCHANNEL" THEN DO
  113.                             CALL ClientJoinChannel index ClientArg1
  114.                             END
  115.                         WHEN ClientMessage = "LEAVECHANNEL" THEN DO
  116.                             CALL ClientLeaveChannel index ClientArg1
  117.                             END
  118.                         WHEN ClientMessage = "CHANGETOPIC" THEN DO
  119.                             CALL ClientChangeTopic index ClientArg1
  120.                             END
  121.                         WHEN ClientMessage = "NICKCHANGEREQUEST" THEN DO
  122.                             CALL ClientChangeNick index ClientArg1
  123.                             END
  124.                         WHEN ClientMessage = "LISTUSERS" THEN DO
  125.                             Call ListUsers index
  126.                             END
  127.                         WHEN ClientMessage = "LISTCHANNELUSERS" THEN DO
  128.                             CALL ListChannelUsers index
  129.                             END
  130.                         WHEN ClientMessage = "LISTCHANNELS" THEN DO
  131.                             Call ListChannels index
  132.                             END
  133.                         WHEN ClientMessage = "HELP" THEN DO
  134.                             CALL SendClientHelp index
  135.                             END
  136.                         WHEN ClientMessage = "QUIT" THEN DO
  137.                             CALL ClientQuit index ClientArg1
  138.                             END
  139.                         OTHERWISE DO
  140.                             SAY "Invalid Message in Server Maintenance Queue!"
  141.                             SIGNAL SERVEREND
  142.                             END
  143.                         END
  144.                     DROP ClientMessage ClientArg1
  145.                     END
  146.                 END
  147.         
  148.         CALL PopSleep 250
  149.         END
  150.  
  151.     SIGNAL SERVEREND
  152.  
  153. NickIndex: PROCEDURE EXPOSE clients.
  154. /* Search for and return index of a nickname in the client array */
  155. /* Returns zero if nick not found                                */
  156.     PARSE UPPER ARG nickname
  157.     index = 0
  158.     IF clients.0 > 0 THEN DO i = 1 TO clients.0
  159.         if TRANSLATE(clients.i.Nick) = nickname THEN DO
  160.             index = i
  161.             LEAVE
  162.             END
  163.         END
  164.     RETURN index
  165.  
  166. ChannelIndex: PROCEDURE EXPOSE channels.
  167. /* Search for and return index of a channel in the channel array */
  168. /* Returns zero if channel not found                             */
  169.     PARSE UPPER ARG searchname
  170.     index = 0
  171.     IF channels.0 > 0 THEN DO i = 1 TO channels.0
  172.         if TRANSLATE(channels.i.channelname) = searchname THEN DO
  173.             index = i
  174.             LEAVE
  175.             END
  176.         END
  177.     RETURN index
  178.  
  179. PostSystemMessage: PROCEDURE EXPOSE clients.
  180. /* A system event or message must be sent to all clients */
  181.     PARSE ARG message
  182.     SAY "System Message: """Message"""."
  183.     IF CLIENTS.0 > 0 THEN DO i = 1 TO clients.0
  184.         CALL RxQueue 'SET', clients.i.Q2Client
  185.         QUEUE "OUTPUT *** "message
  186.         END
  187.     RETURN
  188.  
  189. ClientPrivMsg: PROCEDURE EXPOSE clients.
  190. /* A client sends a private message to another client */
  191.     PARSE ARG SourceNick TargetNick Msg
  192.     TargetIndex = NickIndex(TargetNick)
  193.     SourceIndex = NickIndex(SourceNick)
  194.     IF TargetIndex > 0 THEN DO
  195.         TargetNick = clients.Targetindex.nick /* Fixes case mismatches */
  196.         /* Message to Source */
  197.         headerlength = LENGTH('-> ' || TargetNick || ' ')
  198.         maxlinelength = 80 - headerlength
  199.         currentline = 0
  200.         message = Msg
  201.         DO UNTIL LENGTH(message) = 0
  202.             /* BUILD A LINE */
  203.             currentline = currentline + 1
  204.             messageline.currentline = message
  205.             if LENGTH( messageline.currentline ) < maxlinelength THEN DO
  206.                 message = ''
  207.                 END
  208.             ELSE DO
  209.                 BreakColumn = MaxLineLength + 1
  210.                 CharacterAtBreak = ''
  211.                 DO UNTIL CharacterAtBreak = ' '
  212.                     BreakColumn = BreakColumn - 1
  213.                     IF BreakColumn = 1 THEN DO
  214.                         BreakColumn = MaxLineLength + 1
  215.                         LEAVE
  216.                         END
  217.                     CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
  218.                     END
  219.                 messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
  220.                 message = STRIP(SUBSTR(message,BreakColumn),'Leading')
  221.                 END
  222.             /* FINISH BUILDING A LINE */
  223.             END
  224.         messagelines.0 = currentline
  225.         CALL RxQueue 'SET', clients.SourceIndex.Q2Client
  226.         DO j = 1 to messagelines.0
  227.         /* OUTPUT A LINE */
  228.             IF j = 1 THEN
  229.                 header = '-> ' || TargetNick || ' '
  230.             ELSE
  231.                 header = LEFT('',headerlength)
  232.             QUEUE "OUTPUT" header || messageline.j
  233.             /* FINISH OUTPUTTING A LINE */
  234.             END
  235.         /* Message to Target */
  236.         headerlength = LENGTH( '[' || SourceNick || '] ')
  237.         maxlinelength = 80 - headerlength
  238.         currentline = 0
  239.         message = Msg
  240.         DO UNTIL LENGTH(message) = 0
  241.             /* BUILD A LINE */
  242.             currentline = currentline + 1
  243.             messageline.currentline = message
  244.             if LENGTH( messageline.currentline ) < maxlinelength THEN DO
  245.                 message = ''
  246.                 END
  247.             ELSE DO
  248.                 BreakColumn = MaxLineLength + 1
  249.                 CharacterAtBreak = ''
  250.                 DO UNTIL CharacterAtBreak = ' '
  251.                     BreakColumn = BreakColumn - 1
  252.                     IF BreakColumn = 1 THEN DO
  253.                         BreakColumn = MaxLineLength + 1
  254.                         LEAVE
  255.                         END
  256.                     CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
  257.                     END
  258.                 messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
  259.                 message = STRIP(SUBSTR(message,BreakColumn),'Leading')
  260.                 END
  261.             /* FINISH BUILDING A LINE */
  262.             END
  263.         messagelines.0 = currentline
  264.         CALL RxQueue 'SET', clients.TargetIndex.Q2Client
  265.         DO j = 1 to messagelines.0
  266.         /* OUTPUT A LINE */
  267.             IF j = 1 THEN
  268.                 header = '[' || SourceNick || '] '
  269.             ELSE
  270.                 header = LEFT('',headerlength)
  271.             QUEUE "OUTPUT" header || messageline.j
  272.             /* FINISH OUTPUTTING A LINE */            
  273.             END
  274.         END
  275.     ELSE DO
  276.         CALL RxQueue 'SET', clients.SourceIndex.Q2Client
  277.         IF LENGTH("*** No such user as" TargetNick) > 80 THEN
  278.             TargetNick = SUBSTR(TargetNick,1,57) || '...'
  279.         QUEUE "OUTPUT *** No such user as" TargetNick
  280.         END
  281.     RETURN
  282.     
  283. ClientPrivDo: PROCEDURE EXPOSE clients.
  284. /* A client sends a private action to another client */
  285.     PARSE ARG SourceNick TargetNick Msg
  286.     TargetIndex = NickIndex(TargetNick)
  287.     SourceIndex = NickIndex(SourceNick)
  288.     IF TargetIndex > 0 THEN DO
  289.         TargetNick = clients.Targetindex.nick /* Fixes case mismatches */
  290.         /* Message to Source */
  291.         headerlength = LENGTH('-> ' || TargetNick || ' * ' || SourceNick || ' ')
  292.         maxlinelength = 80 - headerlength
  293.         currentline = 0
  294.         message = Msg
  295.         DO UNTIL LENGTH(message) = 0
  296.             /* BUILD A LINE */
  297.             currentline = currentline + 1
  298.             messageline.currentline = message
  299.             if LENGTH( messageline.currentline ) < maxlinelength THEN DO
  300.                 message = ''
  301.                 END
  302.             ELSE DO
  303.                 BreakColumn = MaxLineLength + 1
  304.                 CharacterAtBreak = ''
  305.                 DO UNTIL CharacterAtBreak = ' '
  306.                     BreakColumn = BreakColumn - 1
  307.                     IF BreakColumn = 1 THEN DO
  308.                         BreakColumn = MaxLineLength + 1
  309.                         LEAVE
  310.                         END
  311.                     CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
  312.                     END
  313.                 messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
  314.                 message = STRIP(SUBSTR(message,BreakColumn),'Leading')
  315.                 END
  316.             /* FINISH BUILDING A LINE */
  317.             END
  318.         messagelines.0 = currentline
  319.         CALL RxQueue 'SET', clients.SourceIndex.Q2Client
  320.         DO j = 1 to messagelines.0
  321.         /* OUTPUT A LINE */
  322.             IF j = 1 THEN
  323.                 header = '-> ' || TargetNick || ' * ' || SourceNick || ' '
  324.             ELSE
  325.                 header = LEFT('',headerlength)
  326.             QUEUE "OUTPUT" header || messageline.j
  327.             /* FINISH OUTPUTTING A LINE */
  328.             END
  329.         /* Message to Target */
  330.         headerlength = LENGTH( '* [' || SourceNick || '] ')
  331.         maxlinelength = 80 - headerlength
  332.         currentline = 0
  333.         message = Msg
  334.         DO UNTIL LENGTH(message) = 0
  335.             /* BUILD A LINE */
  336.             currentline = currentline + 1
  337.             messageline.currentline = message
  338.             if LENGTH( messageline.currentline ) < maxlinelength THEN DO
  339.                 message = ''
  340.                 END
  341.             ELSE DO
  342.                 BreakColumn = MaxLineLength + 1
  343.                 CharacterAtBreak = ''
  344.                 DO UNTIL CharacterAtBreak = ' '
  345.                     BreakColumn = BreakColumn - 1
  346.                     IF BreakColumn = 1 THEN DO
  347.                         BreakColumn = MaxLineLength + 1
  348.                         LEAVE
  349.                         END
  350.                     CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
  351.                     END
  352.                 messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
  353.                 message = STRIP(SUBSTR(message,BreakColumn),'Leading')
  354.                 END
  355.             /* FINISH BUILDING A LINE */
  356.             END
  357.         messagelines.0 = currentline
  358.         CALL RxQueue 'SET', clients.TargetIndex.Q2Client
  359.         DO j = 1 to messagelines.0
  360.         /* OUTPUT A LINE */
  361.             IF j = 1 THEN
  362.                 header = '* [' || SourceNick || '] '
  363.             ELSE
  364.                 header = LEFT('',headerlength)
  365.             QUEUE "OUTPUT" header || messageline.j
  366.             /* FINISH OUTPUTTING A LINE */            
  367.             END
  368.         END
  369.     ELSE DO
  370.         CALL RxQueue 'SET', clients.SourceIndex.Q2Client
  371.         IF LENGTH("*** No such user as" TargetNick) > 80 THEN
  372.             TargetNick = SUBSTR(TargetNick,1,57) || '...'
  373.         QUEUE "OUTPUT *** No such user as" TargetNick
  374.         END
  375.     RETURN
  376.     
  377. ClientSay: PROCEDURE EXPOSE clients.
  378. /* A client says something, so it is broadcast to the public */
  379.     PARSE ARG index message
  380.     nickname = clients.index.nick
  381.     if clients.index.channel = '' THEN DO
  382.         CALL RxQueue 'SET', clients.index.Q2Client
  383.         QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
  384.         END
  385.     ELSE IF CLIENTS.0 > 0 THEN DO
  386.         headerlength = LENGTH('<' || nickname || '> ')
  387.         maxlinelength = 80 - headerlength
  388.         currentline = 0
  389.         DO UNTIL LENGTH(message) = 0
  390.             /* BUILD A LINE */
  391.             currentline = currentline + 1
  392.             messageline.currentline = message
  393.             if LENGTH( messageline.currentline ) < maxlinelength THEN DO
  394.                 message = ''
  395.                 END
  396.             ELSE DO
  397.                 BreakColumn = MaxLineLength + 1
  398.                 CharacterAtBreak = ''
  399.                 DO UNTIL CharacterAtBreak = ' '
  400.                     BreakColumn = BreakColumn - 1
  401.                     IF BreakColumn = 1 THEN DO
  402.                         BreakColumn = MaxLineLength + 1
  403.                         LEAVE
  404.                         END
  405.                     CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
  406.                     END
  407.                 messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
  408.                 message = STRIP(SUBSTR(message,BreakColumn),'Leading')
  409.                 END
  410.             /* FINISH BUILDING A LINE */
  411.             END
  412.         messagelines.0 = currentline
  413.         DO i = 1 TO clients.0
  414.             IF clients.i.channel = clients.index.channel THEN DO
  415.                 CALL RxQueue 'SET', clients.i.Q2Client
  416.                 DO j = 1 to messagelines.0
  417.                     /* OUTPUT A LINE */
  418.                     IF j = 1 THEN DO
  419.                         if nickname = clients.i.nick THEN
  420.                             header = '<' || nickname || '> '
  421.                         ELSE
  422.                             header = '<' || nickname || '> '
  423.                         END
  424.                     ELSE
  425.                         header = LEFT('',headerlength)
  426.                     QUEUE "OUTPUT" header || messageline.j
  427.                     /* FINISH OUTPUTTING A LINE */
  428.                     END
  429.                 END
  430.             END
  431.         END
  432.     RETURN
  433.  
  434. ClientDo: PROCEDURE EXPOSE clients.
  435. /* A client does something, so it is broadcast to the public */
  436.     PARSE ARG index message
  437.     nickname = clients.index.nick
  438.     if clients.index.channel = '' THEN DO
  439.         CALL RxQueue 'SET', clients.index.Q2Client
  440.         QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
  441.         END
  442.     ELSE IF CLIENTS.0 > 0 THEN DO
  443.         headerlength = LENGTH('* ' || nickname || ' ')
  444.         maxlinelength = 80 - headerlength
  445.         currentline = 0
  446.         DO UNTIL LENGTH(message) = 0
  447.             /* BUILD A LINE */
  448.             currentline = currentline + 1
  449.             messageline.currentline = ''
  450.             messageline.currentline = message
  451.             if LENGTH( messageline.currentline ) < maxlinelength THEN DO
  452.                 message = ''
  453.                 END
  454.             ELSE DO
  455.                 BreakColumn = MaxLineLength + 1
  456.                 CharacterAtBreak = ''
  457.                 DO UNTIL CharacterAtBreak = ' '
  458.                     BreakColumn = BreakColumn - 1
  459.                     IF BreakColumn = 1 THEN DO
  460.                         BreakColumn = MaxLineLength + 1
  461.                         LEAVE
  462.                         END
  463.                     CharacterAtBreak = SUBSTR(messageline.currentline,BreakColumn,1)
  464.                     END
  465.                 messageline.currentline = SUBSTR(messageline.currentline,1,BreakColumn - 1)
  466.                 message = STRIP(SUBSTR(message,BreakColumn),'Leading')
  467.                 END
  468.             /* FINISH BUILDING A LINE */
  469.             END
  470.         messagelines.0 = currentline
  471.         DO i = 1 TO clients.0
  472.             IF clients.i.channel = clients.index.channel THEN DO
  473.                 CALL RxQueue 'SET', clients.i.Q2Client
  474.                 DO j = 1 to messagelines.0
  475.                     /* OUTPUT A LINE */
  476.                     IF j = 1 THEN DO
  477.                         if nickname = clients.i.nick THEN
  478.                             header = '* ' || nickname || ' '
  479.                         ELSE
  480.                             header = '* ' || nickname || ' '
  481.                         END
  482.                     ELSE
  483.                         header = LEFT('',headerlength)
  484.                     QUEUE "OUTPUT" header || messageline.j
  485.                     /* FINISH OUTPUTTING A LINE */
  486.                     END
  487.                 END
  488.             END
  489.         END
  490.     RETURN
  491.  
  492. ClientJoinChannel: PROCEDURE EXPOSE clients. channels.
  493. /* A client has requested to join a channel                  */
  494.     PARSE ARG index targetchannel
  495.     IF clients.index.channel <> '' THEN  /* Implicitly leave other channel */
  496.         call ClientLeaveChannel( index )
  497.     channelindex = ChannelIndex( targetchannel )
  498.     IF channelindex = 0 THEN DO
  499.         channels.0 = ( channels.0 ) + 1
  500.         channelindex = channels.0
  501.         channels.channelindex.channelname = targetchannel
  502.         channels.channelindex.users = 1
  503.         channels.channelindex.topic = 'No topic defined'
  504.         clients.index.channel = targetchannel
  505.         CALL RxQueue 'SET', clients.index.Q2Client
  506.         QUEUE "OUTPUT *** You have created channel" targetchannel
  507.         END
  508.     ELSE DO
  509.         targetchannel = channels.channelindex.channelname
  510.         channels.channelindex.users = ( channels.channelindex.users ) + 1
  511.         CALL RxQueue 'SET', clients.index.Q2Client
  512.         QUEUE "OUTPUT *** You have joined channel" targetchannel
  513.         QUEUE "OUTPUT *** Topic for" targetchannel || ":" channels.channelindex.topic
  514.         DO i = 1 TO clients.0
  515.             IF clients.i.channel = targetchannel THEN DO                
  516.                 CALL RxQueue 'SET', clients.i.Q2Client
  517.                 QUEUE 'OUTPUT *** ' || clients.index.nick || ' has joined channel' targetchannel
  518.                 END
  519.             END
  520.         END
  521.     clients.index.channel = targetchannel
  522.     RETURN
  523.  
  524. ClientLeaveChannel: PROCEDURE EXPOSE clients. channels.
  525. /* A client has requested to leave its present channel       */
  526.     PARSE ARG index partingmessage
  527.     if clients.index.channel = '' THEN DO
  528.         CALL RxQueue 'SET', clients.index.Q2Client
  529.         QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
  530.         END
  531.     ELSE DO
  532.         IF partingmessage = '' THEN partingmessage = 'Leaving'
  533.         ChannelToLeave = clients.index.channel
  534.         /*SAY "User number" index "(" || clients.index.nick || ") leaving channel" ChannelToLeave || "."*/
  535.         DO i = 1 TO clients.0
  536.             IF clients.i.channel = ChannelToLeave THEN DO
  537.                 if i = index THEN
  538.                     message = '*** You have left channel' ChannelToLeave '(' || partingmessage || ')'
  539.                 ELSE
  540.                     message = '*** ' || clients.index.nick || ' has left channel' ChannelToLeave '(' || partingmessage || ')'
  541.                 CALL RxQueue 'SET', clients.i.Q2Client
  542.                 QUEUE "OUTPUT" message
  543.                 END
  544.             END
  545.         clients.index.channel = ''
  546.         ChannelIndex = ChannelIndex( ChannelToLeave )
  547.         IF Channels.ChannelIndex.users = 1 THEN DO
  548.         /* Delete Channel */
  549.             IF ChannelIndex = channels.0 THEN DO
  550.                 DROP Channels.ChannelIndex.topic
  551.                 DROP Channels.ChannelIndex.users
  552.                 DROP Channels.ChannelIndex.channelname
  553.                 END
  554.             ELSE DO
  555.                 DO i = ChannelIndex to Channels.0
  556.                     j = i + 1
  557.                     Channels.i.users       = Channels.j.users
  558.                     Channels.i.ChannelName = Channels.j.ChannelName
  559.                     Channels.i.topic       = Channels.j.topic
  560.                     END
  561.                 DROP Channels.i.users Channels.i.ChannelName Channels.i.topic
  562.                 DROP Channels.j.users Channels.j.ChannelName Channels.j.topic
  563.                 DROP i j
  564.                 END
  565.             channels.0 = ( channels.0 ) - 1
  566.             END
  567.         ELSE DO
  568.             /* Remove user from channel */
  569.             Channels.ChannelIndex.users = ( Channels.ChannelIndex.users ) - 1
  570.             END
  571.         END
  572.     RETURN
  573.  
  574. ClientChangeTopic: PROCEDURE EXPOSE clients. channels.
  575. /* A client has changed the topic for a channel              */
  576.     PARSE ARG index newtopic
  577.     if clients.index.channel = '' THEN DO
  578.         CALL RxQueue 'SET', clients.index.Q2Client
  579.         QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
  580.         END
  581.     ELSE DO
  582.         channelindex = ChannelIndex( clients.index.channel )
  583.         if newtopic = '' THEN DO
  584.             CALL RxQueue 'SET', clients.index.Q2Client
  585.             QUEUE "OUTPUT *** Topic for " || clients.index.channel || ": " || channels.channelindex.topic
  586.             END
  587.         ELSE DO
  588.             channels.channelindex.topic = newtopic
  589.             DO i = 1 TO clients.0
  590.                 IF clients.i.channel = clients.index.channel THEN DO
  591.                     if i = index THEN DO
  592.                     message1 = '*** New topic set for channel ' || clients.index.channel
  593.                         END
  594.                     ELSE DO
  595.                         message1 = '*** ' || clients.index.nick || ' has set a new topic for channel ' || clients.index.channel
  596.                         END
  597.                     message2 = '*** Topic: ' || LEFT(channels.channelindex.topic,48)
  598.                 CALL RxQueue 'SET', clients.i.Q2Client
  599.                     QUEUE "OUTPUT" message1
  600.                     QUEUE "OUTPUT" message2
  601.                     END
  602.                 END
  603.             END
  604.         END
  605.     RETURN
  606.  
  607. ClientChangeNick: PROCEDURE EXPOSE clients. channels.
  608. /* A client has requested a new nickname                     */
  609.     PARSE ARG index newnick
  610.     IF newnick = clients.index.nick THEN DO
  611.         CALL RxQueue 'SET', clients.index.Q2Client
  612.         QUEUE "OUTPUT * That is already your nickname!"
  613.         END
  614.     ELSE IF NickIndex(newnick) THEN DO
  615.         CALL RxQueue 'SET', clients.index.Q2Client
  616.         QUEUE "OUTPUT * Nickname" newnick "is already in use."
  617.         END
  618.     ELSE DO
  619.         CALL RxQueue 'SET', clients.index.Q2Client
  620.         QUEUE "NICKCHANGED" NewNick
  621.         CALL PostSystemMessage( clients.index.nick "is now known as" newnick"." )
  622.         clients.index.nick = newnick
  623.         END
  624.     RETURN
  625.     
  626. ListUsers: PROCEDURE EXPOSE clients.
  627. /* A client has requested a list of all users                */
  628.     PARSE ARG index
  629.     CALL RxQueue 'SET', clients.index.Q2client
  630.     QUEUE "OUTPUT ***  ,----------------------."
  631.     QUEUE "OUTPUT *** | User List - ALL USERS  `---------------------------------------------."
  632.     QUEUE "OUTPUT *** | Nick       In Channel | Nick       In Channel | Nick       In Channel |"
  633.     QUEUE "OUTPUT *** |=======================|=======================|=======================|"
  634.     SELECT
  635.         WHEN ( clients.0 - 3 * TRUNC(clients.0 / 3) ) = 0 THEN DO
  636.             i = 1
  637.             IF clients.0 > 0 THEN DO UNTIL i = clients.0 + 1
  638.                 j = i + 1
  639.                 k = i + 2
  640.                 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) || " |"
  641.                 i = i + 3
  642.                 drop j k
  643.                 END
  644.             QUEUE "OUTPUT *** `-----------------------------------------------------------------------'"
  645.             DROP i
  646.             END
  647.         WHEN ( clients.0 - 3 * TRUNC(clients.0 / 3) ) = 1 THEN DO
  648.             i = 1
  649.             IF clients.0 > 3 THEN DO
  650.                 DO UNTIL i = clients.0
  651.                     j = i + 1
  652.                     k = i + 2
  653.                     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) || " |"
  654.                     i = i + 3
  655.                     drop j k
  656.                     END
  657.                 i = i - 2
  658.                 END
  659.             QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " |-----------------------------------------------'"
  660.             QUEUE "OUTPUT *** `-----------------------'"
  661.             DROP i
  662.             END
  663.         WHEN ( clients.0 - 3 * TRUNC(clients.0 / 3) ) = 2 THEN DO
  664.             i = 1
  665.             IF clients.0 > 3 THEN DO
  666.                 DO UNTIL i = clients.0 - 1
  667.                     j = i + 1
  668.                     k = i + 2
  669.                     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) || " |"
  670.                     i = i + 3
  671.                     drop k
  672.                     END
  673.                 i = i - 2
  674.                 END
  675.             j = i + 1
  676.             QUEUE "OUTPUT *** | " || LEFT(clients.i.nick,9) || "  " || LEFT(clients.i.channel,10) || " | " || LEFT(clients.j.nick,9) || "  " || LEFT(clients.j.channel,10) || " |-----------------------'"
  677.             QUEUE "OUTPUT *** `-----------------------------------------------'"
  678.             DROP i j
  679.             END
  680.         END
  681.     RETURN
  682.  
  683. ListChannelUsers: PROCEDURE EXPOSE clients.
  684. /* A client has requested a list of users in current channel */
  685.     PARSE ARG index
  686.     CALL RxQueue 'SET', clients.index.Q2client
  687.     if clients.index.channel = '' THEN DO
  688.         QUEUE "OUTPUT *** You are not in a channel! (/join <channelname>)"
  689.         END
  690.     ELSE DO
  691.         QUEUE "OUTPUT ***  ,----------------------."
  692.         QUEUE "OUTPUT *** | User List - " || LEFT(clients.index.channel,10) || " `---------."
  693.         QUEUE "OUTPUT *** | Nick      | Nick      | Nick      |"
  694.         QUEUE "OUTPUT *** |===========|===========|===========|"
  695.  
  696.         /* Build a list of users in current channel */
  697.         TempClientArray.0 = 0
  698.         DO i = 1 to clients.0
  699.             if clients.i.channel = clients.index.channel THEN DO
  700.                 TempClientArray.0 = ( TempClientArray.0 ) + 1
  701.                 newindex = TempClientArray.0
  702.                 TempClientArray.newindex = clients.i.nick
  703.                 drop newindex
  704.                 END
  705.             END
  706.  
  707.         SELECT
  708.             WHEN ( TempClientArray.0 - 3 * TRUNC(TempClientArray.0 / 3) ) = 0 THEN DO
  709.                 i = 1
  710.                 IF TempClientArray.0 > 0 THEN DO UNTIL i = TempClientArray.0 + 1
  711.                     j = i + 1
  712.                     k = i + 2
  713.                     QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " | " || LEFT(TempClientArray.k,9) || " |"
  714.                     i = i + 3
  715.                     drop j k
  716.                     END
  717.                 QUEUE "OUTPUT *** `-----------------------------------'"
  718.                 DROP i
  719.                 END
  720.             WHEN ( TempClientArray.0 - 3 * TRUNC(TempClientArray.0 / 3) ) = 1 THEN DO
  721.                 i = 1
  722.                 IF TempClientArray.0 > 3 THEN DO
  723.                     DO UNTIL i = TempClientArray.0
  724.                         j = i + 1
  725.                         k = i + 2
  726.                         QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " | " || LEFT(TempClientArray.k,9) || " |"
  727.                         i = i + 3
  728.                         drop j k
  729.                         END
  730.                     i = i - 2
  731.                     END
  732.                 QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " |-----------------------'"
  733.                 QUEUE "OUTPUT *** `-----------'"
  734.                 DROP i
  735.                 END
  736.             WHEN ( TempClientArray.0 - 3 * TRUNC(TempClientArray.0 / 3) ) = 2 THEN DO
  737.                 i = 1
  738.                 IF TempClientArray.0 > 3 THEN DO
  739.                     DO UNTIL i = TempClientArray.0 - 1
  740.                         j = i + 1
  741.                         k = i + 2
  742.                         QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " | " || LEFT(TempClientArray.k,9) || " |"
  743.                         i = i + 3
  744.                         drop k
  745.                         END
  746.                     i = i - 2
  747.                     END
  748.                 j = i + 1
  749.                 QUEUE "OUTPUT *** | " || LEFT(TempClientArray.i,9) || " | " || LEFT(TempClientArray.j,9) || " |-----------'"
  750.                 QUEUE "OUTPUT *** `-----------------------'"
  751.                 DROP i j
  752.                 END
  753.             END
  754.         END
  755.     RETURN
  756.  
  757. ListChannels: PROCEDURE EXPOSE clients. channels.
  758. /* A client has requested a list of all users                */
  759.     PARSE ARG index
  760.     CALL RxQueue 'SET', clients.index.Q2client
  761.     QUEUE "OUTPUT ***  ,-------------."
  762.     QUEUE "OUTPUT *** | Channel List  `------------------------------------------------------."
  763.     QUEUE "OUTPUT *** | Channel    | Topic                                            | Users |"
  764.     QUEUE "OUTPUT *** |============|==================================================|=======|"
  765.     IF channels.0 > 0 THEN DO i = 1 to channels.0
  766.     QUEUE "OUTPUT *** | " || LEFT(channels.i.channelname,10) || " | " || LEFT(channels.i.topic,48) || " | " || LEFT(channels.i.users,5) || " |"
  767.         END
  768.     QUEUE "OUTPUT *** `-----------------------------------------------------------------------'"
  769.     RETURN
  770.  
  771. SendClientHelp: PROCEDURE EXPOSE clients.
  772. /* A client has requested help for commands                  */
  773.     PARSE ARG index
  774.     CALL RxQueue 'SET', clients.index.Q2client
  775.     QUEUE "OUTPUT ***       ,----------------------------------------------------------."
  776.     QUEUE "OUTPUT ***      |         REXXchat 1.0 alpha -- HELP FOR COMMANDS            |"
  777.     QUEUE "OUTPUT ***      |============================================================|"
  778.     QUEUE "OUTPUT ***      | <message>                 say something publically         |"
  779.     QUEUE "OUTPUT ***      | /me <action>              do something (eg `/me jumps!')   |"
  780.     QUEUE "OUTPUT ***      |                                                            |"
  781.     QUEUE "OUTPUT ***      | /msg <nick> <message>     send a private message to <nick> |"
  782.     QUEUE "OUTPUT ***      | /describe <nick> <action> send a private action to <nick>  |"
  783.     QUEUE "OUTPUT ***      |                                                            |"
  784.     QUEUE "OUTPUT ***      | /list                     list channels                    |"
  785.     QUEUE "OUTPUT ***      | /join <channel>           join a channel (leaves current)  |"
  786.     QUEUE "OUTPUT ***      | /leave [parting message]  leave current channel            |"
  787.     QUEUE "OUTPUT ***      | /names                    list users in current channel    |"
  788.     QUEUE "OUTPUT ***      | /topic [new topic]        show/set current channel's topic |"
  789.     QUEUE "OUTPUT ***      |                                                            |"
  790.     QUEUE "OUTPUT ***      | /nick <nickname>          change your nickname             |"
  791.     QUEUE "OUTPUT ***      | /users                    list all users                   |"
  792.     QUEUE "OUTPUT ***      | /clear                    clear screen                     |"
  793.     QUEUE "OUTPUT ***      | /quit [parting message]   quit REXXchat                    |"
  794.     QUEUE "OUTPUT ***      `------------------------------------------------------------'"
  795.     RETURN
  796.     
  797. ClientQuit: PROCEDURE EXPOSE clients. channels.
  798. /* A client wishes to quit, and must be removed from the     */
  799. /* array of clients.                                         */
  800.     PARSE ARG index partingmessage
  801.     IF partingmessage = '' THEN partingmessage = 'Leaving'
  802.     /*SAY "User number" index "(" || clients.index.nick || ") requests to leave REXXchat."*/
  803.     IF clients.index.channel <> '' THEN
  804.         /*SAY "User number" index "(" || clients.index.nick || ") must leave channel" clients.index.channel "first."*/
  805.         CALL ClientLeaveChannel index partingmessage
  806.     CALL RxQueue 'SET', clients.index.Q2Client
  807.     QUEUE 'OUTPUT *** You have quit ('partingmessage').'
  808.     QUEUE 'ENDSESSION'
  809.     CALL RxQueue 'DELETE', clients.index.Q2Server
  810.     nickname = clients.index.nick
  811.     IF index = clients.0 THEN DO
  812.         DROP clients.index.Q2Client clients.index.Q2Server clients.index.Nick clients.index.channel
  813.         END
  814.     ELSE DO
  815.         DO i = index to clients.0
  816.             j = i + 1
  817.             clients.i.Q2Client = clients.j.Q2Client
  818.             clients.i.Q2Server = clients.j.Q2Server
  819.             clients.i.Nick     = clients.j.Nick
  820.             clients.i.channel  = clients.j.channel
  821.             END
  822.         DROP clients.i.Q2Client clients.i.Q2Server clients.i.Nick clients.i.channel
  823.         DROP clients.j.Q2Client clients.j.Q2Server clients.j.Nick clients.j.channel
  824.         DROP i j
  825.         END
  826.     clients.0 = ( clients.0 ) - 1
  827.     CALL PostSystemMessage nickname 'has left REXXchat ('partingmessage')'
  828.  
  829.     RETURN
  830.  
  831. SYNTAX:
  832.     /*CALL RxQueue 'DELETE', MaintenanceQueue
  833.     CALL PostSystemMessage 'SERVER CRASH! KILL YOUR TELNET SESSION NOW.'*/
  834.     SAY
  835.     SAY "Abnormal program interruption!"
  836.     SAY 'A SYNTAX condition was raised on line' sigl'!'
  837.     SAY '  The error number is' rc', which means "'Errortext(rc)'"'
  838.     SAY '  That line is "'Sourceline(sigl)'"'
  839.     SAY '  Entering DEBUG mode.'
  840.     TRACE ?R
  841.     Nop
  842.     SIGNAL END
  843. HALT:
  844. SERVEREND:
  845.     SAY "Server Closing."
  846.     CALL RxQueue 'DELETE', MaintenanceQueue
  847.  
  848.     SIGNAL END
  849.  
  850. END:
  851.     EXIT(0)