LISTSERV.EXEC

/* LISTSERV group mailing program      */
/*                                     */
/* An NJE (bitnet/HNET) list server    */
/* for z/VM, VM/ESA and VM/SP          */
/*                                     */
/* copyright 2023-2024  by moshix      */
/*                                     */
/***************************************/
/* execute this from LISTSERV before starting the program            */
/* defaults set tell msgcmd msgnoh to remove host(user) in output    */

/* configuration parameters - IMPORTANT                               */

listservversion="0.2.0"  /* must be configured!                       */
timezone="CET"           /* adjust for your server IMPORTANT          */
localnode=""             /* localnode is now autodetected as 2.7.1    */
shutdownpswd="999999999" /* any user with this passwd shuts down srv  */
osversion="z/VM 7.2"     /* OS version for enquries and stats         */
typehost="z114"          /* what kind of machine                      */
hostloc  ="Moonbasea"    /* where is this machine                     */
sysopname="MOSHIX  "     /* who is the sysop for this listserv server */
sysopemail="m234xx@gmail" /* where to contact this systop             */
compatibility=3           /* 1 VM/SP 6, 2=VM/ESA 3=z/VM and up        */
sysopuser='MAINT'         /* sysop user who can force users out       */
sysopnode=translate(localnode) /* sysop node automatically set        */
debugmode=0               /* print debug info on LISTSERV console if 1*/
log2file=1                /* all calls to log also in LISTSERV LOG A  */
                          /* make sure to not run out of space !!!    */
federation=0              /* is this chat server federating with others? */


/*---------------CODE SECTION STARTS BELOW --------------------------*/
if relinit() /= 0 then signal xit   /* initialize listserv properly and run tests */

'PURGE RDR ALL'

/* Invoke WAKEUP first so it will be ready to receive msgs */
/* This call also issues a 'SET MSG IUCV' command.         */

/*'SET MSG IUCV' */
/*"WAKEUP +1 (IUCVMSG"  really needed??                    */

  'MAKEBUF'


/* if we are federating go initalize the federation now    */
if federation = 1 then call initfederation



/* In this loop, we wait for a message to arrive and       */
/* process it when it does.  If the "operator" types on    */
/* the console (rc=6) then leave the exec.                 */

/* ******************************************************* */
/* the forever loop below runs all the time and is the     */
/* processing loop for all incoming messages.              */
/* Since WAKEUP is a blocking call, this loop cannot really*/
/* every be overrun by too much load. All accumulated msgs */
/* just grow the buffer while this loop processes each     */
/* incoming mesasge. This makes it exceptionally reliable. */
/* ******************************************************* */

  Do forever;
     'wakeup +2 (CONS RDR NOREAD' /* QUIET wake up 2 min and also get memos */

 /*    parse pull text   */
    CurrentTime=Extime()
     select
        when Rc = 2 then do
           /* timer has expired */
           /*   CALL log('Checkout timer triggered at:  '||mytime()) */
           CurrentTime=Extime()
           end

        when Rc = 4 then do;   /* we have a mail coming in!  */
              CALL LOG('Incoming mail!')
              receivedmsgs= receivedmsgs + 1
                 /* Im only interested in files with CLASS=H so I query the reader to see
                    if there is something for me
                     try also for class H cp Q R CL H', */
                       'PIPE (name GET_SPOOL)',
                          '| cp Q R',
                          '| take last',
                          '| spec w2 1',
                          '| var SpId'
                       'PIPE (name CHECKRC)',
                          '| reader FILE' SpId,
                          '| stem PTERM.',
                          '| take last',
                          '| var check'
               call handlemail 'PTERM'
               call synclistdisk /* write subscribers db to disk */

          end /* of when */
        when Rc = 6 then
          signal xit
        otherwise
     end   /* of select */
 end;   /* of do forever loop  */

syntax:
call LOG("Error signal was triggered, rc: "||rc)
signal xit;

xit:
/* when its time to quit, come here    */

  'WAKEUP RESET';        /* turn messages from IUCV to ON    */
  'SET MSG ON'
  'DROPBUF'
exit;

errorhandler:
parse ARG msg            /* what error are we checking for/  */
if (msg = returnNJEmsg)  | (msg = returnNJEmsg2) | (msg = returnNJEmsg3) | ,
   (msg = returnNJEmsg4) | (msg= returnNJEmsg5) then return 1
else return 0

handlemail:
/* handle all incoming email
   first check if its a valid email from the headers
*/
  parse arg instem
  /* Copy STEM  */
  do i=0 to value(instem'.0')
     mail.i=value(instem'.'i)
  end
  lines=mail.0
  lastline=lines-2 /* it seems the last line is 2 before lines... */
  say '*** Lines in incoming mail: '||lines
  /* Print mail STEM  */
  do i=1 to mail.0
     say mail.i
  end
  say '*** content line of email: '||mail.lines

return

synclistdisk:
/* write subscriber list to disk, overwriting old db file each time */
return



handlemsg:
/* handle all incoming messages and send to proper method */
   parse ARG userid,node,msg
    origmsg=msg
    userid=strip(userid)
    node=strip(node)
    CurrentTime=Extime()
    umsg = translate(msg)  /* make upper case */
    umsg=strip(umsg)
if debugmode=1 then say "FIXX handlemsg func: USERID,NODE,MSG: "userid" @ "node": "msg
    /* below few lines: error handling                 */
    loopmsg=SUBSTR(umsg,1,10) /* extract RSCS error msg */
if errorhandler(loopmsg) > 1 then do
         if debugmode=1 then say "FIXX handlemsg func: errorhandle > 1"
         loopCondition = 1
         /* silently  drop message and don't process it */
         call log('Loop detector triggered for user:  '||userid||'@'||node)
         return
 end

   updbuff=1
   SELECT                             /* HANDLE MESSAGE TYPES  */
      when (umsg = "/WHO") then
           call sendwho userid,node
      when (umsg = "/SYSTEM") then
           call systeminfo userid,node
      when (umsg = "/STATS") then
           call sendstats userid,node
      when (umsg = "/LOGOFF") then do
           call logoffuser userid,node
           updbuff=0                              /* removed, nothing to update */
      end
      when (umsg = "/LOGOUT") then do
           call logoffuser userid,node
           updbuff=0                              /* removed, nothing to update */
      end
      when (umsg = "/LOGON") then do
           call logonuser  userid,node
  /*RMX    call enterRoom userid,node,'GENERAL'*/ /* enter default GENERAL room */
           updbuff=0                              /* already up-to-date */
      end
      when (umsg = "/LOGIN") then do
           call logonuser  userid,node
   /*RMX   call enterRoom userid,node,'GENERAL'*/ /* enter default GENERAL room */
           updbuff=0                              /* already up-to-date */
      end
      when (pos("/ROOMS",umsg)>0) then do
/*RMX      call ShowRooms userid,node  */
/*RMX*/    call helpuser userid,node
      end
      when (pos("/ROOM",umsg)>0) then do
/*RMX      call EnterRoom  userid,node,umsg  */
/*RMX*/    call helpuser userid,node
      end
      when umsg='/ECHO' then do
               'TELL' userid 'AT' node 'USER: 'userid' Node: 'node
      end
      when (umsg = "/HELP") then do
           call helpuser  userid,node
      end
      when (umsg = "/MENU") then do
           call helpuser  userid,node
      end
      when (umsg = "/BENCHMARK") then do
           call usrbenchmark userid,node
      end
      when (umsg = "/HELPME") then do
           call helpuser  userid,node
      end
      when (umsg = "/VERSION") then do
           call version   userid,node
      end
      when (umsg = "/VER") then do
           call version   userid,node
      end
      when (umsg = "/HISTORY") then do
           call history   userid,node
      end
      when (umsg = "/USERS") then do
           call users   userid,node
      end
      when (umsg = shutdownpswd) then do
           call  log( "Shutdown initiated by: "||userid||" at node "||node)
           signal xit
      end

      when left(umsg,1) = "/" then do
            call helpuser  userid,node
      end

      otherwise
           call sendchatmsg userid,node,origmsg
        end
   if updBuff=1 then call refreshTime currentTime,userid,node /* for each msg ! */
   call CheckTimeout currentTime
return



systeminfo:
/* send /SYSTEM info about this host  */
     parse ARG userid,node
     listuser = userid"@"node

   CurrentTime=Extime()
   call CheckTimeout currentTime

     parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
       with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
     cpu = right( cpu+0, 3)
    'TELL' userid 'AT' node '-> NJE node name        : 'localnode
    'TELL' userid 'AT' node '-> Relay chat version   : 'relaychatversion
    'TELL' userid 'AT' node '-> OS for this host     : 'osversion
    'TELL' userid 'AT' node '-> Type of host         : 'typehost
    'TELL' userid 'AT' node '-> Location of this host: 'hostloc
    'TELL' userid 'AT' node '-> Time Zone of RELAY   : 'timezone
    'TELL' userid 'AT' node '-> SysOp for this server: 'sysopname
    'TELL' userid 'AT' node '-> SysOp email addr     : 'sysopemail
    'TELL' userid 'AT' node '-> System Load          :'cpu'%'
    'TELL' userid 'AT' node '-> This system speed    :  'sysperf'sec -- IBM z114 0.25 sec'
    if compatibility > 2 then do
       page=paging()
       rstor=rstorage()
       cfg=configuration()
       lcpus=numcpus()
   /*  parse var mcpu mpage mcf mrstor mlcpus  */
      'TELL' userid 'AT' node '-> Pages/Sec            : 'page
      'TELL' userid 'AT' node '-> IBM Machine Type     : 'cfg
      'TELL' userid 'AT' node '-> Memory in LPAR or VM : 'rstor
      'TELL' userid 'AT' node '-> Number of CPUs       : 'lcpus
    end
     if compatibility > 2 then do
     totmessages = totmessages + 14
     end
    else do
     totmessages = totmessages + 10
    end
return

usrbenchmark:
/* send to user a fuller benchmark suite */
    parse ARG userid,node
  'TELL' userid 'AT' node '-> Benchmark Overiew (smaller number is better)'
  'TELL' userid 'AT' node '-> --------------------------------------------'
  'TELL' userid 'AT' node '->                  '
  'TELL' userid 'AT' node '-> In seconds:      '

  'TELL' userid 'AT' node '-> This system                   :  'sysperf
  'TELL' userid 'AT' node '-> IBM z114                      :  0.225'
  'TELL' userid 'AT' node '-> IBM zEC12                     :  0.230'
  'TELL' userid 'AT' node '-> IBM z/PDT on Xeon 3.5Ghz      :  0.850'
  'TELL' userid 'AT' node '-> IBM z/PDT on Xeon 2.4Ghz      :  1.250'
  'TELL' userid 'AT' node '-> Hyperion 4.4 on Xeon 3.5Ghz   :  8.800'
  'TELL' userid 'AT' node '-> Hyperion 4.4 on Xeon 2.1Ghz   : 12.010'
  totmessages = totmessages + 11
return 0



sendstats:
/* send usage statistics to whoever asks, even if not logged on */
    parse ARG userid,node

     parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
       with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
     cpu = right( cpu+0, 3)
    actualtime=Extime()
    elapsedsec=(actualtime-starttimeSEC)
    if elapsedsec = 0 then elapsedsec = 1 /* avoid division by zero on Jan 1 at 00:00 */

    msgsrate = (receivedmsgs + totmessages) / elapsedsec
    msgsratef= FORMAT(msgsrate,4,2) /* rounding */
    msgsratef = STRIP(msgsratef)
    listuser = userid"@"node
    'TELL' userid 'AT' node '-> Total number of users       : '@size()
    'TELL' userid 'AT' node '-> Highest nr.  of users       : 'highestusers
    'TELL' userid 'AT' node '-> Total number of msgs        : 'totmessages
    'TELL' userid 'AT' node '-> Messages rate /second       : 'msgsratef
    'TELL' userid 'AT' node '-> Server up since             : 'starttime' 'timezone
    'TELL' userid 'AT' node '-> System CPU load             : 'STRIP(cpu)'%'
    'TELL' userid 'AT' node '-> RELAY CHAT version          : v'relaychatversion


     if lastmsgreceived /= 0 then do               /* did we ever get any real chat msg? */
        lastno=Extime()
        sincelast=(lastno-lastmsgreceived)        /* how many sec since last msg */
        'TELL' userid 'AT' node '-> Seconds since last chat msg : 'sincelast
        'TELL' userid 'AT' node '-> Last chat msg by user       : 'lastmsgwho
     end

     if lastmsgreceived /= 0 then do             /* did we ever get any real chat msg? */
        totmessages = totmessages+ 9
     end
      else totmessages = totmessages+ 7

     call writestats                               /* write stats to disk for now */
return

helpuser:
/* send help menu */
  parse ARG userid,node
  listuser = userid"@"node


'TELL' userid 'AT' node '.  __    ____  ___  ____  ___  ____  ____  _  _ '
'TELL' userid 'AT' node '. (  )  (_  _)/ __)(_  _)/ __)( ___)(  _ \( \/ )'
'TELL' userid 'AT' node '.  )(__  _)(_ \__ \  )(  \__ \ )__)  )   / \  / '
'TELL' userid 'AT' node '. (____)(____)(___/ (__) (___/(____)(_)\_)  \/  '
'TELL' userid 'AT' node '                                                '
'TELL' userid 'AT' node ' Welcome to LISTSERV   for z/VM,VM/ESA,VM/SP,MVS  V'relaychatversion
'TELL' userid 'AT' node '                                                                  '
'TELL' userid 'AT' node '/HELP      for this chat version'
'TELL' userid 'AT' node '/STATS     for chat statistics'
'TELL' userid 'AT' node '/SYSTEM    for info aobut this host'
'TELL' userid 'AT' node '/ECHO      send an echo to yourself                  '
'TELL' userid 'AT' node '/VERSION   for information about the current RELAY CHAT version'
'TELL' userid 'AT' node '/BENCHMARK for performance information about this server'
'TELL' userid 'AT' node '              '

  totmessages = totmessages + 13
return





version:
/* send to requestor the current RELAY CHAT version                */
  parse ARG userid,node
'TELL' userid 'AT' node '> RELAY CHAT for z/VM, VM/ESA, VM/SP, MVS 3.8 NJE   V'relaychatversion
totmessages = totmessages + 1
return


CheckTimeout:
/* Check if user has not sent any message, automatic LOGOFF */
   arg ctime
   cj=0 /* save logons to remove, else logon buffer doesn't match  */
   do ci=1 to words($.@)
      entry=word($.@,ci)
      if entry='' then iterate
      parse value entry with '/'cuser'@'cnode'('otime')'
/*    say cuser cnode ctime otime ctime-otime*/
      if ctime-otime > maxdormant then do  /* timeout per configuration */
         cj=cj+1
         $remove.cj=cuser','cnode
      end
   end
   do ci=1 to cj
       $remove.ci=cuser','cnode
/*    call logoffuser cuser,cnode   */
      interpret 'call logoffuser '$remove.ci
      call log($remove.ci||'logged off - timeout reached  after '||maxdormant|| ' seconds')
      silentlogoff=0 /* reset silent logoff to zero */
   end
return


refreshTime:
/* Refresh last transaction time */
 /*trace i    */
   arg ctime,userid,node
   listuser=userid'@'node
   ppos=pos('/'listuser,$.@)
   if ppos=0 then return              /* user not logged on */
   ppos=pos('(',$.@,ppos+1)           /* find timestamp */
   if ppos=0 then return              /* not found, let it be */
   rpos=pos(')',$.@,ppos+1)+1         /* find end of timestamp  */
   if rpos=0 then return              /* ) not found, let it be */
   rlen=rpos-ppos
   $.@=overlay('('ctime')',$.@,ppos,rlen)
return


exTime:
/* Calculate Seconds in this year */
  dd=(date('d')-1)*86400
  parse value time() with hh':'mm':'ss
  tt=hh*3600+mm*60+ss
return right(dd+tt,8,'0')


mytime: procedure
 timenow = left(time(),5)
 hr = left(timenow,2)
 min = right(timenow,2)
 if hr > 12 then timenow         = (hr - 12)'.'min' pm'
   else if hr = 12 then timenow  = hr'.'min' pm'
                    else timenow = hr'.'min' am'
 if left(timenow,1) = '0' then timenow = substr(timenow,2)
 dow     = left(date('weekday'),3)
 day     = right(date('sorted'),2)
 if left(day,1) = '0' then day = substr(day,2)
 month   = left(date('month'),3)
 year    = left(date('sorted'),4)
return timenow',' dow day month year


p:      return word(arg(1), 1)    /*pick the first word out of many items*/
sy:      say;
         say left('', 30) "   " arg(1) '   ';
         return
@init:   $.@=;
        @adjust: $.@=space($.@);
        $.#=words($.@);
        return
@hasopt: arg o;
        return pos(o, opt)\==0
@size:  return $.#

/*                                        */
@del:   procedure expose $.;
        arg k,m;
        call @parms 'km'
         _=subword($.@, k, k-1)   subword($.@, k+m)
         $.@=_;
         call @adjust;
        return

@get:    procedure expose $.;     arg k,m,dir,_
         call @parms 'kmd'
         do j=k  for m  by dir  while  j>0  &  j<=$.#
             _=_ subword($.@, j, 1)
        end   /*j*/
         return strip(_)

@parms:  arg opt      /*define a variable based on an option.*/
         if @hasopt('k')  then k=min($.#+1, max(1, p(k 1)))
         if @hasopt('m')  then m=p(m 1)
         if @hasopt('d')  then dir=p(dir 1);
         return

@put:    procedure expose $.;
            parse arg x,k;
            k=p(k $.#+1);
            call @parms 'k'
            $.@=subword($.@, 1, max(0, k-1))   x   subword($.@, k);
            call @adjust
         return

@show:   procedure expose $.;
            parse arg k,m,dir;
            if dir==-1  &  k==''   then k=$.#
            m=p(m $.#);
            call @parms 'kmd';
            say @get(k,m, dir);
         return

list:
/* this is only as examples how to use the double linked list
    for future expanesion of this program                      */
   call sy 'initializing the list.'            ;  call @init
   call sy 'building list: blue'               ;  call @put "blue"
   call sy 'displaying list size.'             ;  say  "list size="@size()
   call sy 'forward list'                      ;  call @show
   call sy 'backward list'                     ;  call @show ,,-1
   call sy 'showing 4th item'                  ;  call @show 4,1
   call sy 'showing 5th & 6th items'           ;  call @show 5,2
   call sy 'adding item before item 4: black'  ;  call @put "black",4
   call sy 'showing list'                      ;  call @show
   call sy 'adding to tail: white'             ;  call @put "white"
   call sy 'showing list'                      ;  call @show
   call sy 'adding to head: red'               ;  call @put  "red",0
   call sy 'showing list'                      ;  call @show
return


log:
/* general logger function                */
/* log a line to console and RELAY LOG A  */
   parse ARG  logline
   say mytime()' :: 'logline
   if log2file = 1 & compatibility > 0 then do
   address command
/*  'PIPE (name logit)',
     '| spec /'mytime()'/ 1 /::/ n /'logLine'/ n',
     '| >> RELAY LOG A'*/
   logline=mytime()||' :: '||logline
     'EXECIO 1 DISKW RELAY LOG A (STRING '||logline
     'FINIS RELAY LOG A'
   end
return

cpubusy:
/* how busy are the CPU(s) on this LPAR */
/* extract CPU buy information for stats etc. */
 cplevel = space(cp_id) sl
 strlen = length(cplevel)

 parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
        with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
 cpu = right( cpu+0, 3)
return cpu

paging:
/* how many pages per second is this LPAR doing? */
/* extra currenct OS paging activity */
 sl = c2d(right(diag(0), 2))
 cplevel = space(cp_id) sl
 strlen = length(cplevel)

 parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
        with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
return page

rstorage:
 parse value diag(8,"QUERY STORAGE")   with . . rstor rstor? . "15"x
return rstor

configuration:
/* return machine configuration */
/* extract machine type etc. */
 if compatibility > 2 then do
Parse Value Diag(8,'QUERY CPLEVEL') With ProdName .
     Parse Value Diag(8,'QUERY CPLEVEL') With uptime  , . . .  .  .  .  . ipltime


  Parse Value Diag(8,'QUERY CPLEVEL') With ProdName .
  Parse Value Diag(8,'QUERY CPLEVEL') With uptime  , . . .  .  .  .  . ipltime
  parse value stsi(1,1,1) with 49  type   +4 ,
                               81  seq   +16 ,
                              101  model +16 .

  parse value stsi(2,2,2) with 33 lnum   +2 ,  /* Partition number       */
                               39 lcpus  +2 ,  /* # of CPUs in the LPAR  */
                               45 lname  +8    /* partition name         */

  parse value stsi(3,2,2) with 39 vcpus  +2 ,  /* # of CPUs in the v.m.  */
                               57 cp_id +16

  parse value c2d(lnum) c2d(lcpus) c2d(vcpus) right(seq,5) lname model ,
         with     lnum      lcpus      vcpus        ser    lname model .

  blist = "- 2097 z10-EC 2098 z10-BC 2817 z196 2818 z114",
          "  2827 zEC12  2828 zBC12 2964 z13 2965 z13s"

  brand = strip(translate( word(blist, wordpos(type, blist)+1), " ", "-"))

end
return type

numcpus:
/* return number of CPUs in this LPAR */
  parse value stsi(1,1,1) with 49  type   +4 ,
                               81  seq   +16 ,
                              101  model +16 .

  parse value stsi(2,2,2) with 33 lnum   +2 ,  /* Partition number       */
                               39 lcpus  +2 ,  /* # of CPUs in the LPAR  */
                               45 lname  +8    /* partition name         */

  parse value stsi(3,2,2) with 39 vcpus  +2 ,  /* # of CPUs in the v.m.  */
                               57 cp_id +16

  parse value c2d(lnum) c2d(lcpus) c2d(vcpus) right(seq,5) lname model ,
         with     lnum      lcpus      vcpus        ser    lname model .

  blist = "- 2097 z10-EC 2098 z10-BC 2817 z196 2818 z114",
          "  2827 zEC12  2828 zBC12 2964 z13 2965 z13s 1090 zPDT 3096 z14"

  brand = strip(translate( word(blist, wordpos(type, blist)+1), " ", "-"))


return lcpus



selftest:
/* Send myself an NJE message before starting up to see if all good */
        'DROPBUF'
       'TELL RELAY at 'localnode' TEST100'
       'wakeup (iucvmsg QUIET'   /* wait for a message         */
        parse pull text          /* get what was send          */
        parse var text type sender . nodeuser msg
        parse var nodeuser node '(' userid '):'
       'DROPBUF'
   if msg = "TEST100" then do
      return 0
   end
return -1

emptybuff:
/* empty NJE buffer before starting RELAY CHAT */

   'MAKEBUF'
  'wakeup (iucvmsg QUIET'   /* wait for a message         */
   parse pull text          /* get what was send          */
   parse var text type sender . nodeuser msg
   parse var nodeuser node '(' userid '):'
  'DROPBUF'
return 0

writestats:
/* WRITE STATS TO DISK */
if compatibility > 0 then do
address command
fileid='RELAY STATS A'
record=" "
record=mytime()||" :: totalmessages: "||totmessages||"  highestusers: "||highestusers
 'EXECIO 1 DISKW RELAY STATS A (STRING '||record
 'FINIS RELAY STATS A'
end
return




relinit:
/* this is the general RELAY CHAT init and setup testing function   */
/* it is executed early during RELAY chat start, must return 0     */
/* GLOBAL VARIABLES        pls adapt to your installation            */
                          /* RSCS error messages we need to catch    */
returnNJEmsg= "HCPMSG045E"/* messages returning for users not logged on */
returnNJEmsg2="DMTRGX334I"/* looping error message flushed         */
returnNJEmsg3="HCPMFS057I"/* RSCS not receiving message            */
returnNJEmsg4="DMTPAF208E"/* Invalid user ID message               */
returnNJEmsg5="DMTPAF210E"/* RSCS DMTPAF210E Invalid location      */

relaychatversion=listservversion /* make it compatible with allcode */
lastmsgreceived=0        /* log when last user message was recvd   */
lastmsgwho='NOBODY'      /* log which user sent last chat msg      */
totmessages  = 0         /* total number of msgs sent              */
correctmails = 0         /* number of correct mails received       */
receivedmails = 0        /* number of received mails correct and wrong */
otime = 0                /* overtime to log off users after n minutes */
starttime=mytime()       /*  for /SYSTEM                           */
starttimeSEC=ExTime()    /*  for msg rate  calculation             */
logline = " "            /* initialize log line                    */
receivedmsgs=0           /* number of messages received for stats and loop*/
msgrotator=1             /* this will rotate the 7 prev msgs       */
err1="currently NOT"
err2="to logon on"
err3="Weclome to RELAY chat"
err4="logged off now"
loopCondition = 0        /* when a loop condition is detected this will turn to 1 */
historypointer=1         /* pointer to last entry in history     */
ushistorypointer=1       /* pointer to last entry in user history*/

sysperf=0                /* /benchmark system performance (in sec) holder */


whoamiuser=""             /* for autoconfigure                        */
whoaminode=""
whomistack=""
call whoami               /* who the fahma am I??                     */
say 'Hello, I am: '||whoamiuser||' at '||whoaminode||' with '||whoamistack

localnode=whoaminode   /* set localnode */

if compatibility > 2 then do /* must be z/VM       , ie min requirement VM level*/

     parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
       with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
 say 'All CPU avg: 'cpu '%     Paging: 'paging()

     say 'Machine type: 'configuration()'     RAM: 'rstorage()
     say 'Number of CPUs in LPAR: 'numcpus()
 END
     say '                        '
     say '****** LOG BELOW *******'

/* some simple logging  for stats etc        */
      CALL log('RELAY chat '||relaychatversion||' initializing...')


/* init double linked list of online users   */
call @init
 CALL log('List has been initialized.')
 CALL log('List size: '||@size())
if @size() /= 0 then do
   CALL log('Linked list init has failed! Abort ')
   signal xit;
end

/*
if emptybuff() < 0 then do
   CALL log('General error in draining buffer.  Abort!')
   signal xit;
end   */

/* warn upon certain config parm constellations     */

if log2file=1 then call log ("Logging to console AND RELAY LOG A. Keep enough disk space")
if send2ALL=0 then call log ("RELAY CHAT will send chats users in same room, send2ALL = 0")
if send2ALL=1 then call log ("RELAY CHAT will send chats to users, send2ALL=1")
if compatibility =1 then call log ("RELAY CHAT starting in VM/SP mode")
if compatibility =2 then call log ("RELAY CHAT starting in VM/ESA mode")
if compatibility =3 then call log ("LISTSERV  starting in z/VM mode")
if compatibility =-1 then call log ("LISTSERV  starting in MVS/3.8NJE mode")
if debugmode = 0 then call log ("Debug mode is turned OFF")
if debugmode = 1 then call log ("Debug mode is turned ON")


/*-------------------------------------------*/
/*  signal on syntax*/
/* now run a quick self test to see if NJE is working (RSCS up?) before continuing
if selftest() < 0 then do
 CALL log('NJE Self Test failed. RSCS not running or previous messages in buffer...')
end
else do
 CALL log('NJE Self Test passed...')
end */

 CALL log('Depth of history for this run: '||history.0)

 CALL LOG ('Starting relative system benchmarking')
 sysperf=benchmark()
 call LOG ('This system 8x8 benchmark in sec: '||sysperf||'  -- IBM z114 M05: 0.25 sec')
 call LOG ('System solution should show 92: '||bsolution)

 CALL log('********** LISTSERV  START **********')
 say ' .                                               '
 say ' .  __    ____  ___  ____  ___  ____  ____  _  _ '
 say ' . (  )  (_  _)/ __)(_  _)/ __)( ___)(  _ \( \/ )'
 say ' .  )(__  _)(_ \__ \  )(  \__ \ )__)  )   / \  / '
 say ' . (____)(____)(___/ (__) (___/(____)(_)\_)  \/  '
 say '  Welcome to LISTSERV FOR r z/VM,VM/ESA,VM/SP,MVS/3.8 NJE  -  V'relaychatversion
 say ''
return 0

benchmark:
/* benchmark relative system speed with nqueen problem 8x8 */
elp=time('E')
bsolution=queen(8,1)
elp=Trunc(time('e')-elp,3) /* number of seconds */
return elp

QUEEN: PROCEDURE expose count
 parse arg n,noprint
 chess.0=copies('. + ',n%2)
 chess.1=copies('+ . ',n%2)
 chessAl='a b c d e f g h i j k l m n o p q r s t u v x y z'
 count = 0
 k = 1
 a.k = 0
 do while k>0
    a.k = a.k + 1
    do while a.k<= n & place(k) =0
       a.k = a.k +1
    end
    if a.k > n then k=k-1
    else do   /* a.k <= n */
       if k=n then do
          count=count+1
       end
       else do
          k=k+1
          a.k=0
       end
    end
end
return count

whoami:
/* determine node name */
"id (stack"
pull whoamiuser . whoaminode . whoamistack
whoamistack=LEFT(whoamistack,5)
return

selftest:
/* Send myself an NJE message before starting up to see if all good */
        'DROPBUF'
       'TELL RELAY at 'localnode' TEST100'
       'wakeup (iucvmsg QUIET'   /* wait for a message         */
        parse pull text          /* get what was send          */
        parse var text type sender . nodeuser msg
        parse var nodeuser node '(' userid '):'
       'DROPBUF'
   if msg = "TEST100" then do
      return 0
   end
return -1










place: procedure expose a. count
/* place queens on chess board for /benchmark command */
 parse arg ps
 do i=1 to ps-1
    if a.i = a.ps then return 0
    if abs(a.i-a.ps)=(ps-i) then return 0
 end
return 1

initfederation:
/* initializes nodes we are federating with               */
/* below configure all friendly nodes and update fnodes.0 */
fnodes.0=1
fnodes.1="zvm72msh"





return 0

/*  CHANGE HISTORY                                                   */
/*  V0.1    :  testing WAKEUP mechanism                              */
/*  V0.2    :  Parsing incoming emails into components               */