.title	CREME		; Create Meeting

	.inclu	"b:global"

	Text	NtStat,	<"Status            <|ppet>">
	Text	ailmax,	<"Inl{ggs max <obegr{nsatt>">
	Text	pvp,	<"Privilegier   <Anv{ndare>">
	Text	grpp,	<"Typ av grupp       <M|te>">
	Text	me1,	<"Slutet m|te         <Nej>">
	Text	me2,	<"Skrivskyddat m|te   <Nej>">
	Text	rep,	<"Vad vill du kalla gruppen">

	Text	lose,	<"L|senord                 ">
	Text	lose2,	<"Som kontroll, l|senordet ">
	Text	lose3,	<"Nytt l|senord		<Samma>">
	Text	lose4	<"Nytt l|senord		       ">

	Text	fail,	<"L|senorden {r ej lika, f|rs|k igen."<15><12>>
	Text	fail2,	<"F|r kort l|senord. Minst 4 tecken kr{vs."<15><12>>

fail3:
	.byte	20$-10$
10$:	.ascii	"Till}tna {r alla skrivbara tecken."<15><12>
	.ascii	"OBS! KOM skiljer INTE p} STORA och sm} bokst{ver"
	.ascii	" (a-})."<15><12>
20$:
dlosen:	.asciz	"??????"
	.even
paswp1:	.word	lose
	.word	0

paswp2:	.word	lose3
	.word	6

paswp3:	.word	lose4
	.word	6

	sect	code

nogo:	write	#dhir
	rts	pc

mafe:	Write	#MAF
	rts	pc

;+
; CrePer creates a person.
; Argument:	r0 = Privs for the person to be created.
;		r1 = Address of "name"-string.
;
; Return:	r0 = Logical #. or carry set (if something went wrong)
;-

oCrPer:	clr	tmp+12			; Are to be logical group-nr.
	mov	r0, tmp+20		; Flag to creme (and privs)
	mov	r1, r0
	mov	#Pstr1, r1
	call	MovStr			; Move name-string.
	clr	r0
	bisb	(r1)+, r0		
	mov	r1, Strs+2
	add	r1, r0
	mov	r0, Strs+4
	call	Creme2
	mov	tmp+12, r0
	beq	fusk
	cmp	#11147, tmp+20		; Everything is ok number!
	beq	fusk
	clr	r0
fusk:	rts	pc

oCrMe:	bitb	#xCEME, mypriv+1
	beq	nogo
	Reparse	#2, #rep		; After this r0 = 2 (importent)
	bcs	fusk
	clr	tmp+20

Creme2:	mov	#LstGrp, r1
	call	GetAdr
	cmp	#-1, 2(r1)
	beq	mafe			; No room left in memory.
	setnam	#"CR
	mov	sp, tmp+14
	mov	strs+2, r1
	mov	strs+4, r0
	sub	r1, r0
	dec	r0

	mov	#FB3+1, r2
	movb	r0, FB3
	call	ambtst
	bcc	2$
	write	#amb
	jmp	rt

2$:	movb	(r1)+, (r2)+
	sob	r0, 2$
	tst	tmp+20
	beq	99$
	inc	r0
	br	110$			; Person (r0 = 1)

99$:	mov	#1, r1
	cmpb	MyPriv, #xSuU
	blo	110$			; M|te (r0 = 0)
	beq	9905$
	bis	#10, r1
9905$:	parser	#PMLST, r1, #grpp
	call	PCRLF
	tst	level
	bne	100$
	clr	r0
	br	110$

100$:	mov	found, r1
	call	GetAdr
	mov	(r1),r0
110$:	mov	r0, tmp+10
	mov	#4, r0			; M\TE (-1 = PERSON)
	sub	tmp+10, r0		; PERSON-p

	mov	#FB2, r1
	push	<r1, r0>
	mov	#100, r0
112$:	clr	(r1)+			; Clear the area before use.
	sob	r0, 112$
	pop	<r0, r1>

	mov	r0, (r1)+		; PERSON eller M\TE (typ)
	clr	(r1)+
	clr	(r1)+
	push	r1
	clr	(r1)+			; Logiskt nummer.
	mov	me, (r1)+		; Skapare
	.date
	mov	xrb, (r1)+
	mov	xrb+2, (r1)+
	clr	(r1)+			; Default flagword
	clr	(r1)+
	clr	(r1)+			; Presentation
	clr	(r1)+			; Antal medlemmar
	push	r1
	clr	(r1)+			; MEDLEMSSKAP
	clr	(r1)+
	push	r1
	clr	(r1)+			; MOTTAGNA
	clr	(r1)+
	cmp	#1, tmp+10
	bhi	meet
	blo	netp

	push	r1
	clrb	(r1)+			; Privs
	movb	#377, (r1)+		; Default rights.
	mov	#6., r0
123$:	clr	(r1)+
	sob	r0, 123$
	push	r1
	mov	#dlosen, r0
3$:	movb	(r0)+, (r1)+
	bne	3$
	dec	r1

;	clr	(r1)+
;	clr	(r1)+			; Senast inne.
;	clr	(r1)+			; Antal markerade.
;	clr	(r1)+
;	clr	(r1)+			; Pekare till MARKERADE (fil 2)
;	clr	(r1)+			; L{sta brev
	mov	#100, r0
30$:	clr	(r1)+
	sob	r0, 30$
	jmp	opop

netp:	call	pcrlf
	cmp	(sp)+, (sp)+
	clr	r3
	PARSER	#NetSta, #-1, #NtStat
	call	pcr2lf
	mov	#found, r2
	mov	level, r0
	beq	20$

10$:	mov	(r2)+, r1
	call	GetAdr
	bis	(r1), r3	
	sob	r0, 10$

20$:	mov	r3, FB2+16		; FlagWord
	jmp	xgen

meet:	mov	#xOPN, r2
	PARSER	#janejl, #377, #me1	; Slutet ?
	call	PCRLF
	tst	level
	beq	10$
	mov	Found, r1
	call	GetAdr
	tst	(r1)
	beq	10$
	bic	#xOPN, r2		; Bit 1

10$:	PARSER	#janejl, #377, #me2	; Skrivskyddat ?
	call	PCR2LF
	tst	level
	beq	20$
	mov	found, r1
	call	GetAdr
	tst	(r1)
	beq	20$
	bis	#xWP, r2

20$:	mov	r2, FB2+16
	pop	<r0, r0>

	jmp	xgen


; Well, now we just have to ask for a password and the privs.


opop:	push	<#10$, r0, r1, r2, r3>
	mov	#paswp1, tmp+6
	jmp	ps2

10$:	tstb	tmpstr
	beq	opop

	movb	tmpstr, r0
	inc	r0
	mov	#tmpstr, r1
	mov	#tmp, r2
20$:	movb	(r1)+, (r2)+
	sob	r0, 20$

	pop	r3
	mov	r3, tmp+16

; Done with the password now continue with the privs.

prvs:	mov	tmp+20, r0
	bne	40$
	mov	#PRILST,r1
	bit	#ABSPRV, KSW		; Absolutprivs-P
	bne	20$			; Yes! May create all types.
	clr	r0
	bisb	MyPriv, r0
	gos	findcm
	mov	rNxt-rstr(r0), r1

20$:	PARSER	r1, #377, #pvp
	tst	level
	bne	30$
	mov	#xUser, r0
	br	40$

30$:	mov	found, r1
	call	GetAdr
	mov	(r1), r0

40$:	pop	r2			; Privs
	movb	r0, (r2)
	call	PCR2LF

; Here comes a dangerous section.

	call	MtxBgn
	call	ccoff

	mov	#1, r0
au:	mov	#FB1, r1
	call	spawn
	pop	r2
	mov	(r1), (r2)+
	mov	(r1), (r2)		; Till MOTTAGNA
	mov	(r1), 50(r2)		; Mypoin
	mov	#7, (r1)
	gos	put	<#1, r0, #FB1>
	mov	#1, r0
	mov	#FB1, r1
	call	spawn
	pop	r2
	mov	(r1), (r2)+
	mov	(r1), (r2)		; till MEDLEMSSKAP
	mov	#6, (r1)
	gos	put	<#1, r0, #FB1>
	br	xgen2

xgen:	call	MtxBgn
	call	ccoff

xgen2:	gos	get	<#1, #2, #FB1, #1, #lock>
	mov	#1, r0
	call	exlock
	mov	#FB1, r0
	inc	30(r0)
	mov	30(r0), r1		; det LOGISKA numret
	mov	r1, tmp+12
	cmp	#1, tmp+10		; Person?
	bne	8$			; No...

	; Move default values for PERSONs.

	mov	tmp+16, r2		; I'm not responsible for this
	mov	114(r0), 16-54(r2)	; mess/AG
	mov	116(r0), 124-54(r2)
	mov	120(r0), 126-54(r2)

8$:	gos	put,	<#1, #2, #FB1>
	pop	r2			; Address to logical number position
	mov	r1, (r2)+
	tst	tmp+20
	beq	10$
	mov	r1, (r2)		; Creator (Self)
10$:	mov	r1, r0			; His/Her logical number
	mov	tmp+10, r0
	cmp	#1, tmp+10
	bne	gen

	clr	r0
	bisb	FB2+36, r0
	gos	crypt, <#tmp, tmp+12, r0>	; enkrypt the password.
	mov	r1, r2
	mov	#CODLEN, r4
	mov	tmp+16, r3
	mov	#1, (r3)+
45$:	movb	(r2)+, (r3)+		; thansfer it to a better place.
	sob	r4, 45$

gen:	mov	#1, r0
	mov	#FB1, r1
	call	spawn
	push	(r1)
	mov	#FB2, r2
	mov	#100, r3
50$:	mov	(r2)+, (r1)+
	sob	r3, 50$
	gos	put	<#1, r0, #FB1>

; Now set the correct name in file 4

	mov	#FB1, r1
	mov	tmp+12, r0		; tmp+12 contains LOCIGAL number.
	call	crein4
	mov	r1, NxtAdr		; Temp. storage.
	push	r0
	mov	#2, r0
	sub	tmp+10, r0
	bne	56$
	mov	#10, r0
56$:	mov	r0, (r1)+
	pop	r0
	mov	(sp), (r1)+		; Fysiskt nummer.
	clr	(r1)+			; HIGH
	movb	FB3, r2
	movb	r2, (r1)+
	mov	#FB3+1, r3
60$:	movb	(r3)+, (r1)+
	sob	r2, 60$
	gos	put	<#4,, #FB1>
	gos	LnkGrp,	<Tmp+12, NxtAdr, #FB2>	; Put group in memory.

	call	MtxEnd
	call	ccon

	mov	#11147, tmp+20
	tst	tmp+10
	bne	rt

	mov	me, r0
	pop	r1
	call	addmem			; I must be a member in this meeting.

rt:	mov	#1, r0
	call	release
	mov	tmp+14, sp	
	rts	pc


; Asks for a (new) user password (and sometimes ask for the old one)

bbpw:	write	#ppp5
	sec
	pop	<r3, r2, r1, r0>
	rts	pc


oAsPwO:	push	<r0, r1, r2, r3>
	write	#ppp
	write	stat
	call	readln
	mov	4(sp), r1
	clr	r0
	bisb	36(r1), r0
	mov	r1, r3
	gos	crypt,	<#tmpstr,6(r1),r0>
	mov	#CODLEN, r0
;	mov	#CRYBUF, r2
	mov	r3, r2
	add	#56, r2
10$:	cmpb	(r2)+, (r1)+
	bne	bbpw
	sob	r0, 10$
	mov	6(r3), tmp+2
	clr	tmp+12
	bisb	36(r3), tmp+12		; Setup for "crypt" call.
	mov	#paswp1, tmp+6
	br	ps1

askpw2:	mov	r0, tmp+6
	push	<r0, r1, r2, r3>
ps1:	call	PCRLF
ps2:	mov	@tmp+6, r0
	write	r0
	write	stat
	call	readln
	call	upper
	call	PCRLF
	clrb	tmpstr+100
	mov	#tmpstr+100, r1
	mov	#tmpstr, r2
	movb	(r2), r0
	beq	30$
	inc	r0
10$:	movb	(r2)+, (r1)+
	sob	r0, 10$

	gos	crypt, <#tmpstr, tmp+2, tmp+12>
	bcc	15$
	write	#fail2
	br	ps1

15$:	write	#lose2
	mov	tmp+6, r0
	mov	2(r0), r0
	beq	17$
	call	spcout
17$:	write	stat
	call	readln
	call	upper
	call	PCRLF
	cmpb	tmpstr, tmpstr+100
	beq	30$

20$:	write	#fail
	br	ps1

30$:	tstb	tmpstr
	beq	40$
	mov	#tmpstr+1, r2
	mov	#tmpstr+101, r3
	movb	tmpstr, r0
35$:	cmpb	(r2)+, (r3)+
	bne	20$
	sob	r0, 35$
40$:	pop	<r3, r2, r1, r0>
	clc
	rts	pc


Proc	oAskPw,	<str, pers, privs>
Begin
	push	<r0, tmp+2, tmp+12>
	mov	str(r5), r0
	mov	pers(r5), tmp+2
	mov	privs(r5), tmp+12
	bic	#^c377, tmp+12
	push	r5
	call	askpw2
	pop	r5
	pop	<tmp+12, tmp+2, r0>
Ret

	.end