PROGRAM RMC C IDENT /3.1/ C C-------RMC REMOTE MCR FUNCTION C C Allows remote manipulation of terminals C C >RMC TI:MCR COMMAND STRING C for commands targeted for TI: C C >RMC TTN:MCR COMMAND STRING C for commands targeted for terminal unit 'N' C RMC stays in core until the remote command completes. C C >RMC TTN:$MCR COMMAND STRING C for commands for which RMC is not to wait for exit status. C However, it tries to pass on the OCB via RPOI. C C MODIFIED: C 16-APR-80 J. DOWNWARD FIX BUG FOR TI: #'S >7. CLEAN UP CODE C TO MAKE MORE LINEAR. FIX BUG IN ERROR C MESSAGE. C C 29-APR-81 J. DOWNWARD MODIFIED TO USE FORTRAN-77 FEATURES C C 03-SEP-81 J. DOWNWARD Modified to use the RPOI (Chain) C directive of RSX11M V4.0. C C 19-Nov-81 J. Downward Work with any CLI (whatever' at C the terminal) DIMENSION ICMD(40),IEXBLK(8) CHARACTER*1 LRET ! Carriage return CHARACTER*2 LDEV CHARACTER*80 LCMD CHARACTER*80 LMCRBF PARAMETER LUN=1 ! Error msgs to TI: on LUN=1 PARAMETER IRPOEX=128 ! Force issuing task to exit PARAMETER IRPONL=2 ! Pass on only 1 OCB DATA CLI /6RCLI.../ ! Spawn commands to MCR... DATA LRET /"15/ ! Carriage return IUNIT=0 ! Assume unit #0 IER=0 ! Assume get command line err ISTOP=1 ! Stop after spawning command IEF=1 ! event flag 1 IEXSTS=1 ! Assume sucessful exit status C IFLG=IRPOEX+IRPONL ! Exit on success and pass OCB IFLG=IRPONL ! Pass only one OCB to MCR... CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,) CALL GETMCR(LMCRBF,IBYT) ! Get command line OPEN(UNIT=LUN,NAME='TI:') ! Assign ti: to lun CALL CHKPRV(LUN,IUPRV,ITPRV) ! Is TI: is privleged? C ! Requires get term char. IF(IBYT.LE.1) GOTO 9010 ! No command line,error exit ICOL=INDEX(LMCRBF(1:IBYT),':') ! Is a ':' in command line IF(ICOL.EQ.0) GOTO 9020 ! If yes, OK IF(IUPRV.EQ.0) GOTO 9050 ! Terminal not privleged II=ICOL ! Save pointer to colon J=ICOL+1 ! Point where a '$' might be IF(LMCRBF(J:J).EQ.'$') THEN ! ISTOP=0 ! If there,don't wait for exit II=ICOL+1 ! Move pointer to '$' ENDIF ! IF(II.GE.IBYT) GOTO 9030 ! No command? IBYT=IBYT-II ! Byte count of command LCMD=LMCRBF(II+1:II+IBYT) ! Transfer command C C First test to see if a command without a unit # has been issued, C ie, VT:cmd or TI:cmd. LDEV=LMCRBF(ICOL-2:ICOL-1) ! See if TI: or VT: READ(LDEV,100)IDEV ! Insert into IDEV 100 FORMAT(1A2) ! IUNIT=0 ! IF(LDEV.EQ.'VT') GOTO 2000 ! If a VT, are ready to spawn IF(LDEV.EQ.'TI') GOTO 2050 ! If using 'TI:' SPAWN it C C Now, see if a valid command of the form TTuuu:cmd is present C JJ=INDEX(LMCRBF(1:ICOL),'TT') ! Do we have a 'TT'? IF(JJ.EQ.0) THEN ! If not 'TT' JJ=INDEX(LMCRBF(1:ICOL),'VT') ! Then is it 'VT0' IF(JJ.EQ.0) THEN ! If not a VT LDEV=LMCRBF(5:6) ! Set dev name GOTO 9090 ! Display error message ELSE ! else if is VT GOTO 2000 ! spawn command ENDIF ! endif ENDIF ! Now have device name READ(LMCRBF(JJ:JJ+1),100)IDEV ! Get device name READ(LMCRBF(JJ+2:ICOL-1),125,ERR=9040)ITTN 125 FORMAT(O3) ! IF(ITTN.GT."127) GOTO 9080 ! Illegal device number C -- There are two ways we can send commands to MCR. One way is to c shoot the command off not charing as to whether or when it succeeds C The other is to insure that the OCB is used to notify when the C target command completes. Now if a system only has the spawn directive C the only way to achieve the last method is to wait (stop) until the C command on the target terminal completes. IE RMC must stay in core. C If the system has the RPIO directive, one can relink the OCB's C ie attach the external command directly to the parent task, skiping C the in between link to RMC. If we arn't supposed to stop, just spawn C the command and exit, don't worry about exit status. C ! Try RPOI first, may not have ! to worry about stoping. ! (unless a '$' seen) 2000 IF(ISTOP.EQ.1) THEN ! (only spawn&stop if fails) CALL RPOI(CLI,,,,LCMD,IBYT,IFLG,IDEV,ITTN,,,IER) ! Then try RPOI IF(IER.EQ.1) GOTO 9100! If success, exit. IF(IER.NE.1 .AND. ! If failed & directive not - IER.NE.-99)WRITE(LUN,8000)IER ! missing, warn user END IF ! ENDIF CALL SPAWN(CLI,,,IEF,,IEXBLK,,LCMD,IBYT,ITTN,IDEV,IER) GOTO 2100 ! ! Try RPOI first, may not have ! to worry about stoping. ! (unless a '$' seen) 2050 IF(ISTOP.EQ.1) THEN ! If want to pass exit status CALL RPOI(CLI,,,,LCMD,IBYT,IFLG,,,,,IER)! Try RPOI first IF(IER.EQ.1) GOTO 9100! And exit on success, IF(IER.NE.1 .AND. ! If failed & directive not - IER.NE.-99)WRITE(LUN,8000)IER ! missing, warn user END IF ! ENDIF CALL SPAWN(CLI,,,IEF,,IEXBLK,,LCMD,IBYT,,,IER) 2100 IF(IER.NE.1) GOTO 9060! Spawn failed, Don't wait IF(ISTOP.EQ.1)CALL STOPFR(IEF,IER) ! Stop to get exit status IEXSTS=IEXBLK(1) ! Transfer exit status IF(IER.EQ.1) GOTO 9990! Success GOTO 9070 8000 FORMAT(' RMC -- RPOI failed, attempting to SPAWN, IDS =',O6) 8010 FORMAT(' RMC -- Get Command Line failure, no command') 8020 FORMAT(' RMC -- Syntax Error, No colon found') 8030 FORMAT(' RMC -- Syntax Error, No command found after colon') 8040 FORMAT(' RMC -- Syntax Error, Invalid terminal number ',A) 8050 FORMAT(' RMC -- Privlege Violation, Terminal not privleged') 8060 FORMAT(' RMC -- SPAWN Failure, IDS = ',O6) 8070 FORMAT(' RMC -- Wait for EFN failure, IDS = ',O6) 8080 FORMAT(' RMC -- Syntax Error, Illegal device number: ',O3) 8090 FORMAT(' RMC -- Syntax Error, Illegal device name: ',A) 8100 FORMAT(' >',A,$) 9010 WRITE(LUN,8010) ! GET COMMAND LINE FAILURE GOTO 9950 ! EXIT WITH ERROR STATUS 9020 WRITE(LUN,8020) ! SYNTAX ERROR, NO COLON FOUND GOTO 9950 ! EXIT WITH ERROR STATUS 9030 WRITE(LUN,8030) ! NO COMMAND AFTER ':' GOTO 9950 ! EXIT WITH ERROR STATUS 9040 WRITE(LUN,8040)LMCRBF(JJ+2:ICOL-1)! SYNTAX ERROR, INVALID TERMINAL # GOTO 9950 ! EXIT WITH FATAL ERROR 9050 WRITE(LUN,8050) ! PRIVLEGE VIOLATION,TI: NOT PRIVLEGED GOTO 9950 ! SHOW FATAL EXIT ERROR 9060 WRITE(LUN,8060)IER ! SPAWN FAILURE GOTO 9950 ! REPORT FATAL EXIT STATUS 9070 WRITE(LUN,8070)IER ! WAIT FOR EFN FAILURE GOTO 9950 ! REPORT FATAL EXIT STATUS 9080 WRITE(LUN,8080)ITTN ! REPORT ILLEGAL DEVICE NUMBER GOTO 9950 ! REPORT FATAL EXIT STATUS 9090 WRITE(LUN,8090)LDEV ! REPORT ILLEGAL DEVICE NAME GOTO 9950 ! SHOW FATAL EXIT STATUS 9100 WRITE(LUN,8100)LRET ! Make a prompt on TI: GOTO 9999 ! And exit 9950 IEXSTS=4 ! SET FATAL ERROR STATUS 9990 CALL EXST(IEXSTS) ! SHOW EXIT STATUS 9999 END C CHKPRV -- CHECK TO SEE IF TERMINAL IS PRIVLEGED C C CALL CHKPRV(LUN,IUPRV,ITPRV) C C LUN = LOGICAL UNIT NUMBER OF TERMINAL IN QUESTION C IUPRV = 0 TERMINAL UNPRIVLEGED C IUPRV = 1 TERMINAL PRIVLEGED C ITPRV = 0 TASK UNPRIVLEGED C ITPRV = 1 TASK PRIVLEGED C C ** THIS ROUTINE REQUIRES SF.GMC SUPPORT IN THE TERMINAL DRIVER C- SUBROUTINE CHKPRV(LUN,IUPRV,ITPRV) LOGICAL*1 LTERM(2) DIMENSION IDPB(6) ! DIRECTIVE PARAMETER BLOCK FOR QIO EQUIVALENCE (ITERM,LTERM) ! FOR CONVENIENCE IUPRV=0 ! ASSUME TERMINAL UNPRIVLEGED ITPRV=0 ! ASSUME TASK UNPRIVLEGED ISFGMC="2560 ! OCTAL VALUE FOR SF.GMC ITERM="51 ! QUERY CODE FOR TERM PRIVLEGE STATUS IDPB(2)=2 ! QIO BYTE COUNT CALL GETADR(IDPB,ITERM) ! GET ADDRESS OF BUFFER CALL WTQIO(ISFGMC,LUN,1,,,IDPB,IDSW) IF(IDSW.LE.0)IUPRV=0 ! IF QIO FAILS, ASSUME TI: UNPRIVLEGED IF(LTERM(2).EQ.1)IUPRV=1 ! SHOW TERMINAL AS PRIVLEGED NPRI=60 ! TEST PRIORITY CALL ALTPRI(,NPRI,IDSW) ! IF TASK NOT PRIVLEGED, IS ERROR IF(IDSW.EQ.1)ITPRV=1 ! NO ERROR, TASK PRIVLEGED CALL ALTPRI(,) ! RETURN TO DEFAULT PRIORITY RETURN END