├── .gitignore ├── AUTHORS ├── COPYING ├── COPYING-GPL-3 ├── Makefile ├── NEWS ├── README.md ├── bower.conf.sample ├── make_man ├── screenshots ├── bower_index.png ├── bower_thread.png ├── bower_thread2.png └── bower_thread3.png ├── src ├── .gitignore ├── Makefile ├── Mercury.options ├── Mercury.options.ncursesw ├── addressbook.m ├── async.m ├── base64.m ├── bower.m ├── byte_array.m ├── call_system.m ├── callout.m ├── char_util.m ├── color.m ├── compose.crypto.m ├── compose.m ├── config.m ├── copious_output.m ├── cord_util.m ├── crypto.m ├── curs.m ├── curs_signal.m ├── data.m ├── detect_mime_type.m ├── fold_lines.m ├── forward.m ├── gpgme.data.m ├── gpgme.encrypt.m ├── gpgme.invalid_key.m ├── gpgme.key.m ├── gpgme.key_array.m ├── gpgme.m ├── gpgme.sign.m ├── gpgme.signer.m ├── help.m ├── index_view.m ├── json.m ├── list_util.m ├── maildir.m ├── make_temp.m ├── make_utf8.m ├── make_version.sh ├── message_file.m ├── message_template.m ├── mime_type.m ├── notmuch_config.m ├── pager.m ├── pager_text.m ├── path_expand.m ├── pipe_to.m ├── poll_notify.m ├── process.m ├── prog_config.m ├── prog_options.m ├── quote_arg.m ├── quote_command.m ├── recall.m ├── regex.m ├── resend.m ├── rfc2045.m ├── rfc2047.decoder.m ├── rfc2047.encoder.m ├── rfc2047.m ├── rfc2231.m ├── rfc3986.m ├── rfc5234.m ├── rfc5322.m ├── rfc5322.parser.m ├── rfc5322.writer.m ├── rfc6068.m ├── sanitise.m ├── screen.m ├── scrollable.m ├── search_term.m ├── send_util.m ├── shell_word.m ├── signal.m ├── size_util.m ├── sleep.m ├── splitmix64.m ├── string_util.m ├── sys_util.m ├── tags.m ├── text_entry.m ├── thread_pager.m ├── time_util.m ├── uri.m ├── view_async.m ├── view_common.m ├── write_message.m └── xdg.m └── tests ├── Makefile ├── Mercury.options ├── runtest.sh ├── test_base64.m ├── test_fqdn.m ├── test_json.exp ├── test_json.m ├── test_process.exp ├── test_process.m ├── test_rfc2047.exp ├── test_rfc2047_decode.exp ├── test_rfc2047_decode.m ├── test_rfc2047_encode.exp ├── test_rfc2047_encode.m ├── test_rfc2231.exp ├── test_rfc2231.m ├── test_rfc3986.exp ├── test_rfc3986.m ├── test_rfc5322.exp ├── test_rfc5322.m ├── test_rfc6068.exp ├── test_rfc6068.m ├── test_search_term.exp ├── test_search_term.m ├── test_shell_word.exp ├── test_shell_word.inp └── test_shell_word.m /.gitignore: -------------------------------------------------------------------------------- 1 | *.[oa] 2 | *~ 3 | Mercury/ 4 | *.err 5 | *.mh 6 | tags 7 | bower.1 8 | bower 9 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Peter Wang 2 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | Bower is free software. 2 | 3 | You can redistribute it and/or modify it under the terms of the GNU 4 | General Public License as published by the Free Software Foundation, 5 | either version 3 of the License, or (at your option) any later 6 | version. 7 | 8 | This program is distributed in the hope that it will be useful, but 9 | WITHOUT ANY WARRANTY; without even the implied warranty of 10 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | General Public License for more details. 12 | 13 | You should have received a copy of the GNU General Public License 14 | along with this program, (in the COPYING-GPL-3 file in this 15 | directory). If not, see http://www.gnu.org/licenses/ 16 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | AWK = awk 2 | 3 | .PHONY: bower 4 | bower: 5 | @$(MAKE) -C src ../bower 6 | 7 | .PHONY: clean 8 | clean: 9 | rm -rf src/Mercury 10 | rm -f src/*.err src/*.mh src/bower bower bower.1 11 | 12 | .PHONY: man 13 | man: bower.1 14 | 15 | bower.1: README.md make_man 16 | $(AWK) -f make_man < README.md | \ 17 | pandoc -f markdown -t man --standalone \ 18 | -M title=bower -M section=1 -o bower.1 19 | -------------------------------------------------------------------------------- /make_man: -------------------------------------------------------------------------------- 1 | #!/usr/bin/awk -f 2 | 3 | BEGIN { 4 | output = 1; 5 | } 6 | 7 | /^See some.*screen shots/ { 8 | next; 9 | } 10 | 11 | /^Requirements$/ { 12 | output = 0; 13 | } 14 | 15 | /^Configuration$/ { 16 | output = 1; 17 | } 18 | 19 | output { 20 | print 21 | } 22 | -------------------------------------------------------------------------------- /screenshots/bower_index.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wangp/bower/d0019521c1323046b1280856373d166d3f0f94d5/screenshots/bower_index.png -------------------------------------------------------------------------------- /screenshots/bower_thread.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wangp/bower/d0019521c1323046b1280856373d166d3f0f94d5/screenshots/bower_thread.png -------------------------------------------------------------------------------- /screenshots/bower_thread2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wangp/bower/d0019521c1323046b1280856373d166d3f0f94d5/screenshots/bower_thread2.png -------------------------------------------------------------------------------- /screenshots/bower_thread3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wangp/bower/d0019521c1323046b1280856373d166d3f0f94d5/screenshots/bower_thread3.png -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | prog_version.m 2 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | MMC = mmc 2 | PARALLEL = -j $(shell nproc 2>/dev/null || echo 1) 3 | UNAME_S := $(shell uname -s) 4 | ifeq ($(UNAME_S),Darwin) 5 | LN_DEREF_FLAG := 6 | else 7 | LN_DEREF_FLAG := -L 8 | endif 9 | 10 | MMC_MAKE_FLAGS := 11 | ifdef WITH_NCURSESW_DIR 12 | MMC_MAKE_FLAGS := --options-file Mercury.options.ncursesw 13 | endif 14 | 15 | files = $(wildcard *.m) prog_version.m 16 | 17 | ../bower: bower 18 | @ln $(LN_DEREF_FLAG) -f bower ../bower 19 | 20 | bower: $(files) Mercury.options Mercury.options.ncursesw Mercury.params 21 | @$(MMC) --make $(PARALLEL) $(MMC_MAKE_FLAGS) $@ && touch $@ 22 | 23 | prog_version.m: ../NEWS make_version.sh 24 | @./make_version.sh 25 | 26 | Mercury.params: 27 | 28 | tags: $(files) 29 | @mtags $(files) 30 | -------------------------------------------------------------------------------- /src/Mercury.options: -------------------------------------------------------------------------------- 1 | # Default target for mmc --make. 2 | MAIN_TARGET = bower 3 | 4 | # Default grade. You can override this in the environment. 5 | GRADE = hlc.gc 6 | MCFLAGS += --grade $(GRADE) 7 | 8 | # Link with curses. 9 | MLLIBS-bower += -lncursesw -lpanelw 10 | 11 | # Build with gpgme. 12 | CFLAGS += -D_FILE_OFFSET_BITS=64 13 | MLLIBS-bower += -lgpgme 14 | 15 | # Statically link to Mercury libraries. 16 | MCFLAGS-bower += --mercury-linkage static 17 | 18 | # General optimisation flags. 19 | MCFLAGS += --optimise-constructor-last-call 20 | 21 | # Don't specify to the C compiler that the ANSI dialect of C should be used. 22 | # --ansi-c practically does nothing after Mercury commit 61df175 23 | # so this only relaxes older Mercury compilers. 24 | MCFLAGS += --no-ansi-c 25 | 26 | # Module-specific options. 27 | MCFLAGS-json += --exec-trace-tail-rec 28 | MCFLAGS-make_utf8 += --exec-trace-tail-rec 29 | MCFLAGS-pager += --exec-trace-tail-rec 30 | CFLAGS-async += -D_POSIX_SOURCE 31 | CFLAGS-curs += -D_XOPEN_SOURCE_EXTENDED 32 | CFLAGS-signal += -D_POSIX_SOURCE 33 | CFLAGS-string_util += -D_GNU_SOURCE 34 | CFLAGS-time_util += -D_GNU_SOURCE 35 | 36 | # Add workspace-specific options here. 37 | -include Mercury.params 38 | -------------------------------------------------------------------------------- /src/Mercury.options.ncursesw: -------------------------------------------------------------------------------- 1 | MCFLAGS += --cflag -DWITH_NCURSESW_DIR 2 | MLLIBS-bower += -ltinfow 3 | -------------------------------------------------------------------------------- /src/addressbook.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2012 Peter Wang 3 | 4 | :- module addressbook. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module list. 9 | :- import_module maybe. 10 | 11 | :- import_module notmuch_config. 12 | :- import_module prog_config. 13 | :- import_module screen. 14 | 15 | %-----------------------------------------------------------------------------% 16 | 17 | :- func addressbook_section = string. 18 | 19 | :- pred search_addressbook(notmuch_config::in, string::in, string::out) 20 | is semidet. 21 | 22 | :- pred search_notmuch_address(prog_config::in, string::in, list(string)::out, 23 | io::di, io::uo) is det. 24 | 25 | :- pred search_notmuch_address_top(prog_config::in, string::in, 26 | maybe(string)::out, io::di, io::uo) is det. 27 | 28 | :- pred prompt_addressbook_add(prog_config::in, screen::in, string::in, 29 | io::di, io::uo) is det. 30 | 31 | %-----------------------------------------------------------------------------% 32 | %-----------------------------------------------------------------------------% 33 | 34 | :- implementation. 35 | 36 | :- import_module char. 37 | :- import_module int. 38 | :- import_module pair. 39 | :- import_module string. 40 | 41 | :- import_module callout. 42 | :- import_module list_util. 43 | :- import_module quote_command. 44 | :- import_module text_entry. % XXX cyclic 45 | 46 | %-----------------------------------------------------------------------------% 47 | 48 | addressbook_section = "bower:addressbook". 49 | 50 | %-----------------------------------------------------------------------------% 51 | 52 | :- pred is_alias_char(char::in) is semidet. 53 | 54 | is_alias_char(C) :- 55 | ( char.is_alnum_or_underscore(C) 56 | ; C = ('-') 57 | ; C = ('+') 58 | ; C = ('.') 59 | ; 60 | % Allow all non-ASCII. I suppose we should check for Unicode 61 | % whitespace but it should not matter. 62 | char.to_int(C, Int), 63 | Int > 0x7f 64 | ). 65 | 66 | %-----------------------------------------------------------------------------% 67 | 68 | search_addressbook(NotmuchConfig, Alias, Expansion) :- 69 | string.all_match(is_alias_char, Alias), 70 | search(NotmuchConfig, addressbook_section, Alias, Expansion). 71 | 72 | %-----------------------------------------------------------------------------% 73 | 74 | search_notmuch_address(Config, SearchString, NameAddrs, !IO) :- 75 | ( string.prefix(SearchString, "/") -> 76 | % Avoid notmuch-address interpreting the string as an incomplete regex. 77 | NameAddrs = [] 78 | ; 79 | run_notmuch(Config, 80 | [ 81 | "address", "--format=json", "--output=sender", "--output=count", 82 | "--deduplicate=address", "date:1y..now", 83 | "from:" ++ SearchString 84 | ], 85 | no_suspend_curses, 86 | parse_address_count_list, Res, !IO), 87 | ( 88 | Res = ok(Pairs0), 89 | sort(descending, Pairs0, Pairs), 90 | map(snd, Pairs, NameAddrs) 91 | ; 92 | Res = error(_), 93 | NameAddrs = [] 94 | ) 95 | ). 96 | 97 | search_notmuch_address_top(Config, SearchString, MaybeFound, !IO) :- 98 | search_notmuch_address(Config, SearchString, NameAddrs, !IO), 99 | ( 100 | NameAddrs = [Top | _], 101 | MaybeFound = yes(Top) 102 | ; 103 | NameAddrs = [], 104 | MaybeFound = no 105 | ). 106 | 107 | :- pred descending(T::in, T::in, comparison_result::out) is det. 108 | 109 | descending(A, B, R) :- 110 | compare(R, B, A). 111 | 112 | %-----------------------------------------------------------------------------% 113 | 114 | prompt_addressbook_add(Config, Screen, Address0, !IO) :- 115 | History0 = init_history, 116 | text_entry_initial(Screen, "Address: ", History0, Address0, complete_none, 117 | ReturnAddress, !IO), 118 | ( 119 | ReturnAddress = yes(Address), 120 | ( Address = "" -> 121 | true 122 | ; 123 | prompt_addressbook_add_2(Config, Screen, Address, !IO) 124 | ) 125 | ; 126 | ReturnAddress = no 127 | ). 128 | 129 | :- pred prompt_addressbook_add_2(prog_config::in, screen::in, string::in, 130 | io::di, io::uo) is det. 131 | 132 | prompt_addressbook_add_2(Config, Screen, Address, !IO) :- 133 | History0 = init_history, 134 | text_entry_initial(Screen, "Alias as: ", History0, suggest_alias(Address), 135 | complete_config_key(Config, addressbook_section), ReturnAlias, !IO), 136 | ( 137 | ReturnAlias = yes(Alias), 138 | ( Alias = "" -> 139 | true 140 | ; string.all_match(is_alias_char, Alias) -> 141 | do_addressbook_add(Config, Alias, Address, Res, !IO), 142 | ( 143 | Res = ok, 144 | update_message_immed(Screen, set_info("Alias added."), !IO) 145 | ; 146 | Res = error(Error), 147 | update_message_immed(Screen, set_warning(Error), !IO) 148 | ) 149 | ; 150 | update_message_immed(Screen, set_warning("Invalid alias."), !IO) 151 | ) 152 | ; 153 | ReturnAlias = no 154 | ). 155 | 156 | :- func suggest_alias(string) = string. 157 | 158 | suggest_alias(Address) = Alias :- 159 | ( string.sub_string_search(Address, "<", Index) -> 160 | string.between(Address, Index + 1, length(Address), SubString), 161 | string.to_char_list(SubString, Chars0) 162 | ; 163 | string.to_char_list(Address, Chars0) 164 | ), 165 | list_util.take_while(is_alias_char, Chars0, Chars, _), 166 | string.from_char_list(Chars, Alias). 167 | 168 | :- pred do_addressbook_add(prog_config::in, string::in, string::in, 169 | maybe_error::out, io::di, io::uo) is det. 170 | 171 | do_addressbook_add(Config, Alias, Address, Res, !IO) :- 172 | get_notmuch_command(Config, Notmuch), 173 | Key = addressbook_section ++ "." ++ Alias, 174 | make_quoted_command(Notmuch, ["config", "set", Key, Address], 175 | redirect_input("/dev/null"), redirect_output("/dev/null"), Command), 176 | io.call_system(Command, CallRes, !IO), 177 | ( 178 | CallRes = ok(ExitStatus), 179 | ( ExitStatus = 0 -> 180 | Res = ok 181 | ; 182 | string.format("notmuch returned exit status %d", 183 | [i(ExitStatus)], Warning), 184 | Res = error(Warning) 185 | ) 186 | ; 187 | CallRes = error(Error), 188 | Notmuch = command_prefix(shell_quoted(NotmuchString), _), 189 | string.append_list(["Error running ", NotmuchString, ": ", 190 | io.error_message(Error)], Warning), 191 | Res = error(Warning) 192 | ). 193 | 194 | %-----------------------------------------------------------------------------% 195 | % vim: ft=mercury ts=4 sts=4 sw=4 et 196 | -------------------------------------------------------------------------------- /src/bower.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module bower. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- pred main(io::di, io::uo) is cc_multi. 10 | 11 | %-----------------------------------------------------------------------------% 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- implementation. 15 | 16 | :- import_module bool. 17 | :- import_module list. 18 | :- import_module maybe. 19 | :- import_module string. 20 | 21 | :- import_module async. 22 | :- import_module compose. 23 | :- import_module crypto. 24 | :- import_module help. 25 | :- import_module index_view. 26 | :- import_module notmuch_config. 27 | :- import_module prog_config. 28 | :- import_module prog_options. 29 | :- import_module prog_version. 30 | :- import_module rfc6068. 31 | :- import_module screen. 32 | :- import_module search_term. 33 | :- import_module signal. 34 | :- import_module view_common. 35 | 36 | :- use_module curs. 37 | :- use_module curs_signal. 38 | 39 | :- type entry_point 40 | ---> index_view_default_terms 41 | ; index_view_terms(string) 42 | ; compose(string). 43 | 44 | %-----------------------------------------------------------------------------% 45 | 46 | :- pragma foreign_decl("C", local, 47 | " 48 | #include 49 | "). 50 | 51 | %-----------------------------------------------------------------------------% 52 | 53 | main(!IO) :- 54 | setlocale(!IO), 55 | io.command_line_arguments(Args, !IO), 56 | parse_options(Args, NonOptionArgs, OptionsRes), 57 | ( 58 | OptionsRes = ok(Options), 59 | ( Options ^ help = yes -> 60 | io.progname_base("bower", ProgName, !IO), 61 | print_help(ProgName, !IO) 62 | ; Options ^ version = yes -> 63 | io.write_string(version_string, !IO), 64 | io.nl(!IO) 65 | ; 66 | main_1(NonOptionArgs, !IO) 67 | ) 68 | ; 69 | OptionsRes = error(Error), 70 | io.stderr_stream(Stream, !IO), 71 | print_error(Stream, Error, !IO), 72 | io.set_exit_status(1, !IO) 73 | ). 74 | 75 | :- pred main_1(list(string)::in, io::di, io::uo) is cc_multi. 76 | 77 | main_1(Args, !IO) :- 78 | ( 79 | Args = [FirstArg | RestArgs], 80 | is_mailto_uri(FirstArg) 81 | -> 82 | ( 83 | RestArgs = [], 84 | ( parse_mailto_uri(FirstArg, _Headers) -> 85 | main_2(compose(FirstArg), !IO) 86 | ; 87 | io.stderr_stream(Stream, !IO), 88 | print_error(Stream, "Error parsing mailto: argument.", !IO), 89 | io.set_exit_status(1, !IO) 90 | ) 91 | ; 92 | RestArgs = [_ | _], 93 | io.stderr_stream(Stream, !IO), 94 | print_error(Stream, 95 | "Unexpected arguments following mailto: argument.", !IO), 96 | io.set_exit_status(1, !IO) 97 | ) 98 | ; 99 | ( 100 | Args = [], 101 | EntryPoint = index_view_default_terms 102 | ; 103 | Args = [_ | _], 104 | Terms = string.join_list(" ", Args), 105 | EntryPoint = index_view_terms(Terms) 106 | ), 107 | main_2(EntryPoint, !IO) 108 | ). 109 | 110 | :- pred main_2(entry_point::in, io::di, io::uo) is cc_multi. 111 | 112 | main_2(EntryPoint, !IO) :- 113 | load_prog_config(ResConfig, !IO), 114 | ( 115 | ResConfig = ok(Config, NotmuchConfig), 116 | init_crypto(ResCrypto, !IO), 117 | ( 118 | ResCrypto = ok(Crypto), 119 | main_3(Config, NotmuchConfig, Crypto, EntryPoint, !IO), 120 | shutdown_crypto(Crypto, !IO) 121 | ; 122 | ResCrypto = error(Error), 123 | io.stderr_stream(Stream, !IO), 124 | io.write_string(Stream, 125 | "Error initialising crypto support:\n", !IO), 126 | print_error(Stream, Error, !IO), 127 | io.set_exit_status(1, !IO) 128 | ) 129 | ; 130 | ResConfig = errors(Errors), 131 | io.stderr_stream(Stream, !IO), 132 | io.write_string(Stream, "Errors in configuration file:\n", !IO), 133 | list.foldl(print_error(Stream), Errors, !IO), 134 | io.set_exit_status(1, !IO) 135 | ). 136 | 137 | :- pred main_3(prog_config::in, notmuch_config::in, crypto::in, 138 | entry_point::in, io::di, io::uo) is cc_multi. 139 | 140 | main_3(Config, NotmuchConfig, Crypto, EntryPoint, !IO) :- 141 | curs_signal.install_suspend_handlers(!IO), 142 | curs_signal.install_exit_handlers(!IO), 143 | signal.ignore_sigint(no, !IO), 144 | async.install_sigchld_handler(!IO), 145 | curs.start(!IO), 146 | ( try [io(!IO)] 147 | main_4(Config, NotmuchConfig, Crypto, EntryPoint, MessageUpdate, !IO) 148 | then 149 | curs.stop(!IO) 150 | catch sigint_received -> 151 | curs.stop(!IO), 152 | kill_self_with_sigint(!IO) 153 | ), 154 | io.output_stream(Stream, !IO), 155 | print_message_update(Stream, MessageUpdate, !IO). 156 | 157 | :- pred main_4(prog_config::in, notmuch_config::in, crypto::in, 158 | entry_point::in, message_update::out, io::di, io::uo) is det. 159 | 160 | main_4(Config, NotmuchConfig, Crypto, EntryPoint, MessageUpdate, !IO) :- 161 | init_common_history(Config, CommonHistory0), 162 | create_screen(status_attrs(Config), Screen, !IO), 163 | draw_status_bar(Screen, !IO), 164 | curs.refresh(!IO), 165 | ( 166 | ( 167 | EntryPoint = index_view_default_terms, 168 | get_default_search_terms(NotmuchConfig, Terms) 169 | ; 170 | EntryPoint = index_view_terms(Terms) 171 | ), 172 | open_index(Config, NotmuchConfig, Crypto, Screen, Terms, 173 | CommonHistory0, !IO), 174 | MessageUpdate = no_change 175 | ; 176 | EntryPoint = compose(MailtoArg), 177 | start_compose(Config, Crypto, Screen, yes(MailtoArg), Transition, 178 | CommonHistory0, _CommonHistory, !IO), 179 | Transition = screen_transition(_Sent, MessageUpdate) 180 | ). 181 | 182 | :- pred setlocale(io::di, io::uo) is det. 183 | 184 | :- pragma foreign_proc("C", 185 | setlocale(IO0::di, IO::uo), 186 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 187 | may_not_duplicate], 188 | " 189 | setlocale(LC_ALL, """"); 190 | IO = IO0; 191 | "). 192 | 193 | :- pred print_error(io.output_stream::in, string::in, io::di, io::uo) is det. 194 | 195 | print_error(Stream, Error, !IO) :- 196 | io.write_string(Stream, Error, !IO), 197 | io.nl(Stream, !IO). 198 | 199 | :- pred print_message_update(io.output_stream::in, message_update::in, 200 | io::di, io::uo) is det. 201 | 202 | print_message_update(Stream, MessageUpdate, !IO) :- 203 | ( 204 | MessageUpdate = no_change 205 | ; 206 | MessageUpdate = clear_message 207 | ; 208 | ( MessageUpdate = set_info(Message) 209 | ; MessageUpdate = set_warning(Message) 210 | ; MessageUpdate = set_prompt(Message) 211 | ), 212 | io.write_string(Stream, Message, !IO), 213 | io.nl(Stream, !IO) 214 | ). 215 | 216 | %-----------------------------------------------------------------------------% 217 | % vim: ft=mercury ts=4 sts=4 sw=4 et 218 | -------------------------------------------------------------------------------- /src/call_system.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2013 Peter Wang 3 | 4 | :- module call_system. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module maybe. 9 | 10 | :- import_module process. 11 | 12 | % Execute a shell command as a subprocess, read the contents of the 13 | % standard output as a string. The output is expected to be UTF-8 encoded; 14 | % the provisions for wrong encodings are given by make_utf8_string. 15 | % 16 | % This started as a replacement for popen() that would block SIGWINCH in 17 | % the child. Ideally we would not invoke the shell in most cases. 18 | % 19 | :- pred call_system_capture_stdout(string::in, spawn_env::in, maybe(int)::in, 20 | io.res(string)::out, io::di, io::uo) is det. 21 | 22 | % Execute a shell command as a subprocess, and write a string to the 23 | % standard input of the subprocess. 24 | % 25 | :- pred call_system_write_to_stdin(string::in, spawn_env::in, string::in, 26 | io.res::out, io::di, io::uo) is det. 27 | 28 | % As above, but concurrently writes to the standard input of the subprocess 29 | % and reads from the standard output of the subprocess. 30 | % 31 | :- pred call_system_filter(string::in, spawn_env::in, string::in, 32 | maybe(int)::in, io.res(string)::out, io::di, io::uo) is det. 33 | 34 | %-----------------------------------------------------------------------------% 35 | %-----------------------------------------------------------------------------% 36 | 37 | :- implementation. 38 | 39 | :- import_module list. 40 | :- import_module string. 41 | 42 | %-----------------------------------------------------------------------------% 43 | 44 | call_system_capture_stdout(Command, SpawnEnv, ErrorLimit, Res, !IO) :- 45 | posix_spawn_get_stdout("/bin/sh", ["-c", Command], SpawnEnv, 46 | SpawnRes, !IO), 47 | ( 48 | SpawnRes = ok({Pid, PipeRead}), 49 | drain_pipe(PipeRead, DrainRes, Buffers, !IO), 50 | close_pipe_read(PipeRead, !IO), 51 | do_wait(Pid, no, WaitRes, !IO), 52 | ( 53 | WaitRes = ok, 54 | ( 55 | DrainRes = ok, 56 | ( make_utf8_string(ErrorLimit, Buffers, String) -> 57 | Res = ok(String) 58 | ; 59 | Res = error(io.make_io_error("not UTF-8 text")) 60 | ) 61 | ; 62 | DrainRes = error(Error), 63 | Res = error(Error) 64 | ) 65 | ; 66 | WaitRes = error(Error), 67 | Res = error(Error) 68 | ) 69 | ; 70 | SpawnRes = error(Error), 71 | Res = error(Error) 72 | ). 73 | 74 | %-----------------------------------------------------------------------------% 75 | 76 | call_system_write_to_stdin(Command, SpawnEnv, Input, Res, !IO) :- 77 | posix_spawn_get_stdin("/bin/sh", ["-c", Command], SpawnEnv, 78 | SpawnRes, !IO), 79 | ( 80 | SpawnRes = ok({Pid, PipeWrite}), 81 | write_string_to_pipe(PipeWrite, Input, WriteRes, !IO), 82 | close_pipe_write(PipeWrite, !IO), 83 | do_wait(Pid, no, WaitRes, !IO), 84 | ( 85 | WaitRes = ok, 86 | ( 87 | WriteRes = ok, 88 | Res = ok 89 | ; 90 | WriteRes = partial_write(_), 91 | Res = error(io.make_io_error("incomplete write to pipe")) 92 | ; 93 | WriteRes = error(Error), 94 | Res = error(Error) 95 | ) 96 | ; 97 | WaitRes = error(Error), 98 | Res = error(Error) 99 | ) 100 | ; 101 | SpawnRes = error(Error), 102 | Res = error(Error) 103 | ). 104 | 105 | %-----------------------------------------------------------------------------% 106 | 107 | call_system_filter(Command, SpawnEnv, Input, ErrorLimit, Res, !IO) :- 108 | posix_spawn_get_stdin_stdout("/bin/sh", ["-c", Command], SpawnEnv, 109 | SpawnRes, !IO), 110 | ( 111 | SpawnRes = ok({Pid, PipeWrite, PipeRead}), 112 | write_and_read_concurrently_and_close_both(PipeWrite, Input, 113 | PipeRead, WriteAndReadRes, Buffers, !IO), 114 | % Both PipeWrite and PipeRead are closed at this point. 115 | ( 116 | WriteAndReadRes = ok, 117 | do_wait(Pid, no, WaitRes, !IO) 118 | ; 119 | WriteAndReadRes = error(_Error), 120 | kill(Pid, sigterm, KillRes, !IO), 121 | ( 122 | KillRes = ok, 123 | do_wait(Pid, yes(sigterm), WaitRes, !IO) 124 | ; 125 | KillRes = error(KillError), 126 | % What can we do if kill fails? 127 | WaitRes = error(KillError) 128 | ) 129 | ), 130 | ( 131 | WaitRes = ok, 132 | ( 133 | WriteAndReadRes = ok, 134 | ( make_utf8_string(ErrorLimit, Buffers, String) -> 135 | Res = ok(String) 136 | ; 137 | Res = error(io.make_io_error("not UTF-8 text")) 138 | ) 139 | ; 140 | WriteAndReadRes = error(Error), 141 | Res = error(Error) 142 | ) 143 | ; 144 | WaitRes = error(Error), 145 | Res = error(Error) 146 | ) 147 | ; 148 | SpawnRes = error(Error), 149 | Res = error(Error) 150 | ). 151 | 152 | %-----------------------------------------------------------------------------% 153 | 154 | :- pred do_wait(pid::in, maybe(int)::in, io.res::out, io::di, io::uo) is det. 155 | 156 | do_wait(Pid, ExpectSignal, Res, !IO) :- 157 | wait_pid(Pid, blocking, WaitRes, !IO), 158 | ( 159 | WaitRes = no_hang, 160 | % Should not occur. 161 | Res = error(io.make_io_error("process not finished")) 162 | ; 163 | WaitRes = child_exit(ExitStatus), 164 | ( ExitStatus = 0 -> 165 | Res = ok 166 | ; 167 | Msg = "process returned with exit code " ++ 168 | string.from_int(ExitStatus), 169 | Res = error(io.make_io_error(Msg)) 170 | ) 171 | ; 172 | WaitRes = child_signalled(Signal), 173 | ( ExpectSignal = yes(Signal) -> 174 | Res = ok 175 | ; 176 | Msg = "process received signal " ++ string.from_int(Signal), 177 | Res = error(io.make_io_error(Msg)) 178 | ) 179 | ; 180 | WaitRes = child_abnormal_exit, 181 | Msg = "process exited abnormally", 182 | Res = error(io.make_io_error(Msg)) 183 | ; 184 | WaitRes = error(Error), 185 | Res = error(Error) 186 | ). 187 | 188 | %-----------------------------------------------------------------------------% 189 | % vim: ft=mercury ts=4 sts=4 sw=4 et 190 | -------------------------------------------------------------------------------- /src/char_util.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2020 Peter Wang 3 | 4 | :- module char_util. 5 | :- interface. 6 | 7 | :- import_module char. 8 | 9 | :- pred is_printable(char::in) is semidet. 10 | 11 | %-----------------------------------------------------------------------------% 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- implementation. 15 | 16 | :- pragma foreign_proc("C", 17 | is_printable(Char::in), 18 | [will_not_call_mercury, promise_pure, thread_safe], 19 | " 20 | /* The argument to isprint must be representable by an unsigned char 21 | * or equal to EOF. 22 | */ 23 | SUCCESS_INDICATOR = (Char >= 0x80) || isprint(Char); 24 | "). 25 | 26 | %-----------------------------------------------------------------------------% 27 | % vim: ft=mercury ts=4 sts=4 sw=4 et 28 | -------------------------------------------------------------------------------- /src/config.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module config. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module map. 9 | 10 | :- type config == map(section, map(string, string)). 11 | 12 | :- type section == string. 13 | 14 | :- func init_config = config. 15 | 16 | :- pred load_config_file(string::in, io.res(config)::out, io::di, io::uo) 17 | is det. 18 | 19 | :- pred search_config(config::in, section::in, string::in, string::out) 20 | is semidet. 21 | 22 | %-----------------------------------------------------------------------------% 23 | %-----------------------------------------------------------------------------% 24 | 25 | :- implementation. 26 | 27 | :- import_module int. 28 | :- import_module string. 29 | 30 | %-----------------------------------------------------------------------------% 31 | 32 | init_config = map.init. 33 | 34 | load_config_file(FileName, Res, !IO) :- 35 | io.open_input(FileName, OpenRes, !IO), 36 | ( 37 | OpenRes = ok(Stream), 38 | load_config_stream(Stream, "", Res0, map.init, Config, !IO), 39 | io.close_input(Stream, !IO), 40 | ( 41 | Res0 = ok, 42 | Res = ok(Config) 43 | ; 44 | Res0 = error(Error), 45 | Res = error(Error) 46 | ) 47 | ; 48 | OpenRes = error(Error), 49 | Res = error(Error) 50 | ). 51 | 52 | :- pred load_config_stream(io.input_stream::in, section::in, io.res::out, 53 | config::in, config::out, io::di, io::uo) is det. 54 | 55 | load_config_stream(Stream, Section0, Res, !Config, !IO) :- 56 | io.read_line_as_string(Stream, ReadRes, !IO), 57 | ( 58 | ReadRes = ok(Line0), 59 | Line = string.strip(Line0), 60 | ( Line = "" -> 61 | Section = Section0 62 | ; 63 | parse_line(Line, Section0, Section, !Config) 64 | ), 65 | load_config_stream(Stream, Section, Res, !Config, !IO) 66 | ; 67 | ReadRes = eof, 68 | Res = ok 69 | ; 70 | ReadRes = error(Error), 71 | Res = error(Error) 72 | ). 73 | 74 | :- pred parse_line(string::in, section::in, section::out, 75 | config::in, config::out) is det. 76 | 77 | parse_line(Line, !Section, !Config) :- 78 | string.unsafe_index(Line, 0, FirstChar), 79 | ( 80 | ( FirstChar = ('#') 81 | ; FirstChar = (';') 82 | ) 83 | -> 84 | % Comment line. 85 | true 86 | ; FirstChar = ('[') -> 87 | ( string.sub_string_search_start(Line, "]", 1, CloseIndex) -> 88 | % Everything after the closing bracket is ignored. 89 | string.between(Line, 1, CloseIndex, !:Section) 90 | ; 91 | % Invalid line. 92 | true 93 | ) 94 | ; string.sub_string_search(Line, "=", EqIndex) -> 95 | End = string.count_code_units(Line), 96 | string.between(Line, 0, EqIndex, Left), 97 | string.between(Line, EqIndex + 1, End, Right), 98 | Key = string.rstrip(Left), 99 | Value = string.lstrip(Right), 100 | ( map.search(!.Config, !.Section, Map0) -> 101 | map.set(Key, Value, Map0, Map), 102 | map.det_update(!.Section, Map, !Config) 103 | ; 104 | Map = map.singleton(Key, Value), 105 | map.det_insert(!.Section, Map, !Config) 106 | ) 107 | ; 108 | % Invalid line. 109 | true 110 | ). 111 | 112 | search_config(Config, Section, Key, Value) :- 113 | map.search(Config, Section, SectionMap), 114 | map.search(SectionMap, Key, Value). 115 | 116 | %-----------------------------------------------------------------------------% 117 | % vim: ft=mercury ts=4 sts=4 sw=4 et 118 | -------------------------------------------------------------------------------- /src/copious_output.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module copious_output. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module maybe. 9 | 10 | :- import_module data. 11 | :- import_module mime_type. 12 | :- import_module prog_config. 13 | :- import_module quote_command. 14 | 15 | :- pred expand_part(prog_config::in, message_id::in, part_id::in, mime_type::in, 16 | maybe(content_charset)::in, maybe(command_prefix)::in, 17 | maybe_error(string)::out, io::di, io::uo) is det. 18 | 19 | :- pred filter_text_part(command_prefix::in, mime_type::in, 20 | maybe(content_charset)::in, string::in, maybe_error(string)::out, 21 | io::di, io::uo) is det. 22 | 23 | %-----------------------------------------------------------------------------% 24 | %-----------------------------------------------------------------------------% 25 | 26 | :- implementation. 27 | 28 | :- import_module list. 29 | :- import_module string. 30 | 31 | :- import_module call_system. 32 | :- import_module process. 33 | 34 | %-----------------------------------------------------------------------------% 35 | 36 | expand_part(ProgConfig, MessageId, PartId, ContentType, MaybeContentCharset, 37 | MaybeFilterCommand, Res, !IO) :- 38 | get_notmuch_command(ProgConfig, Notmuch), 39 | make_quoted_command(Notmuch, [ 40 | "show", "--format=raw", part_id_to_part_option(PartId), 41 | message_id_to_search_term(MessageId) 42 | ], redirect_input("/dev/null"), no_redirect, ShowCommand), 43 | ( 44 | MaybeFilterCommand = yes(Filter), 45 | make_quoted_command(Filter, [], no_redirect, no_redirect, 46 | FilterCommand), 47 | Command = ShowCommand ++ " | " ++ FilterCommand 48 | ; 49 | MaybeFilterCommand = no, 50 | Command = ShowCommand 51 | ), 52 | % The notmuch command will inherit these environment variables as well, 53 | % which is not really intended but also not problematic. 54 | make_part_spawn_env(ContentType, MaybeContentCharset, SpawnEnv), 55 | ErrorLimit = yes(100), 56 | % If decryption is enabled then we should run curs.pause 57 | % in case pinentry-curses is called. 58 | call_system_capture_stdout(Command, SpawnEnv, ErrorLimit, CallRes, !IO), 59 | ( 60 | CallRes = ok(Output), 61 | Res = ok(Output) 62 | ; 63 | CallRes = error(Error), 64 | Res = error(io.error_message(Error)) 65 | ). 66 | 67 | %-----------------------------------------------------------------------------% 68 | 69 | filter_text_part(CommandPrefix, ContentType, MaybeContentCharset, Input, Res, 70 | !IO) :- 71 | % We don't really need to invoke the shell but this is easier for now. 72 | make_quoted_command(CommandPrefix, [], no_redirect, no_redirect, Command), 73 | make_part_spawn_env(ContentType, MaybeContentCharset, SpawnEnv), 74 | ErrorLimit = yes(100), 75 | call_system_filter(Command, SpawnEnv, Input, ErrorLimit, CallRes, !IO), 76 | ( 77 | CallRes = ok(Output), 78 | Res = ok(Output) 79 | ; 80 | CallRes = error(Error), 81 | Res = error(io.error_message(Error)) 82 | ). 83 | 84 | %-----------------------------------------------------------------------------% 85 | 86 | :- pred make_part_spawn_env(mime_type::in, maybe(content_charset)::in, 87 | spawn_env::out) is det. 88 | 89 | make_part_spawn_env(ContentType, MaybeContentCharset, SpawnEnv) :- 90 | VarContentType = 91 | set_var("PART_CONTENT_TYPE", mime_type.to_string(ContentType)), 92 | ( 93 | MaybeContentCharset = yes(content_charset(Charset)), 94 | VarCharset = set_var("PART_CHARSET", Charset) 95 | ; 96 | MaybeContentCharset = no, 97 | VarCharset = delete_var("PART_CHARSET") 98 | ), 99 | SpawnEnv = environ([ 100 | VarContentType, 101 | VarCharset 102 | ]). 103 | 104 | %-----------------------------------------------------------------------------% 105 | % vim: ft=mercury ts=4 sts=4 sw=4 et 106 | -------------------------------------------------------------------------------- /src/cord_util.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2016 Peter Wang 3 | 4 | :- module cord_util. 5 | :- interface. 6 | 7 | :- import_module cord. 8 | 9 | % Also in cord.m from 2016-06-08 10 | % 11 | :- pred snoc(T::in, cord(T)::in, cord(T)::out) is det. 12 | 13 | %-----------------------------------------------------------------------------% 14 | %-----------------------------------------------------------------------------% 15 | 16 | :- implementation. 17 | 18 | snoc(X, C, snoc(C, X)). 19 | 20 | %-----------------------------------------------------------------------------% 21 | % vim: ft=mercury ts=4 sts=4 sw=4 et 22 | -------------------------------------------------------------------------------- /src/crypto.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module crypto. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module maybe. 9 | 10 | :- import_module gpgme. 11 | 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- type crypto == gpgme.ctx. 15 | 16 | :- pred init_crypto(maybe_error(crypto)::out, io::di, io::uo) is det. 17 | 18 | :- pred shutdown_crypto(crypto::in, io::di, io::uo) is det. 19 | 20 | %-----------------------------------------------------------------------------% 21 | %-----------------------------------------------------------------------------% 22 | 23 | :- implementation. 24 | 25 | init_crypto(Res, !IO) :- 26 | gpgme_init(!IO), 27 | gpgme_engine_check_version(openpgp, ResGpgme, !IO), 28 | ( 29 | ResGpgme = ok, 30 | gpgme_new(ResContext, !IO), 31 | ( 32 | ResContext = ok(Context), 33 | gpgme_set_protocol(Context, openpgp, ResProto, !IO), 34 | ( 35 | ResProto = ok, 36 | gpgme_set_armor(Context, ascii_armor, !IO), 37 | Res = ok(Context) 38 | ; 39 | ResProto = error(Error), 40 | shutdown_crypto(Context, !IO), 41 | Res = error(Error) 42 | ) 43 | ; 44 | ResContext = error(Error), 45 | Res = error(Error) 46 | ) 47 | ; 48 | ResGpgme = error(Error), 49 | Res = error(Error) 50 | ). 51 | 52 | shutdown_crypto(Context, !IO) :- 53 | gpgme_release(Context, !IO). 54 | 55 | %-----------------------------------------------------------------------------% 56 | % vim: ft=mercury ts=4 sts=4 sw=4 et 57 | -------------------------------------------------------------------------------- /src/curs_signal.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2019 Peter Wang 3 | 4 | :- module curs_signal. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- pred install_suspend_handlers(io::di, io::uo) is det. 10 | 11 | :- pred install_exit_handlers(io::di, io::uo) is det. 12 | 13 | %-----------------------------------------------------------------------------% 14 | %-----------------------------------------------------------------------------% 15 | 16 | :- implementation. 17 | 18 | :- pragma foreign_decl("C", local, " 19 | #include 20 | #include 21 | 22 | static void curs_signal_handler(int sig); 23 | static void curs_exit_handler(int sig); 24 | "). 25 | 26 | :- pragma foreign_code("C", " 27 | 28 | /* Inspired by mutt... */ 29 | 30 | static bool isendwin_state = FALSE; 31 | 32 | static void curs_signal_handler(int sig) 33 | { 34 | int save_errno = errno; 35 | 36 | switch (sig) { 37 | case SIGTSTP: 38 | isendwin_state = isendwin(); 39 | curs_set(1); 40 | if (!isendwin_state) { 41 | endwin(); 42 | } 43 | kill(0, SIGSTOP); 44 | /* fallthrough */ 45 | 46 | case SIGCONT: 47 | if (!isendwin_state) { 48 | refresh(); 49 | } 50 | /* We never hide the cursor so no need to restore */ 51 | /* a hidden cursor state. */ 52 | break; 53 | } 54 | 55 | errno = save_errno; 56 | } 57 | 58 | static void curs_exit_handler(int sig) 59 | { 60 | curs_set(1); 61 | endwin(); /* just to be safe */ 62 | exit(128 + sig); 63 | } 64 | "). 65 | 66 | :- pragma foreign_proc("C", 67 | install_suspend_handlers(_IO0::di, _IO::uo), 68 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 69 | may_not_duplicate], 70 | " 71 | struct sigaction act; 72 | 73 | act.sa_handler = curs_signal_handler; 74 | sigemptyset(&act.sa_mask); 75 | sigaddset(&act.sa_mask, SIGTSTP); 76 | act.sa_flags = 0; 77 | 78 | #ifdef SA_RESTART 79 | act.sa_flags |= SA_RESTART; 80 | #endif 81 | 82 | sigaction(SIGCONT, &act, NULL); 83 | sigaction(SIGTSTP, &act, NULL); 84 | "). 85 | 86 | :- pragma foreign_proc("C", 87 | install_exit_handlers(_IO0::di, _IO::uo), 88 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 89 | may_not_duplicate], 90 | " 91 | struct sigaction act; 92 | 93 | sigemptyset(&act.sa_mask); 94 | act.sa_flags = 0; 95 | act.sa_handler = curs_exit_handler; 96 | sigaction(SIGTERM, &act, NULL); 97 | sigaction(SIGHUP, &act, NULL); 98 | sigaction(SIGQUIT, &act, NULL); 99 | "). 100 | 101 | %-----------------------------------------------------------------------------% 102 | % vim: ft=mercury ts=4 sts=4 sw=4 et 103 | -------------------------------------------------------------------------------- /src/detect_mime_type.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module detect_mime_type. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- import_module mime_type. 10 | 11 | :- type mime_type_with_charset 12 | ---> mime_type_with_charset( 13 | mtc_type :: mime_type, % e.g. text/plain 14 | mtc_charset :: string % e.g. us-ascii, utf-8, binary 15 | ). 16 | 17 | :- pred detect_mime_type(string::in, io.res(mime_type_with_charset)::out, 18 | io::di, io::uo) is det. 19 | 20 | %-----------------------------------------------------------------------------% 21 | %-----------------------------------------------------------------------------% 22 | 23 | :- implementation. 24 | 25 | :- import_module list. 26 | :- import_module maybe. 27 | :- import_module string. 28 | 29 | :- import_module call_system. 30 | :- import_module process. 31 | :- import_module quote_command. 32 | 33 | %-----------------------------------------------------------------------------% 34 | 35 | detect_mime_type(FileName, Res, !IO) :- 36 | make_quoted_command(file_command, ["--brief", "--mime", FileName], 37 | redirect_input("/dev/null"), no_redirect, Command), 38 | call_system_capture_stdout(Command, environ([]), no, CallRes, !IO), 39 | ( 40 | CallRes = ok(String0), 41 | String = string.chomp(String0), 42 | ( string.split_at_string("; charset=", String) = [TypeStr, Charset] -> 43 | Type = make_mime_type(TypeStr), 44 | Res = ok(mime_type_with_charset(Type, Charset)) 45 | ; 46 | Res = error(io.make_io_error("could not parse mime type")) 47 | ) 48 | ; 49 | CallRes = error(Error), 50 | Res = error(Error) 51 | ). 52 | 53 | :- func file_command = command_prefix. 54 | 55 | file_command = command_prefix(shell_quoted("file"), quote_once). 56 | 57 | %-----------------------------------------------------------------------------% 58 | % vim: ft=mercury ts=4 sts=4 sw=4 et 59 | -------------------------------------------------------------------------------- /src/fold_lines.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module fold_lines. 5 | :- interface. 6 | 7 | :- import_module list. 8 | 9 | :- type span 10 | ---> span( 11 | mandatory :: string, 12 | trailing_ws :: string 13 | ). 14 | 15 | :- pred get_spans_by_whitespace(string::in, list(span)::out) is det. 16 | 17 | :- pred fill_lines(int::in, list(span)::in, list(string)::out) is det. 18 | 19 | %-----------------------------------------------------------------------------% 20 | %-----------------------------------------------------------------------------% 21 | 22 | :- implementation. 23 | 24 | :- import_module int. 25 | :- import_module string. 26 | 27 | :- import_module string_util. 28 | 29 | %-----------------------------------------------------------------------------% 30 | 31 | % String = " This is the sentence. " 32 | % Spans = [1--2----3--4---5----------] 33 | 34 | get_spans_by_whitespace(String, Spans) :- 35 | get_spans_ws(String, 0, Spans). 36 | 37 | :- pred get_spans_ws(string::in, int::in, list(span)::out) is det. 38 | 39 | get_spans_ws(String, Pos0, Spans) :- 40 | until_whitespace(String, Pos0, Pos1), 41 | skip_whitespace(String, Pos1, Pos2), 42 | ( Pos2 = Pos0 -> 43 | Spans = [] 44 | ; 45 | make_span(String, Pos0, Pos1, Pos2, Span), 46 | get_spans_ws(String, Pos2, RestSpans), 47 | Spans = [Span | RestSpans] 48 | ). 49 | 50 | :- pred make_span(string::in, int::in, int::in, int::in, span::out) is det. 51 | 52 | make_span(String, Pos0, Pos1, Pos2, Span) :- 53 | string.unsafe_between(String, Pos0, Pos1, Mandatory), 54 | string.unsafe_between(String, Pos1, Pos2, Trailer), 55 | Span = span(Mandatory, Trailer). 56 | 57 | %-----------------------------------------------------------------------------% 58 | 59 | fill_lines(MaxWidth, Spans, Lines) :- 60 | take_spans(MaxWidth, Spans, 0, LineSpans, RestSpans), 61 | make_line(LineSpans, Line), 62 | ( 63 | RestSpans = [], 64 | Lines = [Line] 65 | ; 66 | RestSpans = [_ | _], 67 | fill_lines(MaxWidth, RestSpans, RestLines), 68 | Lines = [Line | RestLines] 69 | ). 70 | 71 | :- pred take_spans(int::in, list(span)::in, int::in, list(span)::out, 72 | list(span)::out) is det. 73 | 74 | take_spans(_MaxWidth, [], _Width0, [], []). 75 | take_spans(MaxWidth, [Span | Spans], Width0, Taken, NotTaken) :- 76 | Span = span(Mandatory, Trailer), 77 | Width1 = Width0 + string_wcwidth(Mandatory), 78 | Width2 = Width1 + string_wcwidth(Trailer), 79 | ( 80 | Width2 =< MaxWidth 81 | -> 82 | take_spans(MaxWidth, Spans, Width2, Taken2, NotTaken), 83 | Taken = [Span | Taken2] 84 | ; 85 | ( Width0 = 0 % first span on a line must be taken 86 | ; Width1 =< MaxWidth 87 | ) 88 | -> 89 | Taken = [Span], 90 | NotTaken = Spans 91 | ; 92 | Taken = [], 93 | NotTaken = [Span | Spans] 94 | ). 95 | 96 | :- pred make_line(list(span)::in, string::out) is det. 97 | 98 | make_line(Spans, Line) :- 99 | flatten(Spans, Strings), 100 | string.append_list(Strings, Line). 101 | 102 | :- pred flatten(list(span)::in, list(string)::out) is det. 103 | 104 | flatten([], []). 105 | flatten([Span | Spans], Strings) :- 106 | Span = span(Mandatory, Trailer), 107 | ( 108 | Spans = [], 109 | Strings = [Mandatory] 110 | ; 111 | Spans = [_ | _], 112 | flatten(Spans, Strings1), 113 | Strings = [Mandatory, Trailer | Strings1] 114 | ). 115 | 116 | %-----------------------------------------------------------------------------% 117 | % vim: ft=mercury ts=4 sts=4 sw=4 et 118 | -------------------------------------------------------------------------------- /src/gpgme.encrypt.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module gpgme.encrypt. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- type encrypt_op 10 | ---> encrypt_only 11 | ; encrypt_sign. 12 | 13 | :- type encrypt_flag 14 | ---> always_trust 15 | ; no_encrypt_to. 16 | 17 | :- type encrypt_result 18 | ---> encrypt_result( 19 | invalid_recipients :: list(invalid_key) 20 | ). 21 | 22 | :- pred gpgme_op_encrypt(encrypt_op::in, ctx::in, list(key)::in, 23 | list(encrypt_flag)::in, data::in, data::in, 24 | maybe_error(encrypt_result)::out, io::di, io::uo) is det. 25 | 26 | %-----------------------------------------------------------------------------% 27 | %-----------------------------------------------------------------------------% 28 | 29 | :- implementation. 30 | 31 | :- import_module gpgme.invalid_key. 32 | :- import_module gpgme.key_array. 33 | 34 | :- pragma foreign_enum("C", encrypt_flag/0, [ 35 | always_trust - "GPGME_ENCRYPT_ALWAYS_TRUST", 36 | no_encrypt_to - "GPGME_ENCRYPT_NO_ENCRYPT_TO" 37 | ]). 38 | 39 | :- type gpgme_encrypt_result. 40 | 41 | :- pragma foreign_type("C", gpgme_encrypt_result, "gpgme_encrypt_result_t"). 42 | 43 | %-----------------------------------------------------------------------------% 44 | 45 | gpgme_op_encrypt(Op, Ctx, Recipients, Flags, data(Plain, _), data(Cipher, _), 46 | Res, !IO) :- 47 | FlagsInt = encrypt_flags_to_int(Flags), 48 | with_key_array(gpgme_op_encrypt_2(Op, Ctx, FlagsInt, Plain, Cipher), 49 | Recipients, {Ok, Error}, !IO), 50 | ( 51 | Ok = yes, 52 | gpgme_op_encrypt_result(Ctx, Res, !IO) 53 | ; 54 | Ok = no, 55 | Res = error(Error) 56 | ). 57 | 58 | :- func encrypt_flags_to_int(list(encrypt_flag)) = int. 59 | 60 | encrypt_flags_to_int(Flags) = list.foldl(or_encrypt_flag, Flags, 0). 61 | 62 | :- func or_encrypt_flag(encrypt_flag, int) = int. 63 | 64 | :- pragma foreign_proc("C", 65 | or_encrypt_flag(F::in, X0::in) = (X::out), 66 | [will_not_call_mercury, promise_pure, thread_safe], 67 | " 68 | X = X0 | F; 69 | "). 70 | 71 | :- pred gpgme_op_encrypt_2(encrypt_op::in, ctx::in, int::in, gpgme_data::in, 72 | gpgme_data::in, gpgme_key_array::in, {bool, string}::out, io::di, io::uo) 73 | is det. 74 | 75 | gpgme_op_encrypt_2(Op, Ctx, Flags, Plain, Cipher, Recp, {Ok, Error}, !IO) :- 76 | gpgme_op_encrypt_3(sign(Op), Ctx, Flags, Plain, Cipher, Recp, Ok, Error, 77 | !IO). 78 | 79 | :- pred gpgme_op_encrypt_3(bool::in, ctx::in, int::in, gpgme_data::in, 80 | gpgme_data::in, gpgme_key_array::in, bool::out, string::out, 81 | io::di, io::uo) is det. 82 | 83 | :- pragma foreign_proc("C", 84 | gpgme_op_encrypt_3(Sign::in, Ctx::in, Flags::in, Plain::in, Cipher::in, 85 | Recp::in, Ok::out, Error::out, _IO0::di, _IO::uo), 86 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io], 87 | " 88 | gpgme_error_t err; 89 | 90 | if (Sign) { 91 | err = gpgme_op_encrypt_sign(Ctx, Recp, Flags, Plain, Cipher); 92 | } else { 93 | err = gpgme_op_encrypt(Ctx, Recp, Flags, Plain, Cipher); 94 | } 95 | if (err == GPG_ERR_NO_ERROR) { 96 | Ok = MR_YES; 97 | Error = MR_make_string_const(""""); 98 | } else { 99 | Ok = MR_NO; 100 | Error = _gpgme_error_to_string(err, MR_ALLOC_ID); 101 | } 102 | "). 103 | 104 | :- func sign(encrypt_op) = bool. 105 | 106 | sign(encrypt_only) = no. 107 | sign(encrypt_sign) = yes. 108 | 109 | %-----------------------------------------------------------------------------% 110 | 111 | :- pred gpgme_op_encrypt_result(ctx::in, maybe_error(encrypt_result)::out, 112 | io::di, io::uo) is det. 113 | 114 | gpgme_op_encrypt_result(Ctx, Res, !IO) :- 115 | promise_pure 116 | ( 117 | gpgme_op_encrypt_result_2(Ctx, Ok, EncryptResult0, !IO), 118 | ( 119 | Ok = yes, 120 | semipure convert_encrypt_result(EncryptResult0, EncryptResult), 121 | Res = ok(EncryptResult) 122 | ; 123 | Ok = no, 124 | Res = error("gpgme_op_encrypt_result failed") 125 | ) 126 | ). 127 | 128 | :- pred gpgme_op_encrypt_result_2(ctx::in, bool::out, 129 | gpgme_encrypt_result::out, io::di, io::uo) is det. 130 | 131 | :- pragma foreign_proc("C", 132 | gpgme_op_encrypt_result_2(Ctx::in, Ok::out, EncryptResult::out, 133 | _IO0::di, _IO::uo), 134 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 135 | may_not_duplicate], 136 | " 137 | EncryptResult = gpgme_op_encrypt_result(Ctx); 138 | Ok = (EncryptResult != NULL) ? MR_YES : MR_NO; 139 | "). 140 | 141 | :- semipure pred convert_encrypt_result(gpgme_encrypt_result::in, 142 | encrypt_result::out) is det. 143 | 144 | convert_encrypt_result(EncryptResult0, EncryptResult) :- 145 | semipure encrypt_result_fields(EncryptResult0, InvalidRecipients0), 146 | semipure convert_invalid_keys(InvalidRecipients0, InvalidRecipients), 147 | EncryptResult = encrypt_result(InvalidRecipients). 148 | 149 | :- semipure pred encrypt_result_fields(gpgme_encrypt_result::in, 150 | gpgme_invalid_key::out) is det. 151 | 152 | :- pragma foreign_proc("C", 153 | encrypt_result_fields(EncryptResult::in, InvalidRecipients::out), 154 | [will_not_call_mercury, promise_semipure, thread_safe], 155 | " 156 | InvalidRecipients = EncryptResult->invalid_recipients; 157 | "). 158 | 159 | %-----------------------------------------------------------------------------% 160 | % vim: ft=mercury ts=4 sts=4 sw=4 et 161 | -------------------------------------------------------------------------------- /src/gpgme.invalid_key.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module gpgme.invalid_key. 5 | :- interface. 6 | 7 | :- semipure pred convert_invalid_keys(gpgme_invalid_key::in, 8 | list(invalid_key)::out) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | convert_invalid_keys(Key0, Res) :- 16 | ( semipure convert_invalid_key(Key0, Key1, Key) -> 17 | semipure convert_invalid_keys(Key1, Keys), 18 | Res = [Key | Keys] 19 | ; 20 | Res = [] 21 | ). 22 | 23 | :- semipure pred convert_invalid_key(gpgme_invalid_key::in, 24 | gpgme_invalid_key::out, invalid_key::out) is semidet. 25 | 26 | convert_invalid_key(Key0, Next, Key) :- 27 | semipure invalid_key_fields(Key0, Next, Fingerprint, Reason), 28 | Key = invalid_key(Fingerprint, Reason). 29 | 30 | :- semipure pred invalid_key_fields(gpgme_invalid_key::in, 31 | gpgme_invalid_key::out, string::out, string::out) is semidet. 32 | 33 | :- pragma foreign_proc("C", 34 | invalid_key_fields(Key::in, Next::out, Fingerprint::out, Reason::out), 35 | [will_not_call_mercury, promise_semipure, thread_safe], 36 | " 37 | SUCCESS_INDICATOR = (Key != NULL); 38 | if (SUCCESS_INDICATOR) { 39 | Next = Key->next; 40 | MR_make_aligned_string_copy_msg(Fingerprint, Key->fpr, MR_ALLOC_ID); 41 | Reason = _gpgme_error_to_string(Key->reason, MR_ALLOC_ID); 42 | } else { 43 | Next = NULL; 44 | Fingerprint = MR_make_string_const(""""); 45 | Reason = MR_make_string_const(""""); 46 | } 47 | "). 48 | 49 | %-----------------------------------------------------------------------------% 50 | % vim: ft=mercury ts=4 sts=4 sw=4 et 51 | -------------------------------------------------------------------------------- /src/gpgme.key_array.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module gpgme.key_array. 5 | :- interface. 6 | 7 | :- type gpgme_key_array. 8 | 9 | :- pred with_key_array(pred(gpgme_key_array, T, io, io), list(key), T, io, io). 10 | :- mode with_key_array(pred(in, out, di, uo) is det, in, out, di, uo) is det. 11 | 12 | %-----------------------------------------------------------------------------% 13 | %-----------------------------------------------------------------------------% 14 | 15 | :- implementation. 16 | 17 | :- import_module int. 18 | :- use_module exception. 19 | :- use_module require. 20 | 21 | :- pragma foreign_type("C", gpgme_key_array, "gpgme_key_t *"). 22 | 23 | %-----------------------------------------------------------------------------% 24 | 25 | with_key_array(Pred, Keys, Out, !IO) :- 26 | promise_pure 27 | ( 28 | make_key_array(Keys, KeyArray, !IO), 29 | promise_equivalent_solutions [Out, !:IO] 30 | ( 31 | exception.try_io( 32 | (pred(R::out, IO0::di, IO::uo) is det :- 33 | Pred(KeyArray, R, IO0, IO)), 34 | TryResult, !IO), 35 | ( 36 | TryResult = exception.succeeded(Out), 37 | free_key_array(KeyArray, !IO) 38 | ; 39 | TryResult = exception.exception(Excp), 40 | free_key_array(KeyArray, !IO), 41 | exception.throw(Excp) 42 | ) 43 | ) 44 | ). 45 | 46 | :- pred make_key_array(list(key)::in, gpgme_key_array::uo, io::di, io::uo) 47 | is det. 48 | 49 | make_key_array(Keys, KeyArray, !IO) :- 50 | allocate_key_array(length(Keys), KeyArray0), 51 | fill_key_array(0, Keys, KeyArray0, KeyArray, !IO). 52 | 53 | :- pred allocate_key_array(int::in, gpgme_key_array::uo) is det. 54 | 55 | :- pragma foreign_proc("C", 56 | allocate_key_array(Size::in, KeyArray::uo), 57 | [will_not_call_mercury, promise_pure, thread_safe], 58 | " 59 | /* NULL terminated */ 60 | KeyArray = calloc(Size + 1, sizeof(gpgme_key_t)); 61 | "). 62 | 63 | :- pred fill_key_array(int::in, list(key)::in, 64 | gpgme_key_array::di, gpgme_key_array::uo, io::di, io::uo) is det. 65 | 66 | fill_key_array(_Index, [], !KeyArray, !IO). 67 | fill_key_array(Index, [Key | Keys], !KeyArray, !IO) :- 68 | Key = key(_KeyInfo, Mutvar), 69 | get_mutvar(Mutvar, MaybeKey, !IO), 70 | ( 71 | MaybeKey = yes(GpgmeKey), 72 | set_key_array(Index, GpgmeKey, !KeyArray), 73 | fill_key_array(Index + 1, Keys, !KeyArray, !IO) 74 | ; 75 | MaybeKey = no, 76 | require.unexpected($module, $pred, "key already unref'd") 77 | ). 78 | 79 | :- pred set_key_array(int::in, gpgme_key::in, 80 | gpgme_key_array::di, gpgme_key_array::uo) is det. 81 | 82 | :- pragma foreign_proc("C", 83 | set_key_array(Index::in, Key::in, KeyArray0::di, KeyArray::uo), 84 | [will_not_call_mercury, promise_pure, thread_safe], 85 | " 86 | KeyArray = KeyArray0; 87 | KeyArray[Index] = Key; 88 | "). 89 | 90 | :- pred free_key_array(gpgme_key_array::in, io::di, io::uo) is det. 91 | 92 | :- pragma foreign_proc("C", 93 | free_key_array(KeyArray::in, _IO0::di, _IO::uo), 94 | [will_not_call_mercury, promise_pure, thread_safe], 95 | " 96 | free(KeyArray); 97 | "). 98 | 99 | %-----------------------------------------------------------------------------% 100 | % vim: ft=mercury ts=4 sts=4 sw=4 et 101 | -------------------------------------------------------------------------------- /src/gpgme.sign.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module gpgme.sign. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module list. 9 | 10 | :- type sign_result 11 | ---> sign_result( 12 | invalid_signers :: list(invalid_key), 13 | new_signatures :: list(new_signature) 14 | ). 15 | 16 | :- type new_signature 17 | ---> new_signature( 18 | % type 19 | % pubkey_algo 20 | hash_algo :: hash_algo, 21 | % sig_class 22 | timestamp :: timestamp, 23 | fingerprint :: string 24 | ). 25 | 26 | :- pred gpgme_op_sign_detached(ctx::in, data::in, data::in, 27 | maybe_error(sign_result)::out, io::di, io::uo) is det. 28 | 29 | %-----------------------------------------------------------------------------% 30 | %-----------------------------------------------------------------------------% 31 | 32 | :- implementation. 33 | 34 | :- import_module gpgme.invalid_key. 35 | 36 | :- type gpgme_sign_result. 37 | 38 | :- pragma foreign_type("C", gpgme_sign_result, "gpgme_sign_result_t"). 39 | 40 | :- type gpgme_new_signature. 41 | 42 | :- pragma foreign_type("C", gpgme_new_signature, "gpgme_new_signature_t"). 43 | 44 | %-----------------------------------------------------------------------------% 45 | 46 | gpgme_op_sign_detached(Ctx, data(Plain, _), data(Sig, _), Res, !IO) :- 47 | gpgme_op_sign_2(Ctx, Plain, Sig, Ok, Error, !IO), 48 | ( 49 | Ok = yes, 50 | gpgme_op_sign_result(Ctx, Res, !IO) 51 | ; 52 | Ok = no, 53 | Res = error(Error) 54 | ). 55 | 56 | :- pred gpgme_op_sign_2(ctx::in, gpgme_data::in, gpgme_data::in, 57 | bool::out, string::out, io::di, io::uo) is det. 58 | 59 | :- pragma foreign_proc("C", 60 | gpgme_op_sign_2(Ctx::in, Plain::in, Sig::in, Ok::out, Error::out, 61 | _IO0::di, _IO::uo), 62 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 63 | may_not_duplicate], 64 | " 65 | gpgme_error_t err; 66 | 67 | err = gpgme_op_sign(Ctx, Plain, Sig, GPGME_SIG_MODE_DETACH); 68 | if (err == GPG_ERR_NO_ERROR) { 69 | Ok = MR_YES; 70 | Error = MR_make_string_const(""""); 71 | } else { 72 | Ok = MR_NO; 73 | Error = _gpgme_error_to_string(err, MR_ALLOC_ID); 74 | } 75 | "). 76 | 77 | %-----------------------------------------------------------------------------% 78 | 79 | :- pred gpgme_op_sign_result(ctx::in, maybe_error(sign_result)::out, 80 | io::di, io::uo) is det. 81 | 82 | gpgme_op_sign_result(Ctx, Res, !IO) :- 83 | promise_pure 84 | ( 85 | gpgme_op_sign_result_2(Ctx, Ok, SignResult0, !IO), 86 | ( 87 | Ok = yes, 88 | semipure convert_sign_result(SignResult0, SignResult), 89 | Res = ok(SignResult) 90 | ; 91 | Ok = no, 92 | Res = error("gpgme_op_sign_result failed") 93 | ) 94 | ). 95 | 96 | :- pred gpgme_op_sign_result_2(ctx::in, bool::out, gpgme_sign_result::out, 97 | io::di, io::uo) is det. 98 | 99 | :- pragma foreign_proc("C", 100 | gpgme_op_sign_result_2(Ctx::in, Ok::out, SignResult::out, 101 | _IO0::di, _IO::uo), 102 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 103 | may_not_duplicate], 104 | " 105 | SignResult = gpgme_op_sign_result(Ctx); 106 | Ok = (SignResult != NULL) ? MR_YES : MR_NO; 107 | "). 108 | 109 | :- semipure pred convert_sign_result(gpgme_sign_result::in, sign_result::out) 110 | is det. 111 | 112 | convert_sign_result(SignResult0, SignResult) :- 113 | semipure sign_result_fields(SignResult0, InvalidSigners0, Signatures0), 114 | semipure convert_invalid_keys(InvalidSigners0, InvalidSigners), 115 | semipure convert_signatures(Signatures0, Signatures), 116 | SignResult = sign_result(InvalidSigners, Signatures). 117 | 118 | :- semipure pred sign_result_fields(gpgme_sign_result::in, 119 | gpgme_invalid_key::out, gpgme_new_signature::out) is det. 120 | 121 | :- pragma foreign_proc("C", 122 | sign_result_fields(SignResult::in, InvalidSigners::out, Signatures::out), 123 | [will_not_call_mercury, promise_semipure, thread_safe], 124 | " 125 | InvalidSigners = SignResult->invalid_signers; 126 | Signatures = SignResult->signatures; 127 | "). 128 | 129 | :- semipure pred convert_signatures(gpgme_new_signature::in, 130 | list(new_signature)::out) is det. 131 | 132 | convert_signatures(Signature0, Res) :- 133 | ( semipure convert_signature(Signature0, Next, Signature) -> 134 | semipure convert_signatures(Next, Signatures), 135 | Res = [Signature | Signatures] 136 | ; 137 | Res = [] 138 | ). 139 | 140 | :- semipure pred convert_signature(gpgme_new_signature::in, 141 | gpgme_new_signature::out, new_signature::out) is semidet. 142 | 143 | convert_signature(Signature0, Next, Signature) :- 144 | semipure signature_fields(Signature0, Next, HashAlgo, Timestamp, Fingerprint), 145 | Signature = new_signature(HashAlgo, Timestamp, Fingerprint). 146 | 147 | :- semipure pred signature_fields(gpgme_new_signature::in, 148 | gpgme_new_signature::out, hash_algo::out, int::out, string::out) 149 | is semidet. 150 | 151 | :- pragma foreign_proc("C", 152 | signature_fields(Sig::in, Next::out, HashAlgo::out, Timestamp::out, 153 | Fingerprint::out), 154 | [will_not_call_mercury, promise_semipure, thread_safe], 155 | " 156 | SUCCESS_INDICATOR = (Sig != NULL); 157 | if (SUCCESS_INDICATOR) { 158 | Next = Sig->next; 159 | HashAlgo = Sig->hash_algo; 160 | Timestamp = Sig->timestamp; 161 | MR_make_aligned_string_copy_msg(Fingerprint, Sig->fpr, MR_ALLOC_ID); 162 | } else { 163 | Next = NULL; 164 | HashAlgo = -1; 165 | Timestamp = 0; 166 | Fingerprint = MR_make_string_const(""""); 167 | } 168 | "). 169 | 170 | %-----------------------------------------------------------------------------% 171 | % vim: ft=mercury ts=4 sts=4 sw=4 et 172 | -------------------------------------------------------------------------------- /src/gpgme.signer.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module gpgme.signer. 5 | :- interface. 6 | 7 | :- pred gpgme_signers_clear(ctx::in, io::di, io::uo) is det. 8 | 9 | :- pred gpgme_signers_add(ctx::in, key::in, maybe_error::out, io::di, io::uo) 10 | is det. 11 | 12 | %-----------------------------------------------------------------------------% 13 | %-----------------------------------------------------------------------------% 14 | 15 | :- implementation. 16 | 17 | :- use_module require. 18 | 19 | %-----------------------------------------------------------------------------% 20 | 21 | :- pragma foreign_proc("C", 22 | gpgme_signers_clear(Ctx::in, _IO0::di, _IO::uo), 23 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 24 | may_not_duplicate], 25 | " 26 | gpgme_signers_clear(Ctx); 27 | "). 28 | 29 | %-----------------------------------------------------------------------------% 30 | 31 | gpgme_signers_add(Ctx, Key, Res, !IO) :- 32 | Key = key(_KeyInfo, Mutvar), 33 | get_mutvar(Mutvar, MaybeKey, !IO), 34 | ( 35 | MaybeKey = yes(GpgmeKey), 36 | gpgme_signers_add_2(Ctx, GpgmeKey, Ok, Error, !IO), 37 | ( 38 | Ok = yes, 39 | Res = ok 40 | ; 41 | Ok = no, 42 | Res = error(Error) 43 | ) 44 | ; 45 | MaybeKey = no, 46 | require.unexpected($module, $pred, "key already unref'd") 47 | ). 48 | 49 | :- pred gpgme_signers_add_2(ctx::in, gpgme_key::in, bool::out, string::out, 50 | io::di, io::uo) is det. 51 | 52 | :- pragma foreign_proc("C", 53 | gpgme_signers_add_2(Ctx::in, Key::in, Ok::out, Error::out, 54 | _IO0::di, _IO::uo), 55 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 56 | may_not_duplicate], 57 | " 58 | gpgme_error_t err; 59 | 60 | err = gpgme_signers_add(Ctx, Key); 61 | if (err == GPG_ERR_NO_ERROR) { 62 | Ok = MR_YES; 63 | Error = MR_make_string_const(""""); 64 | } else { 65 | Ok = MR_NO; 66 | Error = _gpgme_error_to_string(err, MR_ALLOC_ID); 67 | } 68 | "). 69 | 70 | %-----------------------------------------------------------------------------% 71 | % vim: ft=mercury ts=4 sts=4 sw=4 et 72 | -------------------------------------------------------------------------------- /src/help.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2022 Peter Wang 3 | 4 | :- module help. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- pred print_help(string::in, io::di, io::uo) is det. 10 | 11 | %-----------------------------------------------------------------------------% 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- implementation. 15 | 16 | :- import_module list. 17 | :- import_module string. 18 | 19 | print_help(ProgName, !IO) :- 20 | Lines = [ 21 | "Usage: " ++ ProgName ++ " [OPTION]... [SEARCH-TERM]...", 22 | " " ++ ProgName ++ " [OPTION]... mailto:MAILTO", 23 | "", 24 | "Options:", 25 | " -h, --help Display usage and options.", 26 | " --version Display version.", 27 | "" 28 | ], 29 | io.output_stream(Stream, !IO), 30 | list.foldl(write_string_nl(Stream), Lines, !IO). 31 | 32 | :- pred write_string_nl(io.text_output_stream::in, string::in, io::di, io::uo) 33 | is det. 34 | 35 | write_string_nl(Stream, S, !IO) :- 36 | io.write_string(Stream, S, !IO), 37 | io.nl(Stream, !IO). 38 | 39 | %-----------------------------------------------------------------------------% 40 | % vim: ft=mercury ts=4 sts=4 sw=4 et 41 | -------------------------------------------------------------------------------- /src/list_util.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2016 Peter Wang 3 | 4 | :- module list_util. 5 | :- interface. 6 | 7 | :- import_module list. 8 | 9 | % Avoid list.takewhile deprecated from 2016-04-22 10 | % 11 | :- pred take_while(pred(T)::in(pred(in) is semidet), list(T)::in, 12 | list(T)::out) is det. 13 | :- pred take_while(pred(T)::in(pred(in) is semidet), list(T)::in, 14 | list(T)::out, list(T)::out) is det. 15 | 16 | %-----------------------------------------------------------------------------% 17 | %-----------------------------------------------------------------------------% 18 | 19 | :- implementation. 20 | 21 | take_while(_, [], []). 22 | take_while(P, [X | Xs], Start) :- 23 | ( if P(X) then 24 | list_util.take_while(P, Xs, Start0), 25 | Start = [X | Start0] 26 | else 27 | Start = [] 28 | ). 29 | 30 | take_while(_, [], [], []). 31 | take_while(P, [X | Xs], Ins, Outs) :- 32 | ( if P(X) then 33 | Ins = [X | Ins0], 34 | list_util.take_while(P, Xs, Ins0, Outs) 35 | else 36 | Ins = [], 37 | Outs = [X | Xs] 38 | ). 39 | 40 | %-----------------------------------------------------------------------------% 41 | % vim: ft=mercury ts=4 sts=4 sw=4 et 42 | -------------------------------------------------------------------------------- /src/maildir.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module maildir. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module list. 9 | :- import_module maybe. 10 | 11 | :- import_module data. 12 | :- import_module prog_config. 13 | :- import_module tags. 14 | 15 | %-----------------------------------------------------------------------------% 16 | 17 | :- pred add_sent(prog_config::in, string::in, list(tag_delta)::in, 18 | maybe_error::out, io::di, io::uo) is det. 19 | 20 | :- pred add_draft(prog_config::in, string::in, list(tag_delta)::in, 21 | maybe_error::out, io::di, io::uo) is det. 22 | 23 | :- pred find_drafts(prog_config::in, maybe(thread_id)::in, 24 | maybe_error(list(message_id))::out, io::di, io::uo) is det. 25 | 26 | :- pred tag_messages(prog_config::in, list(tag_delta)::in, 27 | list(message_id)::in, maybe_error::out, io::di, io::uo) is det. 28 | 29 | :- pred tag_threads(prog_config::in, list(tag_delta)::in, list(thread_id)::in, 30 | maybe_error::out, io::di, io::uo) is det. 31 | 32 | %-----------------------------------------------------------------------------% 33 | %-----------------------------------------------------------------------------% 34 | 35 | :- implementation. 36 | 37 | :- import_module string. 38 | 39 | :- import_module callout. 40 | :- import_module quote_command. 41 | 42 | %-----------------------------------------------------------------------------% 43 | 44 | add_sent(Config, FileName, TagDeltas, Res, !IO) :- 45 | get_notmuch_config(Config, "bower:maildir.sent_folder", ConfigRes, !IO), 46 | ( 47 | ConfigRes = ok(SentFolder) 48 | ; 49 | ConfigRes = error(_), 50 | SentFolder = default_sent_folder 51 | ), 52 | call_notmuch_insert(Config, FileName, SentFolder, TagDeltas, Res, !IO). 53 | 54 | add_draft(Config, FileName, TagDeltas, Res, !IO) :- 55 | get_notmuch_config(Config, "bower:maildir.drafts_folder", ConfigRes, !IO), 56 | ( 57 | ConfigRes = ok(DraftsFolder) 58 | ; 59 | ConfigRes = error(_), 60 | DraftsFolder = default_drafts_folder 61 | ), 62 | call_notmuch_insert(Config, FileName, DraftsFolder, TagDeltas, Res, !IO). 63 | 64 | :- pred call_notmuch_insert(prog_config::in, string::in, string::in, 65 | list(tag_delta)::in, maybe_error::out, io::di, io::uo) is det. 66 | 67 | call_notmuch_insert(Config, FileName, Folder, TagDeltas, Res, !IO) :- 68 | get_notmuch_command(Config, Notmuch), 69 | TagOps = map(tag_delta_to_string, TagDeltas), 70 | make_quoted_command(Notmuch, 71 | ["insert", "--folder=" ++ Folder, "--create-folder" | TagOps], 72 | redirect_input(FileName), no_redirect, Command), 73 | io.call_system(Command, CallRes, !IO), 74 | ( 75 | CallRes = ok(ExitStatus), 76 | ( ExitStatus = 0 -> 77 | Res = ok 78 | ; 79 | Msg = string.format("notmuch insert returned with exit status %d", 80 | [i(ExitStatus)]), 81 | Res = error(Msg) 82 | ) 83 | ; 84 | CallRes = error(Error), 85 | Res = error(io.error_message(Error)) 86 | ). 87 | 88 | :- func default_sent_folder = string. 89 | 90 | default_sent_folder = "Sent". 91 | 92 | :- func default_drafts_folder = string. 93 | 94 | default_drafts_folder = "Drafts". 95 | 96 | %-----------------------------------------------------------------------------% 97 | 98 | find_drafts(Config, MaybeThreadId, Res, !IO) :- 99 | ( 100 | MaybeThreadId = yes(ThreadId), 101 | ThreadSearchTerm = [thread_id_to_search_term(ThreadId)] 102 | ; 103 | MaybeThreadId = no, 104 | ThreadSearchTerm = [] 105 | ), 106 | run_notmuch(Config, 107 | [ 108 | "search", "--format=json", "--output=messages", "--exclude=all", 109 | "--", "tag:draft", "-tag:deleted" | ThreadSearchTerm 110 | ], 111 | no_suspend_curses, 112 | parse_search_messages, Res0, !IO), 113 | ( 114 | Res0 = ok(MessageIds), 115 | Res = ok(MessageIds) 116 | ; 117 | Res0 = error(Error0), 118 | Error = "notmuch search: " ++ Error0, 119 | Res = error(Error) 120 | ). 121 | 122 | %-----------------------------------------------------------------------------% 123 | 124 | tag_messages(Config, TagDeltas, MessageIds, Res, !IO) :- 125 | ( if MessageIds = [] ; TagDeltas = [] then 126 | Res = ok 127 | else 128 | IdStrings = list.map(message_id_to_search_term, MessageIds), 129 | do_tag(Config, TagDeltas, IdStrings, Res, !IO) 130 | ). 131 | 132 | tag_threads(Config, TagDeltas, ThreadIds, Res, !IO) :- 133 | SearchTerms = list.map(thread_id_to_search_term, ThreadIds), 134 | do_tag(Config, TagDeltas, SearchTerms, Res, !IO). 135 | 136 | :- pred do_tag(prog_config::in, list(tag_delta)::in, list(string)::in, 137 | maybe_error::out, io::di, io::uo) is det. 138 | 139 | do_tag(Config, TagDeltas, SearchTerms, Res, !IO) :- 140 | get_notmuch_command(Config, Notmuch), 141 | TagDeltaStrings = list.map(tag_delta_to_string, TagDeltas), 142 | make_quoted_command(Notmuch, 143 | ["tag" | TagDeltaStrings] ++ ["--" | SearchTerms], 144 | redirect_input("/dev/null"), no_redirect, Command), 145 | io.call_system(Command, CallRes, !IO), 146 | ( 147 | CallRes = ok(ExitStatus), 148 | ( ExitStatus = 0 -> 149 | Res = ok 150 | ; 151 | string.format("notmuch tag returned exit status %d", 152 | [i(ExitStatus)], Msg), 153 | Res = error(Msg) 154 | ) 155 | ; 156 | CallRes = error(Error), 157 | Res = error(io.error_message(Error)) 158 | ). 159 | 160 | %-----------------------------------------------------------------------------% 161 | % vim: ft=mercury ts=4 sts=4 sw=4 et 162 | -------------------------------------------------------------------------------- /src/make_temp.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2016 Peter Wang 3 | 4 | :- module make_temp. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module maybe. 9 | 10 | :- pred make_temp_suffix(string::in, maybe_error(string)::out, io::di, io::uo) 11 | is det. 12 | 13 | %-----------------------------------------------------------------------------% 14 | %-----------------------------------------------------------------------------% 15 | 16 | :- implementation. 17 | 18 | :- import_module dir. 19 | :- import_module string. 20 | 21 | :- pragma foreign_decl("C", local, "#include "). 22 | 23 | make_temp_suffix(Suffix, Res, !IO) :- 24 | io.get_environment_var("TMPDIR", MaybeTMPDIR, !IO), 25 | ( 26 | MaybeTMPDIR = yes(Dir) 27 | ; 28 | MaybeTMPDIR = no, 29 | io.get_environment_var("TMP", MaybeTMP, !IO), 30 | ( 31 | MaybeTMP = yes(Dir) 32 | ; 33 | MaybeTMP = no, 34 | Dir = "/tmp" 35 | ) 36 | ), 37 | DirSep = char_to_string(dir.directory_separator), 38 | mkstemps(Dir, DirSep, "mtmp", Suffix, Error, Name, !IO), 39 | ( Error = 0 -> 40 | Res = ok(Name) 41 | ; 42 | Res = error("mkstemps failed (errno " ++ from_int(Error) ++ ")") 43 | ). 44 | 45 | :- pred mkstemps(string::in, string::in, string::in, string::in, int::out, 46 | string::uo, io::di, io::uo) is det. 47 | 48 | :- pragma foreign_proc("C", 49 | mkstemps(Dir::in, DirSep::in, Prefix::in, Suffix::in, Error::out, 50 | FileName::uo, _IO0::di, _IO::uo), 51 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io], 52 | " 53 | int fd, err; 54 | 55 | FileName = MR_make_string(MR_ALLOC_ID, ""%s%s%sXXXXXX%s"", Dir, DirSep, 56 | Prefix, Suffix); 57 | fd = mkstemps(FileName, strlen(Suffix)); 58 | if (fd == -1) { 59 | Error = -1; 60 | } else { 61 | do { 62 | err = close(fd); 63 | } while (err == -1 && MR_is_eintr(errno)); 64 | Error = err; 65 | } 66 | "). 67 | 68 | %-----------------------------------------------------------------------------% 69 | % vim: ft=mercury ts=4 sts=4 sw=4 et 70 | -------------------------------------------------------------------------------- /src/make_version.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -eu 3 | 4 | version=$( head -n 1 ../NEWS ) 5 | case "$version" in 6 | Bower*) ;; 7 | *) 8 | echo "unexpected first line in NEWS file" >&2 9 | version="unknown" 10 | ;; 11 | esac 12 | 13 | cat >prog_version.m < mime_type(string). % type/subtype (all lowercase) 46 | 47 | %-----------------------------------------------------------------------------% 48 | 49 | make_mime_type(String) = mime_type(string.to_lower(String)). 50 | 51 | to_string(mime_type(String)) = String. 52 | 53 | parse_mime_type(String, MimeType, Type, SubType) :- 54 | string.to_lower(String, LowerString), 55 | string.split_at_char('/', LowerString) = [Type, SubType], 56 | Type \= "", 57 | SubType \= "", 58 | all_match(rfc2045.token_char, Type), 59 | all_match(rfc2045.token_char, SubType), 60 | MimeType = mime_type(LowerString). 61 | 62 | %-----------------------------------------------------------------------------% 63 | 64 | is_text(mime_type(Type)) :- 65 | string.prefix(Type, "text/"). 66 | 67 | is_multipart(mime_type(Type)) :- 68 | string.prefix(Type, "multipart/"). 69 | 70 | text_plain = mime_type("text/plain"). 71 | text_html = mime_type("text/html"). 72 | message_rfc822 = mime_type("message/rfc822"). 73 | multipart_alternative = mime_type("multipart/alternative"). 74 | multipart_mixed = mime_type("multipart/mixed"). 75 | multipart_related = mime_type("multipart/related"). 76 | multipart_signed = mime_type("multipart/signed"). 77 | multipart_encrypted = mime_type("multipart/encrypted"). 78 | application_octet_stream = mime_type("application/octet-stream"). 79 | application_pgp_encrypted = mime_type("application/pgp-encrypted"). 80 | application_pgp_signature = mime_type("application/pgp-signature"). 81 | application_pkcs7_mime = mime_type("application/pkcs7-mime"). 82 | 83 | %-----------------------------------------------------------------------------% 84 | % vim: ft=mercury ts=4 sts=4 sw=4 et 85 | -------------------------------------------------------------------------------- /src/notmuch_config.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2018 Peter Wang 3 | 4 | :- module notmuch_config. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module list. 9 | 10 | :- import_module quote_command. 11 | 12 | :- type notmuch_config. 13 | 14 | :- func empty_notmuch_config = notmuch_config. 15 | 16 | :- pred get_notmuch_config(command_prefix::in, io.res(notmuch_config)::out, 17 | io::di, io::uo) is det. 18 | 19 | :- pred contains(notmuch_config::in, string::in, string::in) is semidet. 20 | 21 | :- pred search(notmuch_config::in, string::in, string::in, string::out) 22 | is semidet. 23 | 24 | % get_item_names_with_prefix(Config, SectionNames, NamePrefix, 25 | % MatchingNames): 26 | % 27 | % Return sorted list of item names with NamePrefix, from any of the given 28 | % SectionNames. 29 | % 30 | :- pred get_item_names_with_prefix(notmuch_config::in, list(string)::in, 31 | string::in, list(string)::out) is det. 32 | 33 | %-----------------------------------------------------------------------------% 34 | %-----------------------------------------------------------------------------% 35 | 36 | :- implementation. 37 | 38 | :- import_module int. 39 | :- import_module maybe. 40 | :- import_module string. 41 | 42 | :- import_module call_system. 43 | :- import_module process. 44 | 45 | :- type notmuch_config == list(string). % section.item=value 46 | 47 | %-----------------------------------------------------------------------------% 48 | 49 | empty_notmuch_config = []. 50 | 51 | %-----------------------------------------------------------------------------% 52 | 53 | get_notmuch_config(Notmuch, Res, !IO) :- 54 | make_quoted_command(Notmuch, ["config", "list"], 55 | redirect_input("/dev/null"), no_redirect, Command), 56 | call_system_capture_stdout(Command, environ([]), no, CallRes, !IO), 57 | ( 58 | CallRes = ok(ItemsString), 59 | % The empty string following the final newline is not an item. 60 | ItemsList = string.words_separator(unify('\n'), ItemsString), 61 | Res = ok(ItemsList) 62 | ; 63 | CallRes = error(Error), 64 | Res = error(Error) 65 | ). 66 | 67 | %---------------------------------------------------------------------------% 68 | 69 | contains(Config, Section, ItemName) :- 70 | Prefix = Section ++ "." ++ ItemName ++ "=", 71 | contains_loop(Config, Prefix). 72 | 73 | :- pred contains_loop(notmuch_config::in, string::in) is semidet. 74 | 75 | contains_loop([Item | Items], Prefix) :- 76 | ( if string.prefix(Item, Prefix) then 77 | true 78 | else 79 | contains_loop(Items, Prefix) 80 | ). 81 | 82 | %---------------------------------------------------------------------------% 83 | 84 | search(Config, Section, ItemName, Value) :- 85 | Prefix = Section ++ "." ++ ItemName ++ "=", 86 | search_loop(Config, Prefix, Value). 87 | 88 | :- pred search_loop(notmuch_config::in, string::in, string::out) is semidet. 89 | 90 | search_loop([Item | Items], Prefix, Value) :- 91 | ( if string.remove_prefix(Prefix, Item, Suffix) then 92 | Value = Suffix 93 | else 94 | search_loop(Items, Prefix, Value) 95 | ). 96 | 97 | %-----------------------------------------------------------------------------% 98 | 99 | get_item_names_with_prefix(Items, SectionNames, ItemNamePrefix, 100 | MatchingItemNames) :- 101 | CandidatePrefixes = map(make_candidate_prefix(ItemNamePrefix), SectionNames), 102 | list.filter_map(filter_item(CandidatePrefixes), Items, MatchingItemNames0), 103 | list.sort(MatchingItemNames0, MatchingItemNames). 104 | 105 | :- func make_candidate_prefix(string, string) = string. 106 | 107 | make_candidate_prefix(ItemNamePrefix, SectionName) = 108 | SectionName ++ "." ++ ItemNamePrefix. 109 | 110 | :- pred filter_item(list(string)::in, string::in, string::out) is semidet. 111 | 112 | filter_item(CandidatePrefixes, Item, ItemName) :- 113 | CandidatePrefixes = [CandidatePrefix | CandidatePrefixesTail], 114 | ( if filter_item0(CandidatePrefix, Item, ItemName0) then 115 | ItemName = ItemName0 116 | else 117 | filter_item(CandidatePrefixesTail, Item, ItemName) 118 | ). 119 | 120 | :- pred filter_item0(string::in, string::in, string::out) is semidet. 121 | 122 | filter_item0(CandidatePrefix, Item, ItemName) :- 123 | string.prefix(Item, CandidatePrefix), 124 | sub_string_search(Item, ".", DotIndex), 125 | sub_string_search_start(Item, "=", DotIndex, EqualsIndex), 126 | string.between(Item, DotIndex + 1, EqualsIndex, ItemName). 127 | 128 | %-----------------------------------------------------------------------------% 129 | % vim: ft=mercury ts=4 sts=4 sw=4 et 130 | -------------------------------------------------------------------------------- /src/path_expand.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2012 Peter Wang 3 | 4 | :- module path_expand. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module list. 9 | 10 | :- import_module shell_word. 11 | 12 | :- type home 13 | ---> home(string) 14 | ; no_home. 15 | 16 | :- pred get_home_dir(home::out, io::di, io::uo) is det. 17 | 18 | :- pred expand_tilde_home(home::in, string::in, string::out) is det. 19 | 20 | :- pred expand_tilde_home_in_shell_tokens(home::in, 21 | list(shell_token)::in, list(shell_token)::out) is det. 22 | 23 | %-----------------------------------------------------------------------------% 24 | %-----------------------------------------------------------------------------% 25 | 26 | :- implementation. 27 | 28 | :- import_module bool. 29 | :- import_module maybe. 30 | :- import_module string. 31 | 32 | %-----------------------------------------------------------------------------% 33 | 34 | get_home_dir(MaybeHome, !IO) :- 35 | io.get_environment_var("HOME", MaybeEnvValue, !IO), 36 | ( 37 | MaybeEnvValue = yes(EnvValue), 38 | % Sanity check. 39 | string.prefix(EnvValue, "/") 40 | -> 41 | MaybeHome = home(EnvValue) 42 | ; 43 | MaybeHome = no_home 44 | ). 45 | 46 | %-----------------------------------------------------------------------------% 47 | 48 | expand_tilde_home(MaybeHome, String0, String) :- 49 | FollowedByWordBoundary = yes, % assume nothing follows String0 50 | expand_tilde_home_follow(MaybeHome, String0, FollowedByWordBoundary, 51 | String). 52 | 53 | :- pred expand_tilde_home_follow(home::in, string::in, bool::in, string::out) 54 | is det. 55 | 56 | expand_tilde_home_follow(MaybeHome, String0, FollowedByWordBoundary, String) :- 57 | ( 58 | MaybeHome = home(HomeDir), 59 | % We don't support ~USERNAME prefix. 60 | ( string.remove_prefix("~/", String0, String1) -> 61 | String = HomeDir ++ "/" ++ String1 62 | ; String0 = "~", FollowedByWordBoundary = yes -> 63 | String = HomeDir 64 | ; 65 | String = String0 66 | ) 67 | ; 68 | MaybeHome = no_home, 69 | String = String0 70 | ). 71 | 72 | %-----------------------------------------------------------------------------% 73 | 74 | expand_tilde_home_in_shell_tokens(Home, Tokens0, Tokens) :- 75 | list.map(expand_tilde_home_in_shell_token(Home), Tokens0, Tokens). 76 | 77 | :- pred expand_tilde_home_in_shell_token(home::in, 78 | shell_token::in, shell_token::out) is det. 79 | 80 | expand_tilde_home_in_shell_token(Home, Token0, Token) :- 81 | ( 82 | ( Token0 = whitespace 83 | ; Token0 = gmeta(_) 84 | ), 85 | Token = Token0 86 | ; 87 | Token0 = word(Segments0), 88 | expand_tilde_home_in_shell_word(Home, Segments0, Segments), 89 | Token = word(Segments) 90 | ). 91 | 92 | :- pred expand_tilde_home_in_shell_word(home::in, 93 | list(shell_word_segment)::in, list(shell_word_segment)::out) is det. 94 | 95 | expand_tilde_home_in_shell_word(Home, Segments0, Segments) :- 96 | ( 97 | Segments0 = [unquoted(Str0) | Tail] 98 | -> 99 | % ~ should expand 100 | % ~/x should expand 101 | % ~"x" should not expand 102 | ( 103 | Tail = [], 104 | FollowedByWordBoundary = yes 105 | ; 106 | Tail = [_ | _], 107 | FollowedByWordBoundary = no 108 | ), 109 | expand_tilde_home_follow(Home, Str0, FollowedByWordBoundary, Str), 110 | Segments = [unquoted(Str) | Tail] 111 | ; 112 | Segments = Segments0 113 | ). 114 | 115 | %-----------------------------------------------------------------------------% 116 | % vim: ft=mercury ts=4 sts=4 sw=4 et 117 | -------------------------------------------------------------------------------- /src/pipe_to.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2019 Peter Wang 3 | 4 | :- module pipe_to. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module list. 9 | 10 | :- import_module screen. 11 | :- import_module text_entry. 12 | 13 | :- pred prompt_and_pipe_to_command(screen::in, string::in, list(string)::in, 14 | message_update::out, history::in, history::out, io::di, io::uo) is det. 15 | 16 | %-----------------------------------------------------------------------------% 17 | %-----------------------------------------------------------------------------% 18 | 19 | :- implementation. 20 | 21 | :- import_module maybe. 22 | :- import_module parsing_utils. 23 | :- import_module string. 24 | 25 | :- import_module call_system. 26 | :- import_module path_expand. 27 | :- import_module process. 28 | :- import_module prog_config. 29 | :- import_module quote_command. 30 | :- import_module shell_word. 31 | 32 | :- use_module curs. 33 | 34 | prompt_and_pipe_to_command(Screen, PromptCommand, Strings, MessageUpdate, 35 | !History, !IO) :- 36 | text_entry(Screen, PromptCommand, !.History, complete_none, Return, !IO), 37 | ( 38 | Return = yes(Command), 39 | Command \= "" 40 | -> 41 | add_history_nodup(Command, !History), 42 | pipe_to_command(Command, Strings, MaybeError, !IO), 43 | ( 44 | MaybeError = ok, 45 | MessageUpdate = clear_message 46 | ; 47 | MaybeError = error(Error), 48 | MessageUpdate = set_warning(Error) 49 | ) 50 | ; 51 | MessageUpdate = clear_message 52 | ). 53 | 54 | :- pred pipe_to_command(string::in, list(string)::in, maybe_error::out, 55 | io::di, io::uo) is det. 56 | 57 | pipe_to_command(Command, Strings, MaybeError, !IO) :- 58 | promise_equivalent_solutions [MaybeError, !:IO] ( 59 | shell_word.tokenise(Command, ParseResult), 60 | ( 61 | ParseResult = ok(CommandTokens0), 62 | get_home_dir(Home, !IO), 63 | expand_tilde_home_in_shell_tokens(Home, 64 | CommandTokens0, CommandTokens), 65 | ( 66 | CommandTokens = [], 67 | MaybeError = ok 68 | ; 69 | CommandTokens = [_ | _], 70 | ( shell_word.contains_graphic_metachars(CommandTokens) -> 71 | Message = "Command contains unquoted metacharacters.", 72 | MaybeError = error(Message) 73 | ; 74 | pipe_to_command_2(CommandTokens, Strings, MaybeError, !IO) 75 | ) 76 | ) 77 | ; 78 | ( 79 | ParseResult = error(yes(Error), _Line, Column), 80 | Message = string.format("parse error at column %d: %s", 81 | [i(Column), s(Error)]) 82 | ; 83 | ParseResult = error(no, _Line, Column), 84 | Message = string.format("parse error at column %d", 85 | [i(Column)]) 86 | ), 87 | MaybeError = error(Message) 88 | ) 89 | ). 90 | 91 | :- pred pipe_to_command_2(list(shell_token)::in, list(string)::in, 92 | maybe_error::out, io::di, io::uo) is det. 93 | 94 | pipe_to_command_2(CommandTokens, Strings, MaybeError, !IO) :- 95 | make_pipe_to_command(CommandTokens, Command), 96 | Input = string.join_list(" ", Strings), 97 | curs.suspend(call_system_write_to_stdin(Command, environ([]), Input), 98 | CallRes, !IO), 99 | ( 100 | CallRes = ok, 101 | MaybeError = ok 102 | ; 103 | CallRes = error(Error), 104 | MaybeError = error(io.error_message(Error)) 105 | ). 106 | 107 | :- pred make_pipe_to_command(list(shell_token)::in, string::out) is det. 108 | 109 | make_pipe_to_command(CommandTokens, Command) :- 110 | % Could check for bg operator. 111 | serialise_quote_all(CommandTokens, QuotedCommandStr), 112 | QuoteTimes = ( detect_ssh(CommandTokens) -> quote_twice ; quote_once ), 113 | CommandPrefix = command_prefix(shell_quoted(QuotedCommandStr), QuoteTimes), 114 | make_quoted_command(CommandPrefix, [], no_redirect, no_redirect, Command). 115 | 116 | %-----------------------------------------------------------------------------% 117 | % vim: ft=mercury ts=4 sts=4 sw=4 et 118 | -------------------------------------------------------------------------------- /src/poll_notify.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2018 Peter Wang 3 | 4 | :- module poll_notify. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- import_module prog_config. 10 | :- import_module screen. 11 | 12 | :- pred maybe_poll_notify(prog_config::in, string::in, message_update::out, 13 | io::di, io::uo) is det. 14 | 15 | %-----------------------------------------------------------------------------% 16 | %-----------------------------------------------------------------------------% 17 | 18 | :- implementation. 19 | 20 | :- import_module list. 21 | :- import_module maybe. 22 | :- import_module string. 23 | 24 | :- import_module quote_command. 25 | 26 | maybe_poll_notify(Config, Message, MessageUpdate, !IO) :- 27 | get_poll_notify_command(Config, MaybeCommandPrefix), 28 | ( 29 | MaybeCommandPrefix = yes(CommandPrefix), 30 | make_quoted_command(CommandPrefix, [Message], 31 | redirect_input("/dev/null"), redirect_output("/dev/null"), 32 | Command), 33 | io.call_system(Command, CallRes, !IO), 34 | ( 35 | CallRes = ok(ExitStatus), 36 | ( ExitStatus = 0 -> 37 | MessageUpdate = no_change 38 | ; 39 | string.format("poll_notify command returned exit status %d", 40 | [i(ExitStatus)], Warning), 41 | MessageUpdate = set_warning(Warning) 42 | ) 43 | ; 44 | CallRes = error(Error), 45 | Warning = "Error running poll_notify command: " ++ 46 | io.error_message(Error), 47 | MessageUpdate = set_warning(Warning) 48 | ) 49 | ; 50 | MaybeCommandPrefix = no, 51 | MessageUpdate = no_change 52 | ). 53 | 54 | %-----------------------------------------------------------------------------% 55 | % vim: ft=mercury ts=4 sts=4 sw=4 et 56 | -------------------------------------------------------------------------------- /src/prog_options.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2022 Peter Wang 3 | 4 | :- module prog_options. 5 | :- interface. 6 | 7 | :- import_module bool. 8 | :- import_module list. 9 | :- import_module maybe. 10 | 11 | :- type prog_options 12 | ---> prog_options( 13 | help :: bool, 14 | version :: bool 15 | ). 16 | 17 | :- pred parse_options(list(string)::in, list(string)::out, 18 | maybe_error(prog_options)::out) is det. 19 | 20 | %-----------------------------------------------------------------------------% 21 | %-----------------------------------------------------------------------------% 22 | 23 | :- implementation. 24 | 25 | :- import_module char. 26 | :- import_module getopt. 27 | 28 | %-----------------------------------------------------------------------------% 29 | 30 | :- type option 31 | ---> help 32 | ; version. 33 | 34 | :- pred short_option(char::in, option::out) is semidet. 35 | 36 | short_option('h', help). 37 | 38 | :- pred long_option(string::in, option::out) is semidet. 39 | 40 | long_option("help", help). 41 | long_option("version", version). 42 | 43 | :- pred option_default(option::out, option_data::out) is multi. 44 | 45 | option_default(help, bool(no)). 46 | option_default(version, bool(no)). 47 | 48 | %-----------------------------------------------------------------------------% 49 | 50 | parse_options(Args, NonOptionArgs, Res) :- 51 | OptionOps = option_ops_multi(short_option, long_option, option_default), 52 | getopt.process_options(OptionOps, Args, NonOptionArgs, MaybeOptionTable), 53 | ( 54 | MaybeOptionTable = ok(OptionTable), 55 | getopt.lookup_bool_option(OptionTable, help, Help), 56 | getopt.lookup_bool_option(OptionTable, version, Version), 57 | Options = prog_options(Help, Version), 58 | Res = ok(Options) 59 | ; 60 | MaybeOptionTable = error(OptionError), 61 | Res = error(option_error_to_string(OptionError)) 62 | ). 63 | 64 | % For compatibility with older getopt.process_options predicate 65 | % which returned an error as a string instead of option_error. 66 | % 67 | :- func option_error_to_string(string) = string. 68 | :- pragma consider_used(option_error_to_string/1). 69 | 70 | option_error_to_string(S) = S. 71 | 72 | %-----------------------------------------------------------------------------% 73 | % vim: ft=mercury ts=4 sts=4 sw=4 et 74 | -------------------------------------------------------------------------------- /src/quote_arg.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module quote_arg. 5 | :- interface. 6 | 7 | :- func quote_arg(string) = string. 8 | 9 | %-----------------------------------------------------------------------------% 10 | %-----------------------------------------------------------------------------% 11 | 12 | :- implementation. 13 | 14 | :- import_module char. 15 | :- import_module string. 16 | 17 | % Same algorithm as Python shlex.quote module - should be well tested. 18 | 19 | quote_arg(String) = QuotedString :- 20 | ( String = "" -> 21 | QuotedString = "''" 22 | ; string.all_match(safe, String) -> 23 | QuotedString = String 24 | ; 25 | string.replace_all(String, "'", "'\"'\"'", QuotedString0), 26 | QuotedString = "'" ++ QuotedString0 ++ "'" 27 | ). 28 | 29 | :- pred safe(char::in) is semidet. 30 | 31 | safe(C) :- char.is_alnum_or_underscore(C). 32 | safe('%'). 33 | safe('+'). 34 | safe(','). 35 | safe('-'). 36 | safe('.'). 37 | safe('/'). 38 | safe(':'). 39 | safe('='). 40 | safe('@'). 41 | 42 | % unsafe: 43 | % I =< 0x20 44 | % ! " # $ & ' ( ) * ; < = > ? [ \ ] ^ ` { | } 45 | 46 | %-----------------------------------------------------------------------------% 47 | % vim: ft=mercury ts=4 sts=4 sw=4 et 48 | -------------------------------------------------------------------------------- /src/quote_command.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module quote_command. 5 | :- interface. 6 | 7 | :- import_module list. 8 | 9 | :- type command_prefix 10 | ---> command_prefix(shell_quoted, quote_times). 11 | 12 | :- type shell_quoted 13 | ---> shell_quoted(string). % shell metacharacters quoted/escaped 14 | 15 | % Number of times to quote arguments. 16 | :- type quote_times 17 | ---> quote_once 18 | ; quote_twice. 19 | 20 | :- type redirect_input 21 | ---> no_redirect 22 | ; redirect_input(string). 23 | 24 | :- type redirect_output 25 | ---> no_redirect 26 | ; redirect_output(string) 27 | ; redirect_append(string). 28 | 29 | :- type redirect_stderr 30 | ---> no_redirect 31 | ; redirect_stderr(string). 32 | 33 | :- type run_in_background 34 | ---> run_in_foreground 35 | ; run_in_background. 36 | 37 | :- pred make_quoted_command(command_prefix::in, list(string)::in, 38 | redirect_input::in, redirect_output::in, string::out) is det. 39 | 40 | :- pred make_quoted_command(command_prefix::in, list(string)::in, 41 | redirect_input::in, redirect_output::in, redirect_stderr::in, 42 | run_in_background::in, string::out) is det. 43 | 44 | %-----------------------------------------------------------------------------% 45 | %-----------------------------------------------------------------------------% 46 | 47 | :- implementation. 48 | 49 | :- import_module std_util. 50 | :- import_module string. 51 | 52 | :- import_module quote_arg. 53 | 54 | %-----------------------------------------------------------------------------% 55 | 56 | make_quoted_command(CommandPrefix, UnquotedArgs, RedirectInput, RedirectOutput, 57 | Command) :- 58 | make_quoted_command(CommandPrefix, UnquotedArgs, RedirectInput, 59 | RedirectOutput, no_redirect, run_in_foreground, Command). 60 | 61 | make_quoted_command(command_prefix(Prefix, QuoteTimes), UnquotedArgs, 62 | RedirectInput, RedirectOutput, RedirectStderr, RunInBackground, 63 | Command) :- 64 | some [!Acc] ( 65 | Prefix = shell_quoted(PrefixString), 66 | !:Acc = ["exec", PrefixString | do_quote(QuoteTimes, UnquotedArgs)], 67 | ( 68 | RedirectInput = redirect_input(InputFile), 69 | !:Acc = !.Acc ++ ["<", quote_arg(InputFile)] 70 | ; 71 | RedirectInput = no_redirect 72 | ), 73 | ( 74 | RedirectOutput = redirect_output(OutputFile), 75 | !:Acc = !.Acc ++ [">", quote_arg(OutputFile)] 76 | ; 77 | RedirectOutput = redirect_append(OutputFile), 78 | !:Acc = !.Acc ++ [">>", quote_arg(OutputFile)] 79 | ; 80 | RedirectOutput = no_redirect 81 | ), 82 | ( 83 | RedirectStderr = redirect_stderr(ErrorFile), 84 | !:Acc = !.Acc ++ ["2>", quote_arg(ErrorFile)] 85 | ; 86 | RedirectStderr = no_redirect 87 | ), 88 | ( 89 | RunInBackground = run_in_background, 90 | !:Acc = !.Acc ++ ["&"] 91 | ; 92 | RunInBackground = run_in_foreground 93 | ), 94 | Command = string.join_list(" ", !.Acc) 95 | ). 96 | 97 | :- func do_quote(quote_times, list(string)) = list(string). 98 | 99 | do_quote(quote_once, Args) = list.map(quote_arg, Args). 100 | do_quote(quote_twice, Args) = list.map(compose(quote_arg, quote_arg), Args). 101 | 102 | %-----------------------------------------------------------------------------% 103 | % vim: ft=mercury ts=4 sts=4 sw=4 et 104 | -------------------------------------------------------------------------------- /src/regex.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2023 Peter Wang 3 | 4 | :- module regex. 5 | :- interface. 6 | 7 | :- import_module list. 8 | :- import_module maybe. 9 | 10 | :- type regex. 11 | 12 | :- type cflag 13 | ---> reg_extended 14 | ; reg_icase 15 | ; reg_nosub 16 | ; reg_newline. 17 | 18 | :- type eflag 19 | ---> reg_notbol 20 | ; reg_noteol. 21 | 22 | % regcomp(Regex, CFlags, Res): 23 | % Compile a regular expression. 24 | % 25 | :- pred regcomp(string::in, list(cflag)::in, maybe_error(regex)::out) is det. 26 | 27 | :- type regexec_result 28 | ---> have_match(list(regmatch)) 29 | ; no_match 30 | ; error(string). 31 | 32 | :- type regmatch 33 | ---> regmatch( 34 | rm_start_offset :: int, % can be -1 35 | rm_end_offset :: int % can be -1 36 | ). 37 | 38 | % regexec(Reg, String, EFlags, Res): 39 | % Match String against the compiled pattern Reg. 40 | % 41 | % Warning: not thread-safe. 42 | % Do not use the same regex from multiple threads simultaneously. 43 | % 44 | :- pred regexec(regex::in, string::in, list(eflag)::in, regexec_result::out) 45 | is det. 46 | 47 | % unsafe_regexec_offset(Reg, String, BeginAt, EFlags, Res): 48 | % Same as above, but begin searching from an offset into the string. 49 | % The offset is UNCHECKED. 50 | % 51 | :- pred unsafe_regexec_offset(regex::in, string::in, int::in, list(eflag)::in, 52 | regexec_result::out) is det. 53 | 54 | %-----------------------------------------------------------------------------% 55 | %-----------------------------------------------------------------------------% 56 | 57 | :- implementation. 58 | 59 | :- import_module bool. 60 | :- import_module int. 61 | 62 | :- pragma foreign_decl("C", "#include "). 63 | 64 | :- pragma foreign_type("C", regex, "regex_t *"). 65 | 66 | :- pragma foreign_decl("C", local, " 67 | static void 68 | REGEX_finalize_regex(void *reg0, void *client_data) 69 | { 70 | regex_t *reg = reg0; 71 | (void) client_data; 72 | 73 | regfree(reg); 74 | } 75 | "). 76 | 77 | %-----------------------------------------------------------------------------% 78 | 79 | :- type cflags == int. 80 | :- type eflags == int. 81 | 82 | :- pragma foreign_enum("C", cflag/0, 83 | [ 84 | reg_extended - "REG_EXTENDED", 85 | reg_icase - "REG_ICASE", 86 | reg_nosub - "REG_NOSUB", 87 | reg_newline - "REG_NEWLINE" 88 | ]). 89 | 90 | :- pragma foreign_enum("C", eflag/0, 91 | [ 92 | reg_notbol - "REG_NOTBOL", 93 | reg_noteol - "REG_NOTEOL" 94 | ]). 95 | 96 | :- func cflag_to_int(cflag) = int. 97 | 98 | :- pragma foreign_proc("C", 99 | cflag_to_int(CFlag::in) = (Int::out), 100 | [will_not_call_mercury, promise_pure, thread_safe], 101 | " 102 | Int = CFlag; 103 | "). 104 | 105 | :- func eflag_to_int(eflag) = int. 106 | 107 | :- pragma foreign_proc("C", 108 | eflag_to_int(EFlag::in) = (Int::out), 109 | [will_not_call_mercury, promise_pure, thread_safe], 110 | " 111 | Int = EFlag; 112 | "). 113 | 114 | :- func or_list(func(T) = int, list(T)) = int. 115 | 116 | or_list(_F, []) = 0. 117 | or_list(F, [X | Xs]) = F(X) \/ or_list(F, Xs). 118 | 119 | %-----------------------------------------------------------------------------% 120 | 121 | regcomp(Str, CFlags, Res) :- 122 | CFlagsInt = or_list(cflag_to_int, CFlags), 123 | regcomp0(Str, CFlagsInt, ErrCode, Reg), 124 | ( if ErrCode = 0 then 125 | Res = ok(Reg) 126 | else 127 | regerror(ErrCode, Reg, Error), 128 | Res = error(Error) 129 | ). 130 | 131 | :- pred regcomp0(string::in, cflags::in, int::out, regex::out) is det. 132 | 133 | :- pragma foreign_proc("C", 134 | regcomp0(Str::in, CFlags::in, ErrCode::out, Reg::out), 135 | [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate], 136 | " 137 | Reg = MR_GC_NEW_ATTRIB(regex_t, MR_ALLOC_ID); 138 | ErrCode = regcomp(Reg, Str, CFlags); 139 | if (ErrCode == 0) { 140 | MR_GC_register_finalizer(Reg, REGEX_finalize_regex, 0); 141 | } 142 | "). 143 | 144 | %-----------------------------------------------------------------------------% 145 | 146 | regexec(Reg, Str, EFlags, Res) :- 147 | unsafe_regexec_offset(Reg, Str, 0, EFlags, Res). 148 | 149 | unsafe_regexec_offset(Reg, Str, BeginAt, EFlags, Res) :- 150 | EFlagsInt = or_list(eflag_to_int, EFlags), 151 | regexec0(Reg, Str, BeginAt, EFlagsInt, ErrCode, HaveMatch, Matches), 152 | ( if ErrCode = 0 then 153 | ( 154 | HaveMatch = yes, 155 | Res = have_match(Matches) 156 | ; 157 | HaveMatch = no, 158 | Res = no_match 159 | ) 160 | else 161 | % Even if regexec() is thread-safe, this call would not be. 162 | regerror(ErrCode, Reg, Error), 163 | Res = error(Error) 164 | ). 165 | 166 | :- pred regexec0(regex::in, string::in, int::in, eflags::in, 167 | int::out, bool::out, list(regmatch)::out) is det. 168 | 169 | :- pragma foreign_proc("C", 170 | regexec0(Reg::in, Str::in, BeginAt::in, EFlags::in, 171 | ErrCode::out, HaveMatch::out, MatchList::out), 172 | [may_call_mercury, promise_pure, thread_safe, may_not_duplicate], 173 | " 174 | regmatch_t *matches; 175 | int nmatch; 176 | int rc; 177 | int i; 178 | 179 | // If we had cflags, we could test for REG_NOSUB and skip this. 180 | nmatch = 1 + Reg->re_nsub; 181 | matches = MR_GC_NEW_ARRAY_ATTRIB(regmatch_t, nmatch, MR_ALLOC_ID); 182 | 183 | rc = regexec(Reg, Str + BeginAt, nmatch, matches, EFlags); 184 | 185 | if (rc == 0) { 186 | ErrCode = 0; 187 | HaveMatch = MR_YES; 188 | MatchList = MR_list_empty(); 189 | for (i = nmatch - 1; i >= 0; i--) { 190 | MR_Word m = REGEX_make_regmatch(BeginAt, 191 | matches[i].rm_so, matches[i].rm_eo); 192 | MatchList = MR_list_cons(m, MatchList); 193 | } 194 | } else if (rc == REG_NOMATCH) { 195 | ErrCode = 0; 196 | HaveMatch = MR_NO; 197 | MatchList = MR_list_empty(); 198 | } else { 199 | ErrCode = rc; 200 | HaveMatch = MR_NO; 201 | MatchList = MR_list_empty(); 202 | } 203 | "). 204 | 205 | :- func make_regmatch(int, int, int) = regmatch. 206 | :- pragma foreign_export("C", make_regmatch(in, in, in) = out, 207 | "REGEX_make_regmatch"). 208 | 209 | make_regmatch(BeginAt, StartOfs, EndOfs) = 210 | regmatch(BeginAt + StartOfs, BeginAt + EndOfs). 211 | 212 | %-----------------------------------------------------------------------------% 213 | 214 | :- pred regerror(int::in, regex::in, string::out) is det. 215 | 216 | :- pragma foreign_proc("C", 217 | regerror(ErrCode::in, Reg::in, Error::out), 218 | [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate], 219 | " 220 | char errbuf[256]; 221 | 222 | regerror(ErrCode, Reg, errbuf, sizeof(errbuf)); // null terminated 223 | MR_make_aligned_string_copy_msg(Error, errbuf, MR_ALLOC_ID); 224 | "). 225 | 226 | %-----------------------------------------------------------------------------% 227 | % vim: ft=mercury ts=4 sts=4 sw=4 et 228 | -------------------------------------------------------------------------------- /src/rfc2045.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module rfc2045. 5 | :- interface. 6 | 7 | :- import_module bool. 8 | :- import_module char. 9 | :- import_module pair. 10 | 11 | :- import_module rfc5322. 12 | 13 | :- type token 14 | ---> token(string). 15 | 16 | :- type parameter == pair(attribute, value). 17 | 18 | :- type attribute 19 | ---> attribute(string). % case-insensitive; keep in lowercase 20 | 21 | :- type value 22 | ---> token(token) 23 | ; quoted_string(quoted_string). 24 | 25 | :- pred token_char(char::in) is semidet. 26 | 27 | :- pred parameter_to_string(parameter::in, string::out, bool::out) is det. 28 | 29 | %-----------------------------------------------------------------------------% 30 | %-----------------------------------------------------------------------------% 31 | 32 | :- implementation. 33 | 34 | :- import_module int. 35 | :- import_module list. 36 | :- import_module string. 37 | 38 | :- import_module rfc5322.writer. 39 | 40 | :- type acc == list(string). % reverse 41 | 42 | %-----------------------------------------------------------------------------% 43 | 44 | token_char(Char) :- 45 | char.to_int(Char, Int), 46 | % Exclude SPACE, CTL (0-31 and DEL), and non-ASCII. 47 | 0x20 < Int, Int < 0x7f, 48 | not tspecial(Char). 49 | 50 | :- pred tspecial(char::in) is semidet. 51 | 52 | tspecial('('). tspecial(')'). tspecial('<'). tspecial('>'). tspecial('@'). 53 | tspecial(','). tspecial(';'). tspecial(':'). tspecial('\\'). tspecial('"'). 54 | tspecial('/'). tspecial('['). tspecial(']'). tspecial('?'). tspecial('='). 55 | 56 | %-----------------------------------------------------------------------------% 57 | 58 | parameter_to_string(Attr - Value, String, !:Ok) :- 59 | some [!Acc] ( 60 | !:Acc = [], 61 | !:Ok = yes, 62 | attribute(Attr, !Acc, !Ok), 63 | cons("=", !Acc), 64 | value(Value, !Acc, !Ok), 65 | list.reverse(!.Acc, Strings), 66 | string.append_list(Strings, String) 67 | ). 68 | 69 | :- pred token(token::in, acc::in, acc::out, bool::in, bool::out) is det. 70 | 71 | token(token(String), !Acc, !Ok) :- 72 | cons(String, !Acc). 73 | 74 | :- pred attribute(attribute::in, acc::in, acc::out, bool::in, bool::out) 75 | is det. 76 | 77 | attribute(attribute(String), !Acc, !Ok) :- 78 | token(token(String), !Acc, !Ok). 79 | 80 | :- pred value(value::in, acc::in, acc::out, bool::in, bool::out) is det. 81 | 82 | value(token(Token), !Acc, !Ok) :- 83 | token(Token, !Acc, !Ok). 84 | value(quoted_string(QuotedString), !Acc, !Ok) :- 85 | quoted_string_ascii_only(QuotedString, !Acc, !Ok). 86 | 87 | %-----------------------------------------------------------------------------% 88 | % vim: ft=mercury ts=4 sts=4 sw=4 et 89 | -------------------------------------------------------------------------------- /src/rfc2047.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module rfc2047. 5 | :- interface. 6 | 7 | :- include_module rfc2047.encoder. 8 | :- include_module rfc2047.decoder. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module char. 16 | :- import_module list. 17 | :- import_module stream. 18 | 19 | :- use_module base64. 20 | 21 | % Build up a list of octets for base64 encoding/decoding. 22 | % We could use destructively-updated buffers for efficiency. 23 | 24 | :- type octets_builder 25 | ---> octets_builder. 26 | 27 | :- type octets 28 | ---> octets(list(int)). % reverse 29 | 30 | :- instance stream.stream(octets_builder, octets) where [ 31 | name(_, "octets_builder", !State) 32 | ]. 33 | :- instance stream.output(octets_builder, octets) where [ 34 | flush(_, !State) 35 | ]. 36 | :- instance stream.writer(octets_builder, base64.byte, octets) where [ 37 | put(octets_builder, Byte, octets(Acc0), octets(Acc)) :- ( 38 | copy(Byte, UniqueByte), 39 | Acc = [UniqueByte | Acc0] 40 | ) 41 | ]. 42 | :- instance stream.writer(octets_builder, char, octets) where [ 43 | put(octets_builder, Char, octets(Acc0), octets(Acc)) :- ( 44 | char.to_int(Char, Byte), 45 | copy(Byte, UniqueByte), 46 | Acc = [UniqueByte | Acc0] 47 | ) 48 | ]. 49 | 50 | %-----------------------------------------------------------------------------% 51 | % vim: ft=mercury ts=4 sts=4 sw=4 et 52 | -------------------------------------------------------------------------------- /src/rfc2231.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module rfc2231. 5 | :- interface. 6 | 7 | :- import_module rfc2045. 8 | 9 | :- pred encode_parameter(parameter::in, parameter::out) is det. 10 | 11 | %-----------------------------------------------------------------------------% 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- implementation. 15 | 16 | :- import_module char. 17 | :- import_module int. 18 | :- import_module list. 19 | :- import_module pair. 20 | :- import_module string. 21 | :- use_module require. 22 | 23 | :- import_module rfc5234. 24 | :- import_module rfc5322. 25 | :- import_module string_util. 26 | 27 | % See also RFC 5987 (the application to HTTP) which is a whole lot more 28 | % comprehensible than RFC 2231. 29 | 30 | %-----------------------------------------------------------------------------% 31 | 32 | encode_parameter(Parameter0, Parameter) :- 33 | Parameter0 = Attribute0 - Value0, 34 | ( 35 | Value0 = token(_), 36 | Parameter = Parameter0 37 | ; 38 | Value0 = quoted_string(quoted_string(ascii(_))), 39 | Parameter = Parameter0 40 | ; 41 | Value0 = quoted_string(quoted_string(unicode(String0))), 42 | % We don't break up long values into multiple sections. We only use 43 | % this to encode the filename parameter in Content-Disposition bodies. 44 | Attribute = Attribute0 ++ "*", 45 | encode_string(String0, String1), 46 | Token = token("UTF-8''" ++ String1), 47 | Parameter = Attribute - token(Token) 48 | ). 49 | 50 | :- func attribute ++ string = attribute. 51 | 52 | attribute(Attr) ++ Section = attribute(Attr ++ Section). 53 | 54 | :- pred encode_string(string::in, string::out) is det. 55 | 56 | encode_string(String, TokenString) :- 57 | foldr_code_units(encode_octet, String, [], Chars), 58 | string.from_char_list(Chars, TokenString). 59 | 60 | :- pred encode_octet(int::in, list(char)::in, list(char)::out) is det. 61 | 62 | encode_octet(Octet, TokenChars0, TokenChars) :- 63 | ( 64 | Octet =< 0x7f, 65 | char.from_int(Octet, Char), 66 | unencoded_value_chars(Char) 67 | -> 68 | TokenChars = [Char | TokenChars0] 69 | ; 70 | Hi = (Octet /\ 0xf0) >> 4, 71 | Lo = (Octet /\ 0x0f), 72 | ( 73 | char.int_to_hex_char(Hi, HiChar), 74 | char.int_to_hex_char(Lo, LoChar) 75 | -> 76 | TokenChars = ['%', HiChar, LoChar | TokenChars0] 77 | ; 78 | require.unexpected($module, $pred, "char.int_to_hex_char failed") 79 | ) 80 | ). 81 | 82 | % RFC 5987 explicitly lists the characters that can appear without percent 83 | % encoding. We add '{' and '}' from the RFC 2045 token production, which 84 | % are excluded from RFC 2616. 85 | % 86 | :- pred unencoded_value_chars(char::in) is semidet. 87 | 88 | unencoded_value_chars(C) :- 89 | ( 'ALPHA'(C) 90 | ; 'DIGIT'(C) 91 | ; C = ('!') 92 | ; C = ('#') 93 | ; C = ('$') 94 | ; C = ('&') 95 | ; C = ('+') 96 | ; C = ('-') 97 | ; C = ('.') 98 | ; C = ('^') 99 | ; C = ('_') 100 | ; C = ('`') 101 | ; C = ('|') 102 | ; C = ('~') 103 | ; C = ('{') 104 | ; C = ('}') 105 | ). 106 | 107 | %-----------------------------------------------------------------------------% 108 | % vim: ft=mercury ts=4 sts=4 sw=4 et 109 | -------------------------------------------------------------------------------- /src/rfc5234.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2015 Peter Wang 3 | 4 | :- module rfc5234. 5 | :- interface. 6 | 7 | :- import_module char. 8 | 9 | :- pred 'ALPHA'(char::in) is semidet. 10 | 11 | :- pred 'DIGIT'(char::in) is semidet. 12 | 13 | :- func 'DQUOTE' = char. 14 | 15 | :- pred 'HEXDIG'(char::in, int::out) is semidet. 16 | 17 | :- pred 'VCHAR'(char::in) is semidet. 18 | 19 | :- pred 'WSP'(char::in) is semidet. 20 | 21 | :- pred not_WSP(char::in) is semidet. 22 | 23 | %-----------------------------------------------------------------------------% 24 | %-----------------------------------------------------------------------------% 25 | 26 | :- implementation. 27 | 28 | :- import_module int. 29 | 30 | 'ALPHA'(C) :- 31 | char.is_alpha(C). 32 | 33 | 'DIGIT'(C) :- 34 | char.is_digit(C). 35 | 36 | 'DQUOTE' = '"'. 37 | 38 | 'HEXDIG'(C, I) :- 39 | char.is_hex_digit(C, I). 40 | 41 | 'VCHAR'(C) :- 42 | char.to_int(C, I), 43 | 0x20 =< I, I =< 0x7e. 44 | 45 | 'WSP'(' '). 46 | 'WSP'('\t'). 47 | 48 | not_WSP(C) :- 49 | not 'WSP'(C). 50 | 51 | %-----------------------------------------------------------------------------% 52 | % vim: ft=mercury ts=4 sts=4 sw=4 et 53 | -------------------------------------------------------------------------------- /src/rfc5322.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module rfc5322. 5 | :- interface. 6 | 7 | :- import_module bool. 8 | :- import_module char. 9 | :- import_module list. 10 | :- import_module maybe. 11 | 12 | :- include_module rfc5322.parser. 13 | :- include_module rfc5322.writer. 14 | 15 | %-----------------------------------------------------------------------------% 16 | 17 | :- type ascii_unicode 18 | ---> ascii(string) 19 | ; unicode(string). 20 | 21 | :- type atom 22 | ---> atom(ascii_unicode). 23 | 24 | :- type dot_atom 25 | ---> dot_atom(ascii_unicode). 26 | 27 | :- type quoted_string 28 | ---> quoted_string(ascii_unicode). 29 | 30 | :- type word 31 | ---> word_atom(atom) 32 | ; word_quoted_string(quoted_string). 33 | 34 | :- type phrase == list(word). 35 | 36 | :- type address_list == list(address). 37 | 38 | :- type address 39 | ---> mailbox(mailbox) 40 | ; group( 41 | display_name, 42 | list(mailbox) 43 | ). 44 | 45 | :- type mailbox 46 | ---> mailbox( 47 | maybe(display_name), 48 | addr_spec 49 | ) 50 | ; bad_mailbox(string). 51 | 52 | :- type display_name == phrase. 53 | 54 | :- type addr_spec 55 | ---> addr_spec(local_part, domain). 56 | 57 | :- type local_part 58 | ---> lpart_atom(dot_atom) 59 | ; lpart_quoted_string(quoted_string). 60 | 61 | :- type domain 62 | ---> domain_name(dot_atom) 63 | ; domain_literal(ascii_unicode). % [blah] 64 | 65 | %-----------------------------------------------------------------------------% 66 | 67 | % Exports for rfc2047, rfc2231, rfc6068. 68 | 69 | :- pred ascii(char::in) is semidet. 70 | 71 | :- pred nonascii(char::in) is semidet. 72 | 73 | :- pred header_name_char(char::in) is semidet. 74 | 75 | :- pred atext(char::in) is semidet. 76 | 77 | :- pred atext_or_nonascii(char::in) is semidet. 78 | 79 | :- pred atext_or_nonascii(char::in, bool::in, bool::out) is semidet. 80 | 81 | :- pred dtext_no_obs(char::in) is semidet. 82 | 83 | :- pred qtext(char::in) is semidet. 84 | 85 | :- func make_quoted_string(string) = quoted_string. 86 | 87 | :- func word_to_string(word) = string. 88 | 89 | %-----------------------------------------------------------------------------% 90 | %-----------------------------------------------------------------------------% 91 | 92 | :- implementation. 93 | 94 | :- import_module int. 95 | :- import_module string. 96 | 97 | :- import_module rfc5234. 98 | 99 | %-----------------------------------------------------------------------------% 100 | 101 | ascii(C) :- 102 | char.to_int(C, I), 103 | I =< 0x7f. 104 | 105 | nonascii(C) :- 106 | char.to_int(C, I), 107 | I > 0x7f. 108 | 109 | %-----------------------------------------------------------------------------% 110 | 111 | % 2.2. Header Fields 112 | 113 | header_name_char(C) :- 114 | char.to_int(C, I), 115 | I >= 33, 116 | I =< 126. 117 | 118 | %-----------------------------------------------------------------------------% 119 | 120 | % 3.2.3. Atom 121 | 122 | atext(C) :- 123 | ( 124 | 'ALPHA'(C) 125 | ; 126 | 'DIGIT'(C) 127 | ; 128 | ( C = ('!') ; C = ('#') 129 | ; C = ('$') ; C = ('%') 130 | ; C = ('&') ; C = ('\'') 131 | ; C = ('*') ; C = ('+') 132 | ; C = ('-') ; C = ('/') 133 | ; C = ('=') ; C = ('?') 134 | ; C = ('^') ; C = ('_') 135 | ; C = ('`') ; C = ('{') 136 | ; C = ('|') ; C = ('}') 137 | ; C = ('~') 138 | ) 139 | ). 140 | 141 | atext_or_nonascii(C) :- 142 | ( 143 | atext(C) 144 | ; 145 | nonascii(C) 146 | ). 147 | 148 | atext_or_nonascii(C, !AllAscii) :- 149 | ( atext(C) -> 150 | true 151 | ; 152 | nonascii(C), 153 | !:AllAscii = no 154 | ). 155 | 156 | dtext_no_obs(C) :- 157 | char.to_int(C, I), 158 | ( 33 =< I, I =< 90 159 | ; 94 =< I, I =< 126 160 | ). 161 | 162 | qtext(C) :- 163 | char.to_int(C, I), 164 | ( I = 33 165 | ; 35 =< I, I =< 91 166 | ; 93 =< I, I =< 126 167 | ). 168 | % or obs-qtext 169 | 170 | make_quoted_string(String) = quoted_string(Wrap) :- 171 | ( string.all_match(ascii, String) -> 172 | Wrap = ascii(String) 173 | ; 174 | Wrap = unicode(String) 175 | ). 176 | 177 | word_to_string(Word) = String :- 178 | ( Word = word_atom(atom(Wrap)) 179 | ; Word = word_quoted_string(quoted_string(Wrap)) 180 | ), 181 | ( Wrap = ascii(String) 182 | ; Wrap = unicode(String) 183 | ). 184 | 185 | %-----------------------------------------------------------------------------% 186 | % vim: ft=mercury ts=4 sts=4 sw=4 et 187 | -------------------------------------------------------------------------------- /src/sanitise.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2020 Peter Wang 3 | 4 | :- module sanitise. 5 | :- interface. 6 | 7 | :- type presentable_string 8 | ---> presentable_string(string). 9 | 10 | % Replace all ASCII whitespace characters with SPACE (U+0020) and 11 | % ASCII unprintable characters with U+FFFD. 12 | % 13 | :- func make_presentable(string) = presentable_string. 14 | 15 | %-----------------------------------------------------------------------------% 16 | %-----------------------------------------------------------------------------% 17 | 18 | :- implementation. 19 | 20 | :- import_module char. 21 | :- import_module int. 22 | :- import_module list. 23 | :- import_module string. 24 | 25 | :- import_module char_util. 26 | :- import_module string_util. 27 | 28 | make_presentable(S0) = presentable_string(S) :- 29 | ( string.all_match(is_printable, S0) -> 30 | S1 = S0 31 | ; 32 | % Not the most efficient but should be rarely reached. 33 | string.to_char_list(S0, Chars0), 34 | list.map(sanitise_char, Chars0, Chars), 35 | string.from_char_list(Chars, S1) 36 | ), 37 | collapse_spaces(S1, S). 38 | 39 | :- pred sanitise_char(char::in, char::out) is det. 40 | 41 | sanitise_char(C0, C) :- 42 | ( is_printable(C0) -> 43 | C = C0 44 | ; char.is_whitespace(C0) -> 45 | C = (' ') 46 | ; 47 | C = ('\ufffd') 48 | ). 49 | 50 | :- pred collapse_spaces(string::in, string::out) is det. 51 | 52 | collapse_spaces(S0, S) :- 53 | collapse_spaces_between(S0, 0, string.length(S0), S). 54 | 55 | :- pred collapse_spaces_between(string::in, int::in, int::in, string::out) 56 | is det. 57 | 58 | collapse_spaces_between(S0, Start, End, S) :- 59 | ( sub_string_search_start(S0, " ", Start, SpIndex) -> 60 | skip_whitespace(S0, SpIndex, NonSpIndex), 61 | string.unsafe_between(S0, Start, SpIndex + 1, Head), 62 | collapse_spaces_between(S0, NonSpIndex, End, Tail), 63 | S = Head ++ Tail 64 | ; 65 | ( Start = 0 -> 66 | S = S0 67 | ; Start = End -> 68 | S = "" 69 | ; 70 | string.unsafe_between(S0, Start, End, S) 71 | ) 72 | ). 73 | 74 | %-----------------------------------------------------------------------------% 75 | % vim: ft=mercury ts=4 sts=4 sw=4 et 76 | -------------------------------------------------------------------------------- /src/signal.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2013 Peter Wang 3 | 4 | :- module signal. 5 | :- interface. 6 | 7 | :- import_module bool. 8 | :- import_module io. 9 | 10 | :- pred ignore_sigint(bool::in, io::di, io::uo) is det. 11 | 12 | :- pred get_sigint_count(int::out, io::di, io::uo) is det. 13 | 14 | :- pred kill_self_with_sigint(io::di, io::uo) is erroneous. 15 | 16 | %-----------------------------------------------------------------------------% 17 | %-----------------------------------------------------------------------------% 18 | 19 | :- implementation. 20 | 21 | :- pragma foreign_decl("C", local, " 22 | #include 23 | 24 | static sig_atomic_t sigint_count; 25 | static void sigint_handler(int sig); 26 | "). 27 | 28 | :- pragma foreign_code("C", " 29 | static void 30 | sigint_handler(int sig) 31 | { 32 | (void) sig; 33 | sigint_count++; 34 | } 35 | "). 36 | 37 | :- pragma foreign_proc("C", 38 | ignore_sigint(Ignore::in, _IO0::di, _IO::uo), 39 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 40 | may_not_duplicate], 41 | " 42 | struct sigaction act; 43 | 44 | act.sa_handler = (Ignore ? SIG_IGN : sigint_handler); 45 | sigemptyset(&act.sa_mask); 46 | act.sa_flags = 0; 47 | sigaction(SIGINT, &act, NULL); 48 | "). 49 | 50 | :- pragma foreign_proc("C", 51 | get_sigint_count(N::out, _IO0::di, _IO::uo), 52 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 53 | may_not_duplicate], 54 | " 55 | N = sigint_count; 56 | "). 57 | 58 | :- pragma foreign_proc("C", 59 | kill_self_with_sigint(_IO0::di, _IO::uo), 60 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 61 | may_not_duplicate], 62 | " 63 | struct sigaction act; 64 | 65 | /* Restore default signal handler. */ 66 | act.sa_handler = SIG_DFL; 67 | sigemptyset(&act.sa_mask); 68 | act.sa_flags = 0; 69 | sigaction(SIGINT, &act, NULL); 70 | 71 | /* Kill self. */ 72 | kill(getpid(), SIGINT); 73 | "). 74 | 75 | %-----------------------------------------------------------------------------% 76 | % vim: ft=mercury ts=4 sts=4 sw=4 et 77 | -------------------------------------------------------------------------------- /src/size_util.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2019 Peter Wang 3 | 4 | :- module size_util. 5 | :- interface. 6 | 7 | :- import_module maybe. 8 | 9 | :- import_module data. 10 | 11 | :- pred estimate_decoded_length(maybe(content_transfer_encoding)::in, int::in, 12 | int::out) is semidet. 13 | 14 | :- func format_approx_length(int) = string. 15 | 16 | %-----------------------------------------------------------------------------% 17 | %-----------------------------------------------------------------------------% 18 | 19 | :- implementation. 20 | 21 | :- import_module float. 22 | :- import_module int. 23 | :- import_module list. 24 | :- import_module string. 25 | 26 | estimate_decoded_length(MaybeCTE, Length, DecodedLength) :- 27 | MaybeCTE = yes(content_transfer_encoding("base64")), 28 | % DecodedLength = Length * 3 / 4. 29 | % This produces a better estimate assuming the usual line breaks. 30 | DecodedLength = round_to_int(float(Length) * 0.7402595). 31 | 32 | format_approx_length(Size) = String :- 33 | ( Size = 0 -> 34 | String = "0 bytes" 35 | ; Size =< 1000000 -> 36 | Ks = float(Size) / 1000.0, 37 | String = format("%.1f kB", [f(Ks)]) 38 | ; 39 | Ms = float(Size) / 1000000.0, 40 | String = format("%.1f MB", [f(Ms)]) 41 | ). 42 | 43 | %-----------------------------------------------------------------------------% 44 | % vim: ft=mercury ts=4 sts=4 sw=4 et 45 | -------------------------------------------------------------------------------- /src/sleep.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2012 Peter Wang 3 | 4 | :- module sleep. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- pred sleep(int::in, io::di, io::uo) is det. 10 | 11 | :- pred usleep(int::in, io::di, io::uo) is det. 12 | 13 | %-----------------------------------------------------------------------------% 14 | %-----------------------------------------------------------------------------% 15 | 16 | :- implementation. 17 | 18 | :- pragma foreign_decl("C", local, " 19 | #include 20 | "). 21 | 22 | :- pragma foreign_proc("C", 23 | sleep(Secs::in, _IO0::di, _IO::uo), 24 | [will_not_call_mercury, promise_pure, thread_safe], 25 | " 26 | sleep(Secs); 27 | "). 28 | 29 | :- pragma foreign_proc("C", 30 | usleep(Usecs::in, _IO0::di, _IO::uo), 31 | [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate], 32 | " 33 | usleep(Usecs); 34 | "). 35 | 36 | %-----------------------------------------------------------------------------% 37 | % vim: ft=mercury ts=4 sts=4 sw=4 et 38 | -------------------------------------------------------------------------------- /src/splitmix64.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module splitmix64. 4 | :- interface. 5 | 6 | :- type splitmix64. 7 | 8 | % The state can be seeded with any value. 9 | % 10 | :- pred init(int::in, splitmix64::out) is det. 11 | 12 | :- pred next(int::out, splitmix64::in, splitmix64::out) is det. 13 | 14 | %-----------------------------------------------------------------------------% 15 | %-----------------------------------------------------------------------------% 16 | 17 | :- implementation. 18 | 19 | % Adapted from 20 | 21 | /* Written in 2015 by Sebastiano Vigna (vigna@acm.org) 22 | 23 | To the extent possible under law, the author has dedicated all copyright 24 | and related and neighboring rights to this software to the public domain 25 | worldwide. This software is distributed without any warranty. 26 | 27 | See . */ 28 | 29 | /* This is a fixed-increment version of Java 8's SplittableRandom generator 30 | See http://dx.doi.org/10.1145/2714064.2660195 and 31 | http://docs.oracle.com/javase/8/docs/api/java/util/SplittableRandom.html 32 | 33 | It is a very fast generator passing BigCrush, and it can be useful if 34 | for some reason you absolutely want 64 bits of state; otherwise, we 35 | rather suggest to use a xoroshiro128+ (for moderately parallel 36 | computations) or xorshift1024* (for massively parallel computations) 37 | generator. */ 38 | 39 | :- pragma foreign_decl("C", "#include "). 40 | 41 | :- pragma foreign_type("C", splitmix64, "uint64_t"). 42 | 43 | :- pragma foreign_proc("C", 44 | init(Seed::in, X::out), 45 | [will_not_call_mercury, promise_pure, thread_safe], 46 | " 47 | X = Seed; 48 | "). 49 | 50 | :- pragma foreign_proc("C", 51 | next(Next::out, X0::in, X::out), 52 | [will_not_call_mercury, promise_pure, thread_safe], 53 | " 54 | uint64_t z; 55 | X = X0 + UINT64_C(0x9E3779B97F4A7C15); 56 | z = X; 57 | z = (z ^ (z >> 30)) * UINT64_C(0xBF58476D1CE4E5B9); 58 | z = (z ^ (z >> 27)) * UINT64_C(0x94D049BB133111EB); 59 | z = (z ^ (z >> 31)); 60 | Next = z; 61 | "). 62 | 63 | %-----------------------------------------------------------------------------% 64 | -------------------------------------------------------------------------------- /src/sys_util.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module sys_util. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- pred get_pid(int::out, io::di, io::uo) is det. 10 | 11 | %-----------------------------------------------------------------------------% 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- implementation. 15 | 16 | :- pragma foreign_decl("C", local, 17 | " 18 | #include 19 | "). 20 | 21 | %-----------------------------------------------------------------------------% 22 | 23 | :- pragma foreign_proc("C", 24 | get_pid(Pid::out, IO0::di, IO::uo), 25 | [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, 26 | may_not_duplicate], 27 | " 28 | Pid = (MR_Integer) getpid(); 29 | IO = IO0; 30 | "). 31 | 32 | %-----------------------------------------------------------------------------% 33 | % vim: ft=mercury ts=4 sts=4 sw=4 et 34 | -------------------------------------------------------------------------------- /src/tags.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2012 Peter Wang 3 | 4 | :- module tags. 5 | :- interface. 6 | 7 | :- import_module data. 8 | 9 | :- import_module list. 10 | :- import_module set. 11 | 12 | :- type new 13 | ---> new 14 | ; old. 15 | 16 | :- type unread 17 | ---> unread 18 | ; read. 19 | 20 | :- type replied 21 | ---> replied 22 | ; not_replied. 23 | 24 | :- type deleted 25 | ---> deleted 26 | ; not_deleted. 27 | 28 | :- type flagged 29 | ---> flagged 30 | ; unflagged. 31 | 32 | :- type standard_tags 33 | ---> standard_tags( 34 | unread :: unread, 35 | replied :: replied, 36 | deleted :: deleted, 37 | flagged :: flagged 38 | ). 39 | 40 | :- type tag_delta 41 | ---> tag_delta(string). % +tag or -tag 42 | 43 | :- func tag_delta_to_string(tag_delta) = string. 44 | 45 | :- func tag_to_plus_tag_delta(tag) = tag_delta. 46 | 47 | % There should be more of these instead of bare strings. 48 | :- func draft_tag = tag. 49 | :- func draft_sign_tag = tag. 50 | :- func encrypted_tag = tag. 51 | 52 | :- pred display_tag(tag::in) is semidet. 53 | 54 | :- pred include_user_tag_at_compose(tag::in) is semidet. 55 | 56 | :- pred get_standard_tags(set(tag)::in, standard_tags::out, int::out) is det. 57 | 58 | :- pred validate_tag_deltas(list(string)::in, list(tag_delta)::out, 59 | set(tag)::out, set(tag)::out) is semidet. 60 | 61 | %-----------------------------------------------------------------------------% 62 | %-----------------------------------------------------------------------------% 63 | 64 | :- implementation. 65 | 66 | :- import_module int. 67 | :- import_module string. 68 | 69 | :- import_module string_util. 70 | 71 | %-----------------------------------------------------------------------------% 72 | 73 | tag_delta_to_string(tag_delta(String)) = String. 74 | 75 | tag_to_plus_tag_delta(tag(Tag)) = tag_delta("+" ++ Tag). 76 | 77 | %-----------------------------------------------------------------------------% 78 | 79 | draft_tag = tag("draft"). 80 | draft_sign_tag = tag("draft-sign"). 81 | encrypted_tag = tag("encrypted"). 82 | 83 | %-----------------------------------------------------------------------------% 84 | 85 | display_tag(Tag) :- 86 | not nondisplay_tag(Tag). 87 | 88 | :- pred nondisplay_tag(tag::in) is semidet. 89 | 90 | nondisplay_tag(tag("deleted")). 91 | nondisplay_tag(tag("flagged")). 92 | nondisplay_tag(tag("new")). 93 | nondisplay_tag(tag("replied")). 94 | nondisplay_tag(tag("sent")). 95 | nondisplay_tag(tag("signed")). 96 | nondisplay_tag(tag("unread")). 97 | nondisplay_tag(tag(String)) :- 98 | string.prefix(String, "."). 99 | 100 | %-----------------------------------------------------------------------------% 101 | 102 | include_user_tag_at_compose(Tag) :- 103 | not exclude_user_tag_at_compose(Tag). 104 | 105 | :- pred exclude_user_tag_at_compose(tag::in) is semidet. 106 | 107 | exclude_user_tag_at_compose(tag("attachment")). 108 | exclude_user_tag_at_compose(tag("deleted")). 109 | exclude_user_tag_at_compose(tag("draft")). 110 | exclude_user_tag_at_compose(tag("draft-sign")). 111 | exclude_user_tag_at_compose(tag("encrypted")). 112 | exclude_user_tag_at_compose(tag("new")). 113 | exclude_user_tag_at_compose(tag("replied")). 114 | exclude_user_tag_at_compose(tag("sent")). 115 | exclude_user_tag_at_compose(tag("signed")). 116 | exclude_user_tag_at_compose(tag("unread")). 117 | 118 | %-----------------------------------------------------------------------------% 119 | 120 | get_standard_tags(Tags, StdTags, DisplayTagsWidth) :- 121 | StdTags0 = standard_tags(read, not_replied, not_deleted, unflagged), 122 | set.fold2(get_standard_tags_2, Tags, StdTags0, StdTags, 123 | 0, DisplayTagsWidth). 124 | 125 | :- pred get_standard_tags_2(tag::in, standard_tags::in, standard_tags::out, 126 | int::in, int::out) is det. 127 | 128 | get_standard_tags_2(Tag, !StdTags, !DisplayTagsWidth) :- 129 | ( Tag = tag("unread") -> 130 | !StdTags ^ unread := unread 131 | ; Tag = tag("replied") -> 132 | !StdTags ^ replied := replied 133 | ; Tag = tag("deleted") -> 134 | !StdTags ^ deleted := deleted 135 | ; Tag = tag("flagged") -> 136 | !StdTags ^ flagged := flagged 137 | ; display_tag(Tag) -> 138 | Tag = tag(TagName), 139 | % Add one for separator. 140 | !:DisplayTagsWidth = !.DisplayTagsWidth + string_wcwidth(TagName) + 1 141 | ; 142 | true 143 | ). 144 | 145 | %-----------------------------------------------------------------------------% 146 | 147 | validate_tag_deltas(Words, TagDeltas, AddTags, RemoveTags) :- 148 | list.map_foldl2(validate_tag_delta, Words, TagDeltas, 149 | set.init, AddTags, set.init, RemoveTags). 150 | 151 | :- pred validate_tag_delta(string::in, tag_delta::out, 152 | set(tag)::in, set(tag)::out, set(tag)::in, set(tag)::out) is semidet. 153 | 154 | validate_tag_delta(Word, TagDelta, !AddTags, !RemoveTags) :- 155 | ( string.remove_prefix("-", Word, Tag) -> 156 | not blacklist_tag(Tag), 157 | set.insert(tag(Tag), !RemoveTags), 158 | TagDelta = tag_delta(Word) 159 | ; 160 | ( string.remove_prefix("+", Word, WordSuffix) -> 161 | Tag = WordSuffix, 162 | TagDelta = tag_delta(Word) 163 | ; 164 | Tag = Word, 165 | TagDelta = tag_delta("+" ++ Word) 166 | ), 167 | not blacklist_tag(Tag), 168 | set.insert(tag(Tag), !AddTags) 169 | ). 170 | 171 | :- pred blacklist_tag(string::in) is semidet. 172 | 173 | blacklist_tag(""). 174 | blacklist_tag("-"). 175 | blacklist_tag("+"). 176 | 177 | %-----------------------------------------------------------------------------% 178 | % vim: ft=mercury ts=4 sts=4 sw=4 et 179 | -------------------------------------------------------------------------------- /src/uri.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module uri. 5 | :- interface. 6 | 7 | :- type url_regex. 8 | 9 | :- pred init_url_regex(url_regex::out) is det. 10 | 11 | :- pred detect_url(url_regex::in, string::in, int::out, int::out) is semidet. 12 | 13 | %-----------------------------------------------------------------------------% 14 | %-----------------------------------------------------------------------------% 15 | 16 | :- implementation. 17 | 18 | :- import_module char. 19 | :- import_module int. 20 | :- import_module list. 21 | :- import_module maybe. 22 | :- import_module require. 23 | :- import_module string. 24 | 25 | :- import_module regex. 26 | :- import_module rfc3986. 27 | 28 | :- type url_regex == regex. 29 | 30 | %-----------------------------------------------------------------------------% 31 | 32 | init_url_regex(Reg) :- 33 | regcomp("(https?|gemini)://", [reg_extended], CompRes), 34 | ( 35 | CompRes = ok(Reg) 36 | ; 37 | CompRes = error(Error), 38 | unexpected($pred, "regcomp failed: " ++ Error) 39 | ). 40 | 41 | %-----------------------------------------------------------------------------% 42 | 43 | detect_url(Reg, String, Start, End) :- 44 | detect_url_loop(Reg, String, 0, Start, End). 45 | 46 | :- pred detect_url_loop(regex::in, string::in, int::in, int::out, int::out) 47 | is semidet. 48 | 49 | detect_url_loop(Reg, String, BeginAt, Start, End) :- 50 | % We don't use start-of-line anchors so no need for reg_notbol even when 51 | % BeginAt > 0. 52 | EFlags = [], 53 | unsafe_regexec_offset(Reg, String, BeginAt, EFlags, ExecRes), 54 | require_complete_switch [ExecRes] 55 | ( 56 | ExecRes = have_match(Matches), 57 | ( 58 | Matches = [Match | _], 59 | Match = regmatch(Http, AfterSlashSlash), 60 | ( 61 | is_start_of_word(String, Http), 62 | detect_url_end(String, AfterSlashSlash, End0) 63 | -> 64 | Start = Http, 65 | ( strip_url_trailing_chars(String, Start, End0, UrlEnd) -> 66 | End = UrlEnd 67 | ; 68 | End = End0 69 | ) 70 | ; 71 | detect_url_loop(Reg, String, AfterSlashSlash, Start, End) 72 | ) 73 | ; 74 | Matches = [], 75 | fail 76 | ) 77 | ; 78 | ExecRes = no_match, 79 | fail 80 | ; 81 | ExecRes = error(_), 82 | fail 83 | ). 84 | 85 | :- pred is_start_of_word(string::in, int::in) is semidet. 86 | 87 | is_start_of_word(String, I) :- 88 | not ( 89 | string.unsafe_prev_index(String, I, _, PrevChar), 90 | char.is_alnum_or_underscore(PrevChar) 91 | ). 92 | 93 | :- pred detect_url_end(string::in, int::in, int::out) is det. 94 | 95 | detect_url_end(String, I, End) :- 96 | ( 97 | string.unsafe_index_next(String, I, J, Char), 98 | valid_uri_char(Char) 99 | -> 100 | detect_url_end(String, J, End) 101 | ; 102 | End = I 103 | ). 104 | 105 | :- pred strip_url_trailing_chars(string::in, int::in, int::in, int::out) 106 | is semidet. 107 | 108 | strip_url_trailing_chars(String, Start, End0, UrlEnd) :- 109 | string.unsafe_prev_index(String, End0, End1, LastChar), 110 | ( 111 | ( LastChar = (')'), Open = ('(') 112 | ; LastChar = (']'), Open = ('[') 113 | ), 114 | % Smartly handle bracketed URLs. 115 | count_unbalanced_brackets(Open, LastChar, String, Start, End1, 116 | 1, Unbalanced), 117 | ( Unbalanced > 0 -> 118 | UrlEnd = End1 119 | ; 120 | UrlEnd = End0 121 | ) 122 | ; 123 | ( LastChar = ('!') 124 | ; LastChar = (',') 125 | ; LastChar = ('.') 126 | ; LastChar = (';') 127 | ; LastChar = ('?') 128 | ), 129 | ( string.unsafe_prev_index(String, End1, End2, ')') -> 130 | UrlEnd = End2 131 | ; 132 | UrlEnd = End1 133 | ) 134 | ). 135 | 136 | :- pred count_unbalanced_brackets(char::in, char::in, 137 | string::in, int::in, int::in, int::in, int::out) is det. 138 | 139 | count_unbalanced_brackets(OpenChar, CloseChar, String, Start, Index0, 140 | Unbalanced0, Unbalanced) :- 141 | ( 142 | string.unsafe_prev_index(String, Index0, Index1, Char), 143 | Index1 >= Start 144 | -> 145 | ( Char = CloseChar -> 146 | Unbalanced1 = Unbalanced0 + 1 147 | ; Char = OpenChar -> 148 | Unbalanced1 = Unbalanced0 - 1 149 | ; 150 | Unbalanced1 = Unbalanced0 151 | ), 152 | count_unbalanced_brackets(OpenChar, CloseChar, String, Start, Index1, 153 | Unbalanced1, Unbalanced) 154 | ; 155 | Unbalanced = Unbalanced0 156 | ). 157 | 158 | %-----------------------------------------------------------------------------% 159 | % vim: ft=mercury ts=4 sts=4 sw=4 et 160 | -------------------------------------------------------------------------------- /src/view_async.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2018 Peter Wang 3 | 4 | :- module view_async. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- import_module screen. 10 | 11 | :- pred poll_async_with_progress(screen, 12 | pred(screen, string, Info, Info, io, io), Info, Info, io, io). 13 | :- mode poll_async_with_progress(in, 14 | in(pred(in, in, in, out, di, uo) is det), in, out, di, uo) is det. 15 | 16 | :- pred flush_async_with_progress(screen::in, io::di, io::uo) is det. 17 | 18 | %-----------------------------------------------------------------------------% 19 | %-----------------------------------------------------------------------------% 20 | 21 | :- implementation. 22 | 23 | :- import_module bool. 24 | :- import_module int. 25 | :- import_module list. 26 | :- import_module string. 27 | 28 | :- import_module async. 29 | :- import_module quote_command. 30 | :- import_module sleep. 31 | 32 | %-----------------------------------------------------------------------------% 33 | 34 | poll_async_with_progress(Screen, Handler, !Info, !IO) :- 35 | poll_async_nonblocking(Return, !IO), 36 | ( 37 | Return = none 38 | ; 39 | ( 40 | Return = child_succeeded 41 | ; 42 | Return = child_lowprio_output(Output), 43 | Handler(Screen, Output, !Info, !IO) 44 | ; 45 | Return = child_failed(Op, Failure), 46 | handle_async_failure(Screen, Op, Failure, !IO) 47 | ), 48 | poll_async_with_progress(Screen, Handler, !Info, !IO) 49 | ). 50 | 51 | %---------------------------------------------------------------------------% 52 | 53 | flush_async_with_progress(Screen, !IO) :- 54 | clear_lowprio_async(!IO), 55 | async_count(Count, !IO), 56 | ( Count = 0 -> 57 | true 58 | ; 59 | flush_async_with_progress_loop(Screen, yes, !IO) 60 | ). 61 | 62 | :- pred flush_async_with_progress_loop(screen::in, bool::in, io::di, io::uo) 63 | is det. 64 | 65 | flush_async_with_progress_loop(Screen, Display, !IO) :- 66 | async_count(Count, !IO), 67 | ( Count = 0 -> 68 | update_message(Screen, clear_message, !IO) 69 | ; 70 | ( 71 | Display = yes, 72 | string.format("Flushing %d asynchronous operations.", 73 | [i(Count)], Message), 74 | update_message_immed(Screen, set_info(Message), !IO) 75 | ; 76 | Display = no 77 | ), 78 | poll_async_blocking(Return, !IO), 79 | ( 80 | Return = none, 81 | % Don't busy wait. 82 | usleep(100000, !IO), 83 | flush_async_with_progress_loop(Screen, no, !IO) 84 | ; 85 | Return = child_succeeded, 86 | flush_async_with_progress_loop(Screen, yes, !IO) 87 | ; 88 | Return = child_lowprio_output(_), 89 | flush_async_with_progress_loop(Screen, yes, !IO) 90 | ; 91 | Return = child_failed(Op, Failure), 92 | handle_async_failure(Screen, Op, Failure, !IO), 93 | flush_async_with_progress_loop(Screen, no, !IO) 94 | ) 95 | ). 96 | 97 | %---------------------------------------------------------------------------% 98 | 99 | :- pred handle_async_failure(screen::in, async_op::in, async_failure::in, 100 | io::di, io::uo) is det. 101 | 102 | handle_async_failure(Screen, Op, Failure, !IO) :- 103 | Op = async_shell_command(Prefix, Args, RemainingAttempts0), 104 | Prefix = command_prefix(shell_quoted(PrefixString), _), 105 | FullCommand = string.join_list(" ", [PrefixString | Args]), 106 | ( string.count_codepoints(FullCommand) > 40 -> 107 | ShortCommand = "..." ++ string.right(FullCommand, 37) 108 | ; 109 | ShortCommand = FullCommand 110 | ), 111 | ( 112 | Failure = failure_nonzero_exit(Status), 113 | ( RemainingAttempts0 = 0 -> 114 | string.format("'%s' returned exit status %d; not retrying.", 115 | [s(ShortCommand), i(Status)], Message) 116 | ; 117 | Delay = 5, 118 | string.format("'%s' returned exit status %d; retrying in %d secs.", 119 | [s(ShortCommand), i(Status), i(Delay)], Message), 120 | RemainingAttempts = RemainingAttempts0 - 1, 121 | RetryOp = async_shell_command(Prefix, Args, RemainingAttempts), 122 | retry_async(Delay, RetryOp, !IO) 123 | ) 124 | ; 125 | Failure = failure_signal(Signal), 126 | string.format("'%s' received signal %d; not retrying.", 127 | [s(ShortCommand), i(Signal)], Message) 128 | ; 129 | Failure = failure_abnormal_exit, 130 | string.format("'%s' exited abnormally; not retrying.", 131 | [s(ShortCommand)], Message) 132 | ; 133 | Failure = failure_error(Error), 134 | string.format("'%s': %s; not retrying.", 135 | [s(ShortCommand), s(io.error_message(Error))], Message) 136 | ), 137 | update_message_immed(Screen, set_warning(Message), !IO), 138 | sleep(1, !IO). 139 | handle_async_failure(_Screen, Op, _Failure, !IO) :- 140 | % Ignore poll command failures. 141 | Op = async_lowprio_command(_, _, _). 142 | 143 | %-----------------------------------------------------------------------------% 144 | % vim: ft=mercury ts=4 sts=4 sw=4 et 145 | -------------------------------------------------------------------------------- /src/view_common.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2012 Peter Wang 3 | 4 | :- module view_common. 5 | :- interface. 6 | 7 | :- import_module prog_config. 8 | :- import_module text_entry. 9 | 10 | :- type common_history 11 | ---> common_history( 12 | ch_limit_history :: history, 13 | ch_internal_search_history :: history, 14 | ch_tag_history :: history, 15 | ch_to_history :: history, 16 | ch_subject_history :: history, 17 | ch_open_part_history:: history, 18 | ch_open_url_history :: history, 19 | ch_pipe_id_history :: history, 20 | ch_save_history :: history 21 | ). 22 | 23 | :- pred init_common_history(prog_config::in, common_history::out) is det. 24 | 25 | %-----------------------------------------------------------------------------% 26 | %-----------------------------------------------------------------------------% 27 | 28 | :- implementation. 29 | 30 | init_common_history(Config, CommonHistory) :- 31 | get_open_part_command(Config, OpenPart), 32 | get_open_url_command(Config, OpenUrl), 33 | get_pipe_id_command(Config, PipeId), 34 | 35 | CommonHistory ^ ch_limit_history = init_history, 36 | CommonHistory ^ ch_internal_search_history = init_history, 37 | CommonHistory ^ ch_tag_history = init_history, 38 | CommonHistory ^ ch_to_history = init_history, 39 | CommonHistory ^ ch_subject_history = init_history, 40 | CommonHistory ^ ch_open_part_history = init_history_list(OpenPart), 41 | CommonHistory ^ ch_open_url_history = init_history_list(OpenUrl), 42 | CommonHistory ^ ch_pipe_id_history = init_history_list(PipeId), 43 | CommonHistory ^ ch_save_history = init_history. 44 | 45 | %-----------------------------------------------------------------------------% 46 | % vim: ft=mercury ts=4 sts=4 sw=4 et 47 | -------------------------------------------------------------------------------- /src/xdg.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2011 Peter Wang 3 | 4 | :- module xdg. 5 | :- interface. 6 | 7 | :- import_module io. 8 | :- import_module maybe. 9 | 10 | :- pred search_config_file(string::in, maybe(string)::out, io::di, io::uo) 11 | is det. 12 | 13 | %-----------------------------------------------------------------------------% 14 | %-----------------------------------------------------------------------------% 15 | 16 | :- implementation. 17 | 18 | :- import_module dir. 19 | :- import_module list. 20 | :- import_module string. 21 | 22 | %-----------------------------------------------------------------------------% 23 | 24 | search_config_file(FileName, Res, !IO) :- 25 | get_config_home(MaybeConfigHome, !IO), 26 | ( 27 | MaybeConfigHome = yes(ConfigHome), 28 | search_config_file_loop([ConfigHome], FileName, Res0, !IO) 29 | ; 30 | MaybeConfigHome = no, 31 | Res0 = no 32 | ), 33 | ( 34 | Res0 = yes(_), 35 | Res = Res0 36 | ; 37 | Res0 = no, 38 | get_config_dirs(ConfigDirs, !IO), 39 | search_config_file_loop(ConfigDirs, FileName, Res, !IO) 40 | ). 41 | 42 | :- pred search_config_file_loop(list(string)::in, string::in, 43 | maybe(string)::out, io::di, io::uo) is det. 44 | 45 | search_config_file_loop([], _, no, !IO). 46 | search_config_file_loop([Dir | Dirs], FileName, Res, !IO) :- 47 | io.check_file_accessibility(Dir / FileName, [read], Res0, !IO), 48 | ( 49 | Res0 = ok, 50 | Res = yes(Dir / FileName) 51 | ; 52 | Res0 = error(_), 53 | search_config_file_loop(Dirs, FileName, Res, !IO) 54 | ). 55 | 56 | :- pred get_config_home(maybe(string)::out, io::di, io::uo) is det. 57 | 58 | get_config_home(ConfigHome, !IO) :- 59 | get_environment_var("XDG_CONFIG_HOME", MaybeEnv, !IO), 60 | ( 61 | MaybeEnv = yes(EnvValue), 62 | EnvValue \= "" 63 | -> 64 | ConfigHome = yes(EnvValue) 65 | ; 66 | get_environment_var("HOME", MaybeHome, !IO), 67 | ( 68 | MaybeHome = yes(Home), 69 | ConfigHome = yes(Home / ".config") 70 | ; 71 | MaybeHome = no, 72 | % XXX could try getpwuid? 73 | ConfigHome = no 74 | ) 75 | ). 76 | 77 | :- pred get_config_dirs(list(string)::out, io::di, io::uo) is det. 78 | 79 | get_config_dirs(ConfigDirs, !IO) :- 80 | get_environment_var("XDG_CONFIG_DIRS", MaybeEnv, !IO), 81 | ( 82 | MaybeEnv = yes(EnvValue), 83 | EnvValue \= "" 84 | -> 85 | ConfigDirs = string.split_at_char(':', EnvValue) 86 | ; 87 | ConfigDirs = ["/etc/xdg"] 88 | ). 89 | 90 | %-----------------------------------------------------------------------------% 91 | % vim: ft=mercury ts=4 sts=4 sw=4 et 92 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | MMC = mmc 2 | PARALLEL = -j $(shell nproc 2>/dev/null || echo 1) 3 | DIFF = diff -u 4 | 5 | files = $(wildcard *.m ../src/*.m) 6 | 7 | TESTS = test_base64 \ 8 | test_rfc5322 \ 9 | test_rfc2047_decode \ 10 | test_rfc2047_encode \ 11 | test_rfc2231 \ 12 | test_rfc3986 \ 13 | test_rfc6068 \ 14 | test_json \ 15 | test_process \ 16 | test_search_term \ 17 | test_shell_word 18 | 19 | .PHONY: default 20 | default: $(addsuffix .runtest,$(TESTS)) 21 | 22 | $(TESTS): $(files) Mercury.modules 23 | $(MMC) --make $(PARALLEL) $@ && touch $@ 24 | 25 | Mercury.modules: $(files) 26 | @$(MMC) -f $(files) 27 | 28 | .PHONY: test_base64.runtest 29 | test_base64.runtest: test_base64 30 | ./test_base64 -e < test_base64.m | \ 31 | ./test_base64 -d > test_base64.out && \ 32 | $(DIFF) test_base64.m test_base64.out 33 | @$(RM) test_base64.out 34 | 35 | .PHONY: %.runtest 36 | %.runtest: % 37 | ./runtest.sh $(<) 38 | 39 | # Prevent building targets in parallel to avoid multiple instances of 40 | # mmc trying to make the same target files at once. 41 | test_rfc5322: | test_base64 42 | test_rfc2047_decode: | test_rfc5322 43 | test_rfc2047_encode: | test_rfc2047_decode 44 | test_rfc2231: | test_rfc2047_encode 45 | test_rfc3986: | test_rfc2231 46 | test_rfc6068: | test_rfc3986 47 | -------------------------------------------------------------------------------- /tests/Mercury.options: -------------------------------------------------------------------------------- 1 | -include ../src/Mercury.options 2 | MAIN_TARGET = 3 | 4 | MLLIBS-test_search_term += -lncursesw -lpanelw 5 | 6 | # Add workspace-specific options here. 7 | -include Mercury.params 8 | -------------------------------------------------------------------------------- /tests/runtest.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -eu 3 | 4 | BASE=$1 5 | INP=$BASE.inp 6 | OUT=$BASE.out 7 | EXP=$BASE.exp 8 | DIFF=${DIFF:-diff -u} 9 | 10 | if ! test -f "$INP" ; then 11 | INP=/dev/null 12 | fi 13 | 14 | ./"$BASE" <"$INP" >"$OUT" && 15 | $DIFF "$OUT" "$EXP" && 16 | rm -f "$OUT" 17 | -------------------------------------------------------------------------------- /tests/test_base64.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_base64. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module bool. 16 | :- import_module char. 17 | :- import_module int. 18 | :- import_module list. 19 | :- import_module string. 20 | 21 | :- import_module base64. 22 | 23 | %-----------------------------------------------------------------------------% 24 | 25 | main(!IO) :- 26 | io.command_line_arguments(Args, !IO), 27 | ( Args = ["-d"] -> 28 | test_decode(!IO) 29 | ; Args = ["-e"] -> 30 | test_encode(no, !IO) 31 | ; Args = ["-ew"] -> 32 | test_encode(yes, !IO) 33 | ; 34 | io.set_exit_status(1, !IO) 35 | ). 36 | 37 | :- pred test_decode(io::di, io::uo) is det. 38 | 39 | test_decode(!IO) :- 40 | io.read_file_as_string(ReadRes, !IO), 41 | ( 42 | ReadRes = ok(Input), 43 | string.length(Input, InputLength), 44 | io.stdout_binary_stream(Stream, !IO), 45 | base64.decode(Input, 0, FinalPos, InputLength, Stream, !IO), 46 | ( FinalPos = InputLength -> 47 | true 48 | ; 49 | FinalPos < InputLength, 50 | string.unsafe_index_code_unit(Input, FinalPos, char.to_int('=')) 51 | -> 52 | true 53 | ; 54 | io.set_exit_status(1, !IO) 55 | ) 56 | ; 57 | ReadRes = error(_, Error), 58 | io.stderr_stream(Stderr, !IO), 59 | io.write_string(Stderr, io.error_message(Error), !IO), 60 | io.nl(Stderr, !IO), 61 | io.set_exit_status(1, !IO) 62 | ). 63 | 64 | :- pred test_encode(bool::in, io::di, io::uo) is det. 65 | 66 | test_encode(Wrap, !IO) :- 67 | io.read_file_as_string(ReadRes, !IO), 68 | ( 69 | ReadRes = ok(Input), 70 | ( 71 | Wrap = no, 72 | Encode = base64.encode 73 | ; 74 | Wrap = yes, 75 | Encode = base64.encode_wrap 76 | ), 77 | io.stdout_stream(Stream, !IO), 78 | Encode(Input, 0, string.length(Input), Stream, !IO) 79 | ; 80 | ReadRes = error(_, Error), 81 | io.stderr_stream(Stderr, !IO), 82 | io.write_string(Stderr, io.error_message(Error), !IO), 83 | io.nl(Stderr, !IO), 84 | io.set_exit_status(1, !IO) 85 | ). 86 | 87 | %-----------------------------------------------------------------------------% 88 | % vim: ft=mercury ts=4 sts=4 sw=4 et 89 | -------------------------------------------------------------------------------- /tests/test_fqdn.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_fqdn. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module maybe. 16 | 17 | :- import_module sys_util. 18 | 19 | %-----------------------------------------------------------------------------% 20 | 21 | main(!IO) :- 22 | get_hostname_fqdn(MaybeHostName, MaybeFQDN, !IO), 23 | write_string("host name = ", !IO), 24 | write(MaybeHostName, !IO), 25 | nl(!IO), 26 | write_string("fqdn = ", !IO), 27 | write(MaybeFQDN, !IO), 28 | nl(!IO). 29 | 30 | %-----------------------------------------------------------------------------% 31 | -------------------------------------------------------------------------------- /tests/test_json.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_json. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is cc_multi. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module int. 16 | :- import_module list. 17 | :- import_module map. 18 | :- import_module maybe. 19 | :- import_module parsing_utils. 20 | :- import_module pprint. 21 | :- import_module string. 22 | 23 | :- import_module json. 24 | 25 | %-----------------------------------------------------------------------------% 26 | 27 | main(!IO) :- 28 | list.foldl(test, cases, !IO). 29 | 30 | :- pred test(string::in, io::di, io::uo) is cc_multi. 31 | 32 | test(Input, !IO) :- 33 | parse_json(Input, ParseResult), 34 | io.write_string("«", !IO), 35 | io.write_string(Input, !IO), 36 | io.write_string("»\n", !IO), 37 | ( 38 | ParseResult = ok(Value), 39 | % Note: we use pprint for now instead of pretty_printer as the 40 | % output of pretty_printer was changed slightly on 2022-12-27. 41 | pprint.write(80, to_doc(Value), !IO), 42 | io.nl(!IO), 43 | io.nl(!IO), 44 | test_unescaped_strings(Value, !IO) 45 | ; 46 | ParseResult = error(yes(Message), Line, Column), 47 | indent(Column, !IO), 48 | io.write_string("^\n", !IO), 49 | io.format("%d:%d: %s\n", [i(Line), i(Column), s(Message)], !IO) 50 | ; 51 | ParseResult = error(no, Line, Column), 52 | indent(Column, !IO), 53 | io.write_string("^\n", !IO), 54 | io.format("%d:%d: parse error\n", [i(Line), i(Column)], !IO) 55 | ), 56 | io.write_string("--------\n", !IO). 57 | 58 | :- pred test_unescaped_strings(json::in, io::di, io::uo) is det. 59 | 60 | test_unescaped_strings(Value, !IO) :- 61 | ( 62 | Value = null 63 | ; 64 | Value = bool(_) 65 | ; 66 | Value = int(_) 67 | ; 68 | Value = integer(_) 69 | ; 70 | Value = float(_) 71 | ; 72 | Value = string(EscString), 73 | String = unescape(EscString), 74 | io.write_string("«", !IO), 75 | io.write_string(String, !IO), 76 | io.write_string("»\n", !IO) 77 | ; 78 | Value = list(List), 79 | list.foldl(test_unescaped_strings, List, !IO) 80 | ; 81 | Value = map(Map), 82 | map.foldl_values(test_unescaped_strings, Map, !IO) 83 | ). 84 | 85 | :- pred indent(int::in, io::di, io::uo) is det. 86 | 87 | indent(N, !IO) :- 88 | ( N < 1 -> 89 | true 90 | ; 91 | io.write_char(' ', !IO), 92 | indent(N - 1, !IO) 93 | ). 94 | 95 | :- func cases = list(string). 96 | 97 | cases = [ 98 | "", % bad 99 | 100 | % literals 101 | "null", 102 | "nullx", % bad 103 | "Null", % bad 104 | "true", 105 | "truex", % bad 106 | "True", % bad 107 | "false", 108 | "falsex", % bad 109 | "False", % bad 110 | 111 | % whitespace 112 | " null ", 113 | " null , true ", % bad 114 | "\ufeffnull", % bad 115 | "null\ufeff", % bad 116 | 117 | % integer 118 | "0", 119 | "-0", 120 | "-1", 121 | "+1", 122 | "01", % bad 123 | "001", % bad 124 | "0x1", % bad 125 | "0b1", % bad 126 | "2147483647", % (2**31)-1 127 | "-2147483648", % -(2**31) 128 | "9223372036854775809", % (2**63)+1 129 | "-9223372036854775809", % -(2**63)-1 130 | 131 | % float 132 | "2.71828", 133 | "+2.71828", % bad 134 | "-2.71828", 135 | "2.", % bad 136 | "-2.", % bad 137 | "2e", % bad 138 | "2e+", % bad 139 | "2e-", % bad 140 | "271828e5", 141 | "271828e+5", 142 | "271828e-5", 143 | "271828.e-5", % bad 144 | "271828.0e-5", 145 | "271828.00000E-5", 146 | "0.00271828000000E3", 147 | "0.00271828e+3", 148 | "0.00271828e+33", 149 | "0.00271828e-33", 150 | "0.00271828e+333", % bad 151 | "0.00271828e-333", 152 | 153 | % strings 154 | """", 155 | """abc""", 156 | """ café""", 157 | """☿""", 158 | 159 | """\a""", % bad 160 | """\b""", % bad 161 | """\f""", % bad 162 | """\n""", % bad 163 | """\r""", % bad 164 | """\t""", % bad 165 | """\v""", % bad 166 | """\u0001""", % bad 167 | """\u001f""", % bad 168 | """\\\"""", 169 | """\\\\""", 170 | """\\/""", 171 | """\\a""", % bad 172 | """\\b""", 173 | """\\f""", 174 | """\\n""", 175 | """\\r""", 176 | """\\t""", 177 | """\\v""", % bad 178 | """\\u""", % bad 179 | """\\u0""", % bad 180 | """\\u00""", % bad 181 | """\\u000""", % bad 182 | """\\u0000""", % rejected 183 | """\\u0001""", 184 | """\\u005C""", 185 | """\\u00e9""", 186 | """\\u263f""", 187 | """a\u2028b""", % ok in JSON but not JavaScript 188 | """a\u2029b""", % ok in JSON but not JavaScript 189 | """𝄞""", % U+1D11E 190 | """\\uD834\\uDD1E""", % U+1D11E 191 | """\\ud834\\uDd1E""", % U+1D11E 192 | """\\ud800\\udc00""", % ok 193 | """\\udbff\\udfff""", % ok 194 | """\\ud800""", % bad - lead surrogate only 195 | """\\udc00""", % bad - trail surrogate only 196 | """\\ud800\\udbff""", % bad - two lead surrogates 197 | """\ufdd0\ufdef""", % non-characters 198 | """\\ufdd0\\ufdef""", % non-characters 199 | """\ufffe\uffff""", % non-characters 200 | """\\ufffe\\uffff""", % non-characters 201 | 202 | % array 203 | "[]", 204 | "[", % bad 205 | "]", % bad 206 | "[[]", % bad 207 | "[,]", % bad 208 | "[null]", 209 | "[null,]", % bad 210 | "[null ,true, false]", 211 | 212 | % object 213 | "{}", 214 | "{", % bad 215 | "}", % bad 216 | "{,}", % bad 217 | "{true:false}", % bad 218 | "{a:false}", % bad 219 | "{\"a\"}", % bad 220 | "{\"a\":}", % bad 221 | "{\"a\":null}", 222 | "{\"a\":null, }", % bad 223 | "{\"a\":true, \"a\": false}", % bad 224 | "{\"a\":false ,\"b\" : true, \"cd\": null}", 225 | "{\"ć\":-1234 ,\"b\" : 5.678, \"e\": [], \"A\" : ""nine"", ""d"": {}}" 226 | ]. 227 | 228 | %-----------------------------------------------------------------------------% 229 | % vim: ft=mercury ts=4 sts=4 sw=4 et 230 | -------------------------------------------------------------------------------- /tests/test_process.exp: -------------------------------------------------------------------------------- 1 | ok 2 | -------------------------------------------------------------------------------- /tests/test_process.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_process. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module maybe. 17 | :- import_module string. 18 | 19 | :- import_module process. 20 | 21 | %-----------------------------------------------------------------------------% 22 | 23 | main(!IO) :- 24 | % Send input through rev(1). At least the util-linux version will deadlock 25 | % if we do not interleave reading and writing. 26 | posix_spawn_get_stdin_stdout("rev", [], environ([]), SpawnRes, !IO), 27 | ( 28 | SpawnRes = ok({Pid, StdinPipe, StdoutPipe}), 29 | write_and_read_concurrently_and_close_both(StdinPipe, input, 30 | StdoutPipe, ReadWriteRes, Buffers, !IO), 31 | ( 32 | ReadWriteRes = ok, 33 | ( if make_utf8_string(no, Buffers, Output) then 34 | ( if Output = expected_output then 35 | io.write_string("ok\n", !IO) 36 | else 37 | io.write_string("unexpected output:\n", !IO), 38 | io.write_string(Output, !IO), 39 | io.set_exit_status(1, !IO) 40 | ) 41 | else 42 | io.write_string("output not UTF-8\n", !IO), 43 | io.set_exit_status(1, !IO) 44 | ), 45 | wait_pid(Pid, blocking, WaitRes, !IO), 46 | ( if WaitRes = child_exit(0) then 47 | true 48 | else 49 | report_error(WaitRes, !IO) 50 | ) 51 | ; 52 | ReadWriteRes = error(Error), 53 | report_error(Error, !IO) 54 | ) 55 | ; 56 | SpawnRes = error(Error), 57 | report_error(Error, !IO) 58 | ). 59 | 60 | % Generate >64 KB of input, enough to exceed the default pipe capacity on 61 | % Linux. 62 | :- func input = string. 63 | 64 | input = join_list("\n", lines). 65 | 66 | :- func lines = list(string). 67 | 68 | lines = Lines :- 69 | S16 = "123456789ABCDEF.", 70 | S15 = "123456789abcdef", 71 | Line = append_list(duplicate(63, S16) ++ [S15]), 72 | Lines = duplicate(65, Line) ++ ["abcd"]. 73 | 74 | :- func expected_output = string. 75 | 76 | expected_output = join_list("\n", map(reverse_chars, lines)). 77 | 78 | :- func reverse_chars(string) = string. 79 | 80 | reverse_chars(S) = string.from_rev_char_list(string.to_char_list(S)). 81 | 82 | :- pred report_error(T::in, io::di, io::uo) is det. 83 | 84 | report_error(Error, !IO) :- 85 | io.write(Error, !IO), 86 | io.nl(!IO), 87 | io.set_exit_status(1, !IO). 88 | 89 | %-----------------------------------------------------------------------------% 90 | % vim: ft=mercury ts=4 sts=4 sw=4 et 91 | -------------------------------------------------------------------------------- /tests/test_rfc2047.exp: -------------------------------------------------------------------------------- 1 | input: [""] 2 | [word_atom(atom(ascii("")))] 3 | -------- 4 | input: ["=??="] 5 | [word_atom(atom(ascii("=??=")))] 6 | -------- 7 | input: ["=????="] 8 | [word_atom(atom(ascii("=????=")))] 9 | -------- 10 | input: ["=?UTF-x?Q??="] 11 | [word_atom(atom(ascii("=?UTF-x?Q??=")))] 12 | -------- 13 | input: ["=?UTF-8?x??="] 14 | [word_atom(atom(ascii("=?UTF-8?x??=")))] 15 | -------- 16 | input: ["=?UTF-8?Q??="] 17 | [word_atom(atom(ascii("")))] 18 | -------- 19 | input: ["=?UTF-8?Q?a?="] 20 | [word_atom(atom(ascii("a")))] 21 | -------- 22 | input: ["=?UTF-8?Q?abc?="] 23 | [word_atom(atom(ascii("abc")))] 24 | -------- 25 | input: ["=?UTF-8?Q? ?="] 26 | [word_quoted_string(quoted_string(ascii(" ")))] 27 | -------- 28 | input: ["=?UTF-8?Q???="] 29 | [word_atom(atom(ascii("?")))] 30 | -------- 31 | input: ["=?UTF-8?Q?=?="] 32 | [word_atom(atom(ascii("=?UTF-8?Q?=?=")))] 33 | -------- 34 | input: ["=?UTF-8?Q?=x?="] 35 | [word_atom(atom(ascii("=?UTF-8?Q?=x?=")))] 36 | -------- 37 | input: ["=?UTF-8?Q?=xx?="] 38 | [word_atom(atom(ascii("=?UTF-8?Q?=xx?=")))] 39 | -------- 40 | input: ["=?UTF-8?Q?=A?="] 41 | [word_atom(atom(ascii("=?UTF-8?Q?=A?=")))] 42 | -------- 43 | input: ["=?UTF-8?Q?=00?="] 44 | [word_atom(atom(ascii("=?UTF-8?Q?=00?=")))] 45 | -------- 46 | input: ["=?UTF-8?Q?=09?="] 47 | [word_quoted_string(quoted_string(ascii("\t")))] 48 | -------- 49 | input: ["=?UTF-8?Q?=20?="] 50 | [word_quoted_string(quoted_string(ascii(" ")))] 51 | -------- 52 | input: ["=?UTF-8?Q?_?="] 53 | [word_quoted_string(quoted_string(ascii(" ")))] 54 | -------- 55 | input: ["=?UTF-8?Q?=5F?="] 56 | [word_atom(atom(ascii("_")))] 57 | -------- 58 | input: ["=?UTF-8?Q?é?="] 59 | [word_atom(atom(ascii("=?UTF-8?Q?é?=")))] 60 | -------- 61 | input: ["=?UTF-8?Q?=C3?="] 62 | [word_atom(atom(ascii("=?UTF-8?Q?=C3?=")))] 63 | -------- 64 | input: ["=?UTF-8?Q?=C3=A9?="] 65 | [word_atom(atom(unicode("é")))] 66 | -------- 67 | input: ["=?utf-8?q?=C3=A9?="] 68 | [word_atom(atom(unicode("é")))] 69 | -------- 70 | input: ["=?UTF-8?Q?c_a_f_=C3=A9?="] 71 | [word_quoted_string(quoted_string(unicode("c a f é")))] 72 | -------- 73 | input: ["=?UTF-8?Q?=22=C3=A9=22?="] 74 | [word_quoted_string(quoted_string(unicode("\"é\"")))] 75 | -------- 76 | input: ["=?UTF-8?Q?=e5=99=b8?="] 77 | [word_atom(atom(unicode("噸")))] 78 | -------- 79 | input: ["=?UTF-8?Q?caf?=", "=?UTF-8?Q?=C3=A9?="] 80 | [word_atom(atom(unicode("café")))] 81 | -------- 82 | input: ["=?UTF-8?Q?caf=C3?=", "=?UTF-8?Q?=A9?="] 83 | [word_atom(atom(ascii("=?UTF-8?Q?caf=C3?="))), word_atom(atom(ascii("=?UTF-8?Q?=A9?=")))] 84 | -------- 85 | input: ["=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?="] 86 | [word_atom(atom(unicode("húhúhú")))] 87 | -------- 88 | input: ["=?UTF-8?Q?h=C3=BA?=", "hu", "=?UTF-8?Q?h=C3=BA?="] 89 | [word_atom(atom(unicode("hú"))), word_atom(atom(ascii("hu"))), word_atom(atom(unicode("hú")))] 90 | -------- 91 | -------------------------------------------------------------------------------- /tests/test_rfc2047_decode.exp: -------------------------------------------------------------------------------- 1 | Phrases 2 | ======= 3 | input: [""] 4 | [word_atom(atom(ascii("")))] 5 | -------- 6 | input: ["=??="] 7 | [word_atom(atom(ascii("=??=")))] 8 | -------- 9 | input: ["=????="] 10 | [word_atom(atom(ascii("=????=")))] 11 | -------- 12 | input: ["=?UTF-x?Q??="] 13 | [word_atom(atom(ascii("=?UTF-x?Q??=")))] 14 | -------- 15 | input: ["=?UTF-8?x??="] 16 | [word_atom(atom(ascii("=?UTF-8?x??=")))] 17 | -------- 18 | input: ["=?UTF-8?Q??="] 19 | [word_atom(atom(ascii("")))] 20 | -------- 21 | input: ["=?UTF-8?Q?a?="] 22 | [word_atom(atom(ascii("a")))] 23 | -------- 24 | input: ["=?UTF-8?Q?abc?="] 25 | [word_atom(atom(ascii("abc")))] 26 | -------- 27 | input: ["=?UTF-8?Q? ?="] 28 | [word_quoted_string(quoted_string(ascii(" ")))] 29 | -------- 30 | input: ["=?UTF-8?Q???="] 31 | [word_atom(atom(ascii("?")))] 32 | -------- 33 | input: ["=?UTF-8?Q?=?="] 34 | [word_atom(atom(ascii("=?UTF-8?Q?=?=")))] 35 | -------- 36 | input: ["=?UTF-8?Q?=x?="] 37 | [word_atom(atom(ascii("=?UTF-8?Q?=x?=")))] 38 | -------- 39 | input: ["=?UTF-8?Q?=xx?="] 40 | [word_atom(atom(ascii("=?UTF-8?Q?=xx?=")))] 41 | -------- 42 | input: ["=?UTF-8?Q?=A?="] 43 | [word_atom(atom(ascii("=?UTF-8?Q?=A?=")))] 44 | -------- 45 | input: ["=?UTF-8?Q?=00?="] 46 | [word_atom(atom(ascii("=?UTF-8?Q?=00?=")))] 47 | -------- 48 | input: ["=?UTF-8?Q?=09?="] 49 | [word_quoted_string(quoted_string(ascii("\t")))] 50 | -------- 51 | input: ["=?UTF-8?Q?=20?="] 52 | [word_quoted_string(quoted_string(ascii(" ")))] 53 | -------- 54 | input: ["=?UTF-8?Q?_?="] 55 | [word_quoted_string(quoted_string(ascii(" ")))] 56 | -------- 57 | input: ["=?UTF-8?Q?=5F?="] 58 | [word_atom(atom(ascii("_")))] 59 | -------- 60 | input: ["=?UTF-8?Q?é?="] 61 | [word_atom(atom(ascii("=?UTF-8?Q?é?=")))] 62 | -------- 63 | input: ["=?UTF-8?Q?=C3?="] 64 | [word_atom(atom(ascii("=?UTF-8?Q?=C3?=")))] 65 | -------- 66 | input: ["=?UTF-8?Q?=C3=A9?="] 67 | [word_atom(atom(unicode("é")))] 68 | -------- 69 | input: ["=?utf-8?q?=C3=A9?="] 70 | [word_atom(atom(unicode("é")))] 71 | -------- 72 | input: ["=?UTF-8*EN?Q?=C3=A9?="] 73 | [word_atom(atom(unicode("é")))] 74 | -------- 75 | input: ["=?UTF-8?Q?=22=C3=A9=22?="] 76 | [word_quoted_string(quoted_string(unicode("\"é\"")))] 77 | -------- 78 | input: ["=?UTF-8?Q?=e5=99=b8?="] 79 | [word_atom(atom(unicode("噸")))] 80 | -------- 81 | input: ["=?UTF-8?Q?caf?=", "=?UTF-8?Q?=C3=A9?="] 82 | [word_atom(atom(unicode("café")))] 83 | -------- 84 | input: ["=?UTF-8?Q?caf=C3?=", "=?UTF-8?Q?=A9?="] 85 | [word_atom(atom(ascii("=?UTF-8?Q?caf=C3?="))), 86 | word_atom(atom(ascii("=?UTF-8?Q?=A9?=")))] 87 | -------- 88 | input: ["=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?="] 89 | [word_atom(atom(unicode("húhúhú")))] 90 | -------- 91 | input: ["=?UTF-8?Q?h=C3=BA?=", "hu", "=?UTF-8?Q?h=C3=BA?="] 92 | [word_atom(atom(unicode("hú"))), word_atom(atom(ascii("hu"))), 93 | word_atom(atom(unicode("hú")))] 94 | -------- 95 | input: ["=?UTF-8?B??="] 96 | [word_atom(atom(ascii("")))] 97 | -------- 98 | input: ["=?UTF-8?B?=?="] 99 | [word_atom(atom(ascii("")))] 100 | -------- 101 | input: ["=?UTF-8?B?YQ==?="] 102 | [word_atom(atom(ascii("a")))] 103 | -------- 104 | input: ["=?UTF-8?B?YWI=?="] 105 | [word_atom(atom(ascii("ab")))] 106 | -------- 107 | input: ["=?UTF-8?B?YWJj?="] 108 | [word_atom(atom(ascii("abc")))] 109 | -------- 110 | input: ["=?UTF-8?B?Y*==?="] 111 | [word_atom(atom(ascii("=?UTF-8?B?Y*==?=")))] 112 | -------- 113 | input: ["=?UTF-8?B?YQ*=?="] 114 | [word_atom(atom(ascii("=?UTF-8?B?YQ*=?=")))] 115 | -------- 116 | input: ["=?UTF-8?B?AA==?="] 117 | [word_atom(atom(ascii("=?UTF-8?B?AA==?=")))] 118 | -------- 119 | input: ["=?UTF-8?B?gA==?="] 120 | [word_atom(atom(ascii("=?UTF-8?B?gA==?=")))] 121 | -------- 122 | input: ["=?UTF-8?B?w6k=?="] 123 | [word_atom(atom(unicode("é")))] 124 | -------- 125 | input: ["=?UTF-8?B?ww==?=", "=?UTF-8?B?qQ==?="] 126 | [word_atom(atom(ascii("=?UTF-8?B?ww==?="))), 127 | word_atom(atom(ascii("=?UTF-8?B?qQ==?=")))] 128 | -------- 129 | input: ["=?UTF-8?B?Y2Fmw6k=?="] 130 | [word_atom(atom(unicode("café")))] 131 | -------- 132 | input: ["=?UTF-8?B?5Zm4?="] 133 | [word_atom(atom(unicode("噸")))] 134 | -------- 135 | input: ["=?UTF-8?B?Y2Fmw6k=?=", "=?UTF-8?Q?h=C3=BA?="] 136 | [word_atom(atom(unicode("caféhú")))] 137 | -------- 138 | input: ["=?UTF-8?B?Y2Fmw6k=?=", "=?UTF-8?Q?_h=C3=BA?="] 139 | [word_quoted_string(quoted_string(unicode("café hú")))] 140 | -------- 141 | input: ["=?ISO-8859-1?Q?caf=E9?="] 142 | [word_atom(atom(unicode("café")))] 143 | -------- 144 | input: ["=?ISO-8859-1?Q?=A4=A6=A8=B4=B8=BC=BD=BE?="] 145 | [word_atom(atom(unicode("¤¦¨´¸¼½¾")))] 146 | -------- 147 | input: ["=?ISO-8859-1?B?pKaotLi8vb4=?="] 148 | [word_atom(atom(unicode("¤¦¨´¸¼½¾")))] 149 | -------- 150 | 151 | Unstructured 152 | ============ 153 | «» 154 | «» 155 | -------- 156 | «=??=» 157 | «=??=» 158 | -------- 159 | «=????=» 160 | «=????=» 161 | -------- 162 | «=?UTF-x?Q??=» 163 | «=?UTF-x?Q??=» 164 | -------- 165 | «=?UTF-8?x??=» 166 | «=?UTF-8?x??=» 167 | -------- 168 | «=?UTF-8?Q??=» 169 | «» 170 | -------- 171 | «=?UTF-8?Q?a?=» 172 | «a» 173 | -------- 174 | «=?UTF-8?Q?abc?=» 175 | «abc» 176 | -------- 177 | «=?UTF-8?Q? ?=» 178 | «=?UTF-8?Q? ?=» 179 | -------- 180 | «=?UTF-8?Q???=» 181 | «?» 182 | -------- 183 | «=?UTF-8?Q?=?=» 184 | «=?UTF-8?Q?=?=» 185 | -------- 186 | «=?UTF-8?Q?=x?=» 187 | «=?UTF-8?Q?=x?=» 188 | -------- 189 | «=?UTF-8?Q?=xx?=» 190 | «=?UTF-8?Q?=xx?=» 191 | -------- 192 | «=?UTF-8?Q?=A?=» 193 | «=?UTF-8?Q?=A?=» 194 | -------- 195 | «=?UTF-8?Q?=00?=» 196 | «=?UTF-8?Q?=00?=» 197 | -------- 198 | «=?UTF-8?Q?=09?=» 199 | « » 200 | -------- 201 | «=?UTF-8?Q?=20?=» 202 | « » 203 | -------- 204 | «=?UTF-8?Q?_?=» 205 | « » 206 | -------- 207 | «=?UTF-8?Q?=5F?=» 208 | «_» 209 | -------- 210 | «=?UTF-8?Q?é?=» 211 | «=?UTF-8?Q?é?=» 212 | -------- 213 | «=?UTF-8?Q?=C3?=» 214 | «=?UTF-8?Q?=C3?=» 215 | -------- 216 | «=?UTF-8?Q?=C3=A9?=» 217 | «é» 218 | -------- 219 | «=?utf-8?q?=C3=A9?=» 220 | «é» 221 | -------- 222 | «=?UTF-8*EN?Q?=C3=A9?=» 223 | «é» 224 | -------- 225 | «=?UTF-8?Q?=22=C3=A9=22?=» 226 | «"é"» 227 | -------- 228 | «=?UTF-8?Q?=e5=99=b8?=» 229 | «噸» 230 | -------- 231 | «=?UTF-8?Q?caf?= =?UTF-8?Q?=C3=A9?=» 232 | «café» 233 | -------- 234 | «=?UTF-8?Q?caf=C3?= =?UTF-8?Q?=A9?=» 235 | «=?UTF-8?Q?caf=C3?= =?UTF-8?Q?=A9?=» 236 | -------- 237 | «=?UTF-8?Q?h=C3=BA?= =?UTF-8?Q?h=C3=BA?= =?UTF-8?Q?h=C3=BA?=» 238 | «húhúhú» 239 | -------- 240 | «=?UTF-8?Q?h=C3=BA?= hu =?UTF-8?Q?h=C3=BA?=» 241 | «hú hu hú» 242 | -------- 243 | «=?UTF-8?B??=» 244 | «» 245 | -------- 246 | «=?UTF-8?B?=?=» 247 | «» 248 | -------- 249 | «=?UTF-8?B?YQ==?=» 250 | «a» 251 | -------- 252 | «=?UTF-8?B?YWI=?=» 253 | «ab» 254 | -------- 255 | «=?UTF-8?B?YWJj?=» 256 | «abc» 257 | -------- 258 | «=?UTF-8?B?Y*==?=» 259 | «=?UTF-8?B?Y*==?=» 260 | -------- 261 | «=?UTF-8?B?YQ*=?=» 262 | «=?UTF-8?B?YQ*=?=» 263 | -------- 264 | «=?UTF-8?B?AA==?=» 265 | «=?UTF-8?B?AA==?=» 266 | -------- 267 | «=?UTF-8?B?gA==?=» 268 | «=?UTF-8?B?gA==?=» 269 | -------- 270 | «=?UTF-8?B?w6k=?=» 271 | «é» 272 | -------- 273 | «=?UTF-8?B?ww==?= =?UTF-8?B?qQ==?=» 274 | «=?UTF-8?B?ww==?= =?UTF-8?B?qQ==?=» 275 | -------- 276 | «=?UTF-8?B?Y2Fmw6k=?=» 277 | «café» 278 | -------- 279 | «=?UTF-8?B?5Zm4?=» 280 | «噸» 281 | -------- 282 | «=?UTF-8?B?Y2Fmw6k=?= =?UTF-8?Q?h=C3=BA?=» 283 | «caféhú» 284 | -------- 285 | «=?UTF-8?B?Y2Fmw6k=?= =?UTF-8?Q?_h=C3=BA?=» 286 | «café hú» 287 | -------- 288 | «=?ISO-8859-1?Q?caf=E9?=» 289 | «café» 290 | -------- 291 | «=?ISO-8859-1?Q?=A4=A6=A8=B4=B8=BC=BD=BE?=» 292 | «¤¦¨´¸¼½¾» 293 | -------- 294 | «=?ISO-8859-1?B?pKaotLi8vb4=?=» 295 | «¤¦¨´¸¼½¾» 296 | -------- 297 | « =?UTF-8?Q?h=C3=BA?= =?UTF-8?Q?h=C3=BA?= hu =?UTF-8?Q?h=C3=BA?=» 298 | « húhú hu hú» 299 | -------- 300 | -------------------------------------------------------------------------------- /tests/test_rfc2047_decode.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_rfc2047_decode. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module pprint. 17 | :- import_module string. 18 | 19 | :- import_module rfc2047. 20 | :- import_module rfc2047.decoder. 21 | :- import_module rfc5322. 22 | 23 | :- type case == list(string). 24 | 25 | %-----------------------------------------------------------------------------% 26 | 27 | main(!IO) :- 28 | io.write_string("Phrases\n", !IO), 29 | io.write_string("=======\n", !IO), 30 | list.foldl(test_decode_phrase, decode_cases, !IO), 31 | io.write_string("\n", !IO), 32 | io.write_string("Unstructured\n", !IO), 33 | io.write_string("============\n", !IO), 34 | list.foldl(test_decode_unstructured, decode_cases, !IO), 35 | list.foldl(test_decode_unstructured, unstructured_extra_cases, !IO). 36 | 37 | :- pred test_decode_phrase(case::in, io::di, io::uo) is det. 38 | 39 | test_decode_phrase(Input, !IO) :- 40 | Phrase0 = list.map(ascii_atom, Input), 41 | decode_phrase(Phrase0, Phrase), 42 | 43 | io.write_string("input: ", !IO), 44 | io.write(Input, !IO), 45 | io.nl(!IO), 46 | % Note: we use pprint for now instead of pretty_printer as the 47 | % output of pretty_printer was changed slightly on 2022-12-27. 48 | pprint.write(80, to_doc(Phrase), !IO), 49 | io.nl(!IO), 50 | io.write_string("--------\n", !IO). 51 | 52 | :- pred test_decode_unstructured(case::in, io::di, io::uo) is det. 53 | 54 | test_decode_unstructured(Case, !IO) :- 55 | Input = string.join_list(" ", Case), 56 | decode_unstructured(Input, Unstructured), 57 | io.write_string("«", !IO), 58 | io.write_string(Input, !IO), 59 | io.write_string("»\n«", !IO), 60 | io.write_string(Unstructured, !IO), 61 | io.write_string("»\n", !IO), 62 | io.write_string("--------\n", !IO). 63 | 64 | :- func ascii_atom(string) = word. 65 | 66 | ascii_atom(S) = word_atom(atom(ascii(S))). 67 | 68 | :- func decode_cases = list(case). 69 | 70 | decode_cases = [ 71 | [""], 72 | ["=??="], % bad 73 | ["=????="], % bad 74 | ["=?UTF-x?Q??="], % bad 75 | ["=?UTF-8?x??="], % bad 76 | ["=?UTF-8?Q??="], % ok 77 | ["=?UTF-8?Q?a?="], % ok 78 | ["=?UTF-8?Q?abc?="], % ok 79 | ["=?UTF-8?Q? ?="], % bad - not token 80 | ["=?UTF-8?Q???="], % bad - question mark in payload 81 | ["=?UTF-8?Q?=?="], % bad - invalid escape sequence 82 | ["=?UTF-8?Q?=x?="], % bad - invalid escape sequence 83 | ["=?UTF-8?Q?=xx?="], % bad - invalid escape sequence 84 | ["=?UTF-8?Q?=A?="], % bad - invalid escape sequence 85 | ["=?UTF-8?Q?=00?="], % bad - reject NUL 86 | ["=?UTF-8?Q?=09?="], % ok 87 | ["=?UTF-8?Q?=20?="], % ok 88 | ["=?UTF-8?Q?_?="], % ok 89 | ["=?UTF-8?Q?=5F?="], % ok 90 | ["=?UTF-8?Q?é?="], % bad - not ASCII 91 | ["=?UTF-8?Q?=C3?="], % bad - not UTF-8 92 | ["=?UTF-8?Q?=C3=A9?="], % ok 93 | ["=?utf-8?q?=C3=A9?="], % ok 94 | ["=?UTF-8*EN?Q?=C3=A9?="], % ok 95 | ["=?UTF-8?Q?=22=C3=A9=22?="], % ok 96 | ["=?UTF-8?Q?=e5=99=b8?="], % ok 97 | ["=?UTF-8?Q?caf?=", "=?UTF-8?Q?=C3=A9?="], % ok 98 | ["=?UTF-8?Q?caf=C3?=", "=?UTF-8?Q?=A9?="], % bad - split multibyte 99 | ["=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?="], % ok 100 | ["=?UTF-8?Q?h=C3=BA?=", "hu", "=?UTF-8?Q?h=C3=BA?="], % ok 101 | 102 | ["=?UTF-8?B??="], % ok 103 | ["=?UTF-8?B?=?="], % ok? 104 | ["=?UTF-8?B?YQ==?="], % ok 105 | ["=?UTF-8?B?YWI=?="], % ok 106 | ["=?UTF-8?B?YWJj?="], % ok 107 | ["=?UTF-8?B?Y*==?="], % bad - non base64 character 108 | ["=?UTF-8?B?YQ*=?="], % bad - non base64 character 109 | ["=?UTF-8?B?AA==?="], % bad - reject NUL 110 | ["=?UTF-8?B?gA==?="], % bad - not UTF-8 111 | ["=?UTF-8?B?w6k=?="], % ok 112 | ["=?UTF-8?B?ww==?=", "=?UTF-8?B?qQ==?="], % bad - split multibyte 113 | ["=?UTF-8?B?Y2Fmw6k=?="], % ok 114 | ["=?UTF-8?B?5Zm4?="], % ok 115 | 116 | ["=?UTF-8?B?Y2Fmw6k=?=", "=?UTF-8?Q?h=C3=BA?="], % ok 117 | ["=?UTF-8?B?Y2Fmw6k=?=", "=?UTF-8?Q?_h=C3=BA?="], % ok 118 | 119 | ["=?ISO-8859-1?Q?caf=E9?="], % ok 120 | ["=?ISO-8859-1?Q?=A4=A6=A8=B4=B8=BC=BD=BE?="], % ok - not iso-8859-15 121 | ["=?ISO-8859-1?B?pKaotLi8vb4=?="] % ok - not iso-8859-15 122 | ]. 123 | 124 | :- func unstructured_extra_cases = list(case). 125 | 126 | unstructured_extra_cases = [ 127 | [" ", "=?UTF-8?Q?h=C3=BA?=", "=?UTF-8?Q?h=C3=BA?=", "hu", 128 | "=?UTF-8?Q?h=C3=BA?="] % ok 129 | ]. 130 | 131 | %-----------------------------------------------------------------------------% 132 | % vim: ft=mercury ts=4 sts=4 sw=4 et 133 | -------------------------------------------------------------------------------- /tests/test_rfc2047_encode.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_rfc2047_encode. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module pprint. 17 | :- import_module string. 18 | 19 | :- import_module rfc2047. 20 | :- import_module rfc2047.decoder. 21 | :- import_module rfc2047.encoder. 22 | :- import_module rfc5322. 23 | 24 | %-----------------------------------------------------------------------------% 25 | 26 | main(!IO) :- 27 | io.write_string("Phrases\n", !IO), 28 | io.write_string("=======\n", !IO), 29 | list.foldl(test_encode_phrase, encode_cases, !IO), 30 | io.write_string("\n", !IO), 31 | io.write_string("Unstructured\n", !IO), 32 | io.write_string("============\n", !IO), 33 | list.foldl(test_encode_unstructured, encode_cases, !IO). 34 | 35 | :- pred test_encode_phrase(phrase::in, io::di, io::uo) is det. 36 | 37 | test_encode_phrase(Phrase0, !IO) :- 38 | encode_phrase(Phrase0, Phrase1), 39 | decode_phrase(Phrase1, Phrase), 40 | 41 | % Note: we use pprint for now instead of pretty_printer as the 42 | % output of pretty_printer was changed slightly on 2022-12-27. 43 | pprint.write(80, to_doc(Phrase0), !IO), 44 | io.nl(!IO), 45 | pprint.write(80, to_doc(Phrase1), !IO), 46 | io.nl(!IO), 47 | pprint.write(80, to_doc(Phrase), !IO), 48 | io.write_string("\n--------\n", !IO). 49 | 50 | :- pred test_encode_unstructured(phrase::in, io::di, io::uo) is det. 51 | 52 | test_encode_unstructured(Phrase, !IO) :- 53 | Input = string.join_list(" ", list.map(word_to_string, Phrase)), 54 | encode_unstructured(Input, Encoded), 55 | decode_unstructured(Encoded, Decoded), 56 | 57 | io.write_string("", !IO), 58 | io.write_string(Input, !IO), 59 | io.write_string("\n", !IO), 60 | io.write_string(Encoded, !IO), 61 | io.write_string("\n", !IO), 62 | io.write_string(Decoded, !IO), 63 | io.write_string("\n", !IO), 64 | io.write_string("--------\n", !IO). 65 | 66 | :- func encode_cases = list(phrase). 67 | 68 | encode_cases = [ 69 | [a("abc")], 70 | [a("噸")], 71 | [qs("now only €15")], 72 | % input looks like encoded-word 73 | [a("=??=")], 74 | [qs("=??=")], 75 | [a("=?abc?=")], 76 | [qs("=?abc?=")], 77 | [a("=?UTF-8?Q??=")], 78 | [qs("=?UTF-8?Q??=")], 79 | % choose Q-encoding 80 | [qs("Svifnökkvinn minn er fullur af álum")], 81 | [a("Svifnökkvinn"), a("álum")], 82 | % choose B-encoding 83 | [qs("Τὸ πλοῖόν μου τὸ μετεωριζόμενον ἐστι πλῆρες ἐγχελέων")], 84 | % intervening ASCII 85 | [qs("Τὸ πλοῖόν μου -- μετεωριζόμενον ---- πλῆρες ἐγχελέων")], 86 | % overlong word 87 | [a("123456789-123456789-123456789-123456789-123456789-123456789-123x")], 88 | % check characters allowed in Q encoded-words 89 | [a("ábcdefghijklmnopqrstuvwxyz!\"#$%")], 90 | [a("ábcdefghijklmnopqrstuvwxyz&'()")], 91 | [a("ábcdefghijklmnopqrstuvwxyz*+,-./")], 92 | [a("ábcdefghijklmnopqrstuvwxyz:;")], 93 | [a("ábcdefghijklmnopqrstuvwxyz<=>")], 94 | [a("ábcdefghijklmnopqrstuvwxyz?@")], 95 | [a("ábcdefghijklmnopqrstuvwxyz[\\]")], 96 | [a("ábcdefghijklmnopqrstuvwxyz^_`")], 97 | [a("ábcdefghijklmnopqrstuvwxyz{|}~")] 98 | ]. 99 | 100 | :- func a(string) = word. 101 | 102 | a(String) = word_atom(atom(unicode(String))). 103 | 104 | :- func qs(string) = word. 105 | 106 | qs(String) = word_quoted_string(quoted_string(unicode(String))). 107 | 108 | %-----------------------------------------------------------------------------% 109 | % vim: ft=mercury ts=4 sts=4 sw=4 et 110 | -------------------------------------------------------------------------------- /tests/test_rfc2231.exp: -------------------------------------------------------------------------------- 1 | «filename*=UTF-8''» 2 | 3 | «filename*=UTF-8''%20a%20B%20» 4 | 5 | «filename*=UTF-8''a%5Cb» 6 | 7 | «filename*=UTF-8''a%22b» 8 | 9 | «filename*=UTF-8''a%2Ab» 10 | 11 | «filename*=UTF-8''a%27b» 12 | 13 | «filename*=UTF-8''a%25b» 14 | 15 | «filename*=UTF-8''ab%3B» 16 | 17 | «filename*=UTF-8''{ab}» 18 | 19 | «filename*=UTF-8''caf%C3%A9» 20 | 21 | «filename*=UTF-8''%E5%99%B8» 22 | 23 | -------------------------------------------------------------------------------- /tests/test_rfc2231.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_rfc2231. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module pair. 17 | 18 | :- import_module rfc2231. 19 | :- import_module rfc2045. 20 | :- import_module rfc5322. 21 | 22 | %-----------------------------------------------------------------------------% 23 | 24 | main(!IO) :- 25 | list.foldl(test, cases, !IO). 26 | 27 | :- pred test(string::in, io::di, io::uo) is det. 28 | 29 | test(Input, !IO) :- 30 | Attr = attribute("filename"), 31 | Value = quoted_string(quoted_string(unicode(Input))), 32 | encode_parameter(Attr - Value, Param), 33 | parameter_to_string(Param, String), 34 | io.write_string("«", !IO), 35 | io.write_string(String, !IO), 36 | io.write_string("»\n\n", !IO). 37 | 38 | :- pred parameter_to_string(parameter::in, string::out) is det. 39 | 40 | parameter_to_string(Param, String) :- 41 | parameter_to_string(Param, String, _Valid). 42 | 43 | :- func cases = list(string). 44 | 45 | cases = [ 46 | "", 47 | " a B ", 48 | "a\\b", 49 | "a\"b", 50 | "a*b", 51 | "a'b", 52 | "a%b", 53 | "ab;", 54 | "{ab}", 55 | "café", 56 | "噸" 57 | ]. 58 | 59 | %-----------------------------------------------------------------------------% 60 | % vim: ft=mercury ts=4 sts=4 sw=4 et 61 | -------------------------------------------------------------------------------- /tests/test_rfc3986.exp: -------------------------------------------------------------------------------- 1 | input: «ftp://ftp.is.co.za/rfc/rfc1808.txt» 2 | uri_components(yes("ftp"), yes("ftp.is.co.za"), "/rfc/rfc1808.txt", no, no) 3 | -------- 4 | input: «http://www.ietf.org/rfc/rfc2396.txt» 5 | uri_components(yes("http"), yes("www.ietf.org"), "/rfc/rfc2396.txt", no, no) 6 | -------- 7 | input: «ldap://[2001:db8::7]/c=GB?objectClass?one» 8 | uri_components(yes("ldap"), yes("[2001:db8::7]"), "/c=GB", 9 | yes("objectClass?one"), no) 10 | -------- 11 | input: «mailto:John.Doe@example.com» 12 | uri_components(yes("mailto"), no, "John.Doe@example.com", no, no) 13 | -------- 14 | input: «news:comp.infosystems.www.servers.unix» 15 | uri_components(yes("news"), no, "comp.infosystems.www.servers.unix", no, no) 16 | -------- 17 | input: «tel:+1-816-555-1212» 18 | uri_components(yes("tel"), no, "+1-816-555-1212", no, no) 19 | -------- 20 | input: «telnet://192.0.2.16:80/» 21 | uri_components(yes("telnet"), yes("192.0.2.16:80"), "/", no, no) 22 | -------- 23 | input: «urn:oasis:names:specification:docbook:dtd:xml:4.1.2» 24 | uri_components(yes("urn"), no, 25 | "oasis:names:specification:docbook:dtd:xml:4.1.2", no, no) 26 | -------- 27 | input: «/example#frag» 28 | uri_components(no, no, "/example", no, yes("frag")) 29 | -------- 30 | input: «/example?#frag» 31 | uri_components(no, no, "/example", yes(""), yes("frag")) 32 | -------- 33 | input: «/example??#frag» 34 | uri_components(no, no, "/example", yes("?"), yes("frag")) 35 | -------- 36 | input: «/example?v=1#frag» 37 | uri_components(no, no, "/example", yes("v=1"), yes("frag")) 38 | -------- 39 | input: «/example?v=1&w=2#frag» 40 | uri_components(no, no, "/example", yes("v=1&w=2"), yes("frag")) 41 | -------- 42 | input: «/example?q#frag» 43 | uri_components(no, no, "/example", yes("q"), yes("frag")) 44 | -------- 45 | input: «/example?q#frag#frag» 46 | uri_components(no, no, "/example", yes("q"), yes("frag#frag")) 47 | -------- 48 | input: «» 49 | uri_components(no, no, "", no, no) 50 | -------- 51 | -------------------------------------------------------------------------------- /tests/test_rfc3986.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_rfc3986. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module pprint. 17 | 18 | :- import_module rfc3986. 19 | 20 | %-----------------------------------------------------------------------------% 21 | 22 | main(!IO) :- 23 | list.foldl(test, cases, !IO). 24 | 25 | :- pred test(string::in, io::di, io::uo) is det. 26 | 27 | test(Input, !IO) :- 28 | io.write_string("input: «", !IO), 29 | io.write_string(Input, !IO), 30 | io.write_string("»\n", !IO), 31 | 32 | ( split_uri(Input, URI) -> 33 | % Note: we use pprint for now instead of pretty_printer as the 34 | % output of pretty_printer was changed slightly on 2022-12-27. 35 | pprint.write(80, to_doc(URI), !IO), 36 | io.nl(!IO) 37 | ; 38 | io.write_string("failed to parse\n", !IO) 39 | ), 40 | io.write_string("--------\n", !IO). 41 | 42 | :- func cases = list(string). 43 | 44 | cases = [ 45 | "ftp://ftp.is.co.za/rfc/rfc1808.txt", 46 | "http://www.ietf.org/rfc/rfc2396.txt", 47 | "ldap://[2001:db8::7]/c=GB?objectClass?one", 48 | "mailto:John.Doe@example.com", 49 | "news:comp.infosystems.www.servers.unix", 50 | "tel:+1-816-555-1212", 51 | "telnet://192.0.2.16:80/", 52 | "urn:oasis:names:specification:docbook:dtd:xml:4.1.2", 53 | "/example#frag", 54 | "/example?#frag", 55 | "/example??#frag", 56 | "/example?v=1#frag", 57 | "/example?v=1&w=2#frag", 58 | "/example?q#frag", 59 | "/example?q#frag#frag", 60 | "" 61 | ]. 62 | 63 | %-----------------------------------------------------------------------------% 64 | % vim: ft=mercury ts=4 sts=4 sw=4 et 65 | -------------------------------------------------------------------------------- /tests/test_rfc5322.m: -------------------------------------------------------------------------------- 1 | % Bower - a frontend for the Notmuch email system 2 | % Copyright (C) 2014 Peter Wang 3 | 4 | :- module test_rfc5322. 5 | :- interface. 6 | 7 | :- import_module io. 8 | 9 | :- pred main(io::di, io::uo) is det. 10 | 11 | %-----------------------------------------------------------------------------% 12 | %-----------------------------------------------------------------------------% 13 | 14 | :- implementation. 15 | 16 | :- import_module bool. 17 | :- import_module list. 18 | :- import_module pprint. 19 | 20 | :- import_module rfc5322. 21 | :- import_module rfc5322.parser. 22 | :- import_module rfc5322.writer. 23 | 24 | :- type case == string. 25 | 26 | %-----------------------------------------------------------------------------% 27 | 28 | main(!IO) :- 29 | io.command_line_arguments(Args, !IO), 30 | ( 31 | Args = [], 32 | Cases = cases 33 | ; 34 | Args = [_ | _], 35 | Cases = Args 36 | ), 37 | list.foldl(test, Cases, !IO). 38 | 39 | :- pred test(string::in, io::di, io::uo) is det. 40 | 41 | test(Input, !IO) :- 42 | io.write_string("input: «", !IO), 43 | io.write_string(Input, !IO), 44 | io.write_string("»\n", !IO), 45 | 46 | parse_address_list(backslash_quote_all, Input, Addresses), 47 | list.foldl(show_address, Addresses, !IO), 48 | io.nl(!IO), 49 | 50 | % Note: we use pprint for now instead of pretty_printer as the 51 | % output of pretty_printer was changed slightly on 2022-12-27. 52 | pprint.write(80, to_doc(Addresses), !IO), 53 | io.nl(!IO), 54 | io.write_string("--------\n", !IO). 55 | 56 | :- pred show_address(address::in, io::di, io::uo) is det. 57 | 58 | show_address(Address, !IO) :- 59 | address_to_string(rfc2047_encoding, Address, String, Valid), 60 | ( 61 | Valid = yes, 62 | io.write_string("valid: «", !IO) 63 | ; 64 | Valid = no, 65 | io.write_string("invalid: «", !IO) 66 | ), 67 | io.write_string(String, !IO), 68 | io.write_string("»\n", !IO). 69 | 70 | :- func cases = list(case). 71 | 72 | cases = [ 73 | (""), 74 | ("user"), 75 | ("user1 , user2"), 76 | ("user1 ,user2"), 77 | ("user@"), 78 | ("@"), 79 | ("@example.com"), 80 | 81 | ("user@example.com"), 82 | 83 | % Dot-atom 84 | ("user.name@example.com"), 85 | ("user.name@example.com.org"), 86 | ("user..name@example.com"), 87 | (".@example.com"), 88 | (".user@example.com"), 89 | ("user.@example.com"), 90 | 91 | % Quoted-string local part 92 | ("\"\"@example.com"), 93 | ("\"user name\"@example.com"), 94 | ("\"user..name\"@example.com"), 95 | ("\"user\\name\"@example.com"), 96 | ("\"user\\\\name\"@example.com"), 97 | ("\"user\\\"name\"@example.com"), 98 | 99 | % Whitespace around at-sign 100 | ("user @example.com"), 101 | ("user@ example.com"), 102 | 103 | % Domain literals 104 | ("user@[]"), 105 | ("user@[127.0.0.1]"), 106 | ("user@[ 127 . 1.2 .3 ]"), 107 | ("user@["), 108 | ("user@[\\]"), 109 | ("user@[[]"), 110 | ("user@[]]"), 111 | 112 | % Non-ASCII 113 | ("uśer@example.com"), 114 | ("user@éxample.com"), 115 | 116 | % Angle-addr 117 | (""), 118 | ("< user@example.com>"), 119 | ("< user@example.com\t>"), 120 | 121 | % Display names 122 | ("Display Name "), 123 | ("Display\\Name "), 124 | ("Display\\\\Name "), 125 | ("Display\\\"Name "), 126 | ("\"Display Name\" "), 127 | ("\"Display Name\" Name2 "), 128 | ("\"Display\\Name\" Name2 "), 129 | ("\"Display\\\\Name\" Name2 "), 130 | ("\"Display\\\"Name\" Name2 "), 131 | 132 | % Display names (may even exceed obs-phrase) 133 | ("D. Name "), 134 | ("Display X. Name "), 135 | ("Display..Name "), 136 | ("Display. .Name "), 137 | 138 | % Display name non-ASCII 139 | ("\"Dísplay Name\" Name2 "), 140 | 141 | % Comments 142 | ("()"), 143 | ("user()@example.com"), 144 | ("user@()example.com"), 145 | ("user@example.com ( here is a comment )"), 146 | ("(comment one)user@example.com(comment two)"), 147 | ("(comment one)Display Name(comment two)"), 148 | ("(comment one)Display Name()(comment two)"), 149 | 150 | % Groups 151 | ("group:"), 152 | ("group:,"), 153 | ("group:;"), 154 | ("group :;"), 155 | ("group : ;"), 156 | ("group :,;"), 157 | ("group :,,,;"), 158 | ("group(comment):(comment);(comment)"), 159 | ("\"group name\":;"), 160 | ("gróup:;"), 161 | ("group : user@example.com ;"), 162 | ("group : user@example.com (comment) ;"), 163 | ("group : user@example.com junk ;"), % could do better 164 | ("group : user1@example.com, user@example.com;"), 165 | ("group : user@example.com, ;"), 166 | ("group : ,user@example.com ;"), 167 | ("group : ,user@example.com,;"), 168 | ("group : User One ;"), 169 | ("group : User One , ;"), 170 | ("group : ,User One ;"), 171 | ("group : User One , user2@example.com ;"), 172 | ("group : user1, user2@example.com ;"), 173 | 174 | % Address list 175 | (","), 176 | ("user@example.com, user2@example.com"), 177 | ("user@example.com ,user2@example.com"), 178 | ("user@example.com , user2@example.com"), 179 | ("user@example.com, user2@example.com, user3@example.com"), 180 | ("user@example.com,"), 181 | ("user@example.com,,,"), 182 | (",,,user@example.com"), 183 | (",,,user@example.com,,,user2@example.com,,,"), 184 | ("Name1 , Name2 "), 185 | ("()Name1()(),()Name2 ()"), 186 | ("Name1 ,, Name2 ") 187 | ]. 188 | 189 | %-----------------------------------------------------------------------------% 190 | % vim: ft=mercury ts=4 sts=4 sw=4 et 191 | -------------------------------------------------------------------------------- /tests/test_rfc6068.exp: -------------------------------------------------------------------------------- 1 | input: «mailto:chris@example.com» 2 | ["To" - "chris@example.com"] 3 | -------- 4 | input: «mailto:infobot@example.com?subject=current-issue» 5 | ["To" - "infobot@example.com", "subject" - "current-issue"] 6 | -------- 7 | input: «mailto:infobot@example.com?body=send%20current-issue» 8 | ["To" - "infobot@example.com", "body" - "send current-issue"] 9 | -------- 10 | input: «mailto:infobot@example.com?body=send%20current-issue%0D%0Asend%20index» 11 | ["To" - "infobot@example.com", "body" - "send current-issue\r\nsend index"] 12 | -------- 13 | input: «mailto:list@example.org?In-Reply-To=%3C3469A91.D10AF4C@example.com%3E» 14 | ["To" - "list@example.org", "In-Reply-To" - "<3469A91.D10AF4C@example.com>"] 15 | -------- 16 | input: «mailto:majordomo@example.com?body=subscribe%20bamboo-l» 17 | ["To" - "majordomo@example.com", "body" - "subscribe bamboo-l"] 18 | -------- 19 | input: «mailto:joe@example.com?cc=bob@example.com&body=hello» 20 | ["To" - "joe@example.com", "cc" - "bob@example.com", "body" - "hello"] 21 | -------- 22 | input: «mailto:joe@example.com?cc=bob@example.com?body=hello» 23 | failed to parse 24 | -------- 25 | input: «mailto:gorby%25kremvax@example.com» 26 | ["To" - "gorby%kremvax@example.com"] 27 | -------- 28 | input: «mailto:unlikely%3Faddress@example.com?blat=foop» 29 | ["To" - "unlikely?address@example.com", "blat" - "foop"] 30 | -------- 31 | input: «mailto:Mike%26family@example.org» 32 | ["To" - "Mike&family@example.org"] 33 | -------- 34 | input: «mailto:%22not%40me%22@example.org» 35 | ["To" - "\"not@me\"@example.org"] 36 | -------- 37 | input: «mailto:%22oh%5C%5Cno%22@example.org» 38 | ["To" - "\"oh\\\\no\"@example.org"] 39 | -------- 40 | input: «mailto:%22%5C%5C%5C%22it's%5C%20ugly%5C%5C%5C%22%22@example.org» 41 | ["To" - "\"\\\\\\\"it\'s\\ ugly\\\\\\\"\"@example.org"] 42 | -------- 43 | input: «mailto:user@example.org?subject=caf%C3%A9» 44 | ["To" - "user@example.org", "subject" - "café"] 45 | -------- 46 | input: «mailto:user@example.org?subject=%3D%3Futf-8%3FQ%3Fcaf%3DC3%3DA9%3F%3D» 47 | ["To" - "user@example.org", "subject" - "=?utf-8?Q?caf=C3=A9?="] 48 | -------- 49 | input: «mailto:user@example.org?subject=%3D%3Fiso-8859-1%3FQ%3Fcaf%3DE9%3F%3D» 50 | ["To" - "user@example.org", "subject" - "=?iso-8859-1?Q?caf=E9?="] 51 | -------- 52 | input: «mailto:user@example.org?subject=caf%C3%A9&body=caf%C3%A9» 53 | ["To" - "user@example.org", "subject" - "café", "body" - "café"] 54 | -------- 55 | input: «mailto:user@%E7%B4%8D%E8%B1%86.example.org?subject=Test&body=NATTO» 56 | ["To" - "user@納豆.example.org", "subject" - "Test", "body" - "NATTO"] 57 | -------- 58 | -------------------------------------------------------------------------------- /tests/test_rfc6068.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_rfc6068. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module pretty_printer. 17 | 18 | :- import_module rfc6068. 19 | 20 | %-----------------------------------------------------------------------------% 21 | 22 | main(!IO) :- 23 | list.foldl(test, cases, !IO). 24 | 25 | :- pred test(string::in, io::di, io::uo) is det. 26 | 27 | test(Input, !IO) :- 28 | io.write_string("input: «", !IO), 29 | io.write_string(Input, !IO), 30 | io.write_string("»\n", !IO), 31 | 32 | ( parse_mailto_uri(Input, Mailto) -> 33 | pretty_printer.write_doc(format(Mailto), !IO), 34 | io.nl(!IO) 35 | ; 36 | io.write_string("failed to parse\n", !IO) 37 | ), 38 | io.write_string("--------\n", !IO). 39 | 40 | :- func cases = list(string). 41 | 42 | cases = [ 43 | "mailto:chris@example.com", 44 | "mailto:infobot@example.com?subject=current-issue", 45 | "mailto:infobot@example.com?body=send%20current-issue", 46 | "mailto:infobot@example.com?body=send%20current-issue%0D%0Asend%20index", 47 | "mailto:list@example.org?In-Reply-To=%3C3469A91.D10AF4C@example.com%3E", 48 | "mailto:majordomo@example.com?body=subscribe%20bamboo-l", 49 | "mailto:joe@example.com?cc=bob@example.com&body=hello", 50 | "mailto:joe@example.com?cc=bob@example.com?body=hello", % WRONG! 51 | "mailto:gorby%25kremvax@example.com", 52 | "mailto:unlikely%3Faddress@example.com?blat=foop", 53 | "mailto:Mike%26family@example.org", 54 | "mailto:%22not%40me%22@example.org", 55 | "mailto:%22oh%5C%5Cno%22@example.org", 56 | "mailto:%22%5C%5C%5C%22it's%5C%20ugly%5C%5C%5C%22%22@example.org", 57 | "mailto:user@example.org?subject=caf%C3%A9", 58 | "mailto:user@example.org?subject=%3D%3Futf-8%3FQ%3Fcaf%3DC3%3DA9%3F%3D", 59 | "mailto:user@example.org?subject=%3D%3Fiso-8859-1%3FQ%3Fcaf%3DE9%3F%3D", 60 | "mailto:user@example.org?subject=caf%C3%A9&body=caf%C3%A9", 61 | "mailto:user@%E7%B4%8D%E8%B1%86.example.org?subject=Test&body=NATTO" 62 | ]. 63 | 64 | %-----------------------------------------------------------------------------% 65 | % vim: ft=mercury ts=4 sts=4 sw=4 et 66 | -------------------------------------------------------------------------------- /tests/test_search_term.exp: -------------------------------------------------------------------------------- 1 | input: «» 2 | tokens: [] 3 | terms: «» 4 | apply limit: yes 5 | 6 | -------------------- 7 | input: «x y» 8 | tokens: [literal("x"), whitespace, literal("y")] 9 | terms: «x y» 10 | apply limit: yes 11 | 12 | -------------------- 13 | input: «{x(y)z}» 14 | tokens: [open_brace, literal("x"), open_paren, literal("y"), close_paren, literal("z"), close_brace] 15 | terms: «{x(y)z}» 16 | apply limit: yes 17 | 18 | -------------------- 19 | input: «abc(x{yz})def» 20 | tokens: [literal("abc"), open_paren, literal("x"), open_brace, literal("yz"), close_brace, close_paren, literal("def")] 21 | terms: «abc(x{yz})def» 22 | apply limit: yes 23 | 24 | -------------------- 25 | input: «"» 26 | error: Error parsing search string. 27 | 28 | -------------------- 29 | input: «x""y» 30 | tokens: [literal("x"), literal("\"\""), literal("y")] 31 | terms: «x""y» 32 | apply limit: yes 33 | 34 | -------------------- 35 | input: «x"a b""cde"y» 36 | tokens: [literal("x"), literal("\"a b\"\"cde\""), literal("y")] 37 | terms: «x"a b""cde"y» 38 | apply limit: yes 39 | 40 | -------------------- 41 | input: «~x» 42 | tokens: [macro("x")] 43 | terms: «~x» 44 | apply limit: yes 45 | 46 | -------------------- 47 | input: «~x~y» 48 | tokens: [macro("x~y")] 49 | terms: «~x~y» 50 | apply limit: yes 51 | 52 | -------------------- 53 | input: «x~y» 54 | tokens: [literal("x~y")] 55 | terms: «x~y» 56 | apply limit: yes 57 | 58 | -------------------- 59 | input: «x ~y» 60 | tokens: [literal("x"), whitespace, macro("y")] 61 | terms: «x ~y» 62 | apply limit: yes 63 | 64 | -------------------- 65 | input: «"~x"» 66 | tokens: [literal("\"~x\"")] 67 | terms: «"~x"» 68 | apply limit: yes 69 | 70 | -------------------- 71 | input: «"x"~y» 72 | tokens: [literal("\"x\""), literal("~y")] 73 | terms: «"x"~y» 74 | apply limit: yes 75 | 76 | -------------------- 77 | input: «(~x ~D ~F ~U ~A)» 78 | tokens: [open_paren, macro("x"), whitespace, literal("tag:deleted"), whitespace, literal("tag:flagged"), whitespace, literal("tag:unread"), whitespace, do_not_apply_limit, close_paren] 79 | terms: «(~x tag:deleted tag:flagged tag:unread )» 80 | apply limit: no 81 | 82 | -------------------- 83 | input: «x:~y» 84 | tokens: [literal("x:~y")] 85 | terms: «x:~y» 86 | apply limit: yes 87 | 88 | -------------------- 89 | input: «x:"~y"» 90 | tokens: [literal("x:"), literal("\"~y\"")] 91 | terms: «x:"~y"» 92 | apply limit: yes 93 | 94 | -------------------- 95 | input: «x:/~y/» 96 | tokens: [literal("x:/~y/")] 97 | terms: «x:/~y/» 98 | apply limit: yes 99 | 100 | -------------------- 101 | input: «x:(~y)» 102 | tokens: [literal("x:"), open_paren, macro("y"), close_paren] 103 | terms: «x:(~y)» 104 | apply limit: yes 105 | 106 | -------------------- 107 | input: «x:{~y}» 108 | tokens: [literal("x:"), open_brace, macro("y"), close_brace] 109 | terms: «x:{~y}» 110 | apply limit: yes 111 | 112 | -------------------- 113 | input: «~» 114 | tokens: [literal("~")] 115 | terms: «~» 116 | apply limit: yes 117 | 118 | -------------------- 119 | input: «~xyz:» 120 | tokens: [macro("xyz:")] 121 | terms: «~xyz:» 122 | apply limit: yes 123 | 124 | -------------------- 125 | input: «~xyz(» 126 | tokens: [macro("xyz"), open_paren] 127 | terms: «~xyz(» 128 | apply limit: yes 129 | 130 | -------------------- 131 | input: «~xyz)» 132 | tokens: [macro("xyz"), close_paren] 133 | terms: «~xyz)» 134 | apply limit: yes 135 | 136 | -------------------- 137 | input: «~xyz{» 138 | tokens: [macro("xyz"), open_brace] 139 | terms: «~xyz{» 140 | apply limit: yes 141 | 142 | -------------------- 143 | input: «~xyz}» 144 | tokens: [macro("xyz"), close_brace] 145 | terms: «~xyz}» 146 | apply limit: yes 147 | 148 | -------------------- 149 | input: «~xyz"abc"» 150 | tokens: [macro("xyz"), literal("\"abc\"")] 151 | terms: «~xyz"abc"» 152 | apply limit: yes 153 | 154 | -------------------- 155 | input: «~d» 156 | tokens: [macro("d")] 157 | terms: «~d» 158 | apply limit: yes 159 | 160 | -------------------- 161 | input: «~dtoday» 162 | tokens: [macro("dtoday")] 163 | terms: «~dtoday» 164 | apply limit: yes 165 | 166 | -------------------- 167 | input: «~d today» 168 | tokens: [date_range("today", "today")] 169 | terms: «date:today..today» 170 | apply limit: yes 171 | 172 | -------------------- 173 | input: «~d{today}» 174 | tokens: [date_range("today", "today")] 175 | terms: «date:today..today» 176 | apply limit: yes 177 | 178 | -------------------- 179 | input: «~d..» 180 | error: Error parsing search string. 181 | 182 | -------------------- 183 | input: «~d..today» 184 | tokens: [date_range("", "today")] 185 | terms: «date:..today» 186 | apply limit: yes 187 | 188 | -------------------- 189 | input: «~d {last week}..» 190 | tokens: [date_range("last week", "")] 191 | terms: «date:last_week..» 192 | apply limit: yes 193 | 194 | -------------------- 195 | input: «~d {3 days ago}..{next year}» 196 | tokens: [date_range("3 days ago", "next year")] 197 | terms: «date:3_days_ago..next_year» 198 | apply limit: yes 199 | 200 | -------------------- 201 | input: «~d 3.days.ago..next.year» 202 | tokens: [date_range("3.days.ago", "next.year")] 203 | terms: «date:3.days.ago..next.year» 204 | apply limit: yes 205 | 206 | -------------------- 207 | input: «x ~A» 208 | tokens: [literal("x"), whitespace, do_not_apply_limit] 209 | terms: «x » 210 | apply limit: no 211 | 212 | -------------------- 213 | input: «( ~A )» 214 | tokens: [open_paren, whitespace, do_not_apply_limit, whitespace, close_paren] 215 | terms: «( )» 216 | apply limit: no 217 | 218 | -------------------- 219 | input: «{ ~A }» 220 | tokens: [open_brace, whitespace, do_not_apply_limit, whitespace, close_brace] 221 | terms: «{ }» 222 | apply limit: no 223 | 224 | -------------------- 225 | input: «x:(~A)» 226 | tokens: [literal("x:"), open_paren, do_not_apply_limit, close_paren] 227 | terms: «x:()» 228 | apply limit: no 229 | 230 | -------------------- 231 | -------------------------------------------------------------------------------- /tests/test_search_term.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_search_term. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is det. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module bool. 16 | :- import_module list. 17 | :- import_module maybe. 18 | 19 | :- import_module search_term. 20 | 21 | %-----------------------------------------------------------------------------% 22 | 23 | main(!IO) :- 24 | io.command_line_arguments(Args, !IO), 25 | ( 26 | Args = [], 27 | Cases = cases 28 | ; 29 | Args = [_ | _], 30 | Cases = Args 31 | ), 32 | list.foldl(run_test_case, Cases, !IO). 33 | 34 | :- pred run_test_case(string::in, io::di, io::uo) is det. 35 | 36 | run_test_case(Input, !IO) :- 37 | io.write_string("input: «", !IO), 38 | io.write_string(Input, !IO), 39 | io.write_string("»\n", !IO), 40 | parse_search_string(Input, Res), 41 | ( 42 | Res = ok(Tokens), 43 | tokens_to_search_terms(Tokens, Terms), 44 | check_apply_limit(Tokens, ApplyLimit), 45 | io.write_string("tokens: ", !IO), 46 | io.print(Tokens, !IO), 47 | io.write_string("\n", !IO), 48 | io.write_string("terms: «", !IO), 49 | io.write_string(Terms, !IO), 50 | io.write_string("»\n", !IO), 51 | io.write_string("apply limit: ", !IO), 52 | io.print(ApplyLimit, !IO), 53 | io.nl(!IO) 54 | ; 55 | Res = error(Error), 56 | io.write_string("error: ", !IO), 57 | io.write_string(Error, !IO), 58 | io.nl(!IO) 59 | ), 60 | 61 | io.write_string("\n--------------------\n", !IO). 62 | 63 | :- func cases = list(string). 64 | 65 | cases = [ 66 | % whitespace 67 | "", 68 | "x y", 69 | 70 | % parens/braces 71 | "{x(y)z}", 72 | "abc(x{yz})def", 73 | 74 | % double-quoted strings 75 | """", 76 | "x""""y", 77 | "x""a b""""cde""y", 78 | 79 | % tilde only special after whitespace or open paren/brace 80 | "~x", 81 | "~x~y", 82 | "x~y", 83 | "x ~y", 84 | """~x""", 85 | """x""~y", 86 | "(~x ~D ~F ~U ~A)", 87 | "x:~y", 88 | "x:""~y""", 89 | "x:/~y/", 90 | "x:(~y)", 91 | "x:{~y}", 92 | 93 | % macro names 94 | "~", 95 | "~xyz:", 96 | "~xyz(", 97 | "~xyz)", 98 | "~xyz{", 99 | "~xyz}", 100 | "~xyz""abc""", 101 | 102 | % date ranges 103 | "~d", 104 | "~dtoday", 105 | "~d today", 106 | "~d{today}", 107 | "~d..", 108 | "~d..today", 109 | "~d {last week}..", 110 | "~d {3 days ago}..{next year}", 111 | "~d 3.days.ago..next.year", 112 | 113 | % ~A 114 | "x ~A", 115 | "( ~A )", 116 | "{ ~A }", 117 | "x:(~A)" 118 | ]. 119 | 120 | %-----------------------------------------------------------------------------% 121 | % vim: ft=mercury ts=4 sts=4 sw=4 et 122 | -------------------------------------------------------------------------------- /tests/test_shell_word.exp: -------------------------------------------------------------------------------- 1 | input: «abc def? x#y» 2 | tokens: [word([unquoted("abc")]), whitespace, word([unquoted("def?")]), whitespace, word([unquoted("x#y")])] 3 | serialise: «abc def? x#y» 4 | quote all: «abc 'def?' 'x#y'» 5 | 6 | -------------------- 7 | input: « abc def 123 456 » 8 | tokens: [word([unquoted("abc")]), whitespace, word([unquoted("def")]), whitespace, word([unquoted("123")]), whitespace, word([unquoted("456")])] 9 | serialise: «abc def 123 456» 10 | quote all: «abc def 123 456» 11 | 12 | -------------------- 13 | input: «abc|&;()<>xyz» 14 | tokens: [word([unquoted("abc")]), gmeta("|&;()<>"), word([unquoted("xyz")])] 15 | serialise: «abc|&;()<>xyz» 16 | quote all: «abc'|&;()<>'xyz» 17 | 18 | -------------------- 19 | input: «\» 20 | error: missing escaped character 21 | 22 | -------------------- 23 | input: «a\\b» 24 | tokens: [word([unquoted("a"), quoted("\\\\"), unquoted("b")])] 25 | serialise: «a\\b» 26 | quote all: «a\\b» 27 | 28 | -------------------- 29 | input: «a\;b» 30 | tokens: [word([unquoted("a"), quoted("\\;"), unquoted("b")])] 31 | serialise: «a\;b» 32 | quote all: «a\;b» 33 | 34 | -------------------- 35 | input: «a\'b» 36 | tokens: [word([unquoted("a"), quoted("\\\'"), unquoted("b")])] 37 | serialise: «a\'b» 38 | quote all: «a\'b» 39 | 40 | -------------------- 41 | input: «'» 42 | error: unmatched single quote 43 | 44 | -------------------- 45 | input: «a''b» 46 | tokens: [word([unquoted("a"), quoted("\'\'"), unquoted("b")])] 47 | serialise: «a''b» 48 | quote all: «a''b» 49 | 50 | -------------------- 51 | input: «a' 'b» 52 | tokens: [word([unquoted("a"), quoted("\' \'"), unquoted("b")])] 53 | serialise: «a' 'b» 54 | quote all: «a' 'b» 55 | 56 | -------------------- 57 | input: «a';'b» 58 | tokens: [word([unquoted("a"), quoted("\';\'"), unquoted("b")])] 59 | serialise: «a';'b» 60 | quote all: «a';'b» 61 | 62 | -------------------- 63 | input: «a'"'b» 64 | tokens: [word([unquoted("a"), quoted("\'\"\'"), unquoted("b")])] 65 | serialise: «a'"'b» 66 | quote all: «a'"'b» 67 | 68 | -------------------- 69 | input: «"» 70 | error: unmatched double quote 71 | 72 | -------------------- 73 | input: «a""b» 74 | tokens: [word([unquoted("a"), quoted("\"\""), unquoted("b")])] 75 | serialise: «a""b» 76 | quote all: «a""b» 77 | 78 | -------------------- 79 | input: «a" "b» 80 | tokens: [word([unquoted("a"), quoted("\" \""), unquoted("b")])] 81 | serialise: «a" "b» 82 | quote all: «a" "b» 83 | 84 | -------------------- 85 | input: «a";"b» 86 | tokens: [word([unquoted("a"), quoted("\";\""), unquoted("b")])] 87 | serialise: «a";"b» 88 | quote all: «a";"b» 89 | 90 | -------------------- 91 | input: «a"'"b» 92 | tokens: [word([unquoted("a"), quoted("\"\'\""), unquoted("b")])] 93 | serialise: «a"'"b» 94 | quote all: «a"'"b» 95 | 96 | -------------------- 97 | input: «a"\"b» 98 | error: unmatched double quote 99 | 100 | -------------------- 101 | input: «a"\""b» 102 | tokens: [word([unquoted("a"), quoted("\"\\\"\""), unquoted("b")])] 103 | serialise: «a"\""b» 104 | quote all: «a"\""b» 105 | 106 | -------------------- 107 | input: «foo &1 && true |{bar; bar}&» 108 | tokens: [word([unquoted("foo")]), whitespace, gmeta("<"), word([unquoted("/dev/random")]), whitespace, word([unquoted("2")]), gmeta(">&"), word([unquoted("1")]), whitespace, gmeta("&&"), whitespace, word([unquoted("true")]), whitespace, gmeta("|"), word([unquoted("{bar")]), gmeta(";"), whitespace, word([unquoted("bar}")]), gmeta("&")] 109 | serialise: «foo &1 && true |{bar; bar}&» 110 | quote all: «foo '<'/dev/random 2'>&'1 '&&' true '|''{bar'';' 'bar}''&'» 111 | 112 | -------------------- 113 | -------------------------------------------------------------------------------- /tests/test_shell_word.inp: -------------------------------------------------------------------------------- 1 | # unquoted 2 | abc def? x#y 3 | 4 | # spaces 5 | abc def 123 456 6 | 7 | # metacharacters 8 | abc|&;()<>xyz 9 | 10 | # escape character 11 | \ 12 | a\\b 13 | a\;b 14 | a\'b 15 | 16 | # single quotes 17 | ' 18 | a''b 19 | a' 'b 20 | a';'b 21 | a'"'b 22 | 23 | # double quotes 24 | " 25 | a""b 26 | a" "b 27 | a";"b 28 | a"'"b 29 | a"\"b 30 | a"\""b 31 | 32 | # command 33 | foo &1 && true |{bar; bar}& 34 | -------------------------------------------------------------------------------- /tests/test_shell_word.m: -------------------------------------------------------------------------------- 1 | %-----------------------------------------------------------------------------% 2 | 3 | :- module test_shell_word. 4 | :- interface. 5 | 6 | :- import_module io. 7 | 8 | :- pred main(io::di, io::uo) is cc_multi. 9 | 10 | %-----------------------------------------------------------------------------% 11 | %-----------------------------------------------------------------------------% 12 | 13 | :- implementation. 14 | 15 | :- import_module list. 16 | :- import_module maybe. 17 | :- import_module string. 18 | :- import_module parsing_utils. 19 | 20 | :- import_module shell_word. 21 | 22 | %-----------------------------------------------------------------------------% 23 | 24 | main(!IO) :- 25 | main_loop(!IO). 26 | 27 | :- pred main_loop(io::di, io::uo) is cc_multi. 28 | 29 | main_loop(!IO) :- 30 | io.read_line_as_string(ReadRes, !IO), 31 | ( 32 | ReadRes = ok(Input0), 33 | Input = chomp(Input0), 34 | ( if Input = "" ; string.prefix(Input, "#") then 35 | true 36 | else 37 | run_test_case(chomp(Input), !IO) 38 | ), 39 | main_loop(!IO) 40 | ; 41 | ReadRes = eof 42 | ; 43 | ReadRes = error(Error), 44 | io.stderr_stream(Stderr, !IO), 45 | io.write_string(Stderr, io.error_message(Error), !IO), 46 | io.nl(Stderr, !IO), 47 | io.set_exit_status(1, !IO) 48 | ). 49 | 50 | :- pred run_test_case(string::in, io::di, io::uo) is cc_multi. 51 | 52 | run_test_case(Input, !IO) :- 53 | io.write_string("input: «", !IO), 54 | io.write_string(Input, !IO), 55 | io.write_string("»\n", !IO), 56 | tokenise(Input, ParseResult), 57 | ( 58 | ParseResult = ok(Tokens), 59 | io.write_string("tokens: ", !IO), 60 | io.print_line(Tokens, !IO), 61 | serialise_as_is(Tokens, AsIs), 62 | io.write_string("serialise: «", !IO), 63 | io.write_string(AsIs, !IO), 64 | io.write_string("»\n", !IO), 65 | serialise_quote_all(Tokens, QuoteAll), 66 | io.write_string("quote all: «", !IO), 67 | io.write_string(QuoteAll, !IO), 68 | io.write_string("»\n", !IO) 69 | ; 70 | ParseResult = error(MaybeError, _, _), 71 | io.write_string("error: ", !IO), 72 | ( 73 | MaybeError = yes(Error), 74 | io.write_string(Error, !IO) 75 | ; 76 | MaybeError = no, 77 | io.write_string("unknown parse error", !IO) 78 | ), 79 | io.nl(!IO) 80 | ), 81 | 82 | io.write_string("\n--------------------\n", !IO). 83 | 84 | %-----------------------------------------------------------------------------% 85 | % vim: ft=mercury ts=4 sts=4 sw=4 et 86 | --------------------------------------------------------------------------------