2!		PROGRAM		: FINGER.BAS
5!		VERSION		: V1.1
6!		EDIT		: 08
7!		EDIT DATE	: 14-Sep-89
10	EXTEND
11	! &
	&
	&
	!		  C O P Y R I G H T &
	&
	&
  !	  Copyright (C) 1989 by Terence M. Kennedy, &
  !	  All Rights Reserved.
  !	&
  !	&
  !	This software is furnished under a license and may be used and &
  !	copied  only  in accordance with the terms of such license and &
  !	with the  inclusion  of  the  above  copyright  notice.   This &
  !	software  or  any  other copies thereof may not be provided or &
  !	otherwise made available to any other person.  No title to and &
  !	ownership of the software is hereby transferred. &
  !	&
  !	The information in this software is subject to change  without &
  !	notice  and should not be  construed as a commitment by either &
  !	Terence M. Kennedy or Saint Peter's College. &
  !	&
  !******************************************************************* &
	&

20	! &
	&
	&
	!	M O D I F I C A T I O N    H I S T O R Y &
	&
	&
	! VER/ED	EDIT DATE	REASON &
	! T1.0-00	07-Aug-89	Initial coding for field test &
	! T1.0-01	08-Aug-89	Correct errors in help files, add &
	!				fastpath for non-wild lookups in &
	!				fnwild%(), add minimum match length &
	!				for user lookups, add flag to check &
	!				node of sender if desired, get the &
	!				username before opening net link. &
	! T1.0-02	08-Aug-89	Add fastpath in configuration file, &
	!				correct errors in configuration file &
	!				comments, add ability to prevent re- &
	!				porting mail information if desired. &
	! T1.0-03	11-Aug-89	Change program name on the fly to in- &
	!				dicate if local, server or requestor. &
	! V1.0-04	12-Aug-89	Modify escfix$ to also correct the SI &
	!				and SO characters for proper output. &
	! V1.0-05	26-Aug-89	Display LAT dialups a little differ- &
	!				ently, fix terminal types of 43 up &
	!				being off by one. &
	! V1.0-06	28-Aug-89	Fix problem of fingering a specific &
	!				user not working depending on the &
	!				time of login. Ugh. &
	! V1.1-07	10-Sep-89	Add support for aliases and forwarding &
	!				by using information FINMAI gets from &
	!				MAIL$:MAIL.SYS. &
	! V1.1-08	14-Sep-89	Modify to cluster RMS w/ CSPLIB to fix &
	!				virtual address space problem, add &
	!				access read, allow modify so multiple &
	!				copies run properly, fix so logged-out &
	!				jobs are reported as <Logged out>. &
	&
	&

30	! &
	&
	&
	!	V A R I A B L E    U S A G E &
	&
	&
	! VARIABLE	USAGE &
	! a$		Scratch variable for SYS() calls &
	! accmod%	Access mode. 1%=local, 3%=via DECnet &
	! alias$	Flag for whether this username is an alias &
	! any%		Flag for any matching usernames &
	! b$		Scratch variable &
	! buff9$	Buffer for channel #9% &
	! buff11$	Buffer for channel #11% &
	! buff12$	Buffer for channel #12% &
	! buflen$	Length of message buffer received &
	! bypass$	String to XLATE out control characters &
	! c		Floating point CPU time variable &
	! candidate$	Possible string for wildcard match &
	! cim.lla%	Logical link address in connect initiate message &
	! command$	Command line &
	! command.1$	Command line segment &
	! command.2$	Command line segment &
	! day%		Day of month &
	! day.week$(7)	Array of weekday names &
	! detflg%	Flag for detached job &
	! devnam%	Address of monitor device name table &
	! devokb%	Offset of monitor first non-disk device &
	! dow%		Day of week (0%=Sunday) &
	! dsklog%	Address of monitor disk logical table &
	! erno%		Error number &
	! escfix$	String to XLATE ESCs to CHR$(155%)s &
	! fill1$, fill2$, &
	! fill3$	Padding variables for FIELDs &
	! flags%(3%)	Flags for command qualifiers &
	! forward$	Forwarding address for this user &
	! hdrout%	Flag for header already output &
	! i%		Scratch variable &
	! i.retcnt%	Retry count for network read operations &
	! iam$		User and Node for remote Fingers &
	! index%	Element of flags%() that this mask applies to &
	! j%		Scratch variable &
	! job%		Current job number as integer &
	! job$		Current job number as string &
	! job0$		Monitor job information, part I &
	! job1$		Monitor job information, part II &
	! job2$		Monitor job information, part III &
	! jobact%	Total number of active jobs on system &
	! jobcnt%	Number of active jobs found for this user &
	! jobmax%	Maximum number of jobs &
	! jobtyp%	Type of job (interactive, batch, net, etc.) &
	! k%		Scratch variable &
	! l%		Scratch variable &
	! l.host$	Our name for our local host (display only) &
	! l.msg$	Message of the day, or indirect filespec &
	! l.org$	Our organization name (display only) &
	! ljkflg%       Flag to prevent reporting of mail information &
	! locatn$	Location of the user's terminal &
	! m%		Scratch variable &
	! m.count%	New mail message count &
	! m.found%	Flag for any new messages found &
	! m.from$	From: field of a mail message &
	! m.rept$	Work string for mail reporting &
	! m.subj$	Subj: field of a mail message &
	! m.token$	Field tpe of next message header field &
	! maildate$	Date of mail message receipt &
	! mask%		Bit to set/clear in flags%() for qualifier &
	! match$	Username we are comparing argument with &
	! mbox.id$	Mail file verification &
	! mbox.new$	New mail count &
	! mbox.total$	Total mail count &
	! mbox.type$	Mail file verification &
	! mbox.version$	Mail file verification &
	! minwld%	Minimum number of non-wild characters for match &
	! month%	Month of year &
	! month.year$()	Array of 3-character month names &
	! msg$		Message buffer to be returned to invoker &
	! msg.1$	Component of msg$ for complex messages &
	! node$		DECnet node we are fingering (unpadded) &
	! nodreq%	Flag for node name required in mail match &
	! nonwld%	Number of non-wild characters in the name requested &
	! o.retcnt%	Retry count for network write operations &
	! opsys$	Operating system and version information &
	! pattern$	Pattern we are matching against for wildcards &
	! persname$	Personal name from ISAM file &
	! ppn$		Project-Programmer Number from ISAM file &
	! recurs%	Recursion level for alias resolution &
	! qual$		Qualifier we are looking for to set flags%() &
	! r0%, r1$, r2%, &
	! r3%, r4%, r5%, &
	! r6%, r7%, r8%, &
	! r9%		VAX emulation registers (honestly) &
	! reason%	Reason code for connect error &
	! reqd%		Number of required match characters in qualifier &
	! reqd$		Portion of qualifier required for match &
	! router$	Node to send request to if host not known locally &
	! stat%		Status code for connect error &
	! t0		Work variable for uptime computation &
	! ttabl$	String of valid terminal type codes &
	! tttype$	Type of terminal this job is using &
	! u.name$	Personal name of user$ &
	! u.ppn$	PPN expressed in system format &
	! u.prog%	Programmer number component of PPN &
	! u.proj%	Project number component of PPN &
	! user$		User name we are fingering &
	! username$	Username from ISAM file &
	! version$	Version number and release date of this program &
	! where$	Node name of person issuing finger command &
	! who$		User name of person issuing finger command &
	! wild%		Flag for wildcard in username search &
	! year%		Work variable for date computation &
	! yf%		Work variable for date computation &
	! yf2%		Work variable for date computation &
	! zdate%	Work variable for date computation &
	! ztime%	Work variable for date computation &
	&
	&

40	! &
	&
	&
	!	I / O    C H A N N E L    U S A G E &
	&
	&
	! CHANNEL	USAGE &
	! #9%		Configuration file, read on startup, or &
	!		terminal or mail file, read during processing &
	! #10%		Username file (FINGER$:FINGER.DAT) &
	! #11%		Inbound finger links (we are a server) &
	! #12%		Outbound finger links (we are a requestor) &
	&
	&

50	! &
	&
	&
	!	F U N C T I O N    U S A G E &
	&
	&
	! FUNCTION	USAGE &
	! fnactive%	Determine if a job is active on the system &
	! fndatim$	Convert internal date/time to printable data &
	! fngetjob%	Build a line of information about a job &
	! fnheader%	Display job information header &
	! fnmaildate$	Convert mail date/time to printable data &
	! fnppntoname$	Convert PPN to username &
	! fnstate$	Compute job state &
	! fnwild%	Wildcard matching &
	&
	&

60	! &
	&
	&
	!	M A J O R    P R O G R A M    S E C T I O N S &
	&
	&
	! SECTION	USAGE &
	!  1000- 1999	Declarations, RUN trap &
	!  2000- 2999	Finger, no arguments &
	!  3000- 3999   Finger a specific user &
	!  4000- 4999	Finger a wildcarded user &
	! 25000-25999   Function definition &
	! 26000-26999	Parse command qualifiers &
	! 27000-27999	Return a line of output to fingerer &
	! 28000-28999	DECnet communication to finger a remote node &
	! 29000-29999	DECnet communication to respond to remote fingers &
	! 30000-30999	CCL entry point &
	! 31000-31999	Initial setup and initialization code &
	! 32000-32599	Error handling &
	! 32600-32767	Exit processing &
	&
	&

1000	! Entry point if "RUN" &
	&
	dim flags%(3%) &
	\ dim day.week$(7%), month.year$(12%) &
	\ map (indexf) string ppn$=2%, username$=12%, persname$=31%, &
	   forward$=64%, alias$=1%, filler$=18% &
	\ print "?FINGER - Please use the DCL FINGER command." &
	\ goto 32767 &
	! This is not a directly executable program &

2000	! Entry point for local FINGER command &
	&
	gosub 26000 &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 if accmod%=3% &
	\ msg$=version$+chr$(13%)+chr$(10%) &
	\ gosub 27000 if flags%(1%) and 32% &
	\ goto 2050 if (flags%(1%) and 16%) <> 16% &
	\ goto 2010 if accmod%=3% &
	\ msg$="?FINGER - Please use the DCL HELP command for help."+ &
	   chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 32600 &
	! Print the version information if requested. If the user didn't ask &
	! for help, proceed. If user asked for help and access was local, tell &
	! him to use DCL HELP instead. &

2010	open "FINGER$:FINGER.HLP" for input as file #9%, mode 6144%, access &
	   read, allow modify &
	\ goto 2030 &
	! Open the help file, if present. &

2020	msg$="?FINGER - Cannot open help file FINGER$:FINGER.HLP"+chr$(13%)+ &
	   chr$(10%) &
	\ gosub 27000 &
	\ goto 32600 &
	! Print an appropriate error message and exit. &

2030	input line #9%,msg$ &
	\ gosub 27000 &
	\ goto 2030 &
	! Read help lines until we are done. &

2040	close #9% &
	\ goto 32600 &
	! Then close the file and bail out. &

2050	recurs%=10% &
	\ open "FINGER$:FINGER.DAT" for input as file #10%, &
	   organization indexed, &
	   recordsize 128%, &
	   map indexf, &
	   primary key ppn$, &
	   alternate key username$, &
	   mode 4352%, &
	   access read, &
	   allow modify &
	\ i%=instr(1%,command$," ") &
	\ goto 3000 if i% &
	! Allow up to 10 recursions in alias resolution &
	! Open the mail control file &
	! See if a person is being fingered, skip to personal finger if so &

2060	msg$=l.org$+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$=l.host$+", "+opsys$+", "+fndatim$(0%,0%)+", "+ &
	   num1$(jobact%)+" Jobs, "+num1$(jobmax%)+" Max."+ &
	   chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$="Uptime " &
	\ i%=peek(36%)/1000%+2% &
	\ j%=(peek(512%)/1000% <> peek(36%)/1000%) &
	\ j%=635%+((i%/4%*4%)=i%) if j% &
	\ t=(peek(512%)-peek(36%)-j%)*1440.+(peek(38%)-peek(514%)) &
	\ t0=int(t/1440.) &
	\ t=(t-(t0*1440.))*60.+60.-(peek(516%) and 255%) &
	\ t=86400. if t0<0. &
	\ goto 2070 if t0<0. &
	\ msg$=msg$+num1$(t0)+" " if t0<>0. &
	! Print the simple stuff in the header. Compute the uptime. &

2070	if t<0. or t>=86400. then msg$=msg$+"?? ??:??:??" &
	else k%=t/3600. &
	\ msg$=msg$+right(num1$(k%+100%),2%)+":" &
	\ t=t-(k%*3600.) &
	\ k%=t/60. &
	\ msg$=msg$+right(num1$(k%+100%),2%)+":" &
	\ t=t-(k%*60.) &
	\ msg$=msg$+right(num1$(int(t+100%)),2%) &
	! More uptime stuff. &

2080	msg$=msg$+", since "+fndatim$(peek(36%),peek(38%))+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 2120 if (flags%(1%) and 128%) <> 128% &
	\ goto 2120 if l.msg$="" &
	\ goto 2090 if left(l.msg$,1%)="@" &
	\ msg$=l.msg$+chr$(13%)+chr$(10%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 2120 &
	! Print the rest of the uptime stuff. See if we want to do anything &
	! with the local message field. &

2090	l.msg$=right(l.msg$,2%) &
	\ open l.msg$ for input as file #9%, mode 6144%, access read, allow &
	   modify &
	! Open the local message file. &

2100	input line #9,msg$ &
	\ gosub 27000 &
	\ goto 2100 &
	! Read lines from the message file until EOF. &

2110	close #9% &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	! Print the trailing blank line. &

2120	open "FINGER$:FINGER.TRM" for input as file #9%, recordsize 512%, &
	   mode 6144%, access read, allow modify &
	\ field #9%, 512% as buff9$ &
	\ for j%=1% to jobmax% &
	\ goto 2130 if fnactive%(0%,0%,j%)<>1% &
	\ i%=fngetjob%(j%) &
	\ l%=(flags%(1%) and 15%) and i% &
	\ gosub 27000 if len(msg$)>3% and l%<>0% &
	! Get the job information, display it if it's a job we want to see. &

2130	next j% &
	\ close #9% &
	\ close #10% &
	\ goto 32600 &

3000	! The command was to finger a particular user (if we have an exact &
	! match on the username), or to look up a user (if we don't have an &
	! exact match) &
	&
	user$=cvt$$(right(command$,i%+1%),128%) &
	\ u.ppn$=cvt%$(peek(peek(peek(520%)+8%)+24%)) &
	\ who$=fnppntoname$(u.ppn$) &
	\ where$="" &
	\ i%=instr(1%,iam$,"~")
	\ who$=left(iam$,i%-1%) if (accmod%=3% and iam$<>"") &
	\ where$=mid(iam$,i%+1%,len(iam$)) if (accmod%=3% and iam$<>"") &
	\ user$=who$ if user$="." &
	\ i%=instr(1%,user$," ") &
	\ goto 3010 if i%=0% &
	\ msg$="?FINGER - Too many parameters - re-enter command with fewer"+ &
	   " parameters."+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 32600 &
	! Pick out username portion. If more than one, give error message and &
	! exit. &

3010	wild%=(instr(1%,user$,"*") or instr(1%,user$,"?") or &
	   instr(1%,user$,"%")) &
	\ i%=instr(1%,l.host$," ") &
	\ msg$=l.host$ if i%=0% &
	\ msg$=left(l.host$,i%-1%) if i%<>0% &
	\ msg$=msg$+" RSTS/E, "+fndatim$(0%,0%)+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 4000 if wild% &
	\ i%=0% &
	! See if wildcard in username. Print header info. Don't bother looking &
	! in usernames if we had a wildcard. &

3020	get #10%, key #1% eq user$ &
	\ goto 4000 if alias$="S" &
	\ goto 3023 if alias$<>"Y" &
	\ i%=1% &
	\ recurs%=recurs%-1% &
	\ msg$="?FINGER - excessive recursion resolving alias."+chr$(13%)+ &
	   chr$(10%) &
	\ gosub 27000 if recurs%=0% &
	\ goto 4040 if recurs%=0% &
	\ msg$=user$+" is an alias for "+cvt$$(persname$,160%)+chr$(13%)+ &
	   chr$(10%) &
	\ gosub 27000 &
	\ goto 4040 if instr(1%,persname$,"::") &
	\ goto 4040 if instr(1%,persname$,"@") &
	\ user$=cvt$$(persname$,160%) &
	\ goto 3020 &
	! If a system distribution list, treat as wildcard. If not an alias, &
	! process normally. Otherwise resolve alias until it either leaves &
	! this node or recurses more than 10 times. &

3023	msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 if i% &
	! Print a blank line after alias information (if there was any, that &
	! is). &
	\ goto 4000 if user$<>cvt$$(username$,128%) &
	\ u.proj%=ascii(left(ppn$,1%)) &
	\ u.prog%=ascii(mid(ppn$,2%,1%)) &
	\ jobcnt%=0% &
	\ u.name$=cvt$$(persname$,128%) &
	\ msg$=user$+" ["+num1$(u.proj%)+","+num1$(u.prog%)+"] ("+u.name$+ &
	   ") is not logged in."+chr$(13%)+chr$(10%) &
	\ open "FINGER$:FINGER.TRM" for input as file #9%, recordsize 512%, &
	   mode 6144%, access read, allow modify &
	\ field #9%, 512% as buff9$ &
	\ for j%=1% to jobmax% &
	\ k%=fnactive%(u.proj%,u.prog%,j%) &
	\ goto 3025 if k%=0% &
	\ jobcnt%=jobcnt%+1%&
	\ i%=fngetjob%(j%) &
	\ gosub 27000 if len(msg$)>3% &
	! We have a match. Compute the PPN and personal name for this user. &
	! Display the status of any active jobs. If none were found, give &
	! the "not logged in" message. &

3025	next j% &
	\ close #9% &
	\ gosub 27000 if jobcnt%=0% &

3030	msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$=" Default directory: _SY0:["+num1$(u.proj%)+","+ &
	   num1$(u.prog%)+"]"+chr$(13%)+chr$(10%) &
	\ gosub 27000 if flags%(3%) and 8% &
	\ a$=sys(chr$(6%)+chr$(-25%)+chr$(-1%)+chr$(4%)+chr$(u.prog%)+ &
	   chr$(u.proj%)) &
	\ i%=ascii(mid(a$,8%,1%)) &
	\ j%=swap%(cvt$%(mid(a$,9%,2%))) &
	\ msg$=" Last login: " &
	\ msg$=" Logged in since: " if jobcnt%<>0% &
	\ msg$=msg$+fndatim$(j%,swap%(cvt$%(mid(a$,11%,2%))) and 2047%)+" " &
	\ msg$=msg$+"(detached)" if (i%=255% and jobcnt%=0%) &
	\ msg$=msg$+"from KB"+num1$(i%)+":" if (i%<>255% and jobcnt%=0%) &
	\ msg$=" Last login: (none)" if j%=0% &
	\ msg$=msg$+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 3110 if (flags%(3%) and 4%) <> 4% &
	\ goto 3110 if ljkflg%>=2% &
	! Compute the user's default directory and display if desired. Get &
	! and format date/time/KB of last login. See if mail info wanted. &

3040	a$="SY:["+num1$(u.proj%)+","+num1$(u.prog%)+"]MAIL.MAI" &
	\ i%=0% &
	\ open a$ for input as file #9%, mode 12544%, access read, allow &
	   modify &
	\ field #9%, 6% as fill1$, &
		      2% as mbox.version$, &
		      2% as mbox.type$, &
		      2% as mbox.total$, &
		      4% as fill2$, &
		      6% as mbox.id$, &
		      2% as fill3$, &
		      2% as mbox.new$ &
	\ get #9%, record 1% &
	\ i%=swap%(cvt$%(mbox.new$)) if (mbox.id$="FOLDER") and &
	   (mbox.type$=cvt%$(swap%(5%))) and (mbox.version$= &
	   cvt%$(swap%(1%+swap%(3%)))) &
	! Open the user's mail file. Read the new mail count. &

3050	goto 3055 if cvt$$(forward$,160%)="" &
	\ msg$=" Mail is forwarded to: "+cvt$$(forward$,160%)+chr$(13%)+ &
	   chr$(10%) &
	\ gosub 27000 &
	\ goto 3100 &
	! Check for any forwarding in effect. If so, display address and &
	! exit, otherwise do the whole thing. &
	
3055	msg$=" Mail: " &
	\ msg$=msg$+"(no new mail)" if i%=0% &
	\ msg$=msg$+num1$(i%) if i%<>0% &
	\ msg$=msg$+" new message" if i%<>0% &
	\ msg$=msg$+"s" if i%>1% &
	\ msg$=msg$+"." if i%<>0% &
	\ msg$=msg$+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 3100 if ljkflg%>=1% &
	\ goto 3100 if i%=0% &
	\ j%=swap%(cvt$%(mbox.total$)) &
	\ j%=(j%-i%)+1% &
	\ goto 3100 if j%<=0% &
	\ k%=j%/20% &
	\ m%=(((j%-(k%*20%))-1%)*24%)+33% &
	\ field #9%, 512% as buff9$ &
	\ i%=2% &
	\ m.count%=0% &
	! Display the new message count. If 0, just bail out. Otherwise com- &
	! pute the index block and offset for the first new message. Preset &
	! the counter of messages from us to zero. &

3060	get #9%, record i% &
	\ j%=i% &
	\ i%=swap%(cvt$%(mid(buff9$,3%,2%))) &
	\ k%=k%-1% &
	\ goto 3060 if k%<>-1% &
	\ i%=j% &
	! Chase the index blocks until we have the one we want. &

3070	get #9%, record i% &
	\ b$=buff9$+"" &
	\ i%=swap%(cvt$%(mid(b$,3%,2%))) &
	\ for j%=m% to 489% step 24% &
	\ k%=swap%(cvt$%(mid(b$,j%+2%,2%))) &
	\ goto 3100 if k%=0% &
	\ get #9%, record k% &
	\ m.from$="" &
	\ m.subj$="" &
	\ k%=23% &
	! Get the first index record of the mailfile which contains new mail. &
	! Save pointer to forward link. Step through the mail entries, start- &
	! ing at the offset of the first new message. Form first part of info &
	! line. &

3080	l%=swap%(cvt$%(mid(buff9$,k%,2%))) &
	\ m.token$=mid(buff9$,k%+2%,1%) &
	\ m.from$=mid(buff9$,k%+3%,l%-1%) if m.token$=chr$(129%) &
	\ m.subj$=mid(buff9$,k%+3%,l%-1%) if m.token$=chr$(135%) &
	\ k%=k%+l%+2% &
	\ k%=k%+1% if mid(buff9$,k%,1%)=chr$(0%) &
	\ goto 3080 if (m.from$="" or m.subj$="") unless m.token$=chr$(255%) &
	\ m.rept$="  "+fnmaildate$(mid(buff9$,8%,12%))+" Subj: " &
	\ m.subj$="<blank>" if m.subj$="" &
	\ m.rept$=m.rept$+m.subj$ &
	\ m.rept$=left(m.rept$,78%)+chr$(13%)+chr$(10%) &
	\ m.found%=0% &
	\ m.found%=1% if left(m.from$,len(who$)+1%)=who$+" " and nodreq%=0% &
	! If From: field is 'MUMBLE ' &
	\ m.found%=1% if left(m.from$,len(who$)+1%)=who$+" " and nodreq%<>0% &
	   and where$="" &
	! If From: field is 'MUMBLE ' &
	\ m.found%=1% if mid(m.from$,instr(1%,m.from$,"::")+2%,len(who$)+1%)= &
	   who$+" " and nodreq%=0% &
	! If From: field is '<anything>::MUMBLE ' &
	\ m.found%=1% if left(m.from$,len(who$)+len(where$)+3%)= &
	   where$+"::"+who$+" " and nodreq%<>0% &
	! If From: field is 'MUMBLE::MUMBLE ' &
	\ m.count%=m.count%+1% if m.found%=1% &
	\ msg$="  Has the following unread message(s) from you:"+chr$(13%)+ &
	   chr$(10%) &
	\ gosub 27000 if (m.count%=1% and m.found%=1%) &
	\ msg$=m.rept$ &
	\ gosub 27000 if m.found%=1% &
	! Gather the info we need, report results to user. &

3090	next j% &
	\ m%=33% &
	\ goto 3070 if i%<>0% &
	! Get next message in this block. If done here, get next block if &
	! there is one after forcing scan from start of block. &

3100	close #9% &
	! Close the mail file as we're done with it (hooray) &

3110	goto 3150 if (flags%(3%) and 2%) <> 2% &
	\ msg$=" Plan: " &
	\ a$="_SY:["+num1$(u.proj%)+","+num1$(u.prog%)+"]FINGER.PLN" &
	\ open a$ for input as file #9%, mode 4096%, access read, allow modify &
	\ msg$=msg$+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	! Open the user's planfile for input. &

3120	input line #9%, a$ &
	\ a$=xlate(a$,bypass$) if (flags%(3%) and 1%) <> 1% &
	\ msg$=a$ &
	\ gosub 27000 &
	\ goto 3120 &
	! See if bypass is enabled. If it isn't, translate to remove the &
	! control characters. Display the message and loop for another line. &

3130	msg$=msg$+"(no plan file)"+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 3150 &
	! Say the user has no plan file and exit. &

3140	close #9% &
	! Close the plan file and exit. &

3150	close #10% &
	\ goto 32600 &
	! All done, bail out... &

4000	! We either had a wildcarded username or no exact match for the &
	! username. So, try to match any record in the complete database. &
	&
	nonwld%=len(user$) &
	\ for i%=1% to len(user$) &
	\ a$=mid(user$,i%,1%) &
	\ nonwld%=nonwld%-1% if a$="?" &
	\ nonwld%=nonwld%-1% if a$="%" &
	\ nonwld%=nonwld%-1% if a$="@" &
	\ next i% &
	\ goto 4005 if nonwld%>=minwld% &
	\ msg$="?FINGER - Too few non-wild characters in username."+ &
	   chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 4040 &
	! Determine the number of non-wild characters in the request. Compare &
	! with site-specified limit. Complain if too short. &

4005	find #10%, key #1% ge " " &
	! Start looking through the personal name fields &

4010	get #10% &
	\ goto 4010 if alias$="Y" &
	\ match$=cvt$$(persname$,160%) &
	\ goto 4010 if fnwild%(user$,match$)=0% &
	! Get the next record of personal names. If we don't match one, skip &
	! to next personal name. &

4020	msg$=username$+" - "+cvt$$(persname$,128%)+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ any%=any%+1% &
	\ goto 4010 &
	! Build the message string and display it. Increment the count of &
	! matched names and go get another. &

4030	msg$=user$+": No such user."+chr$(13%)+chr$(10%) &
	\ gosub 27000 if any%=0% &
	! Report the non-matching if indeed we didn't match any. &

4040	close #10% &
	\ goto 32600 &
	! All done, bail out. &

25000	! Functions and stuff &
	&
	def* fndatim$(zdate%,ztime%) &
	\ a$=sys(chr$(6%)+chr$(20%)+chr$(zdate%)+chr$(swap%(zdate%)) &
	   +chr$(1%)+chr$(swap%(1%))+string$(10%,0%)+chr$(ztime%) &
	   +chr$(swap%(ztime%))+chr$(1%)+chr$(swap%(1%))+string$(10%,0%)) &
	\ year%=val(mid(a$,7%,2%))+1900% &
	\ month%=val(mid(a$,10%,2%)) &
	\ day%=val(mid(a$,13%,2%)) &
	\ yf%=year%+(month%-14%)/12% &
	\ yf2%=yf%-(int(yf%/100%))*100% &
	\ dow%=((13%*(month%+10%-(month%+10%)/13%*12%)-1%)/5% &
	   +day%+77%+5%*yf2%/4% &
	   +yf%/400% &
	   -yf%/100%*2%) &
	\ dow%=dow%-(int(dow%/7%))*7% &
	\ fndatim$=day.week$(dow%)+", "+num1$(day%)+"-"+month.year$(month%-1%) &
	   +"-19"+mid(a$,7%,2%)+" "+mid(a$,21%,5%) &
	\ fnend &
	! Isn't this ugly? &
	! Get system date, pervert to sep. month, day, year values. &
	! Incant to get correct day of week (you don't want to know) &
	! and return w/ lookup text. &

25010	def* fnmaildate$(maildate$) &
	\ year%=val(left(maildate$,4%)) &
	\ month%=val(mid(maildate$,5%,2%)) &
	\ day%=val(mid(maildate$,7%,2%)) &
	\ yf%=year%+(month%-14%)/12% &
	\ yf2%=yf%-(int(yf%/100%))*100% &
	\ dow%=((13%*(month%+10%-(month%+10%)/13%*12%)-1%)/5% &
	   +day%+77%+5%*yf2%/4% &
	   +yf%/400% &
	   -yf%/100%*2%) &
	\ dow%=dow%-(int(dow%/7%))*7% &
	\ fnmaildate$=day.week$(dow%)+", "+num1$(day%)+"-"+ &
	   month.year$(month%-1%)+"-"+left(maildate$,4%)+" "+ &
	   mid(maildate$,9%,2%)+":"+mid(maildate$,11%,2%) &
	\ fnend &
	! Like fndatim$, but for Mail-11 internal format dates. &

25020	def* fnppntoname$(u.ppn$) &
	\ a$="<Unknown>" &
	\ get #10%, key #0% eq u.ppn$ &
	\ a$=cvt$$(username$,128%) &
	\ a$="<Logged out>" if u.ppn$=chr$(0%)+chr$(0%) &
	! Look up PPN in database. Default to "<Unknown>" if not present, &
	! or "<Logged out>" if the job is running under PPN [0,0]. &

25030	fnppntoname$=a$ &
	\ fnend &
	! Set the returned string and exit. &

25040	def* fnwild%(pattern$,candidate$) &
	\ r0%=0% &
	\ goto 25045 if wild%<>0% &
	\ goto 25080 if instr(1%,candidate$,pattern$)<>0% &
	\ goto 25100 &
	! See if a wildcard is present. If not, do fast lookup. &

25045	pattern$="*"+pattern$+"*" &
	\ r4%=len(pattern$) &
	\ r2%=len(candidate$) &
	\ r5%=1% &
	\ r3%=1% &
	\ r6%=0% &

25050	r4%=r4%-1% &
	\ goto 25070 if r4%<0% &
	\ r1$=mid(pattern$,r5%,1%) &
	\ r5%=r5%+1% &
	\ goto 25090 if r1$="*" &
	\ r2%=r2%-1% &
	\ goto 25100% if r2%<0% &
	\ a$=mid(candidate$,r3%,1%) &
	\ r3%=r3%+1% &
	\ goto 25050 if r1$=a$ &
	\ goto 25050 if r1$="%" &
	\ goto 25050 if r1$="?" &

25060	r6%=r6%-1% &
	\ goto 25100 if r6%<0% &
	\ r7%=r7%+1% &
	\ r2%=r6% &
	\ r3%=r7% &
	\ r4%=r8% &
	\ r5%=r9% &
	\ goto 25050 &

25070	goto 25060 if r2%<>0% &

25080	r0%=1% &
	\ goto 25100 &

25090	goto 25080 if r4%=0% &
	\ r6%=r2% &
	\ r7%=r3% &
	\ r8%=r4% &
	\ r9%=r5% &
	\ goto 25050 &

25100	fnwild%=r0% &
	\ fnend &
	! This function returns the match status of a pattern in a candidate. &
	! It was lifted from VMS FINGER's WILD.MAR routine, which sort of &
	! makes this a VAX in your 11 (or is that a turkey in your tank)? &

25110	def* fnactive%(u.proj%,u.prog%,j%) &
	\ fnactive%=0% &
	\ job0$=sys(chr$(6%)+chr$(26%)+chr$(j%)+chr$(0%)) &
	\ job1$=sys(chr$(6%)+chr$(26%)+chr$(j%)+chr$(1%)) &
	\ job2$=sys(chr$(6%)+chr$(26%)+chr$(j%)+chr$(2%)) &
	\ fnactive%=1% if (u.proj%=ascii(mid(job0$,22%,1%)) and &
	    u.prog%=ascii(mid(job0$,21%,1%))) &
	\ fnactive%=1% if u.proj%+u.prog%=0% &
	! See if user u.proj%,u.prog% is active on job j%. Return active if &
	! we are asking about any PPN as well. &

25120	fnend &
	! Return status to caller &

25130	def* fnheader% &
	\ msg$="" &
	\ msg$=msg$+"Job " if flags%(2%) and 1% &
	\ msg$=msg$+"Username     " if flags%(2%) and 2% &
	\ msg$=msg$+"  PPN   " if flags%(2%) and 4% &
	\ msg$=msg$+"Personal name        " if flags%(2%) and 8% &
	\ msg$=msg$+"Progrm " if flags%(2%) and 16% &
	\ msg$=msg$+"Term   " if flags%(2%) and 32% &
	\ msg$=msg$+"Login " if flags%(2%) and 64% &
	\ msg$=msg$+" CPU  " if flags%(2%) and 128% &
	\ msg$=msg$+"ST " if flags%(2%) and 256% &
	\ msg$=msg$+"Size  " if flags%(2%) and 512% &
	\ msg$=msg$+"Location         " if flags%(2%) and 1024% &
	\ msg$=msg$+"TTType  " if flags%(2%) and 2048% &
	\ msg$=msg$+"Pri/Rb " if flags%(2%) and 4096% &
	\ msg$=msg$+"RTS    " if flags%(2%) and 8192% &
	\ msg$=msg$+chr$(13%)+chr$(10%) &
	\ gosub 27000 if len(msg$)>3% &
	\ hdrout%=1% &
	\ fnend &
	! Display the status header &

25140	def* fngetjob%(j%) &
	\ u.proj%=ascii(mid(job0$,22%,1%)) &
	\ u.prog%=ascii(mid(job0$,21%,1%)) &
	\ u.ppn$=cvt%$(swap%(u.proj%)+u.prog%) &
	\ user$=fnppntoname$(u.ppn$) &
	\ u.name$=cvt$$(persname$,128%) &
	\ i%=ascii(mid(job2$,15%,1%)) &
	\ jobtyp%=1% if i%<2% &
	\ jobtyp%=2% if i%=2% &
	\ jobtyp%=4% if i%>3% &
	\ jobtyp%=8% if (u.proj%=1% and u.prog%=2%) &
	\ fngetjob%=jobtyp% &
	\ i%=fnheader% if hdrout%=0% &
	\ msg$="" &
	\ goto 25150 if (flags%(2%) and 1%) <> 1% &
	\ msg$=msg$+" " if j%<10% &
	\ msg$=msg$+num1$(j%)+"  " &
	! Look up the PPN and username of this job. Compute the job type. &
	! Display the header if required. Add the job number to the string &
	! if we are displaying it. &

25150	msg$=msg$+user$+string$(13%-len(user$),32%) if flags%(2%) and 2% &
	\ goto 25160 if (flags%(2%) and 4%) <> 4% &
	\ msg$=msg$+" " if u.proj%<10% &
	\ msg$=msg$+" " if u.proj%<100% &
	\ msg$=msg$+num1$(u.proj%)+","+num1$(u.prog%) unless &
	   u.proj%+u.prog%=0% &
	\ msg$=msg$+"*,*" if u.proj%+u.prog%=0% &
	\ msg$=msg$+" " if u.prog%<10% &
	\ msg$=msg$+" " if u.prog%<100% &
	\ msg$=msg$+" " &
	! Tack on username if required. Add the PPN to the string if we are &
	! displaying it. &

25160	msg$=msg$+u.name$+string$(21%-len(u.name$),32%) if flags%(2%) and 8% &
	\ msg$=msg$+rad$(swap%(cvt$%(mid(job0$,17%,2%))))+ &
	   rad$(swap%(cvt$%(mid(job0$,19%,2%))))+" " if flags%(2%) and 16% &
	\ i%=ascii(mid(job0$,4%,1%)) &
	\ detflg%=0% &
	\ detflg%=1% if i%>127% &
	\ goto 25170 if (flags%(2%) and 32%) <> 32% &
	\ msg$=msg$+"Det   " if detflg%=1% &
	\ msg$=msg$+"KB"+num1$(i%)+":" if detflg%=0% &
	\ msg$=msg$+" " if i%<10% &
	\ msg$=msg$+" " if i%<100% &
	\ msg$=msg$+" " &
	! Tack on the personal name if desired. Tack on the program name if &
	! desired. Tack on the KB number if desired. &

25170	goto 25200 if (flags%(2%) and 64%) <> 64% &
	\ i%=swap%(cvt$%(mid(job0$,9%,2%))) &
	\ j%=peek(514%) &
	\ k%=i%+j% &
	! Skip this mess if login time not desired. Otherwise get connect &
	! time, time now, and sum them &

25180	goto 25190 if k%<1441% &
	\ k%=k%-1440% &
	\ goto 25180 &
	! Normalize the time. &

25190	msg$=msg$+"      " if detflg%=1% &
	\ a$=sys(chr$(6%)+chr$(20%)+chr$(0%)+chr$(swap%(0%)) &
	   +chr$(1%)+chr$(swap%(1%))+string$(10%,0%)+chr$(k%) &
	   +chr$(swap%(k%))+chr$(1%)+chr$(swap%(1%))+string$(10%,0%)) &
	\ msg$=msg$+mid(a$,21%,5%)+" " if detflg%=0% &
	! Convert the time value to 24-hour format, unless the job is de- &
	! tached in which case we blank it out. &

25200	goto 25210 if (flags%(2%) and 128%) <> 128% &
	\ c=swap%(cvt$%(mid(job0$,7%,2%))) &
	\ c=c+65536. if c<0. &
	\ c=c+65536.*ascii(mid(job0$,16%,1%)) &
	\ c=c/10. &
	\ msg$=msg$+right(num1$((c/60.)+100000.),2%)+" " if c>5999. &
	\ goto 25210 if c>5999. &
	\ i%=c &
	\ j%=i%/60% &
	\ k%=i%-(j%*60%) &
	\ msg$=msg$+right(num1$(j%+100%),2%)+":"+right(num1$(k%+100%),2%)+" " &
	! Skip CPU time if not wanted. Determine the time in seconds and &
	! format it as '99999' if it won't fit as '99:59', otherwise format &
	! as '99:59' &

25210	msg$=msg$+fnstate$+" " if flags%(2%) and 256% &
	\ goto 25220 if (flags%(2%) and 512%) <> 512% &
	\ i%=ascii(mid(job1$,13%,1%)) &
	\ j%=ascii(mid(job1$,19%,1%)) &
	\ msg$=msg$+" " if i%<10% &
	\ msg$=msg$+num1$(i%)+"/" &
	\ msg$=msg$+" " if j%<10% &
	\ msg$=msg$+num1$(j%)+" " &
	! Tack on job state if desired. Tack on current/maximum size if &
	! desired. &

25220	locatn$="                " &
	\ locatn$="- Batch queue - " if jobtyp%=2% &
        \ locatn$="- DECnet -      " if jobtyp%=4% &
	\ locatn$="- Detached -    " if detflg%=1% &
	\ tttype$="       " &
	\ goto 25240 if left(locatn$,1%)<>" " &
	\ i%=ascii(mid(job0$,4%,1%))+8% &
	\ j%=i%/8% &
	\ k%=(i%-(j%*8%))*64% &
	\ get #9%, record j%+1% &
	\ locatn$=mid(buff9$,k%+4%,16%) &
	\ tttype$=mid(buff9$,k%+20%,7%) &
	\ a$=sys(chr$(6%)+chr$(22%)+chr$(12%)+chr$(6%)+chr$(0%)+chr$(0%)+ &
	   chr$(i%-8%)+string$(3%,0%)+chr$(9%)+string$(29%,0%)) &
	! Preset location and terminal type to spaces. If detached, bail &
	! out. Otherwise get the record we want (add 4 for a header). &
	! Make a try for LAT information. &

25230	i%=ascii(mid(buff9$,3%,1%)) &
	\ b$=mid(buff9$,4%,i%) &
	\ j%=ascii(mid(buff9$,i%+4%,1%)) &
	\ locatn$=mid(buff9$,i%+5%,j%)+" "+b$ &
	\ locatn$="Dialup "+right(b$,8%) if left(b$,7%)="DIALUP." &
	\ locatn$=left(locatn$,16%) if len(locatn$)>16% &
	\ locatn$=locatn$+string$(16%-len(locatn$),32%) &
	! Construct a LAT location field &

25240	msg$=msg$+locatn$+" " if flags%(2%) and 1024% &
	\ goto 25250 if (flags%(2%) and 2048%) <> 2048% &
	\ msg$=msg$+tttype$+" " if tttype$<>"Unknown" &
	\ goto 25250 if tttype$<>"Unknown" &
	\ a$=sys(chr$(6%)+chr$(16%)+chr$(1%)+mid(job0$,4%,1%)+string$(26%,0%)) &
	\ i%=ascii(mid(a$,5%,1%)) &
	\ goto 25250 if i%<1% &
	\ goto 25250 if i%>50% &
	\ msg$=msg$+mid(tttabl$,(i%-1%)*7%+1%,7%)+" " &
	! Tack on location field. Bail out if terminal type not desired, &
	! otherwise tack on user text if not 'Unknown', else get type code &
	! from system and convert to type. &

25250	goto 25260 if (flags%(2%) and 4096%) <> 4096% &
	\ b$=num1$(ascii(mid(job1$,17%,1%))*256%/256%) &
	\ msg$=msg$+string$(3%-len(b$),32%)+b$+"/" &
	\ i%=ascii(mid(job1$,18%,1%)) &
	\ msg$=msg$+num1$(i%) &
	\ msg$=msg$+" " if i%<10% &
	\ msg$=msg$+" " &
	! Skip this if PRI/RB not desired. Otherwise tack on priority and &
	! runburst information. &

25260	goto 25270 if (flags%(2%) and 8192%) <> 8192% &
	\ msg$=msg$+rad$(swap%(cvt$%(mid(job0$,27%,2%))))+ &
	   rad$(swap%(cvt$%(mid(job0$,29%,2%)))) &
	! Skip this if RTS not desired. Otherwise tack RTS info on the end. &

25270	msg$=msg$+chr$(13%)+chr$(10%) &
	\ fnend &
	! Terminate the output line properly &

25280	def* fnstate$ &
	\ i%=swap%(cvt$%(mid(job1$,11%,2%))) &
	\ b$="RN" &
	\ goto 25320 if (i% and (swap%(cvt$%(mid(job1$,9%,2%)))))<>0% &
	\ b$="RS" &
	\ goto 25320 if (swap%(cvt$%(mid(job1$,15%,2%))))=0% and &
	   ascii(mid(job1$,14%,1%))=196% &
	\ i%=i% and (not 16384%) if (i% and (not 16384%))<>0% &
	\ b$="BF" &
	\ goto 25320 if (i% and 16384%)<>0% &
	\ b$="SL" &
	\ goto 25290 if (i% and 8192%)=0% &
	\ b$="SR" if ascii(mid(job1$,7%,1%))=5% &
	\ goto 25320 &

25290	b$="FP" &
	\ goto 25320 if (i% and 4096%)<>0% &
	\ b$="TT" &
	\ goto 25320 if (i% and 2048%)<>0% &
	\ b$="HB" &
	\ goto 25320 if i%=0% &
	\ j%=2% &
	\ goto 25310 if i%=2% &

25300	k%=peek(peek(swap%(cvt$%(mid(job1$,25%,2%))))+ &
	   ascii(mid(job1$,20%,1%))) &
	\ j%=0% &
	\ j%=peek(k%) and 255% if k%<>0% &
	\ if j%=0% then l%=peek(peek(k%+8%)-4%) and 255% &
	\ b$=cvt%$(swap%(peek(dsklog%+(l%*10%)+6%))) &
	\ b$="??" if len(cvt$$(b$,-2%))=0% or k%=0% &
	\ goto 25320 &

25310	b$=cvt%$(swap%(peek(devnam%+devokb%+j%-2%))) &
	\ b$="^C" if swap%(cvt$%(mid(job1$,21%,2%)))<0% if j%=2% &

25320	fnstate$=b$ &
	\ fnend &
	! This function returns the 2-character job state. &

26000	! Routine to parse command qualifiers &
	! Entered with command$ set to the command line, flags%() undefined &
	! Returns with qualifiers stripped, flags%() set appropriately, and &
	! iam$ set to the originating user (if applicable). &
	&
	iam$="" &
	! Initialize flags &

26010	i%=instr(1%,command$,"/") &
	\ return if i%=0% &
	\ restore &
	\ j%=instr(i%+1%,command$,"/") &
	\ k%=instr(i%+1%,command$," ") &
	\ j%=32767% if j%=0% &
	\ k%=32767% if k%=0% &
	\ j%=k% if k%<j% &
	\ j%=len(command$)+1% if j%=0% &
	\ command.1$=cvt$$(mid(command$,i%+1%,j%-i%-1%),416%) &
	\ command$=cvt$$(left(command$,i%-1%)+right(command$,j%), 152%) &
	! See if any more qualifiers on line. If not, exit. &
	! Isolate qualifier and remove from command line &

26020	! here we would look up the qualifier &
	&
	read qual$,mask%,index% &
	\ goto 26030 if qual$="EOF" &
	\ reqd%=instr(1%,qual$,"*")-1% &
	\ reqd$=left(qual$,reqd%) &
	\ goto 26040 if left(command.1$,reqd%)=reqd$ &
	\ goto 26050 if left(command.1$,reqd%+2%)="NO"+reqd$ &
	\ goto 26020 &
	! Look up next qualifier. If no more, go complain. &
	! Otherwise, see if required part matches, dispatch on asserted &
	! or negated qualifiers if matched. &
	! Otherwise go try again &

26030	msg$="?FINGER - Unrecognized command qualifier '/"+command.1$+"'."+ &
	   chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 26010 &
	! Print our error message, then go see if any other qualifiers can &
	! be parsed. &

26040	reqd$=reqd$+mid(qual$,reqd%+2%,len(qual$)) &
	\ goto 26060 if left(command.1$,5%)='IAM="' &
	\ goto 26030 if len(command.1$) > len(reqd$) &
	\ goto 26030 if left(reqd$,len(command.1$)) <> command.1$ &
	\ flags%(index%)=flags%(index%) or mask% &
	\ goto 26010 &
	! If this is the special /IAM qualifier, go process it specially. &
	! Here we have a partial match for an asserted qualifier - see if the &
	! rest matches. If not, exit. &
	! otherwise, OR in the new qualifier bitmask &
	! and go pick up another &

26050	reqd$=reqd$+mid(qual$,reqd%+2%,len(qual$)) &
	\ goto 26030 if len(command.1$) > len(reqd$)+2% &
	\ goto 26030 if left(reqd$,len(command.1$)-2%) <> mid(command.1$,3%, &
	   len(command.1$)) &
	\ flags%(index%)=flags%(index%) and (not(mask%)) &
	\ goto 26010 &
	! Here we have a partial match for a deasserted qualifier - see if the &
	! rest matches. If not, exit. &
	! otherwise, AND out the new qualifier bitmask &
	! and go pick up another &

26060	command.1$=right(command.1$,6%) &
	\ goto 26030 if right(command.1$,len(command.1$))<>'"' &
	\ goto 26010 if accmod%=1% &
	\ iam$=left(command.1$,len(command.1$)-1%) &
	\ flags%(index%)=flags%(index%) or mask% &
	\ goto 26010 &
	! Make sure IAM is a quoted string. If not network access, just ig- &
	! nore it. &

26070	! Data for qualifiers - format is qualifier, onmask, index &
	&
	data  "IN*TERACTIVE",	1,	1, &
	      "BA*TCH",		2,	1, &
	      "SU*BPROCESS",	0,	0, &
	      "NE*TWORK",	4,	1, &
	      "SY*STEM",	8,	1, &
	      "AL*L",		15,	1, &
	      "H*ELP",		16,	1, &
	      "V*ERSION",	32,	1, &
	      "IAM=*",		64,	1, &
	      "ME*SSAGE",	128,	1, &
	      "J*OB",		1,	2, &
	      "PI*D",		1,	2, &
	      "PRO*CESSNAME",	2,	2, &
	      "U*SERNAME",	2,	2, &
	      "PP*N",		4,	2, &
	      "PE*RSONALNAME",	8,	2, &
	      "IM*AGENAME",	16,	2, &
	      "TE*RMINAL",	32,	2, &
	      "LOG*INTIME",	64,	2, &
	      "C*PUTIME",	128,	2, &
	      "ID*LETIME",	0,	2, &
	      "ST*ATE",		256,	2, &
	      "SI*ZE",		512,	2, &
	      "LOC*ATION",	1024,	2, &
	      "TT*TYPE",	2048,	2, &
	      "SW*APPED",	0,	2, &
	      "PRI*ORITY",	4096,	2, &
	      "R*UNTIMESYSTEM", 8192,	2, &
	      "F*ULL",		16383,	2, &
	      "BY*PASS",	1,	3, &
	      "PL*AN",		2,	3, &
	      "MA*IL",		4,	3, &
	      "AR*EA",		8,	3, &
	      "EOF",		0,	0 &

27000	! Routine to ship messages back to our caller &
	&
	goto 27010 if accmod%=3% &
	\ print xlate(msg$,escfix$); &
	\ return &
	! Determine method. If local, just stuff it out to terminal &

27010	o.retcnt%=0%
27020	field #11%, len(msg$) as buff11$ &
	\ lset buff11$=msg$ &
	\ a$=sys(chr$(6%)+chr$(22%)+chr$(-5%)+chr$(1%)+string$(6%,0%)+ &
	     chr$(11%)+chr$(0%)+cvt%$(swap%(len(msg$)))+cvt%$(swap%(0%))+ &
	     string$(4%,0%)+chr$(3%)+string$(13%,0%)+chr$(0%)+ &
	     string$(5%,0%)) &
	\ return &
	! Remote, output it across the DECnet link. &

28000	! Entry point for issuing remote FINGER command &
	&
	a$=sys(chr$(6%)+chr$(-10%)+"FINREQ") &
	\ call name &
	\ open "NL:" as file #12%, recordsize 512% &
	\ job%=peek(518%)/2% &
	\ job$=mid(num1$(job%+100%),2%,2%) &
	\ u.ppn$=cvt%$(peek(peek(peek(520%)+8%)+24%)) &
	\ open "FINGER$:FINGER.DAT" for input as file #10%, &
	   organization indexed, &
	   recordsize 128%, &
	   map indexf, &
	   primary key ppn$, &
	   alternate key username$, &
	   mode 4352%, &
	   access read, &
	   allow modify &
	\ user$=fnppntoname$(u.ppn$) &
	\ close #10% &

28010	a$=sys(chr$(6%)+chr$(22%)+chr$(1%)+chr$(0%)+"FIN."+job$+ &
	   string$(10%,0%)+chr$(117%)+chr$(12%)+string$(2%,0%)+ &
	   chr$(255%)+chr$(1%)+string$(2%,0%)+chr$(1%)+string$(5%,0%)+ &
	   chr$(1%)) &
	! Declare Object 117 receiver as RIB #1 &

28020	msg$="["+node$+chr$(255%) &
	\ gosub 27000 &
	\ field #12, 172% as buff12$ &
	\ lset buff12$=node$+string$(6%-len(node$),32%)+chr$(0%)+ &
	   chr$(117%)+chr$(1%)+string$(17%,0%)+string$(146%,0%) &
	! Prepare Connect Initiate message &

28030	a$=sys(chr$(6%)+chr$(22%)+chr$(-2%)+chr$(1%)+string$(6%,0%)+ &
	   chr$(12%)+chr$(0%)+cvt%$(swap%(172%))+cvt%$(swap%(0%))+ &
	   string$(8%,0%)+cvt%$(swap%(512%))+string$(8%,0%)+chr$(1%)+ &
	   string$(5%,0%)) &
	! Send Connect Initiate message on RIB #1 &

28040	i.retcnt%=0%
28050	a$=sys(chr$(6%)+chr$(22%)+chr$(2%)+chr$(9%)+chr$(0%)+chr$(0%)+ &
	   string$(4%,0%)+chr$(12%)+chr$(0%)+cvt%$(swap%(512%))+ &
	   cvt%$(swap%(0%))+string$(10%,0%)+cvt%$(swap%(15%))+string$(6%,0%)+ &
	   chr$(1%)+string$(5%,0%)) &
	\ stat%=ascii(mid(a$,3%,1%)) &
	\ reason%=swap%(cvt$%(mid(a$,23%,2%))) &
	\ goto 28060 if stat%=253% &
	\ erno%=256%+reason% &
	\ goto 28120 if stat%=252% &
	\ msg$=": link failed]"+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$="?FINGER - Status code="+num1$(stat%)+", reason code="+ &
	   num1$(reason%)+"."+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 28100 &
	! Clear retry count and sleep waiting for a response. When we get a &
	! response, look at status byte. If all is ok, proceed, else report &
	! the error and bail out. &

28060	msg$=".DECnet]"+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 28070 if accmod%<>1% &
	\ a$=sys(chr$(6%)+chr$(22%)+chr$(-19%)+chr$(1%)) &
	\ a$=cvt$$(mid(a$,5%,6%),128%) &
	\ command$=command$+'/IAM="'+user$+'~'+a$+'"' &
	! Print the connect message. Skip next if not originating node. Get &
	! user's username from mail database. Get node name from DECnet. Tack &
	! onto command line. &

28070	field #12%, len(command$)+2% as buff12$ &
	\ lset buff12$=command$+chr$(13%)+chr$(10%) &
	\ a$=sys(chr$(6%)+chr$(22%)+chr$(-5%)+chr$(1%)+string$(6%,0%)+ &
	   chr$(12%)+chr$(0%)+cvt%$(swap%(len(buff12$)))+cvt%$(swap%(0%))+ &
	   string$(4%,0%)+chr$(3%)+string$(13%,0%)+chr$(1%)) &
	! Send the finger command to the remote node on RIB #1 &

28080	i.retcnt%=0%
28090	a$=sys(chr$(6%)+chr$(22%)+chr$(2%)+chr$(9%)+chr$(0%)+chr$(0%)+ &
	   string$(4%,0%)+chr$(12%)+chr$(0%)+cvt%$(swap%(512%))+ &
	   cvt%$(swap%(0%))+string$(10%,0%)+cvt%$(swap%(15%))+ &
	   string$(6%,0%)+chr$(1%)+string$(5%,0%)) &
	\ goto 28100 if mid(a$,3%,1%)=chr$(248%) &
	\ buflen%=swap%(cvt$%(mid(a$,13%,2%))) &
	\ field #12, buflen% as buff12$ &
	\ msg$=buff12$ &
	\ gosub 27000 &
	\ goto 28080 &
	! Receive network data message. If it was link disconnect, go to &
	! our exit routine, else report the message to the user and go &
	! back for more. &

28100	a$=sys(chr$(6%)+chr$(22%)+chr$(0%)+chr$(0%)+string$(30%,0%)+ &
	   chr$(1%)+string$(5%,0%)) &
	! Remove our receiver &

28110	close #12% &
	\ goto 32600 &
	! Close and exit. &

28120	goto 28130 if (router$<>"" and node$<>router$ and &
	   (erno%=6% or erno%=31% or erno%=258%)) &
	\ msg$=": link failed]"+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ msg$="?FINGER - " &
	\ msg.1$="Unknown error code "+num1$(erno%)+" at line "+num1$(erl)+ &
	         " in job "+num1$(peek(518%)/2%) &
	\ msg.1$="No such node defined" if erno%=6% or erno%=31% or erno%=258% &
	\ msg.1$="Remote node is not currently reachable" if erno%=14% or &
	   erno%=22% or erno%=259% or erno%=295% &
	\ msg.1$="Network unavailable" if erno%=62% or erno%=66% &
	\ msg.1$="No FINGER server" if erno%=260% &
	\ msg.1$="Link timeout for node "+node$ if erno%=512% &
	\ msg$=msg$+msg.1$+"."+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 28100 &
	! If no such node, we have a router node, and router wasn't the node &
	!   we were trying for, re-issue command through router node &
	! Construct a plausible error message and display it &

28130	a$=sys(chr$(6%)+chr$(22%)+chr$(-19%)+chr$(1%)) &
	\ a$=cvt$$(mid(a$,5%,6%),128%) &
	\ goto 28140 if a$<>router$ &
	\ router$="" &
	\ goto 28120 &
	! Get local host node name, compare with router host node name to &
	! prevent infinite looping. If same, zap router entry and go give &
	! the regular error message after all &

28140	msg$=" via routing host "+router$+"]"+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ command$=command$+"@"+node$ &
	\ node$=router$ &
	\ goto 28020 &
	! Re-issue command using routing host &

29000	! Network entry point &
	&
	a$=sys(chr$(6%)+chr$(-10%)+"FINSRV") &
	\ call name &
	\ open "NL:" as file #11%, recordsize 512% &
	\ on error goto 32000 &
	\ job%=peek(518%)/2% &
	\ job$=mid(num1$(job%+100%),2%,2%) &
	! Change our program name to indicate server. &

29010	a$=sys(chr$(6%)+chr$(22%)+chr$(1%)+chr$(0%)+"FIN$"+job$+ &
	   string$(10%,0%)+chr$(117%)+chr$(12%)+chr$(0%)+chr$(0%)+ &
	   chr$(255%)+chr$(1%)+string$(2%,0%)+chr$(1%)+string$(5%,0%)+ &
	   chr$(0%)) &
	! Declare object 117 receiver &

29020	a$=sys(chr$(7%)) &

29030	a$=sys(chr$(6%)+chr$(22%)+chr$(2%)+chr$(9%)+chr$(0%)+ &
	   chr$(0%)+string$(4%,0%)+chr$(11%)+chr$(0%)+ &
	   cvt%$(swap%(512%))+cvt%$(swap%(0%))+string$(10%,0%)+ &
	   cvt%$(swap%(10%))+string$(6%,0%)+chr$(0%)+string$(7%,0%)) &
	\ cim.lla%=swap%(cvt$%(mid(a$,5%,2%))) &
	! Receive a [connect initiate] message, extract the parts we need &

29040	a$=sys(chr$(6%)+chr$(22%)+chr$(-3%)+chr$(1%)+ &
	   cvt%$(swap%(cim.lla%))+string$(4%,0%)+chr$(0%)+chr$(0%)+ &
	   cvt%$(swap%(0%))+cvt%$(swap%(0%))+string$(8%,0%)+ &
	   cvt%$(swap%(512%))+string$(14%,0%)) &
	! Send connect confirm message &

29050	i.retcnt%=0%
29060	a$=sys(chr$(6%)+chr$(22%)+chr$(2%)+chr$(9%)+chr$(0%)+ &
	   chr$(0%)+string$(4%,0%)+chr$(11%)+chr$(0%)+ &
	   cvt%$(swap%(512%))+cvt%$(swap%(0%))+string$(10%,0%)+ &
	   cvt%$(swap%(10%))+string$(6%,0%)+chr$(0%)+string$(7%,0%)) &
	\ field #11%, swap%(cvt$%(mid(a$,13%,2%)))-2% as buff11$ &
	\ command$=cvt$$(buff11$,128%) &
	\ accmod%=3% &
	\ goto 31000 &
	! Receive network data message containing finger command &

30000	! CCL entry point &
	&
	on error goto 32000 &
	\ a$=sys(chr$(6%)+chr$(-7%)) &
	\ command$=sys(chr$(7%)) &
	\ accmod%=1% &
	\ goto 31000 &
	! Set up error trap &
	! Set up ^C trap &
	! Get command line from local user and go to command processing code &

31000	! Initial command processing &
	&
	version$="RSTS/E Finger: Version V1.1-08 of 14-Sep-1989" &
	\ bypass$="........."+chr$(9%)+chr$(10%)+".."+chr$(13%)+ &
	   ".................. !"+chr$(34%)+"#$%&'()*+,-./"+ &
	   "0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ" + &
	   "[/]^_`abcdefghijklmnopqrstuvwxyz{|}~." &
	\ escfix$="." &
	\ escfix$=escfix$+chr$(i%) for i%=1% to 13% &
	\ escfix$=escfix$+chr$(142%)+chr$(143%) &
	\ escfix$=escfix$+chr$(i%) for i%=16% to 26% &
	\ escfix$=escfix$+chr$(155%) &
	\ escfix$=escfix$+chr$(i%) for i%=28% to 31% &
	\ escfix$=escfix$+right(bypass$,33%) &
	\ tttabl$="UnknownLA36   VT52   VT55   LA180S VT100  LA120  LA12   "+ &
	   "LA100  LA34   LA38   LA50   VT101  VT102  VT125  VT131  "+ &
	   "VT132  VT220  VT240  VT241  VT105  VK100  RT02   LA30   "+ &
	   "VT50   VT50H  VT05   VT05B  LA30S  2741   ASR33  KSR33  "+ &
	   "ASR35  KSR35  LN03   UnknownUnknownUnknownUnknownUnknown"+ &
	   "UnknownUnknownUnknownLA210  LQP03  LQP02  LA75   VT330  "+ &
	   "VT340  VT320  " &
	\ a$=sys(chr$(6%)+chr$(-12%)) &
	\ i%=peek(swap%(cvt$%(mid(a$,13%,2%)))) &
	\ jobmax%=swap%(i%) and 255% &
	\ jobact%=i% and 255% &
	\ dsklog%=swap%(cvt$%(mid(a$,21%,2%))) &
	\ devnam%=swap%(cvt$%(mid(a$,5%,2%))) &
	\ devokb%=swap%(cvt$%(mid(a$,9%,2%))) &
	\ hdrout%=0% &
	\ opsys$=cvt$$(right(sys(chr$(6%)+chr$(9%)+chr$(0%)),3%),5%) &
	\ i%=instr(1%,opsys$," ") &
	\ i%=instr(i%+1%,opsys$," ") &
	\ opsys$=left(opsys$,i%-1%) &
	\ day.week$(0%)="Sunday" &
	\ day.week$(1%)="Monday" &
	\ day.week$(2%)="Tuesday" &
	\ day.week$(3%)="Wednesday" &
	\ day.week$(4%)="Thursday" &
	\ day.week$(5%)="Friday" &
	\ day.week$(6%)="Saturday" &
	\ month.year$(0%)="Jan" &
	\ month.year$(1%)="Feb" &
	\ month.year$(2%)="Mar" &
	\ month.year$(3%)="Apr" &
	\ month.year$(4%)="May" &
	\ month.year$(5%)="Jun" &
	\ month.year$(6%)="Jul" &
	\ month.year$(7%)="Aug" &
	\ month.year$(8%)="Sep" &
	\ month.year$(9%)="Oct" &
	\ month.year$(10%)="Nov" &
	\ month.year$(11%)="Dec" &
	\ minwld%=0% &
	\ nodreq%=0% &
	\ ljkflg%=0% &
	\ flags%(1%)=143% &
	\ flags%(2%)=3575% &
	\ flags%(3%)=15% &
	\ l.host$="" &
	\ l.msg$="" &
	\ l.org$="" &
	\ router$="" &
	\ open "FINGER$:FINGER.CNF" for input as file #9%, mode 6144%, &
	   access read, allow modify &
	! Set up version string, preset some defaults if couldn't open the &
	! configuration file, open the configuration file &

31010	input line #9%, a$ &
	\ goto 31010 if left(a$,1%)="!" &
	\ goto 31030 if left(a$,1%)="Q" &
	\ b$=cvt$$(left(a$,1%),32%) &
	\ a$=left(a$,len(a$)-2%) &
	\ a$=right(a$,3%) &
	\ l.host$=a$ if b$="H" &
	\ l.org$=a$ if b$="O" &
	\ l.msg$=a$ if b$="M" &
	\ router$=a$ if b$="R" &
	\ goto 31020 if router$="0" &
	\ minwld%=val(a$) if b$="W" &
	\ nodreq%=val(a$) if b$="N" &
	\ ljkflg%=val(a$) if b$="L" &
	\ flags%(1%)=val(a$) if b$="1" &
	\ flags%(2%)=val(a$) if b$="2" &
	\ flags%(3%)=val(a$) if b$="3" &
	\ goto 31010 &
	! Read a line from the finger configuration file. &
	! Skip if a comment, else set appropriate item and loop. &

31020	msg$="?FINGER - Error in configuration file FINGER$:FINGER.CNF"+ &
	   chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ router$="" &
	\ close #9% &
	\ goto 31040 &
	! Print error message and bail out. &
	! If anything is wrong with the file, the router information is &
	! deleted as being unreliable. &

31030	close #9% &
	! Close configuration file &

31040	for i%=len(command$) to 1% step -1% &
	\ goto 31050 if mid(command$,i%,1%)="@" &
	\ goto 31070 if mid(command$,i%,2%)="::" &
	\ next i% &
	\ goto 2000 &
	! Traverse the command looking for a nodespec &
	! If we didn't find one, it's a local FINGER, otherwise continue &
	!  into network command splitting &

31050	command.1$=left(command$,i%-1%) &
	\ command.2$="" &
	\ j%=instr(i%+1%,command$," ") &
	\ command.2$=right(command$,j%) if j% &
	\ goto 31060 if j% &
	\ j%=instr(i%+1%,command$,"/") &
	\ command.2$=right(command$,j%) if j% &
	! Get the left part of the command, look for stuff after nodespec. &
	! If found, save as right part. &

31060	j%=len(command$)+1% if j%=0% &
	\ node$=mid(command$,i%+1%,j%-i%-1%) &
	\ command$=command.1$+command.2$ &
	\ goto 28000 &
	! Build node string, strip from command string &
	! Go do remote FINGER command &

31070	for j%=i%-1% to 1% step -1% &
	\ goto 31080 if mid(command$,j%,1%)=" " &
	\ next j% &
	! Find the start of the nodespec &

31080	node$=mid(command$,j%+1%,i%-j%-1%) &
	\ command$=left(command$,j%)+right(command$,i%+2%) &
	\ goto 28000 &
	! Build node and command strings &
	! Go do remote FINGER command &

32000	! Error handlers &
	! &
	erno%=err					! Error number &
	\ resume 32060 if erno%=28%			! Local ^C &
	\ resume  2020 if erl= 2010			! No help file &
	\ resume  2040 if erl= 2030			! Eof on help file &
	\ resume 32080 if erl= 2050			! No username file &
	\ resume  2120 if erl= 2090			! No message file &
	\ resume  2110 if erl= 2100			! Eof on message file &
	\ resume  4000 if erl= 3020			! User not found &
	\ resume  3050 if erl= 3040			! No MAIL.MAI file &
	\ resume  3130 if erl= 3110			! No planfile &
	\ resume  3140 if erl= 3120			! Eof on planfile &
	\ resume  4030 if erl= 4010			! User not found &
	\ resume 25030 if erl=25020			! User not found &
	\ resume 25120 if erl=25110			! No such job &
	\ resume 25240 if erl=25220			! Not a LAT terminal &
	\ resume 25250 if erl=25240			! Terminal went away &
	\ resume 28020 if erl=28010 			! Rcvr already decl. &
	\ resume 28120 if erl=28030			! Error on connect &
	\ resume 32010 if erl=28050 and erno%=5%	! Receive suspend &
	\ resume 32080 if erl=28000			! No username file &
	\ resume 32020 if erl=28090 and erno%=5%	! Receive suspend &
	\ resume 28110 if erl=28100			! Error on remove RCV &
	\ resume 32030 if erl=27020			! Transmit suspend &
	\ resume 29020 if erl=29010			! Rcvr already decl. &
	\ resume 32040 if erl=29060 and erno%=5%	! Receive suspend &
	\ resume 31020 if erl=31000			! Error opening .CNF &
	\ resume 31020 if erl=31010			! Error reading .CNF &
	\ resume 31040 if erl=31020			! Error closing .CNF &
	\ resume 32070 if erl=32060			! Error on remove RCV &
	\ resume 32050 if erl=32610			! Transmit suspend &
	\ resume 32767 if erl=32620			! Error killing job &
	\ resume 32090					! Error we don't do &

32010	sleep 1% &
	\ i.retcnt%=i.retcnt%+1% &
	\ goto 28050 if i.retcnt%<5% &
	\ erno%=512% &
	\ goto 28120 &
	! Wait a bit, increment retry counter and try again &

32020	sleep 1% &
	\ i.retcnt%=i.retcnt%+1% &
	\ goto 28090 if i.retcnt%<5% &
	\ erno%=512% &
	\ goto 28120 &
	! Wait a bit, increment retry counter and try again &

32030	sleep 1% &
	\ o.retcnt%=o.retcnt%+1% &
	\ goto 27020 if o.retcnt%<5% &
	\ erno%=512% &
	\ goto 32600 &
	! Wait a bit, increment retry counter and try again &

32040	sleep 1% &
	\ i.retcnt%=i.retcnt%+1% &
	\ goto 29060 if i.retcnt%<5% &
	\ erno%=512% &
	\ goto 32600 &
	! Wait a bit, increment retry counter and try again &

32050	sleep 1% &
	\ o.retcnt%=o.retcnt%+1% &
	\ goto 32610 if o.retcnt%<5% &
	\ erno%=512% &
	\ goto 32620 &
	! Wait a bit, increment retry counter and try again &

32060	a$=sys(chr$(6%)+chr$(22%)+chr$(-9%)+chr$(1%)+string$(6%,0%)+ &
	     chr$(0%)+chr$(0%)+cvt%$(swap%(0%))+cvt%$(swap%(0%))+ &
	     string$(18%,0%)+chr$(1%)+string$(5%,0%)) &
	\ a$=sys(chr$(6%)+chr$(22%)+chr$(0%)+chr$(0%)+string$(30%,0%)+ &
	   chr$(1%)+string$(5%,0%)) &
	! Send link abort message and remove our receiver &

32070	close #12% &
	\ goto 32767 &
	! Close the buffer channel and exit. &

32080	msg$="?FINGER - Cannot open username file FINGER$:FINGER.DAT"+ &
	   chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	\ goto 32600 &

32090	msg$=cvt$$(right(sys(chr$(6%)+chr$(9%)+chr$(erno%)),3%),5%)+ &
	   " at line "+num1$(erl)+"."+chr$(13%)+chr$(10%) &
	\ gosub 27000 &
	! Error we don't handle, simply report it &

32600	! We are done, make an orderly exit. &
	&
	o.retcnt%=0% &
	\ msg$=chr$(13%)+chr$(10%) &
	\ gosub 27000 if accmod%=1% &

32610	goto 32767% if accmod%<>3% &
	\ field #11, 1% as buff11$ &
	\ lset buff11$=chr$(255%) &
	\ a$=sys(chr$(6%)+chr$(22%)+chr$(-8%)+chr$(1%)+string$(6%,0%)+ &
	     chr$(11%)+chr$(0%)+cvt%$(swap%(1%))+cvt%$(swap%(0%))+ &
	     string$(24%,0%)) &
	! Send flush character in disconnect message &

32620	close #11% &
	\ a$=sys(chr$(6%)+chr$(8%)+chr$(0%)+string$(24%,0%)+chr$(255%)) &
	! Close our workfile and kill self &

32767	end				! Not as simple as it looked, eh?