mu-scm: implement mime-part handling, refact

Implement accessing the MIME-parts + docs  + test.

Implement saving attachments to file.

Implement creating messages from files.

Refactor / rename functions to be more uniform.

meson.build

@@ -176,6 +176,7 @@ if not get_option('tests').disabled()
   config_h_data.set_quoted('LN_PROGRAM',   ln.full_path())
 
   testmaildir=join_paths(meson.current_source_dir(), 'testdata')
+  config_h_data.set_quoted('MU_TESTDATADIR',  testmaildir)
   config_h_data.set_quoted('MU_TESTMAILDIR',  join_paths(testmaildir, 'testdir'))
   config_h_data.set_quoted('MU_TESTMAILDIR2',  join_paths(testmaildir, 'testdir2'))
   config_h_data.set_quoted('MU_TESTMAILDIR4',  join_paths(testmaildir, 'testdir4'))

scm/meson.build

@@ -21,6 +21,7 @@ lib_mu_scm=static_library(
   [
     'mu-scm.cc',
     'mu-scm-message.cc',
+    'mu-scm-mime.cc',
     'mu-scm-store.cc'
   ],
   dependencies: [

scm/mu-scm-message.cc

@@ -19,7 +19,9 @@
 
 #include "mu-scm-types.hh"
 #include "message/mu-message.hh"
+#include "message/mu-mime-object.hh"
 #include <mutex>
+#include <cstdio>
 
 using namespace Mu;
 using namespace Mu::Scm;
@@ -40,6 +42,7 @@ using MessageMap = std::unordered_map<std::string, MessageObject>;
 static MessageMap message_map;
 }
 
+
 static const Message&
 to_message(SCM scm, const char *func, int pos)
 {
@@ -60,7 +63,10 @@ finalize_message(SCM scm)
 }
 
 static SCM
-subr_message_object_make(SCM message_path_scm) try {
+subr_cc_message_make(SCM message_path_scm) try {
+
+	constexpr auto func{"cc-message-make"};
+
 	// message objects eat fds, tickle the gc... letting it handle it
 	// automatically is not soon enough.
 	if (message_map.size() >= 0.8 * max_message_map_size)
@@ -71,31 +77,37 @@ subr_message_object_make(SCM message_path_scm) try {
 	// qttempt to give an good error message rather then getting something
 	// from GMime)
 	if (message_map.size() >= max_message_map_size)
-		throw ScmError{"make-message", "too many open messages"};
+		throw ScmError{"cc-make-message", "too many open messages"};
 
 	// if we already have the message in our map, return it.
-	auto path{from_scm<std::string>(message_path_scm, "make-message", 1)};
+	auto path{from_scm<std::string>(message_path_scm, func, 1)};
 	if (const auto it = message_map.find(path); it != message_map.end())
 		return it->second.foreign_object;
 
 	// don't have it yet; attempt to create one
-	if (auto res{Message::make_from_path(path)}; !res)
+	if (auto res{Message::make_from_path(path)}; !res) {
-		throw ScmError{"make-message", "failed to create message"};
+		mu_printerrln("{}", res.error().what());
-	else {
+		throw ScmError{func, "failed to create message"};
+	} else {
 		// create a new object, store it in our map and return the foreign ptr.
-		std::pair<std::string, MessageObject> item {path, MessageObject{std::move(*res), {}}};
+		std::pair<std::string, MessageObject> item {path,
+			MessageObject{std::move(*res), {}}};
 		auto it = message_map.emplace(std::move(item));
 		return it.first->second.foreign_object = scm_make_foreign_object_1(
-			message_type, const_cast<Message*>(&it.first->second.message));
+			message_type,
+			const_cast<Message*>(&it.first->second.message));
 	}
 } catch (const ScmError& err) {
 	err.throw_scm();
 }
 
 static SCM
-subr_message_body(SCM message_scm, SCM html_scm) try {
+subr_cc_message_body(SCM message_scm, SCM html_scm) try {
-	const auto& message{to_message(message_scm, "body", 1)};
+
-	const auto html{from_scm<bool>(html_scm, "message-body", 2)};
+	constexpr auto func{"cc-message-make"};
+
+	const auto& message{to_message(message_scm, func, 1)};
+	const auto html{from_scm<bool>(html_scm, func, 2)};
 	if (const auto body{html ? message.body_html() : message.body_text()}; body)
 		return to_scm(*body);
 	else
@@ -105,9 +117,12 @@ subr_message_body(SCM message_scm, SCM html_scm) try {
 }
 
 static SCM
-subr_message_header(SCM message_scm, SCM field_scm) try {
+subr_cc_message_header(SCM message_scm, SCM field_scm) try {
-	const auto& message{to_message(message_scm, "header", 1)};
+
-	const auto field{from_scm<std::string>(field_scm, "message-header", 2)};
+	constexpr auto func{"cc-message-header"};
+
+	const auto& message{to_message(message_scm, func, 1)};
+	const auto field{from_scm<std::string>(field_scm, func, 2)};
 
 	if (const auto val{message.header(field)}; val)
 		return to_scm(*val);
@@ -117,21 +132,76 @@ subr_message_header(SCM message_scm, SCM field_scm) try {
 	err.throw_scm();
 }
 
+static SCM
+subr_cc_message_plist(SCM message_scm) try {
+
+	constexpr auto func{"cc-message-plist"};
+
+	const auto& message{to_message(message_scm, func, 1)};
+	const auto plist{"'" + message.sexp().to_string()};
+	return scm_c_eval_string(plist.c_str());
+
+} catch (const ScmError& err) {
+	err.throw_scm();
+}
+
+
+
+/**
+ * Get a list of message's MIME-parts
+ *
+ * @param message_scm  a Message (foreign-object)
+ *
+ * @return a list of MIME parts, each is a pair
+ *   ( mime-obj . alist )
+ * where the mime-obj is the GMimeObject* as a foreign-object,
+ * and alist is an association list describing the part.
+ */
+static SCM
+subr_cc_message_parts(SCM message_scm) try {
+
+	constexpr auto func{"cc-message-parts"};
+
+	const auto& message{to_message(message_scm, func, 1)};
+	const auto& parts{message.parts()};
+
+	SCM parts_scm{SCM_EOL};
+	for (size_t idx = 0; idx != parts.size(); ++idx) {
+		auto part{parts[idx]};
+		auto mime_part{GMIME_PART(part.mime_object().object())};
+		SCM mime_part_scm{to_scm(mime_part)};
+		SCM alist_scm{to_scm(idx, parts[idx])};
+
+		parts_scm = scm_append_x(
+			scm_list_2(parts_scm,
+				   scm_list_1(
+					   scm_cons(mime_part_scm, alist_scm))));
+	}
+
+	return parts_scm;
+
+} catch (const ScmError& err) {
+	err.throw_scm();
+}
+
 static void
 init_subrs()
 {
 #pragma GCC diagnostic push
 #pragma GCC diagnostic ignored "-Wcast-function-type"
-	scm_c_define_gsubr("message-object-make", 1/*req*/, 0/*opt*/, 0/*rst*/,
+	scm_c_define_gsubr("cc-message-make", 1/*req*/, 0/*opt*/, 0/*rst*/,
-			   reinterpret_cast<scm_t_subr>(subr_message_object_make));
+			   reinterpret_cast<scm_t_subr>(subr_cc_message_make));
-	scm_c_define_gsubr("message-body", 2/*req*/, 0/*opt*/, 0/*rst*/,
+	scm_c_define_gsubr("cc-message-body", 2/*req*/, 0/*opt*/, 0/*rst*/,
-			   reinterpret_cast<scm_t_subr>(subr_message_body));
+			   reinterpret_cast<scm_t_subr>(subr_cc_message_body));
-	scm_c_define_gsubr("message-header",2/*req*/, 0/*opt*/, 0/*rst*/,
+	scm_c_define_gsubr("cc-message-header",2/*req*/, 0/*opt*/, 0/*rst*/,
-			   reinterpret_cast<scm_t_subr>(subr_message_header));
+			   reinterpret_cast<scm_t_subr>(subr_cc_message_header));
+	scm_c_define_gsubr("cc-message-parts",1/*req*/, 0/*opt*/, 0/*rst*/,
+			   reinterpret_cast<scm_t_subr>(subr_cc_message_parts));
+	scm_c_define_gsubr("cc-message-plist",1/*req*/, 0/*opt*/, 0/*rst*/,
+			   reinterpret_cast<scm_t_subr>(subr_cc_message_plist));
 #pragma GCC diagnostic pop
 }
 
-
 void
 Mu::Scm::init_message()
 {

scm/mu-scm-mime.cc

@@ -0,0 +1,257 @@
+/*
+** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
+**
+** This program is free software; you can redistribute it and/or modify it
+** under the terms of the GNU General Public License as published by the
+** Free Software Foundation; either version 3, or (at your option) any
+** later version.
+**
+** This program 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 General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software Foundation,
+** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+**
+*/
+
+#include "mu-scm-types.hh"
+#include "message/mu-message.hh"
+#include "message/mu-mime-object.hh"
+#include <mutex>
+#include <cstdio>
+
+using namespace Mu;
+using namespace Mu::Scm;
+
+namespace {
+static SCM mime_part_type;
+static scm_t_port_type *mime_stream_port_type;
+}
+
+static GMimeStream*
+from_scm_port(SCM port)
+{
+	return GMIME_STREAM(reinterpret_cast<GMimeStream*>(SCM_STREAM(port)));
+}
+
+static size_t
+mime_stream_read(SCM port, SCM dst, size_t start, size_t count)
+{
+	auto stream{from_scm_port(port)};
+	const auto res = g_mime_stream_read(stream,
+					    reinterpret_cast<char*>(SCM_BYTEVECTOR_CONTENTS (dst) + start),
+					    count);
+	if (res < 0)
+		scm_misc_error("mime-object-read", "failed to read stream",
+			       SCM_BOOL_F);
+
+	return static_cast<size_t>(res);
+}
+
+static scm_t_off
+mime_stream_seek(SCM port, scm_t_off offset, int whence)
+{
+	auto stream{from_scm_port(port)};
+	const auto gwhence = [](int w) {
+		switch(w) {
+		case SEEK_SET: return GMIME_STREAM_SEEK_SET;
+		case SEEK_CUR: return GMIME_STREAM_SEEK_CUR;
+		case SEEK_END: return GMIME_STREAM_SEEK_END;
+		default:
+			scm_misc_error("mime-stream-seek", "invalid whence",
+				       SCM_BOOL_F);
+			return GMIME_STREAM_SEEK_SET; // never reached.
+		}
+	}(whence);
+
+	const auto res = g_mime_stream_seek(stream, offset, gwhence);
+	if (res < 0)
+		scm_misc_error("mime-stream-seek", "invalid seek",
+			       SCM_BOOL_F);
+
+	return res;
+}
+
+static scm_t_port_type*
+make_mime_stream_port_type()
+{
+	auto ptype = scm_make_port_type(const_cast<char*>("mime-stream"), mime_stream_read, {});
+
+	scm_set_port_close(ptype, [](SCM port){g_mime_stream_close(from_scm_port(port));});
+	scm_set_port_needs_close_on_gc(ptype, true);
+
+	scm_set_port_seek(ptype, mime_stream_seek);
+
+	return ptype;
+}
+
+static GMimePart*
+part_from_scm(SCM scm, const char *func, int pos)
+{
+	if (!SCM_IS_A_P(scm, mime_part_type))
+		throw ScmError{ScmError::Id::WrongType, func, pos, scm, "mime-part"};
+
+	return GMIME_PART(reinterpret_cast<GMimePart*>(scm_foreign_object_ref(scm, 0)));
+}
+
+static GMimeStream*
+get_decoded_stream(GMimePart *part)
+{
+	auto wrapper{g_mime_part_get_content(part)};
+	if (!wrapper)
+		throw ScmError{"make-make-mime-stream-port",
+			"failed to create data-wrapper"};
+
+	auto stream{g_mime_stream_mem_new()};
+	if (!stream)
+		throw ScmError{"make-make-mime-stream-port",
+			"failed to create mem-stream"};
+
+	const auto res{g_mime_data_wrapper_write_to_stream(wrapper, stream)};
+	if (res < 0) {
+		g_object_unref(stream);
+		throw ScmError{"make-make-mime-stream-port",
+			"failed to write to stream"};
+	}
+
+	return stream;
+}
+
+static GMimeStream*
+get_stream(GMimePart *part, bool content_only)
+{
+	auto stream = g_mime_stream_mem_new();
+	if (!stream)
+		throw ScmError{"make-mime-stream-port",
+			"failed to create mem-stream"};
+
+	ssize_t res{};
+	if (content_only)  // content-only
+		res = g_mime_object_write_content_to_stream(
+			GMIME_OBJECT(part), {}, stream);
+	else // with headers
+		res = g_mime_object_write_to_stream(
+			GMIME_OBJECT(part), {}, stream);
+
+	if (res < 0) {
+		g_object_unref(stream);
+		throw ScmError{"make-mime-stream-port",
+			"failed to write to stream"};
+	}
+
+	return stream;
+}
+
+/**
+ * Create a port for the mime-part
+ *
+ * @param mime_obj mime object (foreign object)
+ * @param content_only_scm whether to not include headers
+ * @param decode_scm whether to decode content
+ * (must be false if decode_scm is true)
+ *
+ * @return SCM for mime stream port
+ */
+static SCM
+subr_make_mime_stream_port(SCM mime_part_scm, SCM content_only_scm,
+			   SCM decode_scm)
+{
+
+	constexpr auto func{"make-mime-stream-port"};
+	GMimeStream *stream{};
+	try {
+		auto part = part_from_scm(mime_part_scm, func, 1);
+		const auto decode{from_scm<bool>(decode_scm,
+						 func, 2)};
+		const auto content_only{from_scm<bool>(content_only_scm,
+						       func, 3)};
+		if (decode)
+			stream = get_decoded_stream(part);
+		else
+			stream = get_stream(part, content_only);
+
+		if (const auto res = g_mime_stream_reset(stream); res != 0)
+			throw ScmError{func, "failed to reset stream"};
+
+		return scm_c_make_port(mime_stream_port_type, SCM_RDNG,
+				       reinterpret_cast<scm_t_bits>(stream));
+	} catch (const ScmError& err) {
+		if (stream)
+			g_object_unref(stream);
+		err.throw_scm();
+	}
+
+	return SCM_UNSPECIFIED;
+}
+
+
+SCM
+Mu::Scm::to_scm(GMimePart *part)
+{
+	return scm_make_foreign_object_1(mime_part_type, g_object_ref(part));
+}
+
+SCM
+Mu::Scm::to_scm(size_t idx, const MessagePart& part)
+{
+	static SCM sym_index{make_symbol("index")};
+	static SCM sym_content_type{make_symbol("content-type")};
+	static SCM sym_content_description{make_symbol("content-description")};
+	static SCM sym_size{make_symbol("size")};
+	static SCM sym_attachment{make_symbol("attachment?")};
+	static SCM sym_filename{make_symbol("filename")};
+	static SCM sym_signed{make_symbol("signed?")};
+	static SCM sym_encrypted{make_symbol("encrypted?")};
+
+	SCM alist = scm_acons(sym_index, to_scm(idx), SCM_EOL);
+
+	if (const auto ctype{part.mime_type()}; ctype)
+		alist = scm_acons(sym_content_type, to_scm(*ctype), alist);
+	if (const auto cdesc{part.content_description()}; cdesc)
+		alist = scm_acons(sym_content_description, to_scm(*cdesc), alist);
+
+	if (part.is_attachment())
+		alist = scm_acons(sym_attachment, SCM_BOOL_T, alist);
+
+	alist = scm_acons(sym_size, to_scm(part.size()), alist);
+
+	if (const auto fname{part.cooked_filename(true/*minmimal*/)}; fname)
+		alist = scm_acons(sym_filename, to_scm(*fname), alist);
+
+	if (part.is_signed())
+		alist = scm_acons(sym_signed, SCM_BOOL_T, alist);
+	if (part.is_encrypted())
+		alist = scm_acons(sym_encrypted, SCM_BOOL_T, alist);
+
+	return scm_reverse_x(alist, SCM_EOL); // slightly more convenient
+}
+
+static void
+init_subrs()
+{
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wcast-function-type"
+	scm_c_define_gsubr("cc-mime-make-stream-port",3/*req*/, 0/*opt*/, 0/*rst*/,
+			   reinterpret_cast<scm_t_subr>(subr_make_mime_stream_port));
+#pragma GCC diagnostic pop
+}
+
+void
+Mu::Scm::init_mime()
+{
+	mime_part_type = scm_make_foreign_object_type(
+		make_symbol("g-mime-part"),
+		scm_list_1(make_symbol("data")),
+		[](SCM scm) { // finalizer
+			g_object_unref(
+				GMIME_PART(reinterpret_cast<GMimePart*>(
+						   scm_foreign_object_ref(scm, 0))));
+		});
+
+	mime_stream_port_type = make_mime_stream_port_type();
+
+	init_subrs();
+}

scm/mu-scm-store.cc

@@ -39,23 +39,25 @@ to_store(SCM scm, const char *func, int pos)
 }
 
 static SCM
-subr_mcount(SCM store_scm) try {
+subr_cc_store_mcount(SCM store_scm) try {
-	return to_scm(to_store(store_scm, "mcount", 1).size());
+	return to_scm(to_store(store_scm, "cc-store-mcount", 1).size());
 } catch (const ScmError& err) {
 	err.throw_scm();
 }
 
 static SCM
-subr_cfind(SCM store_scm, SCM pattern_scm, SCM personal_scm, SCM after_scm, SCM max_results_scm) try {
+subr_cc_store_cfind(SCM store_scm, SCM pattern_scm, SCM personal_scm, SCM after_scm, SCM max_results_scm) try {
+
+	constexpr auto func{"cc-store-cfind"};
 
 	SCM contacts{SCM_EOL};
-	const auto pattern{from_scm<std::string>(pattern_scm, "cfind", 2)};
+	const auto pattern{from_scm<std::string>(pattern_scm, func, 2)};
-	const auto personal{from_scm<bool>(personal_scm, "cfind", 3)};
+	const auto personal{from_scm<bool>(personal_scm, func, 3)};
-	const auto after{from_scm_with_default(after_scm, 0, "cfind", 4)};
+	const auto after{from_scm_with_default(after_scm, 0, func, 4)};
 	// 0 means "unlimited"
-	const size_t maxnum = from_scm_with_default(max_results_scm, 0U, "cfind", 5);
+	const size_t maxnum = from_scm_with_default(max_results_scm, 0U, func, 5);
 
-	to_store(store_scm, "cfind", 1).contacts_cache().for_each(
+	to_store(store_scm, func, 1).contacts_cache().for_each(
 		[&](const auto& contact)->bool {
 			contacts = scm_append_x(scm_list_2(contacts, scm_list_1(to_scm(contact))));
 			return true;
@@ -80,22 +82,24 @@ to_sort_field_id(SCM field, const char *func, int pos)
 }
 
 static SCM
-subr_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups_scm,
+subr_cc_store_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups_scm,
 	  SCM sort_field_scm, SCM reverse_scm, SCM max_results_scm) try {
 
-	const auto& store{to_store(store_scm, "mfind", 1)};
+	constexpr auto func{"cc-store-mfind"};
-	const auto query{from_scm<std::string>(query_scm, "mfind", 2)};
+
-	const auto related(from_scm<bool>(related_scm, "mfind", 3));
+	const auto& store{to_store(store_scm, func, 1)};
-	const auto skip_dups(from_scm<bool>(skip_dups_scm, "mfind", 4));
+	const auto query{from_scm<std::string>(query_scm, func, 2)};
+	const auto related(from_scm<bool>(related_scm, func, 3));
+	const auto skip_dups(from_scm<bool>(skip_dups_scm, func, 4));
 
 	if (!scm_is_false(sort_field_scm) && !scm_is_symbol(sort_field_scm))
-		throw ScmError{ScmError::Id::WrongType, "mfind", 5, sort_field_scm, "#f or sort-field-symbol"};
+		throw ScmError{ScmError::Id::WrongType, func, 5, sort_field_scm, "#f or sort-field-symbol"};
 
-	const auto sort_field_id = to_sort_field_id(sort_field_scm, "mfind", 5);
+	const auto sort_field_id = to_sort_field_id(sort_field_scm, func, 5);
-	const auto reverse(from_scm<bool>(reverse_scm, "mfind", 6));
+	const auto reverse(from_scm<bool>(reverse_scm, func, 6));
 
 	// 0 means "unlimited"
-	const size_t maxnum = from_scm_with_default(max_results_scm, 0U, "mfind", 7);
+	const size_t maxnum = from_scm_with_default(max_results_scm, 0U, func, 7);
 
 	const QueryFlags qflags = QueryFlags::SkipUnreadable |
 		(skip_dups ? QueryFlags::SkipDuplicates : QueryFlags::None) |
@@ -107,7 +111,7 @@ subr_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups_scm,
 	const auto qres = store.run_query(query, sort_field_id, qflags, maxnum);
 
 	if (!qres)
-		throw ScmError{ScmError::Id::WrongArg, "mfind", 2, query_scm, ""};
+		throw ScmError{ScmError::Id::WrongArg, func, 2, query_scm, ""};
 
 	for (const auto& mi: *qres) {
 		if (auto plist{mi.document()->get_data()}; plist.empty())
@@ -122,17 +126,19 @@ subr_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups_scm,
 } catch (const ScmError& err) {
 	err.throw_scm();
 }
+
+
 static void
 init_subrs()
 {
 #pragma GCC diagnostic push
 #pragma GCC diagnostic ignored "-Wcast-function-type"
-	scm_c_define_gsubr("store-mfind", 7/*req*/, 0/*opt*/, 0/*rst*/,
+	scm_c_define_gsubr("cc-store-mfind", 7/*req*/, 0/*opt*/, 0/*rst*/,
-			   reinterpret_cast<scm_t_subr>(subr_mfind));
+			   reinterpret_cast<scm_t_subr>(subr_cc_store_mfind));
-	scm_c_define_gsubr("store-mcount", 1/*req*/, 0/*opt*/, 0/*rst*/,
+	scm_c_define_gsubr("cc-store-mcount", 1/*req*/, 0/*opt*/, 0/*rst*/,
-			   reinterpret_cast<scm_t_subr>(subr_mcount));
+			   reinterpret_cast<scm_t_subr>(subr_cc_store_mcount));
-	scm_c_define_gsubr("store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/,
+	scm_c_define_gsubr("cc-store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/,
-			   reinterpret_cast<scm_t_subr>(subr_cfind));
+			   reinterpret_cast<scm_t_subr>(subr_cc_store_cfind));
 #pragma GCC diagnostic pop
 }
 

scm/mu-scm-test.scm

@@ -1,6 +1,7 @@
 ;; unit tests
 
-(use-modules (mu) (srfi srfi-64))
+(use-modules (mu) (srfi srfi-64)
+	     (ice-9 textual-ports))
 
 (define (test-basic)
   (test-begin "test-basic")
@@ -47,14 +48,11 @@
 (define (test-mfind)
   (test-begin "test-mfind")
   (let ((msg (car (mfind "" #:sort-field 'date #:reverse? #t))))
-
     (test-equal "test with multi to and cc" (subject msg) )
     (test-equal "2016-05-15 16:57:25"
       (time->string (date msg) #:format "%F %T" #:utc? #t)))
-
   (test-end "test-mfind"))
 
-
 (define (test-message-full)
   (test-begin "test-message-full")
 
@@ -91,6 +89,49 @@
     (test-equal "3BE9E6535E3029448670913581E7A1A20D852173@emss35m06.us.lmco.com" (thread-id msg)))
   (test-end "test-message-more"))
 
+
+(define (test-message-parts)
+  (test-begin "test-message-parts")
+  (let* ((msg (car (mfind "flag:attach")))
+	 (parts (mime-parts msg)))
+    (test-equal 3 (length parts))
+    (test-equal
+	'(((index . 0) (content-type . "text/plain") (size . 1174))
+	  ((index . 1) (content-type . "text/x-vcard") (attachment? . #t) (size . 306)
+	   (filename . "mihailim.vcf"))
+	  ((index . 2) (content-type . "text/plain") (size . 153)))
+      (map (lambda (part) (mime-part->alist part)) parts))
+
+    (let ((port (make-port (car parts))))
+      (test-assert (port? port))
+      (test-assert (input-port? port))
+      (test-assert (not (port-closed? port)))
+      (test-equal "Marco Bambini wrote:" (get-string-n port 20)))
+
+    (test-end "test-message-parts")))
+
+(define (test-message-new)
+  (test-begin "test-message-new")
+  (let ((msg (make-message (format #f "~a/testdir2/Foo/cur/mail5" (getenv "MU_TESTDATADIR"))))
+	(tmpdir (getenv "MU_TESTTEMPDIR")))
+    (test-equal "pics for you" (subject msg))
+    (test-equal
+	'(((index . 0) (content-type . "text/plain") (size . 27))
+	  ((index . 1) (content-type . "image/jpeg") (size . 23881) (filename . "sittingbull.jpg"))
+	  ((index . 2) (content-type . "image/jpeg") (size . 21566) (filename . "custer.jpg")))
+      (map (lambda (part) (mime-part->alist part)) (mime-parts msg)))
+
+    (let* ((part (list-ref (mime-parts msg) 1))
+	   (alist (mime-part->alist part))
+	   (fname (format #f "~a/~a" tmpdir (assoc-ref alist 'filename))))
+      (write-to-file part #:filename fname)
+      (test-assert (access? fname R_OK))
+      ;; note, the 23881 is the _encoded_ size.
+      (test-equal 17674 (stat:size (stat fname))))
+
+    ;;(write-to-file (list-ref (mime-parts msg) 1))
+    (test-end "test-message-new")))
+
 (define (test-options)
   (test-begin "test-options")
   (let ((opts %options))
@@ -99,7 +140,7 @@
     (test-equal (assoc-ref opts 'debug) #f)
     (test-equal (assoc-ref opts 'verbose) #f)
     (test-equal (assoc-ref opts 'muhome) #f))
-    (test-end "test-options"))
+  (test-end "test-options"))
 
 (define (test-helpers)
   (test-begin "test-helpers")
@@ -131,6 +172,8 @@
       (test-mfind)
       (test-message-full)
       (test-message-more)
+      (test-message-parts)
+      (test-message-new)
       (test-options)
       (test-helpers)
 

scm/mu-scm-types.hh

@@ -22,6 +22,7 @@
 
 #include "lib/mu-store.hh"
 #include "message/mu-contact.hh"
+#include "message/mu-mime-object.hh"
 
 #include "mu-scm.hh"
 
@@ -41,6 +42,12 @@ void init_store(const Mu::Store& store);
  */
 void init_message();
 
+
+/**
+ * Initialize SCM/MimeObject/Part support
+ */
+void init_mime();
+
 /**
  * Convert a Contact to an SCM
  *
@@ -50,6 +57,28 @@ void init_message();
  */
 SCM to_scm(const Contact& contact);
 
+
+/**
+ * Convert a MessagePart to an SCM (alist)
+ *
+ * @param idx index of the message-part
+ * @param part the part
+ *
+ * @return SCM
+ */
+SCM to_scm(size_t idx, const MessagePart& part);
+
+
+/**
+ * Convert a GMimePart* to an SCM (alist)
+ *
+ * @param obj a mime part
+ *
+ * @return SCM
+ */
+SCM to_scm(GMimePart *part);
+
+
 } // Mu::Scm
 
 #endif /*MU_SCM_TYPES_HH*/

scm/mu-scm.cc

@@ -62,6 +62,7 @@ init_module_mu(void* _data)
 	init_options(config->options);
 	init_store(config->store);
 	init_message();
+	init_mime();
 }
 
 static const Result<std::string>
@@ -181,6 +182,9 @@ test_scm_script()
 {
 	TempDir tempdir{};
 	const auto MuTestMaildir{ Mu::canonicalize_filename(MU_TESTMAILDIR, "/")};
+
+	::setenv("MU_TESTTEMPDIR", tempdir.path().c_str(), 1);
+
 	auto store{Store::make_new(tempdir.path(), MuTestMaildir)};
 	assert_valid_result(store);
 
@@ -207,6 +211,7 @@ int
 main(int argc, char* argv[])
 {
 	::setenv("MU_SCM_DIR", MU_SCM_SRCDIR, 1);
+	::setenv("MU_TESTDATADIR", MU_TESTDATADIR, 1);
 
 	mu_test_init(&argc, &argv);
 

scm/mu-scm.scm

@@ -19,17 +19,20 @@
 (define-module (mu)
   :use-module (oop goops)
   :use-module (system foreign)
+  :use-module (rnrs bytevectors)
   :use-module (ice-9 optargs)
+  :use-module (ice-9 binary-ports)
   #:export (
-	    ;; classes
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-	    <store>
+	    ;; Mime-parts
-
+	    <mime-part>
-	    mfind
+	    mime-part->alist
-	    mcount
+	    make-port
-	    cfind
+	    write-to-file
-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+	    ;; Message
 	    <message>
-	    sexp
+	    make-message
 
 	    date
 	    last-change
@@ -75,14 +78,27 @@
 	    body
 	    header
 
+	    mime-parts
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+	    ;; Store
+	    <store>
+	    mfind
+	    mcount
+	    cfind
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+	    ;; Other
+
 	    ;; misc
 	    %options
-;;	    %preferences
+	    ;;	    %preferences
 
 	    ;; helpers
 	    string->time
 	    time->string))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; some helpers for dealing with plists / alists
 (define (plist-for-each func plist)
@@ -124,6 +140,62 @@ If not found, return #f."
 				  v)))))
      plist)
     alist))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; MIME-parts
+;;
+;; A <mime-object> has two slots:
+;; partobj -->    wraps a GMimePart* as a "foreign object"
+;; alist -->      alist with information about some MIME-part
+(define-class <mime-part> ()
+  (mimepart  #:init-value #f #:init-keyword #:mimepart)
+  (alist     #:init-value #f #:init-keyword #:alist #:getter mime-part->alist))
+
+(define* (make-port mime-part #:key (content-only? #t) (decode? #t))
+  "Create a read port for MIME-PART.
+If CONTENT-ONLY? is #t, only include the contents, not headers.
+If DECODE? is #t, decode the content (from e.g., base64); in that case,
+CONTENT-ONLY? is implied to be #t."
+  (cc-mime-make-stream-port (slot-ref mime-part 'mimepart) content-only? decode?))
+
+(define* (make-output-file mime-part #:key (filename #f) (overwrite? #f))
+  "Create a port for the file to write MIME-PART to.
+
+FILENAME is the path to the file name. If not specified, use the 'filename'
+field in the mime-part and if that does not exist, use 'mime-part-<index>' with
+<index> being the number of the mime-part.
+
+OVERWRITE? specifies whether existing files by the same name or overwritten.
+Otherwise, trying to overwrite an existing file raises an error."
+  (let* ((alist (mime-part->alist mime-part))
+	(filename (or filename
+		      (assoc-ref alist 'filename)
+		      (format #f "mime-part-~d" (assoc-ref alist 'index)))))
+	;; we need an fd-based port since we want to support overwrite?
+	(open filename
+	      (logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644)))
+
+(define* (write-to-file mime-part #:key (filename #f) (overwrite? #f))
+  "Write MIME-PART to a file.
+
+FILENAME is the path to the file name. If not specified, use the 'filename'
+field in the mime-part and if that does not exist, use 'mime-part-<index>' with
+<index> being the number of the mime-part.
+
+OVERWRITE? specifies whether existing files by the same name or overwritten.
+Otherwise, trying to overwrite an existing file raises an error."
+  (let* ((input (make-port mime-part))
+	 (output (make-output-file mime-part
+				   #:filename filename #:overwrite? overwrite?))
+	 (buf (make-bytevector 4096)) ;; just a guess...
+	 (bytes 0))
+    (while (not (eof-object? bytes)) ;; XXX do this in a more elegant way.
+      (set! bytes (get-bytevector-n! input buf 0 (bytevector-length buf)))
+      (put-bytevector output buf 0 (if (eof-object? bytes) 0 bytes)))
+    (close input)
+    (close output)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Message
@@ -132,25 +204,31 @@ If not found, return #f."
 ;; plist -->      this is the message sexp cached in the database;
 ;;                for each message (for mu4e, but we reuse here)
 ;; object-->      wraps a Mu::Message* as a "foreign object"
-;;
+;; parts -->      MIME-parts
 ;; generally the plist is a bit cheaper, since the mu-message
-;; captures a file-deescriptor.
+;; captures a file-descriptor.
 
 (define-class <message> ()
+  (object #:init-value #f #:init-keyword #:object)
   (plist #:init-value #f #:init-keyword #:plist)
-  (object #:init-value #f #:init-keyword #:object))
+  (parts #:init-value #f #:init-keyword #:parts))
+
+(define (make-message path)
+  "Create a <message> from file at PATH."
+  (make <message> #:object (cc-message-make path)))
 
 (define-method (plist (message <message>))
   "Get the PLIST for this MESSAGE."
+  (when (not (slot-ref message 'plist))
+    (slot-set! message 'plist (cc-message-plist (object message))))
   (slot-ref message 'plist))
 
 (define-method (object (message <message>))
   "Get the foreign object for this MESSAGE.
-If MESSAGE does not have such an object yet, crate it from the
+If MESSAGE does not have such an object yet, create it from the
 path of the message."
   (if (not (slot-ref message 'object))
-      (slot-set! message 'object
+      (slot-set! message 'object (cc-message-make (path message))))
-		 (message-object-make (path message))))
   (slot-ref message 'object))
 
 (define-method (find-field (message <message>) field)
@@ -170,7 +248,7 @@ If LST is #f, return #f."
       (+ (ash (car lst) 16) (cadr lst))
       #f))
 
-;; Accessor for the fields
+;; Accessors for the fields
 
 (define-method (subject (message <message>))
   "Get the subject for MESSAGE or #f if not found."
@@ -335,16 +413,26 @@ not found."
   (find-contact-field message ':bcc))
 
 (define* (body message #:key (html? #f))
-  "Get the MESSAGE body or #f if not found.
+  "Get the MESSAGE body or #f if not found
 If #:html is non-#f, instead search for the HTML body.
 Requires the full message."
-  (message-body (object message) html?))
+  (cc-message-body (object message) html?))
 
 (define-method (header (message <message>) (field <string>))
   "Get the raw MESSAGE header FIELD or #f if not found.
 FIELD is case-insensitive and should not have the ':' suffix.
 Requires the full message."
-  (message-header (object message) field))
+  (cc-message-header (object message) field))
+
+(define-method (mime-parts (message <message>))
+  "Get the MIME-parts for this message.
+This is a list of <mime-part> objects."
+  (let ((msgobj (object message)))
+    (map (lambda (mimepart-alist)
+	   (make <mime-part>
+	     #:mimepart (car mimepart-alist)
+	     #:alist (cdr mimepart-alist)))
+	 (cc-message-parts msgobj))))
 
 ;; Store
 ;;
@@ -370,13 +458,13 @@ Requires the full message."
   (make-store %default-store-object))
 
 (define* (mfind query
-	       #:key
+		#:key
-	       (store %default-store)
+		(store %default-store)
-	       (related? #f)
+		(related? #f)
-	       (skip-dups? #f)
+		(skip-dups? #f)
-	       (sort-field 'date)
+		(sort-field 'date)
-	       (reverse? #f)
+		(reverse? #f)
-	       (max-results #f))
+		(max-results #f))
    "Find messages matching some query.
 
 The query is mandatory, the other (keyword) arguments are optional.
@@ -389,14 +477,14 @@ The query is mandatory, the other (keyword) arguments are optional.
     #:max-results max. number of matches. Default: false (unlimited))."
    (map (lambda (plist)
 	  (make <message> #:plist plist))
-	(store-mfind (store-object store) query
+	(cc-store-mfind (store-object store) query
 		     related? skip-dups? sort-field reverse? max-results)))
 
 (define* (mcount
 	  #:key
 	  (store %default-store))
   "Get the number of messages."
-  (store-mcount (store-object store)))
+  (cc-store-mcount (store-object store)))
 
 (define* (cfind pattern
 		#:key
@@ -412,7 +500,7 @@ The pattern is mandatory; the other (keyword) arguments are optional.
     #:personal?   only include 'personal' contacts. Default: all
     #:after       only include contacts last seen time_t: Default all
     #:max-results max. number of matches. Default: false (unlimited))."
-  (store-cfind (store-object store) pattern personal? after max-results))
+  (cc-store-cfind (store-object store) pattern personal? after max-results))
 
 ;;; Misc
 
@@ -467,7 +555,6 @@ The input date format is fixed."
 	     (mktime sbdtime "UTC")
 	     (mktime sbdtime)))))
 
-
 (define* (time->string time-t #:key (format 'preference) (utc? 'preference))
   "Convert a time_t (second-since-epoch) value TIME-T into a string.
 

scm/mu-scm.texi

@@ -355,14 +355,15 @@ Example usage:
 @node Message
 @section Message
 
-A message represents the information about some e-mail message whose information
+A message represents the information about an e-mail message. @t{mu} gets this
-has been extracted and store in the @t{mu} store (database).
+information either from its database (the @t{mu} store), e.g., with @code{mfind}
+(see @xref{Store}) or by reading an email message from the file-systems with
+@code{make-message}.
 
-You can retrieve lists of @t{<message>} objects with @t{mfind} method, as
+In many of the examples below we assume there is some @code{message} object,
-explained in @xref{Store}. In the following, we use some message-object @t{msg},
+e.g. as retrieved through:
-e.g.
 @lisp
-l(define msg (car (mfind "hello")))
+(define msg (car (mfind "hello")))
 @end lisp
 
 @anchor{full-message} Many of the procedures below use the internal
@@ -370,10 +371,18 @@ representation of the message from the database; this re-uses the same
 information that @t{mu4e} uses. However, that is not sufficient for all:
 @code{body} and @code{header} need the full message. To get this, it needs to
 open the message file from the file-system. Much of this is internal to
-@t{mu-scm}, except that full-method-procedures are relatively a bit slower.
+@t{mu-scm}, except that full-method-procedures are a bit slower relatively to
+the database-only ones.
 
 @subsection Basics
 
+@deffn {Scheme Procedure} make-message path
+@end deffn
+Create a new message object from a file-system path.
+
+This is a @emph{full message}, unlike the ones you get from a store-query (i.e.,
+@code{mfind}).
+
 @deffn {Scheme Procedure} subject message
 @end deffn
 Get the message subject, or @t{#f} if there is none.
@@ -438,13 +447,86 @@ If @var{#:html?} is non-@t{#f}, get the HTML-body instead.
 
 This requires the @ref{full-message,,full message}.
 
+@deffn {Scheme Procedure} message-id message
+@end deffn
+Get the message's @t{Message-ID} field, or @t{#f} if there is none.
+
+For example:
+@lisp
+(message-id msg)
+=> "87a15477-dd66-43e5-a722-81c545d6af19@@gmail.com"
+@end lisp
+
+@subsection MIME-parts
+
+Messages consist of one or more MIME-parts, which include the body, attachments
+and other parts. To get the MIME-parts for a message, you can use the
+@code{mime-parts} method on a @code{message}.
+
+@deffn {Scheme Procedure} mime-parts message
+@end deffn
+Get the MIME-parts for this message, as a list of @code{<mime-part>} objects.
+
+A MIME-parts is an object with a few methods.
+
+@deffn {Scheme Procedure} mime-part->alist mime-part
+@end deffn
+Get an association list (alist) describing the MIME part.
+
+For example:
+@lisp
+;; describe the second MIME-part of the first message with an attachment
+(mime-part->alist
+ (cadr (mime-parts
+       (car (mfind "flag:attach" #:max-results 1)))))
+=> ((filename . "emacs.png") (size . 18188) (content-type . "image/png") (index . 1))
+@end lisp
+
+Depending on the MIME-part, different fields can be present:
+@itemize
+@item @t{index}
+the index (number) of the part, 0-based
+@item @t{mime-type}
+the MIME-type of the part
+@item @t{size}
+the size of the part in bytes. For encoded parts, this is the @emph{encoded} size
+@item @t{filename} the filename (for attachments).
+This is as specified in the message, but with forward slashes and
+control-characters removed or substituted with @t{-}.
+@item @t{signed?}
+is this part (cryptographically) signed?
+@item @t{encrypted?}
+is this part encrypted?
+@end itemize
+
+@deffn {Scheme Procedure} make-port mime-part [#:content-only? #f]
+                                              [#:decode? #t]
+@end deffn
+Get a read-port for the given MIME-part. Ports are the standard mechanism for
+dealing with I/O in Guile; see its documentation for further details.
+
+If @code{content-only?} is true, only include the contents, not headers. If
+@code{decode?} is true, decode the content (from e.g., Base-64); in that
+case, @code{content-only?} is implied to be #t.
+
+
+@deffn {Scheme Procedure} write-to-file [#:filename #f] [#:overwrite? #f]
+@end deffn
+Write MIME-part to file.
+
+Use @code{filename} is the file/path to use for writing; if this is @code{#f},
+the name is taken from the @t{filename} property of the MIME-part alist. If that
+does not exist, a generic name is chosen.
+
+If @code{overwrite?} is true, overwrite existing files of the same name;
+otherwise, raise an error if the file already exists.
+
 @subsection Contacts
 
 Message fields @t{To:}, @t{From:}, @t{Cc:} and @t{Bcc:} contain @emph{contacts}.
 @t{mu-scm} represents those as list of contact-alists, or contacts for short.
-Each contact is an alist with at least an @t{email} and optionally a @t{name}
+Each contact is an alist with at least an @code{email} and optionally a
-field. For instance:
+@code{name} field. For instance:
-
 @lisp
 (to msg)
 => (((name . "Hannibal Smith") (email . "jhs@@example.com"))