identification division. program-id. PSI$X25_RECEIVE_COBOL. /*********************************************************************** * * * COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION, 1993 * * ALL RIGHTS RESERVED. UNPUBLISHED - RIGHTS RESERVED * * UNDER THE COPYRIGHT LAWS OF THE UNITED STATES. * * * * RESTRICTED RIGHTS LEGEND: USE, DUPLICATION, OR DISCLOSURE * * BY THE U.S. GOVERNMENT IS SUBJECT TO RESTRICTIONS AS SET * * FORTH IN SUBPARAGRAPH (C)(1)(II) OF DFARS 252.227-7013, * * OR IN FAR 52.227-19, OR IN FAR 52.227-14 ALT. III, AS * * APPLICABLE. * * * * THIS SOFTWARE IS PROPRIETARY TO AND EMBODIES CONFIDENTIAL * * TECHNOLOGY OF DIGITAL. POSSESSION, USE, OR COPYING OF THE * * SOFTWARE AND MEDIA IS AUTHORIZED ONLY PURSUANT TO A VALID * * WRITTEN LICENSE FROM DIGITAL. * * * ************************************************************************ *++ * FACILITY: * * X25 Example Program * * ABSTRACT: * * RECEIVE PROGRAM * * Digital is furnishing this example software "as is" without * warranty of any kind, express or implied, including the implied * warranties of merchantability and fitness for a particular purpose. * Digital disclaims any and all liability for the performance or * non-performance of this software. * * * This program is intended to run with the send example programes. * Data is entered via the terminal to the send program, and sent by * X.25 to the receive program. * * The following NCL commands can be used to configure X.25. This * configeration assumes the following * - the send and recieve programs are running on the same system * - the same gateway is used to place and outgoing call and recieve * - the incomming call. * - the recieve example is started by a application entity * - the file specified by the application entity contains a DCL * command to run the receive executable. * * * create x25 access * create x25 client * ! * ! Create DTE classes * ! * create x25 access dte class crock type remote * set x25 access dte class crock service node {(node=dundee, - * rating=512)} * create x25 access dte class crock1 type remote * set x25 access dte class crock1 service node {(node=dundee, - * rating=512)} * ! * ! Create security DTE class * ! * create x25 access security dte class default * ! * ! Create remote DTE entity * ! * create x25 access security dte class default remote dte match_all - * remote address prefix * * set x25 access security dte class default remote dte match_all - * rights identifier {match_all} * ! * ! Create template * ! * create x25 access template net_template1 * set x25 access template net_template1 dte class crock * create x25 access template default * ! * ! Create filter * ! * create x25 access filter receive * set x25 access filter receive incoming dte address 12345 * ! * ! Create security filter * ! * create x25 access security filter default * set x25 access security filter default acl - * {(identifier=(match_all),access=all)} * ! * ! Create application entity * ! * create x25 access application receive * set x25 access application receive filters {receive} * set x25 access application receive user system * set x25 access application receive file sys$system:x25$receive.com * ! * ! Enable everything * ! * enable x25 access * enable x25 client * enable x25 access application receive * * * * FUNCTIONAL DESCRIPTION: * * * Declare references to external variables and declare * local variables * * Assign a mailbox for the network device to SYS$NET * * Assign an input/output (I/O) channel to the network * device (NWA0:) * * Wait until a connection request appears in mailbox * * Accept the connection * * Loop reading data until control-z received * * Clear the call * * Deassign the mailbox and I/O channels * *-- environment division. configuration section. special-names. *+ * Define CONTROL-Z to be the 27th character of the ASCII character set; * that is, 32 octal. *- symbolic characters CONTROL-Z is 27. data division. file section. working-storage section. *+ * Local Variables: *- 01 SS-STATUS picture S9(9) computational. 01 OUTPUT-LENGTH picture 9(9) computational. 01 IOSB. 02 IOSB-STATUS picture 9(4) computational. 02 IOSB-COUNT picture 9(4) computational. 02 IOSB-DEVDEPEND picture 9(9) computational. 01 PSI-CHAN picture S9(4) computational. 01 MBX-CHAN picture S9(4) computational. 01 MBX-BUFFER picture X(200). 01 RECEIVE-BUFFER picture X(256). 01 ACCEPT-LENGTH picture S9(4) computational. 01 ACCEPT-LENGTH-X redefines ACCEPT-LENGTH picture X. 01 FN_CODE picture S9(9) computational. *+ * Constants. *- 01 SS$_NORMAL picture S9(9) comp value external SS$_NORMAL. 01 IO$_ACCESS picture S9(9) comp value external IO$_ACCESS. 01 IO$M_ACCEPT picture S9(9) comp value external IO$M_ACCEPT. 01 IO$_READVBLK picture S9(9) comp value external IO$_READVBLK. 01 IO$_DEACCESS picture S9(9) comp value external IO$_DEACCESS. 01 MBX-NAME picture X(7) value "SYS$NET". 01 PSI-NAME picture X(6) value "_NWA0:". 01 MBX_HEADER_LENGTH picture S9(4) comp value 21. procedure division. 0001-start. *+ * Assign mailbox for network. *- call "SYS$ASSIGN" using by descriptor MBX-NAME, by reference MBX-CHAN, by value 0, by value 0 giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. *+ * Assign a channel for PSI. *- call "SYS$ASSIGN" using by descriptor PSI-NAME, by reference PSI-CHAN, by value 0, by descriptor MBX-NAME giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. *+ * Read the mailbox for connects. *- call "SYS$QIOW" using by value 0, by value MBX-CHAN, by value IO$_READVBLK, by reference IOSB, by value 0, by value 0, by reference MBX-BUFFER, by value 200, by value 0, by value 0, by value 0, by value 0 giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. if IOSB-STATUS is not equal to SS$_NORMAL then go to 98. *+ * Accept the connection. *- compute FN_CODE = IO$_ACCESS + IO$M_ACCEPT. compute ACCEPT-LENGTH = IOSB-COUNT - MBX_HEADER_LENGTH. call "SYS$QIOW" using by value 0, by value PSI-CHAN, by value FN_CODE, by reference IOSB, by value 0, by value 0, by value 0, by descriptor MBX-BUFFER(22 : ACCEPT-LENGTH), by value 0, by value 0, by value 0, by value 0 giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. if IOSB-STATUS is not equal to SS$_NORMAL then go to 98. *+ * Loop to receive messages from PSI_SEND. If an end of file message * is received (first byte contains control-Z), clear the call. *- 10. call "SYS$QIOW" using by value 0, by value PSI-CHAN, by value IO$_READVBLK, by reference IOSB, by value 0, by value 0, by reference RECEIVE-BUFFER, by value 200, by value 0, by value 0, by value 0, by value 0 giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. if IOSB-STATUS is not equal to SS$_NORMAL then go to 98. *+ * If message is ^Z then exit else output message. *- if RECEIVE-BUFFER (1 : 1) is equal to CONTROL-Z then go to 20. display RECEIVE-BUFFER(1:IOSB-COUNT). go to 10. 20. *+ * Clear the call. *- call "SYS$QIOW" using by value 0, by value PSI-CHAN, by value IO$_DEACCESS, by reference IOSB, by value 0, by value 0, by value 0, by value 0, by value 0, by value 0, by value 0, by value 0 giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. if IOSB-STATUS is not equal to SS$_NORMAL then go to 98. *+ * Deassign the network device channel. *- call "SYS$DASSGN" using by value PSI-CHAN giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. *+ * Deassign mailbox channel. *- call "SYS$DASSGN" using by value MBX-CHAN giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. *+ * Exit with success code. *- call "SYS$EXIT" using by value 1. *+ * Exit with error status. *- 98. move IOSB-STATUS to SS-STATUS. 99. call "SYS$EXIT" using by value SS-STATUS.