.title users Display Logged In Users ;;; Eric P. Scott, Jet Propulsion Laboratory, March 1984 ;;; Kenneth A. Adelman, Caltech, suggested using the PHONE object ;;; to obtain remote information $devdef $dscdef $dvidef $fabdef $jpidef $libdef $namdef $rabdef $rmsdef $shrdef $ssdef $stsdef $xabdef $xabprodef TAB=9 .default displacement,word .psect code,nowrt,exe,shr,pic,long .entry users,^m ;;; Open SYS$OUTPUT pushaw xabpro+xab$w_pro ; Death to evil Exe bits! clrl -(sp) calls #2,g^sys$setdfprot bisw2 #!!- !xab$m_noexe,xabpro+xab$w_pro moval nam,r3 movab -nam$c_maxrss(sp),sp ; Only need ES if $CREATE fails movab (sp),nam$l_esa(r3) movb #nam$c_maxrss,nam$b_ess(r3) moval fab,r2 $create fab=r2 blbs r0,7$ pushl nam$l_rsa(r3) ; Pretty death movzbl nam$b_rsl(r3),-(sp) bneq 5$ movl nam$l_esa(r3),4(sp) movzbl nam$b_esl(r3),(sp) bneq 5$ movl fab$l_fna(r2),4(sp) movzbl fab$b_fns(r2),(sp) assume fab$l_stv eq fab$l_sts+4 5$: movq fab$l_sts(r2),-(sp) pushaq 8(sp) pushl #1 pushl #sts$m_cust_def!shr$_openout!sts$k_severe pushl #5 $putmsg_s facnam=facnam,msgvec=12(sp) bisl3 4(sp),#sts$m_inhib_msg,r0 6$: ret assume nam$b_esl eq nam$b_ess+1 7$: clrw nam$b_ess(r3) ; Drop ES clrl nam$l_esa(r3) movab nam$c_maxrss(sp),sp bbc #dev$v_rec,fab$l_dev(r2),15$ movw fab$w_bls(r2),twidth ; Can get width from RMS ;; Should this be bbc #nam$v_ppf,nam$l_fnb(r3),15$ ? bbc #fab$v_ppf_ind,fab$w_ifi(r2),15$ ; Stale for PPFs assume <&^xffff0000> eq 0 bitw #dev$m_net!dev$m_spl,fab$l_dev(r2) ; $GETDVI would fail bneq 15$ ; if NET; examines intermediate if SPL pushab nam$t_dvi+1(r3) ; Do it the hard way movzbl nam$t_dvi(r3),-(sp) movw #dsc$k_dtype_t!,2(sp) clrq -(sp) pushal twidth pushl #4! clrl -(sp) clrq -(sp) pushaq rab+rab$l_sts pushal 16(sp) pushaq 36(sp) clrq -(sp) calls #8,@#sys$getdvi addl2 #24,sp blbc r0,6$ clrl -(sp) calls #1,@#sys$waitfr movzwl rab+rab$l_sts,r0 blbc r0,6$ 15$: $connect rab=rab blbc r0,6$ ;;; Get command line pushaw tlen clrl -(sp) pushaq bufdsc calls #3,g^lib$get_foreign blbc r0,18$ ; No CLI? tstw tlen ; Parameter given? bneq 19$ ; Yes, remote users 18$: brw 59$ ; No, local users ;;; Make sure we have something resembling a node name 19$: moval zfab,r4 movb tlen,fab$b_fns(r4) moval znam,r5 $parse fab=r4 blbs r0,27$ bbc #nam$v_node,nam$l_fnb(r5),25$ movl fab$l_stv(r4),r0 beql 25$ cmpw r0,#ss$_nopriv ; Sigh... bneq 24$ movzwl #ss$_nonetmbx,r0 24$: ret 25$: pushl fab$l_fna(r4) movzbl fab$b_fns(r4),-(sp) pushaq (sp) pushl #1 pushl #sts$m_cust_def!shr$_syntax!sts$k_severe pushl #3 $putmsg_s facnam=facnam,msgvec=12(sp) bisl3 4(sp),#sts$m_inhib_msg,r0 26$: ret 27$: cmpl nam$l_fnb(r5),#nam$m_node bneq 25$ ; Whatever it is it's not what we want ;; A possible extension here would be to allow NODE!QUOTED ;; and a = in the filename to allow specification of an ;; alternative task specifier "for debugging purposes." ;;; Establish DECnet connection, set up to query PHONE clrq -(sp) ; If there's no DECnet there's no pushaw tlen ; point continuing pushaq net0 calls #4,@#sys$assign blbc r0,26$ clrl jpi2 ; Get our username and local node name clrq -(sp) clrl -(sp) pushal jpilst clrq -(sp) clrl -(sp) calls #7,@#sys$getjpi blbc r0,26$ clrl -(sp) calls #1,@#sys$waitfr pushab buffer pushl #63 clrq -(sp) clrl -(sp) pushaq 12(sp) pushaw 16(sp) pushaw sys_node calls #6,@#sys$trnlog blbc r0,26$ movzbl nam$b_node(r5),r0 ; Construct remote task specifier movl nam$l_node(r5),r1 pushl r1 movc3 #tslen,taskspec,(r1)[r0] subl3 znam+nam$l_node,r3,-(sp) ;; If the user specified explicit routing, too bad. ;; We don't hack PSTHRU. (Why doesn't DEC support ;; LIB$NET_CONNECT?) (CLIUTL--Go fiche!) clrq -(sp) ; Connect now to free ZES clrq -(sp) pushaq 16(sp) clrl -(sp) clrq -(sp) pushaq ziosb pushl #io$_access movzwl tlen,-(sp) clrl -(sp) calls #12,@#sys$qiow addl2 #8,sp blbc r0,41$ movzwl ziosb,r0 blbc r0,41$ popr s^#^m ; Drop leading underscore from cmpb (r1),#^a/_/ ; SYS$NODE translation bneq 38$ decl r0 incl r1 38$: movab zes,r3 ; Construct LOCAL::USERNAME movb #15,(r3)+ ; PHONE code for next directory line movc3 r0,(r1),(r3) movab username,r2 locc #^a/ /,#12,(r2) subl2 r2,r1 movc3 r1,(r2),(r3) clrb (r3)+ moval znam,r5 subl3 nam$l_esa(r5),r3,r2 movb r2,nam$b_esl(r5) ;;; See who's out there and build a tree clrl r3 ; Number of users we've seen clrq -(sp) ; Request first directory line clrq -(sp) movzbl nam$b_esl(r5),-(sp) pushab zes clrq -(sp) pushaq ziosb pushl #io$_writevblk movzwl tlen,-(sp) clrl -(sp) calls #12,@#sys$qiow blbs r0,42$ 41$: ret 42$: movzwl ziosb,r0 blbc r0,41$ clrq -(sp) ; Gobble reply clrq -(sp) movzwl #256,-(sp) pushab buffer clrq -(sp) pushaq ziosb pushl #io$_readvblk movzwl tlen,-(sp) clrl -(sp) calls #12,@#sys$qiow blbc r0,41$ movzwl ziosb,r0 blbc r0,41$ tstw ziosb+2 beql 54$ ; No more clrq -(sp) ; Request next directory line clrq -(sp) movzbl nam$b_esl(r5),-(sp) pushab zes clrq -(sp) pushaq ziosb pushl #io$_writevblk movzwl tlen,-(sp) clrl -(sp) calls #12,@#sys$qio ; Async! blbc r0,41$ movab buffer+16,r2 ; Pick out username locc #^a/ /,#15,(r2) subl2 r2,r1 movq r1,-(sp) ; Stash it away clrl -(sp) pushal (sp) pushaw newn pushaw ncmp pushal zero ; Don't insert duplicates pushaq 20(sp) pushal tree calls #6,g^lib$insert_tree blbc r0,53$ cmpl r0,#lib$_keyalrins bneq 50$ movl (sp),r1 ; You got yours already! incb 10(r1) ; Bump 50$: addl2 #12,sp incl r3 clrl -(sp) ; Block until net write completes calls #1,@#sys$waitfr brw 42$ 53$: ret 54$: movb #13,zes ; PHONE code to tell slave to go away clrq -(sp) clrq -(sp) movzbl nam$b_esl(r5),-(sp) pushab zes clrq -(sp) pushaq ziosb pushl #io$_writevblk movzwl tlen,-(sp) clrl -(sp) calls #12,@#sys$qiow blbc r0,53$ movzwl ziosb,r0 blbc r0,53$ $dassgn_s chan=tlen blbc r0,53$ brw 80$ ;;; See who's here and build a tree 59$: clrl r3 ; Number of users we'e seen 60$: clrq -(sp) ; Look at a process clrl -(sp) pushal jpilst clrl -(sp) pushal pid clrl -(sp) calls #7,@#sys$getjpi pushl r0 clrl -(sp) calls #1,@#sys$waitfr popr s^#^m blbs r0,70$ cmpw r0,#ss$_nomoreproc ; Seen 'em all beql 80$ cmpw r0,#ss$_nopriv ; #@$%!! beql 60$ cmpw r0,#ss$_noprivstrt ; Heh heh blssu 68$ cmpw r0,#ss$_noprivend blequ 60$ 68$: ret 70$: tstw tlen ; A process is "interesting" beql 60$ ; if it has a terminal movab username,r2 ; Trim username locc #^a/ /,#12,(r2) subl2 r2,r1 movq r1,-(sp) ; Stash it away clrl -(sp) pushal (sp) pushaw newn pushaw ncmp pushal zero ; Don't insert duplicates pushaq 20(sp) pushal tree calls #6,g^lib$insert_tree blbc r0,68$ cmpl r0,#lib$_keyalrins bneq 77$ movl (sp),r1 ; You got yours already! incb 10(r1) ; Bump 77$: addl2 #12,sp incl r3 brw 60$ ;;; Casify each name, hack duplicates, determine column width 80$: moval rab,r2 tstl r3 ; But first, check for degenerate case bneq 83$ movab nousers,rab$l_rbf(r2) movw #nouserslen,rab$w_rsz(r2) brb 92$ 83$: pushaw magic ; Do yer stuff pushal tree calls #2,g^lib$traverse_tree blbc r0,68$ incw max ; One space between columns ;;; Display!!! movab buffer,rab$l_rbf(r2) ; Output header pushl r3 pushaq bufdsc pushaw rab$w_rsz(r2) pushaq usersf calls #4,@#sys$fao $put rab=r2 blbc r0,95$ bbcc #rab$v_cco,rab$l_rop(r2),. ; Display nodes clrw rab$w_rsz(r2) clrw tlen pushaw display pushal tree calls #2,g^lib$traverse_tree blbc r0,95$ 92$: $put rab=r2 blbc r0,95$ $close fab=fab blbs r0,95$ pushl nam+nam$l_rsa movzbl nam+nam$b_rsl,-(sp) assume fab$l_stv eq fab$l_sts+4 movq fab+fab$l_sts,-(sp) pushaq 8(sp) pushl #1 pushl #sts$m_cust_def!shr$_closeout!sts$k_severe pushl #5 $putmsg_s facnam=facnam,msgvec=12(sp) bisl3 4(sp),#sts$m_inhib_msg,r0 95$: ret .even ;;; Format for display .entry magic,^m movl 4(ap),r2 movzbl 11(r2),r0 movab 12(r2),r1 clrb (r1)[r0] ; Make nul-terminated 102$: movzbl (r1)+,r0 ; Mix case beql 110$ 103$: cmpb r0,#^a/A/ blssu 102$ cmpb r0,#^a/Z/ bgtru 102$ cmpb r0,#^a/M/ ; 2nd order bneq 107$ cmpb (r1),#^a/C/ bneq 107$ bisb2 #^o40,(r1)+ brb 102$ 106$: bisb2 #^o40,(r1)+ 107$: cmpb (r1),#^a/A/ blssu 102$ cmpb (r1),#^a/Z/ blequ 106$ brb 102$ 110$: movzbl 10(r2),r1 ; Any duplicates? beql 115$ movzbl 11(r2),r0 ; Append count pushab 12(r2)[r0] pushl #4!! addl3 #1,r1,-(sp) pushaq 4(sp) pushaw 8(sp) pushaq dupf calls #4,@#sys$fao addb2 (sp),11(r2) addl2 #8,sp 115$: cmpb 11(r2),max ; New max? blequ 116$ movzbw 11(r2),max 116$: movzwl #ss$_normal,r0 ret .even ;;; Display another node .entry display,^m moval rab,r2 movl rab$l_rbf(r2),r3 movzwl tlen,r4 ; Column position (NOT record size!) bleq 162$ ; First item on a line movzwl max,r0 ; R5 <- goal column divl3 r0,r4,r5 mull2 r0,r5 addl2 r0,r5 addl2 r5,r0 ; Would another field be too much? cmpw r0,twidth blssu 155$ $put rab=r2 ; Punt what we've got blbc r0,166$ clrl r4 ; And we're at beginning-of-line brb 162$ 155$: movzwl rab$w_rsz(r2),r0 ; R3 <- buffer pointer addl2 r0,r3 bicl3 #7,r4,r0 ; Use tabs if they help 157$: addl2 #8,r0 cmpl r0,r5 bgtru 160$ movl r0,r4 movb #TAB,(r3)+ brb 157$ 160$: cmpl r4,r5 ; Make up the difference with spaces bgequ 162$ 161$: movb #^a/ /,(r3)+ aoblss r5,r4,161$ 162$: movl 4(ap),r1 ; Shove text on end of line movzbl 11(r1),r0 addw3 r0,r4,tlen movc3 r0,12(r1),(r3) subl2 rab+rab$l_rbf,r3 movw r3,rab+rab$w_rsz movzwl #1,r0 166$: ret ;; Each node in the tree has the form ;; +-------------------------------+ ;; | | 0 ;; +- -+ ;; | overhead | 4 ;; +-------+-------+- -+ ;; | count | dups | | 8 ;; +-------+-------+---------------+ ;; <-- username | 12 ;; -+ .even ;;; Compare given string with existing node .entry ncmp,^m movq @4(ap),r2 movzwl r2,r2 movl 8(ap),r1 movzbl 11(r1),r0 cmpc5 r2,(r3),#^a/ /,r0,12(r1) beql 205$ ; There ought to be a better way blssu 207$ movl #1,r0 ret 205$: clrl r0 ret 207$: mnegl #1,r0 ret .even ;;; Make a new node .entry newn,^m movq @4(ap),r2 movzwl r2,r2 addl3 #16,r2,-(sp) ; An extra four bytes for $FAO pushl 8(ap) pushal 4(sp) calls #2,g^lib$get_vm blbc r0,220$ movl @8(ap),r1 clrq (r1) ; Make it clean clrl 8(r1) movb r2,11(r1) ; Stuff ASCIC string movc3 r2,(r3),12(r1) movzwl #1,r0 220$: ret .psect constants,nowrt,noexe,shr,pic,long nousers:: .ascii /No users./ nouserslen=.-nousers .align long taskspec:: .ascii /"PHONE="/ tslen=.-taskspec .psect data,wrt,noexe,noshr,nopic,page buffer:: .blkb 256 bufdsc:: .word 256 .byte dsc$k_dtype_t,dsc$k_class_s .address buffer jpilst:: .word 12,jpi$_username .address username .long 0 jpi2:: .word 8,jpi$_terminal .address terminal .address tlen zero:: .long 0 pid:: .long -1 tree:: .blkl 1 username:: .blkb 12 terminal:: .blkb 8 tlen:: .blkw 1 max:: .blkw 1 .align long twidth:: .long 80 .align quad facnam:: .ascid /USERS/ .align quad usersf:: .ascid /!UL user!%S:/ .align quad dupf:: .ascid /*!UB/ .align quad net0:: .ascid /_NET0:/ .align quad sys_node:: .ascid /SYS$NODE/ .psect fab,wrt,noexe,noshr,nopic,quad fab:: $fab fop=,fac=,rat=,rfm=var,- xab=xabpro,nam=nam,fnm=,dnm= .psect nam,wrt,noexe,noshr,nopic,quad nam:: $nam rss=nam$c_maxrss,rsa=rs rs:: .blkb nam$c_maxrss .psect rab,wrt,noexe,noshr,nopic,quad rab:: $rab rop=,fab=fab .psect xabpro,wrt,noexe,noshr,nopic,quad xabpro:: $xabpro .psect zfab,wrt,noexe,noshr,nopic,quad zfab:: $fab nam=znam,fna=buffer ziosb=zfab+fab$l_sts .psect znam,wrt,noexe,noshr,nopic,quad znam:: $nam esa=zes,ess=nam$c_maxrss .=znam+nam$b_nop ; nop= .byte nam$m_pwd!nam$m_rod ; Inhibit "security" "features" .=znam+nam$c_bln zes:: .blkb nam$c_maxrss .end users ; Y'can't live with[out] 'm