Service Programs and Call Stack APIs

I’m a big fan of service programs. From a maintainability point of view, encapsulated procedures are great. And exported procedures, which mean you only need to develop any piece of functionality once, are even better.

However, I now find myself in the position of having to start creating a set of these from scratch (nothing to copy/paste) and, since they can be a bit fiddly, now seems like a good time to document the steps.

In the example that follows, I create a service program with a single procedure, RtvProgram, which returns the name of the program that called the service program. It sounds a bit recursive, I know, but bear with me. Whenever coding a display file (or a report, for that matter) I like to put the program name somewhere on the screen (top left, unless someone tells me otherwise). This means that when someone has a problem, we can very quickly identify what program they are talking about.

Obviously, hard-coding the program name in the display file would be easy. But code gets copied and pasted and, sooner or later, all hard coded values end up being wrong. I have also seen cases of one display file being used by two or more programs, so it is much better to put the program name in a field and retrieve it dynamically. That way, you are always getting the right program.

So on to the service program.

First, you need a copy member to contain the procedure prototype. You could, of course, code the prototype in each program that uses the service program, but that way madness lies.

In my case, I have created the copy member in QRPGLESRC and called it LSS001RP. It looks like this:

 * Retrieve Program Name
d RtvProgram      pr            10a   

And then you need to write the service program:

 * ---------------------------------------------------------------------- *
 * Program     : LSS001R                                                  *
 * Description : Program information service programs                     *
 * ---------------------------------------------------------------------- *
h nomain

 * ---------------------------------------------------------------------- *
 * Exportable Prototypes                                                  *
 * ---------------------------------------------------------------------- *
 /copy LSCLIB/qrpglesrc,lss001rp

 * ---------------------------------------------------------------------- *
 * API Prototypes                                                         *
 * ---------------------------------------------------------------------- *
d RtvCallStack    pr                  extpgm('QWVRCSTK')
d                             2000a
d                               10i 0
d                                8a
d                               56a
d                                8a
d                               15a

 * ---------------------------------------------------------------------- *
 * RtvProgram: Retrieve the program name                                  *
 * ---------------------------------------------------------------------- *
p RtvProgram      b                   export
d RtvProgram      pi            10a

d Var             ds          2000    qualified
d  BytAvl                       10i 0
d  BytRtn                       10i 0
d  Entries                      10i 0
d  Offset                       10i 0
d  Count                        10i 0

d JobID           ds                  qualified
d  QName                        26a   inz('*')
d  IntID                        16a
d  Res3                          2a   inz(*loval)
d  ThreadInd                    10i 0 inz(1)
d  Thread                        8a   inz(*loval)

d Entry           ds                  qualified
d  Length                       10i 0
d  Program                      10a   overlay(Entry: 25)
d  Library                      10a   overlay(Entry: 35)

d VarLength       s             10i 0 inz(%size(Var))
d RcvFormat       s              8a   inz('CSTK0100')
d JobIdFmt        s              8a   inz('JIDF0100')
d ApiError        s             15a
d i               s             10i 0

     RtvCallStack(Var: VarLength: RcvFormat: JobID: JobIdFmt : ApiError);
     for i = 1 to 2;
         Entry = %subst(Var: Var.Offset + 1);
         Var.Offset += Entry.Length;

     return Entry.Program;

p RtvProgram      e
 * ---------------------------------------------------------------------- * 

I’m not going to go into too much detail here. The service program LSS001R contains one procedure, RtvProgram which uses the QWVRCSTK API to retrieve the current call stack then it reads back two entries: The first entry is the service program and the second entry is the calling program. And this is the program name that it returns.

You now need to create the RPG Module. Note the terminology here — you are not creating a Bound RPG Program (it’s the difference between options 15 and 14 in PDM).

I also need the binding source. In this case, the member is called LSS001S and I have put it in the QSRVSRC source file. It looks like this:


Note that the capitalisation is actually important here.

And now I’m ready to create the service program:


Since I’m doing this from scratch, I need to create a binder directory:

CRTBNDDIR BNDDIR(LSCLIB/LSBNDDIR) TEXT('General purpose binding directory')

And add the service program to it:


And we’re ready to go. All I have to do now is make a couple of amendments to the main program to take advantage of the service program:

The control spec needs this line:

h bnddir('LSBNDDIR')                                                       

Obviously, I need to copy the prototype definition somewhere in the definition specification:

 /copy LSCLIB/qrpglesrc,lss001rp                                       

And when the program starts, I need to identify the name of the program:


     // Identify the current program
     program = RtvProgram();

And that’s it.

DSPOSRLS: Display Operating System Release

One of the surprisingly non-inuitive parts of the IBM i is that there is no easy way to identify what OS release your machine is on. Well, not if you don’t have enough authority to use DSPPTF.

A common approach is to use DSPDTAARA QSS1MRI which works, but isn’t officially supported. So this approach could stop working at any point and without notice.

The officially supported method is to use the QSZRTVPR (Retrieve Product Information) API. So I did.

DSPOSRLS is a simple command that retrieves and displays the current OS release level. I have posted the source on GitHub so feel free to browse or download it from there.

Display Program Locks: The quick way of finding who is using a program

Another week, another utility. I’m supporting an application which, among other things, includes the concept of Conflicting Programs. This works by attaching an Activity Level to each program – essentially a count of how many instances of that program are active. When someone launches a program, its Activity Level is incremented and when they exit the program its activity level is decremented.

Each program within the application also has a list of Conflicting Programs attached to it. When you try to launch a program, the activity level of each of its conflicting programs is checked and if any of these activity levels is not zero, the program will not start. Instead, you will see a message telling you which Conflicting Program is active.

It’s a simple and (usually) effective method of ensuring that end users can’t cause data discrepancies by executing tasks when they shouldn’t – you can’t start entering transactions when a month end close is in progress, for example. The problem is that the application can only tell you that a program is active – not who is using it. When someone is preventing you from starting the month close and going home by leaving a transaction entry screen open, identifying who is holding things up is something you want to be able to do as quickly as possible. This is where the Display Program Locks utility comes in.

What this utility does is scans the active jobs on the system and, for each one found, checks its call stack. If the offending program is found, the job is added to a list which is displayed on the screen. The screen handling is pretty basic, but sufficient for the environment in which I am using this utility.

Three source files are attached, for the Display File (DSPPGMLCKD.DSPF), the RPG (DSPPGMLCKR.RPGLE) and the Command Source (DSPPGMLCK.CMD). Feel free to take a look and, if you decide to download and compile it, you will be able to use the DSPPGMLCK command to find exactly who is using any given program.

As ever, comments, observations and improvements are always welcome.

More fun with APIs

So the application I mentioned on Monday was finally approved late yesterday and, today, it’s written and working. There were, inevitably enough, some changes to the spec. The application that has been approved can be executed once an outage has been started and will send a break message to any session still signed on that shouldn’t be, and generate a simple report so the operations folks can visit the offending users with a baseball bat.

This, in itself, wouldn’t be enough for me to bother reposting the code but since I also took the opportunity to develop the application in RPG (or Free Format ILE RPG if you want to be search engine friendly). Doing this gave me a great deal more flexibility over the earlier CL code and also allowed me to prototype the API names into something a lot more readable. You’ll see what I mean if you take a look at the code.

Again, I have filed off the serial numbers and you can take a look at the code here: Lockout.RPGLE

Feel free to copy it, compile it and modify it if it is of any use to you. And if you have any comments or observations, I’d love to hear them.

I do mean it about the baseball bat, though.

Using the QUSLJOB API to retrieve active jobs by user.

There are times (month end, for example) when you need to know which users of an application are signed on so you can respond accordingly. Reliably enough, the iSeries provides all the APIs you need to achieve this.

There are two APIs you need to know about:
QUSLJOB – List Job, generates a list of some or all jobs on the system. This information can be pushed into a user space.
QUSRTVUS – Retrieve User Space, pulls the information out of the user space.

The CL program, below the fold, shows these APIs in action. It does work, although it won’t make any changes – I’m still waiting for final approval to go ahead and write this – and I have filed off a few serial numbers to avoid copyright problems. Feel free to copy it, compile it and modify it according to your own needs. If you have any comments, feedback is always appreciated.

What the program does is read through a table of application users (USERTABLE) and, for each USERID, lists all active jobs for that user in a user space. A nested loop (at Label STEP01A) loops through each job found to retrieve the essential data.

What you do with this retrieved job information is up to you, but I’m thinking in terms of disabling the profile and ending the job.

Update: I’ve just noticed that copying and pasting the code into WordPress causes more than a few oddities in the rendering. So I’ve moved the code into a text file which you can download here: RtvActJob.CLLE