/* GNU Mailutils -- a suite of utilities for electronic mail
Copyright (C) 1999-2021 Free Software Foundation, Inc.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General
Public License along with this library. If not, see
. */
#include "mu_scm.h"
#include
static scm_t_bits mailbox_tag;
/* NOTE: Maybe will have to add some more members. That's why it is a
struct, not just a typedef mu_mailbox_t */
struct mu_mailbox
{
mu_mailbox_t mbox; /* Mailbox */
mu_iterator_t itr;
int noclose;
};
static size_t
mu_scm_mailbox_free (SCM mailbox_smob)
{
struct mu_mailbox *mum = (struct mu_mailbox *) SCM_CDR (mailbox_smob);
mu_iterator_destroy (&mum->itr);
if (!mum->noclose)
{
mu_mailbox_close (mum->mbox);
mu_mailbox_destroy (&mum->mbox);
}
return sizeof 0;
}
static int
mu_scm_mailbox_print (SCM mailbox_smob, SCM port, scm_print_state * pstate)
{
struct mu_mailbox *mum = (struct mu_mailbox *) SCM_CDR (mailbox_smob);
size_t count = 0;
mu_url_t url = NULL;
mu_mailbox_get_url (mum->mbox, &url);
scm_puts ("#mbox, &count);
scm_puts (p, port);
scm_puts (" (", port);
scm_intprint (count, 10, port);
scm_putc (')', port);
}
else
scm_puts ("uninitialized", port);
}
scm_puts (">", port);
return 1;
}
/* Internal functions */
/* There are two C interfaces for creating mailboxes in Scheme.
The first one, mu_scm_mailbox_create0, allows to set `noclose'
bit, which disables closing and releasing the underlying mu_mailbox_t
after the hosting SCM object is freed. Use this, if this mailbox
is referenced elsewhere.
Another one, mu_scm_mailbox_create, always create an object that
will cause closing the mu_mailbox_t object and releasing its memory
after the hosting SCM object is swept away by GC. This is the only
official one.
The mu_scm_mailbox_create0 function is a kludge, needed because
mu_mailbox_t objects don't have reference counters. When it is fixed in
the library, the interface will be removed. */
SCM
mu_scm_mailbox_create0 (mu_mailbox_t mbox, int noclose)
{
struct mu_mailbox *mum;
mum = scm_gc_malloc (sizeof (struct mu_mailbox), "mailbox");
mum->mbox = mbox;
mum->itr = NULL;
mum->noclose = noclose;
SCM_RETURN_NEWSMOB (mailbox_tag, mum);
}
SCM
mu_scm_mailbox_create (mu_mailbox_t mbox)
{
return mu_scm_mailbox_create0 (mbox, 0);
}
int
mu_scm_is_mailbox (SCM scm)
{
return SCM_NIMP (scm) && (long) SCM_CAR (scm) == mailbox_tag;
}
/* ************************************************************************* */
/* Guile primitives */
SCM_DEFINE_PUBLIC (scm_mu_mailbox_p, "mu-mailbox?", 1, 0, 0,
(SCM scm),
"Return @code{true} if @var{scm} is a Mailutils mailbox.\n")
#define FUNC_NAME s_scm_mu_mailbox_p
{
return scm_from_bool (mu_scm_is_mailbox (scm));
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_user_mailbox_url, "mu-user-mailbox-url", 1, 0, 0,
(SCM user),
"Return URL of the default mailbox for user @var{user}.")
#define FUNC_NAME s_scm_mu_user_mailbox_url
{
int rc;
char *p, *str;
SCM ret;
SCM_ASSERT (scm_is_string (user), user, SCM_ARG1, FUNC_NAME);
str = scm_to_locale_string (user);
rc = mu_construct_user_mailbox_url (&p, str);
free (str);
if (rc)
mu_scm_error (FUNC_NAME, rc,
"Cannot construct mailbox URL for ~A",
scm_list_1 (user));
ret = scm_from_locale_string (p);
free (p);
return ret;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_folder_directory, "mu-folder-directory", 0, 1, 0,
(SCM url),
"If @var{url} is given, sets it as a name of the user's folder directory.\n"
"Returns the current value of the folder directory.")
#define FUNC_NAME s_scm_mu_folder_directory
{
if (!SCM_UNBNDP (url))
{
char *s;
SCM_ASSERT (scm_is_string (url), url, SCM_ARG1, FUNC_NAME);
s = scm_to_locale_string (url);
mu_set_folder_directory (s);
free (s);
}
return scm_from_locale_string (mu_folder_directory ());
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_open, "mu-mailbox-open", 2, 0, 0,
(SCM url, SCM mode),
"Opens the mailbox specified by @var{url}. The @var{mode} argument defines\n"
"access mode for the mailbox. It is a string, consisting of one or more of the\n"
"following characters:\n"
"\n"
"@multitable @columnfractions 0.20 0.70\n"
"@headitem @var{mode} @tab Meaning\n"
"@item r @tab Open for reading.\n"
"@item w @tab Open for writing.\n"
"@item a @tab Open for appending to the end of the mailbox.\n"
"@item c @tab Create the mailbox if it does not exist.\n"
"@end multitable\n"
)
#define FUNC_NAME s_scm_mu_mailbox_open
{
mu_mailbox_t mbox = NULL;
char *mode_str;
int mode_bits = 0;
int status;
SCM ret;
SCM_ASSERT (scm_is_bool (url) || scm_is_string (url), url, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_string (mode), mode, SCM_ARG2, FUNC_NAME);
scm_dynwind_begin (0);
mode_str = scm_to_locale_string (mode);
scm_dynwind_free (mode_str);
for (; *mode_str; mode_str++)
switch (*mode_str)
{
case 'r':
mode_bits |= MU_STREAM_READ;
break;
case 'w':
mode_bits |= MU_STREAM_WRITE;
break;
case 'a':
mode_bits |= MU_STREAM_APPEND;
break;
case 'c':
mode_bits |= MU_STREAM_CREAT;
break;
}
if (mode_bits & MU_STREAM_READ && mode_bits & MU_STREAM_WRITE)
mode_bits = (mode_bits & ~(MU_STREAM_READ | MU_STREAM_WRITE)) | MU_STREAM_RDWR;
if (scm_is_bool (url))
{
if (url == SCM_BOOL_F)
mode_str = NULL;
else
mu_scm_error (FUNC_NAME, EINVAL,
"value #t for URL is reserved for future use",
scm_list_1 (url));
}
else
{
mode_str = scm_to_locale_string (url);
scm_dynwind_free (mode_str);
}
status = mu_mailbox_create_default (&mbox, mode_str);
if (status)
mu_scm_error (FUNC_NAME, status,
"Cannot create default mailbox ~A",
scm_list_1 (url));
status = mu_mailbox_open (mbox, mode_bits);
if (status)
{
mu_mailbox_destroy (&mbox);
mu_scm_error (FUNC_NAME, status,
"Cannot open default mailbox ~A",
scm_list_1 (url));
}
ret = mu_scm_mailbox_create (mbox);
scm_dynwind_end ();
return ret;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_close, "mu-mailbox-close", 1, 0, 0,
(SCM mbox),
"Closes mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_close
{
struct mu_mailbox *mum;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
mu_mailbox_close (mum->mbox);
mu_mailbox_destroy (&mum->mbox);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_get_url, "mu-mailbox-get-url", 1, 0, 0,
(SCM mbox),
"Returns URL of the mailbox @var{MBOX}.")
#define FUNC_NAME s_scm_mu_mailbox_get_url
{
struct mu_mailbox *mum;
mu_url_t url;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
status = mu_mailbox_get_url (mum->mbox, &url);
if (status)
mu_scm_error (FUNC_NAME, status,
"Cannot get mailbox url",
SCM_BOOL_F);
return scm_from_locale_string (mu_url_to_string (url));
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_get_message, "mu-mailbox-get-message", 2, 0, 0,
(SCM mbox, SCM msgno),
"Retrieve from message #@var{msgno} from the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_get_message
{
size_t n;
struct mu_mailbox *mum;
mu_message_t msg;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_integer (msgno), msgno, SCM_ARG2, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
n = scm_to_size_t (msgno);
status = mu_mailbox_get_message (mum->mbox, n, &msg);
if (status)
mu_scm_error (FUNC_NAME, status,
"Cannot get message ~A from mailbox ~A",
scm_list_2 (msgno, mbox));
return mu_scm_message_create (mbox, msg);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_messages_count, "mu-mailbox-messages-count", 1, 0, 0,
(SCM mbox),
"Returns number of messages in the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_messages_count
{
struct mu_mailbox *mum;
size_t nmesg;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
status = mu_mailbox_messages_count (mum->mbox, &nmesg);
if (status)
mu_scm_error (FUNC_NAME, status,
"Cannot count messages in mailbox ~A",
scm_list_1 (mbox));
return scm_from_size_t (nmesg);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_expunge, "mu-mailbox-expunge", 1, 0, 0,
(SCM mbox),
"Expunges deleted messages from the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_expunge
{
struct mu_mailbox *mum;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
status = mu_mailbox_expunge (mum->mbox);
if (status)
mu_scm_error (FUNC_NAME, status,
"Cannot expunge messages in mailbox ~A",
scm_list_1 (mbox));
return SCM_BOOL_T;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_sync, "mu-mailbox-sync", 1, 0, 0,
(SCM mbox),
"Synchronize changes to @var{mbox} with its storage.")
#define FUNC_NAME s_scm_mu_mailbox_sync
{
struct mu_mailbox *mum;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
status = mu_mailbox_sync (mum->mbox);
if (status)
mu_scm_error (FUNC_NAME, status,
"Sync failed for mailbox ~A",
scm_list_1 (mbox));
return SCM_BOOL_T;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_flush, "mu-mailbox-flush", 1, 1, 0,
(SCM mbox, SCM expunge),
"Mark all messages in @var{mbox} as seen and synchronize all changes with "
"its storage. If @var{expunge} is @samp{#t}, expunge deleted messages "
"as well.")
#define FUNC_NAME s_scm_mu_mailbox_flush
{
struct mu_mailbox *mum;
int status, do_expunge = 0;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
if (!SCM_UNBNDP (expunge))
{
SCM_ASSERT (scm_is_bool (expunge), expunge, SCM_ARG2, FUNC_NAME);
do_expunge = expunge == SCM_BOOL_T;
}
status = mu_mailbox_flush (mum->mbox, do_expunge);
if (status)
mu_scm_error (FUNC_NAME, status,
"Flush failed for mailbox ~A",
scm_list_1 (mbox));
return SCM_BOOL_T;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_append_message, "mu-mailbox-append-message", 2, 0, 0,
(SCM mbox, SCM mesg),
"Appends message @var{mesg} to the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_append_message
{
struct mu_mailbox *mum;
mu_message_t msg;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG2, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
msg = mu_scm_message_get (mesg);
status = mu_mailbox_append_message (mum->mbox, msg);
if (status)
mu_scm_error (FUNC_NAME, status,
"Cannot append message ~A to mailbox ~A",
scm_list_2 (mesg, mbox));
return SCM_BOOL_T;
}
#undef FUNC_NAME
/* Iterations */
#define ITROP(op, descr) \
do \
{ \
int status = op; \
if (status == MU_ERR_NOENT) \
return SCM_EOF_VAL; \
if (status) \
mu_scm_error (FUNC_NAME, status, \
"~A: " descr ": ~A", \
scm_list_2 (mbox, \
scm_from_locale_string (mu_strerror (status)))); \
} \
while (0)
SCM_DEFINE_PUBLIC (scm_mu_mailbox_first_message, "mu-mailbox-first-message", 1, 0, 0,
(SCM mbox),
"Returns first message from the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_first_message
{
struct mu_mailbox *mum;
int status;
mu_message_t msg;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
if (!mum->itr)
{
status = mu_mailbox_get_iterator (mum->mbox, &mum->itr);
if (status)
mu_scm_error (FUNC_NAME, status,
"~A: cannot create iterator: ~A",
scm_list_2 (mbox,
scm_from_locale_string (mu_strerror (status))));
}
ITROP (mu_iterator_first (mum->itr), "moving to the first message");
ITROP (mu_iterator_current (mum->itr, (void**)&msg),
"getting current message");
return mu_scm_message_create (mbox, msg);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_next_message, "mu-mailbox-next-message", 1, 0, 0,
(SCM mbox),
"Returns next message from the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_next_message
{
struct mu_mailbox *mum;
int status;
mu_message_t msg;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
if (!mum->itr)
{
status = mu_mailbox_get_iterator (mum->mbox, &mum->itr);
if (status)
mu_scm_error (FUNC_NAME, status,
"~A: cannot create iterator: ~A",
scm_list_2 (mbox,
scm_from_locale_string (mu_strerror (status))));
ITROP (mu_iterator_first (mum->itr), "moving to the first message");
}
else
ITROP (mu_iterator_next (mum->itr), "advancing iterator");
ITROP (mu_iterator_current (mum->itr, (void**)&msg),
"getting current message");
return mu_scm_message_create (mbox, msg);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_more_messages_p, "mu-mailbox-more-messages?", 1, 0, 0,
(SCM mbox),
"Returns @samp{#t} if there are more messages in the mailbox @var{mbox}\n"
"ahead of current iterator position. Usually this function is used after\n"
"a call to @samp{mu-mailbox-first-message} or @samp{mu-mailbox-next-message}.\n"
"If not, it initializes the iterator and points it to the first message in"
"the mailbox.")
#define FUNC_NAME s_scm_mu_mailbox_more_messages_p
{
struct mu_mailbox *mum;
int status;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
if (!mum->itr)
{
status = mu_mailbox_get_iterator (mum->mbox, &mum->itr);
if (status)
mu_scm_error (FUNC_NAME, status,
"~A: cannot create iterator: ~A",
scm_list_2 (mbox,
scm_from_locale_string (mu_strerror (status))));
status = mu_iterator_first (mum->itr);
if (status == MU_ERR_NOENT)
return SCM_BOOL_F;
if (status)
mu_scm_error (FUNC_NAME, status,
"~A: cannot set iterator to the first message: ~A",
scm_list_2 (mbox,
scm_from_locale_string (mu_strerror (status))));
}
return scm_from_bool (!mu_iterator_is_done (mum->itr));
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (scm_mu_mailbox_get_size, "mu-mailbox-get-size", 1, 0, 0,
(SCM mbox),
"Return size of the mailbox @var{mbox}.")
#define FUNC_NAME s_scm_mu_mailbox_get_size
{
struct mu_mailbox *mum;
int status;
mu_off_t size;
SCM_ASSERT (mu_scm_is_mailbox (mbox), mbox, SCM_ARG1, FUNC_NAME);
mum = (struct mu_mailbox *) SCM_CDR (mbox);
status = mu_mailbox_get_size (mum->mbox, &size);
if (status)
mu_scm_error (FUNC_NAME, status,
"~A: cannot determine mailbox size: ~A",
scm_list_2 (mbox,
scm_from_locale_string (mu_strerror (status))));
return scm_from_uintmax (size);
}
/* Initialize the module */
void
mu_scm_mailbox_init ()
{
mailbox_tag = scm_make_smob_type ("mailbox", sizeof (struct mu_mailbox));
scm_set_smob_free (mailbox_tag, mu_scm_mailbox_free);
scm_set_smob_print (mailbox_tag, mu_scm_mailbox_print);
#include "mu_mailbox.x"
}