c************
c Description: Remote Midas InterFace (RMIF)
c
c Author: Jeff Schoen 12/99
c
c @author Jeff Schoen
c
c Feb 2005 KCS
c   DR 512208-1 Consolidate changes made in the X-Midas and NeXtMidas versions,
c               including 500002, which changed 'type *' to 'write(*,*)'
c               Also add a reconnect capability for X-Midas clients
c               Added more outputs to log file, to give it most of the same
c                information that was output in verbose mode
c               Added call to M$FORCE1000 in processPacket to compensate for
c                the one in addProperty, needed to allow type 2000 data with
c                frame sizes greater than 32768 bytes to pass properly.
c
c Oct 2009 JC4/NTN (NeXtMidas 2.7.3)
c   BUG 1879    Updated verbose and log messages to print out remote(ir).addr
c                in IPv4_address:port format (vs as 4 integers)
c   BUG 1917    'addr' field in messages sent to macro now uses
c                IPv4_address:port format instead of hex format.
c                subroutine ipaddr2hex is now deprecated and no longer used.
c   BUG 1914    Updated to calls to  formAddr(), funcName(), and openSocket()
c                to be 64-bit safe. Also have to initialize variables (otherwise
c                they can have garbage in them). Fixed picking /HOST= switch
c   BUG 1880    Updated initiRemote() to call m$error if given an invalid remote
c                index number (ie. not 0-MAXREMOTE) and to initialize most of
c                the remote's fields in the REMOTESTRUCT.
c               Added validRemoteIndex() to validate user inputted remote index
c                received from KEYS, PROPS, PING, and ADDR messages to be in the
c                range of 1-MAXREMOTE. Remote index of 0 is special slot for
c                unknown remotes.
c               Update a few spots in code to be within 72 characters for picky
c                Fortran compilers.
c               Also fixed numerous indentation by using uses spaces after the
c                initial tab, so code is readable when tabstop is not set to 8.
c
c Oct 2009 jwestmiller Retrofit from patch used on nxm201 in Jun 2005 KCS
c   DR 536921-1 Improve handling of results parameters passed in on the
c                command line, including reinitialization on reconnection
c
c Dec 2009 NTN (NeXtMidas 2.7.3)
c   BUG 2032    Added RMIF 1.1 quiet close feature (to NOT send a CLOSED
c                response to the remote when a CLOSE packet has a -CLOSE (-106)
c                value in the info field which was introduced to the Java
c                RMIF version in NeXtMidas 2.7.3.
c
c************
	program RMIF

	include 'rmif.inc'
	integer*4 i,j,k,n,ns,nr,ir,ic,ip,im
	integer*4 ngot,attr,stat,nkey,iproc,prange
	real*8 timeLast,timePing,timeLastPoll,timePoll,timeDrop
	character label*40,stmp*1024,type,statuslabel*40,logname*80
	character*(l_max_ascii) portlabel             ! KCS 2 Apr 2003
	character*256 hostip  ! Host IP Address string for /host=
	integer*4     lhostip ! length of hostip string
	record /HEADER/ hcb
	pointer (phcb,hcb)
	logical*4 timeToPoll
	logical*4 keepadj
	real*4 pause
	character*22 ipstr    ! IP Address:port string
	integer*4    lipstr   ! length of ipstr

c Oct 2009 NTN: Initialize string variables to fix issues on pgf77 64-bit
	hostip      = ' '
	label       = ' '
	stmp        = ' '
	statuslabel = ' '
	logname     = ' '
	portlabel   = ' '
	ipstr       = ' '

	call M$CHECKIN

	socketport = M$LPICK(1)
	prange = M$GET_SWITCH_DEF('PRANGE',1)

	msgmod = 0
	if (M$GET_PSWITCH('PKTMSG')) msgmod=1
	if (M$GET_PSWITCH('KEYMSG')) msgmod=2
	msgid  = M$GET_SWITCH('MSGID')
	pause  = M$GET_DSWITCH_DEF('PAUSE',DBLE(Mc.pause))
	maxretry = M$GET_SWITCH_DEF('RETRY',5)
	maxwindow = M$GET_SWITCH_DEF('WINDOW',12)
	Mu.verbose = M$GET_SSWITCH('VERBOSE')
	reopen = M$GET_SWITCH('RECONN') .gt. 0

	if (M$GET_USWITCH('STATUS',statuslabel).le.0) statuslabel = ' '
	if (M$GET_USWITCH('LOG',logname).le.0) logname = ' '

	keepadj = M$GET_SWITCH ('KEEPADJ') .ge. 1

	! JC4/NTN: fix for Bug 1914 to pick /host switch correctly
	lhostip = M$GET_USWITCH('HOST', hostip)

	time     = 0.0
	timePing = M$GET_SWITCH_DEF('TIMEPING',4)
	timeOut  = M$GET_SWITCH_DEF('TIMEOUT',15)
	timeDrop = M$GET_SWITCH_DEF('TIMEDROP',600)
	timeLast = 0.0d0
	timePoll = 0.2d0
	timeLastPoll = 0.0d0

	initpipes= 0
	localrep = ICHAR(Mc.machine(1:1))
	write (prelabel,'(2HP_,i2.2)') IABS(Mc.macro_level)

	if (.not. Mu.spawn) call M$ERROR ('Not run in background')

! start the logger Feb 2005 KCS: Append rather than open new logfile, to
!                                    aid debugging of resyncing
	if (logname .ne. ' ') then
	  logunit = 19
	  i = M$FILE('OPEN/A/L/E',logunit,logname)
	  call M$NOW(time1,time2)
	  logtime = timestr()
	  write(logunit,*) 'Started RMIF log at '//logtime
	else
	  logunit = 0
	endif

! open the local socket
	socket = openSocket (socketport,prange,hostip)
	if (socket.le.0) call M$ERROR ('Opening socket')
	if (Mu.verbose) write(*,*) 'Opened RMIF port ',socketport
	status = initialize (remote)

!  KCS 2 Apr 2003, write out the actual port number used
	portlabel = M$UPICK(1)
!  Make sure it starts with an ASCII character, not a number
	if ( (ichar(portlabel(1:1)) .ge. 65)  .and.
     &       (ichar(portlabel(1:1)) .le. 90)) then
	  call M$LRSLT(portlabel, socketport)
	endif

! create properties array
	call addProperty ('Q:SETKEY')
	call addProperty ('Q:GETKEY')
	call addProperty ('Q:RETKEY')
	call addProperty ('Q:ACKKEY')
	i = M$UAPICK(2,stmp,0)
 1	i = INDEX(stmp,'|')
	if (i.gt.0) then
	  label = stmp(1:i-1)
	  stmp  = stmp(i+1:)
	else
	  label = stmp
	endif
	call addProperty (label)
	if (label .ne. stmp) goto 1

! init common remote structure
	call M$NOW(time1,time2)
	time = time1+time2
	call setTime (time)
	call initRemote (0)

! add remotes
	nremote = (Mc.number_parameters-2) / 2
	do ir = 1, nremote
	  label = M$APICK(ir*2+1)
	  call addRemote (ir,label)
	  call openRemote (ir)
	  i = M$UAPICK(ir*2+2,stmp,0)
 2	  i = INDEX(stmp,'|')
	  if (i.gt.0) then
	    label = stmp(1:i-1)
	    stmp = stmp(i+1:)
	  else
	    label = stmp
	  endif
	  call addChannel (ir,label)
	  if (stmp .ne. label) goto 2
	enddo

	call M$LRSLT(statuslabel,0)

	lastfunc = 0
	if (initpipes.eq.0) call M$SYNC

! loop forever
	do while (.not. Mc.break)

	  iproc = 0
	  status = 1
	  do while (status.ge.0 .and. iproc.le.8)
	    status = recvPacket (socket,pack,BUFSIZE,ir,0)
	    if (status.ge.0) then
	      call procPacket (pack,status,ir,keepadj)
	      iproc = iproc+1
	    endif
	  enddo

! check for RDP handling
	  status = 1
	  do while (status.ge.0)
	    status = checkRemotes (socket,pack,BUFSIZE,ir,0)
	    if (status.ge.0) then
	      call procPacket (pack,status,ir,keepadj)
	    endif
	  enddo

! process messages
	  if (iproc.ge.0) then
	    status = M$GET_MSG (mqh, kmsg, L_kmsg, 0.0, 0)
	    if (status.gt.0 .and. Mu.verbose)
     &                        write(*,*) 'Got msg: ',mqh.name
	    if (status.gt.0 .and. logunit.ne.0)
     &                        write(logunit,*) 'Got msg: ',mqh.name
	    if (status.gt.0) iproc = iproc+1
	    ir = mqh.info
	    !!! jph -- 31JAN06
	    !!! pack.info = 0
	    call initPacketHeader(pack)
	    pack.rep = localrep
	    if (status.le.0) then
	      status = -1
c
c New message 'OPEN', needed only for X-Midas
c
	    else if (mqh.name .eq. 'RPKT' .or. mqh.name .eq. 'OPEN' .or.
     &               mqh.name(4:7) .eq. 'KEY ') then
	      i = M$LENGTH(kmsg.addr)
	      if (i.gt.0) then
	        ir = indexRemote(kmsg.addr)
	      else
	        ir = -1
	      endif
	      if (mqh.name .eq. 'RPKT') then
	        mqh.name = kmsg.func
	        read(mqh.types(12:14),'(i3.3)') k
	        pack.string(1:k) = kmsg.data(1:k)
	      else
	        nkey = (mqh.ndata-1)/2
	        k = 1
	        pack.string(1:k) = '{'
	        do n = 1,nkey
	          i = M$LENGTH(kmsg.key(n).name)
	          pack.string(k+1:k+i) = kmsg.key(n).name(1:i)
	          k = k+i+1
	          pack.string(k:k) = '='
	          i = M$LENGTH(kmsg.key(n).value)
	          pack.string(k+1:k+i) = kmsg.key(n).value(1:i)
	          k = k+i+1
	          pack.string(k:k) = ','
	        enddo
	        pack.string(k:k) = '}'
	      endif
	      if (mqh.name(1:3) .eq. 'ACK') then
	        pack.func = ACK
	        ip = 4
	      elseif (mqh.name(1:3) .eq. 'GET') then
	        pack.func = GET
	        ip = 2
	      elseif (mqh.name(1:3) .eq. 'RET') then
	        pack.func = RET
	        ip = 3
	      elseif (mqh.name(1:3) .eq. 'SET') then
	        pack.func = SET
	        ip = 1
	      elseif (mqh.name(1:4) .eq. 'OPEN') then
C
C   Process OPEN message in case the automatic reopen didn't work
C      (or the timeouts are too long and you don't want to wait)
C
	        if (logunit.ne.0) write(logunit,*)
     &          'Opening ',nremote,' remotes and ',nchannel,' channels'
	        do i = 1, nremote
	          call openRemote(i)
	        end do
	        do i = 1, nchannel
	          call openChannel(i)
	        end do
	      else
	        call M$WARNING ('Illegal message name: '//mqh.name)
	        goto 20
	      endif

	      if (ir.ge.0) then
	        if (Mu.verbose .or. (logunit .ne. 0)) then
	          lipstr = addr_to_string(remote(ir).addr, ipstr)
	        endif
	        ! addressed - send to addressee only
	        if (Mu.verbose) write(*,*) 'Sent packet '
     &,            f2s(pack.func),' ir=',ir,' hp=',ipstr(1:lipstr)
	        if (logunit.ne.0) write(logunit,*) 'Sent packet '
     &,            f2s(pack.func),' ir=',ir,' hp=',ipstr(1:lipstr)
	        status = sendPacket (socket,pack,k,ir,RDP)
	      endif

	      ! send to all other subscribers
	      nr = ir
c    KCS DR 536921-1
c    The pre-existing comment above seems to indicate that if a blank
c     address was supplied (=> ir = -1), the messages should be sent to
c     all open remotes. That's not what happened previously, at least
c     with RPKT messages.
c    This behavior was maintained if the /RECONN switch (reopen variable)
c     is not specified, though it's somewhat hard to believe that this is
c     what was intended.
c    Note that input RPKT messages have had mqh.name reassigned to
c     kmsg.func above, so this test can't be applied to RPKTs only
	      if (reopen) then
	        do ir = 1, nremote
	          if (remote(ir).state .eq. OPEN .or.
     &            remote(ir).state .eq. OPENED) then
	            status = sendPacket (socket,pack,k,ir,RDP)
	          endif
	        end do
	      else
	        do im = 1, property(ip).members
	          ir = property(ip).member(im)
	          if (ir .ne. nr) status = sendPacket (socket,pack,k,ir,RDP)
	        end do
	      endif
  20	  continue

	    else if (mqh.name .eq. 'KEYS' .or. mqh.name .eq. 'PROPS') then
	      pack.func = GETPROP
	      pack.rep = localrep
	      if (validRemoteIndex(ir,mqh.name(1:4)//' message - ignored'))
     &      status = sendPacket (socket,pack,0,ir,RDP)
	    else if (mqh.name .eq. 'PING') then
	      pack.func = PING
	      pack.rep = localrep
	      if (validRemoteIndex(ir,mqh.name(1:4)//' message - ignored'))
     &      status = sendPacket (socket,pack,0,ir,UDP)
	      if (Mu.verbose) write(*,*)'Sent a PING message to ',ir
	      if (logunit.ne.0) write(logunit,*)'Sent a PING message to ',ir
	    else if (mqh.name .eq. 'ADDR') then
	      if (validRemoteIndex(ir,mqh.name(1:4)//' message - ignored'))
     &      call addRemote (ir,kmsg.addr)
	    else if (mqh.name .eq. 'PAUSE') then
	      write(*,*) 'Pausing for ',mqh.info
	      call M$PAUSE ( FLOAT(mqh.info) )
	      write(*,*) 'Done Pausing'
	    else if (mqh.name .eq. 'EXIT') then
	      goto 99
	    endif
	  endif
! end process messages

! notice the time
	  call M$NOW(time1,time2)
	  time = time1+time2
	  call setTime (time)
! determine poll status
	  timeToPoll = time-timeLastPoll .gt. timePoll
	  if (timeToPoll) timeLastPoll = time

! serve properties other than queued messages
	  do ip = QPROPS+1,nproperty

! handle data pipe property
	    if (property(ip).type .eq. PROP_PIPE) then
	      phcb = property(ip).phcb
	      call M$HCBFUNC(hcb,HCBF_AVAIL,nr)
	      if (property(ip).members .eq. 0) then
	        call M$HCBFUNC (hcb,HCBF_SKIP,-1)
	      elseif (nr.ge.1) then
	        if (hcb.class .eq. 2 .and. hcb.ape.eq.1) then  ! FORCE1000
	          hcb.xfer_len = min(nr,max(1,NINT(BUFSIZE/hcb.dbpe)))
	        elseif (nr.eq.1 .or. hcb.class.eq.2) then
	          hcb.xfer_len = 1
	        else
	          hcb.xfer_len = min(nr,max(1,NINT(1024/hcb.dbpe)))
	        endif
	        call M$GRABX (hcb,pack.data,ngot)
	        call servePipeProperty (property(ip),hcb,pack,ngot)
	        iproc = iproc+1
	      endif

! handle results parameters
	    elseif (property(ip).type .eq. PROP_RESULT .and. timeToPoll)then
	      nr = M$GET_RESULT (property(ip).name,mqd,L_mqd,0,type,attr)
	      if (nr.ge.0 .and. (
     &          type.ne.property(ip).rtype
     &          .or. nr.ne.property(ip).len
     &          .or. M$CHK(mqd,property(ip).value,nr).eq.0)) then
	        property(ip).rtype = type
	        property(ip).len = nr
	        call M$MOVE (mqd,property(ip).value,nr)
	        call serveResultProperty (property(ip),pack)
	      endif
	    endif

! end serve properties loop
	  enddo

! ping remote nodes for status
	  if (time-timeLast .gt. timePing) then
	    do ir = 1, nremote
	      pack.func = PING
	      pack.info = ir
	      pack.rep = localrep

c Oct 2009 NTN: set remote host:port into ipstr for debug/log messages
	      if (Mu.verbose .or. (logunit .ne. 0)) then
	        lipstr = addr_to_string(remote(ir).addr, ipstr)
	      endif
c
c Feb 2005 KCS: If in REOPEN mode, ping even closed remotes.  Once they
c                  come back to life, their PONG reply will cause us to
c                  reopen the connection.
c
	      if (remote(ir).state.eq.OPEN .or.
     &            remote(ir).state.eq.OPENED) then
	        if (time-remote(ir).timePong .gt. timeOut) then
	          if (Mu.verbose) write(*,*)
     &	            'Closing remote because of timeout',ir
	          if (logunit.ne.0) write(logunit,*)
     &	            'Closing remote because of timeout',ir
	          call closeRemote (ir)
	        else if (remote(ir).state.eq.OPEN) then
	          call openRemote (ir)
	          status = sendPacket (socket,pack,0,ir,UDP)
	        else
	          status = sendPacket (socket,pack,0,ir,RDP)
	        endif
	        if (Mu.verbose) write(*,*) 'Sent a PING message to ',ir,
     &            ' hp=',ipstr(1:lipstr)
	        if (logunit.ne.0) write(logunit,*)
     &	          'Sent a PING message to ',ir,' hp=',ipstr(1:lipstr)
	      else if (reopen) then
	        status = sendPacket (socket,pack,0,ir,UDP)
	        if (Mu.verbose) write(*,*)
     &           'Closed but sent a PING message to ',ir,ipstr(1:lipstr)
	        if (logunit.ne.0) write(logunit,*)
     &           'Closed but sent a PING message to ',ir,ipstr(1:lipstr)
	      else if (remote(ir).state.eq.CLOSED) then
	        if (time-remote(ir).timePong .gt. timeDrop) then
	          if (Mu.verbose) write(*,*)
     &           'Dropping remote because of timeout',ir,ipstr(1:lipstr)
	          if (logunit.ne.0) write(logunit,*)
     &           'Dropping remote because of timeout',ir,ipstr(1:lipstr)
	         call dropRemote (ir)
	        endif
	        status = sendPacket (socket,pack,0,ir,UDP)
	      endif
	    enddo
	    timeLast = time
	    if (statuslabel .ne. ' ') then
	      i = 0
	      do ir = 1,nremote
	        if (remote(ir).state.eq.OPENED .and.
     &              remote(ir).origin.gt.0) i = i+1
	      enddo
	      call M$LRSLT (statuslabel,i)
	    endif
	  endif

! don't hog the CPU if we did nothing
	  if (iproc.le.0) call M$PAUSE (pause)

	enddo

! shutdown
 99 	continue
	do ip = QPROPS+1,nproperty
	  if (property(ip).type .eq. PROP_PIPE) then
	    phcb = property(ip).phcb
	    call M$CLOSE (hcb)
	  endif
	enddo
	if (Mu.verbose) write(*,*)
     &               'Closing all remotes because of shutdown',ir
	if (logunit.ne.0) write(logunit,*)
     &               'Closing all remotes because of shutdown',ir
	do ir = 1,nremote
	  call closeRemote(ir)
	enddo
	call M$PAUSE(0.1)

	call closeSocket (socket)

	if (logunit.ne.0) then
	  logtime = timestr()
	  write(logunit,*) 'Stopped RMIF log at '//logtime
	  close(logunit)
	endif

	call M$RETURN

	end
! end program

c**********************************************************************c
	subroutine serveResultProperty (prop,pack)
	include 'rmif.inc'
	integer*4 i,k,im,ir,nr,stat
	record /PROPERTYSTRUCT/ prop
	pack.func = ACK
	pack.string(1:1) = '{'
	i = M$LENGTH(prop.name)
c
c   KCS DR 536921-1
c   Trimming off the P_0x means that the call to M$GET_RESULT won't work, so
c    don't do it
c
cc	if (prop.name(1:2) .eq. 'P_') then
cc	  pack.string(2:1+i-4) = prop.name(5:i)
cc	  k=1+i-4+1
cc	else
	  pack.string(2:1+i) = prop.name
	  k=1+i+1
cc	endif
	pack.string(k:k) = '='
	nr = M$RECAST(prop.value,prop.rtype,prop.len,
     &                pack.data(k+1),'A',bufsize-k-1)
	k = k+nr+1
	pack.string(k:k) = '}'
	do im = 1, prop.members
	  ir = prop.member(im)
	  pack.info = prop.channel(im)
    	  stat = sendPacket (socket,pack,k,ir,RDP)
	enddo
	return
	end


c**********************************************************************c
	subroutine servePipeProperty (prop,hcb,pack,ngot)
	include 'rmif.inc'
	integer*4 k,kt,im,ir,ngot,stat
	record /PROPERTYSTRUCT/ prop
	record /PACKETSTRUCT/ packt
	record /HEADER/ hcb

	k = ngot * hcb.dbpe
	pack.func = DBUF
	pack.rep = localrep
	call M$MOVE (pack,packt,8)
	packt.rep = 0
	do im = 1, prop.members
	  ir = prop.member(im)
	  pack.info = prop.channel(im)
	  if (prop.pms(im).dec .gt. 1) then
	    prop.pms(im).count = prop.pms(im).count + 1
	    if (prop.pms(im).count .lt. prop.pms(im).dec) goto 102
	    prop.pms(im).count = 0
	  endif
	  if (prop.pms(im).comp .ne. 0) then
	    kt = compress (prop.pms(im),pack.data,packt.data,k)
	    packt.func = DBUFC
	    packt.info = pack.info
	    packt.rep = remote(ir).rep
	    stat = sendPacket (socket,packt,kt,ir,UDP)
	  else if (hcb.buf_type .eq. 'B'
     &	    .or. remote(ir).rep .eq. pack.rep) then
	    stat = sendPacket (socket,pack,k,ir,UDP)
	  else
	    if (remote(ir).rep .eq. packt.rep) then
	      ! already converted in packt buffer
	    else if (hcb.format.ne.'NH') then
	      call M$MOVE(pack.data,packt.data,k)
	      call M$CONVERT_TO (remote(ir).machine,
     &                           packt.data, hcb.buf_type, k/hcb.bps)
	    elseif (hcb.class.eq.3 .or. hcb.class.eq.5) then
	      hcb.data_rep = remote(ir).machine
	      call M$MOVE (pack.data,packt.data,k)
	      call M$TRANSFER (hcb,packt.data,hcb,packt.data,ngot,-9)
	      hcb.data_rep = Mc.machine
	    endif
	    packt.info = pack.info
	    packt.rep = remote(ir).rep
   	    stat = sendPacket (socket,packt,k,ir,UDP)
	  endif
 102	enddo
	return
	end


c**********************************************************************c
	function timestr()
	include 'rmif.inc'
	integer*4 i
	character*40 string
	i = M$SEC2TOD(time1,string)
	i = max(1,min(20,i))
	timestr = string(1:i)
	return
	end

c**********************************************************************c
c       Convert RMIF func to a string
c**********************************************************************c
	character*8 function f2s(func)
	implicit none
	byte func
	f2s = ' '
	! Oct 2009 NTN: make 64-bit safe call to funcName()
	call funcName(%val(func),f2s)
	return
	end


c**********************************************************************c
c process packet from remote node
c**********************************************************************c
	subroutine procPacket (pack,len,ir,keepadj)
	include 'rmif.inc'
	integer*4 i,j,k,n,nr,ir,ic,ip,attr,ngot,info,nkey,len,dlen,ds,xet
	character type,label*40,xetkey*3,fstring*8
	logical*4 keepadj
	byte dummy(40)
	record /HEADER/ hcb
	pointer (phcb,hcb)
	integer*4 lipstr   ! NTN: temp var for calling addr_to_string() func

	n = pack.info

! logger/verbose
	if (logunit.ne.0 .or. Mu.verbose) then
	  dlen=len
C
C Feb 2005 KCS, func DBUF should also have the string suppressed
C    Also, don't write out every repeated packet, it overfills the logfile
C
	  if (pack.func.eq.DHDR  .or. pack.func.eq.DBUFD .or.
     &	      pack.func.eq.DBUFC .or. pack.func.eq.DBUF) dlen=0
	  if (pack.func .ne. lastfunc) then
	     logtime = timestr()
	     fstring = f2s(pack.func)
	     lastfunc = pack.func   ! JC4: Promula bug, can't use pac.func in write.
	     if (dlen .gt. 0) then  ! Avoid referring to a string with (1:0)
	       if (logunit.gt.0) write (logunit,*) 'RECV func=',lastfunc,
     &           ' seq=',pack.seq,' ',pack.string(1:dlen),' at ',logtime
	       if (Mu.verbose) write (*,*) 'RECV func=',fstring,
     &           ' seq=',pack.seq,' func ',pack.func,' len ',len
	     else
	       if (logunit.gt.0) write (logunit,*) 'RECV func=',lastfunc,
     &           ' seq=',pack.seq,' len ',len,' at ',logtime
c	       if (Mu.verbose) write (*,*) 'RECV func=',fstring,
c    &            ' seq=',pack.seq,' len ',len
	       if (Mu.verbose) write (*,*) 'RECV func=',lastfunc,
     &           '(',fstring,')',
     &           ' flag=',pack.flag,
     &           ' info=',pack.info,
     &           ' rep=',pack.rep,
     &           ' seq=',pack.seq,
     &           ' try=',pack.try,
     &           ' rpt=',pack.rpt,
     &           ' adj=',pack.adj
	     endif
	  endif
	endif
! end logger/verbose

! xet stuff
	xet = pack.func
	if (pack.func.eq.DBUF) then
	  xet = 0
	elseif (pack.func.eq.GET) then
	  xetkey = 'GET'
	elseif (pack.func.eq.RET) then
	  xetkey = 'RET'
	elseif (pack.func.eq.SET) then
	  xetkey = 'SET'
	elseif (pack.func.eq.ACK) then
	  xetkey = 'ACK'
	else
	  xet = 0
	endif

! data buffer
	if (pack.func .eq. DBUF) then
!
! Feb 2005, KCS: Reset our last data timer
!
          remote(ir).timeData = time
	  if (channel(n).state .ne. OPENED) return
	  if (channel(n).phcb .eq. 0) return
	  if (initpipes .gt. 0) return
	  phcb = channel(n).phcb
	  if (keepadj) then
	    ! This is the legacy mode
	    !  If there is an adjunct header in the packet:
	    !    - for type 2000 data this will cut off the last
	    !        n data bytes (where n = adjunct header size)
	    !    - for type 1000 data you will get everything
	    ngot = len / hcb.dbpe
	    call M$FILAD (hcb,pack.data,ngot)
	  else
	    ! This is the new & default mode
	    ! Output data (starting after adjunct header)
	    ngot = (len-pack.adj) / hcb.dbpe
	    call M$FILAD (hcb,pack.data(1+pack.adj),ngot)
	  endif

! data header
	elseif (pack.func .eq. DHDR) then
	  if (channel(n).phcb .ne. 0) return    ! cant re-open an X-Midas pipe
	  call M$MALLOC (L_header_size, phcb)   ! Feb 2005 KCS: And, we
	  call M$INITIALIZE (hcb)               !     don't need to...
	  call M$MOVE(pack.data,hcb,512)
	  hcb.file_name = channel(n).name
	  call M$ALLOCATE (hcb)
!
!     Feb 2005 KCS: Fix needed to allow framesizes bigger than 32768 bytes
!       to pass successfully.
!     To be consistent with the transferring RMIF, we need to call
!      M$FORCE1000 if the frame size is bigger than our packet buffer
!      (the corresponding call is in addProperty)
!
	  if ((hcb.class .eq. 2) .and. (hcb.dbpe .gt. BUFSIZE))
     &      call M$FORCE1000(hcb)
	  if (initpipes.gt.0) then
	    initpipes = initpipes-1
	    if (initpipes.eq.0) call M$SYNC
	  endif
	  channel(n).phcb = phcb

! get/set/ret command
	elseif (xet.ne.0 .and. msgmod.eq.1) then
	  call M$MOVE(MQH_RPKT,mqh,56)
	  mqh.nslots = (len+7+48)/8 + MQH_RPKT.nhslots
	  write(mqh.types(12:14),'(i3.3)') len
	  mqh.info = pack.info
c     NTN: BUG 1917 - use "host_ip:port" instead of hex version of IP/port
	  lipstr = addr_to_string (remote(ir).addr, kmsg.addr)
c	  call ipaddr2hex (remote(ir).addr, kmsg.addr) ! removed for BUG 1917
	  kmsg.func = xetkey
	  kmsg.data(1:len) = pack.string(1:len)
	  ! write(*,*)  'sending message ',xetkey,mqh.name,mqh.nslots,mqh.types
	  call M$SEND_MSG (mqh,kmsg,msgid,0)

! get/set/ret command
	elseif (xet.ne.0 .or. pack.func.eq.MODIFY) then
	  nkey = 0
	  k = 1 ! the initial "{"
	  if (pack.string(1:1).ne.'{') then
	    k = 0
	    len = len+1
	  endif
	  do while (k .lt. len)
	    nkey = nkey+1
	    i = INDEX(pack.string(k+1:len),'=')
	    j = INDEX(pack.string(k+1:len),',')
	    if (j.eq.0) j=len-k
	    if (i.eq.0) i=j
	    j = max(i+1,j)
	    kmsg.key(nkey).name = pack.string(k+1:k+i-1)
c Oct 2009 JC4: not sure if we need this (so keeping it commented out for now)
c	    if ((pack.string(k+i+1:k+i+1) .eq. '"') .and.
c     &          (pack.string(k+j-1:k+j-1) .eq. '"')) then
c	      ! Newer versions of NeXtMidas quote *all* strings, so strip
c	      ! off quotes before inserting (note that old versions quoted
c	      ! *some* strings
c	      kmsg.key(nkey).value = pack.string(k+i+2:k+j-2)
c	    else
	      kmsg.key(nkey).value = pack.string(k+i+1:k+j-1)
c	    endif
	    k = k+j
	  enddo
	  if (pack.func .eq. MODIFY) then
	    if ( procModify(kmsg,nkey,ir) .le. 0) call M$WARNING
     &        ('Bad Modify String: '//pack.string(1:len))
	  elseif (msgmod .gt. 0) then  ! pass on to macro in this form
	    ngot = 1 + 2*nkey
	    info = pack.info
c       NTN: BUG 1917 - use "host:port" instead of hex version of IP/port
	    lipstr = addr_to_string (remote(ir).addr, kmsg.addr)
c	    call ipaddr2hex(remote(ir).addr, kmsg.addr) ! removed for BUG 1917
	    call M$SEND_MSGL(
     &        xetkey//'KEY',0,msgid,info,0,ngot,'S[40]',kmsg,0)
	  else  ! handle internally
	    k = 1
	    do n = 1,nkey
	      ! see if there is a local result
	      if (kmsg.key(n).name(2:2) .eq. ':') then
	        label = prelabel//kmsg.key(n).name(3:)
	      else
	        label = prelabel//kmsg.key(n).name
	      endif
	      nr = M$GET_RESULT(label,dummy,40,0,type,attr)
	      if (nr.lt.0) label = label(5:)  ! assume global
	      if (pack.func .eq. GET) then
	        label = 'A:'//label
	        nr = M$GET_RESULT(
     &               label,%ref(kmsg.key(n).value),40,0,type,attr)
	        i = M$LENGTH(kmsg.key(n).name)
	        pack.string(k+1:k+i) = kmsg.key(n).name(1:i)
	        k = k+i+1
	        pack.string(k:k) = '='
	        pack.string(k+1:k+nr) = kmsg.key(n).value(1:nr)
	        k = k+nr+1
	        pack.string(k:k) = ','
	      else
	        ds = M$STR2RESULT (label, kmsg.key(n).value, 0)
	      endif
	    enddo
	    if (pack.func .eq. GET) then
	      pack.string(k:k) = '}'
	      pack.func = RET
	      status = sendPacket (socket,pack,k,ir,RDP)
	    endif
	  endif

! message send
	else if (pack.func .eq. SEND) then

! message receive
	else if (pack.func .eq. RECV) then

! open remote/channel
	else if (pack.func .eq. OPEN) then
	  if (ir.eq.0) then
	    call addRemoteAddr(remote(0).addr)
	    ir = indexRemoteAddr(remote(0).addr)
	  endif
	  ic = pack.info
	  if (Mu.verbose) write(*,*) 'Got OPEN packet: ',ic,ir
	  if (logunit .ne. 0) write(logunit,*) 'Got OPEN packet for: '
     &,                              pack.string(1:20)
	  if (ic.le.0) then
	    call rep2machine (pack.rep, remote(ir).machine)
	    remote(ir).rep = pack.rep
	    remote(ir).state = OPENED
	    remote(ir).origin = 1
	    remote(ir).recvChk = pack.seq
	    pack.func = OPENED
	    pack.rep = localrep
	    status = sendPacket (socket,pack,0,ir,RDP)
	    remote(ir).timePong = time
	    if (logunit.ne.0) write(logunit,*)
     &	      'Sent OPENED, Remote rep ', remote(ir).machine
	  elseif (ir.le.0 .or. remote(ir).state.ne.OPENED) then
	    call M$WARNING('Cannot open channel on closed remote')
	  elseif (pack.string(1:5) .eq. 'PIPE:') then
	    label = pack.string(6:len)
	    ip = indexProperty (label,PROP_PIPE)
	    if (ip.gt.0) then
	      nr = 512
	      phcb = property(ip).phcb
	      call M$MOVE (hcb,pack.data,nr)
	      if (remote(ir).rep .ne. localrep) then
	        pack.string(5:8)  = remote(ir).machine  ! head_rep
	        pack.string(9:12) = remote(ir).machine  ! data_rep
	        call M$CONVERT_HEADER_TO (pack.data)
	      endif
	      pack.func = DHDR
	      status = sendPacket (socket,pack,nr,ir,RDP)
	      call addMember(ir,ic,ip)
	      if (logunit.ne.0) write(logunit,*)
     &          'Sent RDP, Remote rep ', remote(ir).machine
	    else
	      call M$WARNING ('Pipe not found: '//label)
	    endif
	  elseif (pack.string(1:2) .eq. 'Q:') then
	    label = pack.string(3:len)
	    ip = indexProperty (label,PROP_MSG)
	    if (ip.gt.0) call addMember(ir,ic,ip)
	  elseif (len.eq.3 .and. pack.string(1:3).eq.'SET') then
	    call addMember(ir,ic,1)  ! preset properties
	  elseif (len.eq.3 .and. pack.string(1:3).eq.'GET') then
	    call addMember(ir,ic,2)  ! preset properties
	  elseif (len.eq.3 .and. pack.string(1:3).eq.'RET') then
	    call addMember(ir,ic,3)  ! preset properties
	  elseif (len.eq.3 .and. pack.string(1:3).eq.'ACK') then
	    call addMember(ir,ic,4)  ! preset properties
	  else
	    label = pack.string(1:len)
	    ip = indexProperty (label,PROP_RESULT)
	    if (ip.gt.0) call addMember(ir,ic,ip)
c   KCS DR 536921-1 Update the results parameters after a new remote
c                   has connected or reconnected
c
	    nr = M$GET_RESULT (property(ip).name,mqd,L_mqd,0,type,attr)
	    if (nr .ge. 0) then
	      property(ip).rtype = type
	      property(ip).len = nr
	      call M$MOVE (mqd,property(ip).value,nr)
	      call serveResultProperty (property(ip),pack)
	    endif
c   --------------- End of DR 536921-1 cahnges
	  endif

! a remote OPEN response
	else if (pack.func .eq. OPENED) then
	  if (ir.le.0) then
	    call M$WARNING ('Unsolicited OPENED packet')
	  else
	    remote(ir).state = OPENED
	    call rep2machine (pack.rep, remote(ir).machine)
	    do ic = 1, nchannel
	      if (channel(ic).ir .ne. ir) then
	      else if (channel(ic).state .eq. OPENED) then
	      else
	        call openChannel(ic)
	      endif
	    enddo
	  endif

! close remote/channel
	else if (pack.func .eq. CLOSE) then
	  ic = pack.info
	  if (ir .le. 0) then
	    ! only warn if NOT QUIET CLOSE request from RMIF 1.1 remote
	    if (ic .ne. -CLOSE) then
	      call M$WARNING('Cannot close an unopened remote')
	    endif
	  elseif (ic .le. 0) then
	    do ip = 1, nproperty
	      if (property(ip).members .gt. 0) call delMember(ir,-1,ip)
	    enddo
	    remote(ir).state = DROPPED
	  else
	    do ip = 1, nproperty
	      if (property(ip).members .gt. 0) call delMember(ir,ic,ip)
	    enddo
	  endif
	  if (ic .eq. -CLOSE) then
	    ! RMIF 1.1 remote requested a QUIET CLOSE (so do not respond with CLOSED)
	    if (Mu.verbose) write(*,*) 'Got QUIET CLOSE ir=',ir
	  elseif (ir .gt. 0) then
	    pack.func = CLOSED
	    pack.rep = localrep
	    status = sendPacket (socket,pack,0,ir,RDP)
	  endif

! close remote/channel response
	else if (pack.func .eq. CLOSED) then
	  if (ir.le.0) then
	    call M$WARNING ('Unsolicited CLOSED packet')
	  else
	    remote(ir).state = CLOSED
	  endif

! got pinged by a remote
	else if (pack.func .eq. PING) then
	  pack.func = PONG
	  pack.rep = localrep
	  status = sendPacket (socket,pack,0,ir,RDP)

! got ponged by a remote
	else if (pack.func .eq. PONG) then
	  ir = pack.info
	  if (Mu.verbose) write(*,*) 'Got a PONG message from ',ir
     &,                 ' state ',f2s(remote(ir).state)
	  if (logunit.ne.0) write(logunit,*) 'Got a PONG message from ',ir
     &,                 ' state ',f2s(remote(ir).state)
!
! In REOPEN mode, if the remote cycled off and on too quickly, the standard
!  timeout may not have picked this up.  To get around this, we keep a timer
!  on the last data received.  Once this exceeds the timeout, mark the remote
!  as CLOSED so that any future PONG from it will restart the connection.
!
	  if (reopen .and. remote(ir).timeData .gt. 0 .and.
     &       (time-remote(ir).timeData .gt. timeOut)) then
	    if (Mu.verbose) write(*,*) 'Data timeout on remote ',ir
	    if (logunit.ne.0) write(logunit,*)
     &                      'Data timeout on remote ',ir
	    call closeRemote (ir)
	  endif
!
! Feb 2005 KCS: Try to reopen remotes that were closed because of timeout
!
	  if (reopen .and.
     &        remote(ir).state .ne. OPENED .and.
     &        remote(ir).state .ne. OPEN) then
	    call openRemote(ir)
	    do i = 1, nchannel
	      call openChannel(i)
	    end do
	  endif
	  remote(ir).timePong = time
! query for available properties
	else if (pack.func .eq. GETPROP) then
	  n = pack.info
	  if (n .eq. 0) then
	      k = M$L2A(nproperty,pack.string)
	  elseif (n.gt.0 .and. n.le.nproperty) then
	      k = M$LENGTH(property(n).name)
	      if (property(n).name(1:4) .eq. prelabel) then
	        pack.string(1:k-4) = property(n).name(5:k)
	        k = k-4
	      else
	        pack.string(1:k) = property(n).name(1:k)
	      endif
	  endif
	  pack.func = RETPROP
	  status = sendPacket (socket,pack,k,ir,RDP)

! reply to query for available properties
	else if (pack.func .eq. RETPROP) then
	  n = pack.info
	  write(*,*)  'Property ',n,' = ',pack.string(1:len)
	  if (n .eq. 0) then
	    read(pack.string(1:len),*) nkey
	    do n = 1,nkey
	      pack.func = GETPROP
	      pack.info = n
	      status = sendPacket (socket,pack,0,ir,RDP)
	    enddo
	  endif

	endif

	return
	end
! end procPacket


c**********************************************************************c
	function procModify (kmsg,nkey,ir)
	include 'rmif.inc'
	integer*4 im,ir,ip,n,nkey
	real*8 dval
	status = 0
	if (kmsg.key(1).name .eq. 'PROPERTY') then
	  ip = indexProperty (kmsg.key(1).value,0)
	  if (ip .gt. 0) then
	  im = indexMember (ip,ir)
	  do n = 2,nkey
	  if (kmsg.key(n).name .eq. 'DEC') then
	    status = M$A2D (kmsg.key(n).value,dval)
	    if (status.gt.0) property(ip).pms(im).dec = dval
	  else if (kmsg.key(n).name .eq. 'TRIM1') then
	    status = M$A2D (kmsg.key(n).value,dval)
	    if (status.gt.0) property(ip).pms(im).trim1= max(0,NINT(dval)-1)
	  else if (kmsg.key(n).name .eq. 'TRIM2') then
	    status = M$A2D (kmsg.key(n).value,dval)
	    if (status.gt.0) property(ip).pms(im).trim2 = max(0,NINT(dval))
	  else if (kmsg.key(n).name .eq. 'PLOTWIDTH') then
	    status = M$A2D (kmsg.key(n).value,dval)
	    if (status.gt.0) property(ip).pms(im).plotwidth = dval
	  else if (kmsg.key(n).name .eq. 'COMP') then
	    status = M$A2D (kmsg.key(n).value,dval)
	    if (status.gt.0) property(ip).pms(im).comp = dval
	  endif
	  enddo
	  endif
	endif
	procModify = status
	return
	end

c**********************************************************************c
	subroutine addProperty (name)
	include 'rmif.inc'
	integer*4 ip
	character name*(*)
	record /HEADER/ hcb
	pointer (phcb,hcb)
	if (name.eq.' ') return
	ip = nproperty+1
	if (ip.gt.MAXPROPERTY)
     &		call M$ERROR('Too many properties - see MAXPROPERTY')
	property(ip).type = PROP_RESULT
	property(ip).rtype = ' '
	property(ip).name = name
	property(ip).members = 0
	if (name(1:1).eq.'_') then
	  property(ip).type = PROP_PIPE
	  call M$MALLOC (L_header_size,phcb)
	  call M$INIT(hcb,name,' ',' ',0)
	  call M$OPEN(hcb,HCBF_INPUT)
	  ! to allow frames larger than our packet buffer to pass
	  if(hcb.class.eq.2 .and. hcb.dbpe.gt.BUFSIZE) call M$FORCE1000(hcb)
	  hcb.xfer_len = 1
	  property(ip).phcb = phcb
	elseif (name(1:2).eq.'Q:') then
	  property(ip).type = PROP_MSG
	  property(ip).name = name(3:)
	endif
	nproperty = ip
	return
	end

c**********************************************************************c
	function indexProperty (name,type)
	include 'rmif.inc'
	integer*4 type,n,i
	character name*(*)
	indexProperty = 0
	do n = 1,nproperty
	  i = 1
c   KCS DR 536921-1 Trimming off the P_0x means that the call to
c                   M$GET_RESULT won't work, so don't do it
c
cc	  if (property(n).name(1:2) .eq. 'P_') i=5
	  if (property(n).name(i:) .eq. name .and.
     &	     (property(n).type .eq. type .or. type .eq. 0) ) then
	    indexProperty = n
	  endif
	enddo
	return
	end

c**********************************************************************c
	function indexMember (ip,ir)
	include 'rmif.inc'
	integer*4 ip,ir,im
	indexMember = 0
	if (ip.lt.0 .or. ip.gt.nproperty) return
        do indexMember = 1,property(ip).members
	  if (property(ip).member(indexMember) .eq. ir) return
	enddo
	return
	end

c**********************************************************************c
	subroutine addMember (ir,ic,ip)
	include 'rmif.inc'
	integer*4 im, ir, ic, ip
	do im = 1, property(ip).members
	  if (property(ip).member(im) .eq. ir) return
	enddo
	im = property(ip).members+1
	if (im.gt.MAXMEMBER) then
	  call M$WARNING ('Too many members - see MAXMEMBER')
	  return
	endif
	property(ip).member(im) = ir
	property(ip).channel(im) = ic
	property(ip).members = im
	property(ip).pms(im).count = 0
	property(ip).pms(im).dec = 0
	property(ip).pms(im).plotwidth = 512
	property(ip).pms(im).comp = 0
	property(ip).pms(im).trim1 = 0
	property(ip).pms(im).trim2 = 0
	return
	end

c**********************************************************************c
	subroutine delMember (ir,ic,ip)
	include 'rmif.inc'
	integer*4 n, m, ir, ic, ip
	do n = 1, property(ip).members
	  if (property(ip).member(n) .eq. ir) then
	   if (ic.lt.0 .or. property(ip).channel(n) .eq. ic) then
	    property(ip).members = property(ip).members-1
	    do m = n, property(ip).members
	      property(ip).member(n) = property(ip).member(n+1)
	      property(ip).channel(n) = property(ip).channel(n+1)
	    enddo
	    return
	   endif
	  endif
	enddo
	return
	end

c**********************************************************************c
c Add remote (hex of IP address/port or IP address:port string
c at specified ir (index-of-remote), valid range is 0-MAXREMOTE
c**********************************************************************c
	subroutine addRemote (ir,name)
	include 'rmif.inc'
	integer*4 ir,i,j,k,port,lbuf(2)
	character host*40, name*(*)
	call initRemote(ir)
	remote(ir).name = name
	if (name(1:2) .eq. '0X') then
	  read(name(3:10),'(z8.8)',err=9) lbuf(1)
	  read(name(11:18),'(z8.8)',err=9) lbuf(2)
	  call M$MOVE(lbuf,remote(ir).addr,8)
	else
	  i = INDEX(name,':')
	  j = M$LENGTH(name)
	  if (i.le.1) goto 9
	  read(name(i+1:j),*,err=9) port
	  host = name(1:i-1)
	  ! Oct 2009 JC4/NTN: make 64-bit safe call to formAddr()
	  k = formAddr (host, port, remote(ir).addr)
	endif
	remote(ir).state = CLOSE
	nremote = max(ir,nremote)
	call setRemotes (nremote)  ! for the C routines
	return
  9	call M$WARNING ('addRemote: Bad remote address: '//name)
	return
	end

	subroutine dropRemote (ir)
	include 'rmif.inc'
	integer*4 ir
	call closeRemote(ir)
	remote(ir).state = DROPPED
	return
	end

c**********************************************************************c
c Validate user inputed Remote Index (should be 1-MAXREMOTE(32)), calls
c M$WARNING if it is not in valid range and returns .false.
c otherwise returns .true.
c For BUG 1880 to warn when user inputed ir (from msg.info) is invalid
c @since NeXtMidas 2.7.3
c**********************************************************************c
	function validRemoteIndex (ir,callerName)
	include 'rmif.inc'
	integer*4 ir
	character callerName*(*)
	integer*4 len
	character temp*16
	if (ir .lt. 1 .or. ir .gt. MAXREMOTE) then
	  validRemoteIndex = .false.
	  len = M$L2A(ir,temp)
	  call M$WARNING('Got illegal remote index '
     &            //temp(1:len)//' from '//callerName)
      return
	endif
	validRemoteIndex = .true.
	return
	end

c**********************************************************************c
c Initialize remote at specified index (0-MAXREMOTE(32). I.e.
c zero out/init most fields in the REMOTESTRUCT representing the remote.
c**********************************************************************c
	subroutine initRemote (ir)
	include 'rmif.inc'
	integer*4 ir, len
	character temp*16

	! JC4/NTN: fix for Bug 1880 to error out when given an invalid remote index #
	! NTN: the valid range here is 0-MAXREMOTE (different than in validRemoteIndex)
	if ((ir .lt. 0) .or. (ir .gt. MAXREMOTE)) then
	  len = M$L2A(ir,temp)
	  call M$ERROR('initRemote: Got illegal remote index '//temp(1:len))
	endif

	! JC4/NTN: fix for Bug 1880 is to zero out/init most fields in REMOTESTRUCT
	remote(ir).name    = ' '
	remote(ir).addr(1) = 0
	remote(ir).addr(2) = 0
	remote(ir).addr(3) = 0
	remote(ir).addr(4) = 0
	remote(ir).machine = ' '
	remote(ir).state   = 0
	remote(ir).rep     = localrep
	remote(ir).origin  = 0
	remote(ir).maxretry  = maxretry
	remote(ir).maxwindow = maxwindow

	remote(ir).timePong  = 0
	remote(ir).timeRetry = 0.2d0
	remote(ir).timeData  = -1.d0
	remote(ir).latency   = 0
	remote(ir).sendOff   = 0
	remote(ir).sendSeq   = 0
	remote(ir).sendChk   = 0
	remote(ir).sendQueue = 0
	remote(ir).sendDrop  = 0
	remote(ir).sendOther = 0
	remote(ir).recvOff   = 0
	remote(ir).recvSeq   = 0
	remote(ir).recvChk   = 0
	remote(ir).recvQueue = 0
	remote(ir).recvLost  = 0
	remote(ir).recvReOrder = 0

	return
	end

c**********************************************************************c
c   deprecated since NeXtMidas 2.7.3 - no longer used (see BUG 1917)
	subroutine ipaddr2hex (ipaddr,string)
	include 'rmif.inc'
	integer*4 lbuf(2)
	character*(*) string
	call M$MOVE(ipaddr,lbuf,8)
	write (string,'(2h0Xz8.8,z8.8)') lbuf(1),lbuf(2)
	!write(*,*)  'IPADDR = '//string
	return
	end

c**********************************************************************c
	subroutine addRemoteAddr (ipaddr)
	include 'rmif.inc'
	integer*4 ir,i
	ir = indexRemoteAddr(ipaddr)
	if (ir.le.0) then	! try reuse old slot
	 do i = nremote,1,-1
	  if (remote(i).state .eq. DROPPED) ir = i
	 enddo
	 if (ir.gt.0) call initRemote(ir)
	endif
	if (ir.le.0) then
	  ir = nremote+1
	  if (ir.gt.MAXREMOTE) then
	    call M$WARNING('Too many remotes - see MAXREMOTE')
	    return
	  endif
	  nremote = ir
	  call initRemote(ir)
	  call setRemotes (nremote)
	endif
	call M$MOVE(ipaddr,remote(ir).addr,IPADDRSIZE)
	remote(ir).timePong = time
	return
	end

c**********************************************************************c
	subroutine openRemote (ir)
	include 'rmif.inc'
	integer*4 ic, ir, ip
C
C Feb 2005 KCS, allow reopening remotes that have cycled
C
	if (remote(ir).state .eq. OPENED .and. .not. reopen) return
	pack.func = OPEN
	pack.info = 0
	pack.rep = localrep
	if (Mu.verbose) write(*,*)  'Opening remote ',ir
	if (logunit.ne.0) write(logunit,*)  'Opening remote ',ir
	status = sendPacket (socket,pack,0,ir,RDP)
	! dont reset time if retrying open so it can time out
	if (remote(ir).state .ne. OPEN) remote(ir).timePong = time
	remote(ir).origin = 0
	remote(ir).state = OPEN
	return
	end

c**********************************************************************c
	subroutine rep2machine (rep,machine)
	byte rep
	character*4 machine
	if (rep.eq.ICHAR('I'))then
	  machine = 'IEEE'
	elseif (rep.eq.ICHAR('V'))then
	  machine = 'VAX'
	else
	  machine = 'EEEI'
	endif
	return
	end

c**********************************************************************c
	subroutine closeRemote (ir)
	include 'rmif.inc'
	integer*4 ic, ir, ip
	if (remote(ir).state .eq. CLOSED) return
	do ic = 1, nchannel
	  if (channel(ic).ir .ne. ir) then
	  else if (channel(ic).state .eq. CLOSED) then
	  else
	    call closeChannel(ic)
	  endif
	enddo
	do ip = 1, nproperty
	  if (property(ip).members .gt. 0) call delMember(ir,-1,ip)
	enddo
	pack.func = CLOSE
	pack.info = 0
	pack.rep = localrep
	if (Mu.verbose) write(*,*)  'Closing remote ',ir
	if (logunit.ne.0) write(logunit,*) 'Closing remote ',ir
	status = sendPacket (socket,pack,0,ir,RDP)
	remote(ir).state = CLOSED
	return
	end

c**********************************************************************c
c returns index of remote for specified IP address/port (if found),
c otherwise returns 0 for unknown remote and store ipaddr at remote index 0
c**********************************************************************c
	function indexRemoteAddr (ipaddr)
	include 'rmif.inc'
	integer*4 ir,i
	do ir = 1,nremote
	  if (ipaddr(1).eq.remote(ir).addr(1) .and.
     &	      ipaddr(2).eq.remote(ir).addr(2) ) then
	    indexRemoteAddr = ir
	    return
	  endif
	enddo
	call M$MOVE(ipaddr, remote(0).addr, IPADDRSIZE)
	indexRemoteAddr = 0
	return
	end

c**********************************************************************c
c returns index of remote for specified hex of IP address/port,
c remote name, or IP address:port string (if found),
c otherwise returns 0 for unknown remote and store at remote index 0
c**********************************************************************c
	function indexRemote (name)
	include 'rmif.inc'
	integer*4 ir,i,j,k,port,lbuf(4)
	character*(*) name
	character*32 host
	indexRemote = 0
	if (name(1:2).eq.'0X') then
	  read(name(3:10),'(z8.8)',err=9) lbuf(1)
	  read(name(11:18),'(z8.8)',err=9) lbuf(2)
	  indexRemote = indexRemoteAddr(lbuf)
	  return
	endif
	do ir = 1,nremote
	  if (name.eq.remote(ir).name) then
	    indexRemote = ir
	    return
	  endif
	enddo
	i = INDEX(name,':')
	j = M$LENGTH(name)
	if (i.gt.0 .and. i.lt.j) then
	  read(name(i+1:j),*,err=9) port
	  host = name(1:i-1)
	  ! Oct 2009 JC4/NTN: make 64-bit safe call to formAddr()
	  k = formAddr (host, port, lbuf)
	  indexRemote = indexRemoteAddr(lbuf)
	  if (indexRemote.gt.0) return
	endif
	! have unknown remote, save it at remote index 0
	indexRemote = 0
	call addRemote(0,name)
	return
  9	call M$WARNING ('indexRemote: Bad remote address: '//name)
	return
	end

c**********************************************************************c
	subroutine addChannel (ir,name)
	include 'rmif.inc'
	integer*4 ir, ic, ie
	character name*(*)
	ic = nchannel+1
	if (ic.gt.MAXCHANNEL) then
	  call M$WARNING('Too many channels - see MAXCHANNEL')
	  return
	endif
	ie = INDEX(name,'=')
	if (ie.gt.0) then
	  channel(ic).name = name(1:ie-1)
	  channel(ic).rname = name(ie+1:)
	else
	  channel(ic).name = name
	  channel(ic).rname = name
	endif
	channel(ic).ir = ir
	channel(ic).type = PROP_RESULT
	channel(ic).state = OPEN
	if (name(1:1) .eq. '_') then
	  channel(ic).type = PROP_PIPE
	  initpipes = initpipes+1
	endif
	if (name.eq.'SET' .or. name.eq.'GET' .or.
     &	    name.eq.'RET' .or. name.eq.'ACK') channel(ic).type= PROP_KEY
	if (name(1:2) .eq. 'Q:') channel(ic).type = PROP_MSG
	channel(ic).phcb = 0
	nchannel = ic
	return
	end

c**********************************************************************c
	subroutine openChannel (ic)
	include 'rmif.inc'
	integer*4 ir, ic, ln
C
C Feb 2005 KCS, allow reopening channels that have cycled
C
	if (logunit.ne.0) write(logunit,*) 'Before OC reopen ',reopen
	if (channel(ic).state .eq. OPENED .and. .not. reopen) return
	ir = channel(ic).ir
	pack.func = OPEN
	pack.info = ic
	pack.rep = localrep
	if (channel(ic).type .eq. PROP_PIPE) then
	  pack.string(1:40) = 'PIPE:'//channel(ic).rname
	  ln = M$LENGTH(pack.string(1:40))
	  status = sendPacket (socket,pack,ln,ir,RDP)
	else
	  ln = M$LENGTH(channel(ic).name)
	  pack.string(1:32) = channel(ic).name
	  status = sendPacket (socket,pack,ln,ir,RDP)
	endif
	if (logunit.ne.0) write(logunit,*) 'Opening channel: '
     &,                                   pack.string(1:40)
	channel(ic).state = OPENED
	return
	end

c**********************************************************************c
	subroutine closeChannel (ic)
	include 'rmif.inc'
	integer*4 ir, ic
	if (channel(ic).state .eq. CLOSED) return
	channel(ic).state = CLOSED
	return
	end

c**********************************************************************c
	subroutine sendMessage (text,lt,ir,pack,len)
	include 'rmif.inc'
	integer*4 lt,ir,len,ld
	byte text(80),data(128)
	record /mqd_RERR/ rerr
	integer*4 lipstr ! NTN: temp var for calling addr_to_string(..) func

	call M$MOVE(MQH_RERR,mqh,56)
	ld = max(0,len-8)
	mqh.nslots = (ld+7+128)/8 + MQH_RERR.nhslots
	write(mqh.types(17:19),'(i3.3)') ld
	mqh.info = 0
! Oct 2009 NTN: BUG 1917 - use "host:port" instead of hex version of IP/port
	lipstr = addr_to_string (remote(ir).addr, rerr.addr)
c	call ipaddr2hex (remote(ir).addr, rerr.addr) ! removed for BUG 1917
	call M$MOVE(text,%ref(rerr.text),lt)
	if (len.gt.0) then
	  rerr.func = f2s(pack.func)
	  ld = min(ld,128) ! JC4: MJW MOD prevent buffer overrun
	  call M$MOVE(pack.data,%ref(rerr.data),ld)
	endif
	call M$SEND_MSG (mqh,rerr,msgid,0)
	return
	end

c**********************************************************************c
c Initialize the packet header so other packets do not interfere
c**********************************************************************c
	subroutine initPacketHeader(p)
	include 'rmif.inc'
	record /PACKETSTRUCT/ p

	p.func = 0           ! function (SET|GET|RET|ACK|OPEN...)
	p.flag = 0           ! version / modifiers (BINARY|XML|ASCII)
	p.info = 0           ! packet info field
	p.rep  = 0           ! raw data representation
	p.seq  = 0           ! packet sequence number (0-127)
	p.try  = 0           ! number of retries
	p.rpt  = 0           ! packet report
	p.adj  = 0           ! bytes in adjunct header

	end
