.title	RNews

;+
; RNews extracts news from KOM.
; Creation date: 02-Aug-89 20:18:13
;-

	.inclu	"b:global"

	UsNPrs	= 919.			; Group # for UseNet

	APR1	= 1
	APR2	= 2
	APR3	= 3
	APR4	= 4
	APR5	= 5

	KIN	= 7			; Channel to use for Writing news

	Tab	= 11
	Spc	= 40

	RhtLim	= 75.
	RhtMrg	= 120.

	.psect	code

	.inclu	"b:komfil"		; KOM filedefinitions.

INIT::	.ttnch				; No Echo
	mov 	#^RRNE, firqb+fqnam1
	mov 	#^RWS , firqb+fqnam1+2
	.name				; Set work name
	clr	Me
	mov	#LinLen-2, MaxLin
	mov	#-1, Line
	clr	PTerm			; Default term-typ (dummy crt)
	clrb	xrb+xrci
	.postn
	mov	#Width,r0
	clr	(r0)			; ?
	movb	xrb,(r0)
	decb	(r0)
	movb	firqb+fqjob, r0
	asr	r0
	mov	r0, Job
	write	#WlkMes			; Write a friendly phrase with version.
	errprt	#0
	write	#CRLF

	mov	#xSM+xELIN+xFil, MyFlags
	mov	#UnProm, Stat
	clr	KSW
	movb	#UU.SYS,Firqb+fqfun
	clr	firqb+4
	.UUO
	mov	firqb+26,PPN
	movb	Firqb+5,TERM

OPFIL:	mov	#EOFS,r2		; Open files
	mov	#EOFS-Files, r0		; Number of files * 2

10$:	mov	#firqb+fqfun, r1
	movb	#opnfq, (r1)+
	mov	r0, (r1)+		; Unit number * 2
	mov	KOMPPN, (r1)+
	mov	#^RKOM, (r1)+
	mov	-(r2), (r1)+
	mov	#^RDAT, (r1)+
	mov	#1+8.+128.+32768., firqb+fqmode
	mov	KOMDEV, firqb+fqdev
	mov	KOMDVN, firqb+fqdevn
	calfip
	jsr	pc, error
	dec	r0
	sob	r0, 10$
	write	#CRLF

	; Attach to KOM overlay library.

	call	clrfqb
	movb	#ATRFQ, Firqb+fqfil
	mov	KOMLIB, Firqb+12
	mov	KOMLIB+2, Firqb+14
	mov	#1, Firqb+22		; Read Only.
	.plas				; Attach Resedent Library
	call	Error
	mov	Firqb+Fqppn, OLIde
;	mov	Firqb+Fqnam1, OLSiz
	call	clrfqb
	movb	#CRAFQ, Firqb+Fqfil
	movb	#APR3, Firqb+7
	mov	#Firqb+12,r1
	mov	#128., (r1)+
	mov	OLIde, (r1)+
	mov	OvlTbl+SegB, (r1)+
	mov	OvlTbl+SegB+2, (r1)+
	mov	#200,(r1)		; ReadOnly, Mapping.
	.plas
	call	Error
	mov	firqb+fqppn, OWIde	; Window ID
	mov	#SegB, curseg		; Current maped segment.

	; Attach to KOM group-and command library.

	call	clrfqb
	movb	#ATRFQ, Firqb+fqfil
	mov	KOMRES, Firqb+12
	mov	KOMRES+2, Firqb+14
	mov	#2, Firqb+22
	.plas				; Attach Resedent Library
	call	Error
	mov	Firqb+Fqppn, LibIde
	mov	Firqb+Fqnam1, LibSiz
	call	clrfqb
	movb	#CRAFQ, Firqb+Fqfil
	movb	#APR4, Firqb+7
	mov	#Firqb+12,r1		; There WAS a bug here!
	mov	#128., (r1)+
	mov	LibIde, (r1)+
	clr	(r1)+
	clr	(r1)+
	mov	#202, (r1)		; Write access and Mapping
	.plas
	call	Error
	mov	firqb+fqppn, WinIde	; Window ID
	clr	CurSek			; Current maped sektion.
	
	mov	#100, ResLim
	bis	#UseRes, KSW		; Now we uses a RESLIB
					;  for our commands.

	mov	#2,r2
	gos	Get, <#1, r2, #FB1, #1, #Lock>	; Get INFO-block
	cmp	#xDBVer, FB1+32	; Right DATABASE Version
	beq	20$
	iot

20$:	bit	#1, FB1+34
	beq	40$
	mov	#1,r0
	call	Releas
	Write	#KOMAVS
	jmp	$exit

40$:	mov	FB1+110, HshSiz
	mov	FB1+112, HshEnd

ALIINI:	mov	#Alias1, r1		; Alias INIT.
	mov	r1, LstMem
	clr	(r1)+
	mov	#GRPLST, (r1)+		; Link to KOMRES.
	clr	(r1)+			; rArg
	clr	(r1)+			; Priority none.
	clr	(r1)+			; rPri2
	clr	(r1)+			; rTyp
	clr	(r1)+			; rStr
	mov	r1, NxtMem
	
	mov	#BasAdr, r5		; LIBINF
	cmp	#xLibUi, (r5)
	beq	RESINI
	jmp	CONT

RESINI:	mov	#1, r0			; Init. Resedent Library
	call	Exlock
	mov	#xLibIn, (r5)+
	mov	FB1+22, (r5)+		; # of created text's
	mov	FB1+24, (r5)+
	mov	#17, (r5)+		; Edit # for groups
	mov	#17, (r5)+		; Edit # for texts
	mov	FB1+34, (r5)+		; DSW
	clr	(r5)+			; LSW2
	mov	#FB1+62, r1
	mov	(r1)+, (r5)+		; N[TPERSON n
	movb	(r1)+, r0
	movb	r0, (r5)+
5$:	movb	(r1)+, (r5)+		; KOM's net-address
	sob	r0, 5$
	mov	#PreLst, r1
	call	GetAdr
	mov	r1, r5
	mov	#64.*4, r0
10$:	clr	(r5)+
	sob	r0, 10$
	mov	FB1+30, r4		; Number of groups.
	mov	FB1+42, tmp
	mov	#FSTGRP, NxtAdr		; Start addres of grouplist
	mov	#GRPLST, LstAdr		; Previous linked group.
	mov	LibSiz, r1
	asr	r1
	asr	r1
	bic	#177037, r1
	mov	r1, LibSiz		; Highest possible sektion.
	clr	r1			; Number of linked groups.

INLNK:	mov	r4,r3
	beq	50$
	cmp	#<<EOFB4-STKEND+2>/1000>*10, r3	; Maximum number of groups
	bhis	10$				;  to be read.
	mov	#<<EOFB4-STKEND+2>/1000>*10, r3
10$:	mov	r3,r5
	dec	r5
	ash	#-3,r5			; Number of blocks left to get
	inc	r5
	mov	#stkend+2,r0
	gos	Get, <#4, r2, r0, r5, #Unlock>
	add	r5,r2
20$:	inc	r1
	dec	r4
	tst	(r0)
	beq	30$
	call	maklst
	cmp	#-1, NxtAdr
	beq	50$
30$:	add	#64.,r0
	sob	r3,20$
	br	INLNK

50$:	mov	#LibInf, r1
	call	GETADR
	mov	r1,r5
	add	#100, r1
	mov	LstAdr, (r1)+
	mov	NxtAdr, (r1)+
	mov	LibSiz, (r1)
	mov	#xLibRd, (r5)
	mov	#1, 10(r5)		; Edit # for texts

	mov	#Mutex, r1
	call	GetAdr
	mov	#-1, (r1)+		; Init value for this semaphore.
	clr	(r1)+			; Owner job nr (no one now).

CONT:	mov	#1, r0
	call	Releas
	
505$:	cmp	#xLibRd, (r5)
	beq	530$

510$:	cmp	#xLibIn, (r5)		; This is not possible!
	beq	520$			; You can't be here!
	iot

520$:	mov	#2, xrb
	.sleep
	br	505$
	
530$:	mov	6(r5), EditNr
	
PseWho::

	mov	#stack, sp
	mov	#ovlstk, ovlsp
	mov	#UsNPrs, r0
	mov	r0, Me
	mov	#GRPLST, r1
	call	FindCm
	tst	r0
	bne	10$
	jmp	quit$
10$:	mov	rArg-rStr(r0), MyRec
	mov	rHigh-rStr(r0), MyHigh
	gos	GetMe,	<#FB1>
	mov	102(r1), MyRead
	mov	104(r1), MyPoin
	mov	106(r1), FileNr
	mov	142(r1), NrDist
	mov	144(r1), DstRec
	
RNEWS:	mov	me, r0
	call	GetHig
	mov	r0, MyHigh
	mov	MyRead, r0
	cmp	MyRead, MyHigh
	bhis	$FIN
	call	FixLet
	tst	unrel
	beq	$FIN
	tst	@unrel
	beq	$FIN

10$:	call	RdLet
	mov	MyRead, r0
	tst	@unrel
	bne	10$
	br	RNEWS

$FIN:	call	MtxBgn
	gos	LockMe,	<#FB1>
	mov	MyRead, 102(r1)
	mov	MyPoin, 104(r1)
	mov	FileNr, 106(r1)
	gos	Put,	<#1,, #FB1>	
	call	MtxEnd
	call	pcrlf
	jmp	quit$

RdLet:	tst	unrel
	bne	10$

5$:	jmp	1000$

10$:	mov	@unrel, r1
	beq	5$
	cmp	#-1, r1
	bne	100$

	push	#10$

20$:	add	#2, unrel
	mov	@unrel, mypoin
	add	#2, unrel
	rts	pc

100$:	add	#2, unrel
	cmp	#-1, @unrel
	bne	200$
	call	20$

200$:	inc	myread
	mov	r1, OldL
	mov	#FB4, CurBlk
	clrb	InRpTo
	clr	ComntP

	call	MtxBgn

	gos	GetRec,	<#2, r1, CurBlk,>
	mov	r1, r5
	.date
	mov	xrb, 44(r1)		; Set received-datum...
	mov	xrb+2, 46(r1)
	gos	Put,	<#2,, CurBlk>

	call	MtxEnd

	add	#6, r1
	call	GetDat

	mov	12(r5), r0
	call	GetFrm
	bcs	1000$
	
	mov	r5, r1
	call	MrkHdr

	mov	r5, r1
	call	GetIRT

	tst	OutTbP+2		; Nr of receivers
	beq	1000$			; No receiver => exit!

300$:	call	OpnNxt
	
	Write	#PthUfh
	Write	#frmPth
	call	pcrlf

320$:	mov	#zFrom, r1
	tst	OutTbP
	beq	325$
	mov	#zSend, r1
325$:	call	strout
	Write	#From

	call	DspHd

	Write	#zDate
	Write	#Date
	call	pcrlf
	
	Write	#zID
	mov	#TxtNr, r0
	call	MakeID
	call	strout
	call	pcrlf

340$:	tstb	InRpTo
	beq	350$
	tst	OutTbP+30
	bne	350$

	Write	#zRefer
	Write	#InRpTo
	call	pcrlf

350$:	Write	#zOrg
	Write	#OrgUfh
	call	pcrlf

390$:	gos	OutTxt,	<20(r5), 22(r5), #FB3>

	bic	#UtmOn, KSW
	call	UtmOff

1000$:	rts	pc

OpnNxt:	push	<r0, r1, r2, r3, r4, r5>
	mov	FileNr, r1
	mov	#OutFil+7, r2
	mov	#4, r3
20$:	clr	r0
	div	#10., r0
	add	#'0, r1
	movb	r1, -(r2)
	mov	r0, r1
	sob	r3, 20$
30$:	mov	#'>, r0
	call	ttyout
	mov	#OutFil, r1
	call	strout
	call	pcrlf
	inc	FileNr
	call	opnfil
	bis	#UtmOn, KSW
	pop	<r5, r4, r3, r2, r1, r0>
	rts	pc

;+ Data passed: R1, The address of a 2-word block containing date in RSTS/E
;		    internal format.
;-
GetDat:	push	<r0, r1, r2, r3>
	mov	(r1)+, firqb+4
	mov	(r1), firqb+22
	movb	#uu.cnv, firqb+fqfun
	mov	#-1, firqb+6		; DD-MON-YY format!
	mov	#1, firqb+24		; 24-hour time
	.uuo	
	mov	#firqb+10, r1
	mov	#firqb+21, r0
	mov	#Date+1, r2
20$:	cmpb	-(r0), #40
	beq	20$			; Discard trailing spaces
	sub	r1, r0
	inc	r0
30$:	movb	(r1)+, r3
	cmpb	#'-, r3
	bne	40$
	mov	#40, r3
40$:	movb	r3, (r2)+
	sob	r0, 30$
	movb	#40, (r2)+
	mov	#firqb+26, r1
	mov	#5, r0
50$:	movb	(r1)+, (r2)+
	sob	r0, 50$
	mov	#METT, r1
	movb	(r1)+, r0
60$:	movb	(r1)+, (r2)+
	sob	r0, 60$
	sub	#Date+1, r2
	movb	r2, Date

	pop	<r3, r2, r1, r0>
	rts	pc

;+
; MrkHdr marks all specified headers.
; Call:	r1, pointer to TEXT record in memeory (File 2).
;-

MrkHdr:	push	<r0, r1, r2, r3, r4, r5>
	mov	r1, r5

	mov	#OutTbP, r3
	mov	#EoOTbP-OutTbP, r2
5$:	clrb	(r3)+
	sob	r2, 5$
	bit	#xEXT, 14(r5)
	beq	10$
	bit	#xEXIN, 14(r5)
	beq	20$

10$:	jmp	400$
	
20$:
	gos	opnlin,	<#FB3>
	
	mov	14(r1), TxtNr
	bne	40$
	tst	16(r1)
	bne	40$
	mov	2(r5), TxtNr
	mov	4(r5), TxtNr+2
	br	50$

40$:	mov	16(r1), TxtNr+2
50$:	inc	r2

300$:	dec	r2
	beq	400$
	
	gos	gtln			; Get next line into TmpStr / r1.
	clr	r0
	bisb	(r1)+, r0
	beq	300$
	
	dec	r0
	beq	300$
	
	movb	(r1)+, r4
	sub	#'A, r4
	asl	r4
	inc	OutTbP(r4)
	br	300$

400$:	pop	<r5, r4, r3, r2, r1, r0>
	rts	pc

;+
; MakeID Makes an message-id: Ex. <353656@ufh.dynas.se>
; call:		r0,	pointer to longword
; Return:	r1,	point at buffer.
; Destroys TmpStr. May change section in KOMRES
;-

MakeID:	push	<r3, r2, r0>		; Must be in this order.
	mov	r1, r3
	mov	#MesID, r2
	push	r2
	clrb	(r2)+			; This is to be length-byte.
	movb	#'<, (r2)+
	mov	(r0)+, r1
	mov	(r0), r0
	call	Num32
10$:	movb	(r1)+, (r2)+
	sob	r0, 10$
	mov	#LibInf, r1
	call	GetAdr
	add	#20, r1
	movb	(r1)+, r0
40$:	movb	(r1)+, (r2)+
	sob	r0, 40$
	movb	#'>, (r2)
	pop	r1
	sub	r1, r2
	movb	r2, (r1)
	pop	<r0, r2, r3>
	rts	pc

;+
; GetFrm Creats a from field.
; Call r0, groupnumber.
;-

GetFrm:	push	<r2, r3>
	mov	#GrpLst, r1
	call	FindCm
	tst	r0
	beq	377$
	gos	GetRec,	<#1, rArg-rStr(r0), #FB1, #Unlock>
	add	#160, r1
	movb	(r1)+, r0
	beq	377$
	mov	#From+1, r2
	mov	#FrmPth, r3
	movb	r0, (r3)+
10$:	movb	(r1), (r2)+
	movb	(r1)+, (r3)+
	sob	r0, 10$
	mov	#LibInf, r1
	call	GetAdr
	add	#20, r1
	movb	(r1)+, r0
20$:	movb	(r1)+, (r2)+
	sob	r0, 20$
	movb	#40, (r2)+
	movb	#'(, (r2)+
	mov	FinPtr, r1
	call	GetAdr
	add	#rStr, r1
	movb	(r1)+, r0
30$:	movb	(r1)+, (r2)+
	sob	r0, 30$
	movb	#'), (r2)
	mov	#From, r1
	sub	r1, r2
	movb	r2, (r1)
	
	tst	(pc)+

377$:	sec
	pop	<r3, r2>
	rts	pc

proc	OutTxt,	<Blk, Pos, Buf>

begin
	push	<r2, r3, r4>
	mov	Buf(r5), r1
	gos	get,	<#3, Blk(r5), r1, #1, #Unlock>
	add	Pos(r5),r1		; Line (down)counter
	cmp	#-1, (r1)+
	beq	48$

42$:	Write	#Ilfr
	jmp	377$

48$:	gos	GetWrd,	<Buf(r5)>
	cmp	#1, r0
	bne	42$

	gos	GetWrd,	<Buf(r5)>
	mov	r0, r2		; # of lines!
	beq	200$

	gos	GetLin,	<Buf(r5)>
	push	r1
	mov	#TmpStr, r1
	movb	(r1)+, r0
	beq	80$
	push	r1
	Write	#SubjT
	pop	r1
50$:	cmpb	#':, (r1)+
	beq	70$
	sob	r0, 50$
	Write	#TmpStr
	br	75$

70$:	dec	r0
	beq	75$
	cmpb	#Spc, (r1)
	bne	71$
	inc	r1
	dec	r0
	beq	75$
71$:	tst	ComntP
	beq	74$

	push	<r0, r1>

	sub	#3, r0
	ble	72$
	cmpb	#'R, (r1)+
	bne	72$
	cmpb	#'e, (r1)+
	bne	72$
	cmpb	#':, (r1)+
	beq	73$
72$:	Write	#Reptxt
	
73$:	pop	<r1, r0>

74$:	call	PrintN

75$:	call	pcrlf
80$:	Write	#zLines
	mov	r2, r1
	dec	r1
	clr	r0
	call	deco16
	call	pcr2lf
	pop	r1
	br	100$

90$:	gos	GetLin,	<Buf(r5)>
	call	OutN

100$:	sob	r2,90$

200$:	tst	(pc)+
377$:	sec
	pop	<r4, r3, r2>
	ret


OutN:	push	r1
	mov	#TmpStr, r1
	movb	(r1)+, r0
	beq	7$
	cmpb	#'@, (r1)		; [r denna rad ett filnamn?
	beq	10$
5$:	call	PrintN			; Skriv ut raden (eller delen av raden)
7$:	call	pcrlf
	br	99$

10$:	inc	r1
	dec	r0
	beq	7$
	call	DispFi

99$:	pop	r1
	rts	pc


DspHd:	push	<r3, r4, r5>

	mov	r5, r1
	gos	opnlin,	<#FB3>
	inc	r2

50$:	dec	r2
	ble	80$
	call	gtln
	clr	r5
	bisb	(r1)+, r5
	beq	50$
	cmpb	(r1), #'+
	bne	55$

	inc	r1
	tst	r4
	bne	70$
	br	50$

55$:	clr	r4
	bisb	(r1)+, r4
	cmpb	r4, #'Z
	bne	60$
	clr	r4
	call	pcrlf
	br	70$

60$:	call	pcrlf
	sub	#'A, r4
	asl	r4
62$:	mov	OutTbl(r4), r1
	bne	64$

	clr	r4
	br	50$

64$:	clr	r4
	bisb	(r1), r4
	call	strout
65$:	mov	#Tmpstr+2, r1

70$:	dec	r5
	beq	50$
	mov	r5, r0
	call	PrintN
	br	50$

80$:	call	pcrlf
99$:	pop	<r5, r4, r3>
	rts	pc	


;+
; GetIRT finds the In-Reply-To-field.
; r1 must point at TEXT-record in memory.
;-

GetIRT:	push	<r2, r3, r4, r5>
	mov	r1, r5
	clrb	ComntP			; Until proved othervise!
	bit	#xKom, 14(r5)
	beq	999$
	mov	24(r5), r2		; Commented letter.
	beq	999$
	gos	GetRec,	<#2, r2, #FB1, #Unlock>
	cmp	#1, (r1)
	bne	999$
	bit	#xEXT, 14(r1)
	beq	999$
	bit	#xEXIN, 14(r1)
	beq	999$
	cmp	#UsNPrs, 12(r1)		; Created by UseNet?
	bne	999$			; No!
	
	mov	#True, ComntP

	gos	opnlin,	<#FB3>
	tst	r2
	beq	999$

10$:	call	gtln
	clr	r4
	bisb	(r1)+, r4
	beq	50$
	cmpb	#'F, (r1)+		;  Message-ID?
	bne	50$

	dec	r4
	beq	999$
	mov	#InRpTo, r2
	movb	r4, (r2)+
20$:	movb	(r1)+, (r2)+
	sob	r4, 20$
	br	999$

50$:	sob	r2, 10$

999$:	pop	<r5, r4, r3, r2>
	rts	pc

; CLOSE indicated channel.

proc	close	<ch>
	begin
	call	clrfqb
	movb	ch(r5), firqb+fqfil
	asl	firqb+fqfil
	calfip
	ret

Proc	Rename	<ext>
	begin
	movb	#RENFQ, Firqb+FqFun
	clr	Firqb+FqFil
	mov	#-1, Firqb+FqSiz
	mov	Firqb+FqNam1, Firqb+FqNam2
	mov	Firqb+FqNam1+2, Firqb+FqNam2+2
	mov	ext(r5), Firqb+FqFlag
	clr	Firqb+FqPFlg
	calfip
	call	Filerr
	ret	

SavFqb:	push	<r2, r1, r0>
	mov	#Firqb, r1
	mov	#FqbBuf, r2
	mov	#20, r0
10$:	mov	(r1)+, (r2)+
	sob	r0, 10$
	pop	<r0, r1, r2>
	rts	pc

RstFqb:	push	<r2, r1, r0>
	mov	#Firqb, r1
	mov	#FqbBuf, r2
	mov	#20, r0
10$:	mov	(r2)+, (r1)+
	sob	r0, 10$
	pop	<r0, r1, r2>
	rts	pc

; Delete (mark for deletion) the file indicated by firqb contents

kill:	movb	#DLNFQ, firqb+fqfun
	calfip
	call	Filerr
	return

quit$:	jmp	$exit

NrDist:	.word	0
DstRec:	.word	0
FileNr:	.word	0
NrRece:	.word	0
NrFrom:	.word	0
TxtNr:	.blkw0	2
ComntP:	.word	0

FqbBuf:	.blkw0	20

SubBuf:
Date:	.blkb	200

MesId:	.blkb	200

From:	.blkb	200

FrmPth:	.blkb	20

InRpTo:	.blkb	200

Text	KOMAVS,	<"KOM {r f|r tillf{llet avst{ngt."<15><12>>
Text	WlkMes,	<"RNews   Ver 1.00 ">
Text	OutFil,	<"UN0000.USU">
Text	METT,	<" MET">
Text	IlFr,	<"?Illigal text-format">

Text	SubjT,	<"Subject: ">
Text	RepTxt,	<"Re: ">
Text	OrgUfh,	<"UFH-Haninge, Sweden">
Text	PthUfh,	<"Path: ufh!">

Text	zFrom,	<"From: ">
Text	zTo,	<"To: ">
Text	zSend,	<"Sender: ">
Text	zBcc	<"Bcc: ">
Text	zDate,	<"Date: ">
Text	zId,	<"Message-ID: ">
Text	zRep,	<"Reply-To: ">
Text	zRepTo,	<"In-Reply-To: ">
Text	zRecei,	<"Receiver: ">
Text	zCc,	<"Cc: ">
Text	zNewsG,	<"Newsgroups: ">
Text	zLines,	<"Lines: ">
Text	zRtPth,	<"Return-Path: ">
Text	zStat,	<"Status: ">
Text	zRefer,	<"References: ">
Text	zKeyW,	<"Keywords: ">
Text	zOrg,	<"Organization: ">
Text	zXref,	<"Xref: ">
Text	zFolT,	<"Followup-To: ">

	.even

OutTbl:	.word	zFrom			; 'A'
	.word	zNewsG			; 'B'
	.word	zSend			; 'C'
	.word	0			; 'D'
	.word	0			; 'E'
	.word	0			; 'F'
	.word	zRep			; 'G'
	.word	zRepTo			; 'H'
	.word	0			; 'I'
	.word	0			; 'J'
	.word	zRtPth			; 'K'
	.word	zStat			; 'L'
	.word	zRefer			; 'M'
	.word	zKeyW			; 'N'
	.word	zOrg			; 'O'
	.word	zXref			; 'P'
	.word	zFolT			; 'Q'

OutTbP:	.blkw0	20.
EoOTbP:

	.even

EOKOM:	.End	INIT