REM *** SMTP Daemon v0.9 (c) 1995 Takoyaki Software Ltd
REM *** Programmed by Dylan Cuthbert

PROC main:

	local p%,s%,m%,rs%,r%
	local str$(255),com$(5),from$(255),to$(255)
	global netpid%,reply%,ferr%
	global buf$(255),b%,hostnam$(128)

	global smtpin$(128)
	global smtpout$(128)
	global tempdir$(128)
	global email$(128)
	global tmpnam$(128)

	b%=addr(buf$)

	hostnam$="frisbee.demon.co.uk"

	loadm("a:\opo\tcplib.opo")
		
	initnet:

	loadpref:

	print "SMTP Daemon v0.9"

	while 1
		s%=daemon:		

		buf$=""

		r%=respond:(s%,220)
		if r%<0: unlink: : continue : endif

		print "Connected"

		from$=""
		to$=""

		while 1
			str$=getline$:(s%)
			if asc(str$)=255 : break : endif

			if len(str$)<4 : respond:(s%,500) : continue : endif

			com$=upper$(left$(str$,4))
			if len(str$)>5 : str$=right$(str$,len(str$)-5) : else : str$="" : endif

			reply%=250

			if com$="HELO"

			elseif com$="MAIL"
				if upper$(left$(str$,5))="FROM:"
					to$=""
					from$=mid$(str$,loc(str$,"<")+1,loc(str$,">")-loc(str$,"<")-1)
					print "From: <"+from$+">"
				else
					reply%=504
				endif

			elseif com$="RCPT"
				if upper$(left$(str$,3))="TO:"
					if to$<>""
						reply%=552
					else
						to$=mid$(str$,loc(str$,"<")+1,loc(str$,">")-loc(str$,"<")-1)
						print "To: <"+to$+">"
					endif
				else
					reply%=504
				endif
			elseif com$="RSET"
				to$=""
				from$=""
			elseif com$="QUIT"
				break

			elseif com$="DATA"
				if to$="" or from$=""
					reply%=503
				else
					r%=respond:(s%,354)
					if r%<0 : break : endif

					r%=getdata:(s%,to$,from$)
					if r%<0 : break : endif
				endif

rem *** no commands recognised, so return 'Invalid command'

			else
				reply%=500

			endif

			r%=respond:(s%,reply%)

		endwh

		r%=respond:(s%,221)
		unlink:
	endwh


ENDP

PROC getdata:(s%,to$,from$)
	local f%,r%,str$(255)

	r% = ioopen(f%,addr(tmpnam$),$104)

	str$="Apparently-To: "+to$+chr$(13)+chr$(10)
	iowrite(f%,uadd(addr(str$),1),len(str$))
	str$="Apparently-From: "+from$+chr$(13)+chr$(10)
	iowrite(f%,uadd(addr(str$),1),len(str$))

	while 1
		str$=getline$:(s%)
		if asc(str$)=255 : break : endif
		if str$="." : break : endif

		if left$(str$,2) = ".." : str$ = right$(str$,len(str$)-1) : endif

		iowrite(f%,uadd(addr(str$),1),len(str$))
		str$=chr$(13)+chr$(10)
		iowrite(f%,uadd(addr(str$),1),len(str$))
	endwh

	ioclose(f%)

	if str$="."
		str$=inname$:
		trap rename tmpnam$,str$
		if err
			print "Error renaming "+tmpnam$+" to "+str$
			pause -20
			trap delete tmpnam$
			r%=respond:(s%,451)
			return -1
		endif
	else
		trap delete tmpnam$
	endif

	return 0
ENDP


PROC inname$:
	local n%
	local ret$(128)

	n% = 1

	while 1
		ret$ = smtpin$+"mail."+num$(n%,3)
		if not exist(ret$) : break : endif
		n% = n%+1
		if n%>999 : return "" : endif
	endwh

	return ret$
ENDP


PROC getline$:(s%)
	local r%,l%,bp%,tmp$(255),timeout&,left%

	bp%=len(buf$)+1

	timeout&=0

	while loc(buf$,chr$(13))=0 and loc(buf$,chr$(10))=0 and bp%<253
		do
			l%=recv:(s%,uadd(b%,bp%),0)
			if l%<0 : return chr$(255) : endif
			if l%=0
				pause 5
				timeout&=timeout&+1
				if timeout&>60*10 : return chr$(255) : endif
			endif
		until l%<>0

		left%=l%
		if l%>254-bp% : l%=254-bp% : endif
		left%=left%-l%

		r%=recv:(s%,uadd(b%,bp%),l%)
		if r%<0 : return chr$(255) : endif
		bp% = bp%+l%
		pokeb b%,bp%-1
	endwh

rem *** carriage return EOL

	if loc(buf$,chr$(13))
		tmp$=left$(buf$,loc(buf$,chr$(13))-1)
		buf$=right$(buf$,len(buf$)-loc(buf$,chr$(13)))

rem *** cater for the chance a linefeed might be in the next read

		if left%
			r% = recv:(s%,uadd(b%,len(buf$)+1),1)
			if r%<0: return chr$(255) : endif
			pokeb b%,len(buf$)+1
		endif

rem *** remove the linefeed

		if asc(buf$)=10
			buf$=right$(buf$,len(buf$)-1)
		endif

rem *** linefeed EOL

	elseif loc(buf$,chr$(10))
		tmp$=left$(buf$,loc(buf$,chr$(10))-1)
		buf$=right$(buf$,len(buf$)-loc(buf$,chr$(10)))

rem *** line overflowed buffer EOL
	else
		tmp$=buf$
		buf$=""
	endif

	return tmp$
ENDP



PROC respond:(s%,c%)
	local r$(255)

	if c%=220
		r$="220 "+hostnam$+" Psion Series 3a Simple Mail Transfer Service Ready"
	elseif c%=221
		r$="221 "+hostnam$+" Simple Mail Transfer Service Closing"
	elseif c%=250
		r$="250 OK"

	elseif c%=354
		r$="354 Start mail input; end with <CRLF>.<CRLF>"

	elseif c%=421
		r$="421 Service not available, closing transmission channel"
	elseif c%=450
		r$="450 Requested mail action not taken: mailbox unavailable"
	elseif c%=451
		r$="451 Requested action aborted: local error in processing"
	elseif c%=452
		r$="452 Requested action not taken: insufficient system storage"

	elseif c%=500
		r$="500 Syntax error, command unrecognised"
	elseif c%=501
		r$="501 Syntax error in parameters or arguments"
	elseif c%=502
		r$="502 Command not implemented"
	elseif c%=503
		r$="503 Bad sequence of commands"
	elseif c%=504
		r$="504 Command parameter not implemented"
	elseif c%=550
		r$="550 Requested action not taken; mailbox unavailable"
	elseif c%=552
		r$="552 Recipient storage full, try again in another transaction"
	elseif c%=553
		r$="553 Requested action not taken: mailbox name not allowed"
	elseif c%=554
		r$="554 Transaction failed"

	endif

	r$=r$+chr$(13)+chr$(10)
	return send:(s%,uadd(addr(r$),1),len(r$))

ENDP


PROC loadpref:
	local f%,r%
	local buf$(255),com$(255)

	r% = ioopen(f%,"loc::m:\mail\mail.cfg",$20)
	if r% < 0 : return : endif

	while 1
		buf$ = fgets$:(f%)
		if ferr%<0 : break : endif

		if loc(buf$,":") and loc(buf$,"*") <> 1
			com$ = left$(buf$,loc(buf$,":")-1)
			buf$ = right$(buf$,len(buf$)-loc(buf$,":")-1)

			if len(buf$)
				while asc(buf$) <= 32 : buf$ = right$(buf$,len(buf$)-1) : endwh
			endif

			if com$ = "TempDir" : tempdir$ = buf$ : endif
			if com$ = "E-mail" : email$ = buf$ : endif
			if com$ = "IncomingMail" : smtpin$ = buf$ : endif
			if com$ = "OutgoingMail" : smtpout$ = buf$ : endif

		endif

	endwh
	ioclose(f%)

ENDP

PROC fgets$:(f%)
	local in$(255)

	ferr% = ioread(f%,uadd(addr(in$),1),255)

	if ferr%>=0
		pokeb addr(in$),ferr%
	endif

	return in$

ENDP