[INHERIT ('SYS$LIBRARY:STARLET')]

PROGRAM psi$x25_receive_pascal (input, output);

{
*************************************************************************
**                                                                      *
**         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:
**
**      x.25 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:
**
**      * Inherit external declarations from 'starlet' environment
**      * Declare local constants, types and variables
**      * Define descriptors for the mailbox and network device
**	* 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
**
**--
}


CONST	    iobsz		    = 70;
	    ctrlz		    = 26;


TYPE	    t_ubyte		    = [byte] 0..255;	{08bits 1byte}
	    t_uword		    = [word] 0..65535;	{16bits 2bytes}
	    t_ulong		    = [long] unsigned;	{32bits 4bytes}
	    t_uquad		    = [quad, unsafe]	RECORD
							    l0,l1:unsigned;
							END; {64bits 8bytes}


	    t_mbx_buf	=   RECORD
				msg_typ	: t_uword;
				unit	: t_uword;
				name_sz	: t_ubyte;
				name	: PACKED ARRAY [1..15] OF char;
				info_sz	: t_ubyte;
				info	: [volatile] PACKED ARRAY [1..179] OF char;
			    END;

	    t_iosb	=   RECORD
				status,
				dlen,
				devdep1,
				devdep2	: t_uword
			    END;



VAR	    ncb_desc	:   [volatile] DSC1$TYPE;

	    mbx_msg	:   t_mbx_buf;

	    iosb	:   t_iosb;

	    mbx		:   DSC1$TYPE;

	    mbx_name	:   [volatile] PACKED ARRAY [1..7] OF char
							:= 'SYS$NET';


	    dev		:   DSC1$TYPE;

	    dev_name	:   [volatile] PACKED ARRAY [1..6] OF char
							:= '_NWA0:';


	    io_buf	:   PACKED ARRAY [1..iobsz] OF char;

	    status	:   t_uword;

	    mbx_channel,
	    psi_channel	:   t_uword;

	    fn_code	:   [unsafe] t_uword;

VALUE	    ncb_desc	:=  (	0,
				DSC$K_DTYPE_VT,
				DSC$K_CLASS_VS,
				0   );




PROCEDURE build_descs;

{   Build mailbox and network device descriptors   }

BEGIN
    WITH mbx DO
	BEGIN
	    DSC$W_MAXSTRLEN	:= size(mbx_name);
	    DSC$B_DTYPE		:= DSC$K_DTYPE_T;
	    DSC$B_CLASS		:= DSC$K_CLASS_S;
	    DSC$A_POINTER	:= address(mbx_name)
	END;

    WITH dev DO
	BEGIN
	    DSC$W_MAXSTRLEN	:= size(dev_name);
	    DSC$B_DTYPE		:= DSC$K_DTYPE_T;
	    DSC$B_CLASS		:= DSC$K_CLASS_S;
	    DSC$A_POINTER	:= address(dev_name)
	END
END;   { build_decs }



BEGIN	{ main }
    writeln('X25 Receiver');

    build_descs;

    {   Assign a mailbox channel   }

    status := $assign(	devnam	:= mbx_name,
			chan	:= mbx_channel);

    IF NOT odd(status) THEN $exit(status);


    {   Assign a channel to the network device   }

    status := $assign(	devnam	:= dev_name,
			chan	:= psi_channel,
			mbxnam	:= mbx_name );

    IF NOT odd(status) THEN $exit(status);



    {	Read connect message from mailbox to obtain call NCB   }

    status := $qiow(	chan	:= mbx_channel,
			func	:= IO$_READVBLK,
			iosb	:= iosb,
			p1	:= mbx_msg,
			p2	:= size(mbx_msg));

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);



    {	initialise NCB descriptor from mailbox message   }

    ncb_desc.DSC$W_MAXSTRLEN	:= mbx_msg.info_sz;
    ncb_desc.DSC$A_POINTER	:= address(mbx_msg.info);



    {	Accept the call   }

    fn_code := uor(IO$_ACCESS, IO$M_ACCEPT);

    status := $qiow(	chan	:= psi_channel,
			func	:= fn_code,
			iosb	:= iosb,
			p2	:= iaddress(ncb_desc) );

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);



    {	Loop to read lines from remote process until control-z received   }

    REPEAT
        status := $qiow(	chan	:= psi_channel,
				func	:= IO$_READVBLK,
				iosb	:= iosb,
				p1	:= io_buf,
				p2	:= iobsz);

	IF NOT odd(status) THEN $exit(status);
	IF NOT odd(iosb.status) THEN $exit(iosb.status);

	IF ( io_buf[1] <> chr(ctrlz) ) THEN writeln(io_buf);

    UNTIL ( io_buf[1] = chr(ctrlz) );



    {	Clear the call   }

    status := $qiow(	chan	:= psi_channel,
			func	:= IO$_DEACCESS,
			iosb	:= iosb );

    IF NOT odd(status) THEN $exit(status);
    IF NOT odd(iosb.status) THEN $exit(iosb.status);


    {	Deassign network device and mailbox channels   }

    status := $dassgn(	chan	:= psi_channel );

    IF NOT odd(status) THEN $exit(status);


    status := $dassgn(	chan	:= mbx_channel );

    IF NOT odd(status) THEN $exit(status);

    $exit(ss$_normal);

END.