.enabl	lc
	.dsabl	gbl
	.title	mail
;
; Mailer for Digby's Bitpile.
;
; By John Wilson.
; Intra-BBS mail - 17-Apr-86.
; BBS to user [p,pn]MAIL.BOX - 18-Apr-86.
;
; Must be assembled with HEADER.MAC
;
	.mcall	exit$s
;
msgcnt=	20	;offset of msg count in user record
msgppn=	22	;offset of PPN to send mail to in user record
;
bell=	7	;bell
lf=	12	;line feed
cr=	15	;carriage return
esc=	33	;escape
;
firqb=	402	;file request queue block
xrb=	442	;transfer request block
corcmn=	460	;core common area
calfip=	emt	;call to file processor
opnfq=	2	;subfunc to open a file
crefq=	4	;... to create and open a file
.read=	emt+2	;read a record
.write=	emt+4	;write a record
.sleep=	emt+10	;time delay
.date=	emt+34	;get system date/time
.uuo=	emt+66	;FIP calls (unimplemented user operation)
uu.cnv=	20.	;subfunc to convert date and time to ASCII
;
	.macro	type	str
	jsr	r5,print
	.word	l.'str,str
	.endm
;
mail:	; entry point
	mov	#corcmn,r0	;pt at core common
	clr	r1		;clear high byte
	bisb	(r0)+,r1	;get length
	add	r0,r1		;pt at end
	clrb	(r1)		;mark it
	br	20$		;parse name
10$:	type	to		;'To: '
	mov	#kbbuf,r0	;point at buffer
	call	rdline		;get response
20$:	mov	#rcpt,r5	;point at buffer
	jsr	pc,cvr50	;convert to radix-50
	bcc	30$		;no prob, skip
	type	illnam		;bad name
	br	10$		;try again
30$:	tst	rcpt		;blank name?
	beq	10$		;yes, try again
	mov	#120000,r4	;mode 8192%
	call	opuser		;open user list
	movb	firqb+2,job	;save job #
	mov	firqb+16,r5	;get file size
40$:	mov	#8.,r4		;# of records per block
	mov	#buf,r3		;point at buffer
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;read one block
	clr	(r0)+		;nothing read yet
	mov	r3,(r0)+	;into @#buf
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;(modifier bits)
	.read			;read the block
50$:	mov	#4,r2		;name is 4 words long
	mov	r3,r1		;copy ptr
	mov	#rcpt,r0	;point at name
60$:	cmp	(r0)+,(r1)+	;do they"match?
	bne	70$		;no, kkip
	sob	r2,60$		;loop
	br	90$		;got it
70$:	add	#100,r3		;point at next entry in block
	sob	r4,50$		;check the whole block
	sob	r5,40$		;for all blocks
80$:	; losername not found
	call	close1		;close the file
	type	nosuch		;no such user
	br	10$		;try again
90$:	mov	xrb+10,blk	;save block
	mov	r3,addr		;offset+#buf
	mov	msgppn(r3),usrppn ;save user ppn
	call	close1		;close the file
	type	subj		;'Subject: '
	mov	#sbjct,r0	;point at buffer
	jsr	pc,rdline	;get response
header:	; make the header
; From: LOSERNAME
	mov	#buf,r5		;point at buffer
	mov	#from,r0	;'From: '
	call	copy
; Try to get sender's name from NAMEjj.TMP
	call	clrfrq		;clear out the firqb
	movb	job,r1		;get job*2
	asr	r1		;/2=job
	clr	r0		;sxt
	div	#10.,r0		;separate digits of job #
	mov	r0,r3		;copy high digit
	mul	#50,r3		;shift left (rad50)
	add	r3,r1		;add digits together
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+10,r2	;point at filename
	mov	#^RNAM,(r2)+	;name='NAMEjj.TMP'
	add	#^RE00,r1	;cvt job
	mov	r1,(r2)+	;put in firqb
	mov	#^RTMP,(r2)
	calfip			;open the file
	tstb	firqb		;successful?
	bne	20$		;no, prompt for losername
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;read 1 block
	clr	(r0)+		;(nothing read yet)
	mov	r5,(r0)+	;addr (r5 must be even here!!!!!)
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next (first) block
	clr	(r0)+		;(not applicable)
	clr	(r0)		;no modifiers
	.read			;do it
	call	close1		;close channel 1
	add	#12.,r5		;point at end of username
10$:	cmpb	#' ,-(r5)	;trim trailing blanks
	beq	10$
	inc	r5		;point at first one
	br	30$		;skip
20$:	; anonymous login, prompt for name
	type	from		;'From: '
	movb	#'",(r5)+	;leading quote
	mov	r5,r0		;point at kbbuf
	call	rdline		;read name
	add	r1,r0		;point at end
	mov	r0,r5		;update ptr
	mov	#noname,r0	;make it clear they're anonymous
	call	copy		;copy
30$:	call	crlf
; Subject: subject
	tstb	sbjct		;do we have a subject?
	beq	40$		;no, bag the line
	mov	#subj,r0	;'Subject: '
	call	copy
	mov	#sbjct,r0	;copy the string
	call	copy
	call	crlf
; Date: DD-Mmm-YY, HH:MM xM
40$:	mov	#date,r0	;point at date
	call	copy		;copy to buffer
	.date			;get date, time
	movb	#uu.cnv,firqb+3	;func=convert date/time
	mov	xrb,firqb+4	;copy date
	clr	firqb+6		;use system default format
	mov	xrb+2,firqb+22	;copy time
	clr	firqb+24	;use default
	.uuo			;convert date/time to ASCII
	mov	#firqb+10,r0	;point at date
	call	copy		;copy it
	movb	#',,(r5)+	;add 2 spaces
	movb	#' ,(r5)+
	mov	#firqb+26,r0	;point at time
	call	copy		;copy it
	call	crlf		;add a crlf
; To: LOSERNAME
	mov	#to,r0		;'To: '
	call	copy
	mov	#rcpt,r0	;point at name
	call	pr50		;put in buf
	call	crlf		;crlf
; end of header
	call	crlf		;blank line
; the msg itself...
	type	msg		;'Msg:'
	clr	r4		;we haven't warned them yet
50$:	cmp	r5,#bufend-<2*kbbufl> ;space for 2 full lines?
	blos	60$		;yep
	type	lastln		;no, this has to be the last one
	com	r4		;set flag
60$:	mov	r5,r0		;point
	call	rdline		;read a line
	bcs	80$		;^Z, skip
	add	r1,r5		;update ptr
	cmp	r2,#esc		;did they end with escape?
	bne	70$		;no
	type	crlfs		;go to begn of line
	tst	r1		;blank line?
	beq	80$		;yes
	call	crlf		;no, end it
	br	80$		;skip
70$:	call	crlf		;add a crlf
	tst	r4		;did we say no more?
	beq	50$		;no, loop
80$:	call	crlf		;add a blank line
	; now actually send the msg
	mov	usrppn,r4	;get PPN
	bne	notbbs		;non-zero, send to their account
;
sndbbs:	; send to BBS user
	movb	#377,(r5)+	;mark end of msg
	sub	#rcpt,r5	;find length
	add	#777,r5		;round to next blk
	bic	#777,r5		;whee!
	mov	#mailfi,r2	;point at mail filename
	call	openw		;open for output
	mov	firqb+16,r4	;get file size
	mov	r5,r3		;copy size
	ash	#-9.,r3		;find # blks
	mov	r3,numblk	;poke
	clr	r2		;curr # in a row
10$:	mov	#xrb,r0		;point at xrb
	mov	#2,(r0)+	;len=1 word
	clr	(r0)+		;nothing yet
	mov	#flag,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.read			;read the first word of the blk
	tst	flag		;is it empty?
	beq	20$		;yep, count it
	clr	r2		;zap count, if any
	br	30$		;go do next block
20$:	inc	r2		;bump count
	cmp	r2,r3		;enough?
	blo	30$		;no, do next block
	mov	xrb+10,r1	;get blk #
	dec	r3		;dec count
	sub	r3,r1		;find blk #
	br	40$		;skip
30$:	sob	r4,10$		;loop
	mov	xrb+10,r1	;get last blk #
	inc	r1		;point at 1st blk after end
40$:	mov	#xrb,r0		;yep, pt at xrb
	mov	r5,(r0)+	;buf len
	mov	r5,(r0)+	;(again)
	mov	#rcpt,(r0)+	;starting addr
	mov	#2,(r0)+	;channel 1
	mov	r1,(r0)+	;point at first free blk
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.write			;write the msg
	call	close1		;close the file
	mov	#usrlst,r2	;point at loser list filename
	call	openw		;open it, check for write access
	mov	#xrb,r0		;point at xrb
	mov	#1000,(r0)+	;len=1 blk
	clr	(r0)+		;nothing yet
	mov	#buf,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	mov	blk,(r0)+	;block
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.read			;read the entry for the recipient
	mov	addr,r0		;point at mail count
	inc	msgcnt(r0)	;bump msg count
	mov	#xrb,r0		;pt at xrb
	mov	#1000,(r0)+	;len=1 blk
	tst	(r0)+		;(1000 still there from .READ)
	mov	#buf,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	tst	(r0)+		;(blk is still there)
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.write			;update
	br	exit		;close file, exit
;+
;
; Write the message onto MAIL.BOX in their acct.
; (PPN comes in r4)
;
;-
notbbs:	sub	#buf,r5		;find offset
10$:	bit	#777,r5		;block full?
	beq	20$		;yep
	clrb	buf(r5)		;not yet
	inc	r5
	br	10$		;loop
20$:	mov	#opnfq,r3	;start with an open
30$:	call	clrfrq		;zap the firqb
	movb	r3,firqb+3	;func=open for output
	movb	#2,firqb+4	;channel 1
	mov	#firqb+6,r1	;point
	mov	r4,(r1)+	;PPN
	mov	#^RMAI,(r1)+	;'MAIL.BOX'
	mov	#^RL  ,(r1)+
	mov	#^RBOX,(r1)
	mov	#100002,firqb+22 ;mode=open for append
	calfip			;open the file
	mov	firqb,r0	;error?
	bne	40$		;yep, bag
	bit	#2000,firqb+24	;do we have write access?
	beq	60$		;yep, good
	call	close1		;no, close it
	mov	#3,xrb		;wait 3 seconds
	.sleep
	br	30$		;try again...
	; it might be nice to print a msg
	; on the first time through the loop...
40$:	cmpb	firqb,#5	;"?Can't find file or account" ?
	bne	50$		;no, skip
	mov	#crefq,r3	;this time create it
	br	30$		;loop
50$:	;;;;;; error opening file - print msg and bag
60$:	mov	#xrb,r1		;point at xrb
	mov	r5,(r1)+	;length
	mov	r5,(r1)+
	mov	#buf,(r1)+	;addr
	mov	#2,(r1)+	;channel 1
	clr	(r1)+		;next block(s)
	clr	(r1)+		;(unused)
	clr	(r1)		;no modifiers
	.write			;do it
	;br	exit		;close the file, die
;
exit:	; finish up
	call	close1		;close the file
	mov	#buf,r5		;point at buffer
	mov	#queued,r0	;'Queued: '
	call	copy
	mov	#rcpt,r0	;point at recipient
	call	pr50		;add name
	call	crlf		;crlf
	sub	#buf,r5		;find length
	mov	r5,qlen		;poke
	jsr	r5,print	;print msg
qlen:	.word	0,buf
	exit$s
;+
;
; Open a file for output.
; If the file is in use, wait 3 secs and retry.
;
; On entry:
;  r2	-> .word PPN ? .rad50 /FILNAMEXT/ ? .word dev,<flag,,unit>
;
; On return, C=1 if error opening file,
; else file is open on channel 1.
;
;-
openw:	call	clrfrq		;zap the firqb
	movb	#opnfq,firqb+3	;func=open for output
	movb	#2,firqb+4	;channel 1
	mov	#firqb+6,r1	;point
	mov	(r2)+,(r1)+	;PPN
	mov	(r2)+,(r1)+	;FIL
	mov	(r2)+,(r1)+	;NAM
	mov	(r2)+,(r1)	;.EXT
	mov	(r2)+,firqb+30	;dev
	mov	(r2),firqb+32	;flag, unit
	calfip			;open the file
	mov	firqb,r0	;error?
	bne	10$		;yep, bag
	bit	#2000,firqb+24	;do we have write access?
	beq	20$		;yep, good
	call	close1		;no, close it
	mov	#3,xrb		;wait 3 seconds
	.sleep
	sub	#12,r2		;back up again
	br	openw		;try again...
10$:	sec			;error opening file (code in r0)
	rts	pc
20$:	clc			;no problem
	rts	pc
;+
;
; Open the BBS user list file on channel 1.
; This is currently "DL1:[10,3]BBUSER.DAT".
; On entry, the open mode should be in r4.
;
;-
opuser:	call	clrfrq		;clear the firqb
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+6,r1	;point at filename
	mov	#bbsppn,(r1)+	;filename='devn:[p,pn]BBUSER.DAT'
	mov	#^RBBU,(r1)+
	mov	#^RSER,(r1)+
	mov	#^RDAT,(r1)
	mov	r4,firqb+22	;mode
.iif ne <bbsdev>, mov #bbsdev,firqb+30
.iif ne <bbsunt>, mov #bbsunt,firqb+32
	calfip			;open the file
	tstb	firqb		;error?
	bne	10$		;yes (oops!)
	rts	pc
10$:	type	usrerr		;error opening loser list
	exit$s
;
close1:	; close channel 1
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;do it
	rts	pc
;
clrfrq:	; clear the firqb
	mov	#firqb,r0	;point at firqb
	mov	#20,r1		;length
10$:	clr	(r0)+		;clear out the firqb
	sob	r1,10$		;loop
	rts	pc
;+
;
; Put .RAD50 losername at (r0) in buf at (r5).
;
;-
pr50:	call	pr50a		;do 3 chars
	call	pr50a
	call	pr50a
	;br	pr50a
pr50a:	; do 3 chars
	mov	(r0)+,r3	;get a word
	clr	r2		;SXT
	div	#50,r2		;/50
	mov	r3,r4		;copy rem
	mov	r2,r3		;copy quo
	clr	r2		;SXT
	div	#50,r2		;/50
	movb	rad50(r2),(r5)+	;first byte
	bne	10$		;not null
	dec	r5		;bag it
10$:	movb	rad50(r3),(r5)+	;2nd byte
	bne	20$		;not null
	dec	r5		;bag it
20$:	movb	rad50(r4),(r5)+	;3rd byte
	bne	30$		;not null
	dec	r5		;bag
30$:	rts	pc
;+
;
; Convert a string to radix-50.
; On entry, r0 points to an ASCIZ string,
; r5 points to the area in which to store the result.
;
; On return, C=1 if the string contained non-rad50 chars.
;
;-
cvr50:	mov	r0,r2		;copy ptr
	mov	r0,r4		;twice
10$:	movb	(r0)+,r3	;get a char
	beq	30$		;end, skip
	cmp	r3,#40		;blank or tab?
	blos	10$		;yes, ignore
	cmp	r3,#'a		;lower case?
	blo	20$
	cmp	r3,#'z
	bhi	20$
	bic	#40,r3		;yes, convert
20$:	movb	r3,(r2)+	;put in buf
	br	10$		;loop
30$:	mov	r4,r0		;copy ptr
	sub	r0,r2		;find length
	mov	r2,r1		;copy
	mov	#4,r4		;4 words
40$:	clr	r3		;init
	jsr	pc,60$		;do 3 chars
	jsr	pc,50$
	jsr	pc,50$
	mov	r3,(r5)+	;save
	sob	r4,40$		;loop
	rts	pc
;
50$:	; do a single char
	mul	#50,r3		;make space for the char
60$:	tst	r1		;anything left?
	beq	120$		;no, return
	dec	r1		;yes, dec count
	movb	(r0)+,r2	;and get the char
	cmp	#'$,r2		;dollar sign?
	bne	70$		;no
	add	#33,r3		;yes
	rts	pc
70$:	cmp	#'_,r2		;underline?
	bne	80$		;no
	add	#35,r3		;yes, use undefined code
	rts	pc
80$:	cmp	#'.,r2		;decimal point?
	beq	90$		;yes
	cmp	r2,#'0		;digit?
	blo	100$		;no
	cmp	r2,#'9		;hm?
	bhi	100$		;no
90$:	add	#36-'0,r2	;yes, convert to rad50
	br	110$		;skip
100$:	sub	#'A,r2		;letter?
	blo	130$		;no
	cmp	r2,#25.		;hm?
	bhi	130$		;no
	inc	r2		;yes, convert to rad50
110$:	add	r2,r3		;add in
120$:	rts	pc
130$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc		;fall through to original caller
;+
;
; Copy an ASCIZ string into the buffer at (r5).
; Takes ptr to string in r0.
;
;-
copy:	movb	(r0)+,(r5)+	;copy
	bne	copy		;loop
	dec	r5		;bag the nul
	rts	pc
;+
;
; Add a CRLF to the buffer at (r5).
;
;-
crlf:	movb	#cr,(r5)+	;cr
	movb	#lf,(r5)+	;lf
	rts	pc
;+
;
; Print a string on the terminal.
;
; Call:
;	jsr	r5,print
;	.word	len,addr
;
;-
print:	mov	#xrb,r0		;point at xrb
	mov	(r5),(r0)+	;len
	mov	(r5)+,(r0)+	;... twice
	mov	(r5)+,(r0)+	;addr
	clr	(r0)+		;channel 0
	clr	(r0)+		;next block
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.write			;print it
	rts	r5
;+
;
; Read a line from the terminal into (r0).
; Remove delimiter(s), return ptr in r0,
; length in r1, delimiter in r2.
;
; Return C=1 if end of file.
;
;-
rdline:	mov	#xrb,r1		;point at xrb
	mov	#kbbufl,(r1)+	;length
	clr	(r1)+		;nothing read yet
	mov	r0,(r1)+	;addr
	clr	(r1)+		;channel 0
	clr	(r1)+		;next block
	clr	(r1)+		;unlimited KB wait
	clr	(r1)		;no modifiers
	.read			;get it
	tstb	firqb		;any problems?
	bne	20$		;yep, ^Z or something
	mov	xrb+2,r1	;get # bytes read
	add	r0,r1		;point at end
	movb	-(r1),r2	;back up, get delimiter
	cmpb	-(r1),#cr	;cr?
	beq	10$		;yes
	inc	r1		;no, skip it
10$:	clrb	(r1)		;mark end
	sub	r0,r1		;find length (C=0)
	rts	pc
20$:	sec			;^Z
	rts	pc
	exit$s			;die
;
usrlst:	.word	bbsppn		;[p,pn]
	.rad50	/BBUSERDAT/	;BBUSER.DAT
	.word	bbsdev,bbsunt	;_devn:
;
mailfi:	.word	bbsppn		;[p,pn]
	.rad50	/BBMAILDAT/	;BBMAIL.DAT
	.word	bbsdev,bbsunt	;_devn:
;
rad50:	.ascii	<0>'ABCDEFGHIJKLMNOPQRSTUVWXYZ$._0123456789'
;
from:	.asciz	'From: '	;sender prompt (if "(noname)")
l.from=	.-from-1
;
subj:	.asciz	'Subject: '	;subject prompt
l.subj=	.-subj-1
;
date:	.asciz	'Date: '
;
to:	.asciz	'To: '		;recipient prompt
l.to=	.-to-1
;
msg:	.ascii	'Msg: (end with escape or ^Z)'<cr><lf>
l.msg=	.-msg
;
queued:	.asciz	'Queued: '
;
illnam:	.ascii	'?Invalid username'<cr><lf>
l.illn=	.-illnam
;
nosuch:	.ascii	'?No such user'<cr><lf>
l.nosu=	.-nosuch
;
usrerr:	.ascii	'?MAIL-U-Unable to obtain user list'<cr><lf>
l.usre=	.-usrerr
;
noname:	.asciz	'" (anonymous login)'
;
lastln:	.ascii	<bell>'%This is your last line'<cr><lf>
l.last=	.-lastln
;
crlfs:	.byte	cr,lf
l.crlf=	.-crlfs
;
	.even
blk:	.word			;block # of rcpt loser list entry
addr:	.word			;offset +#buf
;
usrppn:	.word			;loser's PPN, or 0 if mail goes to BBMAIL.DAT
flag:	.word			;buffer used while scanning mail file
;
job:	.byte			;our job number *2
kbbufl=	82.
kbbuf:	.blkb	kbbufl		;random KB buffer
sbjct:	.blkb	kbbufl		;'Subject' buffer
	.even
rcpt:	.blkw	4		;recipient losername
numblk:	.word			;# blks in msg (including rcpt)
buf:	.blkw	1000		;whatever
bufend:
;
	.end	mail