From b02aa5768645d1df7da42195f1fbacd0a62e7d1c Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Wed, 2 Jul 2025 19:02:33 +0300 Subject: [PATCH] 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 | 1 + scm/meson.build | 1 + scm/mu-scm-message.cc | 112 ++++++++++++++---- scm/mu-scm-mime.cc | 257 ++++++++++++++++++++++++++++++++++++++++++ scm/mu-scm-store.cc | 54 +++++---- scm/mu-scm-test.scm | 53 ++++++++- scm/mu-scm-types.hh | 29 +++++ scm/mu-scm.cc | 5 + scm/mu-scm.scm | 147 +++++++++++++++++++----- scm/mu-scm.texi | 102 +++++++++++++++-- 10 files changed, 671 insertions(+), 90 deletions(-) create mode 100644 scm/mu-scm-mime.cc diff --git a/meson.build b/meson.build index 80702eb4..de37e8b2 100644 --- a/meson.build +++ b/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')) diff --git a/scm/meson.build b/scm/meson.build index 0c444e7c..d0a4b2a2 100644 --- a/scm/meson.build +++ b/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: [ diff --git a/scm/mu-scm-message.cc b/scm/mu-scm-message.cc index d4f770ec..47725a3e 100644 --- a/scm/mu-scm-message.cc +++ b/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 +#include using namespace Mu; using namespace Mu::Scm; @@ -40,6 +42,7 @@ using MessageMap = std::unordered_map; 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(message_path_scm, "make-message", 1)}; + auto path{from_scm(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) - throw ScmError{"make-message", "failed to create message"}; - else { + if (auto res{Message::make_from_path(path)}; !res) { + mu_printerrln("{}", res.error().what()); + throw ScmError{func, "failed to create message"}; + } else { // create a new object, store it in our map and return the foreign ptr. - std::pair item {path, MessageObject{std::move(*res), {}}}; + std::pair 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(&it.first->second.message)); + message_type, + const_cast(&it.first->second.message)); } } catch (const ScmError& err) { err.throw_scm(); } static SCM -subr_message_body(SCM message_scm, SCM html_scm) try { - const auto& message{to_message(message_scm, "body", 1)}; - const auto html{from_scm(html_scm, "message-body", 2)}; +subr_cc_message_body(SCM message_scm, SCM html_scm) try { + + constexpr auto func{"cc-message-make"}; + + const auto& message{to_message(message_scm, func, 1)}; + const auto html{from_scm(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 { - const auto& message{to_message(message_scm, "header", 1)}; - const auto field{from_scm(field_scm, "message-header", 2)}; +subr_cc_message_header(SCM message_scm, SCM field_scm) try { + + constexpr auto func{"cc-message-header"}; + + const auto& message{to_message(message_scm, func, 1)}; + const auto field{from_scm(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*/, - reinterpret_cast(subr_message_object_make)); - scm_c_define_gsubr("message-body", 2/*req*/, 0/*opt*/, 0/*rst*/, - reinterpret_cast(subr_message_body)); - scm_c_define_gsubr("message-header",2/*req*/, 0/*opt*/, 0/*rst*/, - reinterpret_cast(subr_message_header)); + scm_c_define_gsubr("cc-message-make", 1/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_message_make)); + scm_c_define_gsubr("cc-message-body", 2/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_message_body)); + scm_c_define_gsubr("cc-message-header",2/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_message_header)); + scm_c_define_gsubr("cc-message-parts",1/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_message_parts)); + scm_c_define_gsubr("cc-message-plist",1/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_message_plist)); #pragma GCC diagnostic pop } - void Mu::Scm::init_message() { diff --git a/scm/mu-scm-mime.cc b/scm/mu-scm-mime.cc new file mode 100644 index 00000000..8a968f06 --- /dev/null +++ b/scm/mu-scm-mime.cc @@ -0,0 +1,257 @@ +/* +** Copyright (C) 2025 Dirk-Jan C. Binnema +** +** 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 +#include + +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(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(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(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("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(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(decode_scm, + func, 2)}; + const auto content_only{from_scm(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(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(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( + scm_foreign_object_ref(scm, 0)))); + }); + + mime_stream_port_type = make_mime_stream_port_type(); + + init_subrs(); +} diff --git a/scm/mu-scm-store.cc b/scm/mu-scm-store.cc index 05cdb912..17f6dd03 100644 --- a/scm/mu-scm-store.cc +++ b/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 { - return to_scm(to_store(store_scm, "mcount", 1).size()); +subr_cc_store_mcount(SCM store_scm) try { + 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(pattern_scm, "cfind", 2)}; - const auto personal{from_scm(personal_scm, "cfind", 3)}; - const auto after{from_scm_with_default(after_scm, 0, "cfind", 4)}; + const auto pattern{from_scm(pattern_scm, func, 2)}; + const auto personal{from_scm(personal_scm, func, 3)}; + 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)}; - const auto query{from_scm(query_scm, "mfind", 2)}; - const auto related(from_scm(related_scm, "mfind", 3)); - const auto skip_dups(from_scm(skip_dups_scm, "mfind", 4)); + constexpr auto func{"cc-store-mfind"}; + + const auto& store{to_store(store_scm, func, 1)}; + const auto query{from_scm(query_scm, func, 2)}; + const auto related(from_scm(related_scm, func, 3)); + const auto skip_dups(from_scm(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 reverse(from_scm(reverse_scm, "mfind", 6)); + const auto sort_field_id = to_sort_field_id(sort_field_scm, func, 5); + const auto reverse(from_scm(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*/, - reinterpret_cast(subr_mfind)); - scm_c_define_gsubr("store-mcount", 1/*req*/, 0/*opt*/, 0/*rst*/, - reinterpret_cast(subr_mcount)); - scm_c_define_gsubr("store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/, - reinterpret_cast(subr_cfind)); + scm_c_define_gsubr("cc-store-mfind", 7/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_store_mfind)); + scm_c_define_gsubr("cc-store-mcount", 1/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_store_mcount)); + scm_c_define_gsubr("cc-store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_store_cfind)); #pragma GCC diagnostic pop } diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index f82b666e..e45bcc89 100644 --- a/scm/mu-scm-test.scm +++ b/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) diff --git a/scm/mu-scm-types.hh b/scm/mu-scm-types.hh index 810b82df..d6e2babb 100644 --- a/scm/mu-scm-types.hh +++ b/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*/ diff --git a/scm/mu-scm.cc b/scm/mu-scm.cc index 2d3ebac4..9c42de29 100644 --- a/scm/mu-scm.cc +++ b/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 @@ -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); diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 497565a7..197796ba 100644 --- a/scm/mu-scm.scm +++ b/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 - - - mfind - mcount - cfind - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Mime-parts + + mime-part->alist + make-port + write-to-file +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Message - sexp + make-message date last-change @@ -75,14 +78,27 @@ body header + mime-parts + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; 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 has two slots: +;; partobj --> wraps a GMimePart* as a "foreign object" +;; alist --> alist with information about some MIME-part +(define-class () + (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-' with + 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-' with + 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 () + (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 from file at PATH." + (make #:object (cc-message-make path))) (define-method (plist (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 )) "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 - (message-object-make (path message)))) + (slot-set! message 'object (cc-message-make (path message)))) (slot-ref message 'object)) (define-method (find-field (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 )) "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 ) (field )) "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 )) + "Get the MIME-parts for this message. +This is a list of objects." + (let ((msgobj (object message))) + (map (lambda (mimepart-alist) + (make + #: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 - (store %default-store) - (related? #f) - (skip-dups? #f) - (sort-field 'date) - (reverse? #f) - (max-results #f)) + #:key + (store %default-store) + (related? #f) + (skip-dups? #f) + (sort-field 'date) + (reverse? #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 #: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. diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index 636bdc67..19bd0aae 100644 --- a/scm/mu-scm.texi +++ b/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 -has been extracted and store in the @t{mu} store (database). +A message represents the information about an e-mail message. @t{mu} gets this +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{} objects with @t{mfind} method, as -explained in @xref{Store}. In the following, we use some message-object @t{msg}, -e.g. +In many of the examples below we assume there is some @code{message} object, +e.g. as retrieved through: @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{} 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} -field. For instance: - +Each contact is an alist with at least an @code{email} and optionally a +@code{name} field. For instance: @lisp (to msg) => (((name . "Hannibal Smith") (email . "jhs@@example.com"))