|
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-2024 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.