PROGRAM TERMINAL_SPEED C C The purpose of this program is to handle multi-speed C terminal ports. It is used typically with dialup C modems such as the VADIC 3450 series which allow C callers to dial up at either 300 or 1200 baud. C You could even call it the terminal speed daemon! C C Typically a command such as RUN TERMSPEED/UIC=[1,4]- C /OUT=TERMSPEED.ERR/ERR=TERMSPEED.ERR- C /PROCESS_NAME=TERMINAL_SPEED/PRIORITY=6/AST=10 C should be placed in your SYSTARTUP.COM followed by C COPY DIALUPS.DAT TERMINAL_SPEED_MBX C where DIALUPS.DAT looks like: C ANSWER TTB4: C ANSWER TTB5: C ANSWER TTB6: C ANSWER TTB7: C for example. C Note that the RUN command above requires privilege to be C executed (which the startup procedure has). C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C IMPORTANT WARNING C This program also requires a certain amount of quota. C The exact quotas required vary depending on the C number of lines you ask it to answer. C If you put the lines above into your system C startup procedure and you don't run this C program with enough quota allocated to it, C the system startup procedure can hang forever. C In this case you will have to halt the system C (^P on a 780, whatever you do on a 750), and C go through the conversational boot procedure C to specify an alternate startup file. C C In order to answer N lines, you should run C TERMSPEED with the following qualifiers: C /AST_LIMIT=(2*N+3) C /BUFFER_LIMIT=(N+3) C /IO_BUFFERED=(N+3) C /QUEUE_LIMIT=(N+3) C where you replace the parenthesized C expression with its actual value. C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C There are several more points about the use of C this program that you should be aware of. C First, any user who C dials up via a line controlled by TERMSPEED C may have to hit carriage return or ^Y or ^C C several times before getting the prompt. C Second, the accounting message generated at the C end of a session for a user on a line C controlled by TERMSPEED will be a detached C process accounting message instead of C an interactive job message. This is C not usually a problem. C Third, it appears that jobs over lines C held by TERMSPEED are not limited by C the total number of interactive jobs C you specify in a SET LOGINS/INTERACTIVE C command. C Fourth, TERMSPEED automatically hangs up on C people who log out but forget to hang up. C You get a 1 minute grace period. C C C The advantage of this program is that you can also C remove lines from the speed daemon's care by something like: C COPY TT TERMINAL_SPEED_MBX C IGNORE TTcu: C ^Z C This is especially useful if you plan to use something like C the VAXNET software, in which a given DZ line might serve C alternatively for dialin and dialout. C At present there are no other commands the daemon understands. C (strong candidate for future work is a SECURE command C which would require a special site-wide dialup password C which could change frequently before invoking LOGINOUT) C C If you are having trouble making this program work properly C on your system, recompile it with the /D_LINES qualifier C and examine TERMSPEED.ERR after running it. C C The COMMON block used throughout TERMSPEED is in TERMSPEED.INC C INCLUDE 'TERMSPEED.INC' C CHARACTER*(*) GRAB_TIMEOUT,SPEED_TIMEOUT,HANGUP_TIMEOUT C C GRAB_TIMEOUT is the time delay between attempts to allocate C a terminal (which probably is currently in use). C SPEED_TIMEOUT is the time delay before issuing a new read C to a terminal after receiving a character at the wrong C speed. It must be at least 1/(the lowest character rate). C For safety's sake I chose to set it at 2 times the above. C Note that character rate can be taken as (baud rate/11). C The initial setting suffices for all speeds down to 110 C baud. C HANGUP_TIMEOUT is the time delay after a process logs out C until the line is automatically hung up. This one is C strictly a matter of taste. C PARAMETER (GRAB_TIMEOUT = '0 0:00:30.0') PARAMETER (SPEED_TIMEOUT = '0 0:00:00.5') PARAMETER (HANGUP_TIMEOUT = '0 0:01:00.0') C TERM_NAME is a character function which returns the C name associated with a given terminal number CHARACTER*6 TERM_NAME C COMMAND is a buffer to receive a request from the outside world CHARACTER*40 COMMAND C GRAB_AST is logical so we know what happened LOGICAL GRAB_AST C Must declare the AST addresses EXTERNAL EXTERNAL GRAB_AST C initially there are no lines in our care DATA HOLD/NLINES*.FALSE./ C C C C Set up address of GRAB_AST GRAB_AST_ADDR = %LOC(GRAB_AST) C set up delay times CALL IFERR(SYS$BINTIM(GRAB_TIMEOUT,GRAB_TIME)) CALL IFERR(SYS$BINTIM(SPEED_TIMEOUT,SPEED_TIME)) CALL IFERR(SYS$BINTIM(HANGUP_TIMEOUT,HANGUP_TIME)) C set up mailbox for communication with outside world CALL IFERR(SYS$CREMBX(%VAL(1),ICHANW,%VAL(80),%VAL(80),%VAL(0),, . 'TERMINAL_SPEED_MBX')) C and immediately delete it so that when we exit it will go away CALL IFERR(SYS$DELMBX(%VAL(ICHANW))) OPEN(UNIT=1,NAME='TERMINAL_SPEED_MBX',TYPE='OLD',READONLY, . CARRIAGECONTROL='LIST') C That's about it. Just wait to get a request via our MBX. 10 CONTINUE C Enable AST delivery CALL IFERR(SYS$SETAST(%VAL(1))) READ(1,100,END=80,ERR=80)L,COMMAND 100 FORMAT(Q,A) C Strip leading blanks and make sure the line has an embedded blank 20 L1 = INDEX(COMMAND,' ') IF(L1.EQ.0)THEN D CALL ANSWER('Improper termspeed format: no embedded blanks') GOTO 10 END IF IF(L1.EQ.1)THEN COMMAND = COMMAND(2:L) L = L - 1 IF(COMMAND.NE.' ')GOTO 20 D CALL ANSWER('Improper termspeed format: blank line') GOTO 10 END IF C Compute terminal number CALL CUPPER(COMMAND) IF(INDEX(COMMAND,':').NE.0)L = INDEX(COMMAND,':') - 1 NUMBER = ICHAR(COMMAND(L:L)) - ICHAR('0') + . 8 * (ICHAR(COMMAND(L-1:L-1)) - ICHAR('A')) + 1 C Require it to in bounds ! IF((NUMBER.LT.1).OR.(NUMBER.GT.NLINES))THEN D CALL ANSWER('Illegal terminal number: '// D . TERM_NAME(NUMBER)) GOTO 10 END IF D TYPE *,'TERM NUMBER IS',NUMBER C Enter critical section by disabling AST delivery CALL IFERR(SYS$SETAST(%VAL(0))) C Was request ANSWER ? IF(COMMAND(1:1).EQ.'A')THEN C Yes. If we already hold it that's all we do. D TYPE *,'GOT AN ANSWER REQUEST' IF(HOLD(NUMBER))THEN D CALL ANSWER('Terminal '//TERM_NAME(NUMBER)// D . ' already held') GOTO 10 END IF C We don't hold terminal. Get it. HOLD(NUMBER) = .TRUE. C Note that ASTs get their parameters passed by value IF(GRAB_AST(%VAL(NUMBER)))THEN C Answer request D CALL ANSWER('Terminal '//TERM_NAME(NUMBER)// D . ' is now held') ELSE C Answer request D CALL ANSWER('Trying to allocate terminal: '// D . TERM_NAME(NUMBER)) END IF GOTO 10 END IF C Was request IGNORE ? IF(COMMAND(1:1).EQ.'I')THEN D TYPE *,'WE GOT AN IGNORE REQUEST' C Yes. If we don't hold it that's all we do. IF(.NOT.HOLD(NUMBER))THEN D CALL ANSWER('Terminal '//TERM_NAME(NUMBER)// D . ' was not currently held') GOTO 10 END IF C clear hold HOLD(NUMBER) = .FALSE. C Release the terminal CALL DALLTERM(NUMBER) C Force completion of any termination message CALL DALLTMBX(NUMBER) C Answer request D CALL ANSWER('Terminal '//TERM_NAME(NUMBER)// D . ' will be released immediately') GOTO 10 END IF C Well ... That takes care of all the requests we recognize D CALL ANSWER('Unrecognized request') GOTO 10 C we get here on read mailbox errors and EOFs 80 CONTINUE C CALL ANSWER('Bad mailbox read') D TYPE *,'BAD MAILBOX READ' GOTO 10 END CHARACTER*6 FUNCTION TERM_NAME(M) TERM_NAME = '_TTA0:' N = M - 1 TERM_NAME(4:4) = CHAR(N/8+ICHAR('A')) TERM_NAME(5:5) = CHAR(MOD(N,8)+ICHAR('0')) RETURN END LOGICAL FUNCTION ALLTERM(N) INCLUDE 'TERMSPEED.INC' CHARACTER*6 TERM_NAME D TYPE *,'ABOUT TO ALLOCATE TERM',N ALLTERM = SYS$ALLOC(TERM_NAME(N),,,) IF(.NOT.ALLTERM)RETURN ALLTERM = SYS$ASSIGN(TERM_NAME(N),ICHAN(N),,) RETURN END SUBROUTINE DALLTERM(N) INCLUDE 'TERMSPEED.INC' CHARACTER*6 TERM_NAME D TYPE *,'ABOUT TO DEALL TERMINAL',N CALL SYS$CANTIM(%VAL(N),) CALL SYS$DASSGN(%VAL(ICHAN(N))) ICHAN(N) = 0 CALL SYS$DALLOC(TERM_NAME(N),) RETURN END SUBROUTINE DALLTMBX(N) INCLUDE 'TERMSPEED.INC' D TYPE *,'ABOUT TO DALL TMBX',N CALL SYS$CANCEL(%VAL(MCHAN(N))) MCHAN(N) = 0 RETURN END SUBROUTINE READTERM(N) INCLUDE 'TERMSPEED.INC' INTEGER*4 DESC(2) EXTERNAL IO$_TTYREADALL,IO$M_NOECHO,IO$M_PURGE EXTERNAL TT$M_REMOTE,IO$_SENSEMODE EXTERNAL CHAR_AST,HANGUP_AST D TYPE *,'HIT READTERM FOR',N C First set up timer for hangup if needed CALL IFERR(SYS$QIOW(%VAL(2),%VAL(ICHAN(N)),IO$_SENSEMODE,,,, . DESC,,,,,)) C We only need to check whether they hung up if remote IF((DESC(2).AND.%LOC(TT$M_REMOTE)).NE.0)THEN D TYPE *,'IT''S A REMOTE ONE ALL RIGHT' HANGUP(N) = .TRUE. CALL IFERR(SYS$SETIMR(,HANGUP_TIME,HANGUP_AST, . %VAL(N))) END IF D TYPE *,'ABOUT TO ISSUE READ TO TERM',N IREADF = %LOC(IO$_TTYREADALL).OR.%LOC(IO$M_NOECHO).OR. . %LOC(IO$M_PURGE) B(N) = 0 CALL IFERR(SYS$QIO(,%VAL(ICHAN(N)),%VAL(IREADF),, . CHAR_AST,%VAL(N), . B(N),%VAL(1),,,,)) RETURN END SUBROUTINE CHAR_AST(M) INCLUDE 'TERMSPEED.INC' CHARACTER*6 TERM_NAME INTEGER*4 QPRIV(2) INTEGER*2 BUF(40) INTEGER*4 DESC(2) EXTERNAL DIB$W_UNIT EXTERNAL TMBX_AST,SPEED_AST EXTERNAL IO$_SETCHAR,IO$_SENSECHAR,IO$_READVBLK EXTERNAL TT$C_BAUD_1200,TT$C_BAUD_300,TT$C_BAUD_110 C BAUD is a table of BAUD rates INTEGER*4 BAUD(0:15) C IBAUD is current baud rate index for each line INTEGER*4 IBAUD(NLINES) DATA IBAUD/NLINES*0/ C NBAUD is number of baud rates in table to try DATA NBAUD/2/ DATA QPRIV/2*'FFFF'X/ C Remember, the AST gets passed the value directly, not its address N = %LOC(M) D TYPE *,'HIT CHAR_AST WITH N =',N C Before we get carried away, make sure we still HOLD this one IF(.NOT.HOLD(N))RETURN C Cancel the hangup call HANGUP(N) = .FALSE. CALL IFERR(SYS$CANTIM(%VAL(N),)) C set up table of baud rates BAUD(0) = %LOC(TT$C_BAUD_1200) BAUD(1) = %LOC(TT$C_BAUD_300) BAUD(2) = %LOC(TT$C_BAUD_110) C C WE DON'T CURRENTLY CHECK 110 BAUD BECAUSE AT THAT SPEED C SETTING RETURNS AND CONTROL-YS DON'T REGISTER AS C CHARACTERS IF THE ACTUAL BAUD RATE IS 1200. C THE KNOWLEDGEABLE USER CAN EASILY CIRCUMVENT C THIS BY HITTING BREAK WHEN STUCK BUT WHY BOTHER FOR NOW? C C check for wakeup character (^C, CR, or ^Y) IF((B(N).NE.3).AND.(B(N).NE.13).AND.(B(N).NE.25))THEN C We got a bad character. Set new baud rate & try again. IBAUD(N) = MOD(IBAUD(N)+1,NBAUD) ISPEED = BAUD(IBAUD(N)) C Get current characteristics. At least on VMS 1.5 you have C to supply these to IO$_SETCHAR CALL IFERR(SYS$QIOW(%VAL(2),%VAL(ICHAN(N)),IO$_SENSECHAR,,,, . DESC,,,,,)) CALL IFERR(SYS$QIOW(%VAL(2),%VAL(ICHAN(N)),IO$_SETCHAR,,,, . DESC,,%VAL(ISPEED),,,)) C wait 1/2 second before trying again. This is C crucial (along with IO$M_PURGE) since if the terminal C is at 300 baud and you try 1200 you sometimes get C 2 characters for each one typed. CALL IFERR(SYS$SETIMR(,SPEED_TIME,SPEED_AST, . %VAL(N))) RETURN END IF C If we get here, we got a good character from them. C First, create a temporary mailbox to read termination message C Restrict message size and buffer quota needed. CALL IFERR(SYS$CREMBX(%VAL(0),MCHAN(N),%VAL(100),%VAL(100), . %VAL(0),,)) C Then, get its number DESC(1) = 80 DESC(2) = %LOC(BUF) CALL IFERR(SYS$GETCHN(%VAL(MCHAN(N)),,DESC,,)) MUNIT = BUF(%LOC(DIB$W_UNIT)/2 + 1) D TYPE *,'MAILBOX UNIT IS',MUNIT C Then, deallocate terminal CALL DALLTERM(N) C Finally, start up LOGINOUT on terminal CALL IFERR(SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT', . TERM_NAME(N),TERM_NAME(N),TERM_NAME(N), . QPRIV,,TERM_NAME(N),%VAL(4),%VAL('10004'X),%VAL(MUNIT), . %VAL(0))) C And issue a read to the termination mailbox CALL IFERR(SYS$QIO(,%VAL(MCHAN(N)),IO$_READVBLK,, . TMBX_AST,%VAL(N), . B(N),%VAL(1),,,,)) RETURN END SUBROUTINE TMBX_AST(M) INCLUDE 'TERMSPEED.INC' C The parameter we get called with is passed by value N = %LOC(M) D TYPE *,'HIT TMBX_AST WITH N =',N C first off, deassign the channel CALL SYS$DASSGN(%VAL(MCHAN(N))) MCHAN(N) = 0 C Before we get carried away, make sure we hold this one IF(.NOT.HOLD(N))RETURN C Asssume a line terminated - try to grab it CALL GRAB_AST(%VAL(N)) RETURN END SUBROUTINE ANSWER(STRING) IMPLICIT INTEGER*4 (S) CHARACTER*(*) STRING EXTERNAL IO$_WRITEVBLK,IO$M_NOW D TYPE *,STRING RETURN END LOGICAL FUNCTION GRAB_AST(M) INCLUDE 'TERMSPEED.INC' LOGICAL ALLTERM N = %LOC(M) D TYPE *,'HIT GRAB_AST WITH N =',N GRAB_AST = .FALSE. IF(.NOT.HOLD(N))RETURN C Try to allocate terminal IF(.NOT.ALLTERM(N))THEN C If we failed, wake up later on to try again CALL IFERR(SYS$SETIMR(,GRAB_TIME,%VAL(GRAB_AST_ADDR), . %VAL(N))) ELSE GRAB_AST = .TRUE. CALL READTERM(N) END IF RETURN END SUBROUTINE SPEED_AST(M) INCLUDE 'TERMSPEED.INC' N = %LOC(M) D TYPE *,'HIT SPEED_AST WITH N =',N IF(.NOT.HOLD(N))RETURN CALL READTERM(N) RETURN END SUBROUTINE HANGUP_AST(M) INCLUDE 'TERMSPEED.INC' EXTERNAL IO$_SETMODE,IO$M_HANGUP N = %LOC(M) D TYPE *,'HIT HANGUP_AST WITH N = ',N IF(.NOT.HOLD(N))RETURN C Maybe they already typed something IF(.NOT.HANGUP(N))RETURN C Prepare to hang them up !!! IFUNC = %LOC(IO$_SETMODE).OR.%LOC(IO$M_HANGUP) D TYPE *,'ABOUT TO HANG UP LINE' C C Since there is a read QIO outstanding on the terminal C we must first cancel it. Otherwise the hangup QIO C wont be seen by the driver until the read completes C (this is a pain, DEC !!!). C CALL SYS$CANCEL(%VAL(ICHAN(N))) CALL SYS$QIO(,%VAL(ICHAN(N)),%VAL(IFUNC),,,, . ,,,,,) RETURN END