Skip to content

Instantly share code, notes, and snippets.

@Faq400Git

Faq400Git/SPAWNTST1_RPGLE.TXT

Last active February 4, 2022 22:12
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Faq400Git/4a55c3ef8a2b098a9bdd9e7aec94130e to your computer and use it in GitHub Desktop.
Save Faq400Git/4a55c3ef8a2b098a9bdd9e7aec94130e to your computer and use it in GitHub Desktop.
Download ZIP
ILE RPG - Spawn and PASE test
Raw
SPAWN_H_RPGLE.TXT
* This source member contains all of the prototypes, data
* structures and constants needed for calling the spawn() API.
*
* Scott Klement, July 22, 2004
*
/if defined(SPAWN_H)
/eof
/endif
/define SPAWN_H
*-----------------------------------------------------------------
* Constants used by the spawn() API
*-----------------------------------------------------------------
D SPAWN_SETSIGMASK...
D C 2
D SPAWN_SETSIGDEF...
D C 4
D SPAWN_SETPGROUP...
D C 8
D SPAWN_SETTHREAD_NP...
D C 16
D SPAWN_SETPJ_NP...
D C 32
D SPAWN_SETCOMPMSG_NP...
D C 64
D SPAWN_SETJOBNAMEPARENT_NP...
D C 128
D SPAWN_FDCLOSED...
D C -1
D SPAWN_NEWPGROUP...
D C -1
D SPAWN_MAX_NUM_ARGS...
D C 255
*-----------------------------------------------------------------
* Flag used for the "options" parameter of the waitpid() API.
*-----------------------------------------------------------------
D WNOHANG C 1
*-----------------------------------------------------------------
* The inheritance structure tells the spawn() API which attributes
* should be inherited in the new job.
*
* struct inheritance {
* flagset_t flags;
* int pgroup;
* sigset_t sigmask;
* sigset_t sigdefault;
* };
*-----------------------------------------------------------------
D flagset_t S 10U 0 based(Template)
D pid_t S 10I 0 based(Template)
D sigset_t s 20U 0 based(Template)
D inheritance_t DS based(Template)
D flags like(flagset_t)
D pgroup like(pid_t)
D sigmask like(sigset_t)
D sigdefault like(sigset_t)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* spawn(): create a child process with inherited attributes
*
* pid_t spawn( const char *path,
* const int fd_count,
* const int fd_map[],
* const struct inheritance *inherit,
* char * const argv[],
* char * const envp[]);
*
* Returns the child's PID or -1 upon error
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
D spawn PR extproc('spawn') like(pid_t)
D path * value options(*string)
D fd_count 10I 0 value
D fd_map 10I 0 dim(256) options(*varsize:*omit)
D inherit likeds(inheritance_t)
D argv * dim(SPAWN_MAX_NUM_ARGS)
D options(*varsize)
D envp * dim(256) options(*varsize)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* spawnp(): create a child process with inherited attributes,
* find the child process using a PATH.
*
* pid_t spawnp( const char *path,
* const int fd_count,
* const int fd_map[],
* const struct inheritance *inherit,
* char * const argv[],
* char * const envp[]);
*
* Returns the child's PID or -1 upon error
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
D spawnp PR extproc('spawnp') like(pid_t)
D path * value options(*string)
D fd_count 10I 0 value
D fd_map 10I 0 dim(256) options(*varsize:*omit)
D inherit likeds(inheritance_t)
D argv * dim(SPAWN_MAX_NUM_ARGS)
D options(*varsize)
D envp * dim(256) options(*varsize)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* waitpid(): Wait for specific child process
*
* pid_t waitpid(pid_t pid, int *stat_loc, int options)
*
* This allows you to check the status of a spawned process, or
* wait for it to complete.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
D waitpid PR extproc('waitpid') like(pid_t)
D pid like(pid_t) value
D stat_loc 10I 0
D options 10I 0 value
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* pipe()--Create an Interprocess Channel
*
* int pipe(int fildes[2]);
*
* returns 0 if successful, -1 if there's an error (errno is set)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
d pipe PR 10I 0 ExtProc('pipe')
d fildes 10I 0 dim(2)
Raw
SPAWNTST1_RPGLE.TXT
* --------------------------------------------
* SPAWNTST1 Testing Scott Klement SPAWNPASE
* running some simple command and
* scripts in QP2SHELL environment
+
* Original code from Scott Klement (SPAWNPASE)
*
*
*
* This demonstrates connecting pipes to a spawned job, and
* using that spawned job to run a program in PASE. That way,
* you can catch the input/output from the PASE command,
* rather than allowing it to go the screen.
* Scott Klement, Sep 6, 2005
*
* To Compile:
* CRTBNDRPG SPAWNPASE SRCFILE(xxx/QRPGLESRC) DBGVIEW(*LIST)
*
H DFTACTGRP(*NO) BNDDIR('QC2LE')
FQSYSPRT O F 132 PRINTER OFLIND(*INOF)
/copy SRc,spawn_h
d close PR 10I 0 ExtProc('close')
d fildes 10I 0 value
D fdopen pr * extproc('fdopen')
D fildes 10I 0 value
D mode * value options(*string)
D fgets PR * ExtProc('_C_IFS_fgets')
D string * value
D size 10I 0 value
D stream * value
D fclose PR 10I 0 ExtProc('_C_IFS_fclose')
D stream * value
D ReportError PR
D OUTPUT_END C 1
D INPUT_END C 2
D pipein s 10I 0 dim(2)
D pipeout s 10I 0 dim(2)
D pipeerr s 10I 0 dim(2)
D ferr s *
D fout s *
D envvar s 100A dim(1)
D parm s 100A dim(4)
D argv s * dim(5) inz(*null)
D envp s * dim(2) inz(*null)
D inh ds likeds(Inheritance_T)
D fdmap s 10I 0 dim(3)
D pid s like(pid_t)
D buffer s 133A
D FirstTime s 1N INZ(*ON)
D p_buffer s *
D line s 132A varying
D
dcl-s TestNr int(5);
// ********************************************************
// Create pipes that will be connected to PASE's standard
// I/O streams (stdin, stdout, stderr)
// ********************************************************
pipe(pipein);
pipe(pipeout);
pipe(pipeerr);
// ********************************************************
// Tell the spawned job to use the above pipes for it's
// standard input, output and error.
// ********************************************************
envvar(1) = 'QIBM_USE_DESCRIPTOR_STDIO=Y' + x'00';
envp(1) = %addr(envvar(1));
envp(2) = *NULL;
fdmap(1) = pipein(OUTPUT_END);
fdmap(2) = pipeout(INPUT_END);
fdmap(3) = pipeerr(INPUT_END);
// ********************************************************
// Set up spawn() so that it'll run the QP2SHELL program
// which, in turn, will run the CP command in PASE
//
// The PASE command run here is:
// "/QOpenSys/usr/sbin/cp /home/klemscot/foo.zip /tmp/test.zip"
// ********************************************************
TestNr=3;
select;
// Coppy file in spawn
when TestNr=1;
parm(1) = '/QSYS.LIB/QP2SHELL.PGM' + x'00';
parm(2) = '/QopenSys/usr/bin/cp' + x'00';
parm(3) = '/www/apachedft/htdocs/index.html' + x'00';
parm(4) = '/www/apachedft/htdocs/index2.html' + x'00';
argv(1) = %addr(parm(1));
argv(2) = %addr(parm(2));
argv(3) = %addr(parm(3));
argv(4) = %addr(parm(4));
argv(5) = *NULL;
// ls List
when TestNr=2;
parm(1) = '/QSYS.LIB/QP2SHELL.PGM' + x'00';
parm(2) = '/QopenSys/usr/bin/ls' + x'00';
argv(1) = %addr(parm(1));
argv(2) = %addr(parm(2));
argv(3) = *NULL;
// cat a fixed text
when TestNr=3;
parm(1) = '/QSYS.LIB/QP2SHELL.PGM' + x'00';
parm(2) = '/QopenSys/usr/bin/echo' + x'00';
parm(3) = '"Hello World"' + x'00';
argv(1) = %addr(parm(1));
argv(2) = %addr(parm(2));
argv(3) = %addr(parm(3));
argv(4) = *NULL;
ENDSL;
// ********************************************************
// Spawn the job
// ********************************************************
inh = *Allx'00';
pid = spawn( argv(1)
: 3
: fdmap
: inh
: argv
: envp
);
if ( pid < 0 );
callp close(pipein(OUTPUT_END));
callp close(pipein(INPUT_END));
callp close(pipeout(OUTPUT_END));
callp close(pipeout(INPUT_END));
callp close(pipeerr(OUTPUT_END));
callp close(pipeerr(INPUT_END));
ReportError();
endif;
// ********************************************************
// Pipes have two ends, one for input, one for output.
// The spawned job will use one end of each pipe, and
// this job will use the other. Consequently, we no
// longer need both ends of the pipes.
//
// Also, since there's no input to be sent to the called
// process, we'll close both ends of the "pipein" pipe.
// ********************************************************
callp close(pipein(OUTPUT_END));
callp close(pipeout(INPUT_END));
callp close(pipeerr(INPUT_END));
callp close(pipein(INPUT_END));
// ********************************************************
// upgrade the two remaining descriptors to buffered
// I/O to make them faster, and easy to do line-at-a-time
// reading.
// ********************************************************
fout = fdopen(pipeout(1): 'r');
ferr = fdopen(pipeerr(1): 'r');
// ********************************************************
// print any output from the PASE command
// ********************************************************
p_buffer = fgets( %addr(buffer): %size(buffer): fout);
dow (p_buffer <> *NULL);
if (FirstTime or *INOF);
except Heading;
FirstTime = *Off;
endif;
line = %str(p_buffer);
except PrintData;
p_buffer = fgets( %addr(buffer): %size(buffer): fout);
enddo;
// ********************************************************
// Print any errors from the PASE command
// ********************************************************
p_buffer = fgets( %addr(buffer): %size(buffer): ferr);
dow (p_buffer <> *NULL);
if (FirstTime or *INOF);
except Heading;
FirstTime = *Off;
endif;
line = %str(p_buffer);
except PrintData;
p_buffer = fgets( %addr(buffer): %size(buffer): ferr);
enddo;
fclose(fout);
fclose(ferr);
*inlr = *on;
/end-free
OQSYSPRT E Heading 2 3
O 'Output from PASE -
O Unzip command'
O E PrintData
O line 132
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* ReportError(): Send an escape message explaining any errors
* that occurred.
*
* This function requires binding directory QC2LE in order
* to access the __errno() function.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P ReportError B
D ReportError PI
D get_errno PR * ExtProc('__errno')
D ptrToErrno s *
D errno s 10I 0 based(ptrToErrno)
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 1A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 8192A options(*varsize)
D ErrorCode DS qualified
D BytesProv 1 4I 0 inz(0)
D BytesAvail 5 8I 0 inz(0)
D MsgKey S 4A
D MsgID s 7A
/free
ptrToErrno = get_errno();
MsgID = 'CPE' + %char(errno);
QMHSNDPM( MsgID
: 'QCPFMSG *LIBL'
: ' '
: 0
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ErrorCode );
/end-free
P E
Raw
SPAWNTST2_RPGLE.TXT
*
* SPAWNTST2 Test SSH and "cat" command
* through Scott Klement SPAWNPASE Example
*
* ???????????????????????????????????????????????????????????????????????????????????????
* IT DOES NOT WORK : I'M NOT ABLE TO SEND TEXT TO STDIN AND GET STDOUT FROM "CAT" COMMAND
*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
*
H DFTACTGRP(*NO) BNDDIR('QC2LE')
FQSYSPRT O F 132 PRINTER OFLIND(*INOF)
/copy src,spawn_h
d close PR 10I 0 ExtProc('close')
d fildes 10I 0 value
D fdopen pr * extproc('fdopen')
D fildes 10I 0 value
D mode * value options(*string)
D fgets PR * ExtProc('_C_IFS_fgets')
D string * value
D size 10I 0 value
D stream * value
D fclose PR 10I 0 ExtProc('_C_IFS_fclose')
D stream * value
*-----------------------------------------------------------------
* fread(): Read items
*
* data = (input) data items to read
* size = (input) size of each data item
* count = (input) number of data items
* stream = (input) pointer to FILE structure to read from
*
* returns the number of full items read, a short count
* indicates an error.
*-----------------------------------------------------------------
D fread PR 10U 0 ExtProc('_C_IFS_fread')
D data * value
D size 10U 0 value
D count 10U 0 value
D stream * value
*-----------------------------------------------------------------
* fwrite(): Write items
*
* data = (input) data items to write
* size = (input) size of each data item
* count = (input) number of data items
* stream = (input) pointer to FILE structure to write to
*
* returns the number of full items written. A short count
* indicates an error.
*-----------------------------------------------------------------
D fwrite PR 10U 0 ExtProc('_C_IFS_fwrite')
D data * value
D size 10U 0 value
D count 10U 0 value
D stream * value
D data S 80A
D len S 10I 0
D ReportError PR
D OUTPUT_END C 1
D INPUT_END C 2
D pipein s 10I 0 dim(2)
D pipeout s 10I 0 dim(2)
D pipeerr s 10I 0 dim(2)
D ferr s *
D fout s *
D fin s *
D envvar s 100A dim(3)
D parm s 100A dim(4)
D argv s * dim(5) inz(*null)
D envp s * dim(3) inz(*null)
D inh ds likeds(Inheritance_T)
D fdmap s 10I 0 dim(3)
D pid s like(pid_t)
D buffer s 133A
D FirstTime s 1N INZ(*ON)
D p_buffer s *
D line s 132A varying
D mytext s 30a
D retval s 10i 0
D retdata s 132a
D
// ********************************************************
// Create pipes that will be connected to PASE's standard
// I/O streams (stdin, stdout, stderr)
// ********************************************************
pipe(pipein);
pipe(pipeout);
pipe(pipeerr);
// ********************************************************
// Tell the spawned job to use the above pipes for it's
// standard input, output and error.
// ********************************************************
envvar(1) = 'QIBM_USE_DESCRIPTOR_STDIO=Y' + x'00';
// Flush data from STDOUT and STDERR immmediately
envvar(2) = 'QIBM_PASE_FLUSH_STDIO=Y' + x'00';
envp(1) = %addr(envvar(1));
envp(2) = %addr(envvar(2));
envp(3) = *NULL;
fdmap(1) = pipein(OUTPUT_END);
fdmap(2) = pipeout(INPUT_END);
fdmap(3) = pipeerr(INPUT_END);
// ********************************************************
// Set up spawn() so that it'll run the QP2SHELL program
// which, in turn, will activate an SSH session
//
// The PASE command run here is:
// "/QOpenSys/usr/sbin/ssh myuser@localhost cat"
// ********************************************************
parm(1) = '/QSYS.LIB/QP2SHELL.PGM' + x'00';
parm(2) = '/QopenSys/usr/bin/ssh' + x'00';
parm(3) = 'myuser@localhost' + x'00';
parm(4) = 'cat' + x'00';
argv(1) = %addr(parm(1));
argv(2) = %addr(parm(2));
argv(3) = %addr(parm(3));
argv(4) = %addr(parm(4));
argv(5) = *NULL;
// ********************************************************
// Spawn the job
// ********************************************************
inh = *Allx'00';
pid = spawn( argv(1)
: 3
: fdmap
: inh
: argv
: envp
);
if ( pid < 0 );
callp close(pipein(OUTPUT_END));
callp close(pipein(INPUT_END));
callp close(pipeout(OUTPUT_END));
callp close(pipeout(INPUT_END));
callp close(pipeerr(OUTPUT_END));
callp close(pipeerr(INPUT_END));
ReportError();
endif;
// ********************************************************
// Pipes have two ends, one for input, one for output.
// The spawned job will use one end of each pipe, and
// this job will use the other. Consequently, we no
// longer need both ends of the pipes.
//
// Also, since there's no input to be sent to the called
// process, we'll close both ends of the "pipein" pipe.
// ********************************************************
callp close(pipeout(INPUT_END));
callp close(pipeerr(INPUT_END));
// DPR do not close pipein
//callp close(pipein(INPUT_END));
//callp close(pipein(OUTPUT_END));
// ********************************************************
// upgrade the two remaining descriptors to buffered
// I/O to make them faster, and easy to do line-at-a-time
// reading.
// ********************************************************
fout = fdopen(pipeout(1): 'r');
ferr = fdopen(pipeerr(1): 'r');
// open pipein to send string to remote ssh
fin = fdopen(pipein(2): 'r');
//print_from_stdout();
//print_from_stderr();
// Write something to ssh stdin
mytext='Hello\n';
retval=fwrite(%addr(mytext):%len(%trim(mytext)):1:fin);
print_from_stdout();
print_from_stderr();
// Write something else to ssh stdin
mytext='My name is Roberto\n';
retval=fwrite(%addr(mytext):%len(%trim(mytext)):1:fin);
print_from_stdout();
print_from_stderr();
callp close(pipein(OUTPUT_END));
callp close(pipein(INPUT_END));
fclose(fout);
fclose(ferr);
fclose(fin);
*inlr = *on;
/end-free
OQSYSPRT E Heading 2 3
O 'Output from PASE -
O SSH test'
O E PrintData
O line 132
//-------------------------------
// print_from_stdout
// Print any output from SDTOUT
//-------------------------------
dcl-proc print_from_stdout;
dcl-pi print_from_stdout;
END-PI;
p_buffer = fgets( %addr(buffer): %size(buffer): fout);
dow (p_buffer <> *NULL);
if (FirstTime or *INOF);
except Heading;
FirstTime = *Off;
endif;
line = %str(p_buffer);
except PrintData;
p_buffer = fgets( %addr(buffer): %size(buffer): fout);
enddo;
return;
end-proc;
//-------------------------------
// print_from_stderr
// Print any output from STDERR
//-------------------------------
dcl-proc print_from_stderr;
dcl-pi print_from_stderr;
END-PI;
p_buffer = fgets( %addr(buffer): %size(buffer): ferr);
dow (p_buffer <> *NULL);
if (FirstTime or *INOF);
except Heading;
FirstTime = *Off;
endif;
line = %str(p_buffer);
except PrintData;
p_buffer = fgets( %addr(buffer): %size(buffer): ferr);
enddo;
return;
end-proc;
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* ReportError(): Send an escape message explaining any errors
* that occurred.
*
* This function requires binding directory QC2LE in order
* to access the __errno() function.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P ReportError B
D ReportError PI
D get_errno PR * ExtProc('__errno')
D ptrToErrno s *
D errno s 10I 0 based(ptrToErrno)
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 1A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 8192A options(*varsize)
D ErrorCode DS qualified
D BytesProv 1 4I 0 inz(0)
D BytesAvail 5 8I 0 inz(0)
D MsgKey S 4A
D MsgID s 7A
/free
ptrToErrno = get_errno();
MsgID = 'CPE' + %char(errno);
QMHSNDPM( MsgID
: 'QCPFMSG *LIBL'
: ' '
: 0
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ErrorCode );
/end-free
P E
P
@Faq400Git
Copy link
Author

Pay attention: SPAWNTST2 it does not work. This GIST is only to share code for Midrange.com forum

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment