Scripts
AI
Animation
CGI
Compression
Console
Database
Debug
Dialects
Dialogs
Editor
Email
Encryption
Extension
External Library
File
File Handling
Files
Financial
FTP
Game
Games
Graphics
GUI
HTML
HTTP
Internet
LDC
Markup
Math
Module
Network
Networking
None
Other - Net
Parse
Patch
Printing
Protocol
Rebol
Scheme
Scientific
SDK
Security
Shell
Sound
SQL
TCP
Testing
Text
Text Processing
UI
User Interface
Util
Utility
VID
Visualization
Web
Win API
X-File
XML
Wiki
REBOL [
Title: "SiMTPop Simulate SMTP & POP"
Author: "Ingo Hohmann"
date: 2003-10-03
File: %simtpop.r
purpose: {To simulate SMTP and POP services on a single user PC,
works with Outlook 98, but is broken for later Versions}
VersionInfo: {Incorporates a fix by Matt McDonald
to work with later Versions of MS Outlook, and other programs
who use EHLO}
library: [
level: 'intermediate
platform: 'all
type: [ tool]
domain: [email dialects internet tcp]
tested-under: [core view win linux]
support: none
license: none
]
]
smtp: open/no-wait tcp://:8025
pop3: open/no-wait tcp://:8110
trace/net on
line: none
get-data-rule: copy [
(either not none? conn [
append line copy conn
][
get-or-end: copy end-rule
])
]
end-rule: [thru end]
smtp-rule: [
(
get-or-end: copy get-data-rule
data-started: false
)
some [
here:
[
"HELO" thru newline
(answer "250 SiMTPop") |
"EHLO" thru newline
(print "1" answer "250 SiMTPop") |
"MAIL" thru newline
(answer "250 Ok MAIL FROM") |
"RCPT" [thru "<" | thru ": " ] copy name to "@" thru newline
(answer "250 Ok RCPT TO") |
"DATA" thru newline
(if not data-started [answer "354 start mail input"] data-started: true)
copy mail thru "^/.^/"
(save-mail name mail
data-started: false
answer "250 OK Mail recieved") |
"RSET" thru newline
(answer "250 OK RSET" data-started: false) |
"QUIT" thru newline
(answer "221 Good Bye" close conn get-or-end: copy end-rule) |
:here get-or-end
]
]
]
pop3-dialog: reduce [
"USER" func [a][
parse a [thru "USER " copy name to newline to end]
if not find mail-boxes name [
append/only append mail-boxes name copy []
]
answer "+OK User name accepted"
]
"PASS" func [a][answer "+OK Password Ok"]
"STAT" func [a /local ans len][
len: 0
ans: rejoin [
"+OK " length? mail-texts: select mail-boxes name " "
]
forall mail-texts [len: len + length? first mail-texts]
append ans form len
answer ans
]
"LIST" func [a /local ans][
ans: rejoin [
"+OK " length? mail-texts: select mail-boxes name " messages ("
]
len: 0
forall mail-texts [len: len + length? first mail-texts]
mail-texts: head mail-texts
append ans rejoin [ "" len ") octets" newline]
forall mail-texts [
append ans rejoin [index? mail-texts " " length? first mail-texts newline]
]
append ans ".^/"
answer ans
]
"RETR" func [a][
parse a [thru "RETR " copy num to newline to end]
num: to-integer num
either num <= length? mail-boxes/:name [
answer "+OK sending mail"
answer pick select mail-boxes name num
] [
answer "-ERR no such message"
]
]
"DELE" func [a][
answer "+OK deleted"
]
"RSET" func [a][
answer "+OK RSET"
]
"NOOP" func [a] [answer "+OK NOOP"]
"QUIT" func [a][
answer "+OK bye"
close conn
done: true
clear select mail-boxes name
]
]
mail-boxes: copy []
save-mail: func [name mail][
either mail-box: find mail-boxes name [
append mail-box/2 mail
] [
append mail-boxes name
append/only mail-boxes compose [(mail)]
]
]
answer: func [text][
print ["-->" text]
either (last text) = newline [
insert conn text
][
insert conn join text newline
]
]
recieve: func [/to end-marker /local line ret][
if not to [ end-marker: "^/" ]
line: copy ""
until [
data: copy conn
append line data
find line end-marker
]
print ["<--" copy/part line (length? line) - 1]
line
]
dispatch [
smtp [
print "+++ SMTP connection +++"
conn: first smtp
answer "220 SiMTPop Ready"
wait [conn]
line: copy ""
parse line smtp-rule
] ; smtp
pop3 [
print "+++ POP3 connection +++"
conn: first pop3
answer "+OK POP3 server ready "
wait [conn]
done: false
while [not done] [
line: recieve
command: copy/part line 4
if error? try [
pop3-dialog/:command line
][
answer "-ERR command not implemented"
]
] ; while
] ; pop3
] ; dispatch