! 25 Jun 87
!
!	Written by Terry R. Lambert
!
! Various utility functions for the bbs
!

! Name:		xmit
! Purpose:	xmit with case sensitivity
! Parameters:	only one... not likeyley to use it a lot
proc xmit
	if lcase
		setvar outval "$1"
	else
		setvar outval toupper("$1")
	endif
	? "$(outval)";
endproc

! Name:		out
! Purpose:	commline display routine... adds CR or CR/LF if LF needed
! Parameters:	a list of 3 string variables to blow out down the line. All
!		variables must be space seperated, but will not be so in
!		the output stream.  All variables concatted to the current
!		line.  No arguments = newline operation.
proc out
	? "$1"
	return
	if "$1"!=""
		if nl & lcase
			xmit "$1\r\n"
			return
		endif
		if lcase
			setvar outval "$1"
		else
			setvar outval toupper("$1")
		endif
		xmit "$(outval)"
		xmit "\r"
		if nl
			xmit "\n"
		endif
	else
		xmit "\r"
		if nl
			xmit "\n"
		endif
	endif
	if "$2"!=""
		if lcase
			setvar outval "$2"
		else
			setvar outval toupper("$2")
		endif
		xmit "$(outval)"
		xmit "\r"
		if nl
			xmit "\n"
		endif
	endif
	if "$3"!=""
		if lcase
			setvar outval "$3"
		else
			setvar outval toupper("$3")
		endif
		xmit "$(outval)"
		xmit "\r"
		if nl
			xmit "\n"
		endif
	endif
endproc

! Name:		yesno
! Purpose:	get only an upper or lowercase "y" or "n" and echo back
!		"YES" or "NO" to the user
! Parameters:	The variable to be set to true (yes) or false (no)
proc yesno
	flush
	repeat
		setvar inval toupper(chrin())
		if inval="Y" | inval="\r"	! assume yes
			setvar $1 true
			? "Yes"
		elseif inval="N"
			setvar $1 false
			? "No"
		else
			setvar inval "X"
			if !quiet
				? "\007";
			endif
		endif
	until inval!="X"
endproc

! Name:		hitret
! Parameters:	none
! Purpose:	give a "hit return to continue message"
proc hitret
	? "     [ Hit RETURN to continue ]"
	repeat
		setvar rval chrin()
	until rval="\r" | rval="^C"
endproc

! Name:		paginate
! Parameters:	filename
! Purpose:	Display the contents of a file, paginated
proc paginate
	fopen 1,"$1"
	setvar count 0
	freadln 1,x
	repeat
		? x
		setvar count count+1
		freadln 1,x
		if count>lcount
			setvar count 0
			do @hitret
		endif
	until feof(1)
	fclose 1
endproc

! Name:		echoin
! Parameters:	variable to set, boolean: t=echo, boolean t=toupper
! Purpose:	Input character string until return executed up to 78 chars,
!		Echo or don't them back down the line ---- allow editing:
!		<DEL> or <BS> backs up one char.
proc echoin
	setvar inval ""
	repeat
		setvar incr chrin()
! Avoid haslle of double parsing quotes everywhere
		if incr='"'
			setvar incr "'"
		endif
		if $3
			setvar incr toupper(incr)
		endif
		if incr="\010" | incr="\177"
			if len(inval)>0
				if $2
					? "\010 \010";
				endif
				setvar inval left(inval,len(inval)-1)
			else
				if !quiet
					? "\007";
				endif
			endif
		elseif incr>=" " & incr<"\177"
			if len(inval)<llimit
				setvar inval inval+incr
				if $2
					? incr;
				endif
			else
				if !quiet
					? "\007";
				endif
			endif
		elseif incr!="\r"
				if !quiet
					? "\007";
				endif
		endif
	until incr="\r"
	setvar $1 inval
endproc

! Name:		userlkup
! Parameters:	string of firstname,space,lastname ("FRED MEYER")
! Purpose:	Do user lookup and load vars passwd, alias, lcount,
!		access; other prefs can be added as needed.

! record format:
! name ("first last")		 passwd alias		     pg ac   terminator
! ############################## ###### #################### ## #### xx
! 1234567890123456789012345678901234567890123456789012345678901234567890
proc userlkup
	setv newuser true
	fopen 1,"userlist"
	repeat
		fread 1,x
		if left("$1                              ",30)=left(x,30)
			setvar passwd midstr(x,32,6)
			setvar alias midstr(x,39,20)
			setvar lcount val(midstr(x,60,2))
			setvar access val(midstr(x,63,4))
			setvar newuser false
		endif
	until len(x)<1 | newuser=false
	fclose 1
endproc

! Name:		chpasswd
! Parameters:	the global passwd, boolean indicating "ask old password"
! Purpose:	allow the user to change his password.  Insists that it
!		not be nothing.  Not updated in base til fixuser is called
proc chpasswd
	if $1
		? "What is your old password? ";
		setvar llimit 6
		do @echoin opasswd false false
		setvar llimit dlimit
		?
		if left(opasswd+"      ",6)!=passwd
			? "Invalid.  Password not changed."
			return
		endif
	endif
	? "Passwords are 6 characters long.  If your password is longer,"
	? "than 6 characters, it will be truncated to 6."
	?
	repeat
		? "What is your new password? ";
		setvar llimit 6
		do @echoin passw1 false false
		?
		? "                    Again? ";
		do @echoin passw2 false false
		setvar llimit dlimit
		?
		if passw1!=passw2
			? "\007Password mistyped.  Try again."
		endif
	until passw1=passw2 and len(passw1)>0
	setvar passwd passw1
	do @fixuser "$(fname) $(lname)" passwd alias lcount access
	? "Password changed.  Please write down your new password to"
	? "prevent forgetting it.  If you lose your password, you must"
	? "contact the sysop and show identification in order to get"
	? "back in."
	?
endproc

! Name:		alias
! Parameters:	the global alias
! Purpose:	allow the user to choose an alias.  Aliases are 1 to 20 chars.
!		Not update in base til fixuser is called.
proc alias
	? "An alias is a name you wish to use when sending and receiving"
	? "mail.  No one will know your alias except the sysop, unless"
	? "you tell them.  Mail will be delivered to your name, your"
	? "alias, your last name, and your first name.  Your default"
	? "alias is $(alias).  You may enter an alternate alias now, or"
	? "keep this one.  Aliases cannot be changed once chosen, except"
	? "by a system operator, so choose carefully.  (This prevents"
	? "someone from logging in, changing their alias to yours, and"
	? "sending illicit mail, as if they were you, then changing it"
	? "back to prevent being caught or blamed)."
	?
	? "Please enter an alias or return for $(alias): "
	setvar llimit 20
	do @echoin nalias true true
	setvar llimit dlimit
	if trim(nalias)="SYSOP" | trim(nalias)="ADMIN"
		?
		? "\007$(nalias) is not an allowed alias."
		setvar nalias ""
	endif
	if len(nalias)>0
		setvar alias nalias
	endif
	do @fixuser "$(fname) $(lname)" passwd alias lcount access
	?
	? "Alias is $(alias)"
	?
	do @hitret
endproc

! Name:		fixuser
! Parameters:	Full name, password, alias, lcount, access
! Purpose:	Update the rights database in an orderly fashion, from one
!		generic entry point.  Full name is key and is *never* changed.

! record format:
! name ("first last")		 passwd alias		     pg ac   terminator
! ############################## ###### #################### ## #### xx
! 1234567890123456789012345678901234567890123456789012345678901234567890
proc fixuser
	setvar rname left("$1                               ",31)
	setvar rpass left($2+"       ",7)
	setvar ralia left($3+"                     ",21)
	setvar rpage left(str($4)+"   ",3)
	setvar raccs left(str($5)+"     ",5)
	setvar record rname+rpass+ralia+rpage+raccs+"xx"
	fopen 1,"userlist"
	fcreate 2,"ulist.tmp"
	setvar found false
	repeat
		freadln 1,x
		if len(x)>0
			if left(x,31)=rname & !found
				fwriteln 2,record
				setvar found true
			else
				fwriteln 2,x
			endif
		endif
	until len(x)=0
	if !found
!							newuser
		fwriteln 2,record
	endif
	fclose 2
	fclose 1
	rename userlist userlist.bak overwrite
	rename ulist.tmp userlist
endproc


! Name:		deluser
! Parameters:	Full name
! Purpose:	Delete a user from the rights database in an orderly fashion.
!		Use generic entry point.  Full name is key.

! record format:
! name ("first last")		 passwd alias		     pg ac   terminator
! ############################## ###### #################### ## #### xx
! 1234567890123456789012345678901234567890123456789012345678901234567890
proc deluser
	setvar rname left("$1                               ",31)
	fopen 1,"userlist"
	fcreate 2,"ulist.tmp"
	setvar found false
	repeat
		freadln 1,x
		if len(x)>0
			if left(x,31)=rname & !found
				! Delete record by not writing it out
				setvar found true
			else
				fwriteln 2,x
			endif
		endif
	until len(x)=0
	fclose 2
	fclose 1
	rename userlist userlist.bak overwrite
	rename ulist.tmp userlist
endproc

! Name:		chkper
! Parameters:	access mask to match, boolean variable
! Purpose:	set boolean variable false if no permission for attempted
!		operation (and give message), set true otherwise.  This
!		is the security checking procedure... Future versions will
!		use bits 0-6 (0-63) as access masks, thus allowing 64 levels
!		of security.  The mask will be passed and if (mask & access)
!		then true will be returned.  Naming the bits mightn't be a
!		bad idea... for instance, bit 6 cries out to be the sysop bit
proc chkper
	setvar x $1
	?
! They MUST have the proper bits unless they have admin access
	if ((access & x) > 0) | ((access & M_admin) > 0)
		? "Working..."
		setvar $2 true
		return
	endif
! Those with sysop access are OK for anything unless admin access is required
	if (((access & M_sysop) > 0) & !((x & M_admin) > 0))
		? "Working..."
		setvar $2 true
		return
	endif
	? "\007%NOPRIV: ";
	setvar $2 false
	switch
	case (x & M_regis) > 0
		? "You are not a registered user"
	case (x & M_email) > 0
		? "You have no access to the message system"
	case (x & M_uload) > 0
		? "You do not have upload priviledges"
	case (x & M_dload) > 0
		? "You do not have download priviledges"
	case (x & M_ukill) > 0
		? "You do not have unlimited message kill priviledges"
	case (x & M_user1) > 0
		? "You have not been given user1 priviledge"
	case (x & M_user2) > 0
		? "You have not been given user1 priviledge"
	case (x & M_sysop) > 0
		? "You are not a SYSOP"
	case (x & M_admin) > 0
		? "You are not the SYSTEM ADMINISTRATOR"
	endswitch
endproc

! Name:		lock
! Parameters:	file name to use in locking, variable to set to current user
!		if the file is already locked
! Purpose:	provide multi-user access to the bulletin board
proc lock
	? "Locking...$1"

	setvar tm time()
	setvar lckstr left("$(tm)                ",16)+"$(fname) $(lname)"
	if !exists("$1")
		iferror fcreate 1,"$1"
			setvar $2 "- Other I/O request"
			fclose 1
			return
		endif
	else
		fopen 1, "$1"
	endif
	freadln 1, lval
	if lval!=""
		setvar $2 "- "+midstr(lval,16,80)
		fclose 1
		return
	endif
	fwriteln 1,lckstr
	fclose 1
	wait 5
	setvar cout 0
	repeat
		setvar cout cout+1
		fopen 1, "$1"
		if _errno != 0
			wait 1
		endif
	until _errno = 0 | cout > 5
	freadln 1,lck2
	fclose 1
	if lck2 != lckstr
		setvar $2 "- "+midstr(lval,16,80)
		return
	endif
	setvar $2 ""
endproc lock

! Name:		wlock
! Parameters:	file name to use in locking, variable to set to current user
!		if the file is already locked
! Purpose:	provide multi-user access to the bulletin board; waits
!		up to 20 seconds for access to the locked file to allow
!		any non-administrative activity to die down
proc wlock
	setvar secs 20
	? "Locking...$1"

	setvar tm time()
	setvar lckstr left("$(tm)                ",16)+"$(fname) $(lname)"
	if !exists("$1")
		setvar cout 0
		repeat
			fcreate 1,"$1"
			if _errno != 0
				wait 1
			endif
		until _errno=0 | cout > secs
		if _errno!=0
			setvar $2 "- Other I/O request"
			fclose 1
			return
		endif
	else
		fopen 1, "$1"
	endif
	freadln 1, lval
	if lval!=""
		setvar $2 "- "+midstr(lval,16,80)
		fclose 1
		return
	endif
	fwriteln 1,lckstr
	fclose 1
	wait 5
	setvar cout 0
	repeat
		setvar cout cout+1
		fopen 1, "$1"
		if _errno != 0
			wait 1
		endif
	until _errno = 0 | cout > secs
	freadln 1,lck2
	fclose 1
	if lck2 != lckstr
		setvar $2 "- "+midstr(lval,16,80)
		return
	endif
	setvar $2 ""
endproc wlock

! Name:		unlock
! Parameters:	file name to use in unlocking
! Purpose:	provide multi-user access to the bulletin board
proc unlock
	? "Unlocking...$1"
	setvar cout 0
	repeat
		setvar cout cout+1
		erase $1
	until _errno = 0 | cout > 5
	if _errno!=0
		?
		? "Lockfile $1 left."
		? "Please report it to SYSOP for manual removal"
		do bbsio@hitret
	endif
endproc unlock
