10 ! STARTUP Version 1.0 RER 1/82 & ! all entry to system is through this program & ! LINK WITH JPI AND BILLING LIBRARY & 20 ! Ruth E. Reebel & ! Copyright (c) 1982 by & ! Amherst Associates Incorporated & ! 210 Old Farm Road & ! Amherst, Massachusetts 01002 & 970 EXTERNAL LONG FUNCTION SYS$GETJPI,SYS$WAITFR,SYS$HIBER & ! get job proc info, wait for each process' info & ! this process will hibernate until BYE or ATTach... & \ EXTERNAL LONG FUNCTION SYS$GETDEV,SYS$TRNLOG & ! get device (to see if mailbox exists,if so proc exists) & \ EXTERNAL LONG FUNCTION SYS$CREMBX,SYS$CREPRC,SYS$SETPRN,SYS$DELPRC & ! create mailbox and process,reset process name,delete proc & \ EXTERNAL LONG FUNCTION SYS$SETPRI & ! used to lower priority after login sequence & \ EXTERNAL LONG CONSTANT SS$_NORMAL,SS$_NOMOREPROC,SS$_NOPRIV, & SS$_SUSPENDED,SS$_DUPLNAM & ! values returned by system service & \ EXTERNAL LONG CONSTANT JPI$_GRP,JPI$_MEM,JPI$_USERNAME, & JPI$_PRCNAM,JPI$_IMAGNAME & \ EXTERNAL LONG FUNCTION SYS$QIOW & \ EXTERNAL LONG IO$_WRITEVBLK & \ DECLARE LONG WILDC,EVTF & \ DECLARE LONG SYS_STATUS,UIC,ILIST(18%),GRPJPI,MEMJPI & \ MAIL$=SPACE$(63%) & \ MBX$=SPACE$(63%) & 980 DIM JOB%(9%,2%),JOBNM$(9%) & \ SYS_STATUS=SYS$SETPRI(,,9% BY VALUE,) & ! 9 is login priority but we must reset to 9 if we are & ! returning here from MAINUP during an attach operation & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ LMT%=9% ! MAX OF 10 JOBS ALLOWED & 1000 MAP (DUMMY) STRING USERNAMEJPI=8%,PRCNAMJPI=15%,IMAGNAMEJPI=64% & \ ILIST(0%)=(JPI$_GRP*65536)+4% & \ ILIST(1%)=LOC(GRPJPI) & \ ILIST(2%)=0% & \ ILIST(3%)=(JPI$_MEM*65536)+4% & \ ILIST(4%)=LOC(MEMJPI) & \ ILIST(5%)=0% & \ ILIST(6%)=(JPI$_USERNAME*65536)+8% & \ A=LOC(USERNAMEJPI) !this necessary due to bug in basic LOC() & \ ILIST(7%)=A & \ ILIST(8%)=0% & \ ILIST(9%)=(JPI$_PRCNAM*65536)+15% & \ A=LOC(PRCNAMJPI) & \ ILIST(10%)=A & \ ILIST(11%)=0% & \ ILIST(12%)=(JPI$_IMAGNAME*65536)+64% & \ A=LOC(IMAGNAMEJPI) & \ ILIST(13%)=A & \ ILIST(14%)=0% & \ ILIST(15%)=0% & \ SYS_STATUS=SYS$GETJPI(,,,ILIST() BY REF,,,) & \ IF SYS_STATUS<>SS$_NORMAL THEN PRINT "ERROR GETTING UIC" & \ STOP & ! get current process information & 1012 UIC=(GRPJPI*65536)+MEMJPI ! FOR CREPRC & \ GRPJPI$=NUM1$(GRPJPI) ! group & \ MEMJPI$=NUM1$(MEMJPI) ! member & \ ORGUSER$=USERNAMEJPI+" " & \ SVEUSER$,ORGUSER$=EDIT$(ORGUSER$,6%) ! save for current proc name assignmt & 1015 DMY$=EDIT$(PRCNAMJPI,6%) & ! save name of current process to ignore it later & 1017 WILDC=-1 & ! do wildcard GETJPI for current UIC's other jobs (if any) & 1020 EVTF=1% & \ SYS_STATUS=SYS$GETJPI(EVTF BY VALUE, & WILDC BY REF, & ,ILIST() BY REF, & ,,) & \ GOTO 1070 IF (SYS_STATUS=SS$_NOMOREPROC) & \ GOTO 1020 IF (SYS_STATUS=SS$_NOPRIV) & \ GOTO 1020 IF (SYS_STATUS=SS$_SUSPENDED) & \ IF (SYS_STATUS AND 1%)=0% THEN PRINT "CONTINUING... ";SYS_STATUS & \ GOTO 1020 & ! loop thru all jobs on system & ! if an error occurs, ignore that job... & 1030 SYS_STATUS=SYS$WAITFR(EVTF BY VALUE) & \ IF (SYS_STATUS AND 1%)=0% THEN PRINT "ERROR WAITFR" & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) & ! wild card GETJPI is asyncronous so we must wait for event flag & 1040 GOTO 1020 IF (NUM1$(MEMJPI)<>MEMJPI$) OR (NUM1$(GRPJPI)<>GRPJPI$) & ! only want same user's processes (by member and group) & \ PRC$=EDIT$(PRCNAMJPI,6%) & \ LPRC%=LEN(PRC$) & \ GOTO 1020 IF PRC$=DMY$ ! the process retrieved is THIS process & \ IMGNM$=EDIT$(IMAGNAMEJPI,6%) & \ IMGNM$="* NO ACTIVE IMAGE *." IF LEN(IMGNM$)=0% & \ I%=INSTR(1%,IMGNM$,"]") & \ IMGNM$=RIGHT$(IMGNM$,I%+1%) & \ I%=INSTR(1%,IMGNM$,".") & \ IMGNM$=LEFT$(IMGNM$,I%-1%) & ! get rid of location info (eg DRA0:[RUTHR]) & ! and extention .EXE & 1045 IF ASCII(PRC$)>=48% AND ASCII(PRC$)<=57% THEN & LCN%=VAL(LEFT$(PRC$,1%)) & \ JOB%(LCN%,0%)=-1% & \ GOTO 1020 & ! main process (ie 0RUTHR0) sets (x,0) flag & 1046 EN$=RIGHT$(PRC$,LPRC%) !get last char & \ GOTO 1020 IF ASCII(EN$)<48% OR ASCII(EN$)>57% !check for number & \ I%=INSTR(1%,PRC$,"_") !look for underline & \ GOTO 1020 IF I%<>0% & ! valid process names have number at end and no underlines. & ! above is necessary only for testing, etc. & 1047 IF ASCII(PRC$)=87% THEN LCN%=VAL(EN$) & \ JOB%(LCN%,0%)=-1% & \ GOTO 1020 & ! process with "W" (ie WRUTHR0) is a main process being "watched" & ! for use with BIG BROTHER program & 1050 IF ASCII(PRC$)=68% THEN LCN%=VAL(EN$) & \ JOB%(LCN%,1%)=-1% & \ JOBNM$(LCN%)=IMGNM$ UNLESS JOBNM$(LCN%)<>"" & \ GOTO 1020 & ! detached process (ie DRUTHR0) sets (x,1) flag & ! save image name only if a BATCH job has not already stored a name & 1060 IF ASCII(PRC$)=66% THEN LCN%=VAL(EN$) & \ JOB%(LCN%,2%)=-1% & \ JOBNM$(LCN%)=IMGNM$ & \ GOTO 1020 & ! batch process (ie BRUTHR0) sets (x,2) flag & ! save image name & 1065 PRINT "UNIDENTIFIED PROCESS: ";PRC$,IMGNM$ & \ GOTO 1020 & ! handle any weirdness...should never reach here & 1070 DETJOB%=0% & \ DETJOB%=DETJOB%+1% IF JOB%(I%,0%)=0% AND JOB%(I%,1%)<>0% & FOR I%=0% TO LMT% & \ GOTO 1080 IF DETJOB%=0% & \ ISARE$="JOB IS " & \ ISARE$="JOBS ARE " IF DETJOB%>1% & \ PRINT "THE FOLLOWING ";ISARE$;"DETACHED UNDER THIS ACCOUNT" & \ FOR I%=0% TO LMT% & \ PRINT TAB(5%);"JOB=";I%;" PROGRAM= ";JOBNM$(I%) & IF JOB%(I%,0%)=0% AND JOB%(I%,1%)<>0% & \ NEXT I% & \ INPUT "JOB NUMBER TO ATTACH TO (=NONE)";N$ & 1075 GOTO 1080 IF LEN(N$)=0% ! non-attach & \ GOTO 1070 IF LEN(N$)>1% ! too many characters & \ GOTO 1070 IF ASCII(N$)<48% OR ASCII(N$)>57% ! not a number & \ N%=VAL(N$) & \ GOTO 1090 IF JOB%(N%,0%)=0% AND JOB%(N%,1%)<>0% ! valid attach & \ PRINT "JOB ";N$;" IS NOT DETACHED" & \ GOTO 1070 & 1080 FOR I%=0% TO LMT% & \ IF JOB%(I%,0%)=0% AND JOB%(I%,1%)=0% THEN N$=NUM1$(I%) & \ GOTO 1090 & ! assign job number for new user (non-attach) & 1085 NEXT I% & \ PRINT "TOO MANY JOBS ON SYSTEM..YOU MUST ATTACH TO AN EXISTING JOB" & \ GOTO 1070 & 1090 TOTJOB%=0% & \ TOTJOB%=TOTJOB%+1% IF JOB%(I%,0%)<>0% & FOR I%=0% TO LMT% & \ GOTO 1100 IF TOTJOB%=0% & \ ISARE$="USER IS " & \ ISARE$="USERS ARE " IF TOTJOB%>1% & \ PRINT TAB(5%);TOTJOB%;" OTHER ";ISARE$;"LOGGED IN UNDER THIS ACCOUNT" & \ PRINT & 1100 ORGUSER$=SVEUSER$+N$ & ! add job number to end of username & 1140 PRC$=N$+ORGUSER$ & ! main proc has job number at start of name & \ SYS_STATUS=SYS$SETPRN(PRC$ BY DESC) & \ IF (SYS_STATUS = SS$_DUPLNAM) THEN & JOB%(I%,J%)=0% FOR J%=0% TO 2% FOR I%=0% TO LMT% & \ PRINT "DUPLICATE PROCESS...TRYING AGAIN" & \ GOTO 1017 & 1145 IF (SYS_STATUS AND 1%)=0 THEN PRINT "ERROR IN SETPRN" & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) & ! change main process name to include job number & 1150 MBX$=PRC$ & \ SUB_S$="D"+ORGUSER$ & ! the mailbox is the process name eg: 0ruthr0 & ! the detached process name is "d"+user name+job number & ! other programs can figure this out by using the process name & 1160 SYS_STATUS=SYS$GETDEV(MBX$ BY DESC,,,,) !look for existing mailbox & \ CALL CHKMON(MBX$) ! check if hibernating & \ GOTO 2000 IF (SYS_STATUS AND 1%)<>0% !mailbox found & ! if this is a reattach, chain directly to MAINUP & ! do not create new process (do not collect $200.00) & ! this is somewhat overkill... & 1170 SYS_STATUS=SYS$CREMBX(,MBX.CH%,512% BY VALUE,,,,MBX$ BY DESC) & \ IF (SYS_STATUS AND 1%)=0% THEN PRINT "ERROR FROM CREMBX" & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) & ! create the mailbox to be used between & ! the main process (running MAINUP) & ! and the detached process (actually doing the work) & 1171 SYS_STATUS=SYS$TRNLOG(MBX$,,MAIL$,1% BY VALUE,,) & \ MBX$=EDIT$(MBX$,-1%) & 1172 CALL LOGNAME(MAIL$,MBX$,0%,0%,SYS_STATUS) & \ IF (SYS_STATUS AND 1%)=0% THEN PRINT "ERROR FROM LOGNAME" & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) & ! put the mailbox logical name in the system table. this is neccessary & ! for the monitor program to work. & 1300 PROG$="SYS$SYSTEM:LOGINOUT.EXE" & \ DECLARE LONG SAME_USER_S,PID_S,BASPRI & \ BASPRI=15 & \ SAME_USER_S=64% & ! the following is to set QUOTA in CREPRC & \ MAP (DUM1) LONG LST(3%) & \ MAP (DUM1) WORD WD(7%) & \ LST(0%)=0% & \ LST(1%)=0% & \ LST(2%)=0% & \ LST(3%)=0% & \ WD(0%)=(6%+20%*256%) & ! 6 is the value of PQL$_FILLM..to allow following processes to hove & ! more than the default of 10 files opened. Since my default is 20 & ! I allowed 20 max for detached proc & \ WD(2%)=10%*256% ! 10 is PQL$_WSQUOTA & \ WD(3%)=450% ! set to 450 instead of default 120 & \ WD(5%)=(7%+16%*256%) ! 7 is PQL$_PGFLQUOTA & \ LST(3%)=39% ! the 16 above plus this 39 together set 10000 in & ! quota list & \ SYS_STATUS=SYS$CREPRC(PID_S, !proc ID & PROG$, !start det proc on loginout & MBX$ BY DESC, & MBX$ BY DESC, & MBX$ BY DESC, !all in/out thru MBX & , !priv & LST() BY REF, !quota & SUB_S$, !name of det proc & BASPRI BY VALUE, !priority of det job & UIC BY VALUE, !detach request & , !no termination mbx & SAME_USER_S BY VALUE) !same priv & \ IF (SYS_STATUS AND 1%)=0 THEN PRINT "ERROR IN CREPRC";SYS_STATUS & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) & 1700 MAP(IOSB.1) LONG IOSB_L(1),STRING REC_BUFFER=140,LONG I & \ MAP(IOSB.1) WORD IOSB_W(3) & \ RECBUF$="@HSLCTL:MAINCTL" !write command file to det proc & \ LSET REC_BUFFER=RECBUF$ & \ IOSB_W(1)=LEN(RECBUF$) & 1710 SYS_STATUS=SYS$QIOW(,MBX.CH% BY VALUE,IO$_WRITEVBLK,,,, & REC_BUFFER BY REF,IOSB_W(1%) BY VALUE,,,,) & \ IF (SYS_STATUS AND 1%)=0 THEN PRINT "ERROR WRITING TO MBX" & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) & ! above also assures that creprc actually created the process before & ! we chain away...this was a problem earlier. & 2000 SYS_STATUS=SYS$SETPRI(,,4% BY VALUE,) ! login done, lower priority CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% CHAIN "HSL1:MAINUP" & ! chain to monitoring program & 19000 ! ERROR TRAPS & ON ERROR GOTO 19000 ! RESET STANDARD ERROR TRAP & 19900 ! UNEXPECTED ERRORS & & PRINT FOR I%=1% TO 4% & \ PRINT 'PROGRAM ERROR ';ERN$ & \ PRINT 'ERROR=';ERR;'AT LINE';ERL & \ PRINT ERT$(ERR) & \ PRINT 'PLEASE CALL AMHERST ASSOCIATES' & \ PRINT CHR$(11%) & \ RESUME 32760 & 32760 ! A B N O R M A L E X I T & ! final billing here & 32767 END