identification division. program-id. PSI$X25_SEND_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: * * * SEND 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 receive example programes. * Data is entered via the terminal to the send program, and sent by * X.25 to the receive program. * * The link command should include psilib.obj in the object list. * * 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 * * Define the NCB * * Create a mailbox for the network device * * Assign an input/output (I/O) channel to the network * device (NWA0:) * * Set up a virtual circuit * * Read the mailbox to obtain the status of the connection * * Loop reading data from keyboard and sending to remote * process 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. Also, define TWELVE and TWO as 12 decimal and 2 * decimal for use in building counted ASCII strings. (Note that 12 decimal * is the value of the 13th acscii character, and two decimal is the value of * the 3rd ascii character.) *- symbolic characters CONTROL-Z, THIRTEEN, TWELVE, FIVE, TWO are 27, 14, 12, 6, 2. input-output section. file-control. select INPUT-FILE assign to "SYS$INPUT". data division. file section. FD INPUT-FILE record is varying in size depending on INPUT-LENGTH. 01 INPUT-RECORD picture is X(256). working-storage section. *+ * Local Variables *- 01 SS-STATUS picture S9(9) computational. 01 IOSB. 02 IOSB-STATUS picture 9(4) computational. 02 IOSB-COUNT picture 9(4) computational. 02 IOSB-SECOND_STATUS picture 9(4) computational. 02 IOSB-FOOBAR picture 9(4) computational. 01 INPUT-LENGTH 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 CTRL-Z-MESSAGE picture X value CONTROL-Z. *+ * 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$_READVBLK picture S9(9) comp value external IO$_READVBLK. 01 IO$_WRITEVBLK picture S9(9) comp value external IO$_WRITEVBLK. 01 IO$_DEACCESS picture S9(9) comp value external IO$_DEACCESS. 01 MBX-NAME picture X(8) value "X25S_MBX". 01 PSI-NAME picture X(6) value "_NWA0:". *+ * Define the NCB: * Define required remote DTE address and subaddress here: *- 01 NCB. 02 REMOTE_DTE. 03 picture S9(4) computational value 10. 03 picture S9(4) comp value external PSI$C_NCB_REMDTE. 02 X1. 03 picture X value FIVE. 03 picture X(5) value "12345". 02 TEMPLATE. 03 picture S9(4) computational value 18. 03 picture S9(4) comp value external PSI$C_NCB_TEMPLATE. 02 X2. 03 picture X value THIRTEEN. 03 picture X(13) value "NET_TEMPLATE1". procedure division. *+ * Open SYS$INPUT to read the input message. *- 1. open input INPUT-FILE. *+ * Create a mailbox for the network device. *- call "SYS$CREMBX" using by value 0, by reference MBX-CHAN, by value 0, by value 0, by value 0, by value 0, by descriptor MBX-NAME giving SS-STATUS. if SS-STATUS is not equal to SS$_NORMAL then go to 99. *+ * Assign a channel to network device. *- 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. *+ * Set up virtual circuit. *- call "SYS$QIOW" using by value 0, by value PSI-CHAN, by value IO$_ACCESS, by reference IOSB, by value 0, by value 0, by value 0, by descriptor NCB, 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. *+ * Read mailbox to get status. *- 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. *+ * Read input message from input stream. *- 10. read INPUT-FILE at end go to 20. *+ * Send the message to PSI_RECEIVE. *- call "SYS$QIOW" using by value 0, by value PSI-CHAN, by value IO$_WRITEVBLK, by reference IOSB, by value 0, by value 0, by reference INPUT-RECORD, by value INPUT-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 send next message. *- go to 10. *+ * End of file on input, send control-Z message. *- 20. call "SYS$QIOW" using by value 0, by value PSI-CHAN, by value IO$_WRITEVBLK, by reference IOSB, by value 0, by value 0, by reference CTRL-Z-MESSAGE, by value 1, 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. *+ * Close the input file. *- close INPUT-FILE. *+ * Deaccess virtual circuit. *- 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 network 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. *- 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. *- call "SYS$EXIT" using by value 1. *+ * Error exit code. *- 98. move IOSB-STATUS to SS-STATUS. 99. call "SYS$EXIT" using by value SS-STATUS.