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 C >RMC TTN:$MCR COMMAND STRING C FOR COMMANDS FOR WHICH RMC IS NOT TO WAIT FOR EXIT STATUS C C DIMENSION ICMD(40),IEXBLK(8) LOGICAL*1 LTTY(80),LDEV(2) LOGICAL*1 LCMD(80),LVAL LOGICAL*1 LUNIT(3) EQUIVALENCE(IDEV,LDEV) EQUIVALENCE(LCMD,ICMD) ! TO WORD ALLIGN BUFFER PARAMETER LUN=1 ! OUTPUT ERROR MESSAGES TO TI: ON LUN=1 DATA CLI2 /6R...MCR/ DATA CLI /6RMCR.../ DATA LUNIT /'0','0','0'/ IER=0 ! SHOW GET COMMAND LINE ERROR TO START WITH ISTOP=1 ! STOP AFTER SPAWNING COMMAND IEF=1 ! EVENT FLAG 1 IEXSTS=1 ! ASSUME SUCESSFUL EXIT STATUS CALL GETMCR(LTTY,IBYT) !GET COMMAND LINE OPEN(UNIT=LUN,NAME='TI:') ! ASSIGN TI: TO LUN CALL CHKPRV(LUN,IUPRV,ITPRV) ! CHECK TO SEE IF TERMINAL IS PRIVLEGED ! REQUIRES GET TERMINAL CHAR. SUPPORT IF(IUPRV.EQ.0)GOTO 9050 ! TERMINAL NOT PRIVLEGED IF(IBYT.LE.1) GOTO 9010 !NO COMMAND LINE,ERROR EXIT DO 1010 I=1,IBYT !LOCATE ':' 1010 IF(LTTY(I).EQ.':') GOTO 1020 !':'? GOTO 9020 ! ERROR EXIT, NO COLON FOUND 1020 II=I ! SAVE POINTER IF(LTTY(I+1).EQ.'$')ISTOP=0 ! IF $ PRECEEDS COMMAND, DON'T WAIT FOR EXIT IF(ISTOP.EQ.0)II=I+1 ! MOVE POINTER PAST '$' IF(I.GE.IBYT) GOTO 9030 !NO COMMAND? IBYT=IBYT-II ! BYTE COUNT OF COMMAND DO 1025,K=1,IBYT ! TRANSFER TO COMMAND BUFFER TO WORD ALLIGN COMMAND 1025 LCMD(K)=LTTY(II+K) ! ELSE GET RANDOM ODD ADDRESS TRAPS J=3 ! BACKWARDS POINTER INTO LUNIT N=1 ! BACKWARDS COUNTER FROM COLON 1030 LVAL=LTTY(I-N) ! TERMINAL UNIT # IF(LVAL.GE.'0'.AND.LVAL.LE.'9') - GOTO 1040 ! LEGAL TERMINAL NUMBER IF(N.EQ.1)GOTO 1080 ! NO TERMINAL NUMBER SPECIFIED GOTO 1050 ! NOT NUMBER SO SEE IF 'TT', 'TI', OR 'VT' 1040 LUNIT(J)=LVAL ! IT WAS A NUMBER LOAD IT INTO SLOT J=J-1 ! BACK UP TO NEXT EMPTY SLOT N=N+1 ! KEEP TRACK OF HOW FAR FROM COLON WE ARE IF(J.EQ.0) GOTO 1050 ! INSERTED ALL NUMBERS, TRY FOR DEVICE GOTO 1030 ! GET ANOTHER NUMBER 1050 LDEV(2)=LTTY(I-N) ! FILL IN LAST DEV LETTER LDEV(1)=LTTY(I-N-1) ! AND FIRST DEVICE LETTER DECODE(3,103,LUNIT,ERR=9040)ITTN ! DECODE UNIT # 103 FORMAT(1I3) IF(ITTN.GE."127)GOTO 9080 ! ILLEGAL DEVICE NUMBER IF(IDEV.NE.'VT')GOTO 1060 ! IF NOT VIRTUAL TERMINAL, CHECK FOR 'TT' ITTN=0 ! ON OUR SYSTEM ONLY CAN SEND COMMANDS TO VT0 GOTO 2000 ! GO DO IT 1060 IF(IDEV.NE.'TT') GOTO 1070 ! IF NOT 'TT', CHECK FOR 'TI' GOTO 2000 ! IS 'TT', SPAWN COMMAND TO IT 1070 IF(IDEV.NE.'TI')GOTO 9090 ! ILLEGAL DEVICE GOTO 2050 ! IS TI: SO USE CORRECT FORM OF SPAWN COMMAND 1080 LDEV(2)=LTTY(I-N) ! CHECK IF ONLY TI: USED LDEV(1)=LTTY(I-N-1) ! IF(IDEV.NE.'TI')GOTO 9090 ! ILLEGAL DEVICE NAME GOTO 2050 ! WAS TI: USE SPECIAL FORM OF SPAWN COMMAND C -- DEPENDING ON THE RELEASE LEVEL OF V3.2(FIELD TEST OR THE REAL THING) C -- MCR MAY BE INSTALLED AS EITHER ...MCR, OR MCR... . THE FOLLOWING WILL C -- MAKE RMC WORK WITH BOTH. EVENTUALLY THE CALL TO SPAWN TO ...MCR SHOULD C -- BE REMOVED. 2000 CALL SPAWN(CLI,,,IEF,,IEXBLK,,LCMD,IBYT,ITTN,IDEV,IER) IF(IER.NE.1) ! IN CASE MCR IS INSTALLED AS ...MCR - CALL SPAWN(CLI2,,,IEF,,IEXBLK,,LCMD,IBYT,ITTN,IDEV,IER) GOTO 2100 2050 CALL SPAWN(CLI,,,IEF,,IEXBLK,,LCMD,IBYT,,,IER) IF(IER.NE.1) ! IN CASE MCR IS INSTALLED AS ...MCR - CALL SPAWN(CLI2,,,IEF,,IEXBLK,,LCMD,IBYT,,,IER) 2100 IF(IER.NE.1) GOTO 9060 IF(ISTOP.EQ.1)CALL STOPFR(IEF,IER) IEXSTS=IEXBLK(1) ! TRANSFER EXIT STATUS IF(IER.EQ.1) GOTO 9999 GOTO 9070 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, TERMINAL NUMBER NOT BE DECODED') 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: ',I3) 8090 FORMAT(' RMC -- SYNTAX ERROR, ILLEGAL DEVICE NAME: ',1A2) 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) ! SYNTAX ERROR, NOT A VALID TERMINAL NUMBER GOTO 9950 ! EXIT WITH FATAL ERROR 9050 WRITE(LUN,8050) ! PRIVLEGE VIOLATION, TERMINAL 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)IDEV ! REPORT ILLEGAL DEVICE NAME GOTO 9950 ! SHOW FATAL EXIT STATUS 9950 IEXSTS=4 ! SET FATAL ERROR STATUS 9999 CALL EXST(IEXSTS) ! SHOW EXIT STATUS 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 TERMINAL 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 TERMINAL UNPRIVLEGED IF(LTERM(2).EQ.1)IUPRV=1 ! SHOW TERMINAL AS PRIVLEGED NPRI=60 ! TEST PRIORITY CALL ALTPRI(,NPRI,IDSW) ! IF TASK NOT PRIVLEGED, WILL CAUSE ERROR IF(IDSW.EQ.1)ITPRV=1 ! NO ERROR, TASK PRIVLEGED CALL ALTPRI(,) ! RETURN TO DEFAULT PRIORITY RETURN END