	Program AtNode

c  must handshake before going conversational to avoid hang
c  i.e. if first line from remote is *, then conversational.
c  increased line buffers to 1000 to accommodate long ONELINE commands

	Implicit Integer(a-z)
	Character*40	Node		! Argument
	Character*60	Task_Name	! Argument
	Character*80	Command		! Built from the two arguments
	Character*1000	Line		! Buffer for data returned
	Character*1000	Command_Line	! Buffer for command

	logical		Converse	! Flag indicating whether to pass param

	External	Err_NoSuchTask	! Defined in ATNODEMSG.MSG
	External	Err_BadNodeName	! Defined in ATNODEMSG.MSG

* 	Collect the node name, remote task and their lengths.  "'node_name'"
*	and "'remote_task'" are required elements defined in ATNODE.CLD.
*	If the elements are not found return a system error code via 
*	LIB$SIGNAL.

	status = cli$get_value ('node_name',
	2                        Node,
	2                        Node_Len)
	if (.not. status) call lib$signal (%val (status))

	colon = index(Node(1:Node_Len),'::')

*	If colons were not included then this is not a valid node name
	if (colon .eq. 0) goto 500

	status = cli$get_value ('remote_task',
	2                        Task_Name,
	2                        Task_Name_Len)
	if (.not. status) call lib$signal (%val (status))


*	Remove trailing blanks and tabs from the two input parameters

	call str$trim(Node, Node, Node_Len)
	call str$trim(Task_Name, Task_Name, Task_Name_Len)


*	Form the 'filename' i.e., NODE::"TASK=COMMANDPROCEDURE"

	Command_Len = Node_Len + Task_Name_Len + 7
	Command(1:Command_Len) =
	2 Node(1:Node_Len)//'"TASK='//Task_Name(1:Task_name_Len)//'"'

*	Establish a logical link with the remote task

c  Fortran Users Guide VMS 4.0 in Network Task-to-Task section 5-8
c  says OPEN(FORM='UNFORMATTED'
c  else FORM='FORMATTED' and CARRIAGECONTROL='NONE'
c  but Bynon did it this way and it works, so Belonis left it.
	open (unit=1, name=Command(1:Command_Len), access='SEQUENTIAL', 
	2	recl=1000, status='OLD', err=400)

	if( cli$get_value('command',
	1			Command_line,
	1			len) ) then
		call unquote( command_line, command_line, len )
c50		write(1,'(a)',err=200) command_line(1:len)
c		print *,command_line
	endif

*	Accept input from the remote task, and display it until EOF or *

	do while (.true.)
	  Line_Len = 0
	  read (1,100,err=200,end=300) Line_len,Line(1:Line_Len)
100	  format(q,a<Line_Len>)
200	  if (Line_Len .lt. 1) then
	    Line_Len = 1
	    Line(1:2) = ' '		! bad ????
	  endif
	  if( (line_len.eq.1) .and. 
	1	(line(1:line_len).eq.'*') ) then
*	Asterisk received from remote, get another line from user
	    if(len.eq.0) then	! no commandline
250		status=lib$get_input(
	1		command_line, Node(1:Node_len)//' ', len )
		if(.not.status) goto 300
	    endif
*	Send line to remote
	    write(1,'(a)',err=200) command_line(1:len)
	    len = 0		! set 'no commandline' flag
	  else
*	Display ordinary output from remote
	    call lib$put_output(line(1:Line_Len))
	  endif
	enddo	! forever

*	Disconnect the link    would be nice to have option to kill server.

300	close (unit=1)
	call exit

400	call lib$signal(Err_NoSuchTask, %val(2),Task_Name(1:Task_Name_Len),
	2	Node(1:Node_Len))
	call exit

500	call lib$signal(Err_BadNodeName, %val(1), Node(1:Node_Len))
	call exit

	end

      subroutine unquote( instr, outstr, outlen )
c  deletes single quotes and converts pairs to single quotes
c  if not in quotes compresses leading and internal spaces and capitalizes
c  strips trailing spaces
c  note: length integer*2
      character*1 ch, last
      character*(*) instr, outstr
      integer*2 outlen, ip, op
      logical*1 inq
 
      inq = .false.		! .true. if in quotes
      last = ' '
      op = 0			! output pointer
 
      do ip = 1, len( instr )	! input pointer
         ch = instr( ip:ip )
         if ( ch .eq. '"' ) then
            if ( .not. inq .and. last .eq. '"' ) then
               op = op + 1
               outstr( op:op ) = '"'
            end if
            inq = .not. inq
         else if ( inq ) then	! copy unchanged if in quotes
            op = op + 1
            outstr( op:op ) = ch
         else if ( ch .eq. ' ' .and. last .eq. ' ' ) then   ! compress spaces
            continue
         else if ( 'a' .le. ch .and. ch .le. 'z' ) then		! capitalize
            op = op + 1
            outstr( op:op ) = char( ichar( ch ) - 32 )
         else			! copy unchanged if not special
            op = op + 1
            outstr( op:op ) = ch
         end if
         last = ch
      end do
 
c  if passed outlen, then set it stripping trailing blank
      if ( %loc( outlen ) .ne. 0 ) then
         if ( last .eq. ' ' .and. .not. inq ) then
            outlen = op - 1
         else
            outlen = op
         end if
      end if
 
      return
 
      end

