PROGRAM PSI$X25_SEND_FORTRAN C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION, 1993 C C ALL RIGHTS RESERVED. UNPUBLISHED - RIGHTS RESERVED C C UNDER THE COPYRIGHT LAWS OF THE UNITED STATES. C C C C RESTRICTED RIGHTS LEGEND: USE, DUPLICATION, OR DISCLOSURE C C BY THE U.S. GOVERNMENT IS SUBJECT TO RESTRICTIONS AS SET C C FORTH IN SUBPARAGRAPH (C)(1)(II) OF DFARS 252.227-7013, C C OR IN FAR 52.227-19, OR IN FAR 52.227-14 ALT. III, AS C C APPLICABLE. C C C C THIS SOFTWARE IS PROPRIETARY TO AND EMBODIES CONFIDENTIAL C C TECHNOLOGY OF DIGITAL. POSSESSION, USE, OR COPYING OF THE C C SOFTWARE AND MEDIA IS AUTHORIZED ONLY PURSUANT TO A VALID C C WRITTEN LICENSE FROM DIGITAL. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C++ C C FACILITY: C C X.25 Example Program C C ABSTRACT: C C C SEND PROGRAM C C Digital is furnishing this example software "as is" without C warranty of any kind, express or implied, including the implied C warranties of merchantability and fitness for a particular purpose. C Digital disclaims any and all liability for the performance or C non-performance of this software. C C C This program is intended to run with the receive example programes. C Data is entered via the terminal to the send program, and sent by C X.25 to the receive program. C C The following NCL commands can be used to configure X.25. This C configeration assumes the following C - the send and recieve programs are running on the same system C - the same gateway is used to place and outgoing call and recieve C - the incomming call. C - the recieve example is started by a application entity C - the file specified by the application entity contains a DCL C command to run the receive executable. C C C create x25 access C create x25 client C ! C ! Create DTE classes C ! C create x25 access dte class crock type remote C set x25 access dte class crock service node {(node=dundee, - C rating=512)} C create x25 access dte class crock1 type remote C set x25 access dte class crock1 service node {(node=dundee, - C rating=512)} C ! C ! Create security DTE class C ! C create x25 access security dte class default C ! C ! Create remote DTE entity C ! C create x25 access security dte class default remote dte match_all - C remote address prefix * C set x25 access security dte class default remote dte match_all - C rights identifier {match_all} C ! C ! Create template C ! C create x25 access template net_template1 C set x25 access template net_template1 dte class crock C create x25 access template default C ! C ! Create filter C ! C create x25 access filter receive C set x25 access filter receive incoming dte address 12345 C ! C ! Create security filter C ! C create x25 access security filter default C set x25 access security filter default acl - C {(identifier=(match_all),access=all)} C ! C ! Create application entity C ! C create x25 access application receive C set x25 access application receive filters {receive} C set x25 access application receive user system C set x25 access application receive file sys$system:x25$receive.com C ! C ! Enable everything C ! C enable x25 access C enable x25 client C enable x25 access application receive C C C FUNCTIONAL DESCRIPTION: C * Define the NCB C * Create a mailbox for the network device C * Assign an input/output (I/O) channel to the network C device (NWA0:) C * Set up a virtual circuit C * Read the mailbox to obtain the status of the connection C * Loop reading data from keyboard and sending to remote C process until control-z received C * Clear the call C * Deassign the mailbox and I/O channels C C-- implicit none include 'sys$library:psilib.for' C+ C External References: C- EXTERNAL IO$_ACCESS, IO$_DEACCESS EXTERNAL IO$_READVBLK, IO$_WRITEVBLK INTEGER*4 SYS$ASSIGN, SYS$CREMBX, SYS$EXIT, SYS$QIOW, SYS$DASSGN C+ C Literal Definitions: C- CHARACTER* (*) PSI_DEV, MBX INTEGER*4 MBX_BUFSIZ PARAMETER (PSI_DEV = '_NWA0:') PARAMETER (MBX = 'X25S_MBX') PARAMETER (MBX_BUFSIZ = 200) C+ C Local Variables C- INTEGER*2 IOSB (4), PSI_CHAN, MBX_CHAN LOGICAL*1 MBX_BUF (MBX_BUFSIZ), T (256), CTRLZ/26/ INTEGER*4 I, LEN C+ C Define the NCB REMOTE_DTE . C- CDEC$ OPTIONS /ALIGN=COMMON=STANDARD INTEGER*2 REMOTE_DTE (2) /10, 0/ LOGICAL*1 X1 (6) /5, '1', '2', '3', '4', '5'/ INTEGER*2 TEMPLATE (2) /18, 0/ LOGICAL*1 X3 (14) /13, 'N', 'E', 'T', '_', 'T', 'E', 'M', 'P', 1 'L', 'A', 'T', 'E', '1'/ INTEGER*4 ACCESS_NCB (2) COMMON/NCB/REMOTE_DTE, X1, TEMPLATE , X3, ACCESS_NCB CDEC$ END OPTIONS C+ C Open SYS$INPUT to read the input message. C- OPEN (UNIT = 5, FILE = 'SYS$INPUT', STATUS = 'OLD') C+ C Create a mailbox for the network device. C- I = SYS$CREMBX (, MBX_CHAN,,,,, MBX) IF (.NOT.I) GOTO 99 C+ C Assign a channel to network device. C- I = SYS$ASSIGN (PSI_DEV, PSI_CHAN,, MBX) IF (.NOT.I) GOTO 99 C+ C Set up virtual circuit. C- REMOTE_DTE (2) = PSI$C_NCB_REMDTE TEMPLATE (2) = PSI$C_NCB_TEMPLATE ACCESS_NCB (1) = %LOC (ACCESS_NCB) -%LOC (REMOTE_DTE) ACCESS_NCB (2) = %LOC (REMOTE_DTE) I = SYS$QIOW (, %VAL (PSI_CHAN), IO$_ACCESS, IOSB,,, 1 , ACCESS_NCB,,,, %VAL (0)) IF (.NOT.I) GOTO 99 IF (.NOT.IOSB (1)) GOTO 98 C+ C Read mailbox to get status. C- I = SYS$QIOW (, %VAL (MBX_CHAN), IO$_READVBLK, IOSB,,, 1 MBX_BUF, %VAL (MBX_BUFSIZ),,,, %VAL (0)) IF (.NOT.I) GOTO 99 IF (.NOT.IOSB (1)) GOTO 98 C+ C Read input message from input stream. C- 10 READ (5, 100, ERR = 20, END = 20) LEN, T 100 FORMAT (Q, 256A1) C+ C Send the message to PSI_RECEIVE. C- I = SYS$QIOW (, %VAL (PSI_CHAN), IO$_WRITEVBLK, IOSB,,, 1 T, %VAL (LEN),,,, %VAL (0)) IF (.NOT.I) GOTO 99 IF (.NOT.IOSB (1)) GOTO 98 C+ C Loop to send next message. C- GOTO 10 C+ C End of file on input, send control-Z message. C- 20 I = SYS$QIOW (, %VAL (PSI_CHAN), IO$_WRITEVBLK, IOSB,,, 1 CTRLZ, %VAL (1),,,, %VAL (0)) IF (.NOT.I) GOTO 99 IF (.NOT.IOSB (1)) GOTO 98 C+ C Close the input file. C- CLOSE (UNIT = 5) C+ C Deaccess virtual circuit. C- I = SYS$QIOW (, %VAL (PSI_CHAN), IO$_DEACCESS, IOSB,,, 1 ,,,,, %VAL (0)) IF (.NOT.I) GOTO 99 IF (.NOT.IOSB (1)) GOTO 98 C+ C Deassign network channel. C- I = SYS$DASSGN (%VAL (PSI_CHAN)) IF (.NOT.I) GOTO 99 C+ C Deassign mailbox. C- I = SYS$DASSGN (%VAL (MBX_CHAN)) IF (.NOT.I) GOTO 99 C+ C Exit with success. C- CALL SYS$EXIT (%VAL (1)) C+ C Error exit code. C- 98 I = IOSB (1) 99 CALL SYS$EXIT (%VAL (I)) END