//CHATCOMINIT.BCPL - Bob Sproull - Pup User Telnet - BCPL
// Copyright Xerox Corporation 1979, 1980
// modified: February 24, 1980  2:44 PM (E. Taft)

//Initialization of communication free storage and of communications.

get "Chat.d"
get "ChatBSP.d"

//outgoing procedure
external [
	ChatComInit
	ChatComOpen
	]

//incoming procedures
external [
//CHAT
	GetString
	GetKey
	CheckShiftSwat
	DirectKeys
	ChatHandlePup
	InitAudio

//BSP
	InitPupLevel1
	OpenLevel1Socket
	CloseLevel1Socket
	SetAllocation
	OpenRTPSocket
	GetPartner
	CreateBSPStream
	GetPBI
	AppendStringToPup
	CompletePup
	ReleasePBI

//ALTOTIME
	SetTimer
	TimerHasExpired

//OS
	Allocate
	InitializeZone
	EraseBits
	GetBitPos
	MoveBlock
	SetBlock
	Ws
	Wns

//CONTEXT
	InitializeContext
	CallContextList
	Block

//QUEUE
	Enqueue
	Unqueue
	Dequeue

//ETHERBOOT
	EtherBoot
	]

//incoming statics
external [
// CHAT
	Parm			//Chat paramters
	ComZone			//Chat free storage pool for communications
	ComZoneLeft
	TTYSoc; TTYStr		//Socket, stream for TTY connection
	DISSoc; DISStr		//Socket, stream for DIS connectoin
	ctxQ			//Main context Q
	makeBootFile

// SYSTEM
	UserName
	UserPassword
	lvAbortFlag
	dsp
	]

static InitDone

let ChatComInit(zoneBottom, zoneLength) be
[CI

	ComZone = InitializeZone(zoneBottom, zoneLength)

	ctxQ=Allocate(ComZone, 2)
	ctxQ!0=0

// Do this first so it gets the highest-priority interrupt channel:
	InitAudio(ComZone, 30)

	InitPupLevel1(ComZone, ctxQ, nTotalPBI, nBytesPerPup)

	TTYSoc=Allocate(ComZone, lenBSPSoc)
	DISSoc=Allocate(ComZone, lenBSPSoc)

//Now start communicating:
	@lvAbortFlag = @lvAbortFlag +1
	ChatComOpen()

	Allocate(ComZone, #77777, lv ComZoneLeft)

]CI

and ChatComOpen() be
[
	InitDone=false
	let initCtx=vec 200
	Enqueue(ctxQ, InitializeContext(initCtx, 200, ChatInitAux))

	until InitDone do
		[
		CallContextList(ctxQ!0)
		CheckShiftSwat()
		]

	Unqueue(ctxQ, initCtx)
]

and ChatInitAux() be
[CIX

// There are three numbers that determine allocation:
//	nDisplayPBI	-- those allocated to display connection
//	nTtyPBIDis	-- those allocated to tty connection if display on
//	nTtyPBI		-- those allocated to tty connection if no display
// Actually allocate one more to be under the receiver.

let disp=Parm>>PARM.DisplayProtocol
let ttyAllocn=(disp)? nTtyPBIDis,nTtyPBI

DISStr=0
DirectKeys(dsp)

test Parm>>PARM.Server then
[Server
   Ws("*NListening for connection")
   OpenLevel1Socket(TTYSoc, table [ 0; 0; socketTelnet ])
   SetAllocation(TTYSoc, ttyAllocn, ttyAllocn-2, 4)
   until OpenRTPSocket(TTYSoc, ctxQ, modeListenAndWait, 0,0,0, ComZone)
		do loop
]Server
 or

[User
//Parse the user's description of the intended partner, using the
// name lookup facilities if necessary.
	let frnPort=vec lenPort

	[
	// Prompt user if coming from a boot file:
	let cs=lv Parm>>PARM.ConnectString
	if @cs eq 0 then GetPromptString("*nConnect to: ",cs,true," ")
	if GetPartner(cs, dsp, frnPort, 0, 1) & frnPort>>Port.host ne 0 break
	@cs = 0
	] repeat

//Note: all hosts that respond to the "where is user" request to the
// Miscellaneous server are assumed to be AutoLogin servers.
// This includes Maxc and IFSs running version 1.18 or newer.

	Login()  // Would like not to do this if server doesn't
		// require login, but have to send user name to find out!
	let jobNumber=nil
	let how=SetMaxcStrategy(frnPort, Parm>>PARM.MAXCForce, lv jobNumber)

	OpenLevel1Socket(TTYSoc, 0, frnPort)
	SetAllocation(TTYSoc, ttyAllocn, ttyAllocn-2, 4)
	if OpenRTPSocket(TTYSoc, ctxQ, 0,0, ChatHandlePup,0, ComZone) then
		[ if how gr 1 then InitialString(how, jobNumber); break ]
	Ws("*nFailed to open connection.")
	CloseLevel1Socket(TTYSoc)
	@(lv Parm>>PARM.ConnectString) = 0
]User repeat

TTYStr=CreateBSPStream(TTYSoc)

Ws("*nConnected to: ")
PrintPort(lv TTYSoc>>PupSoc.frnPort)

InitDone=true
Block() repeat		// kludge
]CIX


//Login()
//	If necessary, prompt user for name,password,acct and save away
//	in core.

and Login() be
[LI
   if Parm>>PARM.MAXCForce eq 1 then return
   if UserPassword>>STR.length gr 0 & UserPassword>>STR.length ls 20 then return
   GetPromptString("*nName: ", UserName, true, " ")
   GetPromptString("Password: ", UserPassword, false," (pst)")
]LI

and GetPromptString(msg,addr,echo,after) be
[
   Ws(msg)			//Prompt
   let p = GetBitPos(dsp)
   if echo then Ws(addr)	//was there
   let c=GetKey()
   if c ne $*s & c ne $*n then
		[
		if echo then EraseBits(dsp, p-GetBitPos(dsp))
		GetString(addr, echo, true, c)
		]
   Ws(after)
]


//SetMaxcStrategy()
// Sends inquiries to MAXC to discover where the user is, if at all.
// MAXCForce contains a code for what the user wants:
// 0=CHAT decides; 1=no prologue; 2=login; 3=attach or login
// Returns:
//	1	No prologue
//	2	Use a login sequence
//	3	Use an attach sequence, jobnumber= MaxcJobNumber
//	4	Attach, but ambiguous number of jobs

and SetMaxcStrategy(frnport, MAXCForce, lvJobNumber) = valof
[SMS
@lvJobNumber=0

//If user wants a forced login or if he wants nothing done, return:
if MAXCForce eq 1 % MAXCForce eq 2 then resultis MAXCForce

let soc=vec lenPupSoc
let infoPort=vec lenPort
MoveBlock(infoPort, frnport, lenPort)
infoPort>>Port.socket↑1=0
infoPort>>Port.socket↑2=socketMiscServices

OpenLevel1Socket(soc, 0, infoPort)

let answer=1			//Assume no prologue
for i=1 to 5 do			//Try five times....
[SendWherePup
	let p=GetPBI(soc)
	AppendStringToPup(p, 1, UserName)
	p>>PBI.pup.type = typeWhereUserRequest
	CompletePup(p)

	let wait=nil; SetTimer(lv wait, 200)	// 2 sec
	Block() repeatuntil TimerHasExpired(lv wait) %
	   soc>>PupSoc.iQ.head ne 0
	p=Dequeue(lv soc>>PupSoc.iQ)
	if p eq 0 then loop
	let pup=lv p>>PBI.pup
	switchon p>>PBI.pup.type into
	[
case typeWhereUserReply:
   [
   answer = 2  // Assume login
   let nb=pup>>Pup.length-22	//Number of data bytes
   for i=1 to nb by 2 do
	[
	let job=pup>>Pup.bytes↑i
	let term=pup>>Pup.bytes↑(i+1)
	if term eq #377 then	//Found detached
	   [
	   answer=3		//Assume an attach command
	   test @lvJobNumber then answer=4
			or @lvJobNumber=job
	   ]
	]
   ReleasePBI(p)
   break
   ]
case typeError:
   [
   if pup!10 eq 2 then [ ReleasePBI(p); break ]  // no such port
   ]  // fall thru
default:
   [
   ReleasePBI(p)
   ]
	]			//Switchon
]SendWherePup

CloseLevel1Socket(soc)
resultis answer
]SMS

//InitialString(MAXC, jobNumber)
// Computes an initial string to send to the connection, governed
// by "MAXC" (see comments in SetMaxcStrategy, above)

and InitialString(MAXC, jobNumber) be
[
	let AppendC(c) be
		[
		let str=(lv Parm>>PARM.InitialString)
		let i=str>>STR.length+1
		str>>STR.char↑i=c
		str>>STR.length=i
		]
	and PlugString(s) be
	   for i=1 to s>>STR.length do AppendC(s>>STR.char↑i)

   if MAXC le 1 then return

   if MAXC eq 4 then
	[
	PlugString("Where "); PlugString(UserName); PlugString("*N")
	]
   PlugString(((MAXC eq 2)? "Login ","Attach "))
   PlugString(UserName)		//Plug in his name
   PlugString(" ")
   PlugString(UserPassword)
   PlugString(" ")
   test MAXC eq 2 then [ PlugString("1*N") ] or
	if MAXC eq 3 then
	   	[
		let div=10
		let going=false
		for i=1 to 2 do
			[
			let digit=jobNumber/div
			if going ne 0 % digit ne 0 then
				[
				going=true
				AppendC(digit+$0)
				]
			jobNumber=jobNumber-div*digit
			div=div/10
			]
		AppendC($*N)
		]
]

//Print out a network address

and PrintPort(p) be
[
Ws("["); Wns(dsp, p>>Port.net, 1, 8)
Ws("#"); Wns(dsp, p>>Port.host, 1, 8)
Ws("#"); Wns(dsp, p>>Port.socket↑1, 1, 8)
Ws("|"); Wns(dsp, p>>Port.socket↑2, 1, 8)
Ws("]")
]