|
midrange.com
Have you tried this?
Callp(e) Die('Crush, kill, destroy...')
If %Error() // Die procedure ended in error.
Endif
(Sorry, you've had to have been a fan of the old Lost in Space show to
appreciate that one.)
You're problem is that you need to send the message to the control boundary
not *PRV or *SAME as we're used to. Use *CTLBDRY or whatever that value is,
in stead of '*' and see if it works.
-Bob Cozzi
www.RPGxTools.com
If everything is under control, you are going too slow.
- Mario Andretti
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of Rich Duzenbury
Sent: Thursday, March 17, 2005 1:13 PM
To: RPG400-L unknown
Subject: Proper way to die...
Hey all,
I'm trying to figure out the correct way to throw an exception from an
RPGLE program.
I'm working on a program where I need to use the profile handle api's to
become another user for a short time. Should any of the api calls fail,
I want to signal an exception, and if the new user is active, be sure
that it's priviliges get dropped.
(See test code below).
I'm calling QMHSNDPM to signal the exception, and I've wrapped it into a
procedure to make it easier to call, as in die('Uh-oh something bad
happened').
In the call to the send program message api, if I set the call stack
entry to '*', and the call stack count to 0, then the message is:
Message ID: RNQ0202
Type: Inquiry
Sev: 99
The call to 'DIE' ended in error.
RPG procedure ZZZ_PH in program LIB/ZZZ_PH at statement 9700 call
program or procedure DIE which ended in error.
This is not terrible, as the program and statement number are listed in
the second level text, BUT, I really need the message to be:
The call to ZZZ_PH ended in error.
Mainly because I might have a hundred programs using the die procedure,
and It would be much easier to debug if the _caller_ of die is listed in
the first level text.
So, I started playing around with the call stack entry and the call
stack count.
In the case where the call stack entry is the name of the program
('ZZZ_PH') and the call stack count is set to zero, I get the same
results as above, namely an RNQ0202 inquiry, sev 99, and the same text.
In the case where the call stack entry is the name of the program, and
the call stack count is set to one, I then receive a much different
result.
In this case, I receive no inquiry message, and the program returns to
the command line with the following error listed at the bottom of the
screen:
Message CEE9901
Type INFO
Application error. CPF9898 unmonitored by ZZZ_PH at statement *N,
instruction x'0000'.
Then application ended abnormally because an exception occurred and was
not handled.
So, what is the proper way to die, such that the _caller_ of the die
procedure is listed in the first level text? Can it be done?
Thank you.
h option(*srcstmt:*nodebugio) dftactgrp(*no) bnddir('QC2LE')
D userid s 10a
D password s 10a
D msg s 50a
D rc s 10i 0
D p_abend s * procptr
D token s *
D feedback s 12a
* Profile handle 1, our current profile handle
D ph1 ds qualified
D handle 12a
D loaded n
D active n
* Profile handle 2, our current profile handle
D ph2 ds qualified
D handle 12a
D loaded n
D active n
* universal api error data structure
D error ds qualified
D provided 10i 0
D available 10i 0
D msgid 7a
D rsvd 1a
D msgdta 80
* program status data structure
D sds sds qualified
D proc *proc
* get profile handle
D getph pr
extproc('QsyGetProfileHandle')
D handle 12a
D userid 10a const
D password 512a const options(*varsize)
D pw_length 10i 0 value
D pw_ccsid 10u 0 value
D error likeds(error)
* set profile handle
D setph pr
extproc('QsySetToProfileHandle')
D handle 12a
D error likeds(error)
* release profile handle
D rlsph pr
extproc('QsyReleaseProfileHandle')
D handle 12a
D error likeds(error)
* cancellation cleanup
D ceertx pr extproc('CEERTX')
D procedure * procptr
D token *
D feedback 12a
* local cleanup routine
D cleanup pr
D die pr
D message 512a const options(*varsize)
D whoami pr extpgm('ZZZ_WHOAMI')
C *entry plist
C parm userid
C parm password
/free
error.provided = %size(error);
// Install cancel handler. In the case that this code
// somehow crashes, this will ensure that cleanup is
// run and drops the priviliges of the passed in userid
p_abend = %paddr('CLEANUP');
ceertx(p_abend : token : feedback);
whoami();
// save our handle so we can restore it later
getph(ph1.handle : '*CURRENT' : '*NOPWD' : 6 : 0 : error);
if error.available > 0;
die('getph-nopwd Error: ' + error.msgid + ' ' +
error.msgdta);
endif;
ph1.loaded = '1';
ph1.active = '1';
// get the handle for the asked for userid/password
getph( ph2.handle : userid : password :
%len(%trim(password)) : 0 : error);
if error.available > 0;
die('getph-withpw Error: ' + error.msgid + ' ' +
error.msgdta);
endif;
ph1.loaded = '1';
// set profile to new handle
setph( ph2.handle : error);
if error.available > 0;
die('setph2 Error: ' + error.msgid +
' ' + error.msgdta);
endif;
ph1.active = '0';
ph2.loaded = '1';
ph2.active = '1';
whoami();
cleanup();
whoami();
*inlr = '1';
/end-free
*
**********************************************************************
* Cleanup the handles and return to base handle
**********************************************************************
*
P cleanup b
D cleanup pi
/free
dsply 'Cleaning up';
// return to original profile if necessary
if ph2.active = '1';
setph( ph1.handle : error);
ph1.active = '1';
ph2.active = '0';
endif;
if ph2.loaded = '1';
rlsph( ph2.handle : error);
ph2.loaded = '0';
endif;
if ph1.loaded = '1';
rlsph( ph1.handle : error);
ph1.loaded = '0';
endif;
/end-free
P e
*
**********************************************************************
* die - kill ourself
**********************************************************************
*
P die b
D die pi
D message 512a const options(*varsize)
D short_msg s 50a
D msgkey s 4a
D msgid c 'CPF9898'
D msgf c 'QCPFMSG *LIBL '
D sndpgmmsg pr extpgm('QMHSNDPM')
D msgid 7a const
D msgf 20a const
D msgdta 512a const options(*varsize)
D msgdtalen 10i 0 const
D msgtype 10a const
D callstkent 10a const
D callstkcnt 10i 0 const
D msgkey 4a
D error likeds(error)
/free
sndpgmmsg( 'CPF9898' : 'QCPFMSG *LIBL' :
%trim(message) : %len(%trim(message)) :
'*ESCAPE' :
sds.proc :
0 :
msgkey :
error);
/end-free
P e
--
Regards,
Rich
Current Conditions in Des Moines, IA
Overcast
Temp 51.8F
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
