Blame view

libmu_scm/mu_message.c 31.6 KB
1
/* GNU Mailutils -- a suite of utilities for electronic mail
2 3
   Copyright (C) 1999, 2000, 2001, 2006, 2007, 2009, 2010 Free Software
   Foundation, Inc.
4

5 6 7
   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
8
   version 3 of the License, or (at your option) any later version.
9

10
   This library is distributed in the hope that it will be useful,
11
   but WITHOUT ANY WARRANTY; without even the implied warranty of
12 13
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.
14

15
   You should have received a copy of the GNU Lesser General
16 17
   Public License along with this library.  If not, see
   <http://www.gnu.org/licenses/>. */
18 19 20

#include "mu_scm.h"

21
static scm_t_bits message_tag;
22 23 24

struct mu_message
{
25
  mu_message_t msg;       /* Message itself */
26 27 28
  SCM mbox;               /* Mailbox it belongs to */
  int needs_destroy;      /* Set during mark phase if the message needs
			     explicit destroying */
29 30 31 32 33 34 35 36
};

/* SMOB functions: */

static SCM
mu_scm_message_mark (SCM message_smob)
{
  struct mu_message *mum = (struct mu_message *) SCM_CDR (message_smob);
37 38
  if (mu_message_get_owner (mum->msg) == NULL)
    mum->needs_destroy = 1;
39 40 41 42 43 44 45
  return mum->mbox;
}

static scm_sizet
mu_scm_message_free (SCM message_smob)
{
  struct mu_message *mum = (struct mu_message *) SCM_CDR (message_smob);
46
  if (mum->needs_destroy)
47
    mu_message_destroy (&mum->msg, NULL);
48
  free (mum);
49
  return 0;
50 51 52
}

static char *
53
_get_envelope_sender (mu_envelope_t env)
54
{
55
  mu_address_t addr;
56
  const char *buffer;
57 58
  char *ptr;
  
59
  if (mu_envelope_sget_sender (env, &buffer)
60
      || mu_address_create (&addr, buffer))
61 62
    return NULL;

63
  if (mu_address_aget_email (addr, 1, &ptr))
64
    {
65
      mu_address_destroy (&addr);
66 67 68
      return NULL;
    }

69
  mu_address_destroy (&addr);
70
  return ptr;
71 72 73 74 75 76
}

static int
mu_scm_message_print (SCM message_smob, SCM port, scm_print_state * pstate)
{
  struct mu_message *mum = (struct mu_message *) SCM_CDR (message_smob);
77
  mu_envelope_t env = NULL;
78
  const char *buffer;
79 80 81 82
  const char *p;
  size_t m_size = 0, m_lines = 0;
  struct tm tm;
  mu_timezone tz;
83
  char datebuf[sizeof ("Mon Jan 01 00:00")]; /* Warning: length must be > 9 */
84

85
  mu_message_get_envelope (mum->msg, &env);
86 87 88

  scm_puts ("#<message ", port);

89
  if (message_smob == SCM_BOOL_F)
90
    {
91 92
      /* several mu_message.* functions may return #f */
      scm_puts ("#f", port);
93 94
    }
  else
95 96 97 98 99 100 101 102 103 104 105
    {
      p = _get_envelope_sender (env);
      scm_puts ("\"", port);
      if (p)
	{
	  scm_puts (p, port);
	  free ((void *) p);
	}
      else
	scm_puts ("UNKNOWN", port);
      
106
      if (mu_envelope_sget_date (env, &p) == 0
107 108 109 110 111
          && mu_parse_ctime_date_time (&p, &tm, &tz) == 0)
	{
	  strftime (datebuf, sizeof (datebuf), "%a %b %e %H:%M", &tm);
	  buffer = datebuf;
	}
112
      else
113
	buffer = "UNKNOWN";
114 115 116 117
      scm_puts ("\" \"", port);
      scm_puts (buffer, port);
      scm_puts ("\" ", port);
      
118 119
      mu_message_size (mum->msg, &m_size);
      mu_message_lines (mum->msg, &m_lines);
120
      
121
      snprintf (datebuf, sizeof (datebuf), "%3lu %-5lu",
122
		(unsigned long) m_lines, (unsigned long) m_size);
123
      scm_puts (datebuf, port);
124
    }
125 126 127 128 129 130 131
  scm_puts (">", port);
  return 1;
}

/* Internal calls: */

SCM
132
mu_scm_message_create (SCM owner, mu_message_t msg)
133 134 135
{
  struct mu_message *mum;

136
  mum = scm_gc_malloc (sizeof (struct mu_message), "message");
137 138
  mum->msg = msg;
  mum->mbox = owner;
139
  mum->needs_destroy = 0;
140 141 142
  SCM_RETURN_NEWSMOB (message_tag, mum);
}

143 144 145 146 147 148
void
mu_scm_message_add_owner (SCM MESG, SCM owner)
{
  struct mu_message *mum = (struct mu_message *) SCM_CDR (MESG);
  SCM cell;

149
  if (scm_is_bool (mum->mbox))
150 151 152 153 154
    {
      mum->mbox = owner;
      return;
    }
  
155
  if (scm_is_pair (mum->mbox))
156
    cell = scm_cons (owner, mum->mbox);
157
  else
158
    cell = scm_cons (owner, scm_cons (mum->mbox, SCM_EOL));
159 160 161
  mum->mbox = cell;
}

162
mu_message_t
163 164 165 166 167 168 169 170 171
mu_scm_message_get (SCM MESG)
{
  struct mu_message *mum = (struct mu_message *) SCM_CDR (MESG);
  return mum->msg;
}

int
mu_scm_is_message (SCM scm)
{
172
  return SCM_NIMP (scm) && (long) SCM_CAR (scm) == message_tag;
173 174 175 176 177
}

/* ************************************************************************* */
/* Guile primitives */

178
SCM_DEFINE_PUBLIC (scm_mu_message_create, "mu-message-create", 0, 0, 0,
179 180
		   (),
		   "Creates an empty message.\n")
181
#define FUNC_NAME s_scm_mu_message_create
182
{
183 184
  mu_message_t msg;
  mu_message_create (&msg, NULL);
185 186 187 188
  return mu_scm_message_create (SCM_BOOL_F, msg);
}
#undef FUNC_NAME

189
/* FIXME: This changes envelope date */
190
SCM_DEFINE_PUBLIC (scm_mu_message_copy, "mu-message-copy", 1, 0, 0,
191 192
		   (SCM mesg),
		   "Creates a copy of the message @var{mesg}.\n")
193
#define FUNC_NAME s_scm_mu_message_copy
194
{
195 196
  mu_message_t msg, newmsg;
  mu_stream_t in = NULL, out = NULL;
197
  int status;
198
  
199 200
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
201

202
  status = mu_message_get_streamref (msg, &in);
203 204 205
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get input stream from message ~A",
206
		  scm_list_1 (mesg));
207
  
208 209 210 211
  status = mu_message_create (&newmsg, NULL);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot create message", SCM_BOOL_F);
212
  
213
  status = mu_message_get_streamref (newmsg, &out);
214
  if (status)
215
    {
216
      mu_message_destroy (&newmsg, NULL);
217 218
      mu_scm_error (FUNC_NAME, status,
		    "Cannot get output stream", SCM_BOOL_F);
219 220
    }

221
  status = mu_stream_copy (out, in, 0, NULL);
222 223 224
  mu_stream_destroy (&in);
  mu_stream_destroy (&out);
  if (status)
225
    {
226 227 228
      mu_message_destroy (&newmsg, NULL);
      mu_scm_error (FUNC_NAME, status,
		    "Error writing to stream", SCM_BOOL_F);
229 230 231 232 233 234
    }
  
  return mu_scm_message_create (SCM_BOOL_F, newmsg);
}
#undef FUNC_NAME

235
SCM_DEFINE_PUBLIC (scm_mu_message_destroy, "mu-message-destroy", 1, 0, 0,
236 237
		   (SCM mesg),
		   "Destroys the message @var{mesg}.")
238
#define FUNC_NAME s_scm_mu_message_destroy
239 240 241
{
  struct mu_message *mum;
  
242 243
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  mum = (struct mu_message *) SCM_CDR (mesg);
244
  mu_message_destroy (&mum->msg, mu_message_get_owner (mum->msg));
245 246 247
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
248

249
SCM_DEFINE_PUBLIC (scm_mu_message_set_header, "mu-message-set-header", 3, 1, 0,
250 251 252 253 254
		   (SCM mesg, SCM header, SCM value, SCM replace),
"Sets header @var{header} of the message @var{mesg} to new @var{value}.\n"
"If @var{header} is already present in the message, its value\n"
"is replaced with the suplied one iff the optional @var{replace} is\n"
"@code{#t}. Otherwise, a new header is created and appended.")
255
#define FUNC_NAME s_scm_mu_message_set_header
256
{
257 258
  mu_message_t msg;
  mu_header_t hdr;
259
  int repl = 0;
260
  int status;
261
  char *hdr_c, *val_c;
262
  
263 264 265
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_string (header), header, SCM_ARG2, FUNC_NAME);
266

267 268
  if (scm_is_bool (value))
    return SCM_UNSPECIFIED;/*FIXME: Exception*/
269
  
270 271
  SCM_ASSERT (scm_is_string (value), value, SCM_ARG3, FUNC_NAME);
  if (!SCM_UNBNDP (replace))
272
    {
273
      repl = replace == SCM_BOOL_T;
274 275
    }
  
276 277 278 279 280
  status = mu_message_get_header (msg, &hdr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message headers", SCM_BOOL_F);

281 282 283
  hdr_c = scm_to_locale_string (header);
  val_c = scm_to_locale_string (value);
  status = mu_header_set_value (hdr, hdr_c, val_c, repl);
284 285 286
  free (hdr_c);
  free (val_c);
  
287 288 289
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot set header \"~A: ~A\" in message ~A",
290
		  scm_list_3 (header, value, mesg));
291
  
292 293 294 295
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

296
SCM_DEFINE_PUBLIC (scm_mu_message_get_size, "mu-message-get-size", 1, 0, 0,
297 298
		   (SCM mesg),
		   "Returns size of the message @var{mesg}\n.")
299
#define FUNC_NAME s_scm_mu_message_get_size
300
{
301
  mu_message_t msg;
302
  size_t size;
303
  
304 305
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
306
  mu_message_size (msg, &size);
307
  return scm_from_size_t (size);
308 309 310
}
#undef FUNC_NAME

311
SCM_DEFINE_PUBLIC (scm_mu_message_get_lines, "mu-message-get-lines", 1, 0, 0,
312 313
		   (SCM mesg),
		   "Returns number of lines in the message @var{msg}.\n")
314
#define FUNC_NAME s_scm_mu_message_get_lines
315
{
316
  mu_message_t msg;
317
  size_t lines;
318 319
  int status;
  
320 321
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
322 323 324 325
  status = mu_message_lines (msg, &lines);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get number of lines in message ~A",
326
		  scm_list_1 (mesg));
327

328
  return scm_from_size_t (lines);
329 330
}
#undef FUNC_NAME
331

332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352
static SCM
filltime (struct tm *bd_time, int zoff, const char *zname)
{
  SCM result = scm_c_make_vector (11, SCM_UNDEFINED);

  SCM_SIMPLE_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec));
  SCM_SIMPLE_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min));
  SCM_SIMPLE_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour));
  SCM_SIMPLE_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday));
  SCM_SIMPLE_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon));
  SCM_SIMPLE_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year));
  SCM_SIMPLE_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday));
  SCM_SIMPLE_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
  SCM_SIMPLE_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
  SCM_SIMPLE_VECTOR_SET (result,9, scm_from_int (zoff));
  SCM_SIMPLE_VECTOR_SET (result,10, (zname
				     ? scm_from_locale_string (zname)
				     : SCM_BOOL_F));
  return result;
}

353
SCM_DEFINE_PUBLIC (scm_mu_message_get_envelope, "mu-message-get-envelope", 1, 0, 0,
354 355
		   (SCM mesg),
		   "Returns envelope date of the message @var{mesg}.\n")
356 357 358 359 360 361 362 363 364
#define FUNC_NAME s_scm_mu_message_get_envelope
{
  mu_message_t msg;
  mu_envelope_t env = NULL;
  int status;
  const char *sender;
  const char *date;
  size_t dlen;
  
365 366
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
367 368 369
  status = mu_message_get_envelope (msg, &env);
  if (status)
    mu_scm_error (FUNC_NAME, status, "cannot get envelope",
370
		  scm_list_1 (mesg));
371 372 373
  status = mu_envelope_sget_sender (env, &sender);
  if (status)
    mu_scm_error (FUNC_NAME, status, "cannot get envelope sender",
374
		  scm_list_1 (mesg));
375 376 377
  status = mu_envelope_sget_date (env, &date);
  if (status)
    mu_scm_error (FUNC_NAME, status, "cannot get envelope date",
378
		  scm_list_1 (mesg));
379 380 381 382 383 384 385 386 387
  dlen = strlen (date);
  if (date[dlen-1] == '\n')
    dlen--;
  return scm_string_append (scm_list_3 (scm_from_locale_string (sender),
					scm_from_locale_string (" "),
					scm_from_locale_stringn (date, dlen)));
}
#undef FUNC_NAME

388
SCM_DEFINE_PUBLIC (scm_mu_message_get_envelope_date, "mu-message-get-envelope-date", 1, 0, 0,
389 390
		   (SCM mesg),
		   "Returns envelope date of the message @var{mesg}.\n")
391 392 393 394 395 396 397 398 399
#define FUNC_NAME s_scm_mu_message_get_envelope_date
{
  mu_message_t msg;
  mu_envelope_t env = NULL;
  int status;
  const char *sdate;
  struct tm tm;
  mu_timezone tz;
  
400 401
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
402 403 404
  status = mu_message_get_envelope (msg, &env);
  if (status)
    mu_scm_error (FUNC_NAME, status, "cannot get envelope",
405
		  scm_list_1 (mesg));
406 407 408
  status = mu_envelope_sget_date (env, &sdate);
  if (status)
    mu_scm_error (FUNC_NAME, status, "cannot get envelope date",
409
		  scm_list_1 (mesg));
410 411 412
  status = mu_parse_ctime_date_time (&sdate, &tm, &tz);
  if (status)
    mu_scm_error (FUNC_NAME, status, "invalid envelope date",
413
		  scm_list_1 (scm_from_locale_string (sdate)));
414 415 416 417
  return filltime (&tm, tz.utc_offset, tz.tz_name);  
}
#undef FUNC_NAME

418
SCM_DEFINE_PUBLIC (scm_mu_message_get_sender, "mu-message-get-sender", 1, 0, 0,
419 420
		   (SCM mesg),
	   "Returns email address of the sender of the message @var{mesg}.\n")
421
#define FUNC_NAME s_scm_mu_message_get_sender
422
{
423 424
  mu_message_t msg;
  mu_envelope_t env = NULL;
425 426 427
  int status;
  SCM ret;
  
428 429
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
430 431
  status = mu_message_get_envelope (msg, &env);
  if (status == 0)
432 433
    {
      char *p = _get_envelope_sender (env);
434
      ret = scm_from_locale_string (p);
435 436
      free (p);
    }
437 438 439
  else
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get envelope of message ~A",
440
		  scm_list_1 (mesg));
441 442 443 444
  return ret;
}
#undef FUNC_NAME

445
SCM_DEFINE_PUBLIC (scm_mu_message_get_header, "mu-message-get-header", 2, 0, 0,
446 447
		   (SCM mesg, SCM header),
"Returns value of the header @var{header} from the message @var{mesg}.\n")
448
#define FUNC_NAME s_scm_mu_message_get_header
449
{
450 451
  mu_message_t msg;
  mu_header_t hdr;
452
  char *value = NULL;
453
  char *header_string;
454 455 456
  SCM ret;
  int status;
  
457 458 459
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_string (header), header, SCM_ARG2, FUNC_NAME);
460 461 462 463 464
  status = mu_message_get_header (msg, &hdr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message headers", SCM_BOOL_F);

465
  header_string = scm_to_locale_string (header);
466
  status = mu_header_aget_value (hdr, header_string, &value);
467
  free (header_string);
468
  switch (status)
469
    {
470
    case 0:
471
      ret = scm_from_locale_string (value);
472
      free (value);
473 474 475 476 477 478 479 480 481
      break;
      
    case MU_ERR_NOENT:
      ret = SCM_BOOL_F;
      break;

    default:
      mu_scm_error (FUNC_NAME, status,
		    "Cannot get header ~A from message ~A",
482
		    scm_list_2 (header, mesg));
483
    }
484

485 486 487 488
  return ret;
}
#undef FUNC_NAME

489 490 491 492 493 494
static int
string_sloppy_member (SCM lst, char *name)
{
  for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
    {
      SCM car = SCM_CAR (lst);
495
      if (scm_is_string (car)
496 497
	  && mu_c_strncasecmp (scm_i_string_chars (car), name,
			       scm_i_string_length (car)) == 0)
498 499 500 501 502
	return 1;
    }
  return 0;
}

503
SCM_DEFINE_PUBLIC (scm_mu_message_get_header_fields, "mu-message-get-header-fields", 1, 1, 0,
504 505 506
		   (SCM mesg, SCM headers),
"Returns list of headers in the message @var{mesg}. optional argument\n" 
"@var{headers} gives a list of header names to restrict return value to.\n")
507
#define FUNC_NAME s_scm_mu_message_get_header_fields
508 509
{
  size_t i, nfields = 0;
510 511
  mu_message_t msg;
  mu_header_t hdr = NULL;
512
  SCM scm_first = SCM_EOL, scm_last = SCM_EOL;
513 514
  int status;
  
515 516 517 518 519 520
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  if (SCM_UNBNDP (headers))
    headers = SCM_EOL;
  else
    SCM_ASSERT (scm_is_pair (headers), headers, SCM_ARG2, FUNC_NAME);
521

522 523 524 525 526 527 528 529 530
  status = mu_message_get_header (msg, &hdr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message headers", SCM_BOOL_F);
  status = mu_header_get_field_count (hdr, &nfields);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get header field count", SCM_BOOL_F);
  
531 532
  for (i = 1; i <= nfields; i++)
    {
533
      SCM scm_name, scm_value, scm_new;
534 535
      char *name, *value;
      
536 537 538 539
      status = mu_header_aget_field_name (hdr, i, &name);
      if (status)
	mu_scm_error (FUNC_NAME, status,
		      "Cannot get header field ~A, message ~A",
540
		      scm_list_2 (scm_from_size_t (i), mesg));
541
      
542
      if (!scm_is_null (headers) && string_sloppy_member (headers, name) == 0)
543
	continue;
544 545 546 547
      status = mu_header_aget_field_value (hdr, i, &value);
      if (status)
	mu_scm_error (FUNC_NAME, status,
		      "Cannot get header value ~A, message ~A",
548
		      scm_list_2 (scm_from_size_t (i), mesg));
549

550 551
      scm_name = scm_from_locale_string (name);
      scm_value = scm_from_locale_string (value);
552

553
      scm_new = scm_cons (scm_cons (scm_name, scm_value), SCM_EOL);
554
      
555
      if (scm_is_null (scm_first))
556
	scm_first = scm_last = scm_new;
557 558
      else
	{
559 560
	  SCM_SETCDR (scm_last, scm_new);
	  scm_last = scm_new;
561 562 563 564 565 566
	}
    }
  return scm_first;
}
#undef FUNC_NAME
  
567
SCM_DEFINE_PUBLIC (scm_mu_message_set_header_fields, "mu-message-set-header-fields", 2, 1, 0,
568 569 570 571
		   (SCM mesg, SCM list, SCM replace),
"Set headers in the message @var{mesg} to those listed in @var{list},\n"
"which is a list of conses @code{(cons @var{header} @var{value})}.\n\n"
"Optional parameter @var{replace} specifies whether new header\n"
Sergey Poznyakoff authored
572 573
"values should replace the headers already present in the\n"
"message.")
574
#define FUNC_NAME s_scm_mu_message_set_header_fields
575
{
576 577
  mu_message_t msg;
  mu_header_t hdr;
578
  int repl = 0;
579
  int status;
580
  
581 582 583 584 585
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_null (list) || scm_is_pair (list),
	      list, SCM_ARG2, FUNC_NAME);
  if (!SCM_UNBNDP (replace))
586
    {
587 588
      SCM_ASSERT (scm_is_bool (replace), replace, SCM_ARG3, FUNC_NAME);
      repl = replace == SCM_BOOL_T;
589 590
    }

591 592 593 594 595
  status = mu_message_get_header (msg, &hdr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message headers", SCM_BOOL_F);

596
  for (; !scm_is_null (list); list = SCM_CDR (list))
597 598 599
    {
      SCM cell = SCM_CAR (list);
      SCM car, cdr;
600
      char *hdr_c, *val_c;
601
      
602
      SCM_ASSERT (scm_is_pair (cell), cell, SCM_ARGn, FUNC_NAME);
603 604
      car = SCM_CAR (cell);
      cdr = SCM_CDR (cell);
605 606
      SCM_ASSERT (scm_is_string (car), car, SCM_ARGn, FUNC_NAME);
      SCM_ASSERT (scm_is_string (cdr), cdr, SCM_ARGn, FUNC_NAME);
607 608
      hdr_c = scm_to_locale_string (car);
      val_c = scm_to_locale_string (cdr);
609
      status = mu_header_set_value (hdr, hdr_c, val_c, repl);
610 611
      free (hdr_c);
      free (val_c);
612 613 614
      if (status)
	mu_scm_error (FUNC_NAME, status,
		      "Cannot set header value: message ~A, header ~A, value ~A",
615
		      scm_list_3 (mesg, car, cdr));
616

617
    }
618
  return SCM_UNSPECIFIED;
619 620 621
}
#undef FUNC_NAME

622
SCM_DEFINE_PUBLIC (scm_mu_message_delete, "mu-message-delete", 1, 1, 0,
623 624 625 626
		   (SCM mesg, SCM flag),
"Mark message @var{mesg} as deleted. Optional argument @var{flag} allows to\n"
"toggle the deletion mark. The message is deleted if it is @code{#t} and\n"
"undeleted if it is @code{#f}.")
627
#define FUNC_NAME s_scm_mu_message_delete
628
{
629 630
  mu_message_t msg;
  mu_attribute_t attr;
631
  int delete = 1;
632
  int status;
633
  
634 635 636
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  if (!SCM_UNBNDP (flag))
637
    {
638 639
      SCM_ASSERT (scm_is_bool (flag), flag, SCM_ARG2, FUNC_NAME);
      delete = flag == SCM_BOOL_T;
640
    }
641 642 643 644 645
  status = mu_message_get_attribute (msg, &attr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message attribute", SCM_BOOL_F);

646
  if (delete)
647
    status = mu_attribute_set_deleted (attr);
648
  else
649 650 651 652 653 654
    status = mu_attribute_unset_deleted (attr);
  
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Error setting message attribute", SCM_BOOL_F);

655
  return SCM_UNSPECIFIED;
656 657 658
}
#undef FUNC_NAME

659
SCM_DEFINE_PUBLIC (scm_mu_message_get_flag, "mu-message-get-flag", 2, 0, 0,
660 661
		   (SCM mesg, SCM flag),
"Return the value of the attribute @var{flag} of the message @var{mesg}.")
662
#define FUNC_NAME s_scm_mu_message_get_flag
663
{
664 665
  mu_message_t msg;
  mu_attribute_t attr;
666
  int ret = 0;
667 668
  int status;
    
669 670 671
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_integer (flag), flag, SCM_ARG2, FUNC_NAME);
672

673 674 675 676 677
  status = mu_message_get_attribute (msg, &attr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message attribute", SCM_BOOL_F);
  
678
  switch (scm_to_int (flag))
679 680
    {
    case MU_ATTRIBUTE_ANSWERED:
681
      ret = mu_attribute_is_answered (attr);
682
      break;
683
      
684
    case MU_ATTRIBUTE_FLAGGED:
685
      ret = mu_attribute_is_flagged (attr);
686
      break;
687
      
688
    case MU_ATTRIBUTE_DELETED:
689
      ret = mu_attribute_is_deleted (attr);
690
      break;
691
      
692
    case MU_ATTRIBUTE_DRAFT:
693
      ret = mu_attribute_is_draft (attr);
694
      break;
695
      
696
    case MU_ATTRIBUTE_SEEN:
697
      ret = mu_attribute_is_seen (attr);
698
      break;
699
      
700
    case MU_ATTRIBUTE_READ:
701
      ret = mu_attribute_is_read (attr);
702
      break;
703
      
704
    case MU_ATTRIBUTE_MODIFIED:
705
      ret = mu_attribute_is_modified (attr);
706
      break;
707
      
708
    case MU_ATTRIBUTE_RECENT:
709
      ret = mu_attribute_is_recent (attr);
710
      break;
711
      
712
    default:
713
      mu_attribute_get_flags (attr, &ret);
714
      ret &= scm_to_int (flag);
715 716 717 718 719
    }
  return ret ? SCM_BOOL_T : SCM_BOOL_F;
}
#undef FUNC_NAME

720
SCM_DEFINE_PUBLIC (scm_mu_message_set_flag, "mu-message-set-flag", 2, 1, 0,
721 722 723
		   (SCM mesg, SCM flag, SCM value),
"Set the attribute @var{flag} in message @var{mesg}. If optional @var{value}\n"
"is @samp{#f}, the attribute is unset.\n")
724
#define FUNC_NAME s_scm_mu_message_set_flag
725
{
726 727
  mu_message_t msg;
  mu_attribute_t attr;
728
  int val = 1;
729 730
  int status;
  
731 732 733
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_integer (flag), flag, SCM_ARG2, FUNC_NAME);
734

735
  if (!SCM_UNBNDP (value))
736
    {
737 738
      SCM_ASSERT (scm_is_bool (value), value, SCM_ARG3, FUNC_NAME);
      val = value == SCM_BOOL_T;
739 740
    }
  
741 742 743 744 745 746
  status = mu_message_get_attribute (msg, &attr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message attribute", SCM_BOOL_F);

  status = 0;
747
  switch (scm_to_int (flag))
748 749
    {
    case MU_ATTRIBUTE_ANSWERED:
750
      if (val)
751
	status = mu_attribute_set_answered (attr);
752
      else
753
	status = mu_attribute_unset_answered (attr);
754
      break;
755
      
756
    case MU_ATTRIBUTE_FLAGGED:
757
      if (val)
758
	status = mu_attribute_set_flagged (attr);
759
      else
760
	status = mu_attribute_unset_flagged (attr);
761
      break;
762
      
763
    case MU_ATTRIBUTE_DELETED:
764
      if (val)
765
	status = mu_attribute_set_deleted (attr);
766
      else
767
	status = mu_attribute_unset_deleted (attr);
768
      break;
769
      
770
    case MU_ATTRIBUTE_DRAFT:
771
      if (val)
772
	status = mu_attribute_set_draft (attr);
773
      else
774
	status = mu_attribute_unset_draft (attr);
775
      break;
776
      
777
    case MU_ATTRIBUTE_SEEN:
778
      if (val)
779
	status = mu_attribute_set_seen (attr);
780
      else
781
	status = mu_attribute_unset_seen (attr);
782
      break;
783
      
784
    case MU_ATTRIBUTE_READ:
785
      if (val)
786
	status = mu_attribute_set_read (attr);
787
      else
788
	status = mu_attribute_unset_read (attr);
789
      break;
790
      
791
    case MU_ATTRIBUTE_MODIFIED:
792
      if (val)
793
	status = mu_attribute_set_modified (attr);
794
      else
795
	status = mu_attribute_clear_modified (attr);
796
      break;
797
      
798
    case MU_ATTRIBUTE_RECENT:
799
      if (val)
800
	status = mu_attribute_set_recent (attr);
801
      else
802
	status = mu_attribute_unset_recent (attr);
803
      break;
804
      
805
    default:
806 807
      if (val)
	status = mu_attribute_set_flags (attr, scm_to_int (flag));
808
    }
809 810 811 812 813
  
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Error setting message attribute", SCM_BOOL_F);
  
814
  return SCM_UNSPECIFIED;
815 816 817
}
#undef FUNC_NAME

818
SCM_DEFINE_PUBLIC (scm_mu_message_get_user_flag, "mu-message-get-user-flag", 2, 0, 0,
819 820
		   (SCM mesg, SCM flag),
"Return value of the user-defined attribute @var{flag} from the message @var{mesg}.")
821
#define FUNC_NAME s_scm_mu_message_get_user_flag
822
{
823 824
  mu_message_t msg;
  mu_attribute_t attr;
825 826
  int status;
  
827 828 829
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_integer (flag), flag, SCM_ARG2, FUNC_NAME);
830 831 832 833
  status = mu_message_get_attribute (msg, &attr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message attribute", SCM_BOOL_F);
834 835
  return mu_attribute_is_userflag (attr, scm_to_int (flag)) ?
                                   SCM_BOOL_T : SCM_BOOL_F;
836 837 838 839
}
#undef FUNC_NAME
  

840
SCM_DEFINE_PUBLIC (scm_mu_message_set_user_flag, "mu-message-set-user-flag", 2, 1, 0,
841 842 843
		   (SCM mesg, SCM flag, SCM value),
"Set user-defined attribute @var{flag} in the message @var{mesg}.\n"
"If optional argumen @var{value} is @samp{#f}, the attribute is unset.")
844
#define FUNC_NAME s_scm_mu_message_set_user_flag
845
{
846 847
  mu_message_t msg;
  mu_attribute_t attr;
848
  int set = 1;
849 850
  int status;
  
851 852 853
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
  SCM_ASSERT (scm_is_integer (flag), flag, SCM_ARG2, FUNC_NAME);
854

855
  if (!SCM_UNBNDP (value))
856
    {
857 858
      SCM_ASSERT (scm_is_bool (value), value, SCM_ARG3, FUNC_NAME);
      set = value == SCM_BOOL_T;
859 860
    }
  
861 862 863 864 865
  status = mu_message_get_attribute (msg, &attr);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get message attribute", SCM_BOOL_F);
  
866
  if (set)
867
    mu_attribute_set_userflag (attr, scm_to_int (flag));
868
  else
869
    mu_attribute_unset_userflag (attr, scm_to_int (flag));
870
  return SCM_UNSPECIFIED;
871 872 873
}
#undef FUNC_NAME

874
SCM_DEFINE_PUBLIC (scm_mu_message_get_port, "mu-message-get-port", 2, 1, 0,
875 876 877
		   (SCM mesg, SCM mode, SCM full),
"Returns a port associated with the message @var{mesg}. The @var{mode} is a\n"
"string defining operation mode of the stream. It may contain any of the\n"
Sergey Poznyakoff authored
878
"two characters: @samp{r} for reading, @samp{w} for writing.\n"
879
"If optional argument @var{full} is specified, it should be a boolean value.\n"
Sergey Poznyakoff authored
880 881 882
"If it is @samp{#t} then the returned port will allow access to any\n"
"part of the message (including headers). If it is @code{#f} then the port\n"
"accesses only the message body (the default).\n")
883
#define FUNC_NAME s_scm_mu_message_get_port
884
{
885 886
  mu_message_t msg;
  mu_stream_t stream = NULL;
887
  int status;
888 889 890
  char *str;
  SCM ret;
  
891 892
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  SCM_ASSERT (scm_is_string (mode), mode, SCM_ARG2, FUNC_NAME);
893

894
  msg = mu_scm_message_get (mesg);
895

896
  if (!SCM_UNBNDP (full))
897
    {
898 899
      SCM_ASSERT (scm_is_bool (full), full, SCM_ARG3, FUNC_NAME);
      if (full == SCM_BOOL_T)
900
	{
901
	  status = mu_message_get_streamref (msg, &stream);
902 903 904 905
	  if (status)
	    mu_scm_error (FUNC_NAME, status, "Cannot get message stream",
			  SCM_BOOL_F);
	}
906 907 908 909
    }

  if (!stream)
    {
910
      mu_body_t body = NULL;
911

912 913 914 915
      status = mu_message_get_body (msg, &body);
      if (status)
	mu_scm_error (FUNC_NAME, status, "Cannot get message body",
		      SCM_BOOL_F);
916
      status = mu_body_get_streamref (body, &stream);
917 918 919
      if (status)
	mu_scm_error (FUNC_NAME, status, "Cannot get message body stream",
		      SCM_BOOL_F);
920
    }
921

922 923
  str = scm_to_locale_string (mode);
  ret = mu_port_make_from_stream (mesg, stream, scm_mode_bits (str));
924 925
  free (str);
  return ret;
926 927
}
#undef FUNC_NAME
928 929
  

930
SCM_DEFINE_PUBLIC (scm_mu_message_get_body, "mu-message-get-body", 1, 0, 0,
931 932
		   (SCM mesg),
		   "Returns message body for the message @var{mesg}.")
933
#define FUNC_NAME s_scm_mu_message_get_body
934
{
935 936
  mu_message_t msg;
  mu_body_t body = NULL;
937 938
  int status;
  
939 940
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
941 942 943
  status = mu_message_get_body (msg, &body);
  if (status)
    mu_scm_error (FUNC_NAME, status, "Cannot get message body", SCM_BOOL_F);
944
  return mu_scm_body_create (mesg, body);
945 946 947
}
#undef FUNC_NAME

948
SCM_DEFINE_PUBLIC (scm_mu_message_multipart_p, "mu-message-multipart?", 1, 0, 0,
949 950
		   (SCM mesg),
"Returns @code{#t} if @var{mesg} is a multipart @acronym{MIME} message.")
951
#define FUNC_NAME s_scm_mu_message_multipart_p
952
{
953
  mu_message_t msg;
954 955
  int ismime = 0;
  
956 957
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
958
  mu_message_is_multipart (msg, &ismime);
959 960 961 962
  return ismime ? SCM_BOOL_T : SCM_BOOL_F;
}
#undef FUNC_NAME

963
SCM_DEFINE_PUBLIC (scm_mu_message_get_num_parts, "mu-message-get-num-parts", 1, 0, 0,
964 965 966
		   (SCM mesg),
"Returns number of parts in a multipart @acronym{MIME} message @var{mesg}.\n"
"Returns @code{#f} if the argument is not a multipart message.")
967
#define FUNC_NAME s_scm_mu_message_get_num_parts
968
{
969
  mu_message_t msg;
970 971
  int ismime = 0;
  size_t nparts = 0;
972
  int status;
973
  
974 975
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
976
  mu_message_is_multipart (msg, &ismime);
977 978 979
  if (!ismime)
    return SCM_BOOL_F;

980 981 982 983
  status = mu_message_get_num_parts (msg, &nparts);
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get number of parts in the message ~A",
984
		  scm_list_1 (mesg));
985
  return scm_from_size_t (nparts);
986 987 988
}
#undef FUNC_NAME

989
SCM_DEFINE_PUBLIC (scm_mu_message_get_part, "mu-message-get-part", 2, 0, 0,
990 991
		   (SCM mesg, SCM part),
"Returns part #@var{part} of a multipart @acronym{MIME} message @var{mesg}.")
992
#define FUNC_NAME s_scm_mu_message_get_part
993
{
994
  mu_message_t msg, submsg;
995
  int ismime = 0;
996
  int status;
997
  
998 999
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  SCM_ASSERT (scm_is_integer (part), part, SCM_ARG2, FUNC_NAME);
1000

1001
  msg = mu_scm_message_get (mesg);
1002
  mu_message_is_multipart (msg, &ismime);
1003 1004 1005
  if (!ismime)
    return SCM_BOOL_F;

1006
  status = mu_message_get_part (msg, scm_to_size_t (part), &submsg);
1007 1008 1009
  if (status)
    mu_scm_error (FUNC_NAME, status,
		  "Cannot get number of part ~A from the message ~A",
1010
		  scm_list_2 (part, mesg));
1011

1012
  return mu_scm_message_create (mesg, submsg);
1013 1014 1015
}
#undef FUNC_NAME

1016
SCM_DEFINE_PUBLIC (scm_mu_message_send, "mu-message-send", 1, 3, 0,
1017 1018 1019 1020
		   (SCM mesg, SCM mailer, SCM from, SCM to),
"Sends message @var{mesg}. Optional @var{mailer} overrides default mailer\n"
"settings. Optional @var{from} and @var{to} give sender and recever\n"
"addresses, respectively.\n")
1021
#define FUNC_NAME s_scm_mu_message_send
1022
{
1023
  char *mailer_name;
1024 1025 1026
  mu_address_t from_addr = NULL;
  mu_address_t to_addr = NULL;
  mu_mailer_t mailer_c = NULL;
1027
  mu_message_t msg;
1028
  int status;
1029
  
1030 1031
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
1032
  
1033
  if (!SCM_UNBNDP (mailer) && mailer != SCM_BOOL_F)
1034
    {
1035 1036
      SCM_ASSERT (scm_is_string (mailer), mailer, SCM_ARG2, FUNC_NAME);
      mailer_name = scm_to_locale_string (mailer);
1037 1038
    }
  else
1039
    {
1040 1041
      SCM val = MU_SCM_SYMBOL_VALUE ("mu-mailer");
      mailer_name = scm_to_locale_string (val);
1042 1043
    }
  
1044
  if (!SCM_UNBNDP (from) && from != SCM_BOOL_F)
1045
    {
1046 1047 1048
      char *s;
      int rc;
      
1049 1050 1051
      SCM_ASSERT (scm_is_string (from), from, SCM_ARG3, FUNC_NAME);
      s = scm_to_locale_string (from);
      rc = mu_address_create (&from_addr, s);
1052 1053 1054
      free (s);
      if (rc)
	mu_scm_error (FUNC_NAME, rc, "cannot create address",
1055
		      scm_list_1 (from));
1056 1057
    }
  
1058
  if (!SCM_UNBNDP (to) && to != SCM_BOOL_F)
1059
    {
1060 1061 1062
      char *s;
      int rc;
      
1063 1064 1065
      SCM_ASSERT (scm_is_string (to), to, SCM_ARG4, FUNC_NAME);
      s = scm_to_locale_string (to);
      rc = mu_address_create (&to_addr, s);
1066 1067 1068
      free (s);
      if (rc)
	mu_scm_error (FUNC_NAME, rc, "cannot create address",
1069
		      scm_list_1 (to));
1070 1071
    }

1072
  status = mu_mailer_create (&mailer_c, mailer_name);
1073
  free (mailer_name);
1074 1075
  if (status)
    mu_scm_error (FUNC_NAME, status, "Cannot get create mailer", SCM_BOOL_F);
1076

1077
  if (scm_to_int (MU_SCM_SYMBOL_VALUE ("mu-debug")))
1078
    {
1079
      mu_debug_t debug = NULL;
1080
      mu_mailer_get_debug (mailer_c, &debug);
1081
      mu_debug_set_level (debug, MU_DEBUG_LEVEL_UPTO (MU_DEBUG_PROT));
1082 1083
    }

1084
  status = mu_mailer_open (mailer_c, MU_STREAM_RDWR);
1085 1086
  if (status == 0)
    {
1087
      status = mu_mailer_send_message (mailer_c, msg, from_addr, to_addr);
1088 1089 1090
      if (status)
	mu_scm_error (FUNC_NAME, status, "Cannot send message", SCM_BOOL_F);

1091
      mu_mailer_close (mailer_c);
1092
    }
1093 1094
  else
    mu_scm_error (FUNC_NAME, status, "Cannot open mailer", SCM_BOOL_F);
1095
  mu_mailer_destroy (&mailer_c);
1096 1097 1098 1099 1100
  
  return status == 0 ? SCM_BOOL_T : SCM_BOOL_F;
}
#undef FUNC_NAME

1101
SCM_DEFINE_PUBLIC (scm_mu_message_get_uid, "mu-message-get-uid", 1, 0, 0,
1102 1103
		   (SCM mesg),
	    "Returns UID of the message @var{mesg}\n")
1104 1105 1106 1107 1108 1109
#define FUNC_NAME s_scm_mu_message_get_uid
{
  mu_message_t msg;
  int status;
  size_t uid;
  
1110 1111
  SCM_ASSERT (mu_scm_is_message (mesg), mesg, SCM_ARG1, FUNC_NAME);
  msg = mu_scm_message_get (mesg);
1112 1113 1114 1115 1116 1117 1118
  status = mu_message_get_uid (msg, &uid);
  if (status)
    mu_scm_error (FUNC_NAME, status, "Cannot get message uid", SCM_BOOL_F);
  return scm_from_size_t (uid);
}
#undef FUNC_NAME

1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131
/* Initialize the module */

void
mu_scm_message_init ()
{
  message_tag = scm_make_smob_type ("message", sizeof (struct mu_message));
  scm_set_smob_mark (message_tag, mu_scm_message_mark);
  scm_set_smob_free (message_tag, mu_scm_message_free);
  scm_set_smob_print (message_tag, mu_scm_message_print);

#include "mu_message.x"

}