World: r3wp

Has anyone tried writing uniserve services ?

This is my first pass at writing a smtp server ...  works from telnet 
but not from a mail client so far.

REBOL [
	Title: "SMTP daemon"
	Author: "Graham Chiu"
	Version: 0.0.1
	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 ]
	
	maildir: %mail/ ; store mail here
	
	save-mail: func [ data /local mailbox ][

  if not dir? mailbox: rejoin [ maildir server/user-data/email "/" 
  ] [
			if not exists? 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: none
	 	]
		stop-at: crlf
		write-client join "220 mail.compkarori.co.nz SMTP" crlf
	]

	smtp-rule: [
		"HELO" thru newline
			( write-client join "250 mail.compkarori.co.nz SMTP" crlf ) |
		"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 server/user-data/state: copy 
   "command" ) |
		"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 "@" thru newline 

   ( server/user-data/email: form name write-client join "250 OK RCPT 
   TO" crlf ) |
		"DATA" thru newline

   ( stop-at: multi-line-end server/user-data/state: copy "body" ) 
	]
	
	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 somewhere at " 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
			]	
		]
	]
]

create a directory called "mail" and each subdirectory holds a "mailbox" 
for the incoming mail.  If a mailbox does not exist, it gets routed 
to mailbox "misc".

the save-mail line should insert the ip address of the client .. 
where I have "somewhere"

time to fire up ethereal and make sure I understand what the terminating 
sequence is for the smtp DATA command.

ah... found a problem.

Working version follows:

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