Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Selma Source

 [1/2] from: barkley::gamebox::net at: 14-Aug-2002 12:56


Does anyone have the source to Selma? I would like to study it and possibly use it in a club I'm in. Thanks! David [barkley--gamebox--net]

 [2/2] from: cybarite:sympatico:ca at: 14-Aug-2002 21:16


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: [carl--rebol--com] 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 [cybarite--sympatico--ca] 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: [cybarite--sympatico--ca] ] 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 [luke--rebol--com] 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 ]