TITLE IMAPSV - Multiforking mail access protocol listener SUBTTL Derived from SMTJFN SEARCH MACSYM,MONSYM .REQUIRE SYS:MACREL SALL ; suppress macro expansions .DIRECTIVE FLBLST ; sane listings for ASCIZ, etc. .TEXT "/NOINITIAL" ; suppress loading of JOBDAT .TEXT "IMAPSV/SAVE" ; save as IMAPSV.EXE ; Version components IMPWHO==0 ; who last edited IMAPSV (0=developers) IMPVER==6 ; IMAPSV's release version (matches monitor's) IMPMIN==1 ; IMAPSV's minor version IMPEDT==^D3 ; IMAPSV's edit version ; This program manages a set of MAPSER forks, and uses TCP JFNs instead ; of TVTs for I/O. ; ; The maximum number of simultaneous connections allowed is controlled ; by the setting of NFKS below. The maximum number of forks to allow to ; exist after they have finished (in order to cut down on MAPSER startup ; overhead) is specified with MAXIDL. IFNDEF MAXIDL,MAXIDL==2 ; maximum allowable idle forks IFNDEF NFKS,NFKS==^D30 ; maximum simultaneous connections IFNDEF PDLLEN,PDLLEN==200 ; PDL size A=1 ; AC definitions B=2 C=3 D=4 FX=14 ; fork table index of current fork CX=16 ; Fork variables ; ; The current fork index (not a TOPS-20 fork handle) is always kept in ; FX, so indexing into the fork table is done implicitly by the following ; DEFSTRs. DEFSTR FH,FKSTAT(FX),17,18 ; TOPS-20 fork handle DEFSTR FKRUN,FKSTAT(FX),18,1 ; set if fork is currently running DEFSTR FKJFN,FKSTAT(FX),35,9 ; fork's network JFN DEFINE NOINT ; disable PSI DEFINE OKINT ; enable PSI DEFINE TMOSET (INTVL,RETAD) < SETZM CLKCNT PUSH P,[PC%USR+RETAD] POP P,CLKLOC PUSH P,[-] POP P,CLKCNT >;DEFINE TMOSET DEFINE TMOCLR < SETZM CLKCNT SETZM CLKLOC >;DEFINE TMOCLR SUBTTL Data area PC1: BLOCK 1 ; level 1 interrupt PC IN1ACS: BLOCK 20 ; level 1 AC save PC2: BLOCK 1 ; level 2 interrupt PC IN2ACS: BLOCK 20 ; level 2 AC save CLKCNT: BLOCK 1 ; clock count CLKLOC: BLOCK 1 ; clock location NRUN: BLOCK 1 ; active fork count list NFORKS: BLOCK 1 ; subfork count NJFNS: BLOCK 1 ; connection count FKSTAT: BLOCK NFKS ; fork status PDL: BLOCK PDLLEN ; stack SUBTTL Pure data CHNTAB: PHASE 0 ; interrupt channel table TIMCHN:!1,,TIMINT ; timeout BLOCK .ICIFT-. .ICIFT:!2,,FRKINT ; fork termination interrupts BLOCK ^D36-. DEPHASE LEVTAB: PC1 ; level 1 PC2 ; level 2 BLOCK 1 ; level 3 unused SUBTTL Main program ; Entry vector EVEC: JRST IMAPSV ; START address JRST IMAPSV ; REENTER address !!! EVECL==.-EVEC IMAPSV: RESET% MOVE P,[IOWD PDLLEN,PDL] MOVX A,.FHSLF ; enable all capabilities RPCAP% IORB C,B EPCAP% MOVE B,[LEVTAB,,CHNTAB] SIR% ; set up interrupt channels EIR% ; enable interrupts MOVX B,1B!1B<.ICIFT> ; channels to interrupt on AIC% ; activate the interrupt channels JSP CX,SETTIM ; start the timer GJINF% ; get my job number MOVE A,C MOVX B, ; get some response for the poor schmucks SJPRI% SETZM FKSTAT ; clear the fork table MOVE A,[FKSTAT,,FKSTAT+1] BLT A,FKSTAT+NFKS-1 DO. MOVE A,NRUN ; get running fork count CAIL A,NFKS ; all in use? WAIT% ; yes, wait for one to complete CALL LISTEN ; listen for a connection LOOP. ; and go back for another one ENDDO. SUBTTL Interrupt routines ; Here to initialize the timer, called via JSP CX,SETTIM. Note that A,B,C ; are clobbered! SETTIM: MOVE A,[.FHSLF,,.TIMEL] ; tick the timer MOVX B,^D5000 ; every 5 seconds MOVX C,TIMCHN ; on TIMCHN channel TIMER% ERJMP .+1 JRST (CX) ;;;Here on timer interrupt TIMINT: MOVEM 17,IN1ACS+17 ; save ACs MOVEI 17,IN1ACS BLT 17,IN1ACS+16 JSP CX,SETTIM ; reinitialize the timer AOSE CLKCNT ; should time out now? IFSKP. SKIPE A,CLKLOC ; get time-out routine MOVEM A,PC1 ; set it ENDIF. MOVSI 17,IN1ACS ; restore ACs BLT 17,17 DEBRK% ; FRKINT is called on fork termination to scan the fork list to find ; any halted forks and close the corresponding connections. FRKINT: MOVEM 17,IN2ACS+17 ; save ACs MOVEI 17,IN2ACS BLT 17,IN2ACS+16 MOVE 17,IN2ACS+17 MOVE A,PC2 ; get interrupt pc location MOVE A,-1(A) ; get waiting instruction CAME A,[WAIT%] ; waiting for a free fork? IFSKP. SETONE PC%USR,PC2 ; yes, make JSYS return to user ENDIF. MOVSI FX,-NFKS ; loop through all forks DO. IFQN. FKRUN ; only "running" forks are checked LOAD A,FH ; get the fork handle RFSTS% ; get its status ERJMP STOP HRRZS B ; flush flags from PC LOAD D,RF%STS,A ; get the fork status code CAIE D,.RFHLT ; halted? CAIN D,.RFFPT ; or terminated? SOSA NRUN ; yes, one less running fork ANSKP. SETZRO FKRUN ; say fork is no longer running CAIE D,.RFHLT ; halted normally? IFSKP. MOVE A,NFORKS ; get the number of existing forks SUB A,NRUN ; subtract balance of running forks CAILE A,MAXIDL ; too many free forks? ANSKP. ELSE. LOAD A,FH ; get the fork handle back KFORK% ; zap it ERJMP STOP SOS NFORKS ; one less fork to worry about SETZRO FH ; say the fork is gone ENDIF. LOAD A,FKJFN ; get the JFN CALL CLSJFN ; close the connection SETZRO FKJFN ; delete it from the table ENDIF. AOBJN FX,TOP. ; loop if more forks to examine ENDDO. MOVSI 17,IN2ACS BLT 17,17 DEBRK% ; return from the interrupt ERJMP STOP ; CLSJFN - close the TCP connection ; ; Accepts: ; A/ network JFN ; Returns: ; +1 Always CLSABT: TXO A,CZ%ABT ; abort the connection CLSJFN: MOVE D,A ; get a copy of the JFN TMOSET (30,CLSABT) CLOSF% ; close it IFJER. TMOCLR MOVE A,D ; get the JFN back RLJFN% ; if close failed, just release JFN ERJMP .+1 ENDIF. TMOCLR SOS NJFNS ; one less connection RET SUBTTL LISTEN - listen for a connection ; Listens for a connection on the TCP IMAP socket and starts up a copy ; of MAPSER. ; ; Returns: ; +1 open failed ; +2 open succeeded, IMAP fork started LISTEN: STKVAR ; temp ac for storing JFN DO. MOVX A,GJ%SHT HRROI B,[ASCIZ "TCP:143#;TIMEOUT:60"] ; wait 60 seconds for SYN GTJFN% ; get a JFN to listen on IFJER. MOVX A,^D<10*1000> ; failed, wait a bit DISMS% LOOP. ; and try again ENDIF. MOVEM A,TCPJFN ; copy the JFN to a safe register MOVX B,!> OPENF% ; wait for a connection IFJER. MOVE A,TCPJFN ; get the JFN back RLJFN% ; through it away ERJMP .+1 MOVX A,^D<10*1000> ; failed, wait a bit DISMS% LOOP. ; and try again ENDIF. ENDDO. MOVX B,.TCSTP ; reset retranmission timeout SETZ C, ; MAPSER will handle timeout TCOPR% ERJMP STOP AOS NJFNS ; bump connection count GDSTS% ; get the device status ERJMP STOP CALL GETFRK ; find a free fork table entry IFNSK. MOVE A,TCPJFN HRROI B,[ASCIZ/* BAD Insufficient system resources; please report this /] SETZ C, SOUTR% ERJMP .+1 CALLRET CLSJFN ; close the connection and return ENDIF. MOVE A,TCPJFN ; get the JFN back STOR A,FKJFN ; save the JFN LOAD A,FH ; get the fork handle in a LOAD B,FKJFN ; get the JFN HRLS B ; B/ input JFN,,output JFN SPJFN% ; set the primary JFNs ERJMP STOP NOINT ; defer interrupts LOAD A,FH SETZ B, ; start the fork at normal entry SFRKV% ; start it ERJMP STOP SETONE FKRUN ; say the fork has been started AOS NRUN ; bump running the running fork count OKINT ; allow interrupts again RET ; return to get another fork ENDSV. SUBTTL GETFRK - allocate a fork ; Scan the fork table looking for an idle fork. If one is found, its ; index is returned, otherwise a new fork is created unless the table is ; full. ; ; Returns: ; +1 no more forks ; +2 success, fork index in FX GETFRK: MOVSI FX,-NFKS ; loop through all forks DO. IFQE. FKJFN ; fork in use? JN FH,,RSKP ; no, if fork exists we can use it AOBJN FX,TOP. ENDIF. ENDDO. ; No idle fork exists, so create one if table can hold it MOVSI FX,-NFKS DO. IFQE. FKJFN ; fork in use? HRRZS FX ; no, isolate the fork index JN FH,,RSKP ; if exists, idle fork appeared, use it MOVX A,CR%CAP ; else make one with our caps CFORK% ERJMP STOP AOS NFORKS ; bump the fork count STOR A,FH ; save the handle TXZ A,.FHSLF MOVX A,GJ%SHT!GJ%OLD HRROI B,[ASCIZ/SYSTEM:MAPSER.EXE/] GTJFN% ; get a handle on the file ERJMP STOP LOAD B,FH ; get the fork handle HRL A,B ; A/ fork,,JFN GET% ; load in the file ERJMP STOP RETSKP ; return with FX set up ENDIF. AOBJN FX,TOP. ; loop if more to try ENDDO. RET ; otherwise fail SUBTTL OKINT and NOINT - turn interrupts on and off .OKINT: SAVEAC MOVX A,.FHSLF EIR% ; enable interrupts RET .NOINT: SAVEAC MOVX A,.FHSLF DIR% ; disable interrupts RET SUBTTL Other randomness STOP: HRROI A,[ASCIZ/IMAPSV: /] ESOUT% MOVX A,.PRIOU HRLOI B,.FHSLF ; dumb ERSTR% SETZ C, ERSTR% NOP ; undefined error number NOP ; can't happen MOVX A,^D5000 ; sleep for 5 seconds DISMS% JRST IMAPSV ; restart ; Literals ...VAR:!VAR ; generate variables (there shouldn't be any) IFN .-...VAR,<.FATAL Variables illegal in this program> ...LIT: XLIST ; save trees during LIT LIT ; generate literals LIST END EVECL,,EVEC ; The End