World: r3wp

REBOL [
	Title: "SMTP daemon"
	Author: "Graham Chiu"
	Version: 0.0.2
	Date: 5/3/2005
]

install-service [
	name: 'smtp
	port-id: 25

	multi-line-end: rejoin [crlf #"." crlf]
	stop-at: crlf
	
	server: make object! [ user-data: none ]

 clear-server: server/user-data [ state: "command" email: computer: 
 none ]
	
	maildir: %mail/ ; store mail here
	domains: [ "@compkarori.co.nz" ] ; list of accepted domains
	
	save-mail: func [ data /local mailbox ][

  if not dir? mailbox: rejoin [ maildir server/user-data/email "/" 
  ] [
			if not exists? mailbox: join maildir %misc/ [
				mailbox: make-dir join maildir %misc/
			]					
		]
		if not exists? join mailbox "mail.txt" [
			write join mailbox "mail.txt" "" 
		]
		write/append join mailbox "mail.txt" join crlf to-string data	
		; print dehex data
	]
	
	on-new-client: has [su] [
			su: server/user-data: context [
			state: copy "command"
			email: computer: none
	 	]
		stop-at: crlf
		write-client join "220 mail.compkarori.co.nz SMTP" crlf
	]

	smtp-rule: [
		"HELO" copy name thru newline
			( write-client join "250 mail.compkarori.co.nz SMTP" crlf 
				if not none? name [
					trim/head/tail name
				]
				server/user-data/computer: form name
			) |
		"EHLO" thru newline
			( write-client join "500 not implemented" crlf ) |
		"MAIL" thru newline
			( write-client join "250 OK MAIL FROM" crlf) |
		"QUIT" thru newline
			( write-client join "221 Good Bye" crlf close-client) |
		"RSET" thru newline
			( write-client join "250 OK RESET" crlf clear-server ) |
		"NOOP" thru newline
			( write-client join "250 OK NOOP" crlf ) |
		"VRFY" thru newline

   ( write-client join "252 send some mail, i'll try my best" crlf ) 
   |
		"EXPN" thru newline
			( write-client join "500 not implemented" crlf ) |

  "RCPT" [ thru "<" | thru ": " ] copy name to "@" copy domain to ">" 
  thru newline 
			( 
				either find domains domain [

     server/user-data/email: form name write-client join "250 OK RCPT 
     TO" crlf 
				][

     write-client join "553 sorry, that domain is not in my list of allowed 
     rcpthosts" crlf
					server/user-data/email: none					
				]
			) |
		"DATA" thru newline

   ( 	stop-at: multi-line-end server/user-data/state: copy "body" 
				write-client join "354 start mail input" crlf
			) 
	]
	
	on-received: func [data /local su] [
		su: server/user-data
		; print join "Data: " data
		switch su/state [
			"command" [
				if not parse data smtp-rule	[ 
					write-client join "500 command not understood" crlf
				]		
			]
			"body" [
				; reject if we don't have a RCPT command first
				if none? su/email [
					write-client join "500 no email address received" crlf
					stop-at: crlf
					su/state: copy "command"
					return
				]
				
				; write the body of the message somewhere

    save-mail rejoin [ "Received: from " su/computer " ( " su/computer 
    " [ " client/remote-ip " ]) " to-idate now newline dehex data newline 
    newline ]
				stop-at: crlf
				write-client join "250 OK MAIL received" crlf
				su/state: "command"
				su/email: none
			]	
		]
	]
]

hmm

clear-server: does [ server/user-data/state: "command" server/user-data/email: 
server/user-data/computer: none ]

put this corrected file into your services directory as smtpd.r

I have mine running as a test on 192.168.1.202

from another pc, or from local host  ... set-net [ [gchiu-:-nowhere-:-com] 
192.168.1.202 ]

send [gchiu-:-compkarori-:-co-:-nz] "testing ..."


and the email is stored in the mail/gchiu directory appended to mail.txt

close-client has no refinement 'now

A couple of questions:
1. how to timeout the client after a period of inactivity?

2. how to process multiple clients at the same time, or to refuse 
a client connection while an existing connection exists?

I've got a prototype version of my mail server now running.

set-net [ youremail-address 203.79.110.37 ]
send [gchiu-:-compkarori-:-com] {your test message ... }

Anyone want to try it out for me ?

Is your problem solve (what you post on French forum) ?

not really .. I just fudged it.

I would like to know the correct way though of preserving session 
data

I posted to the french forum as I thought there has the most experience 
with UniServe ...

Not much. appart Dockimbel of course

I see.

The doc said :

Client =  Property set at runtime pointing to the current client 
port! value
At runtime mean while the client is connected.

ahh .. so I have to set this on-connected

Yes, it's what i think

rather .. on-new-client

I've posted a new version 0.0.4 : http://www.compkarori.com/vanilla/display/Smtpd.r

seems not to correctly set the counter back by one when closing client 
connection

oops ,.. it seems to be working.  Spam is now flooding in :(

fix was to send an error code on receiving EHLO command

seem to be receiving hundreds of spam from judge.lis.net.au

After repeated testing, I have bumped up the version to 0.1.0 at 
http://www.compkarori.com/vanilla/display/Smtpd.r


As explained in the URI, a form of teergrubbing ( anti-spam ) is 
implemented.

I'm getting 4 smtp connections to my server per min .. all of it 
spam.

I left my smtp service running all night .. about 10 hours .. and 
after the 2190'th spam, I hit the infamous "invalid data type during 
recycle" :(

I'll first try switching to 

>> rebol/version
== 2.5.55.3.1

Had the service running all day while I was at work .. and had over 
1700 smtp connections, of which the script allowed 6 email thru. 
 No spam.

I'm now going to see if I can implement greylisting .. which is an 
interesting technique for fighting spammers.

Interesting stuff.  With greylisting, and an enhancement I made to 
the greylisting technique, I have managed to reduce spam.  In 6 hours 
I 6 spam made it through to the spamtrap addresses, whereas I would 
have expected more like 20.  And that is from about 800 smtp connections 
.. or potentially 800 spam being sent to my MX record.

should read .. 6 spam.

And that is with a block period of 10 seconds.  The greylisting paper 
suggests using 1 hour and I'll try that now.

Graham - what is your experience with Uniserve so far? So far so 
good? :-)

Good.

Needs more documentation on writing modules .. but dockimbel says 
he will hopefully produce those in the next couple of days.

As he says, it's very easy to write a new service for it.

Pekr: Uniserve is uberkool!! It is my main webserver since january 
2003. Since then it crashed 2-3 times, not sure it was uni or rebol 
8)

what version of rebol are u using?

/core 2.5.8.2.4

Does that have the new async core in it?

I can't remember all these numbers ... :(

no 8(

I was getting async read errors, and at least one data type recycle 
error before switching to  2.5.55.3.1

Uniserve is not usable with recent async Core. It use the "old" async 
port system.

so, doc said .. but my smtp service appears to be working ...

dunno what this means ...

Graham, can you encap uniserve scripts?

I don't see any reason why not ...

need to redefine 'launch back to itself again.

it looks for files in the services directory .. need to change that 
as well I guess

Last I checked uniserve uses a directory structure to handle stuff. 
So I wonder if the encaped app needs to replicate this structure.