@q
@program jmail.muf
1 99999 d
i
( jmail.muf v1.0 Jessy @ FurryMUCK 8/99
An email-like mail system. Features include forwarding, reply-to,
reply-to-all, personal and global distribution lists, message recall,
folders, configurable limits on mailbox size and message aging time,
and transparent integration with page #mail.
INSTALLATION:
Installation must be performed by a wizard.
Set jmail.muf Wizard. Create a global action with a name such as
'mail;m' or '+mail' and link the action to the program.
Jmail.muf requires lib-reflist, lib-lmgr, lib-strings, lib-editor,
and a .pmatch macro, all of which should be installed on an
established MUCK.
To allow players to be shown a 'You have mail' message at logon,
port jmail-warn.muf.
To allow JMail to use global page aliases in addition to distribution
lists and personal page aliases when resolving names, set cmd-page
prop on JMail to cmd-page's dbref.
@set jmail.muf=cmd-page:88 <or whatever>
To allow programs to send messages, set jmail.muf Link_OK. Or, to
allow programs to send messages without setting jmail.muf Link_OK
-- see note below -- port lib-jmail.
NOTE: JMail includes some sensitive routines relating to cmd-page that
could be abused if copied into other programs. For this reason, you
may want to keep JMail !Link_OK, and forego program calls. My own
belief is that this kind of security-through-obscurity is misguided:
If someone wanted to hack mail, they could do so by copying and
modifying routines from widely available programs. Keeping JMail
!Link_OK wouldn't prevent this, and could give a false sense of
security. As an alternative, you may want to leave JMail !Link_OK, and
install lib-jmail, which duplicates the functions necessary to send
mail, but does not include the more sensitive cmd-page functions.
USAGE:
JMail provides most of the features an email system would. The online
#help system defaults to a simplified introduction, and has detailed
help screens for specific options. The basic syntax is...
mail <player[s]>=<subject> .... Send mail on <subject> to <player[s]>
mail .......................... List messages in your Inbox
mail <msg> .................... Show message <msg> in Inbox
mail <folder> ................. List contents of <folder>
mail <folder>=<msg> ........... Show <msg> in folder <folder>
mail #delete <msg> ............ Delete <msg>
mail #reply <msg> ............. Reply to <msg>
etc...
CONFIGURATION:
The #usage option lets wizards specify default mailbox capacities
and message aging-times. Mailbox capacities are in bytes:
mail #usage 10000 or...
mail #usage 10,000
Message aging-times are specified as <num> <units> where
<num> is
a positive number and <units> is a standard time unit: '1 day',
'3 weeks', '6 months', etc.
mail #usage 3 days
With the above settings, mail would be automatically deleted after
three days, and users would have a mailbox capacity of 10k. Timed-out
mail is not deleted immediately. Rather, JMail checks expiration times
each time you use mail. If a new expired message is found, it's moved
to a to-delete directory, and will be deleted the next time you run
mail more than one hour after it was moved. This gives users a chance
to read all mail. Individual messages can be protected with the #keep
option. If a user's mailbox reaches capacity, she will be unable to
send or receive mail until she deletes messages.
All of which is background for a recommended configuration: A
relatively large mailbox capacity -- 10 KB or so -- and a relatively
short message aging value -- 3 days, say -- will usually work well:
the mailbox will not grow exceptionally large unless the user
deliberately saves a number of large messages, and it will be unlikely
to fill up in normal use. This is the default setting. On a large
MUCK, it would be reasonable to reduce both settings, especially
mailbox capacity. Capacity and aging-times can also be set on a
per-user basis. As a point of comparison, this header comment is
about 7.2 KB.
To prevent players such as guests from using mail -- while still
allowing page #mail if page #mail integration is on -- use the
#usage option with the following syntax:
mail #usage <player>=page-only ... <player> may not use mail
mail #usage <player>=!page-only .. <player> may use mail
To completely block a player from using JMail, use the #usage option
with the following syntax:
mail #usage <player>=lock-out ..... <player> may not use JMail
mail #usage <player>=lock-out .... <player> may use JMail
PUBLIC FUNCTIONS:
jmail-player [ d s1 s2 -- i ] Sends message body s2 with subject s1
to player d. Returns true if successful.
jmail-list [ d s1 s2 s3 -- i ] Sends message body s3 with subject
s2 to members of reflist s1 on object d. Returns true if at least
one list member received the message.
For both, subject lines are limited to 36 characters.
JMail must be set Link_OK in order for programs to use these
functions. JMail registers itself as $lib/jmail after installation,
so $include $lib/jmail in programs that need to send mail.
FINAL NOTE - RESOURCE USAGE:
With a program as large as JMail, it is reasonable to be concerned
about resource usage. JMail is a CPU-intensive program, but not
unreasonably so. Some comparisons: JMailing a 256 character message
takes less than 10% the CPU time than page #mailing the same message
if both players' mailboxes are empty. A break-even point is reached
when the two players' mailboxes total about 4 KB. If the combined
mailbox size of the players is larger than 4 KB, page #mail is
quicker. Of course, JMail keeps mailboxes, so it does increase the
size of the database.
JMail's encryption routines are borrowed from cmd-page, slightly
modified. List-handling routines, also slightly modified, are borrowed
from cmd-lsedit... thanks Revar. Page #mail integration features have
been tested with cmd-page version 2.40. JMail.muf may be freely ported.
Please comment any changes.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
$include $lib/reflist
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
$define DoNukeStack begin depth while pop repeat $enddef
$define DoSynString ">> Syntax: " command @ strcat " " strcat $enddef
$define DoRemoveProp remove_prop $enddef
$define Tell me @ swap notify $enddef
lvar ourArg1 (* str: first cmd arg; may be modified by jmail *)
lvar ourArg2 (* str: second cmd arg; may be modified by jmail *)
lvar ourArg3 (* str: third cmd arg; may be modified by jmail *)
lvar ourBody (* str: msg body in public function calls *)
lvar ourBoolean (* int: misc flow-control var *)
lvar ourCounter (* int or str: misc counter var *)
lvar ourDistList (* str: name of distribution list; may be encrypted *)
lvar ourFolder (* str: target folder name *)
lvar ourFunc (* str: cmd arg with leading # octothorpe *)
lvar ourKey (* int: encryption key *)
lvar ourMessage (* str: target message id *)
lvar ourPlayer (* dbref: dbref of selected player *)
lvar ourSubject (* str: subject of message; may be encrypted *)
lvar ourTime (* int: systime of current message *)
lvar ourTotal (* int: running total of bytes, messges, folders, etc *)
(******** Begin initialization and permission-check functions *********)
: DoInitProgram ( -- ) (* initialize global props *)
prog "@/mail/ve" getprop not if
#0 "_reg/lib/jmail" prog setprop
prog "_defs/jmail-list" "\"$lib/jmail\" match \"jmail-list\" call"
setprop
prog "_defs/jmail-player" "\"$lib/jmail\" match \"jmail-player\" call"
setprop
prog "@/mail/ag" 259200 setprop
prog "@/mail/ma" 10000 setprop
prog "@/mail/ve" "1.0" setprop
then
;
: DoInitPlayer ( d -- ) (* initialize mail props for a player *)
dup "@/mail/ve" getprop if pop exit then (* create system folders *)
dup "@/mail/fo/ Inbox/000000000000.000#" "1" setprop
dup "@/mail/fo/ Drafts/000000000000.000#" "1" setprop
"@/mail/ve" "1.0" setprop
;
: DoInitProcess ( -- ) (* initialize this process *)
DoInitProgram (* make sure program is initialized *)
"me" match me ! (* block dbref spoofing *)
me @ DoInitPlayer (* set initial jmail vals if necessary *)
me @ ourPlayer ! (* store user as ourPlayer *)
strip ourArg1 ! (* store cmd arg *)
" Inbox" ourFolder ! (* inbox is default folder *)
;
: DoProgPermCheck ( -- ) (* kill process for unauthorized users *)
me @ player? not
me @ "@/mail/no" getprop or if
">> Permission denied." Tell pid kill
then
;
: DoMailPermCheck ( -- ) (* kill process for pmail-only users *)
me @ "@/mail/po" getprop if
">> Permission denied." Tell pid kill
then
;
: DoAdminPermCheck ( -- ) (* kill process for non-wiz users *)
me @ "W" flag? not if
">> Permission denied." Tell pid kill
then
;
(************ Encryption functions borrowed from cmd-page *************)
( The stronger encryption method is needed to convert page mail, but )
( the simpler and quicker the better for JMail: it wouldn't matter if )
( I could write armament-grade encryption; someone could still copy )
( and paste from here to a reader program. So, we'll rely on the wiz- )
( only propdir for mail privacy, and use simple encryption to keep )
( prop-browsing wizards from seeing people's mail. )
: asc (stringchar -- int)
dup if
"
1234567890-=!@#$%&*()_+qwertyuiop[]QWERTYUIOP{}asdfghjkl;'ASDFGHJKL:zxcvbnm,./ZXCVBNM<>
swap instr 1 - exit
then pop 0
;
: chr (int -- strchar)
"
1234567890-=!@#$%&*()_+qwertyuiop[]QWERTYUIOP{}asdfghjkl;'ASDFGHJKL:zxcvbnm,./ZXCVBNM<>?\"`~\\|^"
swap strcut 1 strcut pop swap pop
;
: cypher (key chars -- chars')
1 strcut asc swap asc
over 89 > over 89 > or if chr swap chr strcat swap pop exit then
dup 10 / 10 *
4 pick 10 + rot 10 % - 10 %
rot dup 10 / 10 *
5 rotate 10 + rot 10 % - 10 %
4 rotate + chr -3 rotate + chr strcat
;
: crypt-loop (key strcrypt strnorm -- strcrypt)
dup not if pop swap pop exit then
2 strcut 4 pick rot cypher
rot swap strcat swap
crypt-loop
;
: crypt-loop2 (key strcrypt strnorm -- strcrypt)
dup strlen 200 < if crypt-loop exit then
200 strcut swap 4 pick 4 rotate rot crypt-loop
swap crypt-loop2
;
: DoCrypt2 ( s -- s' )
ourKey @ swap swap 9 % 100 + "" rot crypt-loop2
;
: transpose (char -- char')
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz 1234567890_"
over instr dup if
swap pop 1 -
"wG8D kBQzWm4gbRXHOqaZiJPtUTN2pu6M0VjFlK3sdS9oYe5A_7IE1cnLvfyCrhx"
swap strcut 1 strcut pop swap pop
else
pop
then
;
: encrypt-charloop (nullstr string -- string')
dup not if pop exit then
1 strcut swap transpose
rot swap strcat swap
encrypt-charloop
;
: encrypt-loop (nullstr string -- string')
dup not if pop exit then
100 strcut "" rot
encrypt-charloop
rot swap strcat
swap encrypt-loop
;
: DoCrypt1 (string -- string')
"" swap encrypt-loop
;
(************ List-handling functions borrowed from lsedit ************)
: DoEditLoop ( listname dbref {rng} mask currline cmdstring -- )
(* read input for list editor *)
EDITORloop
dup "save" stringcmp not if
pop pop pop pop
3 pick 3 + -1 * rotate
over 3 + -1 * rotate
dup 5 + pick over 5 + pick
over over LMGR-DeleteList
1 rot rot LMGR-PutRange
4 pick 4 pick LMGR-GetList
dup 3 + rotate over 3 + rotate
">> Message saved." Tell
"" DoEditLoop exit
then
dup "abort" stringcmp not if
">> List not saved." Tell
1 ourBoolean ! (* flag: user aborted *)
pop pop pop pop pop pop pop pop pop exit
then
dup "end" stringcmp not if
pop pop pop pop pop pop
dup 3 + rotate over 3 + rotate
over over LMGR-DeleteList
1 rot rot LMGR-PutRange
exit
then
;
: DoEditList ( d s -- ) (* edit list s on d *)
swap
">> Welcome to the list editor. You can get help by entering '.h' on"
Tell
">> a line by itself. '.end' will save and exit. '.abort' will abort"
Tell
">> any changes. To save changes and continue editing, use '.save'."
Tell
over over LMGR-GetList
"save" 1 ".i $" DoEditLoop
;
: DoRemoveList ( d s -- ) (* remove list s from d *)
over swap over over
"#" strcat DoRemoveProp
"#/" strcat nextprop
begin
dup while
over over nextprop
rot rot DoRemoveProp
repeat
pop
;
: DoShowList ( d s -- ) (* display list s on object d *)
"#/" strcat swap LMGR-GetList
begin (* begin line-listing loop *)
dup while
dup 1 + rotate DoCrypt1 Tell
1 -
repeat (* end line-listing loop *)
pop
;
: DoCryptList ( d s -- ) (* encrypt list s on d *)
over rot rot
"#/" strcat nextprop
begin
dup while
over over over over getpropstr DoCrypt1 setprop
over swap nextprop
repeat
pop pop
;
: DoSetKey ( d -- ) (* set encryption key to value for player d *)
ourPlayer @ int ourKey !
;
(*************** Begin internal data-handling functions ***************)
: DoCapitalize ( s -- s' ) (* return s, capitalized *)
1 strcut swap toupper swap strcat
;
: DoLine ( -- ) (* notify with 72 - dashes *)
me @
"-----------------------------------------------------------------------"
notify
;
: DoComString ( -- s ) (* return space + command name + space *)
" " command @ strcat " " strcat
;
: DoDot39 ( s -- s' ) (* return s, padded with dots to 39 chars *)
".................................................................."
strcat 39 strcut pop
;
: DoSafeName ( d -- s ) (* return name of d; wrap for invalid dbrefs *)
dup ok? if
dup player? if
name
else
unparseobj
then
else
pop "<unknown>"
then
;
: DoMsgToTime ( -- i ) (* return ourMessage as a systime *)
ourMessage @ dup "/" rinstr strcut swap pop
dup "." rinstr strcut pop
atoi
;
: DoParseTimeString ( s -- i1 i2 )
(* convert string s to number of seconds i1. i2 is true if successful *)
(* format of s is `<num> if
3 over strlen -
begin
dup while
"0" rot strcat swap
1 -
repeat
pop strcat
swap pop
else
"0000" strcat 3 strcut pop strcat
then
;
: DoGetDaysFromNow ( -- s ) (* format ourMessage as day-from-now *)
ourMessage @ not if "On an unknown date, at " exit then
ourMessage @ "." rinstr not if "On an unknown date, at " exit then
systime 86400 /
ourMessage @ dup "." rinstr strcut pop
dup "/" rinstr pop
atoi 86400 / -
dup if
dup 1 = if
pop "Yesterday at "
else
intostr " days ago at "
then
else
pop "Today at "
then
;
: DoPropToFldr ( s -- s' ) (* return fldr prop s as a fldr name *)
dup "/" rinstr strcut swap pop
;
: DoPropToMsg ( s -- s' ) (* return msg prop s as a msg string *)
dup "/" rinstr strcut swap pop "" "#" subst
;
: DoFldrToProp ( s -- s' ) (* return fldr name s as a fldr prop *)
"@/mail/fo/" swap strcat
;
: DoMsgToProp ( s -- s' ) (* return msg string as a msg prop *)
"@/mail/fo/" ourFolder @ strcat "/" strcat swap strcat
;
: DoMsgToList ( s -- s' ) (* return msg string as a list prop *)
DoMsgToProp "#" strcat
;
: DoFldrNotEmpty ( d s -- ) (* mark d's folder s not empty *)
"@/mail/fo/" swap strcat
"/000000000000.000#" strcat DoRemoveProp
;
: DoCopyDir ( d1 s1 d2 s2 -- ) (* copy dir s1 on d1 to dir s2 on d2.
do not copy subdirs *)
4 pick 4 pick propdir? if
3 pick "*/" smatch not if
3 pick "/" strcat 3 put
then
else
pop pop pop pop exit
then
dup "*/" smatch not if
"/" strcat
then
3 pick 5 rotate 5 rotate 5 rotate 5 rotate
dup 5 rotate 5 rotate 5 rotate 5 rotate
4 pick 4 pick nextprop dup 4 put
5 rotate 5 rotate 5 rotate 5 rotate
begin
4 pick 4 pick getprop if
pop over
7 pick 7 pick swap subst
4 pick 4 pick 4 pick 4 pick
4 rotate 4 rotate getprop setprop
4 pick 4 pick nextprop dup not if
break
then
dup 4 put 5 put
else
4 pick 4 pick dup "*/" smatch if
dup strlen 1 - strcut pop
then
over over nextprop not if
pop pop break
then
nextprop dup 4 put 5 put
then
pop over 7 pick 7 pick swap subst
repeat
pop pop pop pop pop pop pop pop
;
: DoCopyProp ( d1 s1 d2 s2 -- )(* copy d1's prop s1 to d2's prop s2 *)
4 rotate 4 rotate getprop setprop
;
: DoMoveProp ( d1 s1 d2 s2 -- )(* move d1's prop s1 to d2's prop s2 *)
4 pick 4 pick getprop setprop DoRemoveProp
;
: DoRemoveDir ( d s -- ) (* remove dir s from d *)
dup "*/" smatch not if
"/" strcat
then
over over nextprop swap pop
begin
dup while
over over nextprop
3 pick rot "" setprop
repeat
pop pop
;
: DoMoveDir ( d1 s1 d2 s2 -- ) (* move dir s1 on d1 to dir s2 on d2;
delete originals; do not copy or
delete subdirs *)
4 pick 4 pick 4 pick 4 pick
DoCopyDir
pop pop DoRemoveDir
;
: DoCopyToWL ( -- ) (* copy ourMessage to workspace list *)
me @ "@/mail/fo/" ourFolder @ strcat "/" strcat
ourMessage @ strcat "#" strcat
me @ "@/mail/wl#"
4 pick 4 pick 4 pick 4 pick DoCopyDir DoCopyProp
;
: DoEditWL ( -- ) (* edit workspace list *)
me @ "@/mail/wl" DoCryptList
me @ "@/mail/wl" DoEditList
ourBoolean @ if
me @ "@/mail/dl/-jmtemp-" DoRemoveProp
me @ "@/mail/wl#" over over DoRemoveDir DoRemoveProp
exit
then
me @ "@/mail/wl" DoCryptList
;
: DoCheckMemUsed ( d -- i ) (* return size of d's mailbox in bytes *)
(* only message contents and subject lines are counted
against mailbox size; actual size used including
property names and other data props is larger. *)
0 ourTotal !
dup "@/mail/fo/" nextprop
begin (* begin folder-listing loop *)
dup while
over over "/" strcat nextprop
begin (* begin message-listing loop *)
dup while
3 pick over "/" strcat nextprop
begin (* begin line-listing loop *)
dup while
4 pick over getpropstr strlen ourTotal @ + ourTotal !
4 pick swap nextprop
repeat (* end line-listing loop *)
pop
3 pick swap nextprop
repeat (* end message-listing loop *)
pop
over swap nextprop
repeat (* end folder-listing loop *)
pop
dup "@/mail/su/" nextprop
begin
dup while
over over getpropstr strlen ourTotal @ + ourTotal !
over swap nextprop
repeat
pop pop
ourTotal @
;
: DoCheckDbref ( d -- i ) (* return true if d is a player *)
dup ok? if
dup player? if
pop 1
else
pop 0
then
else
pop 0
then
;
: DoCheckBoxFull ( d -- i ) (* return true if d's mbox is full *)
me @ "W" flag? if pop 0 exit then (* wizzes can always mail to *)
dup "@/mail/ma" getprop ourCounter ! (* get capacity *)
ourCounter @ not if
prog "@/mail/ma" getprop ourCounter !
then
(* compare box size to capacity *)
ourCounter @ if
DoCheckMemUsed ourCounter @ > if
1
else
0
then
else
pop 0
then
;
: DoCheckMsgExists ( d s1 s2 -- i )
(* return true if message s2 exists in d's folder s1 *)
swap "@/mail/fo/" swap strcat "/" strcat
swap strcat "#/" strcat nextprop if
1
else
0
then
;
: DoCheckFolderExists ( s -- i ) (* return true if s is a folder *)
me @ "@/mail/fo/" rot strcat "/" strcat nextprop if
1
else
0
then
;
: DoCheckCanMailTo ( d -- i ) (* return true if mail can go to d *)
dup "@/mail/bl" me @ REF-inlist? if (* check: being blocked? *)
">> Your mail to " swap name strcat
" is being blocked." strcat Tell
0 exit
then
dup DoCheckBoxFull if (* check: box full? *)
">> " swap name strcat
"'s mailbox is full." strcat Tell
0 exit
then
dup "@/mail/po" getpropstr if (* check: page-mail only? *)
">> " swap name strcat
" cannot use mail." strcat Tell
0 exit
then
dup "@/mail/no" getpropstr if (* check: lock-out? *)
">> " swap name strcat
" cannot use JMail." strcat Tell
0 exit
then
pop
me @ DoCheckBoxFull if (* check: sender full? *)
">> Your mailbox is full." Tell
">> You must delete messages in order to send or receive mail."
Tell
0 exit
then
1 (* passed all checks: return true *)
;
: DoCheckCanMailToQ ( d -- i ) (* return true if mail can go to d *)
(* this version has no notification, for public function calls *)
dup "@/mail/bl" me @ REF-inlist? if (* check: being blocked? *)
pop 0 exit
then
dup DoCheckBoxFull if (* check: box full? *)
pop 0 exit
then
dup "@/mail/po" getpropstr if (* check: page-mail only? *)
pop 0 exit
then
dup "@/mail/no" getpropstr if (* check: lock-out? *)
pop 0 exit
then
pop
1 (* passed all checks: return true *)
;
: DoCopyMsgTo ( -- ) (* copy new msg from workdir to oplyr *)
ourPlayer @ DoInitPlayer (* initialize target player if needed *)
ourSubject @ DoCrypt1 ourSubject ! (* encrypt subject *)
me @ "@/mail/wl#" (* copy data *)
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat "#" strcat
4 pick 4 pick 4 pick 4 pick DoCopyDir DoCopyProp
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat DoCryptList
ourPlayer @ ourFolder @ DoFldrNotEmpty
ourPlayer @ "@/mail/su/" ourMessage @ strcat ourSubject @ setprop
ourPlayer @ "@/mail/fr/" ourMessage @ strcat me @ setprop
ourPlayer @ "@/mail/un/" ourMessage @ strcat "1" setprop
ourDistList @ if
me @ "@/mail/dl/-jmtemp-"
ourPlayer @ "@/mail/mu/" ourMessage @ strcat
DoCopyProp
then
ourPlayer @ "@/mail/qu" getpropstr not if (* notify player *)
ourPlayer @ ">> You have new mail." notify
then
;
: DoCopyMsgToP ( -- ) (* put a new message in inbox from prog call *)
ourPlayer @ DoInitPlayer (* initialize target player if needed *)
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat "#" strcat
over over "/1" strcat
ourBody @ setprop "1" setprop
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat DoCryptList
ourPlayer @ ourFolder @ DoFldrNotEmpty
ourPlayer @ "@/mail/su/" ourMessage @ strcat ourSubject @ setprop
ourPlayer @ "@/mail/fr/" ourMessage @ strcat me @ setprop
ourPlayer @ "@/mail/un/" ourMessage @ strcat "1" setprop
ourDistList @ if
ourArg3 @ ourDistList @
ourPlayer @ "@/mail/mu/" ourMessage @ strcat
DoCopyProp
then
ourPlayer @ "@/mail/qu" getpropstr not if (* notify player *)
ourPlayer @ ">> You have new mail." notify
then
;
: DoCheckEmptyFldr ( d s -- i ) (* return true if d's fldr s is empty *)
"@/mail/fo/" swap strcat "/" strcat nextprop dup if
"000000000000.000" instr if
1
else
0
then
else
pop 1 (* nonexistent counts as empty *)
then
;
: DoTouchFldr ( s -- ) (* put place holder in ofldr if necessary *)
me @ "@/mail/fo/" 3 pick strcat "/" strcat nextprop if
pop
else
me @ "@/mail/fo/" rot strcat "/000000000000.000#" strcat "1" setprop
then
;
: DoDeleteMsg ( -- ) (* delete omsg in oplyr's ofldr *)
ourPlayer @ "@/mail/fr/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/mu/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/su/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/un/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/ke/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/de/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/pm/" ourMessage @ strcat DoRemoveProp
ourPlayer @ "@/mail/fo/" ourFolder @ strcat "/" strcat
ourMessage @ strcat "#" strcat over over
DoRemoveDir DoRemoveProp
ourFolder @ DoTouchFldr
;
: DoMsgToRecyclingBin ( -- ) (* copy ourMessage to recycling bin *)
me @ "@/mail/rb/" DoRemoveDir (* clear old data *)
me @ dup "@/mail/rb/ms#/" DoRemoveDir
me @ "@/mail/fo/" ourFolder @ strcat "/" strcat (* copy msg *)
ourMessage @ strcat "#" strcat me @ "@/mail/rb/ms#"
4 pick 4 pick 4 pick 4 pick DoCopyDir DoCopyProp
me @ "@/mail/fr/" ourMessage @ strcat
me @ "@/mail/rb/fr" DoCopyProp
me @ "@/mail/su/" ourMessage @ strcat
me @ "@/mail/rb/su" DoCopyProp
me @ "@/mail/un/" ourMessage @ strcat
me @ "@/mail/rb/un" DoCopyProp
me @ "@/mail/mu/" ourMessage @ strcat
me @ "@/mail/rb/mu" DoCopyProp
me @ "@/mail/pm/" ourMessage @ strcat
me @ "@/mail/rb/pm" DoCopyProp
me @ "@/mail/ke/" ourMessage @ strcat
me @ "@/mail/rb/ke" DoCopyProp
me @ "@/mail/rb/ms" ourMessage @ setprop
me @ "@/mail/rb/fo" ourFolder @ DoCrypt1 setprop
;
: DoGetMsgRng ( d s -- s .. s' i )
( return contents of d's folder s as a str rng *)
0 rot dup "@/mail/fo/" 5 rotate strcat "/" strcat nextprop
dup not if
pop pop exit
then
dup "00000000000.000" instr if
pop pop exit
then
begin
dup while
dup dup "/" rinstr strcut swap pop
"" "#" subst
4 pick 4 + -1 * rotate
3 pick 1 + 3 put
over swap nextprop
repeat
pop pop
;
: DoGetPlayerRng ( s -- d .. d' i )(* parse s into rng of plyr dbrefs *)
(* do it differently for 1 player vs 2+; makes loops a little cleaner *)
strip " " explode dup ourCounter !
dup 2 >= if
begin
dup while
over .pmatch
dup #-1 dbcmp if
pop ">> Player " rot DoCapitalize strcat
" not found." strcat Tell
ourCounter @ 1 - ourCounter !
1 - continue
then
dup #-2 dbcmp if
pop ">> Player name `" rot DoCapitalize strcat
" is ambiguous. I don't know who you mean." strcat Tell
ourCounter @ 1 - ourCounter !
1 - continue
then
over 2 + -1 * rotate
swap pop
1 - continue
repeat
pop ourCounter @
else
pop
dup if
dup .pmatch
dup #-1 dbcmp if
pop ">> Player " swap DoCapitalize strcat
" not found." strcat Tell 0 exit
then
dup #-2 dbcmp if
pop ">> Player name `" swap rot DoCapitalize strcat
" is ambigous. I don't kow who you mean." strcat Tell
0 exit
then
swap pop 1 exit
else
pop 0
then
then
;
: DoGetFldrCount ( d -- i ) (* return count of d's folders *)
0 swap
dup "@/mail/fo/" nextprop
begin
dup while
3 pick 1 + 3 put
over swap nextprop
repeat
pop pop
;
: DoGetMsgCount ( d s -- i ) (* return count of msgs in d's folder s *)
0 rot dup "@/mail/fo/" 5 rotate strcat "/" strcat nextprop
dup not if
pop pop exit
then
dup "000000000000.000" instr if
pop pop exit
then
begin
dup while
3 pick 1 + 3 put
over swap nextprop
repeat
pop pop
;
: DoGetUnreadInFldr ( d s -- i )
(* return count of unread msgs in d's folder s *)
0 rot dup "@/mail/fo/" 5 rotate strcat "/" strcat nextprop
dup not if
pop pop exit (* folder doesn't exist; return 0 *)
then
dup "000000000000.000" instr if (* folder is empty; return 0 *)
pop pop exit
then
begin
dup while
ourPlayer @ "@/mail/un/"
3 pick dup "/" rinstr strcut swap pop
"" "#" subst
strcat getprop if
3 pick 1 + 3 put
then
over swap nextprop
repeat
pop pop
;
: DoGetAllFromMe ( -- d..d' ) (* put all msgs from user on stack *)
ourPlayer @ "@/mail/fr/" nextprop (* NOTE: NOT A RANGE; NO INT *)
begin
dup while
ourPlayer @ over getprop me @ dbcmp if
dup DoPropToMsg swap
then
ourPlayer @ swap nextprop
repeat
pop
;
: DoGetMsgInfo ( -- ) (* show subj and date/time of omsg *)
ourPlayer @ "@/mail/su/" ourMessage @ strcat getpropstr DoCrypt1
" (sent %D %l:%M:%S %p)" DoMsgToTime timefmt " " " 0" subst strcat
;
: DoGetMsgEntry ( -- s )(* return s with subj, date, sender of omsg *)
me @ "@/mail/un/" ourMessage @ strcat getprop if "*" else "" then
me @ "@/mail/su/" ourMessage @ strcat getprop DoCrypt1 strcat
" ["
me @ "@/mail/fr/" ourMessage @ strcat getprop dup if
DoSafeName
else
pop "<unknown>"
then
strcat
", %D %l:%M:%S %p]" DoMsgToTime timefmt " " " 0" subst strcat
me @ "@/mail/de/" ourMessage @ strcat getprop if
"(" "[" subst
")" "]" subst
then
" " " " subst
strcat
;
: DoFindMsgByNumber ( s -- ) (* find msg s in ofldr; store in omsg *)
atoi 0 ourCounter ! 0 ourMessage !
dup 0 <= if pop exit then
ourPlayer @ ourFolder @ DoCheckEmptyFldr if
pop exit
then
ourPlayer @ ourFolder @ DoFldrToProp "/" strcat nextprop
begin
dup while
ourCounter @ 1 + ourCounter !
over ourCounter @ = if
dup DoPropToMsg ourMessage ! break
then
ourPlayer @ swap nextprop
repeat
pop pop
;
: DoFindMsgByName (s -- ) (* find msg s in ofldr; store in omsg *)
0 ourMessage !
me @ "@/mail/su/" nextprop
begin
dup while
me @ over getpropstr DoCrypt1 3 pick stringpfx if
dup me @ "@/mail/fo/" ourFolder @ strcat "/" strcat
3 pick dup "/" rinstr strcut swap pop strcat
"#/" strcat nextprop if
dup "/" rinstr strcut swap pop "" "#" subst ourMessage !
break
then
then
me @ swap nextprop
repeat
pop pop
;
: DoFindFldrByNumber ( s -- ) (* find fldr s; store in ofldr *)
atoi 0 ourCounter ! 0 ourFolder !
dup 0 <= if pop exit then
ourPlayer @ "@/mail/fo/" nextprop
begin
dup while
ourCounter @ 1 + ourCounter !
over ourCounter @ = if
dup dup "/" rinstr strcut swap pop ourFolder ! break
then
ourPlayer @ swap nextprop
repeat
pop pop
;
: DoFindFldrByName ( s -- ) (* find fldr s; store in ofldr *)
0 ourFolder !
me @ "@/mail/fo/" nextprop
begin
dup while
dup DoPropToFldr
3 pick stringpfx if
dup DoPropToFldr ourFolder ! break
then
me @ swap nextprop
repeat
pop pop
;
: DoFindFldrByMsg ( -- ) (* find folder that contains omsg *)
ourPlayer @ "@/mail/fo/" nextprop
begin
dup while
ourPlayer @ over "/" strcat ourMessage @ strcat "#/" strcat nextprop
if
dup dup "/" rinstr strcut swap pop ourFolder !
break
then
ourPlayer @ swap nextprop
repeat
pop
;
: DoInsertStampLine ( -- ) (* insert a stampline in working list *)
"On <somedate> *)
(* no need to encrypt: > is same both encrypted and unencrypted *)
me @ "@/mail/wl#/" nextprop
begin
dup while
me @ over over over
getpropstr ">" swap strcat setprop
me @ swap nextprop
repeat
pop
;
: DoFormatReply ( -- ) (* format working list for reply *)
(* list needs to be encrypted when formatting *)
DoInsertGT
DoInsertStampLine
"E" "@/mail/wl" me @ LMGR-GetCount 1 +
"@/mail/wl" me @ LMGR-PutElem
;
: DoConfirmCancel ( -- i ) (* confirm user wants to cancel omsg *)
me @ "@/mail/da" getprop if 1 exit then
">> " DoGetMsgInfo strcat Tell
">> Please confirm: You wish to cancel this message? (y/n)" Tell
DoYesNoI
;
: DoShowDistList ( -- ) (* show members of ourDistList, personal *)
me @ "@/mail/dl/" ourDistList @ strcat getpropstr if
ourDistList @ DoCapitalize " Members: " strcat
me @ "@/mail/dl/" ourDistList @ strcat REF-list strcat Tell
else
">> Distribution list not found." Tell
then
;
: DoShowGDistList ( -- ) (* show members of ourDistList, global *)
prog "@/mail/dl/" ourDistList @ strcat getpropstr if
ourDistList @ DoCapitalize " Members: " strcat
prog "@/mail/dl/" ourDistList @ strcat REF-list strcat Tell
else
">> Distribution list not found." Tell
then
;
: DoShowDistLists ( -- ) (* show personal distribution lists *)
ourArg2 @ if DoShowDistList exit then
DoLine
"DISTRIBUTION LISTS:" Tell " " Tell
me @ "@/mail/dl/" nextprop dup if
begin
dup while
dup dup "/" rinstr strcut swap pop strip DoCapitalize
": " strcat
me @ 3 pick REF-list strcat Tell
me @ swap nextprop
dup if " " Tell then
repeat
else
pop "<none defined>" Tell
then
DoLine
;
: DoShowGDistLists ( -- ) (* show global distribution lists *)
ourArg2 @ if DoShowGDistList exit then
DoLine
"GLOBAL DISTRIBUTION LISTS:" Tell " " Tell
prog "@/mail/dl/" nextprop dup if
begin
dup while
dup dup "/" rinstr strcut swap pop strip DoCapitalize
": " strcat
prog 3 pick REF-list strcat Tell
prog swap nextprop
dup if " " Tell then
repeat
else
pop "<none defined>" Tell
then
DoLine
;
: DoShowUsage ( -- ) (* show mailbox usage stats for ourPlayer *)
0 ourTotal !
"MAILBOX: " ourPlayer @ name strcat Tell
">> "
0 ourCounter !
ourPlayer @ "@/mail/su/" nextprop (* tally number of messages *)
begin
dup while
ourCounter @ 1 + ourCounter !
ourPlayer @ over getpropstr strlen ourTotal @ + ourTotal !
ourPlayer @ swap nextprop
repeat
pop
ourCounter @ intostr strcat
ourCounter @ 1 = if
" message "
else
" messages "
then
strcat
(* tally unread messages *)
0 ourCounter !
ourPlayer @ "@/mail/un/" nextprop
begin
dup while
ourCounter @ 1 + ourCounter !
ourPlayer @ swap nextprop
repeat
pop
ourCounter @ if
"(" strcat ourCounter @ intostr strcat " unread) " strcat
then
"in " strcat
(* tally number of folders *)
0 ourCounter !
ourPlayer @ "@/mail/fo/" nextprop
begin
dup while
ourCounter @ 1 + ourCounter !
ourPlayer @ swap nextprop
repeat
pop
ourCounter @ intostr strcat " folders" strcat Tell
(* tally memory used *)
ourPlayer @ "@/mail/fo/" nextprop
begin (* begin folder-reading loop *)
dup while
ourPlayer @ over "/" strcat nextprop
begin (* begin message-reading loop *)
dup while
ourPlayer @ over "/" strcat nextprop
begin (* begin line-reading loop *)
dup while
ourPlayer @ over getpropstr strlen ourTotal @ + ourTotal !
ourPlayer @ swap nextprop
repeat (* end line-reading loop *)
pop
ourPlayer @ swap nextprop
repeat (* end message-reading loop *)
pop
ourPlayer @ swap nextprop
repeat (* end folder-reading loop *)
pop
">> Memory used: " ourTotal @ intostr strcat " bytes" strcat
ourPlayer @ "@/mail/ma" getprop dup not if
pop prog "@/mail/ma" getprop
then
(* calculate percentage of mailbox capacity used *)
dup if
1000 * ourTotal @ /
100000 swap / intostr
"% capacity)" strcat " (" swap strcat strcat
else
pop
then
Tell
(* show message-aging time *)
ourPlayer @ "@/mail/ag" getprop if
ourPlayer @ "@/mail/ag" getprop
else
prog "@/mail/ag" getprop
then
ourTime !
ourTime @ if
">> Messages are kept for "
ourTime @ DoParseTimeInt strcat Tell
then
;
: DoDeleteLast ( -- ) (* delete last message read *)
me @ "@/mail/lf" getpropstr (* check: do we have one to delete? *)
me @ "@/mail/lm" getpropstr and not if
">> No 'last read' message is currently recorded." Tell exit
then
me @
me @ "@/mail/lf" getpropstr DoCrypt1 dup ourFolder !
me @ "@/mail/lm" getpropstr dup ourMessage ! DoCheckMsgExists not if
">> Your last read message no longer exists." Tell exit
then
ourBoolean @ not if (* confirm if necessary *)
me @ "@/mail/da" getpropstr not if
">> " DoGetMsgEntry strcat Tell
">> Please confirm: You wish to delete this message? (y/n)" Tell
DoYesNo
then
then
(* move msg to recycling bin; delete original *)
DoMsgToRecyclingBin
DoDeleteMsg
me @ "@/mail/lm" DoRemoveProp
me @ "@/mail/lf" DoRemoveProp
">> Message deleted." Tell
;
: DoEditInPlace ( -- ) (* move omsgs to worklist, edit, move back *)
(* it's not really an edit in place: @q aborts or )
( unexpected disconnnections could leave a message )
( being edited in shambles. So, do all edits of )
( existing messages by copying to a work space, )
( then copy back as needed *)
me @ "@/mail/un/" ourMessage @ strcat DoRemoveProp
"FROM: " me @ "@/mail/fr/" (* show header info *)
ourMessage @ strcat getprop DoSafeName strcat Tell
"SUBJECT: " me @ "@/mail/su/"
ourMessage @ strcat getpropstr DoCrypt1 strcat Tell
" " Tell
me @ "@/mail/fo/" ourFolder @ strcat "/" strcat
ourMessage @ strcat "#" strcat
me @ "@/mail/wl#"
4 pick 4 pick 4 pick 4 pick DoCopyProp DoCopyDir (* copy list *)
me @ "@/mail/wl" DoCryptList
me @ "@/mail/wl" DoEditList
me @ "@/mail/wl#/" nextprop if (* finish up if we have a msg *)
background
me @ "@/mail/wl" DoCryptList
me @ "@/mail/fo/" ourFolder @ strcat "/" strcat
ourMessage @ strcat "#" strcat
over over DoRemoveDir DoRemoveProp
me @ "@/mail/wl#"
me @ "@/mail/fo/" ourFolder @ strcat "/" strcat
ourMessage @ strcat "#" strcat
4 pick 4 pick 4 pick 4 pick DoCopyProp DoCopyDir
me @ ourFolder @ DoFldrNotEmpty
me @ ourFolder @ DoTouchFldr
else
DoDeleteMsg
then
;
: DoSendToRange ( d .. d' i -- ) (* send ourMessage to range *)
ourArg3 ! (* we're done with this var... borrow it as a counter *)
begin
ourArg3 @ while
ourArg3 @ 1 - ourArg3 !
ourPlayer ! (* initialize target player, check ok *)
ourPlayer @ DoInitPlayer
ourPlayer @ DoCheckCanMailTo not if
continue
then (* copy data *)
me @ "@/mail/wl#"
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat "#" strcat
4 pick 4 pick 4 pick 4 pick DoCopyDir DoCopyProp
ourPlayer @ "@/mail/su/" ourMessage @ strcat ourSubject @ setprop
ourPlayer @ "@/mail/fr/" ourMessage @ strcat me @ setprop
ourPlayer @ "@/mail/un/" ourMessage @ strcat "1" setprop
ourPlayer @ " Inbox" DoFldrNotEmpty
ourDistList @ if
me @ "@/mail/dl/-jmtemp-"
ourPlayer @ "@/mail/mu/" ourMessage @ strcat
DoCopyProp
then
ourPlayer @ "@/mail/qu" getpropstr not if
ourPlayer @ ">> You have new mail." notify
then
repeat
;
: DoParseFldrMsgArgs ( -- ) (* parse arg1 & arg2 as fldr & msg *)
(* generic parsing for 1=2, inbox=4, 4=policy, drafts=faq, etc. *)
ourArg2 @ if
ourArg1 @ DoFindFldrByNumber ourFolder @ if
ourArg2 @ DoFindMsgByNumber ourMessage @ if
exit
then
ourArg2 @ DoFindMsgByName ourMessage @ if
exit
then
then
ourArg1 @ DoFindFldrByName ourFolder @ if
ourArg2 @ DoFindMsgByNumber ourMessage @ if
exit
then
ourArg2 @ DoFindMsgByName ourMessage @ if
exit
then
then
else
ourArg1 @ DoFindMsgByNumber ourMessage @ if
exit
then
ourArg1 @ DoFindMsgByName ourMessage @ if
exit
then
ourArg1 @ DoFindFldrByNumber ourFolder @ if
exit
then
ourArg1 @ DoFindFldrByName ourFolder @ if
exit
then
then
;
: DoParseArgs ( -- ) (* parse arg into #func, arg1, arg2, arg3 *)
(* when function is called, ourFunc, ourArg2, and
ourArg3 are undef; ourArg1 is command line arg *)
(* this should work of all jmail commands;
put in one place to ensure consistency *)
ourArg1 @ not if exit then (* exit if no args *)
ourArg1 @ "#*" smatch (* check: solo #func arg? )
ourArg1 @ " " instr not and if
ourArg1 @ "#" smatch if
">> Sorry, unable to parse input." Tell pid kill
then
ourArg1 @ "" "#" subst DoPadSysFolders DoCheckFolderExists if
ourArg1 @ "" "#" subst DoPadSysFolders ourArg1 !
else
ourArg1 @ ourFunc !
0 ourArg1 !
then
exit
then
(* check: a leading #func arg? *)
ourArg1 @ "#*" smatch
ourArg1 @ " " instr and if
ourArg1 @ dup " " instr strcut strip ourArg1 ! strip ourFunc !
"#all" ourArg1 @ stringpfx if
ourArg1 @ dup " " instr strcut strip ourArg3 !
strip dup if
ourArg1 !
else
pop ourArg3 @ ourArg1 !
then
then
then
(* check: a 'to' for arg3? *)
ourFunc @ if (* apply only in #send and #move *)
"#send" ourFunc @ stringpfx
"#move" ourFunc @ stringpfx or if
ourArg1 @ " to " instr if
ourArg1 @ dup " to " rinstr strcut strip
dup " " instr strcut swap pop strip ourArg3 !
strip ourArg1 !
then
then
then
(* check: = but not arg1 & arg2? bad syntax *)
ourArg1 @ "=" instr if
ourArg1 @ dup "=" instr strcut strip ourArg2 !
strip dup strlen 1 - strcut pop strip ourArg1 !
ourArg1 @ not ourArg2 @ not or if
">> Sorry, unable to parse input." Tell pid kill
then
then
(* check: #func and arg1 the same? bad syntax *)
ourFunc @ if
ourFunc @ ourArg1 @ smatch if
">> Sorry, unable to parse input." Tell pid kill
then
then
(* pad Inbox and Drafts as needed *)
ourFunc @ if ourFunc @ DoPadSysFolders ourFunc ! then
ourArg1 @ if ourArg1 @ DoPadSysFolders ourArg1 ! then
ourArg2 @ if ourArg2 @ DoPadSysFolders ourArg2 ! then
ourArg3 @ if ourArg3 @ DoPadSysFolders ourArg3 ! then
;
(****************** Begin command-handling functions ******************)
: DoAsk ( -- ) (* set: jmail will prompt for deletions, etc *)
me @ "@/mail/da" DoRemoveProp
">> Set. JMail will ask confirmation to delete, move, or cancel."
Tell
;
: DoAskNo ( -- ) (* set: jmail will not prompt for deletions, etc *)
me @ "@/mail/da" "1" setprop
">> Set. JMail will not ask confirmation to delete, move, or cancel."
Tell
;
: DoBlock ( -- ) (* set: block mail from ourPlayer *)
me @ "@/mail/bl" ourPlayer @ REF-add
">> Set. You are blocking mail from "
ourPlayer @ name strcat "." strcat Tell
;
: DoBlockNo ( -- ) (* set: don't block mail from ourPlayer *)
me @ "@/mail/bl" ourPlayer @ REF-delete
">> Set. You are not blocking mail from "
ourPlayer @ name strcat "." strcat Tell
;
: DoCancel ( -- ) (* cancel an unread message to ourPlayer *)
0 ourCounter ! (* put unread msgs from user on stack as str range *)
(* filter results to range of unread, unkept in inbox *)
ourPlayer @ "@/mail/un/" nextprop
begin
dup while
dup DoPropToMsg ourMessage !
ourPlayer @ "@/mail/fo/ Inbox/"
ourMessage @ strcat "#/" strcat nextprop
ourPlayer @ "@/mail/fr/" ourMessage @ strcat getprop me @ dbcmp
ourPlayer @ "@/mail/ke/" ourMessage @ strcat getprop not
and and if
ourMessage @ swap
ourCounter @ 1 + ourCounter !
then
ourPlayer @ swap nextprop
repeat
pop
(* notify if no unread messages available *)
ourCounter @ not if
">> " ourPlayer @ DoSafeName strcat
" has no unread messages from you." strcat Tell exit
then
ourCounter @ 1 = if (* if 1 unread msg, show and confirm *)
DoConfirmCancel if
ourMessage !
else
">> Aborted." Tell exit
then
else (* if more than 1, show and get selection *)
">> " ourPlayer @ DoSafeName strcat
" has " strcat ourCounter @ intostr strcat
" unread messages from you:" strcat Tell
ourCounter @ 0
begin
dup ourCounter @ = not while
1 +
dup 2 + pick ourMessage !
dup intostr ") " strcat dup strlen 3 = if " " strcat then
DoGetMsgInfo strcat Tell
repeat
pop
ourCounter @
begin
">> Enter number of message to cancel, or .q to quit" Tell
read
".quit" over stringpfx if
">> Aborted." Tell exit
then
dup number? not if
">> Sorry, that's not a number." Tell pop continue
then
atoi dup 0 <
over ourCounter @ > or if
">> Sorry, invalid selection." Tell pop continue
then
2 + pick ourMessage !
DoConfirmCancel if
break
else
">> Aborted." Tell exit
then
repeat
DoNukeStack
then
(* find out if user wants to save a copy *)
">> Do you want to save a copy in your Drafts folder? (y/n)" Tell
DoYesNoI if
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat "#" strcat
me @ "@/mail/fo/ Drafts/" ourMessage @ strcat "#" strcat
4 pick 4 pick 4 pick 4 pick DoCopyDir DoCopyProp
ourPlayer @ "@/mail/su/" ourMessage @ strcat
me @ "@/mail/su/" ourMessage @ strcat DoCopyProp
me @ "@/mail/fr/" ourMessage @ strcat me @ setprop
me @ " Drafts" DoFldrNotEmpty
then
(* cancel message and notify *)
DoDeleteMsg
">> Message cancelled." Tell
;
: DoDeleteAll ( -- ) (* delete all unprotected messages *)
me @ "@/mail/da" getpropstr not if (* confirm *)
">> Please confirm: You wish to delete "
"all unprotected messages? (y/n)" strcat Tell
DoYesNo
then
me @ "@/mail/fo/" nextprop
begin (* begin folder-listing loop *)
dup while
dup DoPropToFldr ourFolder !
me @ ourFolder @ DoGetMsgRng
begin (* begin message-listing loop *)
dup while
swap ourMessage !
me @ "@/mail/ke/" ourMessage @ strcat getpropstr not if
DoDeleteMsg (* delete message *)
then
1 -
repeat (* end message-listing loop *)
pop
me @ swap nextprop
repeat (* end folder-listing loop *)
pop
">> All unprotected messages deleted." Tell
;
: DoDelete ( -- ) (* delete ourMessage *)
me @ "@/mail/da" getpropstr not if (* confirm *)
">> " DoGetMsgEntry strcat Tell
">> Please confirm: You wish to delete this message? (y/n)" Tell
DoYesNo
then
(* copy to recycling bin for undelete *)
DoMsgToRecyclingBin
DoDeleteMsg (* then delete it *)
">> Message deleted." Tell
;
: DoCreateFldr ( s -- ) (* create folder s *)
DoCapitalize (* check: valid name? *)
"{block|cancel|delete|folder|folders|glist|global|keep|"
"list|move|nuke|preempt|reply|send|tidy|usage|warn|-jmtemp-}"
strcat over smatch if
">> Sorry, that folder name would conflict with a mail option."
Tell exit
then
dup number? if
">> Sorry, numbers cannot be used as folder names." Tell exit
then
dup "#*" smatch if
">> Sorry, folder names cannot begin an # octothorpe." Tell exit
then
dup " " instr if
">> Sorry, folder names cannot include spaces." Tell exit
then
dup "/" instr if
">> Sorry, folder names cannot includes slashes." Tell exit
then
(* confirm *)
me @ "@/mail/da" getpropstr not if
">> Please confirm: You wish to create a new folder called "
over strcat "? (y/n)" strcat Tell
DoYesNo
then
(* create it *)
me @ over DoTouchFldr
">> Folder created." Tell
;
: DoDeleteFldr ( -- ) (* delete ourFolder and its contents *)
ourArg1 @ number?
me @ "@/mail/da" getpropstr not or if (* confirm *)
ourArg1 @ number?
me @ "@/mail/da" getpropstr and if
">> Special case... over-riding don't-ask... " Tell
then
">> Please confirm: You wish to delete "
ourFolder @ strip strcat
" and all its contents? (y/n)" strcat Tell
DoYesNo
then
(* put folder contents on stack as string range *)
me @ ourFolder @ DoGetMsgRng
begin (* delete range *)
dup while
swap ourMessage ! DoDeleteMsg
1 -
repeat
pop
(* delete folder *)
me @ "@/mail/fo/" ourFolder @ strcat DoRemoveDir
ourFolder @ " Inbox" smatch
ourFolder @ " Drafts" smatch or if
ourFolder @ DoTouchFldr
then
">> Folder deleted." Tell
;
: DoDeleteDistList ( s -- ) (* delete distlist s *)
me @ "@/mail/dl/" 3 pick strcat getprop if
me @ "@/mail/da" getpropstr not if
">> Please confirm: You wish to delete your "
over DoCapitalize strcat
" distribution list? (y/n)" strcat Tell
DoYesNo
then
me @ "@/mail/dl/" rot strcat DoRemoveProp
">> Deleted." Tell exit
then
me @ "W" flag? if
prog "@/mail/dl/" 3 pick strcat getprop if
me @ "@/mail/da" getpropstr not if
">> Please confirm: You wish to delete the "
over DoCapitalize strcat
" global distribution list? (y/n)" strcat Tell
DoYesNo
then
prog "@/mail/dl/" rot strcat DoRemoveProp
">> Deleted." Tell
then
then
;
: DoEditMsg ( -- ) (* edit ourMessage *)
(* if msg doesn't exist, start new one *)
me @ ourFolder @ ourMessage @ DoCheckMsgExists not if
">> Composing new message in Drafts folder... " Tell
">> SUBJECT: " ourSubject @ strcat Tell
me @ "@/mail/wl" DoEditList
me @ "@/mail/wl#/" nextprop if
background
me @ "@/mail/wl" DoCryptList
me @ "@/mail/wl#"
me @ "@/mail/fo/ Drafts/" ourMessage @ strcat "#" strcat
4 pick 4 pick 4 pick 4 pick DoCopyProp DoCopyDir
me @ "@/mail/su/" ourMessage @ strcat
ourSubject @ DoCrypt1 setprop
me @ "@/mail/fr/" ourMessage @ strcat me @ setprop
me @ ourFolder @ DoFldrNotEmpty
then
">> Done." Tell
else
DoEditInPlace (* otherwise edit existing one in place *)
then
me @ "@/mail/wl#" over over DoRemoveDir DoRemoveProp
;
: DoDistLists ([drng]-- )(* add or remove members from user's dlists *)
ourBoolean @ if
me @ "@/mail/dl/-jmtemp-" REF-allrefs
ourArg1 @ DoCapitalize ourDistList !
begin
dup while
me @ "@/mail/dl/" ourDistList @ strcat 4 pick REF-delete
">> " rot DoSafeName strcat
" removed from your " strcat
ourDistList @ strcat
" distribution list." strcat Tell
1 -
repeat
else
me @ "@/mail/dl/-jmtemp-" REF-allrefs
ourArg1 @ DoCapitalize ourDistList !
begin
dup while
me @ "@/mail/dl/" ourDistList @ strcat 4 pick REF-add
">> " rot DoSafeName strcat
" added to your " strcat
ourDistList @ strcat
" distribution list." strcat Tell
1 -
repeat
then
pop
;
: DoGDistLists ( [drng] -- ) (* add or remove from global dlists *)
me @ "W" flag? not ourArg2 @ not or if (* just show *)
DoShowGDistLists exit
then
me @ "W" flag? not if (* check permission to manipulate *)
">> Permission denied." Tell exit
then
ourBoolean @ if
begin
dup while
prog "@/mail/dl/" ourDistList @ strcat 4 pick REF-delete
">> " rot DoSafeName strcat
" removed from the " strcat
ourDistList @ strcat
" global distribution list." strcat Tell
1 -
repeat
else
begin
dup while
prog "@/mail/dl/" ourDistList @ strcat 4 pick REF-add
">> " rot DoSafeName strcat
" added to the " strcat
ourDistList @ strcat
" global distribution list." strcat Tell
1 -
repeat
then
pop
;
: DoKeep ( -- ) (* mark ourMessage keep *)
me @ "@/mail/ke/" ourMessage @ strcat "1" setprop
me @ "@/mail/de/" ourMessage @ strcat DoRemoveProp
">> Message marked 'keep'." Tell
;
: DoKeepNo ( -- ) (* mark ourMessage don't-keep *)
me @ "@/mail/ke/" ourMessage @ strcat DoRemoveProp
">> Message marked 'don't keep'." Tell
;
: DoAskHelp ( s -- ) (* show help for #ask *)
" " Tell "JMail: Ask" Tell " " Tell
"By default, JMail asks for confirmation before deleting or moving "
"a message, folder, or distribution list. You can turn off these "
"confirmations with #!ask, and turn them back on with #ask."
strcat strcat Tell " " Tell
DoComString "#ask " strcat DoDot39
" JMail will ask for confirmations" strcat Tell
DoComString "#!ask " strcat DoDot39
" Jmail will not ask for confirmations" strcat Tell
" " Tell pop
;
: DoBlockHelp ( s -- ) (* show help for #block *)
" " Tell "JMail: Block" Tell " " Tell
"You may block mail from a particular player with the "
"#block option. You may not send messages to someone while you "
"are blocking them. Messages from wizards will not be blocked."
strcat strcat Tell " " Tell
DoComString "#block <player> " strcat DoDot39
" Block messages from <player>" strcat Tell
DoComString "#!block <player> " strcat DoDot39
" Don't block messages from <player>" strcat Tell
" " Tell pop
;
: DoCancelHelp ( s -- ) (* show help for #cancel *)
" " Tell "JMail: Cancel" Tell " " Tell
"You may cancel or recall unread messages that you sent to a player. "
"Note that a message will be considered 'read' in this context if "
"the target player has moved, touched, or kept the message, "
"even if it has not actually been read."
strcat strcat strcat Tell " " Tell
"The syntax for cancelling a message is '" command @ strcat
" #cancel <player>' If the player only has one unread message from "
"you, this message will automatically be selected. If there is more "
"than one unread message, you will be presented with a list to "
"choose from. When cancelling a message, you have the option to "
"save a copy in your Drafts folder, to be edited and remailed. "
"See also #help for '#view'."
strcat strcat strcat strcat strcat strcat Tell " " Tell
DoComString "#cancel <player> " strcat DoDot39
" Cancel an unread message to <player>" strcat Tell
DoComString "#view <player> " strcat DoDot39
" View messages you sent to <player>" strcat Tell
" " Tell pop
;
: DoDeleteHelp ( s -- ) (* show help for #delete *)
" " Tell "JMail: Delete" Tell " " Tell
"You may use the #delete option to delete either messages, folders, "
"or distribution lists. The #delete option by itself will delete "
"the last message you read. #Delete #all will delete all "
"unprotected messages. The shorthand option #dn will delete the "
"last message you read, and display your next unread message. "
"The #!delete option will recover or undelete your last-deleted "
"message; #!delete does not recover folders or distribution lists."
strcat strcat strcat strcat strcat strcat Tell " " Tell
DoComString "#delete " strcat DoDot39
" Delete the last message you read" strcat Tell
DoComString "#delete <msg> " strcat DoDot39
" Delete <msg> in you Inbox" strcat Tell
DoComString "#delete <folder>=<msg> " strcat DoDot39
" Delete <msg> from if
dup 24 strcut pop
dup " " rinstr strcut pop strip
"... " strcat
then
" (page mail)" strcat DoCrypt1 ourSubject !
DoCrypt1
;
: DoConvertPageMail ( -- ) (* convert existing page mail to jmail *)
me @ "_page/mail#/" nextprop ourCounter !
begin
ourCounter @ while
me @ ourCounter @ getpropstr DoConvPageMailString
me @ "@/mail/fo/ Inbox/" ourMessage @ strcat "#" strcat
over over "1" setprop "/1" strcat rot setprop
me @ "@/mail/fr/" ourMessage @ strcat ourPlayer @ setprop
me @ "@/mail/su/" ourMessage @ strcat ourSubject @ setprop
me @ "@/mail/un/" ourMessage @ strcat "1" setprop
me @ "@/mail/pm/" ourMessage @ strcat "1" setprop
me @ ourCounter @ nextprop
me @ ourCounter @ DoRemoveProp
dup ourCounter !
repeat
pop
me @ "_page/mail#" DoRemoveProp
;
: DoPageMailCheck ( -- ) (* see if user has page mail to convert *)
me @ "_page/mail#/" nextprop if
DoConvertPageMail
then
;
: DoPagePreemptOn ( -- ) (* set up action to handle p #mail *)
prog "@/mail/pmh" getprop dup if
">> Jmail's prop settings show that #preempt is already on." Tell
">> If this is incorrect, type '@ent #" prog atoi intostr strcat
"' to find any actions with " strcat Tell
">> '#mail' in their names, recycle those by dbref, and then type "
Tell ">> " Tell
">> @set #" prog intostr strcat "=@/mail/1206: " strcat
Tell ">> " Tell
">> You should then be able to do #preempt normally." Tell
pop exit
then
me @ "@/mail/da" getpropstr not if
">> Please confirm: You want JMail to handle page mail? (y/n)"
Tell DoYesNo
then
#0 "page #mail;pag #mail;pa #mail;p #mail" newexit
prog "@/mail/pmh" 3 pick setprop
dup "@/mail/1206" "Do Not Remove This Property" setprop
dup "@/mail/ve" "1.0" setprop
prog setlink
">> Set. JMail will now handle page #mail." Tell
;
: DoPagePreemptOff ( -- ) (* recycle p #mail action *)
prog "@/mail/pmh" getprop dup not if
pop "page #mail" match
then
(* flag if problem finding the page #mail action *)
dup not if 1 ourBoolean ! else
dup ok? not if 1 ourBoolean ! else
dup exit? not if 1 ourBoolean ! else
dup getlink prog dbcmp not if 1 ourBoolean ! else
dup "@/mail/1206" getprop not if 1 ourBoolean ! else
then then then then then
ourBoolean @ if
">> Unable to locate page #mail action." Tell
">> Cmd-page should be handling page #mail now." Tell
">> Check actions linked to cmd-page and jmail.muf." Tell
prog "@/mail/pmh" DoRemoveProp
pop
else
me @ "@/mail/da" getpropstr not if
">> Please confirm: You want cmd-page to handle page mail? (y/n)"
Tell DoYesNo
then
recycle
prog "@/mail/pmh" DoRemoveProp
">> Set. Cmd-page will now handle page #mail." Tell
then
;
: DoReadPageMail ( -- ) (* read page #mail, real and emulated *)
me @ "@/mail/un/" nextprop
begin
dup while
dup dup DoPropToMsg ourMessage !
DoShowPageMailMsg
me @ swap nextprop
repeat
pop
"Done." Tell
;
: DoSendPageMail ( -- ) (* send a page #mail emulated msg *)
DoTimeToString ourMessage !
ourPlayer @ "@/mail/fo/ Inbox/" ourMessage @ strcat "#" strcat
over over
"1" setprop
"/1" strcat ourArg3 @ setprop
ourPlayer @ "@/mail/su/" ourMessage @ strcat
ourSubject @ "E(dTMuEKTV1)" strcat setprop
ourPlayer @ "@/mail/fr/" ourMessage @ strcat me @ setprop
ourPlayer @ "@/mail/pm/" ourMessage @ strcat "1" setprop
ourPlayer @ "@/mail/un/" ourMessage @ strcat "1" setprop
ourPlayer @ " Inbox" DoFldrNotEmpty
me @ "@/mail/dl/-jmtemp-" getpropstr " " instr if
me @ "@/mail/dl/-jmtemp-"
ourPlayer @ "@/mail/mu/" ourMessage @ strcat DoCopyProp
then
ourPlayer @
"You sense that you have new mail from %p%. Use 'page #mail' to read."
me @ name "%p%" subst
notify
;
: DoAddressPageMail ( -- ) (* find players to page mail; setup *)
ourArg2 @ (* do all pmails as distlists *)
dup ":," stringpfx over ":'" stringpfx or if
1 strcut swap pop
me @ name swap strcat
else
dup ":" stringpfx if
1 strcut swap pop
me @ name " " strcat swap strcat
then
then
DoCrypt1 ourArg3 !
" " explode
begin
dup while
swap
DoGetPlayers
ourPlayer @ if
me @ "@/mail/dl/-jmtemp-" ourPlayer @ REF-add
"-jmtemp-" ourDistList !
then
1 -
repeat
pop
ourDistList @ if
ourSubject @ dup strlen 24 > if
24 strcut pop strip
dup " " rinstr strcut pop
"..." strcat
then
DoCrypt1 ourSubject !
me @ "@/mail/dl/-jmtemp-" REF-allrefs (* put dbrefs on stack *)
begin
dup while
swap ourPlayer ! (* check: can send? *)
ourPlayer @ DoCheckCanMailTo not if
1 - continue
then
DoSendPageMail (* if so, send *)
1 -
repeat
pop (* notify regarding any players we couldn't match *)
me @ "@/mail/bn" getpropstr if
me @ "@/mail/bn" getpropstr dup " " smatch not if
strip
dup " " instr if
dup dup " " rinstr strcut
strip swap strip "~~and~~" strcat swap strcat
"\" \"" " " subst
"\" and \"" "~~and~~" subst
"\"" strcat "\"" swap strcat
"I don't recognize the players " swap strcat
Tell
else
"I don't recognize the player \""
swap strcat "\"" strcat Tell
then
else
pop
then
then
"You page-mail \""
ourArg2 @ ":," stringpfx ourArg2 @ ":'" stringpfx or if
ourArg2 @ 1 strcut swap pop
me @ name swap strcat
ourArg2 !
else
ourArg2 @ ":" stringpfx if
ourArg2 @ 1 strcut swap pop
me @ name " " strcat swap strcat
ourArg2 !
then
then
ourArg2 @ strcat
"\" to " strcat
me @ "@/mail/dl/-jmtemp-" REF-list strcat "." strcat Tell
else
"page: #mail format: 'page #mail <players>=<message> Tell
then
me @ "@/mail/dl/-jmtemp-" DoRemoveProp
me @ "@/mail/bn" DoRemoveProp
;
(****************** Begin command-parsing functions *******************)
: DoParseAsk ( -- ) (* parse #ask option *)
DoMailPermCheck
DoAsk
;
: DoParseAskNo ( -- ) (* parse #!ask option *)
DoMailPermCheck
DoAskNo
;
: DoParseBlock ( -- ) (* parse #block option *)
DoMailPermCheck
ourArg1 @ not if
DoSynString " #block <player>" strcat Tell exit
then
ourArg1 @ DoGetPlayer
ourPlayer @ if
DoBlock
else
">> Player not found." Tell
then
;
: DoParseBlockNo ( -- ) (* parse #!block option *)
DoMailPermCheck
ourArg1 @ not if
DoSynString " #!block <player>" strcat Tell exit
then
ourArg1 @ DoGetPlayer
ourPlayer @ if
DoBlockNo
else
">> Player not found." Tell
then
;
: DoParseCancel ( -- ) (* parse #cancel option *)
DoMailPermCheck
ourArg1 @ not if
DoSynString " #cancel <player>" strcat Tell exit
then
ourArg1 @ DoGetPlayer
ourPlayer @ if
DoCancel
else
">> Player not found." Tell
then
;
: DoParseDelete ( -- ) (* parse #delete option *)
DoMailPermCheck
ourArg1 @ not if
DoDeleteLast exit
then
ourArg3 @ if
"#all" ourArg3 @ stringpfx if
DoDeleteAll exit
then
then
DoParseFldrMsgArgs
ourMessage @ if
DoDelete
else
ourFolder @ if
DoDeleteFldr
else
me @ "@/mail/dl/" ourArg1 @ strcat getpropstr if
ourArg1 @ DoDeleteDistList
else
me @ "W" flag? if
prog "@/mail/dl/" ourArg1 @ strcat getpropstr if
ourArg1 @ DoDeleteDistList
else
">> Message, folder, or distribution list not found." Tell
then
else
">> Message, folder, or distribution list not found." Tell
then
then
then
then
;
: DoParseDeleteNew ( -- ) (* parse #dn option *)
DoMailPermCheck
1 ourBoolean ! (* flag: we're deleting and reading *)
DoDeleteLast
DoNextNew
;
: DoParseEdit ( -- ) (* parse #edit option *)
DoMailPermCheck
ourArg1 @ not if
DoSynString " #edit [<folder>=]<message>" strcat Tell exit
then
DoParseFldrMsgArgs
ourMessage @ if
DoEditMsg
else
DoTimeToString ourMessage !
ourArg1 @ 38 strcut pop ourSubject !
" Drafts" ourFolder !
DoEditMsg
then
;
: DoParseFolders ( -- ) (* parse #folders option *)
DoMailPermCheck
ourArg1 @ not if
DoShowFldrs
else
ourArg1 @ DoFindFldrByName ourFolder @ if
DoShowFldrContents
else
ourArg1 @ DoFindFldrByNumber ourFolder @ if
DoShowFldrContents
else
ourArg1 @ DoCreateFldr
then
then
then
;
: DoParseGList ( -- ) (* parse #glist option *)
DoMailPermCheck
me @ "W" flag? if
ourArg1 @ if
ourArg2 @ if
ourArg1 @ DoCapitalize ourDistList !
ourArg2 @ DoGetPlayerRng
DoGDistLists
else
ourArg1 @ DoCapitalize ourDistList !
DoShowGDistList
then
else
DoShowGDistLists
then
else
DoShowGDistLists
then
;
: DoParseGListNo ( -- ) (* parse #!glist option *)
DoMailPermCheck
1 ourBoolean ! (* flag: we're deleting from the list *)
DoParseGList
;
: DoParseHelp ( -- ) (* parse #help option *)
ourArg1 @ if
ourArg1 @ "" "#" subst
"ask" over stringpfx if DoAskHelp else
"block" over stringpfx if DoBlockHelp else
"cancel" over stringpfx if DoCancelHelp else
"edit" over stringpfx if DoEditHelp else
"delete" over stringpfx if DoDeleteHelp else
"folders" over stringpfx if DoFolderHelp else
"glist" over stringpfx if DoListHelp else
"keep" over stringpfx if DoKeepHelp else
"lists" over stringpfx if DoListHelp else
"move" over stringpfx if DoMoveHelp else
"new" over stringpfx if DoNewHelp else
"preempt" over stringpfx if DoPreemptHelp else
"quell" over stringpfx if DoQuellHelp else
"reply" over stringpfx if DoReplyHelp else
"send" over stringpfx if DoSendHelp else
"touch" over stringpfx if DoTouchHelp else
"usage" over stringpfx if DoUsageHelp else
"view" over stringpfx if DoViewHelp else
">> Sorry, no help available for '"
swap strcat "'." strcat Tell
then then then then then then then then then
then then then then then then then then then
else
DoHelp
then
;
: DoParseKeep ( -- ) (* parse #keep option *)
DoMailPermCheck
ourArg1 @ not if
DoSynString " #keep [<folder>=]<message>" strcat Tell exit
then
DoParseFldrMsgArgs
ourMessage @ if
DoKeep
else
">> Message not found." Tell exit
then
;
: DoParseKeepNo ( -- ) (* parse #!keep option *)
DoMailPermCheck
ourArg1 @ not if
DoSynString " #!keep [<folder>=]<message>" strcat Tell exit
then
DoParseFldrMsgArgs
ourMessage @ if
DoKeepNo
else
">> Message not found." Tell
then
;
: DoParseList ( -- ) (* parse #glist option *)
DoMailPermCheck
me @ "W" flag? if
ourArg1 @ if
ourArg2 @ if
ourArg1 @ DoCapitalize ourDistList !
ourArg2 @ DoGetPlayers
DoDistLists
else
ourArg1 @ DoCapitalize ourDistList !
DoShowDistList
then
else
DoShowDistLists
then
else
ourArg1 @ if
ourArg1 @ DoCapitalize ourDistList !
ourArg2 @ DoGetPlayers
DoDistLists
else
DoShowDistLists
then
then
;
: DoParseListNo ( -- ) (* parse #!list option *)
DoMailPermCheck
1 ourBoolean ! (* flag: we're deleting from distlist *)
DoParseList
;
: DoParseSendPageMail ( -- ) (* parse a send page mail command *)
ourArg2 @ if
ourArg2 @ 38 strcut pop ourSubject !
else
"page: #mail format: 'page #mail <players>=<message>'" Tell exit
then
me @ "@/mail/po" getpropstr not if
me @ DoCheckBoxFull if
">> Your mailbox is full." Tell
">> You must delete messages before you can send or receive mail."
Tell exit
then
then
(* pretend this is cmd-page *)
ourArg1 @ DoAddressPageMail
;
: DoParsePageMail ( -- ) (* parse page mail command *)
ourArg1 @ if
DoParseSendPageMail
else
DoReadPageMail
then
;
: DoParseMailTo ( -- ) (* parse for new msg *)
trig "@/mail/1206" getpropstr if
DoParsePageMail exit
then
DoMailPermCheck
ourArg1 @ ourArg2 @ and not if
DoSynString " <player>=<subject>" strcat Tell exit
then
ourArg2 @ 38 strcut pop ourSubject !
me @ DoCheckBoxFull if
">> Your mailbox is full." Tell
">> You must delete messages before you can send or receive mail."
Tell exit
then
0 ourBoolean !
ourDistList @ if
DoMailToList exit
then
ourPlayer @ if
DoMailTo exit
else
">> Player not found." Tell
then
;
: DoParseMove ( -- ) (* parse #move option *)
DoMailPermCheck
ourArg3 @ not if
DoSynString " #move [<folder>=]<message> to