David,
I used Carl's base with some minor mods so called it SELMATE
(the new "te" is for Toronto Edition ... it made me smile .... at the time)
And created my own %notices.r file .... I couldn't find the one that went with the
original Selma.r but this seemed to work. It allows me to add more asynch messages
being supported - then send email and do the thing.
This version runs in a loop 10 times. It would not run reliably on my machine
so I was looking to have a CGI from my webserver to restart it remotely.
Let me know if any problems .. I ran it a few weeks ago to demo but the
project that I was preping for has not kicked off yet. I still want to use it for my
project when it is funded.
Good luck with it.
============================= Selmate ==================
REBOL [
Title: "SELMA (Open Group)"
Author: "Carl Sassenrath"
Email: [EMAIL PROTECTED]
Date: 12-May-1999
File: %selmate.r
Purpose: {
SELMA - Simple Email List-Managing Application.(Toronto Edition)
Implements an email list server that can run on any
server or client. Keeps a log of messages and user
activities. Allows recall of past messages. See
%notices.r for help info and commands.
}
Note: {
Has not been modified to take into account
improvements in REBOL since 2.0.0
}
License: {
This script is free to use as you wish but send
us cool (and tested) enhancements.
}
History: [
%selmate.r
[EMAIL PROTECTED] 01-June-2002
[ "added configuration section to hold values"
"took out 'try' because could not see error on throw"
]
]
]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
; Patch
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;-- Modes:
net-watch: offte
;-- Configuration:
list-addr: xxxxxxxxxxxxxxxxxxx
list-user: "xxxxxxxx"
list-pass: ask/hide rejoin ["Input the password for " list-user ": "]
pop-server: "xxxxxxxxxxxx"
smtp-server: "xxxxxxxxxxxxx"
manager: [xxxxxxxxx1 xxxxxxxxx2] ; manager(s) of the list
list-tag: "[IS]" ; tag inserted on
Subject line
user-file: %user-list.r ; user database
log-file: %user-log.r ; user event log
save-dir: %msgs ; where messages are saved
num-file: %next-num.r ; message save counter
note-file: %notices.r ; SELMA's reply messages
check-period: to-time ask "Enter the time interval in the format: 0:01 "
digit: charset "0123456789"
digits: [some digit]
space: charset " ^-"
spaces: [any space]
;-- Setup:
system/user/email: list-addr
system/schemes/default/host: pop-server
system/schemes/smtp/host: smtp-server
system/standard/email: make system/standard/email [
x-uidl: none received: none delivered-to: none
]
;--Rewritten resend func to allow blocks of addresses
resend: func [
"Relay a message"
to from message /local do-send smtp-port
][
do-send: func [port data] [insert port reduce data]
smtp-port: open [scheme: 'smtp]
do-send smtp-port ["MAIL FROM: <" from ">"]
foreach addr to [
if email? addr [
do-send smtp-port ["RCPT TO: <" addr ">"]
]
]
do-send smtp-port ["DATA" message]
close smtp-port
]
Log-Event: func [event] [
write/append log-file reform event ; bug: write/append/lines should work
!!!
write/append log-file newline
]
Log-Message: func [text-msg] [
write to-file rejoin [save-dir "/M" save-num] text-msg ; should be able to
do dir/:save-num
save num-file save-num: save-num + 1
text-msg
]
journalize: func [user action [word!]
][
write/append %journal.txt reduce [now tab user tab action newline]
]
respond: func [to msg] [send to trim/auto msg] ; a respond only goes to the requester
Add-User: func [user] [
either find user-list user [
respond user already-on-list
][
append user-list reduce [user 0]
save user-file user-list
log-event ["new-user:" user now]
respond user welcome
]
]
Remove-User: func [user /local where] [
either where: find user-list user [
respond user farewell
remove/part where 2
save user-file user-list
log-event ["rem-user:" user now]
][
respond user not-on-list
]
]
Post: func [
"Uses SMTP protocol to post the message efficiently"
message /local smtp-port content do-send
][
either here: find user-list first message/from [
either here/2 = (chk: checksum message/content) [
send manager rejoin ["Duplicate Message:" message/from newline
message/content]
][
here/2: chk
save user-file user-list
]
do-send: func [port data] [insert port rejoin data] ; temporary
smtp-port: open [scheme: 'smtp]
do-send smtp-port ["MAIL FROM: <" list-addr ">"]
foreach [addr count] user-list [
do-send smtp-port ["RCPT TO: <" addr ">"]
]
content: message/content
message/content:
message/x-uidl:
message/delivered-to:
message/received:
message/return-path: none
message/reply-to: list-addr
message/to: list-addr
message/date: to-idate message/date
if none = parse message/subject list-tag ; if it already has
the list ID in it don't put it in
[insert message/subject list-tag ]
insert insert message/subject " "
insert insert content net-utils/export message newline
do-send smtp-port ["DATA" content]
close smtp-port
][
if not any [
find first message/from "mailer-daemon"
find first message/from "Postmaster"
][
send manager rejoin ["Bad User:" message/from newline
message/content]
send first message/from rejoin [trim/auto not-on-list newline
message/content]
]
]
]
Repost: func [message /local here there re-cnt] [
re-cnt: 0
parse message/subject [
some [to "re:" here: (remove/part here 3 re-cnt: re-cnt + 1)
[list-tag 0 10 " " there: (remove/part here there) :here |
"(" copy num digits ")" there:
(re-cnt: re-cnt - 1 + (to-integer trim/tail num) remove/part
here there) :here | none]
]
]
insert tail trim message/subject " Re:"
if re-cnt > 1 [
insert tail message/subject reduce ["(" re-cnt ")"]
]
post message
]
Send-Msg-Num: func [user number /local file] [
file: to-file rejoin [save-dir "/M" number]
send user either exists? file [
reform [list-tag "Message" number newline read file]
][
reform [list-tag "Message" number {not available.
Either the message has been archived and is not available for access
or
the message with that number has not yet been created on this list.
}]
]
]
Process-Mail: func [
mail-port [url! block!]
/local mailbox message text-message commands user
][
commands: [
"subscribe" (add-user user journalize user 'add) |
["unsubscribe" | "resign" | "quit" | "bye"] (remove-user user
journalize user 'remove) |
["help" | "info"] (respond user help-info journalize user 'help) |
"security" (respond user security journalize user 'security) |
"user-list" (respond user rejoin ["User List" newline read
%user-list.r]
journalize user 'user-list
) |
["suggest" | "suggestion"]
(resend manager first message/from text-message
journalize user 'suggestion
) |
"history" (respond user get-history) |
"get" ["msg" | "message"] spaces number: digits
(send-msg-num user trim number
journalize user 'get
) |
[thru "re:" list-tag] (log-message text-message repost message
journalize user 'repost) |
(log-message text-message post message
journalize user 'post)
]
mailbox: open mail-port
print [length? mailbox "messages; messages beginning at" save-num]
while [not tail? mailbox] [
text-message: first mailbox
message: import-email text-message
message: make message [X-SELMA: reform [list-tag save-num - 1]]
print rejoin ["Message from: " message/from]
user: first message/from
if none? message/subject [message/subject: "none"]
parse message/subject [commands]
remove mailbox
]
close mailbox
]
Do-SELMA: func [][
do note-file
user-list: load user-file
if not block? user-list [user-list: reduce [user-list]]
save-num: either exists? num-file [load num-file] [1]
if not exists? log-file [write log-file reform [ now newline ] ]
for i 1 10 1 [
if i > 9 []
print now
process-mail [
scheme: 'pop
user: list-user
pass: list-pass
host: pop-server
]
wait check-period
]
]
do-selma
;if error? try [Do-SELMA][send manager "SELMA Error!"] ; I took out the try so I
could see the error to debug
quit
================= Notices.r ============================
REBOL [
title: "List Notices"
file: %notices.r
purpose: {Specify user information used by the list server.}
date: 19-June-2004
author: [EMAIL PROTECTED]
]
list-name: "IS"
help-info: rejoin [{Help
This is the command list for the } list-name { list server.
It is a trial version to see if a list server would be useful for communicating across
a project.
Today any email address can subscribe.
If it is workable, this can be limited to only those ending in the company email
address. Home addresses could be added supported either by adding them manually or
developing a simple challenge response scheme (either go to a web page or insist that
the subscribe email have the password in it.
This version is the most unsophisticated of all of the list servers. The list-server
is a focal point for mail. When it receives some, it forwards a copy to all of the
subscribers (at the time when the message is read).
More sophisticated options are to support an archive which presents information in
"threads" (and hopefully will present them in an html format like was built for the
mySQL protocol (http://rebol.dhs.org/mysql/forum.cgi) and a digest version which will
all re-caps to be sent rather than individual messages.
Replies are to be sent to the list-server } list-addr { and not to people.
Commands
================
get msg 99 - to retrieve message number 99 from the } list-name { data
base
get message 99 - to retrieve message number 99 (an alias of 'get msg')
help - to get this information explaining how to use the } list-name { list
server
info - an alias for 'help'
security - gives you a short explanation of the security of the } list-name {
list server list
subscribe - to join the } list-name { list server list
unsubscribe - to unjoin the } list-name { list server list
resign - an alias for 'unsubscribe'
quit - an alias for 'unsubscribe'
bye - an alias for 'unsubscribe'
Remember to send messages to the list server and let the subscriber portion work the
way it was intended to.
}
]
already-on-list: rejoin [{Already Subscribed
You are already subscribed to the } list-name { list!
}]
welcome: rejoin [{Welcome to List Server
Welcome to the } list-name {list server
This is just a trial to see if a list server can add value to a project.
}
]
not-on-list: rejoin [{Sorry - Not on List Server
You have sent a message to unsubscribe from this list server
but you are not on the } list-name { subscription list.
}]
farewell: rejoin [{Unsubscribe.
Thank you for participating in the } list-name { list server.
Bye}]
security: rejoin [{Security
This is e-mail using the practices that are in place.
The benefits and exposures of e-mail are the same.
A check is in place for preventing the same message from being sent by the same user.
This is only really useful in a re-start situation when reading the mail log. This is
accomplished by hashing the message and storing this hash with the userid. When the
next message is received, its hash value is compared against the hash for the new
message. If they are the same, the second message is not sent and the list-server
manager is notified.
For other versions (such as the html log), then additional security can be put in place
such as http authentication when visiting the site, individual logon IDs and passwords,
all messages can have MD5 checksums stored with them that can be used to verify that
the message content has not been changed....
}
]
directory: %. ; where to find the files
pattern: %mail*.r ; a pattern to match particular files
foreach file read directory [
if find/match/any file pattern [
send [EMAIL PROTECTED] reform [
"File:" file newline newline read file
]
]
]
get-history: func [] [
directory: %./msgs/
pattern: %*
buffer: copy {Message Archive List
}
length: 50
foreach file sort read directory [
if find/match/any file pattern [
message: import-email read directory/:file
append buffer reduce [
file newline
" From: " first message/from newline
" Subject: " message/subject newline
{ Up to } length { characters of the text: }
copy/part message/content length
]
]
]
buffer
]
--
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the
subject, without the quotes.
