program REMHST
c FDHOSTREMOT remote server program. 
c This version uses an ASYNCHRONOUS line, which should be set up as
c eightbit, passall, noecho  before use here.
c  On start it will send out a record with 14747 in it and 16 bytes
c data (the rest ignored). It will read until it gets a reply with
c 5047 in it, 4 bytes. Once it gets the reply it will enter the
c "connected" state and assume it now has a valid channel to the
c fdhostasy program that's talking to FDDRV.
c
	INTEGER*4 NETCHN,NETTRK,NETSCT,NETCYL,NETBLK
c This program is an asynchronous channel using replacement for FDREMSRV
c used to communicate over a terminal port with a remote host.
c It will send data in packetized blocks of 128 characters data
c with a short packet encloser of format
c  .byte 1	;signals start of a valid packet
c  .byte len    ;length of packet (to allow for short end packets)
c  .byte state  ;0=more packets to follow in this transmission, 1=last of a set
c  .byte 2      ;second check byte value
c  .long checksum ;checksum of entire packet
c  .blkb 128	;data
c   (note: checksum covers header AND data)
c
c  The program will function exactly like the DECnet version except
c that it must translate FDTT to find the terminal channel it must
c use instead of opening sys$net.
C opens channel to sys$net, does initial sizing and writes to it.
C Use trnlog for now since it's easier to do...
C Translates logical name FDRDSK to get the device name and uses the
C $getdvi system service to find out the size and physical parameters
C of the device so assigned. Opens a channel to the disk and to sys$net
C and sends a message containing the trks,sectors,cylinders,blks of the
C device back to the sys$net channel. It then must read the net (with
C a size of at least 8192+24 bytes) and interprets the buffer header
C to send back either data alone, or just the IO status block. If the
C data it read was from a write from client to FD:, it must just send
C the 8 bytes of IOSB of the transfer back. (This will normally be
C 1/bytes sent in longword 1 and 0 in longword 2). If the data read
C from the host was a read request, it must send the desired data
C back, after reading it from the local device FDRDSK (FD: Remote DiSK).
c
c
c  Diagram of the connectivity envisioned here:
c
c               <-decnet->
C +-------------+       +--------------+   +----------+   +------------+
C | FDREMHOST   |       | FDHOSTREM    |   | FDDRV    |   | Client prog|
C |   .FOR      |<---   |   .MAR       |   |  .MAR    |   | (uses FD:) |
C | (This prog) |   /   | +fdremsub.for|<->| driver   |<->|            |
C |             |   --->|              |   |          |   |            |
C +-------------+       +--------------+   +----------+   +------------+
c      Machine 1			Machine 2

	INCLUDE '($DVIDEF)'
	INCLUDE '($IODEF)'
	Integer*4 lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	External lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	Character*80 DskDvc,FDTT
	Integer*4 Status,IDKDL,DSKCHN,I4WRK,fdttl
	Integer*4 Sizes(4),Start(4)
C DATA BUFFER AREA
	INTEGER*4 DBF(2076)
C I/O STATUS BLOCKS
	INTEGER*2 IOSBRM(4)
	INTEGER*2 IOSBLO(4)
	INTEGER*4 IOSR(2),IOSL(2)
	EQUIVALENCE(IOSBRM(1),IOSR(1)),(IOSBLO(1),IOSL(1))
C REMOTE AND LOCAL I/O STAT BLKS (NET AND DISK DEVICES RESPECTIVELY)
	INTEGER*2 WRKIOS(4)
C WORK IOSB.
C HEADER IS FIRST 4 LONGWORDS
C BUFFER IS THE REST (PLUS A LITTLE SLOP)
C ITEM LIST FOIR GETDVI
	INTEGER*2 DVII2(6,5)
	INTEGER*4 DVIITM(3,5)
	EQUIVALENCE(DVII2(1,1),DVIITM(1,1))
C  BUF LENGTH, ITEM CODE - 1ST 2 WORDS
C  BUFFER ADDRESS
C  RETURN LENGTH ADDRESS  - NEXT 2 LONGWORDS, EACH ITEM (4 IN ALL)
C TERMINATE GETDVI ITEMLIST
	DVIITM(1,5)=0
	DVIITM(2,5)=0
	DVIITM(3,5)=0
C FIRST ITEM - DISK SIZE
	DVII2(1,1)=4
	DVII2(2,1)=DVI$_MAXBLOCK
	DVIITM(2,1)=%LOC(SIZES(4))
	DVIITM(3,1)=%LOC(I4WRK)
C SECOND ITEM - NUMBER OF TRACKS
	DVII2(1,2)=4
	DVII2(2,2)=DVI$_TRACKS
	DVIITM(2,2)=%LOC(SIZES(1))
	DVIITM(3,2)=%LOC(I4WRK)
C THIRD ITEM - NUMBER OF SECTORS
	DVII2(1,3)=4
	DVII2(2,3)=DVI$_SECTORS
	DVIITM(2,3)=%LOC(SIZES(2))
	DVIITM(3,3)=%LOC(I4WRK)
C FOURTH ITEM - NUMBER OF CYLINDERS
	DVII2(1,4)=4
	DVII2(2,4)=DVI$_CYLINDERS
	DVIITM(2,4)=%LOC(SIZES(3))
	DVIITM(3,4)=%LOC(I4WRK)
C
	netblk=0
	netchn=0
c Zero in channel indicates failure
c First translate the logicals
C ALLOW NOWRITE LOGICAL, IF PRESENT, TO DISABLE WRITING BY REMOTE
	IWRTOK=1
	STATUS=LIB$SYS_TRNLOG('NOWRITE',IDKDL,DSKDVC)
	IF(STATUS)IWRTOK=0
	Status=lib$sys_trnlog('FDRDSK',IDKDL,DskDvc)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
c Terminal to use must be assigned to logical name FDTT.
	Status=lib$sys_trnlog('FDTT',fdttl,fdtt)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C ASSIGN A CHANNEL TO THE NAMED DISK.
	STATUS=SYS$ASSIGN(DSKDVC(1:IDKDL),DSKCHN,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C OPEN THE ASYNCH CHANNEL TO OUR PARTNER...
C (assume the terminal has been set to passall etc. before we get to it, for
C simplicity and portability. I'd like to use this code with few mods on
C PRO 350 and IBM PC.)
	status=sys$assign(fdtt(1:fdttl),NETCHN,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C NOW GET HOLD OF SIZE INFO
	SIZES(1)=0
	STATUS=SYS$GETDVIW(%VAL(2),%VAL(DSKCHN),,DVIITM,,,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C SEND OUT THE INITIAL PACKET OF INFORMATION ON OUR SIZE TO THE OTHER SIDE.
	IF(SIZES(1).EQ.0)CALL SYS$EXIT(%VAL(4))
c Now ready to establish the remote connection.
	do 4000 n1000=1,1000
c send data
	start(1)=14747
c set magic number
	Call netwrt(netchn,start,16,status)
	if(.not.status)goto 4000
	call netread(netchn,start,4,iosbrm,status)
	if(.not.status)goto 4000
c Check if we got the magic cookie. If so, get going for real.
	if(start(1).eq.5047)goto 1001
4000	Continue
	status=0
1001	Continue
	if(.not.status)call sys$exit(%val(8))
	Call netwrt(netchn,sizes,16,status)
c	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_WRITEVBLK),
c     1  ,,,SIZES,%VAL(16),,,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C SIZES ARRAY now contains the t/s/c/b stuff
	netblk=sizes(4)
	nettrk=sizes(1)
	netsct=sizes(2)
	netcyl=sizes(3)
C NOW ENTER OUR NORMAL EVENT LOOP.
100	CONTINUE
C READ OUR BUFFER AND INTERPRET. RETURN I/O STATUS CODE OF
C OUR LOCAL OPERATIONS TO REMOTE AFTER DOING WHAT'S
C NEEDED.
C  BUFFER HEADER STRUCTURE
C  DIRECTION - 0 IF CLIENT READ (WE READ DISK,WRITE NET)
C		OR 1 IF CLIENT WRITE (WE READ NET, WRITE DISK)
C
C  BLOCK NUMBER OF START BLOCK OF TRANSFER
C  BYTES TO TRANSFER
C  I/O STATUS BLOCK LONGWORD 1
C  I/O STATUS BLOCK LONGWORD 2
C HANG OUR READ ON THE NET...
	IF(SIZES(1).EQ.0)CALL SYS$EXIT(%VAL(4))
	Call NetRead(netchn,DBF,8220,IOSBRM,status)
c	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_READVBLK),
c     1  IOSBRM,,,DBF,%VAL(8220),,,,)
	if(.not.status)GOTO 9999
C NOW WE HAVE BUFFER HEADER LOCAL AT LEAST.
	IF(DBF(1).EQ.0)GOTO 1000
C CLIENT WRITE... WE JUST READ NET, NOW WRITE TO DISK AND THEN RETURN STATUS
C SANITY CHECK SIZE.
	IF(DBF(3).LE.0.OR.DBF(3).GT.8220)GOTO 9999
C SKIP THIS IF WRITE IS DISABLED AT THIS HOST VIA NOWRITE LOGICAL NAME DEFINED
	IF(IWRTOK.EQ.0)GOTO 300
	STATUS=SYS$QIOW(%VAL(1),%VAL(DSKCHN),%VAL(IO$_WRITELBLK),
     1  IOSBLO,,,DBF(6),%VAL(DBF(3)),%VAL(DBF(2)),,,)
	if(.not.status)GOTO 9999
C NOW HAVE THE DATA WRITTEN TO DISK HERE, SO FILL IN THE IOSB AND
C RETURN A STATUS TO NET PARTNER
	IOSR(1)=IOSL(1)
	IOSR(2)=IOSL(2)
300	CONTINUE
	DBF(6)=IOSR(1)
	DBF(7)=IOSR(2)
	Call netwrt(Netchn,dbf(6),8,status)
c	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_WRITEVBLK),
c     1  IOSBRM,,,DBF(6),%VAL(8),,,,)
	if(.not.status)GOTO 9999
C NOW STATUS IS REPORTED. BACK TO LOOP FOR ANOTHER EVENT.
	GOTO 2000
1000	CONTINUE
C CLIENT READ...WE READ DISK, WRITE TO NET.
	STATUS=SYS$QIOW(%VAL(1),%VAL(DSKCHN),%VAL(IO$_READLBLK),
     1  IOSBLO,,,DBF(6),%VAL(DBF(3)),%VAL(DBF(2)),,,)
	if(.not.status)GOTO 9999
C GOT THE DATA INTO OUR BUFFERS. NOW DUMP IT BACK AT THE HOST.
C FIRST FILL IN RETURN IOSB
	DBF(4)=IOSL(1)
	DBF(5)=IOSL(2)
	ISZ=DBF(3)+20
	Call NetWrt(netchn,dbf,isz,status)
c	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_WRITEVBLK),
c     1  IOSBRM,,,DBF,%VAL(ISZ),,,,)
	if(.not.status)GOTO 9999
C NOW ALL DATA IS SHOVED BACK TO HOST AT OTHER MACHINE. GO BACK FOR MORE
2000	CONTINUE
C COMMON PROCESSING WOULD GO HERE BUT NOTHING COMES TO MIND FOR NOW.
C THEREFORE JUST GO GET MORE WORK.
	GOTO 100
C ERROR EXIT...CLOSE CHANNELS AND SCRAM.
9999	CONTINUE
	STATUS=SYS$DASSGN(%VAL(NETCHN))
	STATUS=SYS$DASSGN(%VAL(DSKCHN))
	CALL SYS$EXIT(%VAL(1))
	END
c	Call netwrt(netchn,sizes,16,status)
	subroutine NETWRT(ICHN,jBuf,LEN,ISTAT)
c  .byte 1	;signals start of a valid packet
c  .byte len    ;length of packet (to allow for short end packets)
c  .byte state  ;0=more packets to follow in this transmission, 1=last of a set
c  .byte n      ;n=packet count modulo 7
c  .long checksum ;checksum of entire packet
c  .blkb 128	;data
c   (note: checksum covers header AND data)
	INCLUDE '($DVIDEF)'
	INCLUDE '($IODEF)'
	Integer*4 lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	External lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	integer*4 ichn,len,status
	logical*1 buf(256),jbuf(256)
	integer*4 ibuf(64),lenrem
	equivalence(buf(1),ibuf(1))
c Treat the buffer as a byte array; break it up internally.
	integer*4 loccur,ichk
	integer*4 ios(2),rbuf(2)
	integer*2 ios2(4)
	equivalence(ios(1),ios2(1))
	integer*2 rbuf2(4)
	equivalence(rbuf2(1),rbuf(1))
c reply buffer = 2 longwords. 1st=iosb on read (must be 1/len)
c 2nd is checksum received.
	loccur=0
	lenrem=len
	nn=0
	do 100 n=1,100
101	Continue
c max 100 iterations is PLENTY to send maxd 8192+24 bytes. (really 65 should do it)
c Prepare a buffer of data to send.
	buf(1)=1
	buf(3)=0
	if(lenrem.le.128)buf(3)=1
	buf(2)=min0(lenrem,128)
	buf(4)=nn
	ibuf(2)=0
	ii=min0(lenrem,128)
	ichk=buf(3)+1+ii+nn
	do 1 n1=1,ii
	ibuf(8+ii)=jbuf(loccur+ii)
	ichk=ichk+jbuf(loccur+ii)
1	continue
	ibuf(2)=ichk	
	isz=136
c 136=8+128. send constant number so we can read w/o err
c	isz=ii+8
c isz is size we send.
c
c Now have the buffer to send prepared
c send it to other side.
	status=sys$qiow(%val(1),%val(netchn),%val(io$_writevblk),
     1  ,,,jbuf,%val(isz),,,,)
	if(.not.status)return
	if(.not.ios2(1))status=4
	if(.not.ios2(1))Return
c now read the ack from other side. ALWAYS get one of these and retransmit if we fail.
	status=sys$qiow(%val(1),%val(netchn),%val(io$_readvblk),
     1  ios,,,rbuf,%val(8),,,,)
	if(.not.status)return
	if(.not.ios2(1))status=4
	if(.not.ios2(1))Return
c Check that our status is OK
	status=rbuf(1)
	if(.not.rbuf(1))goto 101
	if(rbuf2(2).ne.nn)goto 101
c check packet seq. number ok also on return.
c Other end must check seq number on receipt to ensure it increments. If it does not
c it must use second one and not bump its data pointers. This helps ensure a safe
c round trip for the data and that it arrives intact.
c Next be sure the checksum got here ok. Return message could be garbled, but
c if it's not we know the message got there AND back again ok.
	if(rbuf(2).ne.ichk)goto 101
c if we drop thru, the data got to the other side OK.
c Update to next packet and go on.
	nn=nn+1
	if(nn.ge.128)nn=0
	lenrem=lenrem-128
	if(lenrem.le.0)goto 102
	loccur=loccur+128
100	Continue
102	Continue
c Return "all well" status to our caller at this point.
	status=1
	return
	end
	subroutine NETREAD(ICHN,jBuf,LEN,IOSB,ISTAT)
c  .byte 1	;signals start of a valid packet
c  .byte len    ;length of packet (to allow for short end packets)
c  .byte state  ;0=more packets to follow in this transmission, 1=last of a set
c  .byte  n     ;0 to 7 cyclical. Starts at 0 for each call
c  .long checksum ;checksum of entire packet (except checksum)
c  .blkb 128	;data
c   (note: checksum covers header AND data)
	INCLUDE '($DVIDEF)'
	INCLUDE '($IODEF)'
	Integer*4 lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	External lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	integer*4 ichn,len,Istat
	Integer*2 IOSB(4)
	logical*1 buf(256),jbuf(256)
	integer*4 ibuf(64)
	equivalence(buf(1),ibuf(1))
c Treat the buffer as a byte array; break it up internally.
	integer*4 loccur,ichk
	integer*4 ios(2),rbuf(2)
	integer*2 ios2(4)
	equivalence(ios(1),ios2(1))
c reply buffer = 2 longwords. 1st=iosb on read (must be 1/len)
c 2nd is checksum received.
	integer*2 rbuf2(4)
	equivalence(rbuf2(1),rbuf(1))
c reply buffer = 2 longwords. 1st=iosb on read (must be 1/len)
c 2nd is checksum received.
	loccur=0
	lenrem=0
	nn=0
c nn is index of buffer (mod 128)
	do 100 n=1,100
101	Continue
c max 100 iterations is PLENTY to send maxd 8192+24 bytes. (really 65 should do it)
c Read 136 character buffer
	Istat=sys$qiow(%val(1),%val(Ichn),%val(io$_readvblk),
     1  iosb,,,buf,%val(136),,,,)
	if(.not.iosb(1))istat=2
c send reply...
	rbuf(2)=ibuf(2)
	rbuf2(1)=Istat
	rbuf2(2)=buf(4)
	Istat=sys$qiow(%val(1),%val(Ichn),%val(io$_writevblk),
     1  ios,,,rbuf,%val(8),,,,)
	if(.not.ios2(1))istat=4
	if(.not.ios2(1))Return
c Now validate buffer & store if it looks ok.
	iii=buf(1)
	if(iii.ne.1)goto 101
	ichk=buf(1)+buf(2)+buf(3)+buf(4)
	ii=buf(2)
	do 1 n1=1,ii
	jbuf(8+ii)=buf(loccur+ii)
	ichk=ichk+buf(loccur+ii)
1	continue
	if(ibuf(2).ne.ichk)goto 101
c skip unless checksum looks ok
	nn=buf(4)
	if(nn.gt.127)goto 101
c range check only...
	kk=128+(nn*128)
	if(kk.lt.loccur)goto 101
	kkk=buf(3)
	if(kkk.eq.1)loccur=loccur+ii
	if(kkk.eq.0)loccur=kk
	if(kkk.eq.1)goto 102
100	Continue
c fall-thru means too many retries, failure.
	Istat=2
	return
102	Continue
	iosb(2)=loccur+1
	iosb(1)=1
c success iosb; flag all data copied.
c Return "all well" Istat to our caller at this point.
	Istat=1
	return
	end