TITLE 'Big Brother is watching you' *++ * * -*-ASMH-*- * * Big Brother, by John Wilson. * * Program to read the Big Brother database * maintained by ACM:WHO. * * This program was Gordon Greene's idea. * He wrote his own snapshot program, but I didn't know * that when I wrote mine. The name was his idea too. * * Please send misfeature reports to "WHO Maintenance". * * Mar 22/88 JMBW: Created. * Apr 01/89 JMBW: Added FINGER/WHOIS commands. * Apr 23/89 JMBW: Added Attn handling. * Oct 09/91 JMBW: Added lazy DN resolver (let NETSERV1 do it). * Feb 25/92 JMBW: Do single command and exit if PAR= defined. * Aug 17/92 JMBW: HOST command, cleaned up $REL *BB*. * Sep 28/92 JMBW: HOST now checks MX records. * Jan 02/93 JMBW: LIST command. * *-- GBLA &FNDS(4) ;friendly neighborhood dom. server &FNDS(1) SETA 128,113,1,5 ;NETSERV1.ITS.RPI.EDU (128.113.1.5) *FNDS(1) SETA 128,113,5,81 ;AIX01.ECS.RPI.EDU * GBLC &MTS ;hostname of this MTS &MTS SETC 'MTS.RPI.EDU' ;for SMTP "HELO" cmd * GBLC &BBUSERS,&BBNAMES,&BBHELP,&WNID,&TTYLOC GBLC &HOSTS,&HOST#S &BBUSERS SETC 'ACM0:BB.USERS' ;userID's data file &BBNAMES SETC 'ACM0:BB.NAMES' ;nameID's data file &BBHELP SETC 'ACM0:BB.HELP' ;file displayed on HELP &WNID SETC 'ACM0' ;loc of default WHO.NAMES &TTYLOC SETC 'GZ7V:TERMINALS' ;term loc database &HOSTS SETC 'ACM0:HOSTS' ;host names lookup file &HOST#S SETC 'ACM0:HOSTNUMS' ;host numbers lookup file * TTLDR EQU 17 ;length of leader in &TTYLOC * * PUNCH ' RIP MMDVLSTL' ;it's just not good enough * MACRO &LAB JSYS &DEST,&ARGS,&ERR ;Jump to SYStem &LAB L 15,=V(&DEST) AIF ('&ARGS' EQ '').NOARGS LA 1,&ARGS .NOARGS BASR 14,15 AIF ('&ERR' EQ '').NOERR LTR 15,15 BNZ &ERR .NOERR MEND * Entry in command table. * &STR contains exactly one '-' to indicate minimum abbreviation * &ADDR is branch address MACRO &LAB CMD &STR,&ADDR LCLA &LEN,&I LCLC &S &LEN SETA K'&STR &I SETA 2 .A AIF (&I GE &LEN).X AIF ('&STR'(&I,1) EQ '-').B &I SETA &I+1 AGO .A .B ANOP &LAB DC AL1(&LEN-4,&I-3) &S SETC '&STR'(2,&I-2).'&STR'(&I+1,&LEN-&I-1) DC C'&S' B &ADDR MEXIT .X MNOTE 4,' missing "-" in string' MEND * MACRO &LAB SPSTR &STR,&LUN ;SPRINT-style list &LAB DC A(C&LAB,L&LAB,ZERO,DUMMY) AIF ('&LUN' EQ '').NOLUN DC A(&LUN) .NOLUN ANOP C&LAB DC C&STR L&LAB DC Y(L'C&LAB) MEND * MACRO &LAB CTRL &STR ;$CONTROL string &LAB DC A(C&LAB,L&LAB,NAMFD,CTAREA) C&LAB DC C&STR L&LAB DC Y(L'C&LAB) MEND * * Entry point. * BB CSECT ENTER (11,12),SA=REGS L 2,0(1) ;get PAR= string LM 0,1,=A(ATTN,ATNREG) ;ATTNTRP args JSYS ATTNTRP ;trap Attn's LH 3,0(2) ;get length LA 2,2(2) ;skip it STM 2,3,PARSTR ;save LTR 3,3 ;get anything? BNZ OPWN ;yes, don't show banner JSYS SPRINT,BAN1 ;say hello JSYS SPRINT,BAN2 JSYS SPRINT,BLANK * * Open WHO.NAMES * OPWN LA 9,3 ;3 strikes and we're out OPWN1 LA 0,1 ;unit 1 JSYS GDINFO3 ;implicit open LTR 15,15 ;successful? BNZ OPWN2 ;no CLC 4(4,1),=C'NONE' ;not there? BNE OPWN5 ;yes it is, skip OPWN2 BCTR 9,0 ;update try # LTR 9,9 ;time to give up? BZ OPWN4 ;yes, no names CH 9,=H'2' ;was that the 1st try? BE OPWN3 ;yes, skip MVC SETLST+4(4),=A(MYNAMES) ;use my names file OPWN3 JSYS SETLIO,SETLST ;reassign unit 1 B OPWN1 ;try again OPWN4 MVC SETLST+4(4),=A(DUMDEV) ;use *DUMMY* JSYS SETLIO,SETLST ;assign unit 1 (can't fail) JSYS SERCOM,NOWHO ;warn them OPWN5 LTR 3,3 ;PAR= string defined? BNZ LOOP2 ;jump into loop if so *+ * * Main loop. * * Get next command. * *- LOOP CLI BBMNTD,0 ;*BB* mounted? BZ LOOP0 ;no L 0,NAMFD ;release *BB* JSYS FREEFD JSYS RELEASE,RELBB ;$REL *BB* MVI BBMNTD,0 ;not mounted now LOOP0 CLI PARSTR+7,0 ;entered with PAR=? BNZ EXITA ;quit now if so JSYS SETPFX,INPFX ;set prefix for input LOOP1 JSYS SCARDS,SCLIST ;get input line LTR 15,15 ;EOF? BNZ EXITA ;yes, take off LH 3,LEN ;get length LA 2,KBBUF ;pt at KB buf LOOP2 BAS 4,SKIP ;skip blanks LTR 3,3 ;anything left? BZ LOOP1 ;ignore line if not JSYS SETPFX,OUTPFX ;reset for output CLI 0(2),C'$' ;MTS command? BE MCMD ;yes * eat a keyword, see what it is LR 1,2 ;copy ptr KW1 CLI 0(2),C' ' ;end of keyword? BE KW2 ;yes, skip LA 2,1(,2) ;otherwise advance BCT 3,KW1 ;loop KW2 LR 4,2 ;copy ptr SR 4,1 ;find length BCTR 4,0 ;correct for MVC L 5,=V(CASECONV) ;pt at low core table EX 4,KWUC ;convert to u.c. LA 5,KWTAB ;pt at table XR 6,6 ;load 0's XR 7,7 ;again KW3 CLI 0(5),X'FF' ;end of table? BE KW6 ;yes IC 6,0(5) ;no, get length CR 4,6 ;is our string too long? BH KW4 ;yes, skip this one IC 7,1(5) ;get min length CR 4,7 ;too short? BL KW4 ;yes, skip EX 4,KWCLC ;compare BE KW7 ;got it, skip KW4 LA 5,2+1+4+1(5,6) ;skip lens, str, align, B addr N 5,=F'-2' ;back to halfword boundary B KW3 ;loop KW6 JSYS SERCOM,BADKW ;gack B LOOP ;around for more KW7 LA 5,2+1+1(5,6) ;skip to B instruction N 5,=F'-2' ;back to hw boundary BR 5 ;dispatch KWUC TR 0(0,1),0(5) ;translate to u.c. KWCLC CLC 0(0,1),2(5) ;compare strings * MCMD JSYS CMDNOE,CMDLST ;do the cmd B LOOP ;get next * USING RECORD,8 ;record pointer *+ * * Search by user ID. * *- LOOKID BAS 6,PARSID ;get ID BNZ LKID1 ;got one L 1,=V(LASTJOB) ;get ptr L 1,0(,1) ;point at task tab entry USING TASKTAB,1 MVC NMCCID(4),TUSER ;get our ID DROP 1 LKID1 JSYS GETFD,NMFILE ;get names file ST 0,BBFD ;save FDUB ptr JSYS READ,RLIST ;get what we have LR 2,15 ;copy RC L 0,BBFD ;get handle JSYS FREEFD ;release the file LTR 2,2 ;did we get anything? BNZ NOSEE ;no, get another cmd JSYS GETFD,=C'&TTYLOC ' ;open loc file ST 0,TTYFDP ;save LA 8,FBUF ;point at record LH 7,LEN ;get length of record LKID2 BAS 4,FORMAT ;display this entry LKID3 JSYS READ,FNDLST ;read WHO.NAMES LTR 15,15 ;eof? BNZ LKID4 ;skip if so CLC WNBUF(4),RECID ;is this us? BNE LKID3 ;loop if not LH 5,LEN ;get length SH 5,=H'2' ;correct STH 5,LEN ;replace MVC WNBUF+2(3),=C' ' ;car ctrl, 2 blanks JSYS SPRINT,PNAME ;print the name LKID4 JSYS REWIND,=A(WNUNIT) ;rewind WHO.NAMES LA 8,RECLEN(,8) ;skip to next record entry SH 7,=Y(RECLEN) ;anything left? BNZ LKID2 ;loop if so L 0,TTYFDP ;get handle JSYS FREEFD ;release TTY loc file B LOOP ;get loopy *+ * * Search by name ID. * *- LKNMID BAS 6,PARSID ;get ID BNZ LKNI1 ;got one * use default (current) name DEFNAM L 1,=V(LASTJOB) ;get ptr L 1,0(,1) ;pnt at task tab entry USING TASKTAB,1 MVC NMCCID(4),TNAME ;get our nameID DROP 1 LKNI1 JSYS READ,FNDLST ;read WHO.NAMES LTR 15,15 ;eof? BNZ LKNI2 ;yes, no problem CLC WNBUF(4),NMCCID ;is this it? BNE LKNI1 ;loop if not * print nameID and name LKPNAM LH 1,LEN ;get length LA 1,1(,1) ;add carr ctrl STH 1,LEN ;update JSYS SPRINT,CFNAME ;confirm name JSYS SPRINT,BLANK ;blank line LKNI2 JSYS REWIND,=A(WNUNIT) ;rewind WHO.NAMES JSYS GETFD,IDFILE ;get ID's file ST 0,BBFD ;save FDUB ptr JSYS READ,RLIST ;get what info we have LR 2,15 ;copy RC L 0,BBFD ;get handle JSYS FREEFD ;release the file LTR 2,2 ;anything? BNZ NOSEE ;nope, gack JSYS GETFD,=C'&TTYLOC ' ;open loc file ST 0,TTYFDP ;save LA 8,FBUF ;pnt at rec LH 7,LEN ;get length of record LKNI3 BAS 4,FORMAT ;dump a record LA 8,RECLEN(,8) ;advance to next SH 7,=Y(RECLEN) ;anything left? BNZ LKNI3 ;loop if so L 0,BBFD ;get handle JSYS FREEFD ;free ID's file L 0,TTYFDP ;get handle JSYS FREEFD ;release TTY loc file B LOOP ;get next cmd *+ * * Search by name. * *- DISPLY BAS 4,SKIP ;skip to name LTR 4,3 ;anything? BZ DEFNAM ;default if not BCTR 4,0 ;-1 L 1,=V(CASECONV) ;pt at low core table EX 4,DISUC ;convert to upper IC 1,0(2) ;get 1st char CLM 1,1,=C'''' ;apostrophe? BE DIS1 ;yes CLM 1,1,=C'"' ;quotation mark? BE DIS1 ;yes IC 1,=C' ' ;no, look for a blank B DIS2 ;skip DIS1 LA 2,1(,2) ;advance BCTR 3,0 ;count it LTR 3,3 ;is that it? BZ DEFNAM ;gack if so DIS2 LR 6,2 ;copy start DIS3 CLM 1,1,0(2) ;are we there yet? BE DIS5 ;yes, skip CLI 0(2),C'_' ;no, check for backarrow BNE DIS4 ;nope MVI 0(2),C' ' ;replace with blank DIS4 LA 2,1(,2) ;skip the char BCT 3,DIS3 ;get loopy DIS5 LR 7,2 ;copy SR 7,6 ;find length BCTR 7,0 ;-1 for CLC below CLM 1,1,=C' ' ;quotes? BE DIS6 ;no LTR 3,3 ;did we fall off end? BZ DIS6 ;yes LA 2,1(,2) ;no, eat the closing quote or apost BCTR 3,0 ;count it DIS6 BAS 5,CONFRM ;check it out XR 10,10 ;no matches yet JSYS GETFD,IDFILE ;get ID's file ST 0,BBFD ;save FDUB ptr JSYS GETFD,=C'&TTYLOC ' ;open loc file ST 0,TTYFDP ;save FDUB ptr * search WHO.NAMES for a name containing our string * R6/ addr of compare string * R7/ length-1 of compare string * R10/ number of matches (NZ if any) SRCH1 JSYS READ,FNDLST ;read WHO.NAMES LTR 15,15 ;eof? BNZ SRCH7 ;too bad LH 1,LEN ;copy SH 1,=Y(1+5) ;-1 for MVC/TR, lose nameID EX 1,COPNAM ;copy the name L 2,=V(CASECONV) ;upper case table EX 1,CVTNAM ;convert to upper case SR 1,7 ;find # happy posns (-1-(-1)) BLT SRCH1 ;skip if none LA 1,1(,1) ;convert difference to count LA 2,FBUF ;pt at buf SRCH2 EX 7,CMPNAM ;compare BE SRCH3 ;got it, get laid LA 2,1(,2) ;advance BCT 1,SRCH2 ;try every position (69!) B SRCH1 ;get psyched SRCH3 MVC NMCCID(4),WNBUF ;copy nameID LTR 10,10 ;is this the first? BZ SRCH4 ;yes, skip JSYS SPRINT,BLANK ;no, add a blank line SRCH4 LA 10,1(,10) ;count it LH 1,LEN ;get length LA 1,1(,1) ;add cc STH 1,LEN ;save JSYS SPRINT,CFNAME ;confirm name JSYS SPRINT,BLANK ;blank line JSYS READ,RLIST ;get info LTR 15,15 ;OK? BNZ SRCH6 ;no, gack LA 8,FBUF ;pt @ rec LH 9,LEN ;get length SRCH5 BAS 4,FORMAT ;do one LA 8,RECLEN(,8) ;advance to next SH 9,=Y(RECLEN) ;done? BNZ SRCH5 ;loop if not B SRCH1 ;keep it up SRCH6 JSYS SPRINT,NOTFND ;no info B SRCH1 ;keep going SRCH7 LTR 10,10 ;did we get anything? BNZ SRCH8 ;skip if so JSYS SPRINT,NOTFND ;no such name SRCH8 JSYS REWIND,=A(WNUNIT) ;rewind WHO.NAMES L 0,BBFD ;get handle JSYS FREEFD ;free ID file L 0,TTYFDP ;get handle JSYS FREEFD ;free TTY loc file B LOOP ;get next command * DISUC TR 0(0,2),0(1) ;translate to u.c. COPNAM MVC FBUF(0),WNBUF+5 ;get name from WHO.NAMES CVTNAM TR FBUF(0),0(2) ;translate to upper case CMPNAM CLC 0(0,6),0(2) ;check for match *+ * * Name or ID not found. * *- NOSEE JSYS SPRINT,NOTFND ;aww, too bad B LOOP ;get their next wimpy excuse *+ * * FINGER/WHOIS * * Get information about a user at a remote system, or about * the whole system. "WHOIS user" is like "FINGER user/W"; * the meaning is site-dependent but it generally gets more stuff. * Most of the more recent Unix servers blow this off so you lose. * *- FINGER MVI WSWIT,0 ;no /W switch B WHOIS1 ;skip WHOIS MVI WSWIT,1 ;include a /W switch WHOIS1 MVC PORTNO(2),=C'79' ;set port # for :NAME server BAL 10,UNAME ;lookup * convert name to ASCII, add ["/W" and] CR, LF LA 6,WNBUF(5) ;pt at end of where name will go LTR 5,5 ;is there anything there? BZ WHOIS2 ;skip if not BCTR 5,0 ;-1 for MVC/TR EX 5,WMVNAM ;move into buffer L 1,=V(EBCASC) ;EBCDICK => ASCII table EX 5,WCVASC ;convert WHOIS2 CLI WSWIT,0 ;should we add /W? BZ WHOIS3 ;skip if not MVC 0(2,6),=X'2F57' ;add /W LA 6,2(6) ;count +2 WHOIS3 MVC 0(2,6),=X'0D0A' ;ASCII CR, LF S 6,=A(WNBUF-2) ;find length (incl. cr,lf) STH 6,NCMDLN ;save * send them the command line JSYS WRITE,NAMCMD,WPUNT ;do it JSYS CONTROL,PUSH,WPUNTC ;make sure it's sent * get whatever they say until they close XR 4,4 ;nothing in line buf yet WGET1 JSYS READ,RDNET,WDONE ;read a record, skip if done LA 2,FBUF ;pt at buffer LH 3,LEN ;get length LTR 3,3 ;anything? BZ WGET1 ;loop if not WGET2 NI 0(2),X'7F' ;make sure 7 bits CLI 0(2),X'20' ;ctrl char? BLT WGET5 ;yes WGET3 IC 0,0(2) ;get the char STC 0,KBBUF+1(4) ;save LA 4,1(4) ;update WGET4 LA 2,1(2) ;advance ptr BCT 3,WGET2 ;loop B WGET1 ;read more * handle ctrl chars; cr, lf, tab: special, caret others. WGET5 CLI 0(2),X'0A' ;lf? BE WGET9 ;yes, flush line CLI 0(2),X'0D' ;cr? BE WGET4 ;yes, ignore CLI 0(2),X'09' ;tab? BE WGET7 ;yes, expand WGET6 LA 1,KBBUF+1(4) ;pt at next char MVI 0(1),X'5E' ;quote with uparrow LA 4,1(4) ;skip it XI 0(2),X'40' ;convert B WGET3 ;go copy the char WGET7 LA 0,X'20' ;load an ASCII blank WGET8 STC 0,KBBUF+1(4) ;save it LA 4,1(4) ;advance LR 1,4 ;copy N 1,=F'7' ;are we there yet? BNZ WGET8 ;loop if not B WGET4 ;go skip the tab WGET9 MVI KBBUF,X'20' ;add carriage control * remap characters which are missing on a Courier. CLI COURIER,0 ;are we on a Courier? BZ WGET10 ;no, skip EX 4,WXCOUR ;yes, translate for Courier WGET10 L 1,=V(ASCEBC) ;pt at translation table EX 4,WTRREP ;translate the reply LA 4,1(4) ;+1 (count cc) STH 4,LEN ;save JSYS SPRINT,SPRPLY ;display the reply XR 4,4 ;back to left marg B WGET4 ;loop * finish up; close the connection and release it. WDONE LTR 4,4 ;anything still in buf? BZ WDONE2 ;no, skip * flush last line MVI KBBUF,X'20' ;add carr. ctrl CLI COURIER,0 ;are we on a Courier? BZ WDONE1 ;no, skip EX 4,WXCOUR ;yes, translate WDONE1 L 1,=V(ASCEBC) ;pt at trans table EX 4,WTRREP ;translate reply LA 4,1(4) ;+1 (count cc) STH 4,LEN ;save JSYS SPRINT,SPRPLY ;display WDONE2 JSYS CONTROL,CLOSE ;close it B LOOP * WPUNT JSYS SERCOM,NETERR ;complain B LOOP * WPUNTC MVC FBUF(15),=C' Network error:' ;msg L 1,CTAREA+4 ;get length of msg BCTR 1,0 ;-1 for MVC EX 1,WMVMSG ;move it LA 1,15(1) ;bump length STH 1,LEN ;set length JSYS SERCOM,NETMSG ;print message B LOOP ;return * WMVNAM MVC WNBUF(0),0(4) ;copy username WCVASC TR WNBUF(0),0(1) ;translate it to ASCII WXCOUR TR KBBUF(0),FIXEBC ;fix reply for Courier WTRREP TR KBBUF(0),0(1) ;xlat reply to EBCDICK WMVMSG MVC FBUF+15(0),CTAREA+8 ;copy CONTROL error msg *+ * * Get expansion of a mailing list. * * E.g.: "LIST ITS-LOVERS@MC.LCS.MIT.EDU". * *- MLIST MVC PORTNO(2),=C'25' ;port # for SMTP server BAL 10,UNAME ;get Internet mailname * build "EXPN" command using username MVC WNBUF(5),=C'EXPN ' ;command BCTR 5,0 ;R5-1 for MVC EX 5,EXPNMV ;copy name LA 5,5+1(5) ;re-correct, add LEN('EXPN ') STH 5,NCMDLN ;save length * eat their signon banner XR 9,9 ;trash reply BAL 10,REPLY ;do it * say hello (they might freak otherwise) JSYS WRITE,HELO,WPUNT ;say hello JSYS CONTROL,PUSH,WPUNTC ;make sure they get it * eat their reply XR 9,9 ;trash reply BAL 10,REPLY ;yep * ask for the mailing list expansion JSYS WRITE,NAMCMD,WPUNT ;write "EXPN" cmd JSYS CONTROL,PUSH,WPUNTC ;push it through * display the reply LA 9,1 ;show the reply BAL 10,REPLY ;yep * later dude JSYS WRITE,QUIT,WPUNT ;see you JSYS CONTROL,CLOSE ;we don't care about reply B LOOP * EXPNMV MVC WNBUF+5,0(4) ;copy list name into EXPN cmd *+ * * Receive a reply code from the SMTP server. * * R9/ NZ to display it, 0 to throw it away * R10/ link * *- REPLY JSYS READ,RDNET,WPUNT ;read a line LA 1,FBUF ;point at command LH 2,LEN ;get length AR 2,1 ;pt at end XR 3,3 ;assume not final line * see whether first non-digit is a hyphen or not REPLY1 CLR 1,2 ;blank or just digits? BER 10 ;done if so (don't bother printing) CLI 0(1),C'-' ;hyphen? BE REPLY3 CLI 0(1),C'0' ;digit? BL REPLY2 CLI 0(1),C'9' LA 1,1(1) ;(advance) BLE REPLY1 ;ignore if digit REPLY2 BCTR 3,0 ;R3=-1 (final line of reply) CLI 0(1),C' ' ;blank? BE REPLY4 ;yes, don't back up BCTR 1,0 ;back up REPLY3 MVI 0(1),C' ' ;put a blank there REPLY4 LTR 9,9 ;should we display the msg? BZ REPLY5 ;no ST 1,HOSTNM ;save ptr SR 2,1 ;find length STH 2,LEN JSYS SPRINT,HOSTNM ;display the msg REPLY5 LTR 3,3 ;is there more? BZ REPLY ;get it if so BR 10 *+ * * Get information about an Internet host. * * Same idea as the HOST program for TOPS-20 that * used to be on MIT-OZ.#Chaosnet in the Good Old Days. * *- HOST BAS 4,SKIP ;skip blanks LTR 3,3 ;anything left? BZ LOOP ;who cares MVI HSTINF,1 ;don't release *BB* BAL 10,LOOKUP ;do it B HSTERR ;error from server BCTR 4,0 ;-1 MVI 0(4),C' ' ;add carriage control LA 5,1(5) ;length +1 ST 4,HOSTNM ;save STH 5,LEN JSYS SPRINT,HOSTNM ;give name of host * give IP address(es) LA 8,IPADDR ;point at addr list IPA1 CLC 0(4,8),=F'0' ;end of table? BZ IPA2 LA 8,4(8) ;skip to end of addr L 4,=A(FBUF+512+1) ;free addr BAL 10,CVADDR ;convert addr BCTR 4,0 ;-1 MVI 0(4),C' ' ;add carr ctrl LA 5,1(5) ;length +1 ST 4,HOSTNM ;save STH 5,LEN JSYS SPRINT,HOSTNM ;display LA 8,4(8) ;skip to next addr B IPA1 ;loop * ask again for HINFO stuff IPA2 LH 1,QLEN ;get length LA 1,QRY-3(1) ;point at QTYPE LSB MVI 0(1),13 ;QTYPE=HINFO BAL 10,SNDQRY ;ask again B NOHINF ;no error messages * unpack HINFO field if given L 3,HINFO ;get it LTR 3,3 ;did we get it back? BZ NOHINF ;no MVC KBBUF(6),=C' CPU: ' ;heading LA 4,KBBUF+6 ;point after it XR 5,5 ;init IC 5,0(3) ;get length LA 3,1(3) ;advance BCTR 5,0 ;-1 for MVC/TR EX 5,HSTMVC ;copy to our buffer L 6,=V(ASCEBC) ;conversion table EX 5,HSTTR ;translate to EBCDICK LA 4,1(5,4) ;advance MVC 0(6,4),=C', OS: ' ;2nd heading LA 4,6(4) ;skip LA 3,1(5,3) ;advance IC 5,0(3) ;get OS length LA 3,1(3) ;advance BCTR 5,0 ;-1 for MVC/TR EX 5,HSTMVC ;copy to our buffer EX 5,HSTTR ;translate to EBCDICK LA 4,1(5,4) ;advance S 4,=A(KBBUF) ;find length STH 4,LEN ;save JSYS SPRINT,SPRPLY ;display CPU/OS NOHINF B LOOP * domain server error -- probably no such host HSTERR CL 1,=A(NAMERR) ;is that it? BNE NSERR ;no, punt for sure LH 1,QLEN ;get length LA 1,QRY-3(1) ;point at QTYPE LSB MVI 0(1),15 ;QTYPE=MX BAL 10,SNDQRY ;ask again B NSERR ;OK OK, I get the picture BCTR 4,0 ;-1 MVI 0(4),C' ' ;carriage control LA 5,1(5) ;length +1 ST 4,HOSTNM ;save AR 4,5 ;point at end MVC 0(12,4),=C' (MX record)' ;say it's an MX rec LA 5,12(5) ;update length STH 5,LEN JSYS SPRINT,HOSTNM ;give name * display next MX record MX1 L 1,MX ;get next LTR 1,1 ;is that it? BZ IPA2 ;yes, now ask for HINFO LA 1,2(1) ;skip preference BAL 14,CVNAME ;convert name S 4,=F'2' ;-2 ST 4,HOSTNM ;save MVC 0(2,4),=C' @' ;carriage control +'@' LA 6,2(5) ;count it AR 4,6 ;skip to end MVC 0(12,4),=C' preference=' ;label LA 6,12(6) ;update length LA 7,12(4) ;update + save ptr LA 5,5(7) ;point at buffer LR 4,5 ;copy L 1,MX ;get current record XR 3,3 ;high word=0 ICM 3,B'11',0(1) ;get preference LA 1,C'0' ;EBC DICK 0 BAL 14,CVDEC ;convert to decimal SR 5,4 ;length EX 5,PRFMVC ;copy (+1 junk char) AR 6,5 ;total length STH 6,LEN ;length JSYS SPRINT,HOSTNM ;display entry MVC MX(10*4),MX+4 ;scroll MX list B MX1 ;loop * HSTMVC MVC 0(0,4),0(3) ;copy string HSTTR TR 0(0,4),0(6) ;translate to EBCDICK PRFMVC MVC 0(0,7),0(4) ;copy preference *+ * * Parse "NAME@HOST". * * On return (if any -- punts on error), * R4/ points to EBCDICK username * R5/ length of username * * If all went well then the "[HOST]" message has been displayed * and the connection has been made. * *- UNAME BAS 4,SKIP ;skip blanks LTR 3,3 ;anything left? BZ LOOP ;no, ignore the command * parse off name (everything before @), if any LR 4,2 ;copy ptr UNAME1 CLI 0(2),C'@' ;end of name (if any)? BE UNAME3 ;yes, skip LA 2,1(2) ;no, advance BCT 3,UNAME1 ;loop UNAME2 JSYS SERCOM,NHNAME ;no host name, gack B LOOP ;get next command UNAME3 LR 5,2 ;copy ptr again SR 5,4 ;find # chars in name * R4/ ptr to name, R5/length LA 2,1(2) ;skip @ BCTR 3,0 ;count it LTR 3,3 ;anything left? BZ UNAME2 ;no, complain * R2/ ptr to hostname in line, R3/ count of chars left in line STM 4,5,UNAMS1 ;save R4,R5 ST 10,UNAMS2 ;and R10 * look up host MVI HSTINF,0 ;no add'l stuff BAL 10,LOOKUP ;look up the name B NSERR ;display error message * R4/ host name or IP addr, R5/ length of name or addr * see if we have an EBCDICK terminal CLI SNSED,0 ;have we SENSEd *MSINK*? BNZ UNAME5 MVI SNSED,1 ;don't do this again JSYS GETFD,=C'*MSINK* ' ;SPRINT might be redirected ST 0,DUMMY ;save FDUB ptr JSYS CONTROL,SNSLST ;get terminal info L 0,DUMMY ;get FDUB ptr JSYS FREEFD ;close it CLC SNSDVTYP(3),=C'327' ;327X or Courier? BE UNAME4 CLC SNSDVTYP(3),=C'317' ;3178 then? BNE UNAME5 UNAME4 MVI COURIER,1 ;EBCDICK terminal * display "[HOST]" (or "(HOST)" if EBCDICK) while we connect UNAME5 LA 1,0(4,5) ;pt at end S 4,=F'2' ;back up for " [" CLI COURIER,0 ;EBCDICK terminal? BNZ UNAME6 ;yes, use paren's MVC 0(2,4),=C' [' ;add carr. ctrl, brackets MVI 0(1),C']' B UNAME7 ;skip UNAME6 MVC 0(2,4),=C' (' ;parens on Courier (no []'s) MVI 0(1),C')' UNAME7 LA 5,3(5) ;count bkts + cc STH 5,LEN ;save length ST 4,HOSTNM ;and addr JSYS SPRINT,HOSTNM ;display the line (should %ROLL?) * set up the connection CLC PORTNO(2),=C'79' ;:NAME? BNE UNAME8 ;no, SMTP uses TELNET JSYS MOUNT,MNTTCP,WPUNT ;mount the connection B UNAME9 ;skip UNAME8 JSYS MOUNT,MNTTLN,WPUNT ;mount the connection UNAME9 MVI BBMNTD,1 ;remember *BB* is mounted JSYS GETFD,=C'*BB* ' ;get FDUB ptr ST 0,NAMFD ;save it * convert IP addr to EBCDICK LA 4,FBUF+35 ;allow space for cmd LA 8,IPADDR+4 ;pt past addr BAL 10,CVADDR ;convert S 4,=F'20' ;make room LA 5,20(5) ;update length MVC 0(20,4),=C'DESTINATION_ADDRESS=' ;add cmd ST 4,DADDR ;save addr STH 5,LEN ;save JSYS CONTROL,DADDR,WPUNTC ;set dest addr JSYS CONTROL,DPORT,WPUNTC ;set port # JSYS CONTROL,CONECT,WPUNTC ;actually connect LM 4,5,UNAMS1 ;restore R4,R5 L 10,UNAMS2 ;and R10 BR 10 ;return *+ * * Look up host name/number. * * R2/ ptr to EBCDICK domain name or "a.b.c.d" IP addr. * R3/ count of chars at (R2) * R10/ link * HSTINF/ NZ => get WKS and HINFO too, Z => just A or PTR * * Returns: * +0 domain server returned error * R1 set up for SERCOM call * +4 got at least a partial answer: * R4/ ptr to EBCDICK domain name * R5/ length * IPADDR: 0-terminated table of fullword IP addresses * *- LOOKUP LR 4,2 ;copy ptr LR 5,3 ;copy len * try parsing as A.B.C.D first LA 7,4 ;dot counter (IP addr in R6) XR 1,1 ;init this byte ABCD1 CLI 0(4),C'.' ;dot? BE ABCD5 CLI 0(4),C' ' ;end of string? BE ABCD3 CLI 0(4),C'0' ;digit? BL DNAM1 CLI 0(4),C'9' BH DNAM1 M 0,=F'10' ;*10 IC 0,0(4) ;get dig SH 0,=Y(C'0') ;convert to dec AR 1,0 ;add it in CH 1,=H'255' ;overflowed byte? BGT DNAM1 ABCD2 LA 4,1(4) ;skip char BCT 5,ABCD1 ;loop ABCD3 SLL 6,8 ;left 8 OR 6,1 ;OR in last byte BCT 7,DNAM1 ;we should be done, punt if not * it was an IP addr, value in R6 ST 6,IPADDR ;save IP addr ST 7,IPADDR+4 ;(=0) mark end of addr list * make a query: * QNAME: D.C.B.A.IN-ADDR.ARPA, QTYPE: PTR, QCLASS: IN LA 4,INADDR ;pt at buffer LA 1,X'30' ;ASCII 0 LA 7,4 ;loop count LA 8,IPADDR ;point at addr ABCD4 LR 0,4 ;copy ptr XR 3,3 ;zap IC 3,0(8) ;get next # LA 8,1(8) ;skip it BAL 14,CVDEC ;convert SR 0,4 ;find length BCTR 4,0 ;-1 STC 0,0(4) ;save it BCT 7,ABCD4 ;loop LA 5,ENDINA-1 ;end of query -1 (for MVC) SR 5,4 ;find length EX 5,COPQNM ;copy QNAME LA 5,QRYBUF-QRY+1(5) ;add length of header, correct STH 5,QLEN ;save length B QUERY1 ;go send query ABCD5 SLL 6,8 ;left 8 OR 6,1 ;OR in the new byte XR 1,1 ;init for next one BCT 7,ABCD2 ;go skip the ., unless too many * must be a domain name, parse and build query DNAM1 MVC IPADDR(4),=F'0' ;don't know IP addr LA 4,QRYBUF ;pt at buffer LR 5,2 ;init ptr L 7,=V(EBCASC) ;xlat table * parse next label DNAM2 CLI 0(2),C' ' ;end? BE DNAM4 CLI 0(2),C'.' ;end of label? BE DNAM5 DNAM3 LA 2,1(2) ;skip BCT 3,DNAM2 DNAM4 LR 6,2 ;copy SR 6,5 ;find length STC 6,0(4) ;poke length BCTR 6,0 ;-1 for MVC/TR EX 6,COPLAB ;copy label EX 6,TRLAB ;xlat to ASCII LA 4,2(4,6) ;skip MVC 0(5,4),=X'0000010001' ;end, QTYPE=A, QCLASS=IN S 4,=A(QRY-5) ;find total length STH 4,QLEN ;save B QUERY1 ;go DNAM5 LR 6,2 ;copy SR 6,5 ;find length STC 6,0(4) ;poke it BCTR 6,0 ;-1 for MVC/TR EX 6,COPLAB ;copy label EX 6,TRLAB ;xlat to ASCII LA 4,2(4,6) ;skip LA 5,1(2) ;pt at next B DNAM3 * whatever it was, build and send the query * QRYBUF/ QNAME, QTYPE, and QCLASS fields * QLEN/ length of above * IPADDR is non-zero if we're looking up a name from a number, * zero if we have the name and want the number(s). QUERY1 MVC QRY+10(2),=X'0001' ;QDCOUNT=1 CLI HSTINF,0 ;are we doing the hostinfo thing? BZ QUERY2 XR 0,0 ;get 0 ST 0,TCPWKS ;no TCP WKS's yet ST 0,UDPWKS ;or UDP either ST 0,HINFO ;or HINFO ST 0,MX ;or MX records QUERY2 JSYS MOUNT,MNTUDP,DPUNT ;get a network device MVI BBMNTD,1 ;mounted JSYS GETFD,=C'*BB* ' ;get an FDUB ptr ST 0,NAMFD ;save JSYS CONTROL,WATYPE,DPUNT ;WRITE_ADDRESS_TYPE=BUFFER JSYS CONTROL,TIMER,DPUNT ;set timeout JSYS CONTROL,SOCKET,DPUNT ;SOCKET * send the query SNDQRY LA 2,5 ;# retries QUERY3 JSYS WRITE,QUERY,DPUNT ;yep JSYS READ,RDNET ;get reply LTR 15,15 ;OK? BZ QUERY4 ;yes BCT 2,QUERY3 ;retry DPUNT L 0,NAMFD ;close *BB* JSYS FREEFD JSYS RELEASE,RELBB ;$REL *BB* MVI BBMNTD,0 ;not mounted CLC IPADDR(4),=F'0' ;doing PTR lookup? BZ DPUNT2 ;no, error for sure CLI HSTINF,0 ;did we want more info? BNZ LOOP ;yes, give up quietly * settle for the IP address they gave us if that's all we wanted DPUNT1 LA 4,FBUF+17 ;allow space for no. +' [' LA 8,IPADDR+4 ;point at address B CVADDR ;cvt IP addr, return (R10) DPUNT2 JSYS SERCOM,LUKERR ;lookup error B LOOP QUERY4 CLI HSTINF,0 ;holding out for HINFO? BNZ QUERY5 ;yes, don't release L 0,NAMFD ;close *BB* JSYS FREEFD JSYS RELEASE,RELBB ;$REL *BB* MVI BBMNTD,0 ;not mounted * server reply is in FBUF, length in LEN QUERY5 IC 1,FBUF+3 ;get response code N 1,=F'15' ;isolate low 4 BZ RESP ;we won, parse RR's SLL 1,2 ;*4 L 1,RSPDSP-4(1) ;get SERCOM list BR 10 ;return * N.B. IPADDR may contain a valid address NSERR JSYS SERCOM ;jump here for error msg B LOOP RSPDSP DC A(FMTERR,SRVFLR,NAMERR,NOTIMP,REFUSD) DC A(SRVERR,SRVERR,SRVERR,SRVERR,SRVERR) DC A(SRVERR,SRVERR,SRVERR,SRVERR,SRVERR) * things are OK, handle response RESP LA 1,FBUF+12 ;pt at returned info LH 9,FBUF+4 ;get QDCOUNT * skip queries LTR 9,9 ;did they return it? BZ RESP2 ;no RESP1 BAL 14,SKNAME ;skip QNAME LA 1,4(1) ;skip QTYPE, QCLASS BCT 9,RESP1 ;loop RESP2 ST 9,HNAME ;no hostname yet LH 9,FBUF+6 ;get ANCOUNT LTR 9,9 ;non-zero, right? BZ RR3 ;punt! * scan answer RR's for the ones we want RR1 CLC HNAME(4),=F'0' ;do we have a hostname? BNZ *+8 ST 1,HNAME ;set default if not BAL 14,SKNAME ;skip name CLC 0(2,1),=X'0001' ;A? BE RRA CLC 0(2,1),=X'0005' ;CNAME? BE RRCNAM CLC 0(2,1),=X'000B' ;WKS? BE RRWKS CLC 0(2,1),=X'000C' ;PTR? BE RRPTR CLC 0(2,1),=X'000D' ;HINFO? BE RRHINF CLC 0(2,1),=X'000F' ;MX? BE RRMX RR2 XR 2,2 ;zap out R2 ICM 2,3,8(1) ;get RDLENGTH LA 1,10(2,1) ;skip to next RR BCT 9,RR1 ;loop * we're done, make sure we got the name RR3 L 1,HNAME ;get it LTR 1,1 ;anything? BZ NONAME BAL 14,CVNAME ;convert B 4(10) ;happy return NONAME LA 1,NAMERR ;point at msg BR 10 ;error return * address RR RRA ICM 2,15,10(1) ;get IP addr LA 3,IPADDR ;init ptr RRA1 CLC 0(4,3),=F'0' ;empty slot? BZ RRA2 ;skip LA 3,4(3) ;skip CL 3,=A(4*10+IPADDR) ;off end? BL RRA1 ;loop B RR2 ;just lose it RRA2 ST 2,0(3) ;save MVC 4(4,3),=F'0' ;zap next entry B RR2 ;(space for F'0' after end) * CNAME RR RRCNAM LA 2,10(1) ;pt at CNAME ST 2,HNAME ;definitely right B RR2 * WKS RR RRWKS B RR2 ;later... * PTR RR RRPTR LA 2,10(1) ;pt at PTR ST 2,HNAME ;definitely right B RR2 * HINFO RR RRHINF LA 0,10(1) ;addr ST 0,HINFO ;save ptr B RR2 * MX RR RRMX LA 2,10(1) ;pt at MX record LA 3,MX ;init ptr RRMX1 CLC 0(4,3),=F'0' ;empty slot? BZ RRMX2 LA 3,4(3) ;skip it if not CL 3,=A(4*10+MX) ;off end? BL RRMX1 ;loop B RR2 ;just lose it RRMX2 ST 2,0(3) ;save MVC 4(4,3),=F'0' ;zap next entry B RR2 ;(space for F'0' after end) * COPLAB MVC 1(0,4),0(5) ;copy label to query TRLAB TR 1(0,4),0(7) ;translate to ASCII COPQNM MVC QRYBUF(0),0(4) ;copy query into buf *+ * * Convert a hostname from query form to EBCDICK. * * R1/ pointer to hostname (RFC 1035 form) * R14/ link * * Returns: * R4/ pointer to name * R5/ length * *- CVNAME L 4,=A(FBUF+2+512) ;guaranteed free (RFC 1035) +' [' LR 5,4 ;save for length LM 2,3,=V(ASCEBC,CASECONV) ;conversion tables CVN1 CLI 0(1),X'C0' ;pointer? BGE CVN2 XR 6,6 ;init for length ICM 6,1,0(1) ;get length, set CC BZ CVN3 ;end LA 1,1(1) ;skip length BCTR 6,0 ;-1 for MVC/TR EX 6,CVNMVC ;copy label EX 6,CVNTR1 ;EBCDICK EX 6,CVNTR2 ;UPPER CASE! AR 4,6 ;skip to last char MVI 1(4),C'.' ;add a . LA 4,2(4) ;skip past it LA 1,1(6,1) ;skip to next label B CVN1 ;loop CVN2 ICM 1,3,0(1) ;get pointer N 1,=F'16383' ;isolate LA 1,FBUF(1) ;index into buf B CVN1 ;continue CVN3 CLR 4,5 ;have we moved? BE *+6 ;no (?!), don't lose BCTR 4,0 ;un-put last . SR 5,4 ;find -length LPR 5,5 ;|length| SR 4,5 ;back up BR 14 ;return * CVNMVC MVC 0(0,4),0(1) ;copy string CVNTR1 TR 0(0,4),0(2) ;xlat to EBCDICK CVNTR2 TR 0(0,4),0(3) ;xlat to u.c. *+ * * Skip a domain name. * * R1/ domain name (RFC 1035 form) * R14/ link * * R1 is updated on return. * *- SKNAME XR 2,2 ;zap SKN1 CLI 0(1),X'00' ;end? BZ SKN3 CLI 0(1),X'C0' ;pointer? BGE SKN2 IC 2,0(1) ;get length LA 1,1(2,1) ;skip B SKN1 SKN2 LA 1,1(1) ;+1 (+2 total) SKN3 LA 1,1(1) ;+1 BR 14 *+ * * Convert number to decimal. * * R1/ C'0' or ASCII '0' * R3/ number * R4/ end of buffer (predecrement) * R14/ link * *- CVDEC XR 2,2 ;zero-extend D 2,=F'10' ;divide AR 2,1 ;cvt to EBCDICK or ASCII BCTR 4,0 ;back up STC 2,0(4) ;save LTR 3,3 ;anything left? BNZ CVDEC ;loop BR 14 ;return *+ * * Convert IP addr to EBCDICK. * * R4/ end of buffer * R8/ ptr to end of IP addr * R10/ link * * On return: * R4/ begn of buffer * R5/ length * *- CVADDR LR 5,4 ;copy for subtract later LA 1,C'0' ;EBCDICK 0 LA 7,4 ;loop count CVADR1 XR 3,3 ;zap BCTR 8,0 ;-1 IC 3,0(8) ;get next # BAL 14,CVDEC ;convert BCTR 4,0 ;-1 MVI 0(4),C'.' ;dot BCT 7,CVADR1 ;loop LA 4,1(4) ;skip 1st . SR 5,4 ;find length BR 10 ;return *+ * * List help file. * *- HELP BAS 5,CONFRM ;check for trash JSYS GETFD,=C'&BBHELP ' ;open help file ST 0,HELPFD ;save HELP1 JSYS READ,RHELP ;read a line LTR 15,15 ;done? BNZ HELP2 ;yes JSYS SPRINT,WHELP ;copy to screen B HELP1 ;loop HELP2 L 0,HELPFD ;get handle JSYS FREEFD ;close file B LOOP ;get next cmd *+ * * Format and print the output line. * * Call: BAS 4,FORMAT * * Enter at FORMA1 if the time field has already been set up. * * Accumulators 6 and above are preserved. * *- FORMAT L 1,RECTIM ;get time/date JSYS JULGRGTM ;convert STM 0,3,TIMBUF ;save IC 1,TIMBUF+1 ;get low dig of month N 1,=F'15' ;zero-extend, chop off EBC DICK IC 2,TIMBUF ;get high dig of month N 2,=F'1' ;cvt to binary LNR 2,2 ;0 or -1 N 2,=F'10' ;get it AR 1,2 ;add LR 2,1 ;copy AR 1,2 ;*2 AR 1,2 ;*3 LA 1,MONTHS-3(1) ;index ICM 1,7,0(1) ;get month STCM 1,7,REPTIM ;save it MVC REPTIM+4(2),TIMBUF+3 ;copy DD MVC REPTIM+7(2),TIMBUF+6 ;copy YY MVC REPTIM+10(5),TIMBUF+8 ;copy HH:MM FORMA1 MVC REPID(4),RECID ;copy ID MVC REPDEV(4),RECDEV ;copy device name MVC TTYLIN(4),RECDEV ;copy device # L 5,=F'-1' ;assume none (-TRAILING) JSYS READ,TTRLST ;try to read location LTR 15,15 ;did we get it? BNZ FORMA2 ;no, skip LH 5,LEN ;get length SH 5,=Y(TTLDR) ;subtract leader info EX 5,CMVCTT ;copy TTY loc FORMA2 LA 5,REPLOC-REPORT(,5) ;total length STH 5,LEN ;save length JSYS SPRINT,FMTSPR ;print the line BR 4 ;return *+ * * Parse a 4-character ID. * * Call: BAS 6,PARSID * * Returns Z=1 if eol reached (use default ID). * *- PARSID BAS 4,SKIP ;skip blanks LTR 3,3 ;anything left? BZR 6 ;no, return Z=1 MVC NMCCID(4),=C'$.$.' ;init in case < 4 chars LR 4,2 ;save ptr PRSID1 CLI 0(2),C' ' ;end of ID? BE PRSID2 ;skip if so LA 2,1(,2) ;advance ptr BCT 3,PRSID1 ;get loopy PRSID2 LR 1,2 ;copy ptr SR 1,4 ;find # chars CH 1,=H'4' ;too long? BH CNFRM1 ;yep, extra stuff BCTR 1,0 ;-1 for MVC EX 1,MVCID ;copy L 5,=V(CASECONV) ;pt at low core table TR NMCCID(4),0(5) ;convert to upper case BAS 5,CONFRM ;anything left? LTR 6,6 ;set Z=0 BR 6 ;return MVCID MVC NMCCID(0),0(4) ;copy 1-4 chars of ID *+ * * Skip blanks. Ptr in 2, remaining length in 3. * * Call: BAS 4,SKIP * *- SKIP LTR 3,3 ;anything to skip? BZR 4 ;return now if not SKIP1 CLI 0(2),C' ' ;blank? BNER 4 ;return if not LA 2,1(,2) ;skip it BCT 3,SKIP1 ;get loopy BR 4 ;ran out of stuff *+ * * Check for confirmation. * * Call: BAS 5,CONFRM * *- CONFRM BAS 4,SKIP ;skip blanks LTR 3,3 ;end of line? BZR 5 ;yes, good CNFRM1 JSYS SERCOM,NOTCNF ;complain B LOOP ;around for more * EXITA EXIT , ;die *+ * * Attn vector. * * We come here on an Attn. * *- DROP 11,12 ;just for a second USING ATTN,15 ATTN LM 11,12,=A(BB,BB+X'1000') ;reload base regs DROP 15 ;forget it USING BB,11,12 ;we're back LA 13,REGS ;pt at savearea (so EXIT works) JSYS SETPFX,ATNPFX ;prefix = ! JSYS SERCOM,BLANK ;say hello (at left marg) LM 0,1,=A(ATTN,ATNREG) ;pt at region JSYS ATTNTRP ;reenable B LOOP ;continue * LTORG ;dump constant pool * KWTAB CMD 'D-ISPLAY',DISPLY ;show data for a name CMD 'E-XPLAIN',HELP ;syn. for HELP CMD 'F-INGER',FINGER ;get :NAME info (network) CMD 'HE-LP',HELP ;print help file CMD 'HO-ST',HOST ;get info about host CMD 'I-D',LOOKID ;show data for a CCID CMD 'L-IST',MLIST ;show mailing list members CMD 'M-TS',EXITA ;syn. for STOP CMD 'N-AMEID',LKNMID ;show data for a nameID CMD 'S-TOP',EXITA ;exit the program CMD 'W-HOIS',WHOIS ;get :WHOIS info (network) CMD ':N-AME',FINGER ;ITS-style synonyms (whee) CMD ':W-HOIS',WHOIS CMD '?-',HELP ;syn. for HELP DC X'FF' ;end of table * MONTHS DC C'JanFebMarAprMayJunJulAugSepOctNovDec' * FIXEBC EQU *-X'20' ;table to fix for EBCDICK terms DC X'202122232425262728292A2B2C2D2E2F' DC X'303132333435363738393A3B3C3D3E3F' DC X'404142434445464748494A4B4C4D4E4F' DC X'505152535455565758595A282F29A25F' ;[\]^ => (/)" DC X'276162636465666768696A6B6C6D6E6F' ;` => ' DC X'707172737475767778797A3C7C3EAC7F' ;{}~ => <>, * CMVCTT MVC REPLOC(0),TTBUF+TTLDR ;copy term loc IDFILE DC C'&BBUSERS ' ;userID file NMFILE DC C'&BBNAMES ' ;nameID file HLPFIL DC C'&BBHELP ' ;help file RLIST DC A(FBUF,LEN,RMODS,NMCCID,BBFD) WLIST DC A(FBUF,LEN,@I,NMCCID,BBFD) NMCCID DS F ;use nameID or CCID as line # RMODS DC XL4'08000002' ;@MAXLEN @I @MAXLEN DC XL4'08000000' ;@MAXLEN @I DC XL4'00000002' ;@I NETMOD DC XL4'48000000' ;@ERRRTN @MAXLEN LEN DS H ;length read DC Y(L'FBUF) ;length of buffer DS H ;useless * BAN1 SPSTR ' Big Brother, by John Wilson' BAN2 SPSTR ' Version: &SYSDATE' NOWHO SPSTR ' ??? UNABLE TO ACCESS WHO.NAMES ???' BLANK DC A(BLANKC,ONEH,ZERO,DUMMY) ONEH DC H'1' * INPFX DC A(*+4) ;SCARDS input prefix DC C'*' OUTPFX DC A(BLANKC) ;SPRINT output prefix BLANKC DC C' ' ATNPFX DC A(*+4) ;Attn prefix DC C'!' * SCLIST DC A(KBBUF,LEN,@MAXLEN,DUMMY) ;SCARDS args CMDLST DC A(KBBUF,LEN) ;CMDNOE args BADKW SPSTR ' I beg your pardon?' NOTCNF SPSTR ' Extra character(s) on command line' CFNAME DC A(WNCC,LEN,ZERO,DUMMY) ;SPRINT confirm name NOTFND SPSTR ' No information available' NHNAME SPSTR ' Name must end in "@host"' LUKERR SPSTR ' Name server lookup error' FMTERR SPSTR ' Name format error' SRVFLR SPSTR ' Name server failure' NAMERR SPSTR ' No such host' NOTIMP SPSTR ' Query type unimplemented in name server' REFUSD SPSTR ' Fascist name server refuses access' NETERR SPSTR ' Network error' SRVERR SPSTR ' Host name server error' HELO SPSTR 'HELO &MTS',NAMFD ;say hi to SMTP server QUIT SPSTR 'QUIT',NAMFD ;then blow it off * NAMCMD DC A(WNBUF,NCMDLN,ZERO,DUMMY,NAMFD) ;:NAME cmd RDNET DC A(FBUF,LEN,NETMOD,DUMMY,NAMFD) ;read net SPRPLY DC A(KBBUF,LEN,ZERO,DUMMY) ;echo reply RDHNUM DC A(FBUF,LEN,@I,TTBUF,NAMFD) ;read HOSTNUMS RDHNAM DC A(KBBUF,LEN,@I,DUMMY,NAMFD) ;read HOSTS RDHOST DC A(KBBUF+2,LEN,@I,HOST,NAMFD) ;again HOSTNM DC A(0,LEN,ZERO,DUMMY) ;echo host name NETMSG DC A(FBUF,LEN,ZERO,DUMMY) ;net error message * SNSLST DC A(SNSBUF,SNSLEN,DUMMY,0) ;$CONTROL SNS *MSINK* args SNSLEN DC H'56' SNSED DC X'00' ;Z => haven't SNS'ed *MSINK* yet COURIER DC X'00' ;NZ => *MSINK* is a Courier (no []) * HSTINF DS X ;NZ => LOOKUP gets WKS & HINFO too * SNSBUF DC C'SNS' SNSMDSET DS X ;=0 for terminals SNSDVNAM DS CL4 ;device name ('N001', &c.) SNSDVTYP DS CL4 ;device type ('VTP ', &c.) SNSCUNAM DS CL4 ;ctrl unit name ('NET0', &c.) SNSCUTYP DS CL4 ;ctrl unit type SNSLAID DS CL4 ;line adapter ID ('DIAL', &c.) SNSTRNAM DS CL24 ;terminal name (yeah right) SNSTRTYP DS CL8 ;term type (Vol. IV) * DS 16C ;space for 4 3-dig numbers (+cnt) INADDR DC X'07494E2D41444452044152504100' ;QNAME=IN-ADDR.ARPA DC X'000C' ;QTYPE=PTR DC X'0001' ;QCLASS=IN ENDINA EQU * * QUERY DC A(QRY,QLEN,ZERO,DUMMY,NAMFD) QLEN DS H ;length of query QRY DC X'0035' ;port 53 DC AL1(&FNDS(1),&FNDS(2),&FNDS(3),&FNDS(4)) ;server DC X'1234' ;handle (who cares) DC X'0100' ;QUERY (RD=1) DC X'0001' ;QDCOUNT (1 question) DC X'0000' ;ANCOUNT (0 answers) DC X'0000' ;NSCOUNT (0 NS authorities) DC X'0000' ;ARCOUNT (0 add'l records) QRYBUF DS 500C ;query goes here * TCPWKS DS F ;TCP WKS's UDPWKS DS F ;UDP WKS's HINFO DS F ;CPU/OS * HELPFD DS F ;help file FDUB ptr RHELP DC A(WNBUF,LEN,ZERO,DUMMY,HELPFD) ;read help file WHELP DC A(WNBUF,LEN,ZERO,DUMMY) ;print help file * TIMLST DC A(TIMKEY,ZERO,CURTIM) ;TIME arg list TIMKEY DC F'14' ;minutes since 03/01/00 00:00 ZERO DC F'0' ;constant 0 * TTRLST DC A(TTBUF,LEN,@I,TTYLIN,TTYFDP) ;read TTY loc FMTSPR DC A(REPORT,LEN,ZERO,DUMMY) ;formatted report * SETLST DC A(WNUNIT,WHO#NAMES) ;assign unit 1 MYNAMES DC C'&WNID:' ;"offical" WHO.NAMES WHO#NAMES DC C'WHO.NAMES ' ;filename DUMDEV DC C'*DUMMY* ' ;use when can't find WHO.NAMES FNDLST DC A(WNBUF,LEN,@MAXLEN,DUMMY,WNUNIT) PNAME DC A(WNBUF+2,LEN,ZERO,DUMMY) WNUNIT DC F'1' ;WHO.NAMES unit # * LILIST DC A(LTYP,LNAM,LBOUT,LREG) ;LOADINFO parm list LTYP DC F'257' ;symbol type = resident system LNAM DC CL8'MMDVLSTL' ;name of symbol LBOUT DS F LREG DS 20F ;output region * * $MOUNT and $CONTROL strings * MNTTCP DC A(NREQ,TCPBB,LTCPBB),X'80',AL3(MOPT) ;MOUNT TCP *BB* MNTUDP DC A(NREQ,UDPBB,LTCPBB),X'80',AL3(MOPT) ;MOUNT UDP *BB* MNTTLN DC A(NREQ,TLNBB,LTLNBB),X'80',AL3(MOPT) ;MOUNT TELNET *BB* NREQ DC F'1' ;1 request TCPBB DC C'TCP *BB*' ;this is it UDPBB DC C'UDP *BB*' ;again for UDP LTCPBB DC Y(L'TCPBB) ;length (of either) TLNBB DC C'TELNET *BB*' ;let the HIM handle TELNET LTLNBB DC Y(L'TLNBB) ;length MOPT DC XL4'E800' ;no messages or prompts * DADDR DC A(0,LEN,NAMFD,CTAREA) DPORT CTRL 'DESTINATION_PORT=79' ;skt 79=:NAME server, 25=SMTP PORTNO EQU CDPORT+17 ;patch socket # at PORTNO CONECT CTRL 'CONNECT' PUSH CTRL 'PUSH' CLOSE CTRL 'CLOSE' WATYPE CTRL 'WRITE_ADDRESS_TYPE=BUFFER' ;fewer CONTROL calls SOCKET CTRL 'SOCKET' ;establish socket TIMER CTRL 'TIMER=5SECONDS' ;timeout * RELBB DC A(CBB,LBB,RELFLG) ;RELEASE arg CBB DC C'*BB*' LBB DC A(L'CBB) RELFLG DC XL4'10' ;no messages BBMNTD DC X'00' ;NZ => *BB* is mounted * CURID DS F ;current nameID or CCID CURDEV DS F ;current device name CURTIM DS F ;curr time (TIME(14,0,CURTIM)) * BBFD DS F ;FDUB ptr for curr data file * DUMMY DS F ;dummy line # buf WSWIT DS X ;NZ => use /W switch on :NAME NAMFD DS F ;:NAME server connection NCMDLN DS H ;length of cmd to :NAME server HNAME DS F ;ptr to host name in server reply PARSTR DS 2F ;addr, len of PAR= parm * UNAMS1 DS 2F ;UNAME save area for R2, R3 UNAMS2 DS F ;UNAME save area for R10 * REGS DS 18F ;R13 save area CTAREA DS 27F ;return area for CONTROL ATNREG DS 18F ;save area for ATTNTRP IPADDR DS 10F ;list of IP addr's to try DS F ;F'0' marks end MX DS 10F ;list of MX records DS F ;F'0' marks end * REPORT DC C' ' ;carriage control REPID DS CL4 ;nameID or CCID DC C' ' REPTIM DC C'Mmm DD/YY HH:MM' ;time of last sighting DC C' from ' REPDEV DS CL4 ;device name DC C' ' REPLOC DS CL80 ;device location * WNCC DC C' ' ;car ctrl when dumping WNBUF WNBUF DS CL80 ;WHO.NAMES buffer * KBBUF DS CL132 ;keyboard buffer * TIMBUF DS 4F ;time buffer (JULGRGTM) * TTYLIN DS F ;ACM:TERMINALS line # TTYFDP DS F ; " FDUB ptr TTBUF DS CL80 ; " buf (FW aligned!) * DS 15C ;space for 255.255.255.255 HNUME EQU * ;end of host number * DS 0H ;halfword-align FBUF DS CL1200 ;file record buffer * HASHT DS 4092F ;space for 1023 entries HASHE DS 4F ;1024th entry * * Record format for the data files. * The line number is the userID, and the line consists * of one or more records of the following form * (the number of records can be obtained from the physical * length of the line). * RECORD DSECT RECID DS F ;nameID or userID (line # is other) RECDEV DS F ;device last seen at RECTIM DS F ;time last seen (from "CALL TIME(14,0,I)") RECLEN EQU 12 ;length of a record * * Entry format of our own hash table. * Offset is taken from low 10 bits of task number. * HASHDS DSECT CCID DS F ;user ID (F'0' if unused) NAMEID DS F ;name ID DEVICE DS F ;*MSOURCE*/*MSINK* device name TASKNO DS H ;task # FLAGS DS H ;random flags HARDWR EQU 1 ;1 => hardwired terminal HASHL EQU 16 ;length of a record * * The task table is always large enough to hold the maximum * allowable number of jobs; unused entries are left blank * (CCID=F'0' or F'-1'). * NBRJBTBL DC Y(size) gives the size of the job table; * this number is 640 at RPI, last time I checked - JMBW 5/24/87. * TASKTAB DSECT TSLOT DS 1X ;slot # (00 to FF, then FF till end) TFLAG DS 1X ;seems to be flag bits (FF => end, *usu.*) TTASK DS H ;task number TJOBNM DS CL8 ;job name DS 60X TUSER DS CL4 ;user ID (+X'48') TPROJ DS CL4 ;project number (+X'4C') DS 16X TNAME DS CL4 ;*UD name ID (+X'60') DS 32X TSTAT DS CL12 ;job status string (sometimes) (+X'84') DS 192X TENTL DS 0C ;total length =X'150' * * Device list entry format: * DEVLST DSECT DEVTYP DS 4C ;device type ('3270', etc.) DEVNAM DS 4C ;device name ('I008', etc.) DS 2C ; ??? DEVOWN DS H ;task # of owner DS 8C ; ??? STUSSY DS A ;Dieter says this is a ptr? DS A ; ??? DEVCON DS A ;ptr to CONSDEVS record DS 4A ; ??? * * MM device list entry format: * MMDSECT DSECT MMTYPE DS CL4 ;connection type ('VTP ', 'X.29', etc.) MMNAME DS CL4 ;port name ('N001' etc.) MMFLAG DS Y ;flags - bit 0 seems to indicate direction MMOWNR DS Y ;owner's task # DS A ;seems to be 0 MMTTAB DS A ;addr of owner's task table entry DS 7A ;seems to be 0 * END BB