FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18369 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C C LIST,USER C LIST,GROUP C CALLING SEQUENCE: C CALL ACLIU(ITYPE) C C WHERE: ITYPE=1 FOR USER C ITYPE=2 FOR GROUP C C LIST,USER C C ACCOUNT NAME FUNCTION C C C USER.GROUP LIST ONE ENTRY FOR ACCOUNT C C USER.@ LIST ALL ENTRIES IN ALL GROUPS C WITH NAME USER C C @.GROUP LIST ALL USERS OF GROUP C C @ LIST ALL USERS (DEFAULT) C C @.@ LIST ALL USERS AND GROUPS C SUBROUTINE ACLIU(ITYPE) ,92067-16361 REV.1940 790724 LOGICAL NOGRPS,ISRCH DIMENSION NAME(11),ITBUF(17) COMMON /ACOM1/NDCB(272),NBUF(256),IBUF(256) COMMON /ACOM2/ IDQQ1,IDQQ2,IDQQ3,JTYPE COMMON /ACOMA /ISRCH COMMON /ACOM4/ ICMND(40) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM7/ IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA IAT/2H@ / DATA LPPG,I0,I4,I6 /54,2HI0,2HI4,2HI6 / DATA ICR / 2HCR / C C PARSE ACCOUNT NAME C IERR=0 CALL PARSN(NAME,ICMND,80,ISTRC,IERR) IF(IERR.NE.0) IERR=-203 IF(IERR.NE.0) GO TO 950 C C PARSE LIST DEVICE C CALL NAMR(LIST,ICMND,80,ISTRC) LIST(4)=IAND(LIST(4),3) CALL ACOPL(IERR,3,24) IF(IERR.NE.0) GO TO 900 C C PARSE FOR PASS C CALL NAMR(IPBUF,ICMND,80,ISTRC) C C PARSE FOR ID C CALL NAMR(JPBUF,ICMND,80,ISTRC) C C SET ALL GROUPS FLAG C NOGRPS=.TRUE. IF(NAME(2).EQ.IAT.AND.NAME(7).EQ.IAT) NOGRPS=.FALSE. C C SET DEFAULTS C IF(MBYTE(NAME(1)).EQ.0) NAME(2)=IAT IF(LBYTE(NAME(1)).EQ.0) NAME(7)=IAT IF(LBYTE(NAME(1)).NE.0.OR.NAME(2).EQ.IAT) GO TO 25 NAME(7 )=2HGE NAME(8 )=2HNE NAME(9 )=2HRA NAME(10)=2HL NAME(11)=2H C C SAVE RESET VALUES FOR LOOP C 25 IU=NAME(2) IG=NAME(7) C C SET ACERR FLAG C KERR=-200 C C GROUP LIST ONLY C GO TO(50,550),ITYPE 50 LINES=100 C C GET USER ENTRY C 100 CALL ACGTU (NAME(2),NAME(7),IBUF,IOF,IERR) IF(IERR.NE.0) GO TO 500 C C SET ACERR FLAG TO ZERO FOUND AT LEAST 1 ACCOUNT C KERR=0 C C TEST TO SEE IF WILL FIT ON PAGE C NTSST=LBYTE(IBUF(33+IOF)) IF(LINES+NTSST+18.LE.LPPG) GO TO 150 LINES=0 CALL ACWRL(2H1 ,1) 150 LINES=LINES+17 C C PRINT STARS CALL ACSTR CALL ACFMT (IERR,5,6HUSER: ,-20,0,10,NAME(2),1,2H. ,0,10,NAME(7)) CALL ACFMT (IERR) C C IF I AM NOT SYSTEM MANAGER OR GROUP MANAGER FOR GROUP C I CAN'T LOOK AT PASSWORD OR ID'S C IGID=IBUF(IOF+30) IF(IDSES.NE.7777B.AND.(MYCAP.NE.63.OR.IGID.NE.MYGID)) GO TO 175 C C PRINT PASSWORD C IF (IPBUF(1).NE.2HPA.AND.JPBUF(1).NE.2HPA) GO TO 170 CALL ACFMT (IERR,9,10HPASSWORD: ,-16,0,10,IBUF(2+IOF)) LINES=LINES+1 C C PRINT ID # C 170 IF(JPBUF(1).NE.2HID.AND.IPBUF(1).NE.2HID) GO TO 175 CALL ACFMT (IERR,12,12HUSER ID: ,I4,IBUF(IOF+29)) CALL ACFMT (IERR,12,12HGROUP ID: ,I4,IGID) LINES=LINES+2 C C PRINT HELLO FILE NAME C 175 IX=-14 IF(IBUF(7+IOF).EQ.2H ) IX=-80 C C DONT PRINT SC UNLESS SYSTEM MANAGER C ISC=IBUF(10+IOF) IF(IDSES.NE.7777B.AND.(MYCAP.NE.63.OR.IGID.NE.MYGID)) ISC=0 C CALL ACFMT (IERR,11,12HHELLO FILE: ,IX,0,6,IBUF(7+IOF),1,2H: ,ICR 1 ,ISC,1,2H: ,ICR,IBUF(11+IOF)) C C SET UP PRINT FOR CAPABILTY C IX=-7 ICAPS=IBUF(22+IOF) IF(ICAPS.NE.63.OR.IBUF(IOF+29).EQ.7777B) IX=-80 C C PRINT CAPABILITY C CALL ACFMT (IERR,11,12HCAPABILITY: ,-14,I6,ICAPS,IX, 1 13,14HGROUP MANAGER ) CALL ACFMT (IERR,11,12HDISC LIMIT: ,-14,I6,IBUF(31+IOF)) CALL ACFMT (IERR,11,12HSST SPARES: ,-14,I6,LBYTE(IBUF(32+IOF))) CALL ACFMT (IERR) CALL ACFMT (IERR,9,10HUSER SST: ,-16, 1 22,22HSESSION LU / SYSTEM LU ) CALLACFMT (IERR,-25, 1 22,22H--------- ---------- ) C C COMPUTE NUMBER USER & GROUP SST'S C NGSST=MBYTE(IBUF(32+IOF)) NUSST=NTSST-NGSST C C PRINT SST'S C IF(NTSST.GT.31) 1 CALL READF(NDCB,IERR,IBUF(IOF+64),33,LEN,IBUF(IOF+64)) IF(NTSST.LE.0) GO TO 350 DO 300 I=1,NTSST LINES=LINES+1 IF(LINES.LE.LPPG) GO TO 190 LINES=5 CALL ACWRL(2H1 ,1) CALL ACSTR CALL ACFMT(IERR) CALL ACFMT (IERR,-25, 1 22,22HSESSION LU / SYSTEM LU ) CALLACFMT (IERR,-25, 1 22,22H--------- ---------- ) 190 IF(I.EQ.NUSST+1) GO TO 200 ISES=IAND(255,LBYTE(IBUF(33+IOF+I))+1) ISYS=IAND(255,MBYTE(IBUF(33+IOF+I))+1) CALL ACFMT (IERR,-25,I6,ISES,-5,I6,ISYS) GO TO 300 C C PRINT FIRST GROUP SST C 200 ISES=IAND(255,LBYTE(IBUF(33+IOF+I))+1) ISYS=IAND(255,MBYTE(IBUF(33+IOF+I))+1) CALL ACFMT (IERR,10,10HGROUP SST:,-15,I6,ISES 1 ,-5,I6,ISYS) 300 CONTINUE 350 CALL ACFMT (IERR) CALL ACTIM(IBUF(25+IOF),IERR) IF(IBUF(23+IOF).NE.0.OR.IBUF(24+IOF).NE.0) GO TO 370 CALL ACFMT (IERR,16,16HNEVER LOGGED OFF ) GO TO 380 370 CALL ACLTM(IBUF(23+IOF),ITBUF) CALL ACFMT (IERR,19,20HLAST LOGGED OFF: ,34,ITBUF) 380 CALL ACFMT (IERR) CALL ACSTR C C GO BACK AND SEARCH REST OF DIRECTORY C ISRCH=.TRUE. NAME(2)=IU NAME(7)=IG IF(IU.EQ.IAT.OR.IG.EQ.IAT) GO TO 100 C C PRINT ALL GROUPS? C 500 IF(NOGRPS) GO TO 900 C YES C C GROUP PRINT ROUTINE C 550 LINES=100 ISRCH=.FALSE. C C GET GROUP ACCOUNT C 600 CALL ACGTG (NAME(2),IBUF,IOF,IERR) IF(IERR.NE.0) GO TO 900 C C SET ACERR FLAG FOUND 1 GROUP C KERR=0 C C TEST TO SEE IF IT WILL FIT ON PAGE C NGSST=-IBUF(6+IOF) IF(NGSST+LINES+11.LE.LPPG) GO TO 650 LINES=0 CALL ACWRL(2H1 ,1) 650 LINES=LINES+NGSST+11 CALL ACSTR CALL ACFMT (IERR) CALL ACFMT (IERR,6,6HGROUP:,-19,0,10,NAME(2)) CALL ACFMT (IERR) IF(IPBUF(1).NE.2HID.AND.JPBUF(1).NE.2HID) GO TO 675 CALL ACFMT (IERR,12,12HGROUP ID: ,I4,IAND(IBUF(IOF+1),7777B)) CALL ACFMT (IERR) LINES=LINES+2 675 CALL ACFMT (IERR,10,10HGROUP SST:,-15, 1 22,22HSESSION LU / SYSTEM LU) CALL ACFMT (IERR,-25 1 22,22H--------- ----------) NGSST=-IBUF(6+IOF) IF(NGSST.LE.0)GO TO 750 DO 700 I=1,NGSST ISES=IAND(LBYTE(IBUF(6+IOF+I))+1,255) ISYS=IAND(MBYTE(IBUF(6+IOF+I))+1,255) 700 CALL ACFMT (IERR,-25,I6,ISES,-5,I6,ISYS) 750 CALL ACFMT (IERR) CALL ACTIM(IBUF(2+IOF),IERR) CALL ACFMT (IERR) CALL ACSTR C C PRINT ALL GROUPS C ISRCH=.TRUE. NAME(2)=IU IF(IU.EQ.IAT) GO TO 600 C C CLEAN UP AND EXIT C 900 CALL ACCLL 950 IF(IERR.EQ.-200) IERR=KERR ISRCH=.FALSE. IF(IERR.NE.0) CALL ACERR(IERR) RETURN END