Wilson WindowWare Tech Support

WinBatch WinBatch+Compiler WebBatch
Home | Tech Database | Tech BBS | White Papers | Purchase

Run as an SMTP Server 

Keywords: 	 SMTP server

; Name: SMTP Server.wbt
; Author: Iain Dickason (iain@caverock.net)
; Description: Runs as a SMTP server, supporting minimum implementation as per RFC 821.
; Comments:
;
; This script waits for a connection on port 25, it supports the follow SMTP commands
; HELO,MAIL,RCPT,DATA,QUIT,RSET,NOOP
;
; It does not do anything with the mail received other than log the commands and save the basic
; mail information to a file.
;
; For more information about the SMTP protocol refer to RFC 821 (search Yahoo)
; in some comments you may find text like (4.5.1.) this refers to a section of RFC 821.
;
; Problems:
; the FileNum is not checked to see if it exists already. Always set to 0 on start.
; does not change FileDate if run over night.
; does not check for the existance of MailDir and LogDir.
; hardly any error checking.


Gosub Init

loop = @TRUE
while Loop
	datasocket=sAccept(listensocket,@TRUE)  ; Block for a connection
	if datasocket ; Do we have a conection or error?
		FileNum = FileNum + 1
		MailFile = StrCat(FileDate,StrFix(FileNum, "0", NumLength))
		If Logging then smtplog=FileOpen(StrCat(LogDir,MailFile,".log"),"Write") ; If we are logging then open log 
		If Logging then FileWrite(smtplog,"==Conected")
		Reply_Message = StrCat("220 ",ServerName," ",ServerDesc) ; for full list on reply messages see (4.2.)
		sSendLine (datasocket, Reply_Message) ; Reply with server details
		If Logging then FileWrite(smtplog,">>%Reply_Message%")
		gosub ProcessConnect
		If !DataLoop then ; DataLoop will be False if we have some data. *(not real a good test)*
			Mail = StrCat(From,@crlf,ToAddr,@crlf,Data,@crlf)
			MailFile = FileOpen(StrCat(MailDir,MailFile,".txt"),"Write")
			FileWrite (MailFile, Mail)
			FileClose(MailFile)
			Loop = @FALSE ; uncomment this line to only do one e-mail per run.
		EndIf
	else
		msg=wxGetLastErr()
		Message("Socket Error",msg)
		sClose(listenSocket)
		exit
	endif
	If Logging then FileClose(smtplog)
	sClose (Datasocket)
endwhile
; sClose (Datasocket)
sClose (listensocket)
exit   


:Init

AddExtender("WWWSK32I.DLL") ; Include the Winsock Extender

Logging = @TRUE ; Do we want to log all commands received/sent
LogDir = "C:\Mail\Log\" ; Needs ending \
ServerName = "server.here.co.uk" ; SMTP server's host hame
ServerDesc = "SMTP Test server" ; SMTP server description
MailDir = "C:\Mail\" ; Needs ending \
Now = TimeYmdHms ( )
; The follow three lines set up the 'unique' file name, NumLength is how many digits you want the FileNum to use
; i.e. file one - 5 = 00001, 4 = 0001 etc.
; filename will end up being in the form YYYYMMDDNNNN.txt e.g. 199909250001.txt
FileDate = StrCat(ItemExtract(1,now,":"),ItemExtract(2,now,":"),ItemExtract(3,now,":"))
FileNum = 0
NumLength = 4

BoxOpen("Listener","")

listensocket=sOpen()
sListen(listensocket,"25") ; Port 25 is the SMTP port
;sClose (listensocket)
;exit
Return


:ProcessConnect

; Below are the commands the script accepts, these are required for a minimum implementation (4.5.1.)
; For details on what each command is for refure to (4.1.1.)
Cmd_List = StrCat("HELO",@Tab,"MAIL",@Tab,"RCPT",@Tab,"DATA",@Tab,"QUIT",@Tab,"RSET",@Tab,"NOOP")
Loop = @TRUE
HELO = @FALSE
DataLoop = @TRUE
From = ""
ToAddr = ""
While Loop
	Line = sRecvLine(datasocket,256) ; set to max 256 chars per line could be increased
	If Logging then FileWrite(smtplog,"<<%Line%")
	BoxText(Line)
	Command = StrUpper(StrSub (Line, 1, 4)) ; work out the SMTP command (first 4 chars of line)
	Test = ItemLocate (Command, Cmd_List, @Tab) ; compare with command list
	Select Test
		Case 1 ; HELO
			If Logging then FileWrite(smtplog,"==detected hello")
			HELO = @TRUE
			Error = "250 OK"
			sSendLine (datasocket, Error)
			If Logging then FileWrite(smtplog,">>%Error%")
			Break
		Case 2 ; MAIL
			If Logging then FileWrite(smtplog,"==detected mail")
			If HELO then
				From = ItemExtract(2,Line,":")
				Error = "250 %From% OK"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
			Else
				Error = "503 You must send a HELO or EHLO command first"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
			EndIf
			Break
		Case 3 ; RCPT
			If logging then FileWrite(smtplog,"==detected rcpt")
			If From <> "" then
				ToAddr = ItemExtract(2,Line,":")
				Error = "250 %ToAddr% OK"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
			Else
				Error = "503 MAIL command expected"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
			EndIf
			Break
		Case 4 ; DATA
			If Logging then FileWrite(smtplog,"==detected data")
			If ToAddr <> "" then
				Error = "354 Ready for data"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
				DataLoop = @True
				Data = ""
				While DataLoop
					Line = sRecvLine(datasocket,256)
					If Logging then FileWrite(smtplog,"<<%Line%")
					If Line == "." then
						DataLoop = @False
					Else
						If Line == ".." then Line = "." ; This is required to support transparency. (4.5.2.)
					Data = StrCat(Data,Line,@crlf)
					EndIf
				EndWhile
				Error = "250 Message received OK"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
			Else
				Error = "503 No valid recipients specified"
				sSendLine (datasocket, Error)
				If Logging then FileWrite(smtplog,">>%Error%")
			EndIf
			Break
		Case 5 ; QUIT
			If Logging then FileWrite(smtplog,"==detected quit")
			Error = "221 pageing.ideal.co.uk closeing"
			sSendLine (datasocket, Error)
			If Logging then FileWrite(smtplog,">>%Error%")
			Loop = @FALSE
			Break
		Case 6 ; REST
			If Logging then FileWrite(smtplog,"==detected reset")
			Error = "250 Message received OK"
			sSendLine (datasocket, Error)
			If Logging then FileWrite(smtplog,">>%Error%")
			HELO = @FALSE
			From = ""
			ToAddr = ""
			Break
		Case 7 ; NOOP
			If Logging then FileWrite(smtplog,"==detected Noop")
			Error = "250 Message received OK"
			sSendLine (datasocket, Error)
			If Logging then FileWrite(smtplog,">>%Error%")
			Break
		Case Test ; Everything else
			If Logging then FileWrite(smtplog,"==unkown command")
			Error = "500 Unknown or unimplemented command"
			sSendLine (datasocket, Error)
			If Logging then FileWrite(smtplog,">>%Error%")
			Break
	EndSelect
EndWhile

Return

Article ID:   W14960