RELAYVMSP.EXEC

/**RELAY EXEC CHAT PROGRAM             */
/*                                     */
/* An NJE (bitnet/HNET) chat server    */
/* for z/VM, VM/ESA and VM/SP          */
/*                                     */
/*                                     */
/*                                     */
/* copyright 2020, 2024  by moshix     */
/* All rights reserved                 */
/***************************************/

/* configuration parameters - IMPORTANT */
relaychatversion="2.8.0" /* needed for federation compatibility check      */
timezone="CDT"           /* adjust for your server IMPORTANT               */
maxdormant =  3000       /* max time user can be dormat                    */
localnode ="MOSHIX"      /* IMPORTANT configure your RSCS node here!!      */
shutdownpswd="12dfda189" /* any user who sends this pswrd shuts down server*/
osversion="VM/SP r5"     /* OS version for enquries and stats              */
typehost="Hercules"      /* what kind of machine                           */
hostloc  ="Gcloud IL"    /* where is this machine                          */
sysopname="Mmmmmm  "     /* who is the sysop for this chat server          */
sysopemail="madfaf@gmail"/* where to contact this systop                   */
compatibility=1          /* 1 VM/SP 6, 2=VM/ESA and up                     */
history.0=15             /* history goes back n  last chat lines           */
ushistory.0=15           /* user logon/logff history n entries             */
historypointer=1         /* pointer to last entry in history               */
ushistorypointer=1       /* pointer to last entry in user history          */
sentlast=''              /* last sent user to user message                 */


call console             /* start printing relevant info on console        */




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

  'SET MSG IUCV'
  "WAKEUP +0 (IUCVMSG"

  'MAKEBUF'
/* 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.                 */

  Do forever;
     'wakeup (iucvmsg QUIET'   /* wait for a message         */
     parse pull text          /* get what was send          */
     select
        when Rc = 5 then do;  /* we have a message          */
        /* parse it                                       */
           if pos('From', text) > 0 then  do  /* from RSCS   */
        /* format is like this:                           */
        /* *MSG    RSCS     From ZVM71X1(OPERATOR): hello */
              parse var text type sender . nodeuser msg
          /* break out the node and userid               */
              parse var nodeuser node '(' userid '):'
 CALL LOG('from: '||userid||' @ '||node||' > 'msg)
          call handlemsg  userid,node,msg
           end
           else do;  /* simple msg from local user  */
        /* format is like this:                           */
        /* *MSG    MAINT    hello                         */
              parse var text type userid msg
                   node = localnode
                  call handlemsg  userid,node,msg
           end
        end
        when Rc = 6 then
          signal xit
        otherwise
     end
 end;

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

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


handlemsg:
/* handle all incomign messages and send to proper method */
   parse ARG userid,node,msg
    userid=strip(userid)
    node=strip(node)
    CurrentTime=Extime()
   consolemsg=mytime()||'  'userid||' @ '||node||' : '||msg
    say consolemsg
   umsg = translate(msg)  /* make upper case */
   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 = "/LOGON") then do
           call logonuser  userid,node
           updbuff=0                    /* already up-to-date */
      end

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

      when (umsg = shutdownpswd) then do
           call  log( "Shutdown initiated by: "||userid||" at node "||node)
           signal xit
      end

      when (umsg = "/VERSION") 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 = "/LAST") then do
            call lastmsg userid,node
      end

      otherwise
           call sendchatmsg userid,node,msg
        end
   if updBuff=1 then call refreshTime currentTime,userid,node
   call CheckTimeout currentTime
return

sendchatmsg:
/* what we got is a message to be distributed to all online users */
    parse ARG userid,node,msg
    listuser = userid || "@"||node
    amsg=mytime()||'  'user||' @ '||node||' : '||msg
    sentlast=amsg

    if pos('/'listuser,$.@)>0 then do
      /*  USER IS ALREADY LOGGED ON */
             do ci=1 to words($.@)
                entry=word($.@,ci)
                if entry='' then iterate
                parse value entry with '/'cuser'@'cnode'('otime')'
                hmsg=mytime()||'  'cuser||' @ '||cnode||' : '||msg
                call inserthistory hmsg,historypointer
                if  historypointer < history.0 then historypointer=historypointer +1
                  if userid ?= cuser then do
                    'TELL' cuser 'AT' cnode '<> 'userid'@'node':'msg
                     totmessages = totmessages+ 1
                  end
             end
    end
       else do
          /* USER NOT LOGGED ON YET, LET'S SEND HELP TEXT */
            'TELL' userid 'AT' node 'You are currently NOT logged on.'
            'TELL' userid 'AT' node 'Wecome to RELAY chat for z/VM v'relaychatversion
            'TELL' userid 'AT' node '/HELP for help, or /LOGON to logon on'
            totmessages = totmessages + 3
       end

return

sendwho:
/* who is online right now on this system? */
   userswho = 0    /* counter for seen usres */
   parse ARG userid,node
   listuser = userid || "@"||node
   'TELL' userid 'AT' node '> List of currently logged on users:'
    totmessages = totmessages + 1
    do ci=1 to words($.@)
      entry=word($.@,ci)
      if entry='' then iterate
      parse value entry with '/'cuser'@'cnode'('otime')'
      lasttime=ctime-otime
      'TELL' userid 'AT' node '> ' cuser'@'cnode'  - last seen in min: 'lasttime
      totmessages = totmessages + 1
      userswho = userswho + 1
   end
  'TELL' userid 'AT' node '> Total online right now: 'userswho
   loggedonusers = userswho
  totmessages = totmessages + 1
return

logoffuser:
   parse ARG userid,node
   listuser = userid || "@"||node
   ppos=pos('/'listuser,$.@)
   if ppos=0 then do
           call log("User logoff rejected, not logged-on:  "||listuser)
      return
   end
   rpos=pos(' ',$.@,ppos+1)
   if rpos=0 then rpos=length($.@)+1
   rlen=rpos-ppos
   $.@=overlay(' ',$.@,ppos,rlen)
   $.@=space($.@)
   loggedonusers = loggedonusers - 1
  'TELL' userid 'AT' node '-> You are logged off now.'
  'TELL' userid 'AT' node '-> New total number of users: 'loggedonusers
   totmessages = totmessages + 2
   histuser=mytime()||" User: "userid||" @ "||node||" logged off"
   call insertusrhist histuser,ushistorypointer
   if  ushistorypointer < ushistory.0 then ushistorypointer=ushistorypointer +1

return

lastmsg:
/* show last message received with user date and time
   if no message has been received yet, say so */
parse ARG userid,node
listuser = userid || "@"||node

 totmessages = totmessages + 1

say 'sentlast contains: 'sentlast
if strip(sentlast) = '' then do
       'TELL 'userid' AT 'node '> No user message processed so far...'
       totmessages = totmessages + 1
end
else do
       'TELL 'userid' AT 'node '> Last message received: '
       'TELL 'userid' AT 'node '> 'sentlast
       totmessages = totmessages + 1
end

return


history:
/* show history of last 20 chat messages to /history or upon login */
  parse ARG userid,node

i=0
found=0
z=history.0
 'TELL 'userid' AT 'node '> Previous 'history.0' messages:'
 totmessages = totmessages + 1
do  i = 1 to z   by 1
   if history.i /= "" then do
       'TELL 'userid' AT 'node '> 'history.i
       totmessages = totmessages + 1
       found=found+1
   end
end
if found < 1 then 'TELL 'userid' AT 'node '> ...bummer... no chat history so far...'
       totmessages = totmessages + 1
return


users:
/* show history of last user logons/logoffs                        */
  parse ARG userid,node

i=0
found=0
z=ushistory.0
 'TELL 'userid' AT 'node 'Previous 'ushistory.0' user events: '
 totmessages = totmessages + 1
do  i = 1 to z by 1
   if ushistory.i /= "" then do
       'TELL 'userid' AT 'node '> 'ushistory.i
       totmessages = totmessages + 1
       found=found+1
   end
end
if found < 1 then 'TELL 'userid' AT 'node '> ...bummer... no events found so far.'
       totmessages = totmessages + 1
return


 logonuser:
 /* add user to linked list */
    parse ARG userid,node
    listuser = userid"@"node
    if pos('/'listuser,$.@)>0 then do
       call log("List already logged-on: "||listuser)
      'TELL' userid 'AT' node '-> You are already logged on.'
      'TELL' userid 'AT' node '-> total number of users: 'loggedonusers
    end
    else do
       if loggedonusers < 0 then loggedonusers = 0
       loggedonusers = loggedonusers + 1

       if highestusers < loggedonusers then highestusers = highestusers + 1

       call @put '/'listuser'('currentTime')'
       call log("List user added: "||listuser)
      'TELL' userid 'AT' node '-> LOGON succeeded.  '

      'TELL' userid 'AT' node '-> Total number of users: 'loggedonusers
       call announce  userid, node /* announce to all users  of new user */
       histuser=mytime()||" User: "userid||" @ "||node||" logged on "
       call insertusrhist histuser,ushistorypointer
       if  ushistorypointer < ushistory.0 then ushistorypointer=ushistorypointer +1

    end
    totmessages = totmessages+ 2
 return

systeminfo:
/* send /SYSTEM info about this host  */
     parse ARG userid,node
     listuser = userid"@"node
if compatibility > 1 then do
        parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
       with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
       cpu = right( cpu+0, 3)
   end
 else do
    cpu="NA"
 end

    '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         : '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'%'

    if compatibility > 1 then do
       call machine
       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 > 1 then do
     totmessages = totmessages + 12
     end
    else do
     totmessages = totmessages + 8
    end
return


sendstats:
/* send usage statistics to whoever asks, even if not logged on */
   parse ARG userid,node
    onlinenow = countusers(userid,node)
     if compatibility > 1 then do

        parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
               with 1 "AVGPROC-" cpu "%" 1 "PAGING-"  page "/"
        cpu = right( cpu+0, 3)
    end
   cpu=2
   if loggedonusers < 0 then loggedonusers = 0 /* still goes negative somtimes */

    listuser = userid"@"node
    'TELL' userid 'AT' node '-> Total number of users: 'onlinenow
    'TELL' userid 'AT' node '-> Hihgest nr.  of users: 'highestusers
    'TELL' userid 'AT' node '-> total number of msgs : 'totmessages
    'TELL' userid 'AT' node '-> Server up since      : 'starttime' 'timezone
    'TELL' userid 'AT' node '-> System CPU load      :  'cpu' %'
    'TELL' userid 'AT' node '-> RELAY CHAT version   :  'relaychatversion

     totmessages = totmessages+ 6
return

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


  'TELL' userid 'AT' node 'Welcome to RELAY CHAT for z/VM, VM/ESA, VM/SP v'relaychatversion
  'TELL' userid 'AT' node '--------------------------------------------------------'
  'TELL' userid 'AT' node '              '
  'TELL' userid 'AT' node '/HELP for this help'
  'TELL' userid 'AT' node '/WHO for connected users'
  'TELL' userid 'AT' node '/LOGON to logon to this chat room and start getting chat messages'
  'TELL' userid 'AT' node '/LOGOFF to logoff and stop getting chat messages'
  'TELL' userid 'AT' node '/STATS for chat statistics'
  'TELL' userid 'AT' node '/SYSTEM for info aobut this host'
  'TELL' userid 'AT' node '/VERSION to obtain the version of this RELAY CHAT system'
  'TELL' userid 'AT' node '              '
/* 'TELL' userid 'AT' node '/ROOM 1-9 to join any room, default is room zero (0)'*/
  'TELL' userid 'AT' node ' messages with <-> are incoming chat messages...'
  'TELL' userid 'AT' node ' messages with   > are service messages from chat servers'

  totmessages = totmessages + 12
return

countusers:
 parse ARG userid,node
 listuser = userid"@"node
  onlineusers = 0
   do ci=1 to words($.@)
     entry=word($.@,ci)
     if entry='' then iterate
     parse value entry with '/'cuser'@'cnode'('otime')'
     lasttime=ctime-otime
     onlineusers = onlineusers + 1
  end
return onlineusers

version:
/* send version number to user */
 parse ARG userid,node
 listuser = userid"@"node
 'TELL' userid 'AT' node ' > Version of this RELAY CHAT system: 'relaychatversion
 totmessages = totmessages + 1
return

announce:
/* announce newly logged on user to all users */
  parse ARG userid,node

  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')'
     'TELL' cuser 'AT' cnode '-> New user joined:    'userid' @ 'node
  end


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
         say 'removed user: 'cnode
         $remove.cj=cuser','cnode
      end
   end
   do ci=1 to cj
      interpret 'call logoffuser '$remove.ci
      call log($remove.ci||'logged off due to timeout reached '||maxdormant|| ' minutes')
      loggedonusers = loggedonusers -1
   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)
@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:
parse ARG  logline
say mytime()' :: 'logline
return

machine: procedure;

     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 "/"
     cpu = right( cpu+0, 3)

     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), " ", "-"))

     cfg = htopversion lcpus" CPUs" brand
     parse value diag(8,"QUERY STORAGE")   with . . rstor rstor? . "15"x
     if rstor? <> "" then     /* We have real storage */
       cfg = cfg " " rstor

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

 cpu = right( cpu+0, 3)
/*
 say 'All CPU avg: 'cpu '%     Paging: 'page

     say 'Machine type: 'cfg'     RAM: 'rstor
     say 'Number of CPU: in LPAR: 'lcpus*/
         /* indicators cpu page cfg rstor lcpus */


return

inithistory:
history.1=""
history.2=""
history.3=""
history.4=""
history.5=""
history.6=""
history.7=""
history.8=""
history.9=""
history.10=""
history.11=""
history.12=""
history.13=""
history.14=""
history.15=""
history.16=""
history.17=""
history.18=""
history.19=""
history.20=""

ushistory.1=""
ushistory.2=""
ushistory.3=""
ushistory.4=""
ushistory.5=""
ushistory.6=""
ushistory.7=""
ushistory.8=""
ushistory.9=""
ushistory.10=""
ushistory.11=""
ushistory.12=""
ushistory.13=""
ushistory.14=""
ushistory.15=""
ushistory.16=""
ushistory.17=""
ushistory.18=""
ushistory.19=""
ushistory.20=""
return 0

inserthistory:
/* insert history item and scroll */
parse ARG hmsg,pointer
if pointer < history.0 then do
 history.pointer = hmsg
end

if pointer >= history.0 then do
/* ok, we need to scroll up */

  do i = 1 to history.0
      d = i + 1
      history.i =history.d
  end
  history.z = hmsg/* insert msg at the bottom */
end
return 0

insertusrhist:
/* insert history item and scroll */
parse ARG huser,usrpointer
if usrpointer < ushistory.0 then do
 ushistory.usrpointer = huser
end

if usrpointer >= ushistory.0 then do
/* ok, we need to scroll up */

  do i = 1 to ushistory.0
      d = i + 1
      ushistory.i =ushistory.d
  end

  ushistory.z = huser /* insert user at bottom */
end
return 0

insertusrhist:
/* insert history item and scroll */
parse ARG huser,usrpointer
if usrpointer < ushistory.0 then do
 ushistory.usrpointer = huser
end

if usrpointer >= ushistory.0 then do
/* ok, we need to scroll up */

  do i = 1 to ushistory.0
      d = i + 1
      ushistory.i =ushistory.d
  end

  ushistory.z = huser /* insert user at bottom */
end
return 0


console:
/* start printing relevant info on console        */
if compatibility >1 then do /* this is not VM/SP 6, ie min requirement VM level*/
     sl = c2d(right(diag(0), 2))
     cplevel = space(cp_id) sl
     strlen = length(cplevel)
     say "CP LEVEL: "cplevel

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

     Parse Value Diag(8,'QUERY CPLEVEL') With ProdName .
     Parse Value Diag(8,'QUERY CPLEVEL') With uptime  , . . .  .  .  .  . ipltime
     say ProdName
     say 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), " ", "-"))

     cfg = htopversion lcpus" CPUs" brand
     parse value diag(8,"QUERY STORAGE")   with . . rstor rstor? . "15"x
     if rstor? <> "" then     /* We have real storage */
       cfg = cfg " " rstor

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

 cpu = right( cpu+0, 3)

 say 'All CPU avg: 'cpu '%     Paging: 'page

     say 'Machine type: 'cfg'     RAM: 'rstor
     say 'Number of CPU: in LPAR: 'lcpus
         /* indicators cpu page cfg rstor lcpus */

  END
/* global vars       */

loggedonusers = 0        /* online user at any given moment        */
highestusers = 0         /* most users online at any given moment  */
totmessages  = 0         /* total number of msgs sent */
otime = 0                /* overtime to log off users after n minutes */
starttime=mytime()       /* time this server started */
logline = " "            /* initialize log line      */

say 'Global variables initialized'

srtime=0
/* init double linked list of online users   */
call @init
if inithistory() = 0 then do               /* init history vars */
    SAY   'History initialization passed'
end
say ' '

say 'Server up since      : 'starttime' 'timezone

say 'NJE node name        : 'localnode
say 'Relay chat version   : 'relaychatversion
say 'OS for this host     : 'osversion
say 'Type of host         : 'typehost
say 'Location of this host: 'hostloc
say 'Time Zone of         : 'timezone
say ' '
say '******************************************************'
CALL     log('RELAY chat '||relaychatversion||' started. ')
say '******************************************************'
say ' '
return



/* Version history                                     */
/* v 2.7.0   Provide last message function /last       */
/* v 2.8.0   Better start info for console             */