TCP/IP Programming Examples › PL/I Examples › PL/I TCP/IP Generic Listener Server Program
PL/I TCP/IP Generic Listener Server Program
/*RETRIEVAL*/
/*DMLIST*/
/******************************************************************/
/* The following program is an example of a TCP/IP generic */
/* listener server program written in PL/I. */
/* The processing is the following: */
/* - read a message from the client (first 4 bytes = data length)*/
/* - send the message back to the client program */
/* - if the message text is equal to "STOP" or if the connection */
/* is closed, then it closes its socket and return to the */
/* generic listener service. */
/* - if the message text is not equal to "STOP", then it returns */
/* to the generic listener service without closing its socket. */
/* */
/* Notes for the PL/I compiler on VSE. */
/* - in order to allow arithmetic operations on POINTER type */
/* variables, specify the LANGLVL(OS,SPROG) compiler option */
/* - there is no option to allow external names on 8 characters, */
/* so replace all CALL IDMSOCKI by CALL IDMSOCK, as described */
/* in the Callable Services manual. */
/******************************************************************/
PLILIS: PROC (P1, P2, P3)
OPTIONS (REENTRANT,FETCHABLE);
/******************************************************************/
/* Parameter list with which a listener program receives control */
/******************************************************************/
DCL (P1,P2,P3) POINTER;
DCL SOCKET_PARMS CHAR(80) BASED (ADDR(P1));
DCL SOCKET_DESCRIPTOR FIXED BIN(31) BASED (ADDR(P2));
DCL SOCKET_RESUME_COUNT FIXED BIN(31) BASED (ADDR(P3));
DCL MODE(IDMS_DC) DEBUG;
DCL ADDR BUILTIN;
DCL IDMSPLI ENTRY OPTIONS(INTER,ASSEMBLER);
DCL IDMSOCKI ENTRY OPTIONS(INTER,ASSEMBLER);
DCL IDMSP ENTRY;
INCLUDE IDMS (SUBSCHEMA_CTRL);
INCLUDE IDMS (SOCKET_CALL_INTERFACE);
DCL 1 MSG01 CHAR (20) INIT (' Parameter string :');
DCL 1 MSG02 CHAR (20) INIT (' Socket descriptor :');
DCL 1 MSG03 CHAR (20) INIT (' Resume count :');
DCL 1 MSG04 CHAR (15) INIT (' Starting read.');
DCL 1 MSG05 CHAR (16) INIT (' Starting write.');
DCL 1 MSG06 CHAR (16) INIT (' Closing socket.');
DCL 1 MSG07 CHAR (20) INIT (' Socket return code:');
DCL 1 MSG08 CHAR (20) INIT (' Socket reason code:');
DCL 1 MSG09 CHAR (20) INIT (' Socket errno :');
DCL 1 MSG10 CHAR (20) INIT (' Buffer length :');
DCL 1 MSG11 CHAR (08) INIT (' Buffer:');
DCL 1 MSG12 CHAR (22) INIT (' Data length too long.');
DCL 1 RETLEN FIXED BINARY(31);
DCL 1 WK_LENGTH FIXED BINARY(31);
DCL 1 WK_PTR POINTER;
DCL 1 TEXT CHAR(80) BASED(WK_PTR);
DCL 1 TERM_FLAG FIXED BINARY(31) INITIAL(0);
DCL 1 BUFFER,
3 BUFLEN FIXED BINARY(31),
3 BUFTXT80 CHAR(80);
DCL 1 WORKW,
3 WORK_WCC CHAR(1),
3 WORK CHAR(80);
/******************************************************************/
/* Display the 3 input parameters */
/******************************************************************/
/******************************************************************/
/* Read the first 4 bytes: will contain the remaining length */
/******************************************************************/
WK_LENGTH = 4;
BUFLEN = 0;
WK_PTR = ADDR(BUFLEN);
CALL TCP_READ;
IF (TERM_FLAG = 1) THEN RETURN;
/******************************************************************/
/* Read the remaining data (maximum 80 characters are allowed) */
/******************************************************************/
IF (BUFLEN > 80)
THEN DO;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG12) LENGTH (22);
CALL TCP_CLOSE;
RETURN;
END;
WK_LENGTH = BUFLEN;
WK_PTR = ADDR(BUFTXT80);
CALL TCP_READ;
IF (TERM_FLAG = 1) THEN RETURN;
WORK = BUFLEN;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG10) LENGTH (20)
FROM (WORKW) LENGTH (15);
WORK = BUFTXT80;
WK_LENGTH = BUFLEN + 1;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG11) LENGTH (8)
FROM (WORKW) LENGTH (WK_LENGTH);
/******************************************************************/
/* Send the message back to the client */
/******************************************************************/
WK_LENGTH = BUFLEN + 4;
WK_PTR = ADDR(BUFLEN);
CALL TCP_WRITE;
IF ((BUFLEN = 4) & (SUBSTR(BUFTXT80,1,4) = 'STOP'))
THEN CALL TCP_CLOSE;
RETURN;
/******************************************************************/
/* Procedure to read a message from the client */
/******************************************************************/
TCP_READ: PROC;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG04) LENGTH (15);
DO WHILE (WK_LENGTH > 0);
CALL IDMSOCKI ( SOCKET_FUNCTION_READ,
SOCKET_RETCD,
SOCKET_ERRNO,
SOCKET_RSNCD,
SOCKET_DESCRIPTOR,
WK_PTR->TEXT,
WK_LENGTH,
RETLEN);
WORK = SOCKET_RETCD;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG07) LENGTH (20)
FROM (WORKW) LENGTH (15);
IF ((SOCKET_RETCD ,= 0) | (RETLEN = 0))
THEN DO;
CALL TCP_ERROR;
RETURN;
END;
WK_PTR = WK_PTR + RETLEN;
WK_LENGTH = WK_LENGTH - RETLEN;
END;
END TCP_READ;
/******************************************************************/
/* Procedure to send a message to the client */
/******************************************************************/
TCP_WRITE: PROC;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG05) LENGTH (16);
DO WHILE (WK_LENGTH > 0);
CALL IDMSOCKI ( SOCKET_FUNCTION_WRITE,
SOCKET_RETCD,
SOCKET_ERRNO,
SOCKET_RSNCD,
SOCKET_DESCRIPTOR,
WK_PTR->TEXT,
WK_LENGTH,
RETLEN);
WORK = SOCKET_RETCD;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG07) LENGTH (20)
FROM (WORKW) LENGTH (15);
IF ((SOCKET_RETCD ,= 0) | (RETLEN = 0))
THEN DO;
CALL TCP_ERROR;
RETURN;
END;
WK_PTR = WK_PTR + RETLEN;
WK_LENGTH = WK_LENGTH - RETLEN;
END;
END TCP_WRITE;
/******************************************************************/
/* Procedure to close the socket */
/******************************************************************/
TCP_CLOSE: PROC;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG06) LENGTH (16);
CALL IDMSOCKI ( SOCKET_FUNCTION_CLOSE,
SOCKET_RETCD,
SOCKET_ERRNO,
SOCKET_RSNCD,
SOCKET_DESCRIPTOR);
WORK = SOCKET_RETCD;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG07) LENGTH (20)
FROM (WORKW) LENGTH (15);
END TCP_CLOSE;
/******************************************************************/
/* Procedure to process the socket call errors */
/******************************************************************/
TCP_ERROR: PROC;
WORK = SOCKET_RSNCD;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG08) LENGTH (20)
FROM (WORKW) LENGTH (15);
WORK = SOCKET_ERRNO;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG09) LENGTH (20)
FROM (WORKW) LENGTH (15);
WORK = RETLEN;
WRITE LOG MESSAGE ID (9060300)
PARMS FROM (MSG10) LENGTH (20)
FROM (WORKW) LENGTH (15);
CALL TCP_CLOSE;
TERM_FLAG = 1;
END TCP_ERROR;
END PLILIS;
Copyright © 2014 CA.
All rights reserved.
|
|