;LOGJS.MAC;21 9-Mar-81 22:54:58, Edit by MMCM ;DSK:<134-TENEX>LOGJS.MAC;20 3-Apr-80 16:33:36, Edit by RKNIGHT ; Made SETACT the same as it was before changes to fact file. ;DSK:<134-TENEX>LOGJS.MAC;18 26-Mar-80 16:48:35, Edit by RKNIGHT ; Fixed change-caused brain damage in SETACT. ;DSK:<134-TENEX>LOGJS.MAC;17 24-Mar-80 15:38:08, Edit by RKNIGHT ; Changed STAD to put in last system date/time. ;DSK:<134-TENEX>LOGJS.MAC;15 5-Mar-80 18:57:38, Edit by RKNIGHT ; Changed SETACT to be able to go to different places. ;DSK:<134-TENEX>LOGJS.MAC;13 5-Mar-80 17:17:02, Edit by RKNIGHT ; Changed CACCT to go to one place to do job stats. ;DSK:<134-TENEX>LOGJS.MAC;11 5-Mar-80 15:52:19, Edit by RKNIGHT ; Added code to zero TTYCHS on login. ;<134-TENEX>LOGJS.MAC;10 21-May-78 15:23:01 EDIT BY PETERS ;<134-TENEX>LOGJS.MAC;9 26-Jul-76 21:50:50 TVEDIT'd by Geoff ; OPER's can now do GTDIR's. No harm because passwords are now encrypted. ; but we still won't let 'em do CRDIR's tho! ;<134-TENEX>LOGJS.MAC;8 18-May-76 17:44:06 TVEDIT'd by Geoff ; GTDIR - wheels only. ;<134-TENEX>LOGJS.MAC;6 11-MAY-76 11:15:23 EDIT BY UNTULIS ;ADDED JOB PAGE FAULT INIT CODE ;<134-TENEX>LOGJS.MAC;4 3-MAY-76 18:22:20 EDIT BY LYNCH ; TOOK OUT OPERATOR CAPABILITY TO DO CRDIR JSYS ;<134-TENEX>LOGJS.MAC;3 3-MAY-76 17:29:32 EDIT BY UNTULIS ;ADDED CODE TO NOT ALLOW CAPABILITIES IF BATCH JOB ;<134-TENEX>LOGJS.MAC;2 11-FEB-76 14:16:01 EDIT BY UNTULIS ;CHANGED OPTT TO LOGDES, ADDDED CODE TO SACTF TO HANDLE ;STRING ACCOUNTS CORRECTLY ;<135-TENEX>LOGJS.MAC;15 12-DEC-75 10:54:44 EDIT BY PLUMMER ; ADD IFN PIESLC AROUND LOGI0B ;<134-TENEX>LOGJS.MAC;14 3-SEP-75 12:54:30 EDIT BY ALLEN ; FIX FOR USE OF NEW LOCK MACRO ;<134-TENEX>LOGJS.MAC;13 29-AUG-75 11:25:18 EDIT BY ALLEN ; FIXES FOR NEW PIE-SLICE CPU MAINTENANCE ;<134-TENEX>LOGJS.MAC;12 28-AUG-75 17:17:11 EDIT BY ALLEN ; UNLOCK DIRLCKS MUST NOW SPECIFICALLY REQUEST RELEASE OF HIQ ;<134-TENEX>LOGJS.MAC;11 19-JUN-75 23:50:05 EDIT BY CLEMENTS ; MOD TO LOGIN TO ALLOW FTPSRV TO SUPPRESS LOGIN DATE UPDATING. FLAG ; B16 IN AC1 DOES THIS. ;<134-TENEX>LOGJS.MAC;10 11-JUN-75 10:22:15 EDIT BY ALLEN ; MINOR FIX TO LOGIN SO SYSLOD WORKS ;<134-TENEX>LOGJS.MAC;9 28-APR-75 15:07:32 EDIT BY CLEMENTS ;<134-TENEX>LOGJS.MAC;8 28-APR-75 12:37:52 EDIT BY CLEMENTS ;<134-TENEX>LOGJS.MAC;7 28-APR-75 11:36:07 EDIT BY CLEMENTS ;<134-TENEX>LOGJS.MAC;6 22-APR-75 11:05:41 EDIT BY TOMLINSON ; Hashed passwords back into mainstream sources ;<134-TENEX>HLOGJS.MAC;9 17-APR-75 16:05:59 EDIT BY CLEMENTS ; MOVE MAKNFE WHICH GOT STUCK IN STRAIGHTLINE CODE BY ACCIDENT ;<134-TENEX>HLOGJS.MAC;8 16-APR-75 20:48:28 EDIT BY CLEMENTS ;<134-TENEX>HLOGJS.MAC;7 15-APR-75 22:04:21 EDIT BY SYSTEM ;<134-TENEX>HLOGJS.MAC;6 15-APR-75 18:23:36 EDIT BY CLEMENTS ; MORE FIXES IN HASHER AND FRIENDS ;<134-TENEX>HLOGJS.MAC;5 14-APR-75 15:42:07 EDIT BY CLEMENTS ; FIXES IN PASS HASHER ;<134-TENEX>HLOGJS.MAC;4 13-APR-75 21:54:40 EDIT BY CLEMENTS ; IMPLEMENT HASHED PASSWORD SYSTEM ;<134-TENEX>LOGJS.MAC;4 13-APR-75 20:01:31 EDIT BY CLEMENTS ; FIX LONGSTANDING TYPO IN FAIL RETURN OF MAKF02+6 ;<134-TENEX>LOGJS.MAC;2 10-APR-75 10:53:02 EDIT BY PLUMMER ; SAVE DDB POINTER IN INDEX AROUND CALLS TO CPYDIR SO GC WILL SEE IT ;<134-TENEX>LOGJS.MAC;1 8-APR-75 18:56:15 EDIT BY CLEMENTS ; SEPARATED FROM JSYS.MAC SEARCH STENEX,PROLOG TITLE LOGJS SWAPCD EXTERNAL MENTR,MRETN,BUGCHK,BUGHLT,BUGNTE,MSTKOV,JOBPT,CAPENB,CAPMSK ; Error macro definitions DEFINE ERUNLK(ERRORN,EXTRA)< JRST [ EXTRA IFDIF ,<>, JRST ERUNLD##]> DEFINE ERR(ERRORN,EXTRA)< JRST [ EXTRA IFDIF ,<>, JRST ERRD##]> DEFINE ERABRT(ERRORN,EXTRA)< JRST [ EXTRA IFDIF ,<>, JRST ERABRD##]> ; Make a new fd ; Call: 1: ;STRING POINTER TO DIRECTORY NAME ; 2: ;FLAGS,,PARAMETER BLOCK ADDR. ; 3: ;DEVICE DESIGNATOR IF B17 OF AC2 IS ON ; 4: ;STRING POINTER OF OLD PASSWORD (FOR UN-ENABLED CHANGE) ; CRDIR ; Return ; +1 ; Error ; +2 ; Success ; In parameter block ; 0 ; Pointer to name string ; 1 ; Pointer to password string, 0 if none ; 2-N ; Copy of ddb image .CRDIR::JSYS MENTR UMOVE A,2 ; BIT UMOVE B,3 ; DEVICE DESIGNATOR PUSHJ P,SETUNT## ERR() UMOVE E,2 ;FLAGS,,PARAMPTR MOVE A,CAPENB TRNN A,WHEEL ;MUST HAVE SPECIAL CAPABILITIES, TLNN E,577776 ;OR BE CHANGING PASSWORD ONLY CAIA ERR(CRDIX1) UMOVE A,1 PUSHJ P,CPYFUS## ; Copy directory name string ERR CRDIX3 ; No room in jsb MOVE B,1(A) TLNN B,774000 ERR CRDIX5 ; Null name illegal PUSHJ P,DIRLUU## ; Look up the name in directory JRST MAKNFD ; Non-existent, must make a new one TLO E,(1B15) ; NAME EXISTS. DON'T TOUCH MAIL FILE. PUSH P,A MOVE B,DIRINP MOVEI B,-1(B) MOVEI A,JSBFRE PUSHJ P,RELFRE## ; Release free storage used for name TLNE E,(1B16) ; Delete wanted? JRST DELDIR ; Yes UNLOCK DIRLCK,,HIQ POP P,A TLNE E,(1B6) XCTUU [CAMN A,6(E)] JRST CRDIR1 ERR(CRDIX2) ; Directory number disagrees CRDIR1: PUSHJ P,GETDDB## ; Setup a pointer to the ddb BUG(HLT,) MOVE NUM,A ; Save pointer in num ;BACK HERE AFTER CREATING NEW DIRECTORY, FROM MAKNFD BELOW MAKFD0: TLNN E,(1B1) JRST CRDIR3 ; No password change MOVE B,CAPENB TRNE B,WHEEL JRST MAKF02 ;NO CHECK IF SPEC. CAPS. ENABLED MAKF01: UMOVE B,4 ;GET OLD PASSWORD PTR PUSHJ P,CHKPSX ;CHECK PASSWORD ERR(CRDIX1,) MAKF02: UMOVE A,1(E) ; Get pointer to NEW password PUSH P,A ;SAVE THE INITIAL POINTER PUSHJ P,CPYFUS ; Copy new password to free storage MAKF2F: ERR CRDIX3, ; A HAS LOOKUP POINTER TO JSB COPY OF NEW PASSWORD. PUSHJ P,SETMSK## ; Store in directory ; THIS GETS POINTER INTO DIRINP POP P,A ;GET BACK THE INITIAL POINTER MOVS C,A ;CHECK THE BYTE SIZE ANDI C,7700 ; .. CAIE C,4400 ;IS IT 36 BITS? JRST MAKFH1 ;NO, OLD 7-BIT, PROBABLY XCTBU [ILDB C,A] ;36 BITS. GET FIRST HASH WORD XCTBU [ILDB D,A] ; AND SECOND JRST MAKFH2 ;GO STORE THE HASH MAKFH1: HRRO B,DIRINP ;COMPRESS THE NEW PASSWORD PUSHJ P,HASHPM ;RETURNS HASH IN C,D JRST MAKF2F ;WASN'T ANY JSB SPACE. FAIL. MAKFH2: PUSH P,C ;SAVE HASH WDS ON THE STACK FOR A MOMENT PUSH P,D ; .. MOVEM NUM,DIRSAV ;SAVE IN CASE GC HAPPENS MOVEI B,3 ;GET A DIRECTORY BLOCK TO HOLD THE HASH PUSHJ P,ASGDFR## ; .. ERR(CRDIX4,) POP P,2(A) ;PUT THE NEW HASHED PASSWORD IN THE DIR POP P,1(A) ; .. MOVE NUM,DIRSAV ;RESTORE DDB POINTER HLRZ B,DDBNAM(NUM) ; Get old password pointer HRRZS DDBNAM(NUM) ; Zero old pntr PUSH P,A JUMPE B,MAKFD1 ADDI B,DIRORG PUSHJ P,RELDFR## ; RETURN SPACE OLD PASSWORD WAS IN MAKFD1: POP P,A SUBI A,DIRORG HRLM A,DDBNAM(NUM) ; Store as password MOVE B,DIRINP MOVEI B,-1(B) MOVEI A,JSBFRE PUSHJ P,RELFRE ; Release jsb storage CRDIR3: UMOVE A,3(E) ; Get privilege bits TLNE E,(1B3) MOVEM A,DDBPRV(NUM) UMOVE A,4(E) TLNE E,(1B4) MOVEM A,DDBMOD(NUM) SETZM DDBRES(NUM) UMOVE A,12(E) ; GET LAST LOGIN TLNE E,(1B10) ; WANT TO SET IT? MOVEM A,DDBDAT(NUM) ; YES, SET IT UMOVE A,13(E) TLNE E,(1B11) MOVEM A,DDBGRP(NUM) MOVE A,DDBNUM(NUM) UNLOCK DIRLCK,,HIQ PUSHJ P,SETDIR## BUG(HLT,) UMOVE A,2(E) ; GET MAX ALOCATION TLNE E,(1B2) ; SET THIS ONE ? HRLM A,DIRDSK ; YUP UMOVE A,7(E) ; Default file protection ANDI A,777777 TLO A,500000 TLNE E,(1B7) MOVEM A,DIRDPW UMOVE A,10(E) ANDI A,777777 TLO A,500000 TLNE E,(1B8) MOVEM A,DIRPRT UMOVE A,11(E) ANDI A,777777 TLO A,500000 TLNE E,(1B9) MOVEM A,DIRDBK UMOVE A,14(E) TLNE E,(1B12) MOVEM A,DIRGRP UNLOCK DIRLCK,,HIQ JUMPG UNIT,CRDIR4 ; NO MESSAGE FILE IF NOT DSK: CRDI3A: MOVEI B,20 TLNN E,(1B15) ;IF B15 ON, DON'T CREATE MAILBOX. PUSHJ P,ASGJFR## JRST CRDIR4 PUSH P,A HRLI A,() HRROI B,[ASCIZ /DSK:MESSAGE.TXT;1/] SETZ C, SOUT MOVE B,(P) HRLI B,() MOVSI A,400001 GTJFN JRST CRDIR5 MOVE B,[1,,FDBCTL] ;SEE IF IT'S A FRESH FILE MOVEI C,C GTFDB ;CONTROL WORD TO C TLNN C,FDBNXF!FDBDEL ;IF NON-EXISTENT (NEW) OR DELETED, JRST CRDI3B ; NO. LEAVE IT ALONE HRLI A,FDBCTL ;PUT IT IN STANDARD STATE MOVSI B,FDBPRM!FDBNXF!FDBDEL MOVSI C,FDBPRM!FDBDEL CHFDB HRLI A,FDBPRT ;STANDARD PROTECTION FOR MSG FILES MOVEI B,777777 MOVEI C,770404 ;IS APPENDABLE BY ALL CHFDB CRDI3B: HRRZS A RLJFN JFCL JRST CRDIR5 CRDIR6: SUB P,BHC##+1 CRDIR5: POP P,B MOVEI A,JSBFRE PUSHJ P,RELFRE CRDIR4: SETZM NXTDMP## JRST SKMRTN## DELDIR: PUSH P,DIRNUM ; Remember where we are MOVE JFN,-1(P) ; Get directory number to delete PUSHJ P,DELALL## ; Try very hard to delete all files MOVE A,SYMBOT CAME A,SYMTOP ; Did we succeed? JRST [ MOVE A,DIRORG(A) TRNE A,700000 JRST .+1 POP P,A PUSHJ P,MAPDIR## UNLOCK(DIRLCK) ERR(CRDIX7)] POP P,A PUSHJ P,MAPDIR ; Return to subindex MOVE A,DIRLOC ; Get sym tab loc PUSH P,DIRORG(A) ; Save content DELDI0: CAMGE A,SYMBOT ; At bottom? JRST DELDI1 ; Yes MOVE B,DIRORG-1(A) ; No move symbol table up MOVEM B,DIRORG+0(A) SOJA A,DELDI0 DELDI1: AOS SYMBOT ; Point to new bottom HLRZ B,0(P) ; Get pointer to string ADDI B,DIRORG PUSHJ P,RELDFR ; Release free storage SUB P,[XWD 1,1] POP P,A ; Get directory number PUSHJ P,HSHLUK## ; Find it in hash table BUG(HLT,) MOVSI A,-1 EXCH A,DIRORG(B) ; Get hash table entry, delete entry UNLOCK DIRLCK,,HIQ ; Unlock HLRZS A PUSH P,A ; Save LSH A,-^D12 ; Get subindex number MOVNS A ; Negate PUSHJ P,MAPDIR ; Back to the subdirectory MOVEI A,7777 ANDB A,0(P) ; Extract ddb location HLRZ B,DDBNAM+DIRORG(A) ; Get pointer to password ADDI B,DIRORG CAIE B,DIRORG PUSHJ P,RELDFR ; Release free storage if any POP P,B ADDI B,DIRORG PUSHJ P,RELDFR ; Release free storage for ddb UNLOCK DIRLCK,,HIQ JRST SKMRTN MAKNFD: MOVE A,CAPENB TRNN A,WHEEL ERR(CRDIX1,) MOVE A,SYMBOT SUBI A,2 CAML A,FRETOP JRST .+3 PUSHJ P,XPAND## JRST MAKNFF ; FULL MOVEI B,DDBLEN PUSHJ P,ASGDFR## ; Assign space for the ddb JRST MAKNFF ;CLEANUP AND GIVE CRDIX4 MOVEI NUM,(A) ; Point num to the ddb SETZM DDBNAM(NUM) ; Clear name pointers SETZM DDBNUM(NUM) ; Clear number SETZM DDBPRV(NUM) ; Default privileges SETZM DDBDAT(NUM) ; CLEAR LAST LOGIN SETZM DDBMOD(NUM) ; Default modes SETZM DDBGRP(NUM) SETZM DDBRES(NUM) MOVEM NUM,DIRSAV ;SAVE IN CASE GC HAPPENS PUSHJ P,CPYDIR## ; Copy name to directory JRST MAKNFE ;CLEAN UP AND GIVE CRDIX4 SUBI A,DIRORG ; Convert to relative pointer MOVE NUM,DIRSAV ;RESTORE DDB POINTER HRRM A,DDBNAM(NUM) ; Save as name HRLZ C,A ; Right half yet to be filled in SOS B,DIRLOC SOS A,SYMBOT CAML A,B JRST MAKNFZ ADDI A,DIRORG HRLI A,1(A) BLT A,DIRORG-1(B) MAKNFZ: MOVEM C,DIRORG(B) MOVE B,DIRINP MOVEI B,-1(B) MOVEI A,JSBFRE PUSHJ P,RELFRE MOVN A,DIRNUM ; Get subindex number IMULI A,10000 ; Convert to position in file ADD NUM,A ; Of the ddb SUBI NUM,DIRORG MOVEI A,0 PUSHJ P,SETDIR ; Look at block 0 BUG(HLT,) UMOVE A,6(E) TLNE E,(1B6) JRST FNN01 ;FALLS THRU ;FALLS THRU FROM ABOVE FNN00: MOVE A,LSTDNO ; HIGHEST ASSIGNED NUMBER AOS A ; PLUS 1 CAIL A,NFDIB*40 JRST FNN05 ; NO ROOM LEFT UNLOCK DIRLCK,,HIQ PUSHJ P,HSHLUK ; Is this number available? JRST FNN2 ; OK TO USE AOS LSTDNO JRST FNN00 ; No, try another FNN2: CAIL A,1 CAIL A,NFDIB*40 BUG(HLT,) CAML A,LSTDNO MOVEM A,LSTDNO MOVEM A,DIRORG(B) ; Store directory number in rh HRLM NUM,DIRORG(B) ; And ddb location in left MOVE B,NUM IDIVI B,10000 ; Recover block containing ddb ADDI B+1,DIRORG PUSH P,B+1 PUSH P,A UNLOCK DIRLCK,,HIQ MOVN A,B PUSHJ P,MAPDIR ; Return to original subindex POP P,A POP P,NUM HRRM A,DDBNUM(NUM) MOVE B,DIRLOC HRRM A,DIRORG(B) HRRZS A ; Retain only directory number PUSH P,DIRNUM ; Save current directory number PUSH P,A ; And new directory number PUSHJ P,MAPDIR ; Map the new directory MOVE A,DIRNUM CAME A,0(P) ; See if directory looks like JRST CRWIPE ; It already exists SETO A, CAMN A,DIRLCK CAME A,DIRFRE+1 JRST CRWIPE MOVE A,SYMTOP TRNN A,777 CAMGE A,SYMBOT JRST CRWIPE MOVE A,SYMBOT CAMGE A,FRETOP JRST CRWIPE LOCK DIRLCK,,HIQ ; MATCHES THE LATER UNLOCK JRST CRNWIP CRWIPE: MOVEI A,25 MOVEI B,1000 MOVE C,0(P) PUSHJ P,INIBLK## ; Initialize it CRNWIP: POP P,DIRNUM ; Set its directory number MOVEI A,^D250 ; DEFAULT MAX ALOCATION = 250 HRLM A,DIRDSK MOVE A,[500000,,IDRDPW] MOVEM A,DIRDPW ; SET DEFAULT PROTECTION HRRI A,IDRPRT MOVEM A,DIRPRT ; AND DIRECTORY PROTECTION MOVEI A,2 MOVEM A,DIRDBK ; AND DEFAULT BACKUP SETZM DIRGRP ; AND GROUPS POP P,A SETOM DIREXL ; FOR SRI-AI BSYS LOCK STYLE. WILL GO AWAY SOMEDAY. UNLOCK DIRLCK,,HIQ ; Unlock the new directory PUSHJ P,MAPDIR ; Restore to mapping current di JRST MAKFD0 FNN01: CAIL A,1 CAIL A,NFDIB*40 JRST FNN05 UNLOCK DIRLCK,,HIQ PUSHJ P,HSHLUK JRST FNN2 FNN05: UNLOCK DIRLCK,,HIQ ; Number unavailable, abort MOVE B,NUM IDIVI B,10000 MOVEI C,DIRORG(B+1) ; Location in subindex of ddb PUSH P,C MOVN A,B ; Subindex number PUSHJ P,MAPDIR ; Get back to it POP P,NUM HRRZ B,DDBNAM(NUM) ; Get location of name string ADDI B,DIRORG PUSHJ P,RELDFR ; Release it MOVE B,NUM ; Location of ddb PUSHJ P,RELDFR ; Release it MOVE B,DIRLOC ; Location where symtab entry was put FNN03: CAMG B,SYMBOT ; Something left to move? JRST FNN04 ; No MOVE A,DIRORG-1(B) MOVEM A,DIRORG(B) SOJA B,FNN03 FNN04: AOS SYMBOT UNLOCK DIRLCK,,HIQ ERR(CRDIX6) MAKNFE: MOVE B,DIRSAV ;POINTER TO DDB CALL RELDFR ;RELEASE SPACE FROM INDEX MAKNFF: UNLOCK DIRLCK,,HIQ MOVE B,DIRINP MOVEI B,-1(B) MOVEI A,JSBFRE CALL RELFRE ;RELEASE JSB STORAGE USED FOR NAME ERR (CRDIX4) ; Get directory info ; Call: 1 ; Directory number ; 2 ; Pointer to parameter block ; 3 ; String pointer for password ; GTDIR .GTDIR::JSYS MENTR ; UMOVE A,1 ; DIRNUM & BIT UMOVE B,4 ; DEVICE DESIGNATOR PUSHJ P,SETUNT ERR() MOVE B,CAPENB TRNN B,WHEEL!OPER ERABRT(GTDIX1) ; Not wheel or oper. XCTUU [HRRZ A,1] PUSHJ P,GETDDB ERABRT(GTDIX2) UMOVE E,2 UMOVE C,3 JUMPGE C,GTDIR1 CAML C,[777777000000] HRLI C,() GTDIR1: HLRZ B,DDBNAM(A) ADDI B,DIRORG UMOVEM C,3 ; STORE THE STRING POINTER IN AC 3 MOVEI D,0 ; PUT A NULL THERE PUSH P,C ; SAVE START OF STRING XCTBU [IDPB D,C] ; NULL TO USER SPACE POP P,C ; BACK TO BEGINNING OF STRING TLZE C,7700 ; BUT CHANGE TO 36-BIT DATA, IF ANY TLO C,4400 ; .. UMOVEM C,1(E) ; PUT THAT IN ARG BLOCK MOVE D,1(B) ; NOW COPY THE PASSWORD TO USER SPACE XCTBU [IDPB D,C] ; FIRST WORD OF HASH MOVE D,2(B) ; AND SECOND ONE XCTBU [IDPB D,C] ; .. MOVEI D,0 ; PUT A TERMINATING ZERO WORD THERE XCTBU [IDPB D,C] ; EVEN THOUGH IT'S NOT NEEDED. MOVE D,DDBPRV(A) UMOVEM D,3(E) MOVE D,DDBMOD(A) UMOVEM D,4(E) MOVEI D,0 UMOVEM D,5(E) MOVE D,DDBNUM(A) UMOVEM D,6(E) MOVE D,DDBDAT(A) UMOVEM D,12(E) GTDIR2: MOVE D,DDBGRP(A) UMOVEM D,13(E) MOVE A,DDBNUM(A) UNLOCK DIRLCK,,HIQ PUSHJ P,MAPDIR HLRZ D,DIRDSK ; GIVE USER MAX DISK ALOCATION UMOVEM D,2(E) MOVE D,DIRDPW UMOVEM D,7(E) MOVE D,DIRPRT UMOVEM D,10(E) MOVE D,DIRDBK UMOVEM D,11(E) MOVE D,DIRGRP UMOVEM D,14(E) JRST MRETN ; Set time and date ; Call: 1 ; Date and time in standard format ; STAD ; Return ; +1 ; Can't set because not wheel or opr ; +2 ; Ok .STAD:: JSYS MENTR HRRZ B,JOBNO ; IS THIS USER LOGGED IN? HRRZ B,JOBDIR##(B) ; .. JUMPE B,STAD3 ; NO. BETTER RANGE CHECK THE ANSWER MOVE B,CAPENB TRNE B,WHEEL!OPER JRST STAD1 ; OK, BY WHEEL OR OPER STAD3: SKIPGE TADSEC JRST STAD2 ; BY ORDINARY USER, BUT NEED DATE/TIME MOVEI A,STADX1 ; NOT ALLOWED. SET ALREADY. JRST ERRD STAD2: CAML 1,STADMN ; ORDINARY USER. RANGE CHECK DATE CAML 1,STADMX ; MUST BE IN THIS RANGE SKIPA ; NO GOOD. JRST STAD1 ; OK. MOVEI A,STADX2 ; "RIDICULOUS DATE" ERROR MSG JRST ERRD ; AND FAIL. STAD1: SETZ C, MOVE A,TODCLK## IDIVI A,^D1000 ; Convert to seconds XCTUU [HRRZ B,1] ; Get time SUB B,A ; Compute offset JUMPGE B,.+3 ADDI B,^D24*^D3600 ; If less than 0, augment AOJA C,.-2 XCTUU [HLRZ A,1] SUB A,C MOVEM A,TADDAY MOVEM B,TADSEC NOINT ; MAKE SURE IT GETS LOGGED, SINCE IT PUSH P,CAPENB ; REALLY IS BEING CHANGED MOVEI A,OPER ; SET CAPABILITY FOR EFACT IORM A,CAPENB ; .. MOVE A,JOBNO ; This job HRRZ B,JOBDIR(A) ; User number MOVEM B,LOGBUF+1 UMOVE B,1 ; Tad as given MOVEM B,LOGBUF+2 IORI A,(741B8) ; Tad reset code for fact file MOVSM A,LOGBUF Gtad Movem A,Logbuf+3 ; Stash last known time/date in entry. MOVE A,CTRLTT DPB A,[POINT 12,LOGBUF,29] ; Tty MOVE 1,[XWD -4,LOGBUF] ; Make fact file entry for time set EFACT JFCL POP P,CAPENB ; RESTORE REAL CAPABILITIES, AND NOW OKINT ; SAFE TO ALLOW INTERRUPTS JRST SKMRTN ;FOLLOWING IS RANGE OF DATES ACCEPTED IF USER IS NOT A LOGGED-IN WHEEL/OPR STADMN: 122652,,0 ;MIN NON-WHEEL DATE, 29 DEC 74 STADMX: 135424,,0 ;MAX DATE IF SUSPICIOUS, 1 JAN 1990 ; Read time and date ; Call: RTAD ; Return ; +1 ; 1 ; Current date and time or -1 if not set .GTAD:: JSYS MENTR SKIPGE A+1,TADSEC IFNDEF RTICLK,< JRST GTAD1 ; Not set> IFDEF RTICLK,< JRST [ DATAI 600,B CAML B,STADMN ; RANGE CHECK IN CASE PWR FAIL CAML B,STADMX SETO B, JRST GTAD1] ;RETURN IT FROM CALENDAR CLK> MOVE A,TODCLK IDIVI A,^D1000 ADD A,TADSEC IDIVI A,^D24*^D3600 ADD A,TADDAY HRL A+1,A GTAD1: UMOVEM A+1,1 JRST MRETN LS(TADDAY) LS(TADSEC) IFDEF RTISW,< ;READ MICROSECOND INTERVAL TIMER .USEC:: DATAI 610,1 XCT MJRSTF >;END IFDEF RTISW ; Set fact switch ;CALL: 1 ; MASK OF BITS TO CHANGE ; 2 ; New setting ; SMON ; Traps if process hasn't log privilege ; CHANGED TO REQUIRE WHEEL/OPR INSTEAD OF LOG UNTIL CAPABILITIES ARE ; MORE COMPLETELY IMPLEMENTED .SMON::JSYS MENTR MOVE C,CAPENB TRNN C,WHEEL!OPER ; TEMP CHANGED FROM TLNN C,LOG ERABRT(EFCTX1) ANDCAM 1,FACTSW## AND 2,1 IORM 2,FACTSW JRST MRETN ; Read fact switch ; Call: TMON ; Return ; +1 ; Always ; 1 ; The current fact switch setting .TMON:: JSYS MENTR ;MAKE SLOW JSYS SO AOS CAN'T HURT THE ; RETURN PC BY CARRYING INTO LH TDNE 1,FACTSW AOS 0(P) ;SKIP RETURN JRST MRETN ;RETURN TO USER. ; Enter fact file ; Call: LH(1) ; Minus entry size ; RH(1) ; Location of entry ; EFACT ; Return ; +1 ; Error ; +2 ; Ok .EFACT::JSYS MENTR MOVE B,CAPENB TRNN B,WHEEL!OPER ; TEMP CHANGED FROM TLNN B,LOG ERR(EFCTX1) MOVE B,FACTSW TLNN B,(FACTON) JRST SKMRTN ; Fact file not on HLRO B,A ; Get size CAMG B,[-^D64] ERR(EFCTX2) ; Too big NOINT PUSH P,CAPENB ; Save current caps MOVEI A,WHEEL!OPER ; Set bits to ensure access to IORM A,CAPENB ; Accounts directory and fact file MOVEI C,^D30 EFACT2: HRROI B,[ASCIZ /DSK:FACT/] MOVSI A,1 GTJFN JRST EFACT3 PUSH P,1 MOVE 2,[XWD 440000,20000] OPENF ; Open for append JRST EFACT4 EFACT6: POP P,1 UMOVE C,1 UMOVE B,(C) HLRE D,C MOVNS D DPB D,[POINT 6,B,35] JRST .+2 EFACT1: UMOVE B,(C) BOUT AOBJN C,EFACT1 CLOSF BUG(CHK,) POP P,CAPENB ; Restore caps JRST SKMRTN EFACT4: CAIE A,OPNX9 SETZ C, POP P,1 RLJFN JFCL SOJLE C,EFACT3 MOVEI A,^D4000 DISMS JRST EFACT2 EFACT3: HRROI 2,[ASCIZ /DSK:FACT/] MOVSI 1,400001 GTJFN JRST EFACT9 MOVEI C,^D30 EFACT8: PUSH P,1 MOVE 2,[XWD 440000,20000] JSYS 21 JRST EFACT5 JRST EFACT6 EFACT5: CAIE A,OPNX9 JRST EFACT7 SOJLE C,EFACT7 MOVEI A,^D4000 DISMS POP P,1 JRST EFACT8 EFACT7: POP P,1 RLJFN JFCL EFACT9: POP P,CAPENB ; Restore caps ERR(EFCTX3) ; Set account for file ; Call: 1 ; Jfn ; 2 ; String pointer OR 500000000000+account number ; SACTF ; Return ; +1 ; Error ; +2 ; Ok .SACTF::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN## ERR() JFCL ERR(DESX4) TEST(NE,ASTF) ERUNLK(DESX7) HRRZ A,NLUKD(DEV) CAIE A,MDDNAM## ERUNLK(SACTX1) PUSHJ P,GETFDB## ERUNLK(SACTX4) HRLI A,40000 PUSHJ P,DIRCHK## ERUNLK(SACTX4,) UNLOCK DIRLCK,,HIQ PUSH P,FILACT(JFN) ; Save current contents of this cell UMOVE A,2 TLNN A,777777 HRLI A,440700 SACTF1: CAMG A,[577777777777] CAMGE A,[500000000000] JRST SACTF2 ; Pointer MOVEM A,FILACT(JFN) PUSHJ P,INSACT## JRST SACTF3 SACTF2: MOVE B,MODES## HRR B,CAPENB TDNN B,[1B1!WHEEL!OPER] ERUNLK(SACTX3) ; Alphanumeric accounts not allowed PUSHJ P,CPYFUS ; Copy from the user ERUNLK(SACTX2) ; Cannot copy HRRZM A,FILACT(JFN) HLRE B,A ; GET -(WORD COUNT -1) FROM CPYFUS SUBI B,2 PUSH P,(A) ; SAVE BLOCK HEADER FOR RELFRE MOVMM B,(A) ; PLANT COUNT AT HEAD OF STRING STORAGE FOR INSACT PUSHJ P,INSACT HRRZ B,FILACT(JFN) POP P,(B) ; RESTORE BLOCK HEADER FOR RELFRE MOVEI A,JSBFRE PUSHJ P,RELFRE SACTF3: POP P,FILACT(JFN) PUSHJ P,UNLCKF## JRST SKMRTN ; Get account of file ; Call: 1 ; Jfn ; 2 ; Core location to put string if any ; GACTF ; Return ; +1 ; Error ; +2 ; 2 ; 500000000000+number of string pointer .GACTF::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERR() JFCL ERR(DESX4) TEST(NE,ASTF) ERUNLK(DESX7) HRRZ A,NLUKD(DEV) CAIE A,MDDNAM ERR(GACTX1) PUSHJ P,GETFDB ERUNLK(GACTX2) SKIPLE B,FDBACT(A) JRST GACTF1 UMOVEM B,2 UNLOCK DIRLCK,,HIQ PUSHJ P,UNLCKF AOS (P) JRST SKMRTN GACTF1: UMOVE E,2 HRLI E,440700 UMOVEM E,2 HRLI E,DIRORG+2(B) HRRZ B,DIRORG(B) ADDI B,-3(E) XCTMU [BLT E,(B)] UNLOCK DIRLCK,,HIQ PUSHJ P,UNLCKF JRST SKMRTN ; Login ; Accepts: 1/ flags,,directory # ; ;flags - b16 means don't update login date ; 2/ string pointer to password ; 3/ account designator ; Returns: ; +1 failed, error # in 1 ; +2 success JS LGNPAR,2 ;A PARAMETER FOR EXEC0 TO FEED LOGIN ; SECOND WORD IS LAST LOGIN DATE. ; IF B0 OF LGNPAR=1, THIS IS A CRJOB ; LOGIN, AND REST MAY BE FLAGS. .LOGIN::JSYS MENTR SKIPLE 1,LGNPAR ;DID EXEC0 SAY WE SHOULD FAIL? JRST ERRD ;YES. SO FAIL, WITH THAT CODE. MOVE A,JOBNO MOVEI B,777777 TDNE B,JOBDIR(A) ; Is this job currently logged in? ERR(LGINX5) UMOVE A,1 HLRZ B,A ; Get the flags in LH ANDI B,1B34 ; Mask to ones allowed at login time SKIPL LGNPAR ; CRJOB or ordinary login? HRRM B,LGNPAR ; Ordinary. Set up flags HRRZS A ; Just the Directory Number PUSH P,A ; Save the dir # ADD P,BHC+11 ; Allocate string space UMOVE B,3 ; Get account descriptor PUSH P,B ; Save it CAML B,[500000,,0] ; Check for string or numeric CAMLE B,[577777,,-1] JRST .+2 ; Is a string JRST LOGIN3 MOVEI A,-12(P) ; Where to put account string HRLI A,() ; As per CPYFU1 MOVEM A,0(P) ; Update designator CALL CPYFU1## ; Move from user space BUG(HLT,) MOVE B,0(P) ; Account designator MOVE A,-12(P) ; Directory # LOGIN3: VACCT ; Check validity ERR(LGINX1) ; Nope, doesn't make it MOVE A,0(P) ; Designator IFN PIESLC,< ATGRP ; Get pie-slice group name JRST [ CAIN 1,ACCTX1 ; NO WAY TO CHECK? JRST .+1 ; ALLOW THE LOGIN JRST ERRD] ; FAIL SOME OTHER WAY >; END OF IFN PIESLC EXCH B,-12(P) ; Swap for directory # MOVE A,B ; For GETDDB PUSHJ P,GETDDB ; Get directory descriptor block ERR(LGINX2) MOVE B,DDBGRP(A) HLRZ C,FORKN ; C=index of top job fork HRRZ C,SYSFK(C) ; Get sys index IFDEF SYMBLX,< MOVE D,CAPMSK TLNN D,(1B7) ;ALLOWED SPECIAL GROUP ACCESS? TLZ B,(1B0) ;NO, DISABLE GROUP 0 THEN > MOVEM B,FKGRPS##(C) ; Set user groups - assumes single fork ; group in job when LOGIN executed MOVE B,DDBMOD(A) ; Get mode bits MOVEM B,MODES TLNE B,(1B0) ERR(LGINX2,) SKIPGE B,LGNPAR ;CRJOB SAY SKIP PASSWORD CHECK? TRNN B,1 ; IT'S CRJOB. SKIP PASSW CHECK? SKIPA ;NOT CRJOB, OR CRJOB NEEDS PASSWORD. JRST LOGI0A ;YES, LOGGING IN AS CREATOR PUSHJ P,CHKPSW JRST LOGINE ;PASSWORD WRONG LOGI0A: MOVE B,DDBPRV(A) PUSH P,A MOVE A,CTRLTT ;GET CONTROLLING TTY CAIL A,PTYLO ;IS IT PSEUDO TTY ? CAILE A,PTYHI CAIA ;NO TRZ B,740000 ;YES, DISABLE WHEEL,OPERATOR,CONF,MAINT IFDEF SYMBLX,< MOVE A,CAPMSK TLNN A,(1B7) ;WHEEL NOT ALLOWED? TRZ B,740000 ;YES, DISABLE WHEEL, ETC. > HRRM B,CAPMSK HLLOS CAPENB IFN PIESLC,< MOVE A,DEFGP## ;IN CASE NO ACCOUNT STUFF SKIPN ACTONF ;CAN'T DO IF THIS ON ***SRI-AI*** SKIPN PIEFLG## ;PIE-SLICE DATA FILE MAPPED? JRST LOGIN2 ;NO MOVE A,-13(P) ; Get pie-slice name off stack CALL GRPLUK## ;LOOK IT UP JRST LOGI0B ; FAILED TO FIND GROUP NAME LOGIN2: PUSH P,A ;SAVE GROUP INDEX MOVE A,-2(P) ; Get account designator > ;END PIE-SLICE SCHEDULER CONDITIONAL IFE PIESLC,< MOVE A,-1(P) ; Account designator > ; END OF IFE PIESLC Call Setact ERR(LGINX1,) ; Bad account number IFN PIESLC,< POP P,A CALL CHGGRP## ;PUT JOB INTO CORRECT GROUP NOINT LOCK GRPLOK## ;PREVENT UPDATE OF GROUP CPU TIME MOVE A,JOBNO SETZM JOBRT##(A) SETZM JOBORT##(A) ;RESET RUNTIME UNLOCK GRPLOK OKINT CALL ASGDSH## ;RECOMPUTE DSHARE ENTRIES > ;END PIE-SLICE SCHEDULER CONDITIONAL IFE PIESLC,< MOVE A,JOBNO SETZM JOBRT##(A) > ;END NON-PIE-SLICE SCHED CONDITIONAL POP P,B ; DDB index SUB P,BHC+13 ; account desig+string+group GTAD Move C,Jobno ; Update LLORCA. Movem A,LLORCA##(C) MOVE C,DDBDAT(B) ; GET LAST LOGIN DATE MOVEM C,LGNPAR+1 ; SET LAST LOGIN DATE IN GETAB FOR USER PUSH P,C ; SAVE PREVIOUS TAD JUMPL A,LOGIN5 ; DON'T UPDATE DDB DATE IF NOT NOW KNOWN HRRZ C,LGNPAR ; GET FLAGS TRNE C,2 ; ASKED NOT TO UPDATE LOGIN DATE? JRST LOGIN5 ; YES. BYPASS UPDATING THE DDB MOVEM A,DDBDAT(B) ; OK, UPDATE "LAST LOGIN DATE" IN DDB LOGIN5: POP P,A ; GET BACK PREVIOUS LOGIN TAD XCTUU [EXCH A,1] ; RETURN LAST LOGIN DATE TO USER AC 1, HRLS A ; GET LOGIN DIR,,LOGIN DIR MOVE B,JOBNO MOVEM A,JOBDIR(B) ; STORE AS CURRENT LOGGED IN USER HLRZ C,FORKN ; Top job fork HRRZ B,SYSFK(C) ; B=its sys fork index MOVEM A,FKDIR##(B) ; Set fork directories. TLO B,-1 ; B=FKDIR entry for inferiors MOVE A,JOBNO ; GET JOB NUMBER SETZM JOBPGF##(A) ; CLEAR PAGE AULT COUNT FOR THIS JOB Setzm TTYCHS##(A) ;Zero TTY count. MOVEI A,0(C) ; A=job index top job fork PUSHJ P,MAPINF## CALL LOGIN1 ; Set FKDIR for inferiors, if any. UNLOCK DIRLCK,,HIQ PUSHJ P,LOGONM## ; Type logon message TIME MOVEM A,CONSTO SETZM CAPENB JRST SKMRTN LOGIN1: HRRZ C,SYSFK(A) MOVEM B,FKDIR(C) ; Set FKDIR of fork HRLM A,0(P) PUSHJ P, MAPINF CALL LOGIN1 HLRZ A,0(P) POPJ P, LOGINE: CALL CHKPSU ; UNLOCK DIRLCK AND DO PSWD THING ERR(LGINX4) IFN PIESLC,< LOGI0B: BUG(NTE,) MOVE A,[INIGP] ; DEFAULT GROUP NAME CALL GRPLUK BUG(CHK,) JRST LOGIN2 > ; END IFN PIESLC ; Change account .CACCT::JSYS MENTR MOVE A,JOBNO MOVE B,JOBDIR(A) TRNN B,777777 ERR(CACTX2) ADD P,BHC+11 ; Allocate string space JUMPGE P,MSTKOV ; If it overflowed UMOVE A,1 ; Get account designator PUSH P,A CAML A,[500000000000] CAMLE A,[577777777777] JRST .+3 ; Is a string account MOVE B,A JRST CACCT2 MOVEI B,-12(P) ; Where to put account string HRLI B,() ; As per CPYFU1 MOVEM B,0(P) ; Patch acct location EXCH A,B ; For CPYFU1 too CALL CPYFU1 BUG(HLT,) MOVE B,0(P) ; Designator CACCT2: SETO A, ; ME VACCT ; Verify the pair ERR(CACTX1) IFN PIESLC,< MOVE A,0(P) ; ACCOUNT DESIGNATOR ATGRP JRST [ MOVE A,JOBNO MOVE A,PIEGRP##(A) IMULI A,NWDGRP MOVE B,GRPNM##(A) JRST .+1] ; Use old guy... > ; End IFN PIESLC PUSH P,B ; Save the group name MOVE A,-1(P) CALL SETACT ERR(CACTX1) POP P,A SUB P,BHC+11 ; Release space PUSH P,A ; RESAVE GROUP CALL LGCJM0## ; Don't print it POP P,A ;GET PIE-SLICE GROUP NAME UMOVE B,2 ; Get user bits TLNN B,400000 ; Don't change group? JRST CACCT4 ; Change it MOVE B,CAPENB ; Make sure he's allowed TRNE B,WHEEL!OPER JRST CACCT1 CACCT4: IFN PIESLC,< SKIPN ACTONF## SKIPN PIEFLG## ;GROUP FILE MAPPED? JRST CACCT1 ;NO CALL GRPLUK ;LOOK UP JRST .+4 CALL CHGGRP ;AND PUT HIM IN IT CALL ASGDSH ;RECOMPUTE DSHARE ENTRIES JRST CACCT1 BUG(NTE,) > ; END PIE-SLICE SCHEDULER CONDITIONAL CACCT1: TIME MOVEM A,CONSTO MOVE A,JOBNO IFN PIESLC,< CALL UPDPIE## ;ACCUMULATE GROUP CPU TIME NOINT LOCK GRPLOK SETZM JOBORT(A) SETZM JOBRT(A) Setzm TTYCHS##(A) UNLOCK GRPLOK OKINT > ;END PIE-SLICE SCHED CONDITIONAL IFE PIESLC, JRST SKMRTN SETACT: CAML 1,[500000000000] CAMLE 1,[577777777777] JRST .+2 ; STRING ACCOUNT JRST SETACN ; NUMERIC MOVE 2,MODES ; CHECK, EVEN THOUGH SHOULD'T TLNN 2,(1B1) ; BE NECESSARY NOW DAYS RET ; STRING ACCOUNT NOT ALLOWED PUSH P,C ; SAVE THESE GUYS PUSH P,4 HRRI 2,ACCTSR ; WHERE TO PUT ACCT STR HRLI 2,440700 ; NICE POINTER TLC A,-1 ; DEFAULT POINTER? TLCN A,-1 HRLI 1,440700 ; WAS MOVEI 4,^D39 ; MAXIMUM # OF CHARS SETAC1: ILDB 3,1 ; GET A CHAR SOSG 4 ; COUNT CHARS MOVEI 3,0 ; END OF LINE JUMPE 3,SETAC2 ; ? IDPB 3,2 ; PUT DOWN A BYTE JRST SETAC1 SETAC2: IDPB 3,2 ; END WITH NULL Subi B,Acctsr-2 ; Get the length. HRRZM 2,ACCTSL## ; SAVE LENGTH Hrri A,Acctsr-1 HRLI 1,() POP P,4 POP P,C SETACN: MOVEM A,ACCTPT JRST SKPRET## ; RETURN SUCCESS ;PASSWORD CHECK FOR INTERNAL USE ; 1/ directory number ; 2/ password string ptr PASSWC::MOVEI A,0(A) PUSH P,2 PUSHJ P,GETDDB JRST [ POP P,2 POPJ P,] POP P,2 PUSHJ P,CHKPSX JRST CHKPSU ; UNLOCK DIRLCK, DO PSWD FAILURE THING AOS 0(P) UNLOCK DIRLCK,,HIQ POPJ P, CHKPSW: UMOVE B,2 CHKPSX: PUSH P,A PUSH P,B IFDEF SYMBLX,< SKIPGE B,CTRLTT ;GET CONTROLLING TERMINAL NUMBER JRST CHKPS0 MOVE B,XTTFLG##(B) ;GET SPECIAL FLAG WORD TLNE B,(1B1) ;GOOD GUY? JRST CHKPS1 ;YES, WE DON'T NEED PASSWORDS HERE CHKPS0: >;IFDEF SYMBLX HLRZ B,DDBNAM(A) ; Get pointer to password JUMPE B,CHKPS2 ;NO PASSWORD SKIPN DIRORG+1(B) ; IF PASSWORD IS NULL, HASH IS FORCED TO SKIPE DIRORG+1(B) ; BE ZERO IN BOTH WORDS SKIPA ; NOT ZERO HASH. JRST CHKPS2 ; Null password never matches HRLI B,() ADDI B,DIRORG EXCH B,0(P) ;GET BACK PTR TO USER SUPPLIED PSWD PUSHJ P,HASHPW ;CONVERT STRING POINTED TO BY B TO HASH JRST CHKPS2 ;JSB IS FULL. PRETEND PASSWORD WRONG. MOVE A,-1(P) ;GET BACK ADDRESS OF DDB HLRZ B,DDBNAM(A) ;POINT TO THE REAL HASH CAMN C,DIRORG+1(B) ;IS IT RIGHT? CAME D,DIRORG+2(B) ; .. SKIPA ;NO. FAIL. CHKPS1: AOS -2(P) ;YES, SKIP RETURN. CHKPS2: SUB P,BHC+1 ;ADJUST STACK POINTER POP P,A POPJ P, ; PASSWORD FAILURE ROUTINE CALLED BY ALL CALLERS OF CHKPSX AFTER ; DIRECTORY LOCKS ARE CLEARED CHKPSU: UNLOCK DIRLCK,,HIQ ; ENTER HERE TO UNLOCK DIRECTORY FIRST CHKPSF: MOVEI A,WHEEL+OPER TDNE A,CAPENB ; ENABLED WHEEL/OPERATOR? POPJ P, ; YES. JUST FAIL TIME ; NO. GET NOW SUB A,CONSTO ; TIME ON CONSOLE IDIV A,[^D<1000*60*60>] ; IN HOURS ADDI A,1 ; GRACE PERIOD IMULI A,5 ; ALLOW 5 ERRORS PER HOUR AOS PASFCT## ; COUNT PASSWORD FAILURES (THIS JOB) CAML A,PASFCT ; RATE EXCEEDED? POPJ P, ; NO, JUST FAIL HRROI B,[ASCIZ / EXCESSIVE PASSWORD FAILURE RATE. /] SETZ C, MOVEI A,777777 SKIPL CTRLTT SOUT MOVEI A,JB0TTY ; Get job 0 log tty for this nonsense CAIN A,377777 ; IS NIL? JRST CHKPS3 ; YES, SKIP NOTIFICATION PART PUSH P,CAPENB MOVEI B,OPER MOVEM B,CAPENB ; INSURE ABILITY TO PRINT ON OP CONSOLE SETO B, SETZ C, ODTIM HRROI B,[ASCIZ / EXCESSIVE PASSWORD FAILURE RATE IN JOB /] SETZ C, SOUT MOVE B,JOBNO MOVEI C,12 NOUT JFCL HRROI B,[ASCIZ /, USER /] SETZ C, SOUT MOVE B,JOBNO HRRZ B,JOBDIR(B) ; GET LOGIN DIRECTORY JUMPE B,[ ; IF NOT LOGGED IN HRROI B,[ASCIZ /NOT LOGGED IN /] SOUT JRST CHKPS4] DIRST MOVE A,LOGDES## ;FALL THRU ;FALLS THRU CHKPS4: HRROI B,[ASCIZ / TERMINAL /] SOUT SKIPGE B,CTRLTT JRST [ HRROI B,[ASCIZ /DETACHED/] SOUT JRST CHKPS5] MOVEI C,10 NOUT MOVE A,LOGDES IFDEF IMPCHN,< CAIG B,NVTHI CAIGE B,NVTLO JRST CHKPS5 ; NOT NVT LDB B,PTNETI## ; GET NET UNIT NUMBER OF LINE EXCH B,UNIT LDB UNIT,PFHST## ; GET HOST NUMBER EXCH UNIT,B PUSH P,B HRROI B,[ASCIZ /, HOST /] SETZ C, SOUT POP P,B CVHST NOUT MOVE A,LOGDES > CHKPS5: HRROI B,[ASCIZ / /] SETZ C, SOUT HRROI B,[ASCIZ /OPERATOR NOTIFIED. /] MOVEI A,777777 SKIPL CTRLTT SOUT CHKPS3: MOVE A,JOBNO HRRZ A,JOBPT(A) ; GET FORKX OF TOP FORK MOVSI B,400000+PSILOB## IORM B,FKINT##(A) ; SET LGOUT PSI BIT POP P,CAPENB POPJ P, ;ROUTINE TO CONVERT A STRING PASSWORD TO A HASHED PASSWORD. ;FOR MATHEMATICAL TECHNIQUE AND CREDITS, SEE PURDY, CACM AUG 74 ;AND KNUTH VOLUME 2 SECTION 4.6.3. ;THIS IS A MODIFICATION OF THE SYSTEM USED BY JOHNSON AND THOMAS ;IN RSEXEC ;HASHPW ACCEPTS STRING POINTER IN B AND RETURNS HASH IN C AND D. ;A NULL PASSWORD IS FORCED TO BE A 2-WORD ZERO RESULT. ;THE FOLLOWING FILESYSTEM AC'S ARE USED HERE -- ; UNIT = FIRST ARG TO ARITHMETIC ROUTINES. ; IOS = SECOND ARG ; JFN = RESULT (ALL 3 OF THESE POINT TO A TWO-WORD DATUM) ; NUM = POINTER TO SCRATCH AREA IN JSB STORAGE HASHPM: TDZA D,D ;ENTER HERE FOR STRING IN MON SPACE HASHPW: SETO D,0 ;ENTER HERE TO DO UXCT'S TLC B,-1 ;CHECK FOR -1 IN LH OF STRING POINTER TLCN B,-1 ; .. HRLI B,440700 ;YES. NORMALIZE IT. TLZ B,37 ;AVOID INDEX AND INDIRECT BITS MOVE A,B ;COPY THE STRING POINTER SKIPN D ;IF FROM MONITOR SPACE, ILDB B,A ;GET FIRST CHAR FROM HERE SKIPE D ;IF FROM USER SPACE, XCTBU [ILDB B,A] ;SEE IF FIRST CHARACTER IS NULL JUMPE B,[SETZB C,D ;RETURN A DOUBLEWORD 0 IF SO JRST SKPRET##] ;AND GIVE SUCCESS RETURN ;STRING IS NOT NULL. NOW ASSIGN SOME FREE STORAGE, SAVE AC'S, ETC. PUSH P,A ;SAVE THE STRING POINTER A MOMENT PUSH P,B ;SAVE FIRST CHARACTER PUSH P,D ;SAVE FLAG FOR USER/MON SPACE MOVEI B,31 ;LENGTH OF FREE AREA NEEDED PUSHJ P,ASGJFR ;GET IT FROM JSB AREA JRST [SUB P,BHC##+3 ;CAN'T STOP HERE. GIVE FAIL RETURN POPJ P,0] ; .. POP P,D ;RESTORE USER/MON SPACE FLAG AOS -2(P) ;WILL ALWAYS SUCCEED FROM HERE ON. POP P,B ;GET BACK CHARACTER EXCH A,0(P) ;AND STRING POINTER, SAVE JSB POINTER EXCH UNIT,0(P) ;UNIT TO STACK, GET JSB POINTER IN UNIT PUSH P,IOS ; SAVE SOME MORE PUSH P,JFN ; .. PUSH P,NUM ; .. MOVE IOS,D ;THE FLAG FOR USER OR MON STRINGS MOVE NUM,UNIT ;NOW JSB POINTER WHERE IT WILL RESIDE MOVSI C,1(NUM) ;CLEAR OUT THE BLOCK HRRI C,2(NUM) ; .. SETZM 1(NUM) ; .. BLT C,30(NUM) ; .. PUSH P,E ; AN AC TO COUNT 39 CHAR'S MOVEI E,0 ;NO CHAR'S SEEN YET ;FALL THRU ;FALLS THRU PUSH P,ZERO## ;TWO WORDS OF ZERO ON THE STACK PUSH P,ZERO ; INTO WHICH WILL BE XOR'ED THE TEXT. JRST HSHP1A ; ALREADY HAVE FIRST CHARACTER HPWL1: SKIPN IOS ;GET NEXT CHAR FROM MON SPACE ILDB B,A ;IF FLAG FROM HASHPM ENTRY SKIPE IOS ;ELSE FROM USER SPACE XCTBU [ILDB B,A] ; GET NEXT STRING CHARACTER HSHP1A: JUMPE B,HSHPW1 ;JUMP IF END OF STRING MOVEI C,(E) ;CHARACTER NUMBER IDIVI C,^D10 ;GET INDEX INTO SHIFT/XOR TABLES XCT HPWTB1(D) ;NOW SHIFT CHARACTER XCT HPWTB2(D) ;AND XOR IT ONTO STACK CAIGE E,^D39-1 ;QUIT AT 39 CHARACTERS AOJA E,HPWL1 ; MORE TO GO. HSHPW1: POP P,D ;NOW HAVE FIRST LEVEL MESS ON STACK POP P,C ;GET IT BACK TO AC'S, PUT IT IN JSB FREE POP P,E ; RESTORE THIS AC MOVEM C,25(NUM) ; STORAGE AREA, AT CINPUT AND MOVEM D,26(NUM) ; .. MOVEM C,13(NUM) ; AT FF ALSO. MOVEM D,14(NUM) ; .. MOVEI UNIT,25(NUM) ;MULMPD(CINPUT,CINPUT) TO T3 MOVEI IOS,(UNIT) ; .. MOVEI JFN,7(NUM) PUSHJ P,MULMPD MOVEI UNIT,7(NUM) ;MULMPD(T3,CINPUT) TO T2 MOVEI IOS,25(NUM) MOVEI JFN,5(NUM) PUSHJ P,MULMPD PUSH P,BITS##+^D12 ;SLIDE A BIT ALONG TO COMPUTE SUM HSHPW2: MOVEI UNIT,13(NUM) ;MULMPD(FF,FF) TO FF MOVEI IOS,(UNIT) MOVEI JFN,(UNIT) PUSHJ P,MULMPD MOVE A,HASHN1 ;CHECK BIT IN MAGIC CONSTANT TDNN A,0(P) ; .. JRST HSHPX1 ;NOT ON, DON'T ADD IN THIS TERM MOVEI JFN,13(NUM) ;MULMPD(FF,CINPUT) TO FF MOVEI UNIT,(JFN) MOVEI IOS,25(NUM) PUSHJ P,MULMPD HSHPX1: MOVE A,0(P) LSH A,-1 ;SLIDE BIT TO RIGHT MOVEM A,0(P) JUMPN A,HSHPW2 ;LOOP UNTIL 24 BITS DONE ;FALL THRU ;FALLS THRU POP P,(P) ;DONE. DISCARD FLOATING BIT MOVE A,13(NUM) ;FF TO T1 MOVE B,14(NUM) MOVEM A,3(NUM) MOVEM B,4(NUM) MOVEI UNIT,5(NUM) ;MULMPD(T2,T2) TO FF MOVEI IOS,(UNIT) ; P**6 MOVEI JFN,13(NUM) PUSHJ P,MULMPD MOVEI UNIT,13(NUM) ;MULMPD(FF,FF) TO FF MOVEI IOS,(UNIT) ; P**12 MOVEI JFN,(UNIT) PUSHJ P,MULMPD MOVEI UNIT,13(NUM) ; MULMPD(FF,T3) TO FF MOVEI IOS,7(NUM) ; P**14 MOVEI JFN,13(NUM) PUSHJ P,MULMPD MOVEI UNIT,3(NUM) ; MULMPD(T1,FF) TO T0 MOVEI IOS,13(NUM) ; P**N0 MOVEI JFN,1(NUM) PUSHJ P,MULMPD HSHPW3: MOVEI UNIT,1(NUM) ;NOW COMPUTE TERMS OF FINAL SERIES MOVEI IOS,HASHA0 ;T0=T0*A0 MOVEI JFN,1(NUM) PUSHJ P,MULMPD MOVEI UNIT,3(NUM) ;T1=T1*A1 MOVEI IOS,HASHA1 MOVEI JFN,3(NUM) PUSHJ P,MULMPD MOVEI UNIT,5(NUM) ;T2=T2*A2 MOVEI IOS,HASHA2 MOVEI JFN,5(NUM) PUSHJ P,MULMPD MOVEI UNIT,7(NUM) ;T3=T3*A3 MOVEI IOS,HASHA3 MOVEI JFN,7(NUM) PUSHJ P,MULMPD MOVE A,HASHA4 ;T4=A4 MOVE B,HASHA4+1 MOVEM A,11(NUM) MOVEM B,12(NUM) ;FALL THRU ;FALLS THRU ;NOW ADD UP THE TERMS OF THE SERIES MOVE A,1(NUM) ;FF=T0 MOVE B,2(NUM) MOVEM A,13(NUM) MOVEM B,14(NUM) MOVEI UNIT,3(NUM) ;FF=FF+T1 PUSHJ P,ADDMPD MOVEI UNIT,5(NUM) ;FF=FF+T2 PUSHJ P,ADDMPD MOVEI UNIT,7(NUM) ;FF=FF+T3 PUSHJ P,ADDMPD MOVEI UNIT,11(NUM) ;FF=FF+T4 PUSHJ P,ADDMPD MOVE A,13(NUM) ;XFRM=FF MOVE B,14(NUM) MOVEM A,27(NUM) MOVEM B,30(NUM) MOVEI UNIT,27(NUM) ;XFRM=MODP(XFRM) MOVEI JFN,27(NUM) PUSHJ P,MODP PUSH P,27(NUM) ;SAVE ANSWER ON STACK PUSH P,30(NUM) MOVEI A,JSBFRE ;PREPARE TO RETURN SCRATCH AREA MOVEI B,(NUM) ; .. SETZM 1(NUM) ;BUT FIRST CLEAR THE INTERMEDIATE TERMS MOVSI C,1(NUM) ;JUST IN CASE SOMEONE COULD SEE THEM HRRI C,2(NUM) BLT C,30(NUM) ; .. PUSHJ P,RELFRE ;RETURN THE BLOCK POP P,D ;HERE'S THE ANSWER POP P,C ; .. POP P,NUM ;RESTORE FILE SYSTEM AC'S POP P,JFN POP P,IOS POP P,UNIT POPJ P,0 ;AND RETURN HASH IN C,D ;CONSTANTS HPWTB1: REPEAT 2,< JFCL LSH B,7 LSH B,^D14 LSH B,^D21 LSH B,^D28 > HPWTB2: REPEAT 5,< XORM B,0(P)> REPEAT 5,< XORM B,-1(P)> HASHN1: 100,,13 ;2**24+11. PA==^D59 PRIME: 3777,,-1 377777,,-PA K270P: 0 ^D64*PA HASHA0: 127,,533602 240563,,422132 HASHA1: 053,,542132 020301,,633454 HASHA2: 311,,555236 347001,,45671 HASHA3: 123,,106405 245330,,106744 HASHA4: 155,,226337 124357,,220100 ;THE DOUBLE WORD MULTIPLY ROUTINE MULMPD: MOVE A,1(UNIT) MUL A,1(IOS) MOVEM A,15(NUM) MOVEM B,16(NUM) MOVE A,0(UNIT) MUL A,1(IOS) MOVEM A,21(NUM) MOVEM B,22(NUM) MOVE A,1(UNIT) MUL A,0(IOS) MOVEM A,17(NUM) MOVEM B,20(NUM) MOVE A,0(UNIT) MUL A,0(IOS) MOVEM A,23(NUM) MOVEM B,24(NUM) MLM00: MOVEI C,0 MOVE A,20(NUM) ADD A,22(NUM) TLZE A,(1B0) ADDI C,1 ADD A,15(NUM) TLZE A,(1B0) ADDI C,1 MOVEM A,15(NUM) MOVE A,C ADD A,17(NUM) MOVEI C,0 TLZE A,(1B0) ADDI C,1 ADD A,21(NUM) TLZE A,(1B0) ADDI C,1 ADD A,24(NUM) TLZE A,(1B0) ADDI C,1 MOVEM A,24(NUM) ADDB C,23(NUM) MLM01: IOR C,A JUMPE C,MULMPX ;FALL THRU ;FALLS THRU. FIRST RECURSION NEEDED IF GET HERE. USE "LH" CELLS OVER ; FOR "LL". ON THIS PASS, LH AND HH WOULD BE 0, BECAUSE K270P IS SMALL. MLM02: MOVE A,24(NUM) MUL A,K270P+1 MOVEM A,17(NUM) MOVEM B,20(NUM) MOVE A,23(NUM) MUL A,K270P+1 MOVEM A,21(NUM) MOVEM B,22(NUM) ADD B,17(NUM) TLZN B,(1B0) TDZA C,C MOVEI C,1 MOVEM B,17(NUM) ADD C,21(NUM) MOVEM C,24(NUM) SETZM 23(NUM) JUMPE C,MLMRDG ;JUMP UNLESS NEED TO RECURSE AGAIN ;HERE ON SECOND RECURSION. NOW WILL GET JUST A SINGLE WORD ANSWER. MLMRC2: MOVE A,24(NUM) MUL A,K270P+1 MOVEM A,21(NUM) MOVEM B,22(NUM) MOVEI C,0 ADD B,20(NUM) TLZE B,(1B0) ADDI C,1 MOVEM B,20(NUM) ADDM C,17(NUM) JRST MLMRDG ;MORE OF MULMPD. NOW HAVE ANSWER TO FIRST RECURSION IN 17(NUM), 20(NUM) MLMRDG: MOVEI B,0 MOVE C,20(NUM) ADD C,16(NUM) TLZE C,(1B0) ADDI B,1 MOVEM C,16(NUM) ADD B,17(NUM) TLZN B,(1B0) TDZA C,C MOVEI C,1 ADD B,15(NUM) TLZE B,(1B0) ADDI C,1 MOVEM B,15(NUM) MLMOVL: JUMPLE C,MULMPX MOVE A,K270P+1 ADD A,16(NUM) TLZN A,(1B0) TDZA B,B MOVEI B,1 MOVEM A,16(NUM) ADD B,15(NUM) TLZE B,(1B0) ADDI C,1 MOVEM B,15(NUM) SOJA C,MLMOVL MULMPX: MOVE A,15(NUM) MOVE B,16(NUM) MOVEM A,0(JFN) MOVEM B,1(JFN) POPJ P,0 ;EXIT FROM MULMPD ;DOUBLE WORD ADD MOD P ROUTINE FOR HASHED PASSWORDS ADDMPD: MOVE A,1(UNIT) MOVEI C,0 ADD A,14(NUM) TLZE A,(1B0) ADDI C,1 MOVEM A,14(NUM) MOVE A,0(UNIT) ADD A,C ADD A,13(NUM) TLZN A,(1B0) TDZA C,C MOVEI C,1 MOVEM A,13(NUM) JUMPE C,ADDMPN ADDMPR: MOVE A,K270P+1 ADD A,14(NUM) TLZN A,(1B0) TDZA C,C MOVEI C,1 MOVEM A,14(NUM) MOVE A,C ADD A,13(NUM) TLZN A,(1B0) TDZA C,C MOVEI C,1 MOVEM A,13(NUM) JUMPN C,ADDMPR ADDMPN: POPJ P,0 ;MODULO P ROUTINE FOR HASHED PASSWORDS MODP: MOVE A,0(JFN) CAMGE A,PRIME POPJ P,0 PUSH P,E MOVE E,0(JFN) LSH E,-^D<36-7> JUMPN E,MODPOV MODPNO: MOVE A,0(JFN) CAMLE A,PRIME JRST MODPN1 CAME A,PRIME JRST MODPRT MOVE A,1(JFN) CAML A,PRIME+1 JRST MODPN1 JRST MODPRT MODPRA: MOVEM A,0(JFN) MOVEM B,1(JFN) MODPRT: POP P,E POPJ P,0 MODPN1: MOVE A,1(JFN) SUB A,PRIME+1 MOVEI C,0 TLZE A,(1B0) ADDI C,1 MOVEM A,1(JFN) MOVE A,0(JFN) SUB A,PRIME SUB A,C MOVEM A,0(JFN) JRST MODPRT ;MORE MOD P ROUTINE MODPOV: PUSH P,F MOVEI F,1(P) PUSH P,0 PUSH P,0 MOVEI A,PA MUL A,E MOVEM A,0(F) MOVEM B,1(F) PUSH P,JFN MOVEI JFN,0(F) PUSHJ P,MODP ;NEED TO RECURSE. POP P,JFN MOVE A,0(JFN) TLZ A,774000 ADD A,0(F) MOVEI C,0 TLZE A,(1B0) ADDI C,1 MOVE B,1(F) ADD B,1(JFN) TLZE B,(1B0) ADDI A,1 MOVEM B,1(JFN) MOVEM A,0(JFN) CAMGE A,PRIME JRST MODPO1 PUSH P,JFN ; MOVEI JFN,0(JFN) PUSHJ P,MODP POP P,JFN MODPO1: POP P,(P) POP P,(P) POP P,F JRST MODPRT ; Connect to directory ; Call: 1 ; Directory number (b0 for check of pswd only ; b1 proxy conn - change "login" dir ; b2 connect fork in 4 as spec'd ; by other bits) ; 2 ; String pointer to password ; CNDIR ; Return ; +1 ; Error ; +2 ; Ok .CNDIR::JSYS MENTR ; UMOVE A,1 ; DIRNUM + BITS UMOVE B,3 ; DEVICE DESIGNATOR PUSHJ P,SETUNT ERR() MOVE A,JOBNO HRRZ B,JOBDIR(A) ; Get directory of login UMOVE A,1 HLLZ D,A ; D=function bits TLZ A,-1 JUMPL D,CNCHK ; Check only wanted CAIN B,0 ; Must be logged in to connect ERR(CNDIX5) TLNE D,(1B2) ; Connecting other fork? JRST CNDIRA ; Yes, check handles, etc. CNDIR0: MOVE B,FORKX## SKIPGE B,FKDIR(B) JRST [ TLNE D,(1B1) ; Proxy? ERR(CNDIX6) ; Yes, only legal in top fork of group MOVE B,FKDIR(B) JRST .+1 ] CNDIR1: CAIN A,0(B) JRST CNDIR5 ; Can always connect to login directory PUSH P,D ; Save D smashed by GETDDB PUSHJ P,GETDDB JRST [ POP P,D TLNE D,(1B2) ; Other fork? CALL CNDIRR ; Yes, resume forks ERR(CNDIX3) ] ; No such directory MOVE B,CAPENB TRNE B,WHEEL!OPER JRST CNDIR2 ; Bypass checks for wheels and oprs HLRZ B,DDBNAM(A) ; Does this directory have a password JUMPE B,CNDIR3 ; No PUSHJ P,CHKPSW ; Yes, check it JRST CNDIR3 ; Wrong password, still ok if access CNDIR2: POP P,D ; Restore function flags TLNN D,(1B1) ; Correct password - proxy? JRST CNDIR4 ; No JRST CNDIR6 ; Yes, reset groups and capabilities CNDIR3: POP P,D TLNE D,(1B1) ; Proxy? JRST CNDIEE ; Yes, password required UNLOCK DIRLCK,,HIQ UMOVE A,1 HRRZS A MOVEI B,-1 ; Need to pick up real dsk unit PUSH P,D ; Save flags PUSHJ P,SETDIR ; Map the directory JRST CNDIRQ MOVSI A,XCTF PUSHJ P,DIRCHK ; Do we have the proper access to this JRST CNDIRE POP P,D CNDIR4: UNLOCK DIRLCK,,HIQ CNDIR5: UMOVE A,1 NOINT ; Prevent CFGRP by superiors TLNE D,(1B2) ; Other fork? JRST [ HRRZ B,0(P) JRST CNDI55] ; B=FORKX of top fork in group MOVE B,FORKX SKIPGE C,FKDIR(B) MOVEI B,(C) ; B=FORKX of top fork in group CNDI55: HRLM A,FKDIR(B) ; Set connected dir MOVE C,JOBNO HRRZ E,JOBPT(C) CAIN E,0(B) ; Top fork in group=top fork in job? HRLM A,JOBDIR(C) ; Yes, change JOBDIR TLNE D,(1B1) HRRM A,FKDIR(B) ; For proxy change user/login dir TLNN D,(1B2) JRST SKMRTN CALL CNDIRR ; For other fork connect, resume frozen SUB P,BHC+2 JRST SKMRTN CNCHK: HRRZS A PUSH P,D PUSHJ P,GETDDB ERR(CNDIX3) PUSHJ P,CHKPSW JRST CNDIRE UNLOCK DIRLCK,,HIQ JRST SKMRTN CNDIRQ: BUG(CHK,) POP P,D TLNE D,(1B2) CALL CNDIRR MOVEI 1,CNDIX3 JRST ERRD CNDIRE: POP P,D CNDIEE: JUMPL D,.+3 TLNE D,(1B2) CALL CNDIRR CALL CHKPSU ; UNLOCK DIRLCK AND DO PSWD THING MOVEI 1,CNDIX1 JRST ERRD CNDIR6: MOVE B,DDBGRP(A) ; B=user groups TLNE D,(1B2) ; Connecting other forks? JRST CNDIR9 MOVE C,FORKX ; Proxy request legal only in top fork MOVEM B,FKGRPS(C) HRRO B,DDBPRV(A) ; B=user capabilities HRRZ C,FORKN SETZ A, CALL CNDIR8 ; Reset capabilities JRST CNDIR4 CNDIR7: HRRZ C,SYSFK(A) ; C=SYSFK index SKIPL FKDIR(C) ; Fork top fork in group RET ; Yes, return CNDIRG: MOVEI C,0(A) PUSHJ P,SETLF1## ; map fork's PSB CNDIR8: HRRM B,CAPMSK(A) ; Set possible mask ANDM B,CAPENB(A) ; Set enabled mask MOVEI A,0(C) HRLM A,0(P) PUSHJ P, MAPINF CALL CNDIR7 HLRZ A,0(P) POPJ P, CNDIR9: MOVE C,0(P) ; C=FORKX of top fork in group MOVEM B,FKGRPS(C) ; Set group bits HRRO B,DDBPRV(A) HLRZ A,C ; A=Sys index of top fork in group CALL CNDIRG JRST CNDIR4 CNDIRR: MOVE A,-2(P) ; A=index of frozen fork CALL RFORK1## RET CNDIRA: UMOVE A,4 ; A=USER FORK CALL RLJBFK## ; GET JOB INDEX CNDIRB: ERR(FRKHX1) ; NO SUCH FORK HRRZ B,SYSFK(A) ; B=FORKX OF FORK CAMN B,FORKX ; THIS FORK? JRST CNDIRF ; YES, TREAT AS ORDINARY CNDIR MOVEI C,0(A) ; C=JOB INDEX OF FORK HRRZ E,FORKN ; FIND IMMED INF OF EXECUTING FORK THAT CAIA ; IS SUPERIOR TO FORK SPEC'D BY USER CNDIRC: MOVEI A,0(C) ; A=FORK ADD C,SUPERP## LDB C,C ; C=FORK'S SUPERIOR CAIN C,0(E) ; SUPERIOR OF FORK IN A = THIS FORK? JRST .+3 ; YES, FORK IN 1 IS DESIRED FORK JUMPN C,CNDIRC ERR(FRKHX2) ; ATTEMPT TO MANIPULATE SUPERIOR PUSH P,A ; SAVE FORK TO FREEZE PUSH P,B ; SAVE FORKX OF FORK SPEC'D BY USER PUSH P,D NOINT ; PREVENT SUPERIORS FROM INTERFERING CALL FFORK1## ; FREEZE FORKS TO PREVENT POSSIBLE POP P,D ; RACES WITH CNDIRS, CFGRPS POP P,B SKIPGE FKDIR(B) HRRZ B,FKDIR(B) ; B=FORKX OF TOP FORK IN GROUP CAMN B,FORKX ; EXECUTING FORK=TOP FORK IN GROUP? JRST CNDIRD ; YES, TREAT AS ORDINARY CNDIR MOVSI A,-NUFKS ; FIND JOB FORK INDEX OF TOP FORK HRRZ C,SYSFK(A) ; IN GROUP CAIN B,0(C) JRST .+3 AOBJN A,.-3 JRST [ POP P,A ; Can't find fork CALL RFORK1 ; RESUME FROZEN FORKS JRST CNDIRB ] ; ERROR RETURN TLZ A,-1 ; FOR SKIIF CALL CALL SKIIF## ; IS TOP FORK INF TO EXECUTING FORK? JRST CNDIRD ; NO, TOP FORK OF GROUP SPEC'D BY USER ; IS TOP OF EXECUTING FORK'S GROUP HRL B,A PUSH P,B ; 0(P)=JOB,,SYS INDEX TOP FORK IN GROUP MOVE B,FKDIR(B) ; -1(P)=JOB INDEX FORK FROZEN UMOVE A,1 TLZ A,-1 JRST CNDIR1 CNDIRD: POP P,A ; A=INDEX OF FROZEN FORK PUSH P,D CALL RFORK1 ; RESUME FROZEN FORKS POP P,D CNDIRF: TLZ D,(1B2) ; CLEAR B2 FUNCTION UMOVE A,1 TLZ A,-1 JRST CNDIR0 ; RESUME AS ORDINARY CNDIR ; Determine access to a directory and/or file. ; Call: 1/ Flags,,Directory (target) ; B0: Accept file protection in 2, return file access in 2 ; B1: Accept directory number in 3, do proxy GFACC ; 2/ File protection (numeric) if B0 of AC1 on. ; 3/ Directory number (source) if B1 of AC1 on. ; GFACC ; Returns ; +1 Error, error code in 1 ; +2 Success, directory access in 1, file access in 2 if ; B0 of AC1 on in call .GFACC::JSYS MENTR UMOVE E,1 ; Get function bits and target dir TLNE E,(1B1) ; Proxy GFACC? JRST GFACC1 ; Yes MOVE A,FORKX ; No, get fork number MOVE B,FKGRPS(A) ; Get group word if top of fork group SKIPGE A,FKDIR(A) ; Get conn,,login dir if top of fork grp JRST .-2 ; Not top, FKDIR was fork# of top JRST GFACC2 ; Doing proxy GFACC -- make sure privileged and find out for whom GFACC1: MOVE A,CAPENB ; Wheel or operator enabled? TRNN A,WHEEL+OPER ERR(WHELX1) ; No, error UMOVE A,3 ; User # for whom GFACC is being done PUSHJ P,GETDDB ; Get DDB for user ERR(GFACX1) ; Not there MOVE B,DDBGRP(A) ; Ok, get groups of this user UMOVE A,3 ; Get dir # again PUSHJ P,USTDIR## ; Unlock index ; Here with A/ connected,,login dir #'s of requestor, ; B/ user group membership word of requestor GFACC2: PUSH P,A ; Save requestor dir # PUSH P,B ; Save user group word HRRZ A,E ; Get target dir # PUSHJ P,HSHLUK ; Lookup in index ERR(GFACX1,) UNLOCK DIRLCK,,HIQ ; Unlock index but remain NOINT MOVE C,CAPENB TRNE C,WHEEL+OPER ; Wheel or operator? TLNE E,(1B1) ; And not doing proxy GFACC? JRST GFACC3 ; No, do normal stuff MOVEI A,77 ; Yes, return all access for directory MOVEI D,-^D18 ; Set shift count to return file access JRST GFACC4 ; Bypass directory lookup ; Here with A/ target directory number GFACC3: SETO B, ; Default disk unit arg PUSHJ P,MAPDIR ; Map the directory POP P,D ; Get back user group word of requestor AND D,DIRGRP ; Find common user and directory groups SKIPE D ; User belong to directory group? MOVEI D,-6 ; Set to right-justify group protection POP P,A ; Restore requestor dir #(s) HLRZ B,A ; Connected dir if any HRRZS A CAME A,DIRNUM ; Checking access to own directory? CAMN B,DIRNUM ; Or to connected directory? MOVEI D,-^D12 ; Yes, set to right-justify owner prot. MOVE A,DIRPRT ; Get directory protection word LSH A,(D) ; Right-justify appropriate field ANDI A,77 ; Here with A/ directory access, ; D/ shift count for right-justifying protection field GFACC4: JUMPGE E,GFACC5 ; Jump if not also checking file access UMOVE B,2 ; Get protection word from caller TLC B,500000 ; Only numeric protections allowed TLCE B,-1 ERR(GFACX2) ; Illegal protection LSH B,(D) ; Ok, right-justify appropriate field ANDI B,77 TRNE A,40 ; Have access to target directory, and TRNN A,20 ; Access to open files? SETZ B, ; No, return no access to file UMOVEM B,2 ; Return file access bits GFACC5: UMOVEM A,1 ; Return directory access bits JRST SKMRTN END ; OF LOGJS.MAC