; FWD.MAC - 5/11/87 - Auto-forwarding of messages.
; Thank you K4NTA for the code to handle GATOR 2 PAD
; connections (H forwarding).

	.z80
	maclib	TNC.LIB

	entry	fwd1,fwd2,fwd3,fwd4,chgf,ffcb,kilfwd,fstay,mm7

	external	mlhd,mhprev,mhcur,mmhs,mhnr,mhtype,mhstat,mhto
	external	mhbbs,mhtit,mhtitl

	external	wthdr,kmsg,getto,ucalls,uccnt,prtmsg
	external	change,curtime,firmsg,mfcb,mrec,mfhs
	external	ckname,ername,erdone,parse,flds,fcb1,fcb2,opt2
	external	eofs,leofs,dis,twotnc,@wait
	external	ocall,mcon,mtnc,stnc
	external	log,event,logtxt,llogtxt
	external	decbin,bindec,numb,@fill,@mcmd,@cmpcmd
	external	gotreq,tnca,tncb,@openr,rdcmd,fmbuf,rfcb
	external	@outch,cmdtnc,@docmd,wtcmd,@prtx,@upper,@cmp,@cmpwc
	external	@src,@srct,@srcl,@srcn,@srcw,@srcc
	external	addcr0,getdat,cmd,cmdlen,cmdtyp,gotcon,$memry

	asciictl
	bdosdef
	tncdefs
	timdef

	dseg
tmhpr:	ds	2
kilfwd:	ds	1		; True if ok to kill msg after forward
fstay:	ds	1		; True if F type msgs not killed
frcfwd:	ds	1		; True to ignore hour spec
onebbs:	ds	1		; True if forward only 1 MailBox
fwm1:	db	'S  $G',0
fwm2:	db	' @ $A',0
fwm3:	db	' < $P',0
mm7:	ds	2
dofrom:	ds	1
tcall:	ds	6
fcall:	ds	8		; Only to this MailBox

; File control block, filled by RDPARAM.

ffcb:	ds	fcbsize

; Stuff for GATOR 2 PAD

ispad:	ds	1		; Forward to GATOR 2 PAD

	cseg

; In all those cases of disconnect, etc. just return to caller,
; caller can inspect cmdtyp to find out what happened.
; Return zero cleared - general "No good" status.

badret:	retnz

chgf:	ckname	fcb2
	jp	z,ername
	zmov	ffcb,fcb2,fcbsize
	jp	erdone

; Check if the current time is between the given start/end times.
; Return zero set if ok.

cktime:	fill	numb,5,' '
	movw	numb,cmd+2	; Not before
	call	decbin
	push	hl		; Save start time
	movw	numb,cmd+4	; Not after
	call	decbin
	ld	c,l		; End hour
	pop	hl
	ld	b,l		; Start hour
	ld	a,(hr)
	ld	d,a		; Current hour
	ld	a,c
	cp	b		; End - start
	jr	z,c3
	jr	c,c2

; Start hr < end hr.

	ld	a,d		; Current hour
	cp	b
	ret	c		; Zero cleared
	ld	a,c
	cp	d
	ret	c		; Zero cleared
go:	retz

; Start hour > end hour

c2:	ld	a,d
	cp	b
	jr	nc,go
	ld	a,c
	cp	d
	jr	nc,go
no:	retnz

; Start and end the same

c3:	ld	a,d
	cp	b
	ret

; Read a line and convert to upper case.

rdcmdu:	call	rdcmd
	ret	z		; EOF or ERR
	call	parse
	retnz

; Auto-forwarding.

fwd1:	mvim	onebbs,false
	mvim	frcfwd,false
	jr	fwda
fwd2:	mvim	onebbs,true
	mvim	frcfwd,false
	jr	fwd
fwd3:	mvim	onebbs,false
	mvim	frcfwd,true
	jr	fwda
fwd4:	mvim	onebbs,true
	mvim	frcfwd,true
fwd:	zmov	fcall,fcb2+1,8	; Save call + SSID
fwda:	mvim	ispad,false	; Assume NOT a GATOR 2 PAD
	ld	hl,frcfwd
	ld	(hl),true	; Assume ignore times
	ld	a,(opt2)
	cp	'I'		; Ignore times?
	jr	z,fwdb		; Yes
	ld	(hl),false	; Honor times
fwdb:	openr	ffcb		; Open FWD.TNC
	ret	z		; No file, no forward
	mvim	event,'M'
	ld	hl,logtxt
	ld	(hl),'F'
	inc	hl
	ld	(hl),' '
	mvim	logtxt+7,' '
	ld	hl,change
	ld	a,(hl)
	ld	(hl),false	; Will be up to date
	cp	true		; Is it?
	call	z,getto		; Update, if not current

; Read the next command or list header.

fwdc:	call	rdcmdu
	jr	z,fwdd		; EOF or ERR
	ld	hl,fwdc		; Return address
	push	hl		; Onto stack for return
	ld	a,(fcb1+1)	; Command
	cp	'U'
	jp	z,fwdi
	cp	'F'
	jp	z,dofwd
	cp	'G'
	jp	z,dofwd
	cp	'H'
	jr	z,dopadh
	cp	'P'
	jr	z,dopar
	ret			; and get next list header

; H type forwarding - a GATOR 2 PAD.

dopadh:	mvim	ispad,true	; Thru a PAD
	ld	hl,($memry)	; Use free memory and
	movcmd	,1,cmdmax	; save string to send to PAD
	jp	addcr0		; Add CR,0 at end of string, return

; Finished the file of forwarding instructions.
; Clean up and return to caller.

fwdd:	call	tnca
	console
	mvim	gotreq,false	; Ignore any connect req
	cmpm	change,true	; Any messages killed?
	call	z,wthdr		; If yes, write hdr back
	ret

; Set tnc parameters.

dopar:	ld	a,(fcb1+2)	; TNC ID
	cp	'B'
	jr	z,dopara
	call	tnca
	jr	doparc
dopara:	cmpm	twotnc,false
	jp	z,fwdi
	call	tncb
doparc:	call	rdcmdu		; Get TNC command from file
	jr	z,dopard	; EOF or ERR
	cmpcmd	eofs,leofs
	jr	z,dopard	; End of command group
	ld	hl,($memry)
	movcmd	,0,cmdmax
	call	addcr0		; Put CR,0 at end of string
	docmd	$memry
	jr	doparc
dopard:	console
	mvim	ispad,false
	ret

; Forward messages to another MailBox.
; Example: FA2207C K1BC via KA1CB
; Function, TNC ID, Not before, Not after, Connect path.

dofwd:	cmpm	onebbs,true	; Forward to one MailBox only?
	jr	nz,dofx		; No, do all
	comp	fcall,fcb2+1,8	; This one?
	jp	nz,fwdi		; No, try next MailBox
dofx:	movcmd	logtxt+8,6,llogtxt-10
	call	addcr0		; Put CR,0 at end of string
	ld	a,(fcb1+2)	; TNC ID
	cp	'B'
	jr	z,dofa
	call	tnca
	jr	dofb
dofa:	cmpm	twotnc,false
	jp	z,fwdi		; No B TNC, try next MailBox
	call	tncb
dofb:	console
	ld	hl,dofrom
	ld	(hl),false	; Assume old style
	ld	a,(fcb1+1)	; F or G
	cp	'F'		; Old style?
	jr	z,dofc		; Yes
	ld	(hl),true	; New type, add "< FROM"
dofc:	cmpm	frcfwd,true	; Ignore hours?
	jr	z,dofd		; Yup, do it now
	call	cktime		; Can we do it at this time?
	jp	nz,fwdi		; No

; Read call of person whose messages should be forwarded.

dofd:	call	rdcmdu
	jp	z,fwddis
	cmpcmd	eofs,leofs	; Done with this MailBox?
	jp	z,fwddis	; Yes, disconnect.
	cmpm	fcb1+1,'*'	; Forward ALL?
	jr	z,dofe		; Yes
; Any mail for this person? (Allow wildcards in fwd file entry)
	srclsw	fcb1+1,ucalls,uccnt,6,6
	jr	z,doff		; Yes, forward
; Any mail for this bbs? (Allow wildcards in fwd file entry)
	zmov	tcall,fcb1+1,6
	ld	a,(tcall)
	or	80h
	ld	(tcall),a
	srclsw	tcall,ucalls,uccnt,6,6
	jr	z,doff		; Yes, forward
	jp	dofd		; No, try next call

; Forward all

dofe:	ld	a,(uccnt)	; # calls with unread mail
	or	a
	jp	z,dofd		; Nothing to forward
	dec	a		; Only one call in list?
	jr	nz,doff		; More than one, forward
	srclst	ocall,ucalls,uccnt,6,6
	jp	z,dofd		; Keep mail for owner only here

; Forward mail for call in fcb1+1.

doff:	master
	call	fmsg		; Forward the messages
	console
	jp	z,dofd		; That one went, try next
	call	fwddis		; No go. Disconnect from MailBox
	wait	4		; For any I frames to drain from TNC.

; Ignore the rest of this list by reading to "*** EOF".

fwdi:	console
	mvim	ispad,false
	call	rdcmd
	ret	z
	cmpcmd	eofs,leofs
	ret	z
	jr	fwdi

; Disconnect from the MailBox we are connected to.

fwddis:	mvim	ispad,false
	cmpm	mcon,false
	ret	z		; Not connected
	master
	call	cmdtnc
	call	dis
	ld	a,false
	ld	(mcon),a
	console
	ret

; Eat the menu. Return zero set for ok, cleared if discon/timeout.

eat:	call	getdat
	ckcmd	eat,badret,badret
	ld	a,(cmdlen)
	or	a
	jr	z,eat
	dec	a
	ld	e,a
	ld	d,0
	ld	hl,cmd
	add	hl,de
	ld	a,(hl)
	cp	'>'
	ret	z
	jr	eat

; Connect to another MailBox.
; Return zero set for success, cleared for failure.

cmb:	ld	hl,logtxt+8
	prtx
	call	wtcmd
	ret	nz

; Wait for response from MailBox

cmba:	call	getdat
	ckcmd	cmba,cmbe,cmbf
	call	gotcon
	jr	nz,cmba

; Wait for answer from PAD, if H forwarding.

	cmpm	ispad,true	; Is it a PAD?
	jr	nz,cmbd		; No
	ld	c,cr		; Send a packet to the PAD,
	call	@outch		; so it knows we level 2
cmbb:	call	getdat		; Get line from PAD
	ckcmd	cmbb,cmbf,cmbf
	call	gotpad		; Got PAD's msg?
	jr	nz,cmbb		; No, get another line
	prtx	$memry		; Send the BBS call to the PAD

; Wait for msg from PAD.

cmbc:	call	getdat
	ckcmd	cmbc,cmbf,cmbf
	call	gotrst		; PAD reset msg?
	call	z,eat		; Eat the extra line
	jr	z,cmbd		; Means PAD connected ok
	jr	cmbf		; Failed, no connect

; Connect worked, expect logon msg and menu. Eat them.

cmbd:	call	eat
	ret	z		; Got a '>'
	jr	cmbf

; Connect failed

cmbe:	call	wtcmd
	retnz

; Connect timed out.

cmbf:	call	cmdtnc
	call	dis
	mvim	ispad,false	; Just to be sure
	retnz

; Find PAD's msg.

gotpad:	cmpcmd	padto,lpadto
	ret

; Find PAD reset msg.

gotrst:	cmpcmd	padrst,lpadrst
	ret

; The PAD msgs.

padto:	db	'enter: call [,digi1 [,digi2 [,digi3] ] ]'
lpadto	equ	$-padto

padrst:	db	'to?*** pad: connection reset'
lpadrst	equ	$-padrst

; Forward all messages addressed to fcb1+1.
; Return zero set for ok, cleared if lost connection, or failed connect.

fmsg:	mvim	firmsg,false
	movw	mhcur,mlhd	; Point to last hdr
fmsga:	dtz	mhcur
	ret	z
	movw	mrec,mhcur
	dodosa	setdma,mmhs
	dodosa	rrec,mfcb
	movw	tmhpr,mhprev	; Save pointer to previous header
	cmpm	mhstat,'N'	; Already read or forwarded?
	jp	nz,fmsgk	; Yes
	comp	mhbbs,ocall,6	; It says to keep here?
	jp	z,fmsgk		; Yes
	cmpm	fcb1+1,'*'	; Forward ALL?
	jr	nz,fmsgb	; No
	comp	mhto,ocall,6	; For owner?
	jp	z,fmsgk		; Yes, don't forward
	jr	fmsgd		; No, forward it

fmsgb:	cmpm	mhbbs,' '	; MailBox specified?
	jr	z,fmsgc		; No
	compwc	mhbbs,fcb1+1,6	; To this MailBox?
	jr	z,fmsgd		; Yes, forward it
	jp	fmsgk		; No

fmsgc:	compwc	mhto,fcb1+1,6	; To this person at this MailBox?
	jp	nz,fmsgk	; No
; Ok, forward this msg to this MailBox.
fmsgd:	cmpm	mcon,true	; We connected?
	call	nz,cmb		; No, Attempt connect
	ret	nz		; No connect
	mvim	mcon,true	; We are now connected
	movb	fwm1+1,mhtype
	ld	hl,fwm1
	call	@prtx		; Send "Sx TO"
	ld	hl,fwm2
	cmpm	mhbbs,' '
	call	nz,@prtx	; Send " @ BBS"
	ld	hl,fwm3
	cmpm	dofrom,true	; Put the FROM call in?
	call	z,@prtx		; Send " < FROM"
	ld	c,cr
	call	@outch
; Send TITLE
	ld	hl,mhtit
	ld	b,mhtitl
fmsge:	ld	a,(hl)
	cp	cr
	jr	z,fmsgf
	ld	c,a
	call	@outch
	inc	hl
	dec	b
	jr	nz,fmsge
fmsgf:	ld	c,cr
	call	@outch
; Eat the "Enter title..." and "Enter message..." prompts.
fmsgg:	call	getdat
	ckcmd	fmsgg,badret,badret
fmsgh:	call	getdat
	ckcmd	fmsgh,badret,badret
	call	curtime
	prtx	mm7
	call	prtmsg		; Send the msg
	ld	c,eof
	call	@outch
	ld	c,cr
	call	@outch
	call	eat
	ret	nz
	ld	hl,(mhnr)
	call	bindec
	zmov	logtxt+2,numb,5
	call	log
	cmpm	kilfwd,false		; Kill msg after forward?
	jr	z,fmsgi			; No, just mark it
	cmpm	fstay,true		; 'F' msgs stay here?
	jr	nz,fmsgj		; No, kill it
	cmpm	mhtype,'F'		; Message type F?
	jr	z,fmsgi			; Yes, don't kill it
fmsgj:	call	kmsg
	jr	fmsgk

fmsgi:	mvim	mhstat,'F'
	movw	mrec,mhcur
	dodosa	setdma,mmhs
	dodosa	wrec,mfcb
	mvim	change,true
fmsgk:	movw	mhcur,tmhpr
	jp	fmsga

	end