.TITLE WHO .IDENT "010000" .LIST TTM .enabl LC .nlist ME,CND,BEX ;+ ; Abstract: ; This program is a complete re-write of the DEC program of ; the same name. This program has been written to know ; about DECNET V2.1 and will allow a user to find out who ; is logged in on another node of the network. Also, a ; "HELP" facility has been added for a brief description of ; this utility. ; ; Non-standard Features: ; This program assumes that word U.C3 of the PUD contains ; the UPF record number of the user. This is a "feature" that was ; added by us at DUKE University Medical Center. This program ; was designed for use on an IAS V3.0 Multi-User system. It ; could probably be munged into a timesharing version with ; little difficulty. ; This program also acts as the receiver task on the ; other side of the network. This is since we didn't see the ; need for a seperate receiver task on each end of the network. ; All that a receiver task does is to use up nodes and its ; another program to maintain. ; ; Written: 03-Mar-80, -1.0.0-, Henry R. Tumblin ; ; Modified: ; ; Verified: 10-Mar-80, -1.0.0-, Henry R. Tumblin ; ;- .SBTTL Mcalls and such .MCALL QIOW$,EXIT$S,DIR$,GMCR$,ALUN$S .MCALL FCSMC$,OPNS$R,GET$R,NETMC$ .MCALL ISTAT$,STATE$,TRAN$ FCSMC$ ; Mcall FCS macros NETMC$ ; MCALL Decnet Macros NSSYM$ ; Define DECNET symbols CNBDF$ ; Define connect block offsets CRBDF$ ; TTYLUN = 1 ; LUN for Terminal output TTYEVF = 1 ; TERMINAL EVENT FLAG UPFLUN = 2 ; LUN for User Profile File .MBXLU == 3 ; LUN for network open MBXEVF == 3 ; Event flag for network open .NETLU == 4 ; LUN for network S/R NETEVF == 4 ; Event flag for network S/R .MACRO PRINT BUFR,SIZ,CCW .IF B CCW CLR -(SP) ; SAY NO CCW .IFF MOV CCW,-(SP) ; PUSH CCW .ENDC MOV SIZ,-(SP) ; PUSH SIZ MOV BUFR,-(SP) ; AND BUFR POINTER CALL $OUT ; AND OUTPUT THE STRING .ENDM PRINT .MACRO ERMSG,LABEL,TEXT LABEL: .BYTE 15,12 .ASCII "WHO -- " .ASCII "TEXT" LABEL'S=.-LABEL .ENDM ERMSG ; Local Flags Definitions FL.NOD = 1 ; Node name was specified FL.NET = 2 ; INDICATE NETWORK SUPPORT AVAILABLE FL.HLP = 4 ; Indicate help required FL.REC = 10 ; Indicate we're to receive over network FL.SND = 20 ; Indicate we're to send over network .SBTTL Start Mainline Code START: CALL INITL ; Initialize CALL GETCML ; Get command line ; Print Header message (if necessary) 10$: BIT #FL.SND,FLAGS ; Are we the senders? BNE LOOP1 ; Else go into main process loop MOV #OBUF,R0 ; Point to output buffer MOV #HEADR1,R1 ; Point to header CLR -(SP) ; Init parameter list MOV SP,R2 ; BIT #FL.NET,FLAGS ; Is network available ? BEQ 15$ ; EQ - no MOV #HEADR,R1 ; Include node name in display BIT #FL.NOD,FLAGS ; Was a node name specified ? BEQ 12$ ; EQ - then use home network node MOV #CONB+N.RND,(SP) ; Else say we're displaying destination node BR 15$ ; And display 12$: MOV #NODNAM,(SP) ; Set up parameter list 15$: CALL $EDMSG ; Format header message TST (SP)+ ; Clear stack PRINT #OBUF,R1 ; Output header message ; Now Start listing the info to the screen LOOP1: BIT #FL.REC,FLAGS ; Are we receiving from accross network ? BEQ 20$ ; EQ - then do normally CALL GETNET ; Else get info across network BCS 40$ ; CC - then go display BR 30$ ; Go output message 20$: CALL GETPUD ; Get info from PUD BCS 40$ ; CS - then we're all thru 30$: MOV #BUF,R5 ; Point to info buffer BIT #FL.SND,FLAGS ; Are we sending across the network ? BEQ 32$ ; EQ - then CALL PUTNET ; Else dispatch accross network BCS 40$ ; CS - then leave BR LOOP1 ; And loop till thru 32$: CALL OUTMSG ; Format and output the info BR LOOP1 ; Loop till thru 40$: EXIT: CALL FINISH ; CLOSE THE NETWORK EXIT$S ; Exit gracefully (Always) .SBTTL OUTMSG -- Format and output user info ;+ ; This module will format and output the user information ; block. ; Inputs: ; R5 - Pointer to block to use ; ; Outputs: ; all registers preserved ;- OUTMSG: CALL $SAVAL ; Save my registers MOV #OBUF,R0 ; Point to output buffer MOV #LIN,R1 ; Point to format string MOV R5,-(SP) ; Point to ADD #10,(SP) ; programmer code MOV R5,-(SP) ; Point to ADD #11,(SP) ; group code BITB #UT.PR,24(R5) ; Are they priviledged ? BEQ 10$ ; EQ - no MOV #PRVMSG,-(SP) ; Point to message MOV #PRVSIZ,-(SP) ; Set message size BR 20$ ; And continue 10$: MOV #NPRV,-(SP) ; Else make them non-priv MOV #NPRVSZ,-(SP) ; Set string length 20$: MOV R5,-(SP) ; Point to current ADD #12,(SP) ; programmer code MOV R5,-(SP) ; Point to current ADD #13,(SP) ; group code MOV 22(R5),-(SP) ; Get device # MOV R5,-(SP) ; Point to ADD #20,(SP) ; device name MOV 6(R5),-(SP) ; Get user name MOV 4(R5),-(SP) ; ... MOV 2(R5),-(SP) ; ... MOV (R5),-(SP) ; ... MOV SP,R2 ; Point to parameter list CALL $EDMSG ; Format the message ADD #12.*2,SP ; Clean up the stack PRINT #OBUF,R1 ; Output the string RETURN ; Return to caller .SBTTL GETPUD - Get info from PUD ;+ ; This module sets up the information buffer in ; a format similar to that returned accross the network ; ; The format of the buffer is: ; ; ----------------------------------------- ; ! User name in Rad-50 ! Word 1 ; ! ! Word 2 ; ! ! Word 3 ; ! ! Word 4 ; !---------------------------------------! ; ! Login UIC ! Word 5 ; !---------------------------------------! ; ! Current UIC (from PUD) ! Word 6 ; !---------------------------------------! ; ! Node Name in RAD-50 ! Word 7 ; ! ! Word 8 ; !---------------------------------------! ; ! Device name ! Word 9 ; !---------------------------------------! ; ! Unit Number ! Word 10 ; !---------------------------------------! ; ! Terminal Flags Byte ! unused ! Word 11 ; ----------------------------------------- ;- GETPUD: MOV PUDBAS,R4 ; Get pointer to next PUD to process BNE 10$ ; NE - then it's there MOV .PUDBA,R4 ; Else start at the beginning 10$: BIT #UC.TTY,U.C1(R4); IS THIS A TTY BNE 20$ ; BR IF NO CMP U.DN(R4),#"BA ; Batch terminal ? BEQ 20$ ; EQ - then list it also CMP U.DN(R4),#"VT ; Virtual terminal ? BNE 70$ ; NE - skip it 20$: BIT #UT.LG,U.PR(R4) ; IS IT LOGGED ON?? BEQ 70$ ; NO IT ISN'T MOV U.C3(R4),R1 ; Get UPF record number of user ; Insert the user name and LOGIN UIC MOV #BUF,R2 ; Point to area to receive user name CALL GETNAM ; Get user name from UPF ; Insert the current UIC MOV U.UI(R4),BUF+12 ; Get current UIC from PUD ; Insert the NODE NAME (If it exists) MOV #1,R1 ; Set up conversion terminator MOV #NODNAM,R0 ; Get the node name CALL $CAT5 ; Convert to RAD-50 MOV R1,BUF+14 ; Insert first half of node name MOV #1,R1 ; Set up conversion terminator CALL $CAT5 ; Convert 2nd half of node name MOV R1,BUF+16 ; Insert latter half ; Insert the device name, unit #, and flags byte MOV U.DN(R4),BUF+20 ; Insert device name CLR R0 ; Clear trash MOVB U.UN(R4),R0 ; Get unit # MOV R0,BUF+22 ; And place into buffer MOVB U.TF(R4),BUF+24 ; Insert terminal flags byte ADD #U.SZ,R4 ; Point to next PUD entry CMP .PUDEA,R4 ; At end yet ? BEQ 75$ ; EQ - then quit MOV R4,PUDBAS ; Save for next call RETURN ; Return to caller 70$: ADD #U.SZ,R4 ; Point to next device CMP .PUDEA,R4 ; Are we at end of PUD ? BNE 10$ ; NE - then loop back for more 75$: SEC ; Else indicate the end has been reached 90$: RETURN ; Return to caller .SBTTL GETNAM -- Return user name from UPF file ;+ ; This module will read the users UPF record to ; find their user name. The UPF file will be ; opened shared read during the entire running of ; this program. ; ; Inputs: ; R1 - The UPF record to fetch ; R2 - The destination area of the user name. ;- GETNAM: CALL $SAVAL ; Save our registers GET$R #UPFFIL,#OBUF,#64.,R1 ; Get upf record BCS 80$ ; CS - then get failed MOV F.NRBD+2(R0),R3 ; Get pointer to record MOV #4,R4 ; Get length 4 words 10$: MOV (R3)+,(R2)+ ; Move into destination SOB R4,10$ ; Loop till thru MOV (R3)+,(R2)+ ; Move the Logon UIC there also CLC ; Indicate success BR 90$ ; And leave 80$: MOV #4,R4 ; Set count 82$: CLR (R2)+ ; Blank fill SOB R4,82$ ; Loop till thru CLR (R2)+ ; Reset UIC 90$: RETURN ; Return to caller .SBTTL GETNET -- Receive data from network GETNET: DIR$ #REC ; Receive data from the network CMPB STATUS,#IS.SUC ; Did we receive something ? BEQ 10$ ; EQ - return success SEC ; Else indicate we're thru 10$: RETURN ; Return to caller .SBTTL PUTNET -- Send data accross network PUTNET: DIR$ #SND ; Output over network CMPB STATUS,#IS.SUC ; Did the send complete ? BEQ 10$ ; EQ - then return success SEC ; Else error 10$: RETURN ; Else return to caller .SBTTL $OUT -- Output data to TI0: ; This module will output a string to the ; current output device (TI0:). ; ; Inputs: ; (SP) - Return address ; 2(SP) - Buffer pointer ; 4(SP) - Length to output ; 6(SP) - Format type ; ; Outputs: ; The 3 arguments are cleared off the stack. ; $OUT: MOV 4(SP),QIO+Q.IOPL+2 ; Set length BEQ 10$ ; EQ - then nothing to output MOV 2(SP),QIO+Q.IOPL ; Set buffer pointer MOV 6(SP),QIO+Q.IOPL+4 ; Set CCW DIR$ #QIO ; Output the string 10$: MOV (SP),6(SP) ; Reset return address ADD #6,SP ; Clear stack RETURN ; Return to caller .SBTTL SETPRV -- Set our UIC to [1,1] ; This dirty little routine maps itself into our ; header and changes our UIC to [1,1] so that ; we can access the UPF file. How grotesque! SETPRV: CALL $SAVAL ; Save our registers MOV .CRTSK,R0 ; Get our ATL node MOV #77606,-(SP) ; Set up for full access MOV A.HA(R0),-(SP) ; Point to header CALL ..SPD3 ; Map to our header MOV #<1*400>+1,60000+H.UIC ; Change UIC MOV #<1*400>+1,60000+H.DUI ; to [1,1] CALL ..SPD3 ; Map back to ourselves CMP (SP)+,(SP)+ ; Pop old PAR,PDR pair RETURN ; Return to caller .SBTTL INITL - Initialize program INITL: CALL SETPRV ; Make ourselves priv. FINIT$ ; Initialize FCS ; Open the UPF file OPNS$R #UPFFIL ; Open UPF file BCC 5$ ; CC - then open was successfull PRINT #ER02,#ER02S ; Else output error message JMP EXIT ; and leave 5$: ALUN$S #.MBXLU,#"NS,#0 ; Assign network luns BCS 10$ ; CS - then network not generated ALUN$S #.NETLU,#"NS,#0 ; ... DIR$ #OPN ; Open the network CMPB STATUS,#IS.SUC ; DID IT SUCCEED ? BEQ 20$ ; YES, BRANCH BIC #FL.NET,FLAGS ; CLEAR THE NETWORK FLAG 10$: RETURN ; AND LEAVE 20$: DIR$ #GLN ; Get network info MOV GLNBUF,NODNAM ; Save the node we're on MOV GLNBUF+2,NODNAM+2 ; ... MOV GLNBUF+4,NODNAM+4 ; ... BIS #FL.NET,FLAGS ; Indicate the network is up RETURN ; Return to caller .SBTTL GETCML -- Get command line for WHO GETCML: DIR$ #GETMCR ; Fetch MCR command line BCC 10$ ; CC - Then parse command line BIT #FL.NET,FLAGS ; Is network active ? BNE 5$ ; NE - then connect to caller PRINT #ER01,#ER01S ; Else say network not active 2$: BIC #FL.NOD,FLAGS ; Reset flags RETURN ; Connect to requestor across the network 5$: DIR$ #GND ; Get connect request CMP STATUS,#+IS.SUC ; Is the request valid ? BEQ 6$ ; Connect request is invalid, so reject the connection DIR$ #REJ ; Reject request BR 2$ ; Now accept the connect request from the network 6$: DIR$ #ACC ; Accept connect request CMPB STATUS,#IS.SUC ; Was connect successfull ? BEQ 20$ ; EQ - yes PRINT #ER05,#ER05S ; Else accept connect failure BR 2$ ; And leave 20$: BIS #FL.SND,FLAGS ; Indicate we're to send over the network BR 90$ ; And leave ; Get and parse the input command 10$: MOV #<2*400>+0,R1 ; Set options word MOV #KTB,R2 ; Point to keyword table MOV @#$DSW,R3 ; Set string length MOV #GETMCR+2,R4 ; Point to command line MOV #BEGWHO,R5 ; Point to starting state CALL .TPARS ; Parse the command line BCC 40$ ; CC - then success PRINT #ER06,#ER06S ; Else syntax error PRINT R4,R3,#40 ; Print segment causing error JMP EXIT ; And leave 40$: BIT #FL.HLP,FLAGS ; Did they want help ? BEQ 50$ ; EQ - then leave PRINT #HLP,#HLPSZ ; Print help message JMP EXIT ; And leave for now ; Check for identical node names 50$: BIT #FL.NOD,FLAGS ; Was a node name specified BEQ 90$ ; EQ - no, use home node CMP CONB+N.RND,NODNAM ; Are the names the same ? BNE 60$ ; NE - then it's a different node CMP CONB+N.RND+2,NODNAM+2 ; BNE 60$ ; CMP CONB+N.RND+4,NODNAM+4 ; BNE 60$ ; BIC #FL.NOD,FLAGS ; Say no node is good node BR 90$ ; And leave 60$: DIR$ #CON ; Else connect to node accross network CMPB STATUS,#IS.SUC ; Did we succeed ? BEQ 70$ ; EQ - then return PRINT #ER08,#ER08S ; Network rejected connect BIC #FL.NOD,FLAGS ; Indicate error BR 90$ 70$: BIS #FL.REC,FLAGS ; Indicate we're receiving over network 90$: RETURN ; Return to caller .SBTTL FINISH -- CLOSE THE NETWORK ; ; THIS ROUTINE CLOSES THE LOCAL NETWORK ; FINISH: CLOSE$ #UPFFIL ; Close UPF file BIT #FL.NET,FLAGS ; Network active ? BEQ 10$ ; EQ - not today DIR$ #CLS ; Close the network CMPB STATUS,#IS.SUC ;DID IT SUCCEED? BEQ 10$ ;YES, BRANCH PRINT #ER03,#ER03S ;NO, ERROR 10$: RETURN ;RETURN TO CALLER .SBTTL UPF FDB FSRSZ$ 1 ; 1 fsr buffer required UPFFIL: FDBDF$ ; Allocate a FDB FDRC$A FD.PLC!FD.RAN,,64. ; Random access mode FDOP$A UPFLUN,DSPT ; File OPEN DSPT: .WORD DEVS,DEV ; Device .WORD UICS,UIC ; UIC .WORD FNMS,FNM ; File name ; Input file is - LB0:[1,100]PDSUPF.DAT DEV: .ASCII "LB0:" DEVS=.-DEV UIC: .ASCII "[1,100]" UICS=.-UIC FNM: .ASCII "PDSUPF.DAT" FNMS=.-FNM .EVEN .SBTTL Network Access Blocks OPN: OPNW$ .MBXLU,MBXEVF,STATUS,,<1> ;OPEN THE NETWORK GLN: GLNW$ .MBXLU,MBXEVF,,, ;GET NETWORK LUN INFO GND: GNDW$ .MBXLU,MBXEVF,STATUS,, ; Get connect rqst REJ: REJW$ .MBXLU,MBXEVF,STATUS,, ; Reject connection ACC: ACCW$ .NETLU,NETEVF,STATUS,, ; Accept connect CLS: CLSW$ .MBXLU,MBXEVF,STATUS ;CLOSE THE NETWORK CONB: CONB$$ DUMMY,NO.TAS,1,<...WHO> ; Dummy connect block CON: CONW$ .NETLU,NETEVF,STATUS,, ; Connect to ...WHO DSC: DSCW$ .NETLU,NETEVF,STATUS ; Disconnect from ...WHO SND: SNDW$ .NETLU,NETEVF,STATUS,, ; Send data accross net REC: RECW$ .NETLU,NETEVF,STATUS,, ; Receive data accross net .sbttl TPARS expressions ISTAT$ STB,KTB STATE$ BEGWHO TRAN$ "WHO" STATE$ TRAN$ !SWTCHS,GNOD ; Process switches TRAN$ $LAMDA STATE$ GNOD ; Get node name TRAN$ $EOS,$EXIT TRAN$ $STRNG,,SAVNOD,FL.NOD,FLAGS ; Save node name STATE$ TRAN$ $EOS,$EXIT TRAN$ '_,$EXIT STATE$ STATE$ SWTCHS TRAN$ '/ STATE$ TRAN$ $EOS,$EXIT,INVSW TRAN$ "HELP",$EXIT,,FL.HLP,FLAGS ; Say they want help TRAN$ $LAMDA,$EXIT,INVSW ; Process invalid switch STATE$ SAVNOD: CALL $SAVAL ; Save our registers MOV #CONB+N.RND,R0 ; Point to node name MOV #3,R1 ; Set length word 5$: MOV #<40*400>+40,(R0)+ ; Set to blanks SOB R1,5$ ; Loop till thru MOV .PSTPT,R0 ; Point to string MOV .PSTCN,R1 ; Get length CMP R1,#6 ; Was node name too long ? BLOS 7$ ; LOS - No MOV #6,R1 ; Truncate the string PRINT #ER09,#ER09S ; Say we've truncated the string 7$: MOV #CONB+N.RND,R2 ; Get destination address 10$: MOVB (R0)+,(R2)+ ; Move into position SOB R1,10$ ; Loop till thru RETURN ; Return to caller INVSW: PRINT #ER07,#ER07S,#40 ; Invalid switch PRINT R4,R3,#40 ; Display remainder of string JMP EXIT ; And leave .SBTTL Help Message HLP: .BYTE 15,12,11,11 .ASCII "WHO -- Display users logged in" .BYTE 15,12,11 .ASCII "This program will display the users on the" .BYTE 15,12,11 .ASCII "system specified. The syntax of the command is :" .BYTE 15,12,12,11,11 .ASCII "WHO [/HElp] [node_name]" .BYTE 15,12,12,11 .ASCII "If the node name is not specified, then WHO will be " .BYTE 15,12,11 .ASCII "run on the system it was invoked from." .BYTE 15,12,11 .ASCII "/HElp will display this help text" .BYTE 15,12,12 HLPSZ=.-HLP .EVEN .sbttl DPB's and other buffers GETMCR: GMCR$ ; Get MCR command line QIO: QIOW$ IO.WVB,TTYLUN,TTYEVF,,IOSB,,<0,0,0> PUDBAS: .WORD 0 ; PUD pointer STATUS: .BLKW 2 ; STATUS FOR NETWORK DIRECTIVES MBOX: .BLKB 100. ; Mailbox to use MBOXSZ=.-MBOX GLNBUF: .BLKW 4 ; NETWORK LUN INFO BUFFER GLNLEN = .-GLNBUF ; LENGTH OF BUFFER BUF: .BLKW 12. ; User Info Buffer BUFS = .-BUF ; Buffer size OBUF: .BLKB 132. ; Output buffer IOSB: .BLKW 2 ; Q-I/O Status block FLAGS: .WORD 0 ; Internal flags NODNAM: .BLKB 6 ; Node name PRVMSG: .ASCII /PRIV / PRVSIZ=.-PRVMSG NPRV: .ASCII /NONPRV/ NPRVSZ=.-NPRV SLVMSG: .ASCII /SLAV/ SLVSIZ=.-SLVMSG .EVEN HEADR: .ASCII "%2NNode name = %6A" HEADR1: .ASCIZ "%2NUser%14STerminal%6SUIC%6SStatus%4SLogin UIC%N" LIN: .ASCII "%12<%4R%12>%8S%5<%2A%O:%5>%4S[%B,%B]%3S%6<%VA%6>%4S" .ASCIZ "[%B,%B]%N" .SBTTL ERROR MESSAGES ERMSG ER01, ERMSG ER02, ERMSG ER03, ERMSG ER05, ERMSG ER06, ERMSG ER07, ERMSG ER08, ERMSG ER09, .END START