You are here: DBG/400>DBG400 Web>SourceCodeList>RpgleSource>RpgleDBG205R4 (26 May 2005, MartinRowe)EditAttach
H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT) DFTACTGRP(*NO)
H COPYRIGHT('Copyright (C) 2003 Martin Rowe <martin@dbg400.net>')
**********************************************************************************************
* DBG205R4: DASD monitor
* Copyright (C) 2003 Martin Rowe <martin@dbg400.net>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
**********************************************************************************************
* FILES:
**********************************************************************************************
**********************************************************************************************
* PROTOTYPES:
**********************************************************************************************
D RunCmd PR 1N
D Command 999 Options(*VARSIZE) Const
**********************************************************************************************
* ARRAYS:
**********************************************************************************************
* Message queue array
D P_MsgQueue S 20 Dim(50)
**********************************************************************************************
* DATA STRUCTURES:
**********************************************************************************************
D SDS
D SDS_Pgm 10
* Receiver value DS
D RcvrDS DS 68
D BytesAvail 10I 0
D BytesReturned 10I 0
D CurDateTime 8
D SystemName 8
D ElapsedTime 6
D RetrictState 1
D Reserved1 1
D PctProcUnit 10I 0
D JobsInSystem 10I 0
D PctPermAddr 10I 0
D PctTempAddr 10I 0
D SystemASP 10I 0
D PctSystemASP 10I 0
D TotAuxStorage 10I 0
D CurUnProStg 10I 0
D MaxUnProStg 10I 0
* Standard error code DS for API error handling
D Error_Code DS 272
D ErrBytesProvd 10I 0 Inz(0)
D ErrBytesAvail 10I 0 Inz(0)
D ErrExcept_ID 7
D ErrReserved 1
D ErrException 256
* Receiver value DS for user space header info (used in first call to QUSRTVUS)
D GenRcvrDS DS
D UserArea 64
D GenHdrSize 10I 0
D StrucLevel 4
D FormatName 8
D APIUsed 10
D CreateStamp 13
D InfoStatus 1
D SizeUsUsed 10I 0
D InpParmOff 10I 0
D InpParmSiz 10I 0
D HeadOffset 10I 0
D HeaderSize 10I 0
D ListOffset 10I 0
D ListSize 10I 0
D ListNumber 10I 0
D EntrySize 10I 0
* Type Definition for the JOBL0200 format.
D ListDataDS DS
D L_JobName 10
D L_JobUser 10
D L_JobNbr 6
D L_JobIdent 16
D L_Status 10
D L_JobType 1
D L_JobSubTy 1
D L_Reserved 2
D L_JobInfoSts 1
D L_Reserved2 3
D L_NbrFldsRtn 10I 0
* Repeated section for each key
D L_Variable 2000
*
D Key1Info DS 20
D L_LenInfoRtn1 10I 0
D L_KeyFld1 10I 0
D L_DataType1 1
D L_Reservedx1 3
D L_LenDataRtn1 10I 0
D L_KeyValue1 10I 0
*
D Key2Info DS 20
D L_LenInfoRtn2 10I 0
D L_KeyFld2 10I 0
D L_DataType2 1
D L_Reservedx2 3
D L_LenDataRtn2 10I 0
D L_KeyValue2 4
* Message queue definition
D DS
D MsgQueue 20
D MsgQueName 10 Overlay(MsgQueue)
D MsgQueLib 10 Overlay(MsgQueue:11)
*
D PackAsChar DS
D PackedFld1 3P 0
D CharFld1 2 Overlay(PackedFld1)
**********************************************************************************************
* WORK FIELDS:
**********************************************************************************************
D Cumulative S 7 4
D CurrentEnt S 5P 0 Inz(1)
D DataLength S 10I 0 Inz(140)
D Difference S 7 4
D ExtendAttr S 10 Inz('USRSPC ')
D FirstTime S 1N Inz(*On)
D Flag S 3
D Format S 8
D Index S 10I 0
D InitialSiz S 10I 0 Inz(1024)
D InitialVal S 1 Inz(X'00')
D JobStatus S 10 Inz('*ACTIVE ')
D JobType S 1 Inz('*')
D KeyOffSet S 10I 0
D KeysToRtn S 10I 0 Dim(2)
D ListFormat S 8 Inz('JOBL0200')
D NbrToRtn S 10I 0 Inz(2)
D P_DtaqData S 1
D P_DtaqLen S 5 0
D P_DtaqLib S 10
D P_DtaqName S 10
D P_DtaqWait S 5 0
D P_ErrorID S 7
D P_MsgData S 512
D P_MsgDtaLn S 5 0
D P_MsgFile S 10
D P_MsgID S 7
D P_MsgQueLn S 5 0
D P_MsgType S 10
D P_MsgfLib S 10
D P_RplyMsgQ S 20
D peDiskIncrease S 5 2
D peDiskUse S 3 0
D peFrequency S 3 0
D peTempStorage S 5 0
D Percentage S 7 4
D PrevDiff S 7 4
D PrevPercent S 7 4
D PublicAut S 10 Inz('*ALL ')
D QualifyJob S 26 Inz('*ALL *ALL *ALL ')
D QualJob S 28 Varying
D RCVRLen S 10I 0
D ReplaceSpc S 10 Inz('*YES ')
D RstStsStat S 10
D SubstOffset S 10I 0 Inz(1)
D StartPos S 10I 0 Inz(1)
D TextDescrp S 50 Inz('User space for List Job API')
D ThresholdMb S 10I 0
D UserSpace S 20 Inz('DASDMON QTEMP ')
D MessageUsers S 50 DtaAra(DASDMON)
D WarnLevel S 2 0
**********************************************************************************************
* CONSTANTS:
**********************************************************************************************
D ActiveJobSts C Const(0101)
D TempStorage C Const(2009)
**********************************************************************************************
* FIELD RENAMES:
**********************************************************************************************
**********************************************************************************************
* ENTRY PARAMETERS:
**********************************************************************************************
C *entry PList
C Parm peFrequency
C Parm peDiskUse
C Parm peDiskIncrease
C Parm peTempStorage
**********************************************************************************************
* KEY LISTS:
**********************************************************************************************
**********************************************************************************************
* MAINLINE:
**********************************************************************************************
* Set program control from input parms
C Eval WarnLevel = peDiskUse
C Eval ThresholdMb = peTempStorage
C In MessageUsers
* Create a user space to hold the job list entries
C Call 'QUSCRTUS'
C Parm UserSpace
C Parm ExtendAttr
C Parm InitialSiz
C Parm InitialVal
C Parm PublicAut
C Parm TextDescrp
C Parm ReplaceSpc
C Parm Error_Code
*
B001 C Do *hival
* Do system status check first
C Call 'QWCRSSTS' 90
C Parm RcvrDS
C Parm 68 RCVRLen
C Parm 'SSTS0200' Format
C Parm '*NO' RstStsStat
C Parm Error_Code
* Set prev values for first time through (no need to warn in that case)
B002 C If FirstTime
C Eval PrevPercent = PctSystemASP / 10000
C Eval FirstTime = *Off
E002 C EndIf
C Eval Percentage = PctSystemASP / 10000
C Eval Difference = Percentage - PrevPercent
C Eval Cumulative = PrevDiff + Difference
B002 C If Cumulative > peDiskIncrease
C Or Difference > (peDiskIncrease / 2)
C Eval Flag = '***'
X002 C Else
C Eval Flag = ' '
E002 C EndIf
C Eval P_MsgData = 'System DASD used: ' +
C %Trim(%EditC(Percentage:'P')) +
C '%. Change since last check: ' +
C %Trim(%EditC(Difference:'P')) + '%' + Flag
* Place current DASD % and increase/decrease since last check in the audit log
C Clear P_MsgQueue
C Eval MsgQueName = 'DASDMON'
C Eval MsgQueLib = '*LIBL'
C Eval P_MsgQueue(1) = MsgQueue
C Eval P_MsgQueLn = 1
C ExSr Inform
* Warn if significant rise since last time
B002 C If Cumulative > peDiskIncrease
C Or Difference > (peDiskIncrease / 2)
C Eval P_MsgData = 'System storage use is ' +
C 'increasing. DSPMSG DASDMON to check.'
C ExSr SetMsgUsers
C ExSr Inform
E002 C EndIf
* Warn if over xx% storage
B002 C If Percentage > WarnLevel
C Eval P_MsgData = 'System storage over ' +
C %Char(WarnLevel) +
C '%. DSPMSG DASDMON to review history.'
C ExSr SetMsgUsers
C ExSr Inform
E002 C EndIf
C Eval PrevPercent = Percentage
C Eval PrevDiff = Difference
* Monitor for any jobs using too much temporary storage
C Eval KeysToRtn(1) = TempStorage
C Eval KeysToRtn(2) = ActiveJobSts
* List all the *ACTIVE jobs on the system
C Call 'QUSLJOB'
C Parm UserSpace
C Parm ListFormat
C Parm QualifyJob
C Parm JobStatus
C Parm Error_Code
C Parm JobType
C Parm NbrToRtn
C Parm KeysToRtn
* Get the header info for this space
C Call 'QUSRTVUS'
C Parm UserSpace
C Parm StartPos
C Parm DataLength
C Parm GenRcvrDS
C Parm Error_Code
* Check to see how many entries returned (ie. number of active jobs)
B002 C If ListNumber > 0
* Set the initial offset for the start of the list entries
C Eval ListOffset = ListOffset + 1
C Eval CurrentEnt = 1
* Loop through the entries held in the list section of the user space
B003 C DoW CurrentEnt <= ListNumber
* Get the header info for this space
C Call 'QUSRTVUS'
C Parm UserSpace
C Parm ListOffset
C Parm EntrySize
C Parm ListDataDS
C Parm Error_Code
* Get first key data
C Eval KeyOffSet = 1
C Eval Key1Info = %SubSt(L_Variable :
C KeyOffSet : 20)
* Get second key data
C Eval KeyOffSet = KeyOffSet + L_LenInfoRtn1
C Eval Key2Info = %SubSt(L_Variable :
C KeyOffSet : 20)
*
B004 C If L_KeyValue1 > ThresholdMb
C Eval QualJob = L_JobNbr + '/' +
C %Trim(L_JobUser) + '/' + %Trim(L_JobName)
* Hold job if using more than xxxx temp storage
B005 C If L_KeyValue2 <> 'HLD '
C CallP RunCmd('HLDJOB JOB(' + QualJob + ')')
C Eval P_MsgData = 'Job ' + L_JobNbr + '/' +
C %Trim(L_JobUser) + '/' + %Trim(L_JobName) +
C ' held.'
C ExSr SetMsgUsers
C ExSr Inform
E005 C EndIf
C Eval P_MsgData = 'Job ' + L_JobNbr + '/' +
C %Trim(L_JobUser) + '/' + %Trim(L_JobName) +
C ' has temporary storage of ' +
C %Trim(%EditC(L_KeyValue1: 'Z')) + 'Mb. '
C ExSr SetMsgUsers
C ExSr Inform
E004 C EndIf
* Bump up the counter & offset for the next entry
C Eval ListOffset = ListOffset + EntrySize
C Eval CurrentEnt = CurrentEnt + 1
E003 C EndDo
E002 C EndIf
* Wait x minutes before taking the next snapshot unless exit request received
C Eval P_DtaqWait = peFrequency * 60
C Call 'QRCVDTAQ'
C Parm 'DASDMON' P_DtaqName
C Parm '*LIBL' P_DtaqLib
C Parm 1 P_DtaqLen
C Parm *blanks P_DtaqData
C Parm P_DtaqWait
* Quit if requested
B002 C If P_DtaqData = 'Y'
C Leave
E002 C EndIf
E001 C EndDo
C Eval *INLR = *On
C Return
**********************************************************************************************
* SetMsgUsers: Set up the list of message queues to receive storage alerts
**********************************************************************************************
C SetMsgUsers BegSr
* Send alert messages to DASDMON & QSYSOPR by default
C Eval MsgQueName = 'DASDMON'
C Eval MsgQueLib = '*LIBL'
C Eval P_MsgQueue(1) = MsgQueue
C Eval P_MsgQueLn = 1
C Eval MsgQueName = 'QSYSOPR'
C Eval MsgQueLib = '*USER'
C Eval P_MsgQueue(2) = MsgQueue
C Eval P_MsgQueLn = 2
* Check for any other users to send alert messages to
B001 C Do 6 Index
B002 C If %SubSt(MessageUsers : SubstOffset : 10)
C <> *blanks
C Eval MsgQueName = %SubSt(MessageUsers :
C SubstOffset : 10)
C Eval MsgQueLib = '*USER'
C Eval P_MsgQueue(Index + 2) = MsgQueue
C Eval P_MsgQueLn = P_MsgQueLn + 1
C Eval SubstOffset = SubstOffset + 10
E002 C EndIf
E001 C EndDo
*
C EndSr
**********************************************************************************************
* Inform: Send Non-Program Message
**********************************************************************************************
C Inform BegSr
*
C Call 'DBG045R3'
C Parm 'CPF9898' P_MsgID
C Parm 'QCPFMSG ' P_MsgFile
C Parm '*LIBL ' P_MsgfLib
C Parm P_MsgData
C Parm 512 P_MsgDtaLn
C Parm '*INFO' P_MsgType
C Parm P_MsgQueue
C Parm P_MsgQueLn
C Parm P_RplyMsgQ
C Parm ' ' P_ErrorID
*
C EndSr
**********************************************************************************************
* PROCEDURES:
**********************************************************************************************
**********************************************************************************************
* RunCmd: Run a command via QCMDEXC & return the error flag
**********************************************************************************************
P RunCmd B
D RunCmd PI 1N
D Command 999 Options(*VARSIZE) Const
D RunCmdError S 1N
D P#CmdString S 999
D P#CmdLength S 15 5
C Eval P#CmdLength = %Len(%TrimR(Command))
C Call (E) 'QCMDEXC'
C Parm Command P#CmdString
C Parm P#CmdLength
C Eval RunCmdError = %ERROR
C Return RunCmdError
P E
**********************************************************************************************
Edit | Attach | Print version | History: r1 | Backlinks | View wiki text | Edit wiki text | More topic actions
Topic revision: r1 - 26 May 2005 - 19:58:03 - MartinRowe
Site Map
DBG400
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors. Ideas, requests, problems regarding DBG/400? Send feedback