pax_global_header00006660000000000000000000000064150032017200014500gustar00rootroot0000000000000052 comment=d3bcc2e368e7399af664812cbd67df1dc827d58b interimap-0.5.8/000077500000000000000000000000001500320172000135025ustar00rootroot00000000000000interimap-0.5.8/.gitignore000066400000000000000000000000271500320172000154710ustar00rootroot00000000000000*~ *.bak /build/ /.pc/ interimap-0.5.8/COPYING000066400000000000000000001045171500320172000145450ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . interimap-0.5.8/Changelog000066400000000000000000000471141500320172000153230ustar00rootroot00000000000000interimap (0.5.8) upstream; + Port tests and documentation to Dovecot 2.4. Running the test suite now require Dovecot 2.3 or later. - Makefile: Replace '$(dir $@)' with '$(@D)'. - tests/*/t: Replace filetype=sh with filetype=bash in vim's hints. - tests/certs/generate: Generate X.509 version 3 CA, and pass CA:TRUE as basic constraint. This fixes the test suite with OpenSSL 3.2 with defaults to X.509v3 and CA:FALSE. - tests: Explicitly pass `-in /dev/stdin` to openssl(1). - tests: Check that that pullimap locks its statefile. -- Guilhem Moulin Sat, 26 Apr 2025 18:03:28 +0200 interimap (0.5.7) upstream; * interimap: create database with mode 0600 (but don't change mode of existing databases). The file was previously created with mode 0644 minus umask restrictions, which for permissive umask(2)s is too open. That being said its parent directory is created with restricted mode 0700 so the impact is limited. pullimap, on the other hand, already used mode 0600 for state file creation. * Major Makefile refactoring: improve DESTDIR= handling, add new targets 'all-nodoc', 'install-nodoc', and 'installcheck'. Also, rename 'test' target to 'check'. * `make install` now installs Net/IMAP/InterIMAP.pm to /usr/local/lib/site_perl by default rather than /usr/local/share/perl5 (which is not in @INC as of perl 5.34.0-3 from Debian sid). The installation directory is configurable with sitelib=. * Refactor test harness so one can check the source with `tests/run foo`; what's been built with `INTERIMAP_I=./lib INTERIMAP_PATH=./build ./tests/run foo`, and what's installed with `INTERIMAP_I="" INTERIMAP_PATH=/usr/bin tests/run foo`. * Split interimap and pullimap test suites. + Improve message for missing untagged UIDNEXT responses, which we require but are omitted from some servers. + tests/tls-protocols: downgrade OpenSSL security level to 0, which is required to test TLS version <1.2 on systems with higher security levels, see SSL_CTX_set_security_level(3ssl). Adapted from a patch from for Unbuntu. + tests/tls-*: bump Dovecot's ssl_min_protocol to TLSv1.2, which is the default as of dovecot 1:2.3.18+dfsg1-1 from Debian sid. + `make clean` now cleans test certificates and key material. + Add 'use lib "./lib";' to interimap and pullimap, so the programs can be run directly from the source directory. The directory is substituted with $(sitelib) at compile time (and the line is commented out if $(sitelib) is found in @INC). + doc/build.md: update documentation, and add a new section for how to install without root privileges. + Add Documentation=https://guilhem.org/interimap/... URIs to .service files. - Don't hardcode path to interimap/pullimap in .service files, and instead use $(bindir) (expanded at compile time). - tests/certs/generate: redirect known error output to the standard output. - tests/certs/generate: use custom openssl.cnf to avoid depending on the system default. - tests/pullimap: allow easy exclusion of --idle'ing tests. -- Guilhem Moulin Sun, 27 Feb 2022 16:24:31 +0100 interimap (0.5.6) upstream; - Bump required Net::SSLeay version to 1.86_06 as it's when get_version() was introduced. - doc/template.html: remove type attribute from $if(highlighting-css)$ $endif$ $for(css)$ $endfor$ $if(math)$ $math$ $endif$ $for(header-includes)$ $header-includes$ $endfor$ $for(include-before)$ $include-before$ $endfor$
$if(title)$
$if(parent)$
Parent
$endif$

$title$

$endif$ $body$
$if(author)$ Copyright © $for(author)$$author$$sep$, $endfor$ $endif$
$if(date)$$date$$endif$
interimap-0.5.8/interimap000077500000000000000000002007121500320172000154220ustar00rootroot00000000000000#!/usr/bin/perl -T #---------------------------------------------------------------------- # Fast bidirectional synchronization for QRESYNC-capable IMAP servers # Copyright © 2015-2022 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . #---------------------------------------------------------------------- use v5.14.2; use strict; use warnings; our $VERSION = '0.5.8'; my $NAME = 'interimap'; my $DATABASE_VERSION = 1; use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version/; use DBI ':sql_types'; use DBD::SQLite::Constants ':file_open'; use Fcntl qw/O_WRONLY O_CREAT O_EXCL F_GETFD F_SETFD FD_CLOEXEC/; use List::Util 'first'; use lib "./lib"; use Net::IMAP::InterIMAP 0.5.8 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; delete @ENV{qw/IFS CDPATH ENV BASH_ENV/}; my %CONFIG; sub usage(;$) { my $rv = shift // 0; if ($rv) { print STDERR "Usage: $NAME [OPTIONS] [COMMAND] [MAILBOX [..]]\n" ."Try '$NAME --help' or consult the manpage for more information.\n"; } else { print STDERR "Usage: $NAME [OPTIONS] [MAILBOX [..]]\n" ." or: $NAME [OPTIONS] --repair [MAILBOX [..]]\n" ." or: $NAME [OPTIONS] --delete MAILBOX [..]\n" ." or: $NAME [OPTIONS] --rename SOURCE DEST\n" ."Consult the manpage for more information.\n"; } exit $rv; } my @COMMANDS = qw/repair delete rename/; usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q target=s@ debug+ help|h watch:i notify/, @COMMANDS); usage(0) if $CONFIG{help}; my $COMMAND = do { my @command = grep {exists $CONFIG{$_}} @COMMANDS; usage(1) if $#command>0; $command[0] }; usage(1) if defined $COMMAND and (($COMMAND eq 'delete' and !@ARGV) or ($COMMAND eq 'rename' and $#ARGV != 1)); usage(1) if defined $COMMAND and (defined $CONFIG{watch} or defined $CONFIG{notify}); usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete' or $COMMAND eq 'rename')); $CONFIG{watch} = $CONFIG{notify} ? 900 : 60 if (defined $CONFIG{watch} or $CONFIG{notify}) and !$CONFIG{watch}; @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive die "Invalid mailbox name $_" foreach grep !/\A[\x01-\x7F]+\z/, @ARGV; my $CONF = do { my $conffile = delete($CONFIG{config}) // "config"; $conffile = xdg_basedir( XDG_CONFIG_HOME => ".config", $NAME, $conffile ); read_config( $conffile , [qw/_ local remote/] , database => qr/\A(\P{Control}+)\z/ , logfile => qr/\A(\/\P{Control}+)\z/ , 'log-prefix' => qr/\A(\P{Control}*)\z/ , 'list-reference' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]*)\z/ , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ , 'list-select-opts' => qr/\A([\x20\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]*)\z/ , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ ); }; my ($DBFILE, %LOGGER_CONF, %LIST); { $CONF->{_} //= {}; $DBFILE = $CONF->{_}->{database}; $DBFILE //= $CONF->{remote}->{host}.'.db' if defined $CONF->{remote}; $DBFILE //= $CONF->{local}->{host}. '.db' if defined $CONF->{local}; die "Missing option database" unless defined $DBFILE; $DBFILE = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $DBFILE ); $LOGGER_CONF{'logger-prefix'} = $CONF->{_}->{'log-prefix'} // "%?n?%?m?%n(%m)&%n?: ?"; if (defined (my $l = $CONF->{_}->{logfile})) { require 'POSIX.pm'; require 'Time/HiRes.pm'; open my $fd, '>>', $l or die "Can't open $l: $!\n"; $fd->autoflush(1); my $flags = fcntl($fd, F_GETFD, 0) or die "fcntl F_GETFD: $!"; fcntl($fd, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!"; $LOGGER_CONF{'logger-fd'} = $fd; } $LIST{mailbox} = [@ARGV]; if (!defined $COMMAND or $COMMAND eq 'repair') { if (!@ARGV and defined (my $v = $CONF->{_}->{'list-mailbox'})) { my @mailbox; do { if ($v =~ s/\A[\x21\x23-\x27\x2A-\x5B\x5D-\x7A\x7C-\x7E]+//p) { push @mailbox, ${^MATCH}; } elsif ($v =~ s/\A\"((?: [\x20\x21\x23-\x5B\x5D-\x7E] | # the above plus \x20\x28\x29\x7B (?:\\(?:[\x22\x5C0abtnvfr] | x\p{AHex}{2})) # quoted char or hex-encoded pair )+)\"//x) { push @mailbox, $1 =~ s/\\(?:[\x22\x5C0abtnvfr]|x\p{AHex}{2})/"\"${^MATCH}\""/greep; } } while ($v =~ s/\A\s+//); die "Invalid value for list-mailbox: ".$CONF->{_}->{'list-mailbox'}."\n" if $v ne ""; $LIST{mailbox} = \@mailbox; } $LIST{'select-opts'} = uc($CONF->{_}->{'list-select-opts'}) if defined $CONF->{_}->{'list-select-opts'} and $CONF->{_}->{'list-select-opts'} ne ""; $LIST{params} = [ "SUBSCRIBED" ]; # RFC 5258 - LIST Command Extensions push @{$LIST{params}}, "STATUS (UIDVALIDITY UIDNEXT HIGHESTMODSEQ)" # RFC 5819 - Returning STATUS Information in Extended LIST unless $CONFIG{notify}; } if (defined (my $t = $CONFIG{target})) { @$t = map { split(",", $_) } @$t; die "Invalid target $_\n" foreach grep !/^(?:local|remote|database)$/, @$t; $CONFIG{target} = {}; $CONFIG{target}->{$_} = 1 foreach @$t; } else { $CONFIG{target} = {}; $CONFIG{target}->{$_} = 1 foreach qw/local remote database/; } $CONF->{$_}->{'list-reference'} //= "" foreach qw/local remote/; } my $DBH; # Clean after us my ($IMAP, $lIMAP, $rIMAP); sub cleanup() { undef $_ foreach grep defined, ($IMAP, $lIMAP, $rIMAP); logger(undef, "Cleaning up...") if $CONFIG{debug}; $LOGGER_CONF{'logger-fd'}->close() if defined $LOGGER_CONF{'logger-fd'}; $DBH->disconnect() if defined $DBH; } $SIG{INT} = sub { msg(undef, $!); cleanup(); exit 1; }; $SIG{TERM} = sub { cleanup(); exit 0; }; ############################################################################# # Open (and maybe create) the database { # don't auto-create in long-lived mode unless ($CONFIG{watch} or -e $DBFILE) { sysopen(my $fh, $DBFILE, O_WRONLY | O_CREAT | O_EXCL, 0600) or die "Can't create $DBFILE: $!"; close $fh or warn "close: $!"; } my $dbi_data_source = "dbi:SQLite:dbname=".$DBFILE; my %dbi_attrs = ( AutoCommit => 0, RaiseError => 1, sqlite_use_immediate_transaction => 1, sqlite_open_flags => SQLITE_OPEN_READWRITE ); $DBH = DBI::->connect($dbi_data_source, undef, undef, \%dbi_attrs); $DBH->sqlite_busy_timeout(250); # Try to lock the database before any network traffic so we can fail # early if the database is already locked. $DBH->do("PRAGMA locking_mode = EXCLUSIVE"); $DBH->{AutoCommit} = 1; # turned back off later $DBH->do("PRAGMA foreign_keys = OFF"); # toggled later (no-op if not in autocommit mode) } sub msg($@) { my %h = ( %LOGGER_CONF, name => shift ); return Net::IMAP::InterIMAP::log(\%h, @_); } sub msg2($$@) { my $name = shift; my $mailbox = mbx_name($name => shift); my %h = ( %LOGGER_CONF, name => $name, mailbox => $mailbox ); return Net::IMAP::InterIMAP::log(\%h, @_); } sub logger($@) { my %h = ( %LOGGER_CONF, name => shift ); return Net::IMAP::InterIMAP::logger(\%h, @_); } sub fail($@) { my $name = shift; msg($name, "ERROR: ", @_); exit 1; } logger(undef, ">>> $NAME $VERSION") if $CONFIG{debug}; ############################################################################# # Connect to the local and remote IMAP servers foreach my $name (qw/local remote/) { my %config = %{$CONF->{$name}}; $config{$_} = $CONFIG{$_} foreach grep {defined $CONFIG{$_}} qw/quiet debug/; $config{enable} = 'QRESYNC'; $config{name} = $name; $config{$_} = $LOGGER_CONF{$_} foreach keys %LOGGER_CONF; $config{'compress'} //= ($name eq 'local' ? 0 : 1); $config{keepalive} = 1 if $CONFIG{watch} and $config{type} ne 'tunnel'; my $client = Net::IMAP::InterIMAP::->new(%config); $IMAP->{$name} = { client => $client }; die "Non $_-capable IMAP server.\n" foreach $client->incapable(qw/LIST-EXTENDED UIDPLUS/); die "Non LIST-STATUS-capable IMAP server.\n" if !$CONFIG{notify} and $client->incapable('LIST-STATUS'); } # Pretty-print hierarchy delimiter: DQUOTE QUOTED-CHAR DQUOTE / nil sub print_delimiter($) { my $d = shift // return "NIL"; $d = "\\".$d if $d eq "\\" or $d eq "\""; return "\"".$d."\""; } # Return the delimiter of the default namespace or reference, and cache the # result. Use the cached value if present, otherwise issue a new LIST # command with the empty mailbox. sub get_delimiter($$$) { my ($name, $imap, $ref) = @_; # Use the cached value if present return $imap->{delimiter} if exists $imap->{delimiter}; my (undef, $d) = $imap->{client}->list($ref." \"\""); # $ref is already quoted my @d = values %$d if defined $d; # While multiple LIST responses may happen in theory, we've issued a # single LIST command, so it's fair to expect a single reponse with # a hierarchy delimiter of the root node or reference (we can't # match the root against the reference as it might not be rooted). fail($name, "Missing or unexpected (unsolicited) LIST response.") unless $#d == 0; return $imap->{delimiter} = $d[0]; # cache value and return it } # List mailboxes; don't return anything but update $IMAP->{$name}->{mailboxes} sub list_mailboxes($) { my $name = shift; my $imap = $IMAP->{$name}; my $ref = Net::IMAP::InterIMAP::quote($CONF->{$name}->{'list-reference'}); my $list = ""; $list .= "(" .$LIST{'select-opts'}. ") " if defined $LIST{'select-opts'}; $list .= $ref." "; my @mailboxes = @{$LIST{mailbox}}; my $cached_delimiter = exists $imap->{delimiter} ? 1 : 0; if (grep { index($_,"\x00") >= 0 } @mailboxes) { # some mailbox names contain null characters: substitute them with the hierarchy delimiter my $d = get_delimiter($name, $imap, $ref) // fail($name, "Mailbox name contains null characters but the namespace is flat!"); s/\x00/$d/g foreach @mailboxes; } $list .= $#mailboxes < 0 ? "*" : $#mailboxes == 0 ? Net::IMAP::InterIMAP::quote($mailboxes[0]) : "(".join(" ", map {Net::IMAP::InterIMAP::quote($_)} @mailboxes).")"; my ($mbx, $delims) = $imap->{client}->list($list, @{$LIST{params} // []}); $imap->{mailboxes} = $mbx; # INBOX exists in a namespace of its own, so it may have a different separator. # All other mailboxes MUST have the same separator though, per 3501 sec. 7.2.2 # and https://imapwiki.org/ClientImplementation/MailboxList#Hierarchy_separators # (We assume all list-mailbox arguments given live in the same namespace. Otherwise # the user needs to start multiple interimap instances.) delete $delims->{INBOX}; unless (exists $imap->{delimiter}) { # if the delimiter is still unknown (meaning no names in @{$LIST{mailbox}} # contains null characters) we now cache it if (%$delims) { # got a non-INBOX LIST reply, use the first one as authoritative value my ($m) = sort keys %$delims; $imap->{delimiter} = delete $delims->{$m}; } else { # didn't get a non-INBOX LIST reply so we need to explicitly query # the hierarchy delimiter get_delimiter($name, $imap, $ref); } } logger($name, "Using ", print_delimiter($imap->{delimiter}), " as hierarchy delimiter") if !$cached_delimiter and $CONFIG{debug}; # Ensure all LISTed delimiters (incl. INBOX's children, although they're # in a different namespace -- we treat INBOX itself separately, but not # its children) match the one at the top level (root or reference). my $d = $imap->{delimiter}; foreach my $m (keys %$delims) { fail($name, "Mailbox $m has hierarchy delimiter ", print_delimiter($delims->{$m}), ", while ", print_delimiter($d), " was expected.") if (defined $d xor defined $delims->{$m}) or (defined $d and defined $delims->{$m} and $d ne $delims->{$m}); } } list_mailboxes("local"); if (defined (my $d = $IMAP->{local}->{delimiter})) { # substitute the local delimiter with null characters in the mailbox list s/\Q$d\E/\x00/g foreach @{$LIST{mailbox}}; } list_mailboxes("remote"); # Ensure local and remote namespaces are either both flat, or both hierarchical. # (We can't mirror a hierarchical namespace to a flat one.) fail(undef, "Local and remote namespaces are neither both flat nor both hierarchical ", "(local ", print_delimiter($IMAP->{local}->{delimiter}), ", ", "remote ", print_delimiter($IMAP->{remote}->{delimiter}), ").") if defined $IMAP->{local}->{delimiter} xor defined $IMAP->{remote}->{delimiter}; ############################################################################## # Create or update database schema (delayed until after the IMAP # connections and mailbox LISTing as we need to know the hierarchy # delimiter for the schema migration). { # Invariants: # * UIDVALIDITY never changes. # * All changes for UID < {local,remote}.UIDNEXT and MODSEQ < # {local,remote}.HIGHESTMODSEQ have been propagated. # * No local (resp. remote) new message will ever have a UID <= local.UIDNEXT # (resp. <= remote.UIDNEXT). # * Any idx in `local` must be present in `remote` and vice-versa. # * Any idx in `mapping` must be present in `local` and `remote`. my @schema = ( mailboxes => [ q{idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT}, # to avoid caching hierachy delimiter of mailbox names forever we replace it # with '\0' in that table; the substitution is safe since null characters are # not allowed within mailbox names q{mailbox BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE}, q{subscribed BOOLEAN NOT NULL} ], local => [ q{idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx)}, # no UNIQUE constraint on UIDVALIDITY as two mailboxes may share the same value q{UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0)}, q{UIDNEXT UNSIGNED INT NOT NULL}, # 0 initially q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially (/!\ converted to 8-byte signed integer) # one-to-one correspondence between local.idx and remote.idx ], remote => [ q{idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx)}, # no UNIQUE constraint on UIDVALIDITY as two mailboxes may share the same value q{UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0)}, q{UIDNEXT UNSIGNED INT NOT NULL}, # 0 initially q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially (/!\ converted to 8-byte signed integer) # one-to-one correspondence between local.idx and remote.idx ], mapping => [ q{idx INTEGER NOT NULL REFERENCES mailboxes(idx)}, q{lUID UNSIGNED INT NOT NULL CHECK (lUID > 0)}, q{rUID UNSIGNED INT NOT NULL CHECK (rUID > 0)}, q{PRIMARY KEY (idx,lUID)}, q{UNIQUE (idx,rUID)} # also, lUID < local.UIDNEXT and rUID < remote.UIDNEXT (except for interrupted syncs) # mapping.idx must be found among local.idx (and remote.idx) ], ); # Use the user_version PRAGMA (0 if unset) to keep track of schema # version https://sqlite.org/pragma.html#pragma_user_version my ($schema_version) = $DBH->selectrow_array("PRAGMA user_version"); if ($schema_version < $DATABASE_VERSION) { # schema creation or upgrade required $DBH->begin_work(); if ($schema_version == 0) { my $sth = $DBH->table_info(undef, undef, undef, "TABLE"); unless (defined $sth->fetch()) { # there are no tables, create everything msg(undef, "Creating new schema in database file $DBFILE"); for (my $i = 0; $i <= $#schema; $i+=2) { $DBH->do("CREATE TABLE $schema[$i] (".join(", ", @{$schema[$i+1]}).")"); } goto SCHEMA_DONE; # skip the below migrations } } msg(undef, "Upgrading database version from $schema_version"); # 12-step procedure from https://www.sqlite.org/lang_altertable.html if ($schema_version < 1) { fail(undef, "Local and remote hierachy delimiters differ ", "(local ", print_delimiter($IMAP->{local}->{delimiter}), ", ", "remote ", print_delimiter($IMAP->{remote}->{delimiter}), "), ", "refusing to update table \`mailboxes\`.") if defined $IMAP->{local}->{delimiter} and defined $IMAP->{remote}->{delimiter} # we failed earlier if only one of them was NIL and $IMAP->{local}->{delimiter} ne $IMAP->{remote}->{delimiter}; $DBH->do("CREATE TABLE _tmp${DATABASE_VERSION}_mailboxes (". join(", ", q{idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT}, q{mailbox BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE}, q{subscribed BOOLEAN NOT NULL} ).")"); if (defined (my $d = $IMAP->{local}->{delimiter})) { # local and remote delimiters match, replace them with null characters my $sth = $DBH->prepare("INSERT INTO _tmp${DATABASE_VERSION}_mailboxes SELECT idx, CAST(REPLACE(mailbox, ?, x'00') AS BLOB), subscribed FROM mailboxes"); $sth->bind_param(1, $IMAP->{local}->{delimiter}, SQL_VARCHAR); $sth->execute(); } else { # treat all mailboxes as flat (\NoInferiors names) $DBH->do("INSERT INTO _tmp${DATABASE_VERSION}_mailboxes SELECT * FROM mailboxes"); } $DBH->do("DROP TABLE mailboxes"); $DBH->do("ALTER TABLE _tmp${DATABASE_VERSION}_mailboxes RENAME TO mailboxes"); } fail("database", "Broken referential integrity! Refusing to commit changes.") if defined $DBH->selectrow_arrayref("PRAGMA foreign_key_check"); SCHEMA_DONE: $DBH->do("PRAGMA user_version = $DATABASE_VERSION"); $DBH->commit(); } $DBH->do("PRAGMA foreign_keys = ON"); # no-op if not in autocommit mode $DBH->{AutoCommit} = 0; # always explicitly commit changes } ############################################################################## # # Add a new mailbox to the database. # WARN: does not commit changes! sub db_create_mailbox($$) { my ($mailbox, $subscribed) = @_;; state $sth = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)}); $sth->bind_param(1, $mailbox, SQL_BLOB); $sth->bind_param(2, $subscribed, SQL_BOOLEAN); my $r = $sth->execute(); msg("database", "Created mailbox ", mbx_pretty($mailbox)); return $r; } # Get the index associated with a mailbox. sub db_get_mailbox_idx($) { my $mailbox = shift; state $sth = $DBH->prepare(q{SELECT idx,subscribed FROM mailboxes WHERE mailbox = ?}); $sth->bind_param(1, $mailbox, SQL_BLOB); $sth->execute(); my ($idx, $subscribed) = $sth->fetchrow_array(); die if defined $sth->fetch(); # safety check (we have a UNIQUE contstraint though) return wantarray ? ($idx, $subscribed) : $idx; } # Transform mailbox name from internal representation (with \0 as hierarchy delimiters # and without reference prefix) to a name understandable by the local/remote IMAP server. sub mbx_name($$) { my ($name, $mailbox) = @_; my $x = $name // "local"; # don't add reference if $name is undefined if (defined (my $d = $IMAP->{$x}->{delimiter})) { $mailbox =~ s/\x00/$d/g; } elsif (!exists $IMAP->{$x}->{delimiter} or index($mailbox,"\x00") >= 0) { die; # safety check } return defined $name ? ($CONF->{$name}->{"list-reference"} . $mailbox) : $mailbox; } sub mbx_pretty($) { return mbx_name(undef, $_[0]); } # Transform mailbox name from local/remote IMAP server to the internal representation # (with \0 as hierarchy delimiters and without reference prefix). Return undef if # the name doesn't start with the right reference. sub mbx_unname($$) { my ($name, $mailbox) = @_; return unless defined $mailbox; my $ref = $CONF->{$name}->{"list-reference"}; return unless rindex($mailbox, $ref, 0) == 0; # not for us $mailbox = substr($mailbox, length $ref); if (defined (my $d = $IMAP->{$name}->{delimiter})) { $mailbox =~ s/\Q$d\E/\x00/g; } elsif (!exists $IMAP->{$name}->{delimiter}) { die; # safety check } return $mailbox; } # Format a message with format controls for local/remote/database mailbox names. sub fmt($@) { my $msg = shift; $msg =~ s/%([lrds])/ $1 eq "l" ? mbx_name("local", shift) : $1 eq "r" ? mbx_name("remote", shift) : $1 eq "d" ? mbx_name(undef, shift) : $1 eq "s" ? shift : die /ge; return $msg; } # Return true if $mailbox exists on $name sub mbx_exists($$) { my ($name, $mailbox) = @_; my $attrs = $IMAP->{$name}->{mailboxes}->{$mailbox}; my ($ne, $ns) = (lc '\NonExistent', lc '\NoSelect'); return (defined $attrs and !grep {my $a = lc; $a eq $ne or $a eq $ns} @$attrs) ? 1 : 0; } # Return true if $mailbox is subscribed to on $name sub mbx_subscribed($$) { my ($name, $mailbox) = @_; my $attrs = $IMAP->{$name}->{mailboxes}->{$mailbox}; return (defined $attrs and grep {lc $_ eq lc '\Subscribed'} @$attrs) ? 1 : 0; } ############################################################################## # Process --delete command # if (defined $COMMAND and $COMMAND eq 'delete') { if (defined (my $d = $IMAP->{local}->{delimiter})) { s/\Q$d\E/\x00/g foreach @ARGV; } my @statements = map { $DBH->prepare("DELETE FROM $_ WHERE idx = ?") } # non-referenced tables first to avoid violating # FOREIGN KEY constraints qw/mapping local remote mailboxes/ if @ARGV and $CONFIG{target}->{database}; foreach my $mailbox (@ARGV) { fail(undef, "INBOX can't be deleted") if uc($mailbox) eq "INBOX"; # RFC 3501 sec. 6.3.4 my $idx = db_get_mailbox_idx($mailbox); # delete $mailbox on servers where $mailbox exists. note that # there is a race condition where the mailbox could have # appeared meanwhile foreach my $name (qw/local remote/) { my $mbx = mbx_name($name, $mailbox); $IMAP->{$name}->{client}->delete($mbx) if $CONFIG{target}->{$name} and mbx_exists($name, $mbx); } if (defined $idx and $CONFIG{target}->{database}) { foreach my $sth (@statements) { $sth->bind_param(1, $idx, SQL_INTEGER); $sth->execute(); } $DBH->commit(); msg("database", "Removed mailbox ", mbx_pretty($mailbox)); } } exit 0; } ############################################################################## # Process --rename command # elsif (defined $COMMAND and $COMMAND eq 'rename') { my ($from, $to) = @ARGV; if (defined (my $d = $IMAP->{local}->{delimiter})) { s/\Q$d\E/\x00/g foreach ($from, $to); } # get index of the original name my $idx = db_get_mailbox_idx($from); # ensure the target name doesn't already exist on the servers. there # is a race condition where the mailbox would be created before we # issue the RENAME command, then the server would reply with a # tagged NO response foreach my $name (qw/local remote/) { my $mbx = mbx_name($name, $to); next unless $CONFIG{target}->{$name} and mbx_exists($name, $mbx); fail($name, "Mailbox $mbx exists. Run `$NAME --target=$name --delete ", mbx_pretty($to), "` to delete."); } # ensure the target name doesn't already exist in the database my $to_pretty = mbx_pretty($to); fail("database", "Mailbox $to_pretty exists. Run `$NAME --target=database ", "--delete $to_pretty` to delete.") if $CONFIG{target}->{database} and defined db_get_mailbox_idx($to); # rename $from to $to on servers where $from if LISTed. again there is a # race condition, but if $to has been created meanwhile the server will # reply with a tagged NO response foreach my $name (qw/local remote/) { next unless $CONFIG{target}->{$name}; my ($from, $to) = ( mbx_name($name,$from), mbx_name($name, $to) ); # don't use mbx_exists() here, as \NonExistent names can be renamed # too (for instance if they have children) $IMAP->{$name}->{client}->rename($from, $to) if defined $IMAP->{$name}->{mailboxes}->{$from}; } # rename from to $to in the database if ($CONFIG{target}->{database}) { my $r = 0; if (defined $idx) { my $sth_rename_mailbox = $DBH->prepare(q{ UPDATE mailboxes SET mailbox = ? WHERE idx = ? }); $sth_rename_mailbox->bind_param(1, $to, SQL_BLOB); $sth_rename_mailbox->bind_param(2, $idx, SQL_INTEGER); $r += $sth_rename_mailbox->execute(); } # now rename the children as well my $prefix = $from."\x00"; my $sth_rename_children = $DBH->prepare(q{ UPDATE mailboxes SET mailbox = CAST(? || SUBSTR(mailbox,?) AS BLOB) WHERE SUBSTR(mailbox,1,?) = ? }); $sth_rename_children->bind_param(1, $to, SQL_BLOB); $sth_rename_children->bind_param(2, length($prefix), SQL_INTEGER); $sth_rename_children->bind_param(3, length($prefix), SQL_INTEGER); $sth_rename_children->bind_param(4, $prefix, SQL_BLOB); $r += $sth_rename_children->execute(); $DBH->commit(); msg("database", "Renamed mailbox ", mbx_pretty($from), " to ", mbx_pretty($to)) if $r > 0; } exit 0; } ############################################################################## # Synchronize mailbox and subscription lists sub sync_mailbox_list() { my (%mailboxes, @mailboxes); state $sth_subscribe = $DBH->prepare(q{ UPDATE mailboxes SET subscribed = ? WHERE idx = ? }); state $ignore_mailbox = do { my $re = $CONF->{_}->{"ignore-mailbox"}; defined $re ? qr/$re/ : undef }; foreach my $name (qw/local remote/) { foreach my $mbx (keys %{$IMAP->{$name}->{mailboxes}}) { # exclude names not starting with the given LIST reference; for instance # if "list-mailbox" specifies a name starting with a "breakout" character $mbx = mbx_unname($name, $mbx) // next; # exclude ignored mailboxes (taken from the default config as it doesn't # make sense to ignore mailboxes from one side but not the other next if !@ARGV and defined $ignore_mailbox and $mbx =~ $ignore_mailbox; $mailboxes{$mbx} = 1; } } foreach my $mailbox (keys %mailboxes) { my ($lMailbox, $rMailbox) = map {mbx_name($_, $mailbox)} qw/local remote/; my $lExists = mbx_exists("local", $lMailbox); my $rExists = mbx_exists("remote", $rMailbox); next unless $lExists or $rExists; push @mailboxes, $mailbox; my ($idx, $subscribed) = db_get_mailbox_idx($mailbox); if ($lExists and $rExists) { # $mailbox exists on both sides my $lSubscribed = mbx_subscribed("local", $lMailbox); my $rSubscribed = mbx_subscribed("remote", $rMailbox); if (defined $idx) { if ($lSubscribed xor $rSubscribed) { # mailbox is subscribed on only one server if ($subscribed) { # unsubscribe my ($imap, $mbx) = $lSubscribed ? ($lIMAP, $lMailbox) : ($rIMAP, $rMailbox); $imap->unsubscribe($mbx); } else { # subscribe my ($imap, $mbx) = $lSubscribed ? ($rIMAP, $rMailbox) : ($lIMAP, $lMailbox); $imap->subscribe($mbx); } # toggle subscribtion in the database $subscribed = $subscribed ? 0 : 1; $sth_subscribe->bind_param(1, $subscribed, SQL_BOOLEAN); $sth_subscribe->bind_param(2, $idx, SQL_INTEGER); $sth_subscribe->execute(); $DBH->commit(); } # $mailbox is either subscribed on both servers, or unsubscribed on both elsif ($lSubscribed xor $subscribed) { # $lSubscribed == $rSubscribed but database needs updating $sth_subscribe->bind_param(1, $lSubscribed, SQL_BOOLEAN); $sth_subscribe->bind_param(2, $idx, SQL_INTEGER); $sth_subscribe->execute(); $DBH->commit(); } } else { # add new mailbox; subscribe on both servers if $mailbox is subscribed on one of them my $subscribed = ($lSubscribed or $rSubscribed) ? 1 : 0; db_create_mailbox($mailbox, $subscribed); $IMAP->{local}->{client}->subscribe($lMailbox) if $subscribed and !$lSubscribed; $IMAP->{remote}->{client}->subscribe($rMailbox) if $subscribed and !$rSubscribed; $DBH->commit(); } } elsif ($lExists or $rExists) { # $mailbox is on one server only my $str = mbx_pretty($mailbox); fail("database", "Mailbox $str exists. Run `$NAME --target=database --delete $str` to delete.") if defined $idx; my ($name1, $name2, $mbx1, $mbx2) = $lExists ? ("local", "remote", $lMailbox, $rMailbox) : ("remote", "local", $rMailbox, $lMailbox); my $subscribed = mbx_subscribed($name1, $mbx1); db_create_mailbox($mailbox, $subscribed); $IMAP->{$name2}->{client}->create($mbx2, 1); $IMAP->{$name2}->{client}->subscribe($mbx2) if $subscribed; $DBH->commit(); } } return @mailboxes; } ($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/; my @MAILBOXES = sync_mailbox_list(); my $ATTRS = join ' ', qw/MODSEQ FLAGS INTERNALDATE BODY.PEEK[]/; ############################################################################# # Synchronize messages # Download some missing UIDs from $source; returns the new allocated UIDs sub download_missing($$$@) { my $idx = shift; my $mailbox = shift; my $source = shift; my @set = @_; my @uids; my $target = $source eq 'local' ? 'remote' : 'local'; my ($buff, $bufflen) = ([], 0); undef $buff if ($target eq 'local' ? $lIMAP : $rIMAP)->incapable('MULTIAPPEND'); ($source eq 'local' ? $lIMAP : $rIMAP)->fetch(compact_set(@set), "($ATTRS ENVELOPE)", sub($) { my $mail = shift; return unless exists $mail->{RFC822}; # not for us unless ($CONFIG{quiet}) { my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4]; $from = (defined $from and defined $from->[0]->[2] and defined $from->[0]->[3]) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; msg2($source => $mailbox, "UID $mail->{UID} from <$from> ($mail->{INTERNALDATE})"); } callback_new_message($idx, $mailbox, $source, $mail, \@uids, $buff, \$bufflen) }); push @uids, callback_new_message_flush($idx, $mailbox, $source, @$buff) if defined $buff and @$buff; return @uids; } # Solve a flag update conflict (by taking the union of the two flag lists). sub flag_conflict($$$$$) { my ($mailbox, $lUID, $lFlags, $rUID, $rFlags) = @_; my %flags = map {$_ => 1} (split(/ /, $lFlags), split(/ /, $rFlags)); my $flags = join ' ', sort(keys %flags); msg(undef, "WARNING: Conflicting flag update in ", mbx_pretty($mailbox), " for local UID $lUID ($lFlags) and remote UID $rUID ($rFlags).", " Setting both to the union ($flags)."); return $flags } # Delete a mapping ($idx, $lUID) from the database # WARN: Never commit before the messages have been EXPUNGEd on both sides! sub delete_mapping($$) { my ($idx, $lUID) = @_; state $sth = $DBH->prepare(q{ DELETE FROM mapping WHERE idx = ? and lUID = ? }); $sth->bind_param(1, $idx, SQL_INTEGER); $sth->bind_param(2, $lUID, SQL_INTEGER); my $r = $sth->execute(); die if $r > 1; # safety check (even if we have a UNIQUE constraint) msg('database', "WARNING: Can't delete (idx,lUID) = ($idx,$lUID)") if $r == 0; } # Create a sample (sequence numbers, UIDs) to use as Message Sequence # Match Data for the QRESYNC parameter to the SELECT command. # QRESYNC [RFC7162] doesn't force the server to remember the MODSEQs of # EXPUNGEd messages. By passing a sample of known sequence numbers/UIDs # we let the server know that the messages have been EXPUNGEd [RFC7162, # section 3.2.5.2]. # The UID set is the largest set of higest UIDs with at most 1024 UIDs, # of length (once compacted) at most 256. # The reason why we sample with the highest UIDs is that lowest UIDs are # less likely to be deleted. sub sample($$) { my ($count, $sth) = @_; return unless $count > 0; my ($n, $uids, $min, $max); $sth->execute(); # /!\ assume placeholders are bound already while (defined (my $row = $sth->fetchrow_arrayref())) { my $k = $row->[0]; if (!defined $min and !defined $max) { $n = 0; $min = $max = $k; } elsif ($k == $min - 1) { $min--; } else { $n += $max - $min + 1; $uids = ($min == $max ? $min : "$min:$max") .(defined $uids ? ','.$uids : ''); $min = $max = $k; if (length($uids) > 256) { $sth->finish(); # done with the statement last; } } } if (!defined $uids or length($uids) <= 256) { # exceed max size by at most 22 bytes ("$MIN:$MAX,") $n += $max - $min + 1; $uids = ($min == $max ? $min : "$min:$max") . (defined $uids ? ','.$uids : ''); } die unless $n <= $count; # impossible return ( ($count - $n + 1).':'.$count, $uids ); } # Issue a SELECT command with the given $mailbox. sub select_mbx($$) { my ($idx, $mailbox) = @_; # Count messages state $sth_count_messages = $DBH->prepare(q{ SELECT COUNT(*) FROM mapping WHERE idx = ? }); $sth_count_messages->bind_param(1, $idx, SQL_INTEGER); $sth_count_messages->execute(); my ($count) = $sth_count_messages->fetchrow_array(); $sth_count_messages->finish(); # List last 1024 messages UIDs state $sth_last_lUIDs = $DBH->prepare(q{ SELECT lUID FROM mapping WHERE idx = ? ORDER BY lUID DESC LIMIT 1024 }); state $sth_last_rUIDs = $DBH->prepare(q{ SELECT rUID FROM mapping WHERE idx = ? ORDER BY rUID DESC LIMIT 1024 }); $_->bind_param(1, $idx, SQL_INTEGER) foreach ($sth_last_lUIDs, $sth_last_rUIDs); $lIMAP->select(mbx_name(local => $mailbox), sample($count, $sth_last_lUIDs)); $rIMAP->select(mbx_name(remote => $mailbox), sample($count, $sth_last_rUIDs)); } # Check and repair synchronization of a mailbox between the two servers # (in a very crude way, by downloading all existing UID with their flags) sub repair($) { my $mailbox = shift; my $idx = db_get_mailbox_idx($mailbox) // return; # not in the database my $cache = db_get_cache_by_idx($idx) // return; # no cache # don't use select_mbx() as we don't need to sample here $lIMAP->select(mbx_name(local => $mailbox)); $rIMAP->select(mbx_name(remote => $mailbox)); # get all existing UID with their flags my ($lVanished, $lModified) = $lIMAP->pull_updates(1); my ($rVanished, $rModified) = $rIMAP->pull_updates(1); my (%lVanished, %rVanished); $lVanished{$_} = 1 foreach @$lVanished; $rVanished{$_} = 1 foreach @$rVanished; my (@lToRemove, %lToUpdate, @lMissing); my (@rToRemove, %rToUpdate, @rMissing); my @delete_mapping; # process each pair ($lUID,$rUID) found in the mapping table for the given index, # and compare with the result from the IMAP servers to detect anomalies state $sth_get_mappings = $DBH->prepare(q{ SELECT lUID,rUID FROM mapping WHERE idx = ? }); $sth_get_mappings->bind_param(1, $idx, SQL_INTEGER); $sth_get_mappings->execute(); while (defined (my $row = $sth_get_mappings->fetchrow_arrayref())) { my ($lUID, $rUID) = @$row; if (defined (my $l = $lModified->{$lUID}) and defined (my $r = $rModified->{$rUID})) { # both $lUID and $rUID are known; see sync_known_messages # for the sync algorithm my ($lModSeq, $lFlags) = @$l; my ($rModSeq, $rFlags) = @$r; if ($lFlags eq $rFlags) { # no conflict, whee } elsif ($lModSeq <= $cache->{lHIGHESTMODSEQ} and $rModSeq > $cache->{rHIGHESTMODSEQ}) { # set $lUID to $rFlags $lToUpdate{$rFlags} //= []; push @{$lToUpdate{$rFlags}}, $lUID; } elsif ($lModSeq > $cache->{lHIGHESTMODSEQ} and $rModSeq <= $cache->{rHIGHESTMODSEQ}) { # set $rUID to $lFlags $rToUpdate{$lFlags} //= []; push @{$rToUpdate{$lFlags}}, $rUID; } else { # conflict msg(undef, "WARNING: Missed flag update in ", mbx_pretty($mailbox), " for (lUID,rUID) = ($lUID,$rUID). Repairing.") if $lModSeq <= $cache->{lHIGHESTMODSEQ} and $rModSeq <= $cache->{rHIGHESTMODSEQ}; # set both $lUID and $rUID to the union of $lFlags and $rFlags my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags); $lToUpdate{$flags} //= []; push @{$lToUpdate{$flags}}, $lUID; $rToUpdate{$flags} //= []; push @{$rToUpdate{$flags}}, $rUID; } } elsif (!defined $lModified->{$lUID} and !defined $rModified->{$rUID}) { push @delete_mapping, $lUID; msg(undef, "WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from ", mbx_pretty($mailbox), ". Repairing.") unless $lVanished{$lUID} and $rVanished{$rUID}; } elsif (!defined $lModified->{$lUID}) { push @delete_mapping, $lUID; if ($lVanished{$lUID}) { push @rToRemove, $rUID; } else { msg2(local => $mailbox, "WARNING: UID $lUID disappeared. Redownloading remote UID $rUID."); push @rMissing, $rUID; } } elsif (!defined $rModified->{$rUID}) { push @delete_mapping, $lUID; if ($rVanished{$rUID}) { push @lToRemove, $lUID; } else { msg2(remote => $mailbox, "WARNING: UID $rUID disappeared. Redownloading local UID $lUID."); push @lMissing, $lUID; } } delete $lModified->{$lUID}; delete $lVanished{$lUID}; delete $rModified->{$rUID}; delete $rVanished{$rUID}; } # remove messages on the IMAP side; will increase HIGHESTMODSEQ $lIMAP->remove_message(@lToRemove) if @lToRemove; $rIMAP->remove_message(@rToRemove) if @rToRemove; # remove entries in the table delete_mapping($idx, $_) foreach @delete_mapping; $DBH->commit() if @delete_mapping; # push flag updates; will increase HIGHESTMODSEQ while (my ($lFlags,$lUIDs) = each %lToUpdate) { $lIMAP->push_flag_updates($lFlags, @$lUIDs); } while (my ($rFlags,$rUIDs) = each %rToUpdate) { $rIMAP->push_flag_updates($rFlags, @$rUIDs); } # Process UID found in IMAP but not in the mapping table. my @lDunno = keys %lVanished; my @rDunno = keys %rVanished; msg2(remote => $mailbox, "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) " .compact_set(@lDunno).". Ignoring.") if @lDunno; msg2(local => $mailbox, "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) " .compact_set(@rDunno).". Ignoring.") if @rDunno; foreach my $lUID (keys %$lModified) { msg2(remote => $mailbox, "WARNING: No match for modified local UID $lUID. Redownloading."); push @lMissing, $lUID; } foreach my $rUID (keys %$rModified) { msg2(local => $mailbox, "WARNING: No match for modified remote UID $rUID. Redownloading."); push @rMissing, $rUID; } # download missing UIDs; will increase UIDNEXT and HIGHESTMODSEQ my @rIgnore = download_missing($idx, $mailbox, 'local', @lMissing) if @lMissing; my @lIgnore = download_missing($idx, $mailbox, 'remote', @rMissing) if @rMissing; # download new messages; this will also update UIDNEXT and HIGHESTMODSEQ in the database sync_messages($idx, $mailbox, \@lIgnore, \@rIgnore); } # Sync known messages. Since pull_updates is the last method call on # $lIMAP and $rIMAP, it is safe to call get_cache on either object after # this function, in order to update the HIGHESTMODSEQ. # Return true if an update was detected, and false otherwise sub sync_known_messages($$) { my ($idx, $mailbox) = @_; my $update = 0; # Find local/remote UID from the mapping table. state $sth_get_local_uid = $DBH->prepare(q{ SELECT lUID FROM mapping WHERE idx = ? and rUID = ? }); state $sth_get_remote_uid = $DBH->prepare(q{ SELECT rUID FROM mapping WHERE idx = ? and lUID = ? }); # loop since processing might produce VANISHED or unsolicited FETCH responses while (1) { my ($lVanished, $lModified, $rVanished, $rModified); ($lVanished, $lModified) = $lIMAP->pull_updates(); ($rVanished, $rModified) = $rIMAP->pull_updates(); # repeat until we have nothing pending return $update unless %$lModified or %$rModified or @$lVanished or @$rVanished; $update = 1; # process VANISHED messages # /!\ this might modify the VANISHED or MODIFIED cache! if (@$lVanished or @$rVanished) { my %lVanished = map {$_ => 1} @$lVanished; my %rVanished = map {$_ => 1} @$rVanished; # For each vanished UID, get the corresponding one on the # other side (from the DB); consider it as to be removed if # it hasn't been removed already. my (@lToRemove, @rToRemove, @lDunno, @rDunno); foreach my $lUID (@$lVanished) { $sth_get_remote_uid->bind_param(1, $idx, SQL_INTEGER); $sth_get_remote_uid->bind_param(2, $lUID, SQL_INTEGER); $sth_get_remote_uid->execute(); my ($rUID) = $sth_get_remote_uid->fetchrow_array(); die if defined $sth_get_remote_uid->fetch(); # safety check if (!defined $rUID) { push @lDunno, $lUID; } elsif (!exists $rVanished{$rUID}) { push @rToRemove, $rUID; } } foreach my $rUID (@$rVanished) { $sth_get_local_uid->bind_param(1, $idx, SQL_INTEGER); $sth_get_local_uid->bind_param(2, $rUID, SQL_INTEGER); $sth_get_local_uid->execute(); my ($lUID) = $sth_get_local_uid->fetchrow_array(); die if defined $sth_get_local_uid->fetch(); # safety check if (!defined $lUID) { push @rDunno, $rUID; } elsif (!exists $lVanished{$lUID}) { push @lToRemove, $lUID; } } msg2(remote => $mailbox, "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) " .compact_set(@lDunno).". Ignoring.") if @lDunno; msg2(local => $mailbox, "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) " .compact_set(@rDunno).". Ignoring.") if @rDunno; $lIMAP->remove_message(@lToRemove) if @lToRemove; $rIMAP->remove_message(@rToRemove) if @rToRemove; # remove existing mappings foreach my $lUID (@$lVanished, @lToRemove) { delete_mapping($idx, $lUID); } } # process FLAG updates # /!\ this might modify the VANISHED or MODIFIED cache! if (%$lModified or %$rModified) { my (%lToUpdate, %rToUpdate); # Take flags updates on both sides, and get the # corresponding UIDs on the other side (from the DB). # If it wasn't modified there, make it such; if it was # modified with the same flags list, ignore that message; # otherwise there is a conflict, and take the union. # # Group by flags in order to limit the number of round # trips. while (my ($lUID,$lFlags) = each %$lModified) { $sth_get_remote_uid->bind_param(1, $idx, SQL_INTEGER); $sth_get_remote_uid->bind_param(2, $lUID, SQL_INTEGER); $sth_get_remote_uid->execute(); my ($rUID) = $sth_get_remote_uid->fetchrow_array(); die if defined $sth_get_remote_uid->fetch(); # safety check if (!defined $rUID) { msg2(remote => $mailbox, "WARNING: No match for modified local UID $lUID. Try '--repair'."); } elsif (defined (my $rFlags = $rModified->{$rUID})) { unless ($lFlags eq $rFlags) { my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags); $lToUpdate{$flags} //= []; push @{$lToUpdate{$flags}}, $lUID; $rToUpdate{$flags} //= []; push @{$rToUpdate{$flags}}, $rUID; } } else { $rToUpdate{$lFlags} //= []; push @{$rToUpdate{$lFlags}}, $rUID; } } while (my ($rUID,$rFlags) = each %$rModified) { $sth_get_local_uid->bind_param(1, $idx, SQL_INTEGER); $sth_get_local_uid->bind_param(2, $rUID, SQL_INTEGER); $sth_get_local_uid->execute(); my ($lUID) = $sth_get_local_uid->fetchrow_array(); die if defined $sth_get_local_uid->fetch(); # safety check if (!defined $lUID) { msg2(local => $mailbox, "WARNING: No match for modified remote UID $rUID. Try '--repair'."); } elsif (!exists $lModified->{$lUID}) { # conflicts are taken care of above $lToUpdate{$rFlags} //= []; push @{$lToUpdate{$rFlags}}, $lUID; } } while (my ($lFlags,$lUIDs) = each %lToUpdate) { $lIMAP->push_flag_updates($lFlags, @$lUIDs); } while (my ($rFlags,$rUIDs) = each %rToUpdate) { $rIMAP->push_flag_updates($rFlags, @$rUIDs); } } } } # The callback to use when FETCHing new messages from $name to add it to # the other one. # If defined, the array reference $UIDs will be fed with the newly added # UIDs. # If defined, $buff contains the list of messages to be appended with # MULTIAPPEND. In that case callback_new_message_flush should be called # after the FETCH. sub callback_new_message($$$$;$$$) { my ($idx, $mailbox, $name, $mail, $UIDs, $buff, $bufflen) = @_; return unless exists $mail->{RFC822}; # not for us my $length = length(${$mail->{RFC822}} // ""); if ($length == 0) { # the RFC822 attribute can be NIL or empty (it's an nstring), however # NIL can't be used in APPEND commands, and RFC 3502 sec. 6.3.11 # explicitly forbids zero-length messages, so we ignore these here msg2($name => $mailbox, "WARNING: Ignoring new 0-length message (UID $mail->{UID})"); return; } my @UIDs; unless (defined $buff) { @UIDs = callback_new_message_flush($idx, $mailbox, $name, $mail); } else { # use MULTIAPPEND (RFC 3502) # proceed by batches of 128/1MiB to save roundtrips without blowing up the memory if ($#$buff >= 127 or (@$buff and $$bufflen + $length > 1048576)) { @UIDs = callback_new_message_flush($idx, $mailbox, $name, @$buff); @$buff = (); $$bufflen = 0; } push @$buff, $mail; $$bufflen += $length; } push @$UIDs, @UIDs if defined $UIDs; } # Add the given @messages (multiple messages are only allowed for # MULTIAPPEND-capable servers) from $name to the other server. # Returns the list of newly allocated UIDs. sub callback_new_message_flush($$$@) { my ($idx, $mailbox, $name, @messages) = @_; my $target = $name eq "local" ? "remote" : "local"; my $imap = $target eq "local" ? $lIMAP : $rIMAP; # target client my @sUID = map {$_->{UID}} @messages; my @tUID = $imap->append(mbx_name($target, $mailbox), @messages); die unless $#sUID == $#tUID; # sanity check state $sth = $DBH->prepare(q{ INSERT INTO mapping (idx,lUID,rUID) VALUES (?,?,?) }); my ($lUIDs, $rUIDs) = $name eq 'local' ? (\@sUID,\@tUID) : (\@tUID,\@sUID); for (my $k=0; $k<=$#messages; $k++) { logger(undef, "Adding mapping (lUID,rUID) = ($lUIDs->[$k],$rUIDs->[$k]) for ", mbx_pretty($mailbox)) if $CONFIG{debug}; $sth->bind_param(1, $idx, SQL_INTEGER); $sth->bind_param(2, $lUIDs->[$k], SQL_INTEGER); $sth->bind_param(3, $rUIDs->[$k], SQL_INTEGER); $sth->execute(); } $DBH->commit(); # commit only once per batch return @tUID; } # Sync both known and new messages # If the array references $lIgnore and $rIgnore are not empty, skip # the given UIDs. sub sync_messages($$;$$) { my ($idx, $mailbox, $lIgnore, $rIgnore) = @_; my %ignore = (local => ($lIgnore // []), remote => ($rIgnore // [])); my $loop; do { # get new messages from $source (except @{$ignore{$source}}) and APPEND them to $target foreach my $source (qw/remote local/) { # pull remote mails first my $target = $source eq 'remote' ? 'local' : 'remote'; my $buff = [] unless ($target eq 'local' ? $lIMAP : $rIMAP)->incapable('MULTIAPPEND'); my $bufflen = 0; my @tUIDs; ($source eq 'remote' ? $rIMAP : $lIMAP)->pull_new_messages($ATTRS, sub($) { callback_new_message($idx, $mailbox, $source, shift, \@tUIDs, $buff, \$bufflen) }, @{$ignore{$source}}); push @tUIDs, callback_new_message_flush($idx, $mailbox, $source, @$buff) if defined $buff and @$buff; push @{$ignore{$target}}, @tUIDs; $loop = @tUIDs ? 1 : 0; } # since $source modifies $target's UIDNEXT upon new mails, we # need to check again the first $source (remote) whenever the # last one (local) added new messages to it } while ($loop); # both local and remote UIDNEXT are now up to date; proceed with # pending flag updates and vanished messages sync_known_messages($idx, $mailbox); # don't store the new UIDNEXTs before to avoid downloading these # mails again in the event of a crash state $sth_update_local = $DBH->prepare(q{ UPDATE local SET UIDNEXT = ?, HIGHESTMODSEQ = ? WHERE idx = ? }); state $sth_update_remote = $DBH->prepare(q{ UPDATE remote SET UIDNEXT = ?, HIGHESTMODSEQ = ? WHERE idx = ? }); my ($lUIDNEXT, $lHIGHESTMODSEQ) = $lIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/); $sth_update_local->bind_param(1, $lUIDNEXT, SQL_INTEGER); $sth_update_local->bind_param(2, sprintf("%lld", $lHIGHESTMODSEQ), SQL_BIGINT); $sth_update_local->bind_param(3, $idx, SQL_INTEGER); $sth_update_local->execute(); my ($rUIDNEXT, $rHIGHESTMODSEQ) = $rIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/); $sth_update_remote->bind_param(1, $rUIDNEXT, SQL_INTEGER); $sth_update_remote->bind_param(2, sprintf("%lld", $rHIGHESTMODSEQ), SQL_BIGINT); $sth_update_remote->bind_param(3, $idx, SQL_INTEGER); $sth_update_remote->execute(); $DBH->commit(); } ############################################################################# # Resume interrupted mailbox syncs (before initializing the cache). # my ($MAILBOX, $IDX); # current mailbox, and its index in our database sub db_get_cache_by_idx($) { my $idx = shift; state $sth = $DBH->prepare(q{ SELECT l.UIDVALIDITY AS lUIDVALIDITY, l.UIDNEXT AS lUIDNEXT, l.HIGHESTMODSEQ AS lHIGHESTMODSEQ, r.UIDVALIDITY AS rUIDVALIDITY, r.UIDNEXT AS rUIDNEXT, r.HIGHESTMODSEQ AS rHIGHESTMODSEQ FROM local l JOIN remote r ON l.idx = r.idx WHERE l.idx = ? }); $sth->bind_param(1, $idx, SQL_INTEGER); $sth->execute(); my $cache = $sth->fetchrow_hashref(); die if defined $sth->fetch(); # safety check if (defined $cache) { $cache->{$_} = sprintf("%llu", $cache->{$_}) foreach qw/lHIGHESTMODSEQ rHIGHESTMODSEQ/; } return $cache; } { # Get the list of interrupted mailbox syncs. my $sth_list = $DBH->prepare(q{ SELECT mbx.idx, mailbox FROM mailboxes mbx JOIN local l ON mbx.idx = l.idx JOIN remote r ON mbx.idx = r.idx JOIN mapping ON mbx.idx = mapping.idx WHERE (lUID >= l.UIDNEXT OR rUID >= r.UIDNEXT) GROUP BY mbx.idx }); # For an interrupted mailbox sync, get the pairs (lUID,rUID) that have # already been downloaded. my $sth_get_by_idx = $DBH->prepare(q{ SELECT lUID, rUID FROM mapping m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx WHERE (lUID >= l.UIDNEXT OR rUID >= r.UIDNEXT) AND m.idx = ? }); $sth_list->execute(); while (defined (my $row = $sth_list->fetchrow_arrayref())) { next unless grep { $_ eq $row->[1] } @MAILBOXES; # skip ignored mailboxes ($IDX, $MAILBOX) = @$row; msg(undef, "Resuming interrupted sync for ", mbx_pretty($MAILBOX)); my $cache = db_get_cache_by_idx($IDX) // die; # safety check my ($lMailbox, $rMailbox) = map {mbx_name($_, $MAILBOX)} qw/local remote/; my %lUIDs; $sth_get_by_idx->bind_param(1, $IDX, SQL_INTEGER); $sth_get_by_idx->execute(); while (defined (my $row = $sth_get_by_idx->fetchrow_arrayref())) { $lUIDs{$row->[0]} = $row->[1]; # pair ($lUID, $rUID) } die unless %lUIDs; # sanity check $lIMAP->select($lMailbox); $rIMAP->select($rMailbox); # FETCH all messages with their FLAGS to detect messages that have # vanished meanwhile, or for which there was a flag update. my (%lList, %rList); # The lists of existing local and remote UIDs my $attrs = "(MODSEQ FLAGS)"; $lIMAP->fetch(compact_set(keys %lUIDs), $attrs, sub($){ $lList{shift->{UID}} = 1 }); $rIMAP->fetch(compact_set(values %lUIDs), $attrs, sub($){ $rList{shift->{UID}} = 1 }); my (@lToRemove, @rToRemove); while (my ($lUID,$rUID) = each %lUIDs) { next if $lList{$lUID} and $rList{$rUID}; # exists on both push @lToRemove, $lUID if $lList{$lUID}; push @rToRemove, $rUID if $rList{$rUID}; delete_mapping($IDX, $lUID); } $lIMAP->remove_message(@lToRemove) if @lToRemove; $rIMAP->remove_message(@rToRemove) if @rToRemove; $DBH->commit() if @lToRemove or @rToRemove; # /!\ commit *after* remove_message! # ignore deleted messages delete @lList{@lToRemove}; delete @rList{@rToRemove}; # Resume the sync, but skip messages that have already been # downloaded. Flag updates will be processed automatically since # the _MODIFIED internal cache has been initialized with all our # UIDs. (Since there is no reliable HIGHESTMODSEQ, any flag # difference is treated as a conflict.) $lIMAP->set_cache($lMailbox, UIDVALIDITY => $cache->{lUIDVALIDITY}, UIDNEXT => $cache->{lUIDNEXT} ); $rIMAP->set_cache($rMailbox, UIDVALIDITY => $cache->{rUIDVALIDITY}, UIDNEXT => $cache->{rUIDNEXT} ); sync_messages($IDX, $MAILBOX, [keys %lList], [keys %rList]); } } ############################################################################# # Initialize $lIMAP and $rIMAP states to detect mailbox dirtyness. # my %KNOWN_INDEXES; { # Get all cached states from the database. my $sth = $DBH->prepare(q{ SELECT mailbox, m.idx AS idx, l.UIDVALIDITY AS lUIDVALIDITY, l.UIDNEXT AS lUIDNEXT, l.HIGHESTMODSEQ AS lHIGHESTMODSEQ, r.UIDVALIDITY AS rUIDVALIDITY, r.UIDNEXT AS rUIDNEXT, r.HIGHESTMODSEQ AS rHIGHESTMODSEQ FROM mailboxes m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx }); $sth->execute(); while (defined (my $row = $sth->fetchrow_hashref())) { next unless grep {$row->{mailbox} eq $_} @MAILBOXES; $lIMAP->set_cache(mbx_name(local => $row->{mailbox}), UIDVALIDITY => $row->{lUIDVALIDITY}, UIDNEXT => $row->{lUIDNEXT}, HIGHESTMODSEQ => sprintf("%llu", $row->{lHIGHESTMODSEQ}) ); $rIMAP->set_cache(mbx_name(remote => $row->{mailbox}), UIDVALIDITY => $row->{rUIDVALIDITY}, UIDNEXT => $row->{rUIDNEXT}, HIGHESTMODSEQ => sprintf("%llu", $row->{rHIGHESTMODSEQ}) ); $KNOWN_INDEXES{$row->{idx}} = 1; } } if (defined $COMMAND and $COMMAND eq 'repair') { repair($_) foreach @MAILBOXES; exit 0; } if ($CONFIG{notify}) { # Be notified of new messages with EXISTS/RECENT responses, but don't # receive unsolicited FETCH responses with a RFC822/BODY[]. It costs us an # extra roundtrip, but we need to sync FLAG updates and VANISHED responses # in batch mode, update the HIGHESTMODSEQ, and *then* issue an explicit UID # FETCH command to get new message, and process each FETCH response with a # RFC822/BODY[] attribute as they arrive. foreach my $name (qw/local remote/) { my $mailboxes = join(' ', map {Net::IMAP::InterIMAP::quote(mbx_name($name, $_))} @MAILBOXES); my %mailboxes = map { $_ => [qw/MessageNew MessageExpunge FlagChange/] } ( "MAILBOXES ($mailboxes)", 'SELECTED' ); my %personal = ( personal => [qw/MailboxName SubscriptionChange/] ); my $imap = $name eq "local" ? $lIMAP : $rIMAP; # require STATUS responses for our @MAILBOXES only $imap->notify('SET STATUS', %mailboxes); $imap->notify('SET', %mailboxes, %personal); } } sub loop() { state $sth_insert_local = $DBH->prepare(q{ INSERT INTO local (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,0,0) }); state $sth_insert_remote = $DBH->prepare(q{ INSERT INTO remote (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,0,0) }); state $sth_update_local_highestmodseq = $DBH->prepare(q{ UPDATE local SET HIGHESTMODSEQ = ? WHERE idx = ? }); state $sth_update_remote_highestmodseq = $DBH->prepare(q{ UPDATE remote SET HIGHESTMODSEQ = ? WHERE idx = ? }); while(@MAILBOXES) { if (defined $MAILBOX and ($lIMAP->is_dirty(mbx_name(local => $MAILBOX)) or $rIMAP->is_dirty(mbx_name(remote => $MAILBOX)))) { # $MAILBOX is dirty on either the local or remote mailbox sync_messages($IDX, $MAILBOX); } else { $MAILBOX = mbx_unname(local => $lIMAP->next_dirty_mailbox(map {mbx_name(local => $_)} @MAILBOXES)) // mbx_unname(remote => $rIMAP->next_dirty_mailbox(map {mbx_name(remote => $_)} @MAILBOXES)) // last; $IDX = db_get_mailbox_idx($MAILBOX) // die; # safety check select_mbx($IDX, $MAILBOX); if (!$KNOWN_INDEXES{$IDX}) { my $lUIDVALIDITY = $lIMAP->uidvalidity(mbx_name(local => $MAILBOX)); $sth_insert_local->bind_param(1, $IDX, SQL_INTEGER); $sth_insert_local->bind_param(2, $lUIDVALIDITY, SQL_INTEGER); $sth_insert_local->execute(); my $rUIDVALIDITY = $rIMAP->uidvalidity(mbx_name(remote => $MAILBOX)); $sth_insert_remote->bind_param(1, $IDX, SQL_INTEGER); $sth_insert_remote->bind_param(2, $rUIDVALIDITY, SQL_INTEGER); $sth_insert_remote->execute(); # no need to commit before the first mapping (lUID,rUID) $KNOWN_INDEXES{$IDX} = 1; } elsif (sync_known_messages($IDX, $MAILBOX)) { # sync updates to known messages before fetching new messages # get_cache is safe after pull_update my $lHIGHESTMODSEQ = sprintf "%lld", $lIMAP->get_cache(qw/HIGHESTMODSEQ/); $sth_update_local_highestmodseq->bind_param(1, $lHIGHESTMODSEQ, SQL_BIGINT); $sth_update_local_highestmodseq->bind_param(2, $IDX, SQL_INTEGER); $sth_update_local_highestmodseq->execute(); my $rHIGHESTMODSEQ = sprintf "%lld", $rIMAP->get_cache(qw/HIGHESTMODSEQ/); $sth_update_remote_highestmodseq->bind_param(1, $rHIGHESTMODSEQ, SQL_BIGINT); $sth_update_remote_highestmodseq->bind_param(2, $IDX, SQL_INTEGER); $sth_update_remote_highestmodseq->execute(); $DBH->commit(); } sync_messages($IDX, $MAILBOX); } } } sub notify(@) { # TODO: interpret LIST responses to detect mailbox # creation/deletion/subcription/unsubscription # mailbox creation # * LIST () "/" test # mailbox subscribtion # * LIST (\Subscribed) "/" test # mailbox unsubscribtion # * LIST () "/" test # mailbox renaming # * LIST () "/" test2 ("OLDNAME" (test)) # mailbox deletion # * LIST (\NonExistent) "/" test2 unless (Net::IMAP::InterIMAP::slurp(\@_, $CONFIG{watch}, \&Net::IMAP::InterIMAP::is_dirty)) { $_->noop() foreach @_; } } unless (defined $CONFIG{watch}) { loop(); exit 0; } while (1) { loop(); if ($CONFIG{notify}) { notify($lIMAP, $rIMAP); } else { # we need to issue a NOOP command or go back to AUTH state since the # LIST command may not report the correct HIGHESTMODSEQ value for # the mailbox currently selected # RFC3501: "The STATUS command MUST NOT be used as a "check for # new messages in the selected mailbox" operation" if (defined $MAILBOX) { # Prefer UNSELECT over NOOP commands as it requires a single command per cycle if ($lIMAP->incapable('UNSELECT') or $rIMAP->incapable('UNSELECT')) { $_->noop() foreach ($lIMAP, $rIMAP); } else { $_->unselect() foreach ($lIMAP, $rIMAP); undef $MAILBOX; } } sleep $CONFIG{watch}; # refresh the mailbox list and status list_mailboxes($_) for qw/local remote/; @MAILBOXES = sync_mailbox_list(); } } END { cleanup(); } interimap-0.5.8/interimap.sample000066400000000000000000000011421500320172000166730ustar00rootroot00000000000000#database = imap.example.net.db # only consider subscribed mailboxes list-select-opts = SUBSCRIBED #list-mailbox = "*" # ignore the mailbox named 'virtual' and its descendants ignore-mailbox = ^virtual(?:\x00|$) [local] type = tunnel command = doveadm exec imap null-stderr = YES [remote] #type = imaps host = imap.example.net #port = 993 #proxy = socks5h://localhost:9050 username = guilhem password = xxxxxxxxxxxxxxxx #compress = YES # SSL options #SSL_verify = YES #SSL_protocol_min = TLSv1.2 #SSL_fingerprint = sha256$29111aea5d5be7e448bdc5c6e8a9d03bc9221c53c09b1cfbe6f953221e24dda0 # vim:ft=dosini interimap-0.5.8/interimap.service000066400000000000000000000005451500320172000170600ustar00rootroot00000000000000[Unit] Description=Fast bidirectional synchronization for QRESYNC-capable IMAP servers Documentation=man:interimap(1) Documentation=https://guilhem.org/interimap/interimap.1.html Wants=network-online.target After=network-online.target [Service] ExecStart=@bindir@/interimap --watch=60 RestartSec=10min Restart=on-failure [Install] WantedBy=default.target interimap-0.5.8/interimap@.service000066400000000000000000000006301500320172000171530ustar00rootroot00000000000000[Unit] Description=Fast bidirectional synchronization for QRESYNC-capable IMAP servers (instance %i) Documentation=man:interimap(1) Documentation=https://guilhem.org/interimap/interimap.1.html PartOf=interimap.service Wants=network-online.target After=network-online.target [Service] ExecStart=@bindir@/interimap --config=%i --watch=60 RestartSec=10min Restart=on-failure [Install] WantedBy=default.target interimap-0.5.8/lib/000077500000000000000000000000001500320172000142505ustar00rootroot00000000000000interimap-0.5.8/lib/Net/000077500000000000000000000000001500320172000147765ustar00rootroot00000000000000interimap-0.5.8/lib/Net/IMAP/000077500000000000000000000000001500320172000155245ustar00rootroot00000000000000interimap-0.5.8/lib/Net/IMAP/InterIMAP.pm000066400000000000000000003063201500320172000176160ustar00rootroot00000000000000#---------------------------------------------------------------------- # A minimal IMAP4 client for QRESYNC-capable servers # Copyright © 2015-2022 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . #---------------------------------------------------------------------- package Net::IMAP::InterIMAP v0.5.8; use v5.20.0; use warnings; use strict; use Compress::Raw::Zlib qw/Z_OK Z_STREAM_END Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/; use Config::Tiny (); use Errno qw/EEXIST EINTR/; use Net::SSLeay 1.86_06 (); use List::Util qw/all first/; use POSIX ':signal_h'; use Socket qw/SOCK_STREAM SOCK_RAW SOCK_CLOEXEC IPPROTO_TCP SHUT_RDWR AF_UNIX AF_INET AF_INET6 PF_UNSPEC :addrinfo/; use Exporter 'import'; BEGIN { Net::SSLeay::load_error_strings(); Net::SSLeay::SSLeay_add_ssl_algorithms(); Net::SSLeay::randomize(); our @EXPORT_OK = qw/xdg_basedir read_config compact_set slurp is_dirty has_new_mails/; } # Regexes for RFC 3501's 'ATOM-CHAR', 'ASTRING-CHAR', 'list-char' and 'TEXT-CHAR'. my $RE_ATOM_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]/; my $RE_ASTRING_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5D-\x7A\x7C-\x7E]/; my $RE_LIST_CHAR = qr/[\x21\x23-\x27\x2A\x2B-\x5B\x5D-\x7A\x7C-\x7E]/; my $RE_TEXT_CHAR = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/; my $RE_SSL_PROTO = qr/(?:SSLv[23]|TLSv1|TLSv1\.[0-3])/; # Map each option to a regexp validating its values. my %OPTIONS = ( host => qr/\A(\P{Control}+)\z/, port => qr/\A(\P{Control}+)\z/, proxy => qr/\A(\P{Control}+)\z/, type => qr/\A(imaps?|tunnel)\z/, STARTTLS => qr/\A(YES|NO)\z/i, username => qr/\A([\x01-\x7F]+)\z/, password => qr/\A([\x01-\x7F]+)\z/, auth => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/, command => qr/\A(\P{Control}+)\z/, 'null-stderr' => qr/\A(YES|NO)\z/i, compress => qr/\A(YES|NO)\z/i, SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/, # TODO deprecated, remove in 0.6 SSL_protocol_min => qr/\A(\P{Control}+)\z/, SSL_protocol_max => qr/\A(\P{Control}+)\z/, SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+(?: (?:[A-Za-z0-9]+\$)?\p{AHex}+)*)\z/, SSL_cipherlist => qr/\A(\P{Control}+)\z/, SSL_ciphersuites => qr/\A(\P{Control}*)\z/, # "an empty list is permissible" SSL_hostname => qr/\A(\P{Control}*)\z/, SSL_verify => qr/\A(YES|NO)\z/i, SSL_CApath => qr/\A(\P{Control}+)\z/, SSL_CAfile => qr/\A(\P{Control}+)\z/, ); # Use the same buffer size as Net::SSLeay::read(), to ensure there is # never any pending data left in the current TLS record my $BUFSIZE = 32768; my $CRLF = "\x0D\x0A"; ############################################################################# # Utilities # xdg_basedir($xdg_variable, $default, $subdir, $path) # Return $path if $path is absolute. Otherwise, return # "$ENV{$xdg_variable}/$subdir/$path" (resp. "~/$default/$subdir/path" # if the "$xdg_variable" environment variable is not set). # An error is raised if "$ENV{$xdg_variable}" (resp. "~/$default") is # not an existing absolute directory. # If "$ENV{$xdg_variable}/$subdir" doesn't exist, it is created with # mode 0700. sub xdg_basedir($$$$) { my ($xdg_variable, $default, $subdir, $path) = @_; $path =~ /\A(\p{Print}+)\z/ or die "Insecure $path"; $path = $1; return $path if $path =~ /\A\//; my $basedir = $ENV{$xdg_variable}; $basedir = ($ENV{HOME} // "") ."/". $default unless defined $basedir; die "No such directory: ", $basedir unless -d $basedir; $basedir .= "/".$subdir; $basedir =~ /\A(\/\p{Print}+)\z/ or die "Insecure $basedir"; $basedir = $1; unless (mkdir ($basedir, 0700)) { die "Couldn't create $basedir: $!\n" unless $! == EEXIST; } return $basedir ."/". $path; } # read_config($conffile, $sections, %opts) # Read $conffile's default section, then each section in the array # reference $section (which takes precedence). %opts extends %OPTIONS # and maps each option to a regexp validating its values. sub read_config($$%) { my $conffile = shift; my $sections = shift; my %opts = (%OPTIONS, @_); die "No such config file $conffile\n" unless defined $conffile and -f $conffile and -r $conffile; my $h = Config::Tiny::->read($conffile); my %configs; foreach my $section (@$sections) { my $conf = defined $h->{_} ? { %{$h->{_}} } : {}; # default section $configs{$section} = $conf; if ($section ne '_') { die "No such section $section\n" unless defined $h->{$section}; $conf->{$_} = $h->{$section}->{$_} foreach keys %{$h->{$section}}; } # default values $conf->{type} //= 'imaps'; $conf->{host} //= 'localhost'; $conf->{port} //= $conf->{type} eq 'imaps' ? 993 : $conf->{type} eq 'imap' ? 143 : undef; $conf->{auth} //= 'PLAIN LOGIN'; $conf->{STARTTLS} //= 'YES'; # untaint and validate the config foreach my $k (keys %$conf) { die "Invalid option $k\n" unless defined $opts{$k}; next unless defined $conf->{$k}; die "Invalid option $k = $conf->{$k}\n" unless $conf->{$k} =~ $opts{$k}; $conf->{$k} = $opts{$k} ne qr/\A(YES|NO)\z/i ? $1 : uc $1 eq 'YES' ? 1 : 0; } } return \%configs; } # compact_set(@set) # compact_list(@set) # Compact the UID or sequence number set @set, which must be # non-empty and may not contain '*'. # compact_set sorts the input UID list and removes duplicates, while # compact_list doesn't. sub compact_set(@) { my @set = sort {$a <=> $b} @_; my $min = my $max = shift @set // die 'Empty range'; my $set; while (@set) { my $k = shift @set; if ($k < $max) { die "Non-sorted range: $k < $max"; # sanity check } elsif ($k == $max) { # skip duplicates } elsif ($k == $max + 1) { $max++; } else { $set .= ',' if defined $set; $set .= $min == $max ? $min : "$min:$max"; $min = $max = $k; } } $set .= ',' if defined $set; $set .= $min == $max ? $min : "$min:$max"; return $set; } sub compact_list(@) { my $min = my $max = shift // die 'Empty range'; my ($set, $dir); while (@_) { my $k = shift; $dir //= $k < $max ? -1 : 1; if ($k != $max and $k == $max + $dir) { $max += $dir; } else { $set .= ',' if defined $set; $set .= $min == $max ? $min : "$min:$max"; $min = $max = $k; undef $dir; } } $set .= ',' if defined $set; $set .= $min == $max ? $min : "$min:$max"; return $set; } # with_set($set, $cmd) # Split long commands over multiple subsets to avoid exceeding the server limit sub with_set($&) { my ($set, $cmd) = @_; my $max_length = 4096; for (my $length = length($set); $length > $max_length;) { my $l = rindex($set, ',', $max_length); die unless $l > 0; # sanity check $cmd->(substr($set, 0, $l)); $set = substr($set, ++$l); $length -= $l; } return $cmd->($set); } # in_set($x, $set) # Return true if the UID or sequence number $x belongs to the set $set. # /!\ The highest number in the mailbox, "*" should not appear by # itself (other than in a range). sub in_set($$) { my ($x, $set) = @_; foreach my $r (split /,/, $set) { if ($r =~ /\A([0-9]+)\z/) { return 1 if $x == $1; } elsif ($r eq '*' or $r eq '*:*') { warn "Assuming $x belongs to set $set! (Dunno what \"*\" means.)"; return 1; } elsif ($r =~ /\A([0-9]+):\*\z/ or $r =~ /\A\*:([0-9]+)\z/) { return 1 if $1 <= $x; } elsif ($r =~ /\A([0-9]+):([0-9]+)\z/) { my ($min,$max) = $1 < $2 ? ($1,$2) : ($2,$1); return 1 if $min <= $x and $x <= $max; } } return 0; } # quote($str) # Quote the given string if needed, or make it a (synchronizing) # literal. The literals will later be made non-synchronizing if the # server is LITERAL+-capable (RFC 2088). sub quote($) { my $str = shift; if ($str =~ qr/\A$RE_ASTRING_CHAR+\z/) { return $str; } elsif ($str =~ qr/\A$RE_TEXT_CHAR*\z/) { $str =~ s/([\x22\x5C])/\\$1/g; return "\"$str\""; } else { # we'll later replace the non-synchronizing literal with a # synchronizing one if need be return "{".length($str)."+}$CRLF".$str; } } ############################################################################# # Public interface # /!\ While this module can be used with non QRESYNC-capable (or non # QRESYNC-enabled) servers, there is no internal cache mapping sequence # numbers to UIDs, so EXPUNGE responses are ignored. # The IMAP authentication ('OK'/'PREAUTH'), bye ('BYE') or status # ('OK'/'NO'/'BAD') condition for the last command issued. our $IMAP_cond; # The response text for the last command issued (prefixed with the status # condition but without the tag). our $IMAP_text; # Create a new Net::IMAP::InterIMAP object. Connect to the server, # upgrade to a secure connection (STARTTLS), LOGIN/AUTHENTICATE if needed, and # update the CAPABILITY list. # In addition to the %OPTIONS above, valid parameters include: # # - 'debug': Enable debug messages. # # - 'enable': An extension or array reference of extensions to ENABLE # (RFC 5161) after entering AUTH state. Croak if the server did not # advertise "ENABLE" in its CAPABILITY list or does not reply with # an untagged ENABLED response with all the given extensions. # # - 'name': An optional instance name to include in log messages. # # - 'logger-fd': An optional filehandle to use for debug output # (default: STDERR). # # - 'keepalive': Whether to enable sending of keep-alive messages. # (type=imap or type=imaps). # sub new($%) { my $class = shift; my $self = { @_ }; bless $self, $class; require 'Time/HiRes.pm' if defined $self->{'logger-fd'}; # the IMAP state: one of 'UNAUTH', 'AUTH', 'SELECTED' or 'LOGOUT' # (cf RFC 3501 section 3) $self->{_STATE} = ''; # in/out buffer counts and output stream $self->{_INCOUNT} = $self->{_INRAWCOUNT} = 0; $self->{_OUTCOUNT} = $self->{_OUTRAWCOUNT} = 0; $self->{_OUTBUF} = $self->{_INBUF} = undef; $self->{_LITPLUS} = ''; if ($self->{type} eq 'tunnel') { my $command = $self->{command} // $self->fail("Missing tunnel command"); socketpair($self->{S}, my $s, AF_UNIX, SOCK_STREAM|SOCK_CLOEXEC, PF_UNSPEC) or $self->panic("socketpair: $!"); my $pid = fork // $self->panic("fork: $!"); unless ($pid) { # children close($self->{S}) or $self->panic("close: $!"); open STDIN, '<&', $s or $self->panic("dup: $!"); open STDOUT, '>&', $s or $self->panic("dup: $!"); my $stderr2; if (($self->{'null-stderr'} // 0) and !($self->{debug} // 0)) { open $stderr2, '>&', *STDERR; open STDERR, '>', '/dev/null' or $self->panic("open(/dev/null): $!"); } my $sigset = POSIX::SigSet::->new(SIGINT); my $oldsigset = POSIX::SigSet::->new(); sigprocmask(SIG_BLOCK, $sigset, $oldsigset) // $self->panic("sigprocmask: $!"); unless (exec $command) { my $err = $!; if (defined $stderr2) { close STDERR; open STDERR, '>&', $stderr2; } $self->panic("exec: $err"); } } # parent close($s) or $self->panic("close: $!"); } else { foreach (qw/host port/) { $self->fail("Missing option $_") unless defined $self->{$_}; } $self->{S} = defined $self->{proxy} ? $self->_proxify(@$self{qw/proxy host port/}) : $self->_tcp_connect(@$self{qw/host port/}); if (defined $self->{keepalive}) { setsockopt($self->{S}, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1) or $self->fail("setsockopt SO_KEEPALIVE: $!"); setsockopt($self->{S}, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60) or $self->fail("setsockopt TCP_KEEPIDLE: $!"); } } binmode($self->{S}) // $self->panic("binmode: $!"); $self->_start_ssl($self->{S}) if $self->{type} eq 'imaps'; # command counter $self->{_TAG} = 0; # internal cache, constantly updated to reflect the current server # state for each mailbox $self->{_CACHE} = {}; # persistent cache, describing the last clean (synced) state $self->{_PCACHE} = {}; # list of UIDs for which the server a VANISHED or VANISHED (EARLIER) # response. /!\ requires a QRESYNC-capable server! # Only notifications with UID < $self->{_PCACHE}->{$mailbox}->{UIDNEXT} # are considered. $self->{_VANISHED} = []; # hash UID => [ MODSEQ, FLAGS ] for which the server a FETCH # response with the FLAGS attribute. The \Recent flag is always # omitted from the FLAG list. MODSEQ is always present, and the # value [ MODSEQ, FLAGS ] is updated if another FETCH response with # a higher MODSEQ is received. If FLAGS is undefined, then the FLAG # list of the message is considered unknown and should be retrieved # manually. # Only notifications with UID < $self->{_PCACHE}->{$mailbox}->{UIDNEXT} # and with MODSEQ => $self->{_PCACHE}->{$mailbox}->{HIGHESTMODSEQ} # are considered. $self->{_MODIFIED} = {}; # wait for the greeting my $x = $self->_getline(); $x =~ s/\A\* (OK|PREAUTH) // or $self->panic($x); $IMAP_cond = $1; $IMAP_text = $1.' '.$x; # try to update the cache (eg, capabilities) $self->_resp_text($x); if ($IMAP_cond eq 'OK') { # login required $self->{_STATE} = 'UNAUTH'; my @caps = $self->capabilities(); if ($self->{type} eq 'imap' and $self->{STARTTLS}) { # RFC 2595 section 5.1 $self->fail("Server did not advertise STARTTLS capability.") unless grep {$_ eq 'STARTTLS'} @caps; $self->_send('STARTTLS'); $self->_start_ssl($self->{S}); # refresh the previous CAPABILITY list since the previous one could have been spoofed delete $self->{_CAPABILITIES}; @caps = $self->capabilities(); } my @mechs = ('LOGIN', grep defined, map { /^AUTH=(.+)/i ? uc($1) : undef } @caps); my $mech = (grep defined, map {my $m = uc($_); (grep {$m eq $_} @mechs) ? $m : undef} split(/ /, $self->{auth}))[0]; $self->fail("Failed to choose an authentication mechanism") unless defined $mech; $self->fail("Logins are disabled.") if ($mech eq 'LOGIN' or $mech eq 'PLAIN') and grep {$_ eq 'LOGINDISABLED'} @caps; my ($command, $callback); my ($username, $password) = @$self{qw/username password/}; if ($mech eq 'LOGIN') { $self->fail("Missing option $_") foreach grep {!defined $self->{$_}} qw/username password/; $command = join ' ', 'LOGIN', quote($username), quote($password); } elsif ($mech eq 'PLAIN') { require 'MIME/Base64.pm'; $self->fail("Missing option $_") foreach grep {!defined $self->{$_}} qw/username password/; my $credentials = MIME::Base64::encode_base64("\x00".$username."\x00".$password, ''); $command = "AUTHENTICATE $mech"; if ($self->_capable('SASL-IR')) { # RFC 4959 SASL-IR $command .= " $credentials"; } else { $callback = sub($) {return $credentials}; } } else { $self->fail("Unsupported authentication mechanism: $mech"); } my $dbg; delete $self->{password}; # no need to remember passwords if (($self->{debug} // 0) == 1) { $dbg = $self->{debug}--; my $cmd = $command =~ /\A(LOGIN) / ? $1 : $command =~ /\A(AUTHENTICATE \S+)(?: .*)?\z/ ? $1 : $self->panic(); $self->logger('C: xxx ', $cmd, ' [REDACTED]'); } $self->_send($command, $callback); if (defined $dbg) { $self->logger('S: xxx ', $IMAP_text); $self->{debug} = $dbg; } $self->{_STATE} = 'AUTH'; unless ($IMAP_text =~ /\A\Q$IMAP_cond\E \[CAPABILITY /) { # refresh the CAPABILITY list since the previous one had only pre-login capabilities delete $self->{_CAPABILITIES}; $self->capabilities(); } } elsif ($IMAP_cond eq 'PREAUTH') { if ($self->{type} eq 'imap' and $self->{STARTTLS} != 0) { $self->fail("PREAUTH greeting on plaintext connection? MiTM in action? Aborting, set \"STARTTLS = NO\" to ignore."); } $self->{_STATE} = 'AUTH'; } else { $self->panic(); } # Don't send the COMPRESS command before STARTTLS or AUTH, as per RFC 4978 if ($self->{compress} // 1 and my @algos = grep defined, map { /^COMPRESS=(.+)/i ? uc $1 : undef } @{$self->{_CAPABILITIES}}) { my @supported = qw/DEFLATE/; # supported compression algorithms my $algo = first { my $x = $_; grep {$_ eq $x} @algos } @supported; if (!defined $algo) { $self->warn("Couldn't find a suitable compression algorithm. Not enabling compression."); } else { my ($d, $i); my $r = $self->_send("COMPRESS $algo"); unless ($r eq 'NO' and $IMAP_text =~ /\ANO \[COMPRESSIONACTIVE\] /) { $self->panic($IMAP_text) unless $r eq 'OK'; if ($algo eq 'DEFLATE') { my %args = ( -WindowBits => 0 - MAX_WBITS, -Bufsize => $BUFSIZE ); $self->{_Z_DEFLATE} = Compress::Raw::Zlib::Deflate::->new(%args, -AppendOutput => 1) // $self->panic("Can't create deflation stream"); $self->{_Z_INFLATE} = Compress::Raw::Zlib::Inflate::->new(%args) // $self->panic("Can't create inflation stream"); } else { $self->fail("Unsupported compression algorithm: $algo"); } } } } my @extensions = !defined $self->{enable} ? () : ref $self->{enable} eq 'ARRAY' ? @{$self->{enable}} : ($self->{enable}); if (@extensions) { $self->fail("Server did not advertise ENABLE (RFC 5161) capability.") unless $self->_capable('ENABLE'); $self->fail("Server did not advertise $_ capability.") foreach grep { !$self->_capable($_) } @extensions; $self->_send('ENABLE '.join(' ',@extensions)); my @enabled = @{$self->{_ENABLED} // []}; $self->fail("Couldn't ENABLE $_") foreach grep {my $e = $_; !grep {uc $e eq uc $_} @enabled} @extensions; } return $self; } # Print traffic statistics sub stats($) { my $self = shift; my $msg = 'IMAP traffic (bytes):'; $msg .= ' recv '._kibi($self->{_OUTCOUNT}); $msg .= ' (compr. '._kibi($self->{_OUTRAWCOUNT}). ', factor '.sprintf('%.2f', $self->{_OUTRAWCOUNT}/$self->{_OUTCOUNT}).')' if exists $self->{_Z_DEFLATE} and $self->{_OUTCOUNT} > 0; $msg .= ' sent '._kibi($self->{_INCOUNT}); $msg .= ' (compr. '._kibi($self->{_INRAWCOUNT}). ', factor '.sprintf('%.2f', $self->{_INRAWCOUNT}/$self->{_INCOUNT}).')' if exists $self->{_Z_DEFLATE} and $self->{_INCOUNT} > 0; $self->log($msg); } # Destroy a Net::IMAP::InterIMAP object. sub DESTROY($) { local($., $@, $!, $^E, $?); my $self = shift; $self->{_STATE} = 'LOGOUT'; Net::SSLeay::free($self->{_SSL}) if defined $self->{_SSL}; Net::SSLeay::CTX_free($self->{_SSL_CTX}) if defined $self->{_SSL_CTX}; if (defined (my $s = $self->{S})) { # for type=tunnel we assume the child won't linger around once # we close its standard input and output. shutdown($s, SHUT_RDWR); $s->close() if $s->opened(); } $self->stats() unless $self->{quiet}; } # $self->log($message, [...]) # $self->logger($message, [...]) # Log a $message. The latter method is used to log in the 'logger-fd' # (and adds timestamps). sub log($@) { my $self = shift; return unless @_; my $prefix = _logger_prefix($self); if (defined (my $fd = $self->{'logger-fd'})) { say $fd _date(), " ", $prefix, @_; } say STDERR $prefix, @_; } sub logger($@) { my $self = shift; return unless @_; my $prefix = _logger_prefix($self); if (defined (my $fd = $self->{'logger-fd'})) { say $fd _date(), " ", $prefix, @_; } else { say STDERR $prefix, @_; } } sub _date() { my ($s, $us) = Time::HiRes::gettimeofday(); my $t = POSIX::strftime("%b %e %H:%M:%S", localtime($s)); return "$t.$us"; # millisecond precision } # $self->_logger_prefix() # Format a prefix for logging with printf(3)-like sequences: # %n: the object name # %m: mailbox, either explicit named or selected sub _logger_prefix($) { my $self = shift; my $format = $self->{'logger-prefix'} // return ""; my %seq = ( "%" => "%", m => $self->{mailbox}, n => $self->{name} ); $seq{m} //= $self->{_SELECTED} // die if defined $self->{_STATE} and $self->{_STATE} eq 'SELECTED'; do {} while # rewrite conditionals (loop because of nesting) $format =~ s#%\? ([[:alpha:]]) \? ( (?: (?> (?: [^%&?\\] | %[^?] | \\[&?\\] )+ ) | (?R) )* ) (?: \& ( (?: (?> (?: [^%&?\\] | %[^?] | \\[&?\\] )+ ) | (?R) )*) )? \?# ($seq{$1} // "") ne "" ? $2 : ($3 // "") #agex; $format =~ s#\\([&?\\])#$1#g; # unescape remaining '&', '?' and '\' $format =~ s#%([%mn])# $seq{$1} #ge; return $format; } # $self->warn([$type,] $warning) # Log a $warning. sub warn($$;$) { my ($self, $msg, $t) = @_; $msg = defined $t ? "$msg WARNING: $t" : "WARNING: $msg"; $self->log($msg); } # $self->fail([$type,] $error) # Log an $error and exit with return value 1. sub fail($$;$) { my ($self, $msg, $t) = @_; $msg = defined $t ? "$msg ERROR: $t" : "ERROR: $msg"; $self->log($msg); exit 1; } # $self->panic($error, [...]) # Log a fatal $error including the position of the caller, and exit # with return value 255. sub panic($@) { my $self = shift; my @loc = caller; my $msg = "PANIC at line $loc[2] in $loc[1]"; $msg .= ': ' if @_; $self->log($msg, @_); exit 255; } # $self->capabilities() # Return the capability list of the IMAP4 server. The list is cached, # and a CAPABILITY command is only issued if the cache is empty. sub capabilities($) { my $self = shift; $self->_send('CAPABILITY') unless defined $self->{_CAPABILITIES} and @{$self->{_CAPABILITIES}}; $self->fail("Missing IMAP4rev1 CAPABILITY. Not an IMAP4 server?") unless $self->_capable('IMAP4rev1'); return @{$self->{_CAPABILITIES}}; } # $self->incapable(@capabilities) # In list context, return the list capabilties from @capabilities # which were NOT advertised by the server. In scalar context, return # the length of said list. sub incapable($@) { my ($self, @caps) = @_; my @mycaps = $self->capabilities(); grep {my $cap = uc $_; !grep {$cap eq uc $_} @mycaps} @caps; } # $self->search($criterion) # Issue a UID SEARCH command with the given $criterion. For the "normal" # UID SEARCH command from RFC 3501, return the list of matching UIDs; # for the extended UID SEARCH command from RFC 4731 (ensuring ESEARCH # capability is the caller's responsibility), return an optional "UID" # indicator followed by a hash containing search data pairs. sub search($$) { my ($self, $crit) = @_; my @res; $self->_send('UID SEARCH '.$crit, sub(@) {@res = @_}); return @res } # $self->select($mailbox, [$seqs, $UIDs]) # $self->examine($mailbox, [$seqs, $UIDs]) # Issue a SELECT or EXAMINE command for the $mailbox. Upon success, # change the state to SELECTED, otherwise go back to AUTH. # The optional $seqs and $UIDs are used as Message Sequence Match # Data for the QRESYNC parameter to the SELECT command. sub select($$;$$) { my $self = shift; my $mailbox = shift; $self->_select_or_examine('SELECT', $mailbox, @_); } sub examine($$;$$) { my $self = shift; my $mailbox = shift; $self->_select_or_examine('EXAMINE', $mailbox, @_); } # $self->unselect() # Issue an UNSELECT command (cf. RFC 3691). Upon success, change the # state to AUTH. sub unselect($) { my $self = shift; $self->_send('UNSELECT'); $self->{_STATE} = 'AUTH'; delete $self->{_SELECTED}; # it is safe to wipe cached VANISHED responses or FLAG updates, # because interesting stuff must have made the mailbox dirty so # we'll get back to it $self->{_VANISHED} = []; $self->{_MODIFIED} = {}; $self->{_NEW} = 0; } # $self->logout() # Issue a LOGOUT command. Change the state to LOGOUT. sub logout($) { my $self = shift; # don't bother if the connection is already closed $self->_send('LOGOUT') if $self->{S}->opened(); $self->{_STATE} = 'LOGOUT'; undef $self; } # $self->noop() # Issue a NOOP command. sub noop($) { shift->_send('NOOP'); } # $self->create($mailbox, [$try]) # $self->delete($mailbox, [$try]) # CREATE or DELETE $mailbox. # If try is set, print a warning but don't crash if the command fails. sub create($$;$) { my ($self, $mailbox, $try) = @_; my $r = $self->_send("CREATE ".quote($mailbox)); if ($IMAP_cond eq 'OK') { $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; } else { my $msg = "Couldn't create mailbox ".$mailbox.': '.$IMAP_text; $try ? $self->warn($msg) : $self->fail($msg); } return $r; } sub delete($$;$) { my ($self, $mailbox, $try) = @_; my $r = $self->_send("DELETE ".quote($mailbox)); delete $self->{_CACHE}->{$mailbox}; delete $self->{_PCACHE}->{$mailbox}; if ($IMAP_cond eq 'OK') { $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; } else { my $msg = "Couldn't delete mailbox ".$mailbox.': '.$IMAP_text; $try ? $self->warn($msg) : $self->fail($msg); } return $r; } # $self->rename($oldname, $newname, [$try]) # RENAME the mailbox $oldname to $newname. # If $try is set, print a warning but don't crash if the command fails. # /!\ Requires a LIST command to be issued to determine the hierarchy # delimiter and the mailbox attributes for the original name. sub rename($$$;$) { my ($self, $from, $to, $try) = @_; my ($delim, @attrs); if ($self->{_CACHE}->{$from}) { $delim = $self->{_CACHE}->{$from}->{DELIMITER}; @attrs = @{$self->{_CACHE}->{$from}->{LIST_ATTRIBUTES} // []}; } my $r = $self->_send("RENAME ".quote($from).' '.quote($to)); $self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from}; $self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from}; if (defined $delim and !grep {lc $_ eq lc '\NoInferiors' or lc $_ eq lc '\HasNoChildren'} @attrs) { # on non-flat mailboxes, move children as well (cf 3501) foreach my $c1 (grep /\A\Q$from$delim\E/, keys %{$self->{_CACHE}}) { my $c2 = $c1 =~ s/\A\Q$from$delim\E/$to$delim/r; $self->{_CACHE}->{$c2} = delete $self->{_CACHE}->{$c1} if exists $self->{_CACHE}->{$c1}; $self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1}; } } if ($IMAP_cond eq 'OK') { $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; } else { my $msg = "Couldn't rename mailbox ".$from.': '.$IMAP_text; $try ? $self->warn($msg) : $self->fail($msg); } return $r; } # $self->subscribe($mailbox, [$try]) # $self->unsubscribe($mailbox, [$try]) # SUBSCRIBE or UNSUBSCRIBE $mailbox. # If $try is set, print a warning but don't crash if the command fails. sub subscribe($$;$) { my ($self, $mailbox, $try) = @_; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive my $r = $self->_send("SUBSCRIBE ".quote($mailbox)); if ($IMAP_cond eq 'OK') { $self->log("Subscribe to ".$mailbox) unless $self->{quiet}; } else { my $msg = "Couldn't subscribe to ".$mailbox.': '.$IMAP_text; $try ? $self->warn($msg) : $self->fail($msg); } return $r; } sub unsubscribe($$;$) { my ($self, $mailbox, $try) = @_; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive my $r = $self->_send("UNSUBSCRIBE ".quote($mailbox)); if ($IMAP_cond eq 'OK') { $self->log("Unsubscribe to ".$mailbox) unless $self->{quiet}; } else { my $msg = "Couldn't unsubscribe to ".$mailbox.': '.$IMAP_text; $try ? $self->warn($msg) : $self->fail($msg); } return $r; } # $self->list($criterion, @parameters) # Issue a LIST command with the given $criterion and @parameters. # Return a pair where the first component is a hash reference of # matching mailboxes and their flags, and the second component is a # hash reference of matching mailboxes and their hierarchy delimiter # (or undef for flat mailboxes). sub list($$@) { my $self = shift; my $crit = shift; my %mailboxes; my %delims; $self->_send( "LIST ".$crit.(@_ ? (' RETURN ('.join(' ', @_).')') : ''), sub($$@) {my $name = shift; $delims{$name} = shift; $mailboxes{$name} = \@_;} ); return (\%mailboxes, \%delims); } # $self->remove_message($uid, [...]) # Remove the given $uid list. Croak if the server did not advertise # "UIDPLUS" (RFC 4315) in its CAPABILITY list. # Successfully EXPUNGEd UIDs are removed from the pending VANISHED and # MODIFIED lists. # Return the list of UIDs that couldn't be EXPUNGEd. sub remove_message($@) { my $self = shift; my @set = @_; $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.") unless $self->_capable('UIDPLUS'); with_set(compact_set(@set), sub($) { $self->_send("UID STORE $_[0] +FLAGS.SILENT (\\Deleted)"); $self->_send("UID EXPUNGE $_[0]"); # RFC 4315 UIDPLUS }); my %vanished = map {$_ => 1} @{$self->{_VANISHED}}; my (@failed, @expunged); foreach my $uid (@set) { if (exists $vanished{$uid}) { push @expunged, $uid } else { push @failed, $uid; } } # ignore succesfully EXPUNGEd messages delete @vanished{@expunged}; delete @{$self->{_MODIFIED}}{@expunged}; $self->{_VANISHED} = [ keys %vanished ]; $self->log("Removed ".($#expunged+1)." UID(s) ". compact_set(@expunged)) if @expunged and !$self->{quiet}; $self->warn("Couldn't UID EXPUNGE ".compact_set(@failed)) if @failed; return @failed; } # $self->append($mailbox, $mail, [...]) # Issue an APPEND command with the given mails. Croak if the server # did not advertise "UIDPLUS" (RFC 4315) in its CAPABILITY list. # Each $mail is a hash reference with key 'RFC822' and optionally # 'UID', 'FLAGS' and 'INTERNALDATE'. # Providing multiple mails is only allowed for servers supporting # "MULTIAPPEND" (RFC 3502). # Return the list of UIDs allocated for the new messages, in the order # they were APPENDed. sub append($$@) { my $self = shift; my $mailbox = shift; return unless @_; $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.") unless $self->_capable('UIDPLUS'); $self->fail("Server did not advertise MULTIAPPEND (RFC 3502) capability.") unless $#_ == 0 or $self->_capable('MULTIAPPEND'); # dump the cache before issuing the command if we're appending to the current mailbox my ($UIDNEXT, $EXISTS, $cache, %vanished); $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive if (defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED}) { $cache = $self->{_CACHE}->{$mailbox}; $UIDNEXT = $cache->{UIDNEXT} // $self->panic(); $EXISTS = $cache->{EXISTS} // $self->panic(); %vanished = map {$_ => 1} @{$self->{_VANISHED}}; } my $tag = $self->_cmd_init('APPEND '.quote($mailbox)); foreach my $mail (@_) { my $str = ' '; $str .= '('.join(' ', grep {lc $_ ne '\recent'} @{$mail->{FLAGS}}).') ' if defined $mail->{FLAGS}; $str .= '"'.$mail->{INTERNALDATE}.'" ' if defined $mail->{INTERNALDATE}; $self->_cmd_extend(\$str); $self->_cmd_extend_lit($mail->{RFC822} // $self->panic("Missing message body in APPEND")); } $self->_cmd_flush(); $self->_recv($tag); $IMAP_text =~ /\A\Q$IMAP_cond\E \[APPENDUID ([0-9]+) ([0-9:,]+)\] / or $self->panic($IMAP_text); my ($uidvalidity, $uidset) = ($1, $2); $self->_update_cache_for($mailbox, UIDVALIDITY => $uidvalidity); my @uids; foreach (split /,/, $uidset) { if (/\A([0-9]+)\z/) { $UIDNEXT = $1 + 1 if defined $UIDNEXT and $UIDNEXT <= $1; push @uids, $1; } elsif (/\A([0-9]+):([0-9]+)\z/) { my ($min, $max) = $1 <= $2 ? ($1,$2) : ($2,$1); push @uids, ($min .. $max); $UIDNEXT = $max + 1 if defined $UIDNEXT and $UIDNEXT <= $max; } else { $self->panic($_); } } $self->fail("$uidset contains ".scalar(@uids)." elements while ".($#_+1)." messages were appended.") unless $#uids == $#_; # if $mailbox is the current mailbox we need to update the cache if (defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED}) { # EXISTS responses SHOULD be sent by the server (per RFC3501), but it's not required my %vanished2 = map {$_ => 1} @{$self->{_VANISHED}}; delete $vanished2{$_} foreach keys %vanished; my $VANISHED = scalar(keys %vanished2); # number of messages VANISHED meanwhile $cache->{EXISTS} += $#_+1 if defined $cache->{EXISTS} and $cache->{EXISTS} + $VANISHED == $EXISTS; $cache->{UIDNEXT} = $UIDNEXT if ($cache->{UIDNEXT} // 1) < $UIDNEXT; } unless ($self->{quiet}) { my $msg = "Added ".($#_+1)." UID(s) "; $msg .= "to $mailbox " unless defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED}; if (defined $self->{name} and all {defined $_->{UID}} @_) { $msg .= $self->{name} eq 'local' ? (compact_list(@uids) .' <- '. compact_list(map {$_->{UID}} @_)) : (compact_list(map {$_->{UID}} @_) .' -> '. compact_list(@uids)); } else { $msg .= compact_list(@uids); } $self->log($msg); } return @uids; } # $self->fetch($set, $flags, [$callback]) # Issue a UID FETCH command with the given UID $set, $flags, and # optional $callback. sub fetch($$$;&) { my ($self, $set, $flags, $callback) = @_; return with_set($set, sub($) { $self->_send("UID FETCH $_[0] $flags", $callback); }); } # $self->notify($arg, %specifications) # Issue a NOTIFY command with the given $arg ("SET", "SET STATUS" or # "NONE") and mailbox %specifications (cf RFC 5465 section 6) to be # monitored. Croak if the server did not advertise "NOTIFY" (RFC # 5465) in its CAPABILITY list. sub notify($$@) { my $self = shift; $self->fail("Server did not advertise NOTIFY (RFC 5465) capability.") unless $self->_capable('NOTIFY'); my $command = 'NOTIFY '.shift; while (@_) { $command .= " (".shift." (".join(' ', @{shift()})."))"; } $self->_send($command); } # slurp($imap, $timeout, $stopwhen) # Keep reading untagged responses from the @$imap servers until the # $stopwhen condition becomes true (then return true), or until the # $timeout expires (then return false). # This is mostly useful when waiting for notifications while no # command is progress, cf. RFC 2177 (IDLE) or RFC 5465 (NOTIFY). sub slurp($$$) { my ($selfs, $timeout, $stopwhen) = @_; my $aborted = 0; my $rin = ''; vec($rin, fileno($_->{S}), 1) = 1 foreach @$selfs; while (1) { # first, consider only unprocessed data without our own output # buffer, or within the current TLS record: these would cause # select(2) to block/timeout due to the raw socket not being # ready. my @ready = grep { (defined $_->{_OUTBUF} and $_->{_OUTBUF} ne '') or (defined $_->{_SSL} and Net::SSLeay::pending($_->{_SSL}) > 0) } @$selfs; unless (@ready) { my ($r, $timeleft) = CORE::select(my $rout = $rin, undef, undef, $timeout); next if $r == -1 and $! == EINTR; # select(2) was interrupted die "select: $!" if $r == -1; return $aborted if $r == 0; # nothing more to read (timeout reached) @ready = grep {vec($rout, fileno($_->{S}), 1)} @$selfs; $timeout = $timeleft if $timeout > 0; } foreach my $imap (@ready) { my $x = $imap->_getline(); $imap->_resp($x, sub($;$$) { if ($stopwhen->($imap, @_)) { $aborted = 1; $timeout = 0; # keep reading the handles while there is pending data } }, 'slurp'); } } return $aborted; } # $self->idle($timeout, $stopwhen) # Enter IDLE (RFC 2177) for $timout seconds (by default 29 mins), or # when the callback $stopwhen returns true. # Return true if the callback returned true (either aborting IDLE, or # after the $timeout) and false otherwise. sub idle($$$) { my ($self, $timeout, $stopwhen) = @_; my $tag = $self->idle_start($timeout); my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins $r += $self->idle_stop($tag, $stopwhen); return $r; } # $self->idle_start() # Enter IDLE (RFC 2177). # Return the command tag. sub idle_start($) { my $self = shift; $self->fail("Server did not advertise IDLE (RFC 2177) capability.") unless $self->_capable('IDLE'); my $tag = $self->_cmd_init('IDLE'); $self->_cmd_flush(); return $tag; } # $self->idle_stop($tag, $callback) # Stop a running IDLE (RFC 2177) command $tag. # Returns the number of untagged responses received between the DONE # the tagged response that are satisfying $callback. sub idle_stop($$$) { my ($self, $tag, $callback) = @_; my $r = 0; # done idling $self->_cmd_extend('DONE'); $self->_cmd_flush(); # run the callback again to update the return value if we received # untagged responses between the DONE and the tagged response $self->_recv($tag, sub($;$$) { $r++ if $callback->($self, @_) }, 'slurp'); return $r; } # $self->set_cache($mailbox, STATE) # Initialize or update the persistent cache, that is, associate a # known $mailbox with the last known (synced) state: # * UIDVALIDITY # * UIDNEXT: Any message the UID of which is at least UIDNEXT is # considered new and must be downloaded. (If 0 or missing, all # messages in $mailbox are considered new.) Note that while all # UIDs in the map are panic(); $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive my $cache = $self->{_PCACHE}->{$mailbox} //= {}; my %status = @_; while (my ($k, $v) = each %status) { if ($k eq 'UIDVALIDITY') { # try to detect UIDVALIDITY changes early (before starting the sync) $self->fail("UIDVALIDITY changed! ($cache->{UIDVALIDITY} != $v) ". "Need to invalidate the UID cache for $mailbox.") if defined $cache->{UIDVALIDITY} and $cache->{UIDVALIDITY} != $v; } $cache->{$k} = $v; } $self->logger("Update last clean state for $mailbox: ". '('.join(' ', map {"$_ $cache->{$_}"} grep {defined $cache->{$_}} keys %$cache).')') if $self->{debug}; } # $self->uidvalidity([$mailbox]) # Return the UIDVALIDITY for $mailbox, or hash mapping each mailbox to # its UIDVALIDITY if $mailbox is omitted. sub uidvalidity($;$) { my $self = shift; my $mailbox = shift; if (defined $mailbox) { $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive my $cache = $self->{_CACHE}->{$mailbox} // return; return $cache->{UIDVALIDITY}; } else { my %uidvalidity; while (my ($mbx,$cache) = each %{$self->{_CACHE}}) { $uidvalidity{$mbx} = $cache->{UIDVALIDITY} if ($cache->{UIDVALIDITY} // 0) > 0; } return %uidvalidity; } } # $self->get_cache(@attributes) # Return the persistent cache for the mailbox currently selected. If # some @attributes are given, return the list of values corresponding # to these attributes. # /!\ Should only be called right after pull_updates! # Croak if there are unprocessed VANISHED responses or FLAG updates. sub get_cache($@) { my $self = shift; $self->fail("Invalid method 'get_cache' in state $self->{_STATE}") unless $self->{_STATE} eq 'SELECTED'; my $mailbox = $self->{_SELECTED} // $self->panic(); $self->panic("Pending VANISHED responses!") if @{$self->{_VANISHED}}; $self->panic("Pending FLAG updates!") if %{$self->{_MODIFIED}}; my $cache = $self->{_PCACHE}->{$mailbox}; return @_ ? @$cache{@_} : %$cache; } # $self->is_dirty($mailbox) # Return true if there are pending updates for $mailbox, i.e., if its # internal cache's HIGHESTMODSEQ or UIDNEXT values differ from its # persistent cache's values. sub is_dirty($$) { my ($self, $mailbox) = @_; return 1 if $self->{_NEW}; $self->_updated_cache($mailbox, qw/HIGHESTMODSEQ UIDNEXT/); } # $self->has_new_mails($mailbox) # Return true if there are new messages in $mailbox, i.e., if its # internal cache's UIDNEXT value differs from its persistent cache's. sub has_new_mails($$) { my ($self, $mailbox) = @_; return 1 if $self->{_NEW}; $self->_updated_cache($mailbox, 'UIDNEXT'); } # $self->next_dirty_mailbox(@mailboxes) # Return the name of a dirty mailbox, or undef if all mailboxes are # clean. If @mailbox is non-empty, only consider mailboxes in that # list. sub next_dirty_mailbox($@) { my $self = shift; my %mailboxes = map {$_ => 1} @_; my @dirty = grep { (!%mailboxes or $mailboxes{$_}) and $self->is_dirty($_) } keys %{$self->{_CACHE}}; if ($self->{debug}) { @dirty ? $self->logger("Dirty mailboxes: ".join(', ', @dirty)) : $self->logger("Clean state!"); } return $dirty[0]; } # $self->pull_updates([$full]) # If $full is set, FETCH FLAGS and MODSEQ for each UID up to # UIDNEXT-1. # Get pending updates (unprocessed VANISHED responses and FLAG # updates), and empty these lists from the cache. # Finally, update the HIGHESTMODSEQ from the persistent cache to the # value found in the internal cache. sub pull_updates($;$) { my $self = shift; my $full = shift // 0; my $mailbox = $self->{_SELECTED} // $self->panic(); my $pcache = $self->{_PCACHE}->{$mailbox}; $self->_send("UID FETCH 1:".($pcache->{UIDNEXT}-1)." (MODSEQ FLAGS)") if $full and ($pcache->{UIDNEXT} // 1) > 1; my %modified; while (%{$self->{_MODIFIED}}) { my @missing; while (my ($uid,$v) = each %{$self->{_MODIFIED}}) { # don't filter on the fly (during FETCH responses) because FLAG updates # can arrive while processing pull_new_messages() for instance if (defined $v->[1] and $v->[0] > 0) { # setting the MODSEQ to 0 forces a FETCH next unless $uid < ($pcache->{UIDNEXT} // 1) # out of bounds and ($full or $v->[0] > ($pcache->{HIGHESTMODSEQ} // 0)); # already seen $modified{$uid} = $full ? $v : $v->[1]; } else { push @missing, $uid; } } $self->{_MODIFIED} = {}; # non-empty @missing indicates a discouraged (but allowed) CONDSTORE server behavior, # cf. RFC 7162 sec. 3.1.3 ex. 8 and the comment in push_flag_updates() below with_set(compact_set(@missing), sub($) { $self->_send("UID FETCH $_[0] (MODSEQ FLAGS)") }) if @missing; } # do that afterwards since the UID FETCH command above can produce VANISHED responses my %vanished = map {$_ => 1} grep { $_ < ($pcache->{UIDNEXT} // 1) } @{$self->{_VANISHED}}; my @vanished = keys %vanished; $self->{_VANISHED} = []; # ignore FLAG updates on VANISHED messages delete @modified{@vanished}; # update the persistent cache for HIGHESTMODSEQ (not for UIDNEXT # since there might be new messages) $self->set_cache($mailbox, %{$self->{_CACHE}->{$mailbox}}{HIGHESTMODSEQ}); return (\@vanished, \%modified); } # $self->pull_new_messages($attrs, $callback, @ignore) # FETCH new messages since the UIDNEXT found in the persistent cache # (or 1 in no such UIDNEXT is found), and process each response on the # fly with the callback. # The list of attributes to FETCH, $attr, must contain BODY[]. # If an @ignore list is supplied, then these messages are ignored from # the UID FETCH range. # Finally, update the UIDNEXT from the persistent cache to the value # found in the internal cache. # /!\ Use pull_updates afterwards to udpate the HIGHESTMODSEQ! sub pull_new_messages($$&@) { my $self = shift; my $attrs = shift; my $callback = shift; my @ignore = sort { $a <=> $b } @_; my $mailbox = $self->{_SELECTED} // $self->panic(); my $cache = $self->{_CACHE}->{$mailbox}; my $UIDNEXT; do { my $range = ''; my $first; my $since = $self->{_PCACHE}->{$mailbox}->{UIDNEXT} || 1; foreach my $uid (@ignore) { if ($since < $uid) { $first //= $since; $range .= ',' if $range ne ''; $range .= $since; $range .= ':'.($uid-1) if $since < $uid-1; $since = $uid+1; } elsif ($since == $uid) { $since++; } } $first //= $since; $range .= ',' if $range ne ''; # 2^32-1: don't use '*' since the highest UID can be known already $range .= "$since:4294967295"; $UIDNEXT = $cache->{UIDNEXT} // $self->panic("Unknown UIDNEXT value - non-compliant server?"); $self->fetch($range, "($attrs)", sub($) { my $mail = shift; $UIDNEXT = $mail->{UID} + 1 if $UIDNEXT <= $mail->{UID}; $callback->($mail) if defined $callback; }) if $first < $UIDNEXT or $self->{_NEW}; # update the persistent cache for UIDNEXT (not for HIGHESTMODSEQ # since there might be pending updates) $self->set_cache($mailbox, UIDNEXT => $UIDNEXT); $self->{_NEW} = 0; } # loop if new messages were received in the meantime while ($self->{_NEW} or $UIDNEXT < $cache->{UIDNEXT}); } # $self->push_flag_updates($flags, @set) # Change the flags to each UID in @set to $flags. # A flag update fails for mails being updated after the HIGHESTMODSEQ # found in the persistent cache; push such messages to the MODIFIED # list. sub push_flag_updates($$@) { my $self = shift; my $flags = shift; my @set = @_; my $mailbox = $self->{_SELECTED} // $self->panic(); my $modseq = $self->{_PCACHE}->{$mailbox}->{HIGHESTMODSEQ} // $self->panic(); my %failed; with_set(compact_set(@set), sub($) { $self->_send("UID STORE $_[0] (UNCHANGEDSINCE $modseq) FLAGS.SILENT ($flags)"); if ($IMAP_text =~ /\A\Q$IMAP_cond\E \[MODIFIED ([0-9,:]+)\] $RE_TEXT_CHAR+\z/) { foreach (split /,/, $1) { if (/\A([0-9]+)\z/) { $failed{$1} = 1; } elsif (/\A([0-9]+):([0-9]+)\z/) { my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1); $failed{$_} = 1 foreach ($min .. $max); } else { $self->panic($_); } } } }); my @ok; foreach my $uid (@set) { my $modified = $self->{_MODIFIED}; if ($failed{$uid}) { # $uid was listed in the MODIFIED response code from RFC 7162; will FETCH # again in pull_updates(); per RFC 7162 sec. 3.1.3 $modified->{$uid} might not # be defined ("nice" servers send an untagged FETCH response, cf. example 10, # but they might omit it - allowed but discouraged CONDSTORE server behavior - # cf. example 8) $modified->{$uid} //= [ 0, undef ]; } elsif (defined (my $m = $modified->{$uid})) { # received an untagged FETCH response, remove from the list of pending changes # if the flag list was up to date (either implicitely or explicitly) if (!defined $m->[1] or $m->[1] eq $flags) { delete $modified->{$uid}; push @ok, $uid; } } } unless ($self->{quiet}) { $self->log("Updated flags ($flags) for UID ".compact_set(@ok)) if @ok; $self->log("Couldn't update flags ($flags) for UID ".compact_set(keys %failed).', '. "will try again later") if %failed; } return keys %failed; } # $self->silent_store($set, $mod, @flags) # Set / Add / Remove the flags list on the UID $set, depending on the # value of $mod ('' / '+' / '-'). # /!\ There is no guaranty that message flags are successfully updated! sub silent_store($$$@) { my $self = shift; my $set = shift; my $subcmd = shift . "FLAGS.SILENT"; my $flags = join(' ', @_); with_set($set, sub($) { $self->_send("UID STORE $_[0] $subcmd ($flags)") }); } # $self->expunge($set) # Exunge the given UID $set. # /!\ There is no guaranty that messages are successfully expunged! sub expunge($$) { my $self = shift; my $set = shift; $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.") unless $self->_capable('UIDPLUS'); with_set($set, sub($) { $self->_send("UID EXPUNGE $_[0]") }); } ############################################################################# # Private methods # $self->_ssl_error($error, [...]) # Log an SSL $error and exit with return value 1. sub _ssl_error($$@) { my $self = shift; $self->fail(@_) unless defined $self->{_SSL}; $self->log('SSL ERROR: ', @_); if ($self->{debug}) { while (my $err = Net::SSLeay::ERR_get_error()) { $self->log(Net::SSLeay::ERR_error_string($err)); } } exit 1; } # RFC 3986 appendix A my $RE_IPv4 = do { my $dec = qr/[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5]/; qr/$dec(?:\.$dec){3}/ }; my $RE_IPv6 = do { my $h16 = qr/[0-9A-Fa-f]{1,4}/; my $ls32 = qr/$h16:$h16|$RE_IPv4/; qr/ (?: $h16 : ){6} $ls32 | :: (?: $h16 : ){5} $ls32 | (?: $h16 )? :: (?: $h16 : ){4} $ls32 | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32 | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32 | (?: (?: $h16 : ){0,3} $h16 )? :: $h16 : $ls32 | (?: (?: $h16 : ){0,4} $h16 )? :: $ls32 | (?: (?: $h16 : ){0,5} $h16 )? :: $h16 | (?: (?: $h16 : ){0,6} $h16 )? :: /x }; # Parse an IPv4 or IPv6. In list context, return a pair (IP, family), # otherwise only the IP. If the argument is not an IP (for instance if # it's a hostname), then return (undef, undef) resp. undef. The input # can optionaly be enclosed in square brackets which forces its # interpretation as an IP literal: an error is raised if it is not the # case. my $RE_IPv4_anchored = qr/\A($RE_IPv4)\z/; my $RE_IPv6_anchored = qr/\A($RE_IPv6)\z/; sub _parse_hostip($) { my $v = shift // return; my $literal = $v =~ s/\A\[(.*)\]\z/$1/ ? 1 : 0; my ($ip, $af) = $v =~ $RE_IPv4_anchored ? ($1, AF_INET) : $v =~ $RE_IPv6_anchored ? ($1, AF_INET6) : (undef, undef); die "Invalid IP literal: $v\n" if $literal and !defined($ip); return wantarray ? ($ip, $af) : $ip; } # Opens a TCP socket to the given $host and $port. sub _tcp_connect($$$) { my ($self, $host, $port) = @_; my %hints = (socktype => SOCK_STREAM, protocol => IPPROTO_TCP); my ($host2, $family) = _parse_hostip($host); if (defined $family) { $hints{family} = $family; $hints{flags} |= AI_NUMERICHOST; } else { $host2 = $host; } my ($err, @res) = getaddrinfo($host2, $port, \%hints); $self->fail("getaddrinfo($host2): $err") if $err ne ''; SOCKETS: foreach my $ai (@res) { socket (my $s, $ai->{family}, $ai->{socktype}|SOCK_CLOEXEC, $ai->{protocol}) or $self->panic("socket: $!"); # timeout connect/read/write/... after 30s # XXX we need to pack the struct timeval manually: not portable! # https://stackoverflow.com/questions/8284243/how-do-i-set-so-rcvtimeo-on-a-socket-in-perl my $timeout = pack('l!l!', 30, 0); setsockopt($s, Socket::SOL_SOCKET, Socket::SO_RCVTIMEO, $timeout) or $self->fail("setsockopt SO_RCVTIMEO: $!"); setsockopt($s, Socket::SOL_SOCKET, Socket::SO_SNDTIMEO, $timeout) or $self->fail("setsockopt SO_RCVTIMEO: $!"); until (connect($s, $ai->{addr})) { next if $! == EINTR; # try again if connect(2) was interrupted by a signal next SOCKETS; } return $s; } $self->fail("Can't connect to $host:$port"); } sub _xwrite($$$) { my $self = shift; my ($offset, $length) = (0, length $_[1]); while ($length > 0) { my $n = syswrite($_[0], $_[1], $length, $offset); $self->fail("write: $!") unless defined $n and $n > 0; $offset += $n; $length -= $n; } } sub _xread($$$) { my ($self, $fh, $length) = @_; my $offset = 0; my $buf; while ($length > 0) { my $n = sysread($fh, $buf, $length, $offset) // $self->fail("read: $!"); $self->fail("0 bytes read (got EOF)") unless $n > 0; # EOF $offset += $n; $length -= $n; } return $buf; } # $self->_proxify($proxy, $host, $port) # Initiate the given $proxy to proxy TCP connections to $host:$port. sub _proxify($$$$) { my ($self, $proxy, $host, $port) = @_; $port = getservbyname($port, 'tcp') // $self->fail("Can't getservbyname $port") unless $port =~ /\A[0-9]+\z/; $proxy =~ /\A([A-Za-z0-9]+):\/\/(\P{Control}*\@)?([^:]+|\[[^\]]+\])(:[A-Za-z0-9]+)?\z/ or $self->fail("Invalid proxy URI $proxy"); my ($proto, $userpass, $proxyhost, $proxyport) = ($1, $2, $3, $4); $userpass =~ s/\@\z// if defined $userpass; $proxyport = defined $proxyport ? $proxyport =~ s/\A://r : 1080; my $socket = $self->_tcp_connect($proxyhost, $proxyport); if ($proto eq 'socks5' or $proto eq 'socks5h') { my $resolv = $proto eq 'socks5h' ? 1 : 0; my $v = 0x05; # RFC 1928 VER protocol version my %mech = ( ANON => 0x00 ); $mech{USERPASS} = 0x02 if defined $userpass; $self->_xwrite($socket, pack('CCC*', 0x05, scalar (keys %mech), values %mech)); my ($v2, $m) = unpack('CC', $self->_xread($socket, 2)); $self->fail('SOCKSv5', 'Invalid protocol') unless $v == $v2; %mech = reverse %mech; my $mech = $mech{$m} // ''; if ($mech eq 'USERPASS') { # RFC 1929 Username/Password Authentication for SOCKS V5 my $v = 0x01; # current version of the subnegotiation my ($u, $pw) = split /:/, $userpass, 2; $self->_xwrite($socket, pack('C2', $v,length($u)).$u.pack('C',length($pw)).$pw); my ($v2, $r) = unpack('C2', $self->_xread($socket, 2)); $self->fail('SOCKSv5', 'Invalid protocol') unless $v == $v2; $self->fail('SOCKSv5', 'Authentication failed') unless $r == 0x00; } elsif ($mech ne 'ANON') { # $m == 0xFF $self->fail('SOCKSv5', 'No acceptable authentication methods'); } my ($hostip, $fam) = _parse_hostip($host); unless (defined($fam) or $resolv) { # resove the hostname $host locally my ($err, @res) = getaddrinfo($host, undef, {socktype => SOCK_RAW}); $self->fail("getaddrinfo($host): $err") if $err ne ''; my ($addr) = first { defined($_) } map { my ($err, $ipaddr) = getnameinfo($_->{addr}, NI_NUMERICHOST, NIx_NOSERV); $err eq '' ? [$ipaddr,$_->{family}] : undef } @res; $self->fail("getnameinfo") unless defined $addr; ($hostip, $fam) = @$addr; } # send a CONNECT command (CMD 0x01) my ($typ, $addr); if (defined $fam) { $typ = $fam == AF_INET ? 0x01 : $fam == AF_INET6 ? 0x04 : $self->panic(); $addr = Socket::inet_pton($fam, $hostip); } else { # let the SOCKS server do the resolution $typ = 0x03; $addr = pack('C',length($host)) . $host; } $self->_xwrite($socket, pack('C4', $v, 0x01, 0x00, $typ) . $addr . pack('n', $port)); ($v2, my $r, my $rsv, $typ) = unpack('C4', $self->_xread($socket, 4)); $self->fail('SOCKSv5', 'Invalid protocol') unless $v == $v2 and $rsv == 0x00; my $err = $r == 0x00 ? undef : $r == 0x01 ? 'general SOCKS server failure' : $r == 0x02 ? 'connection not allowed by ruleset' : $r == 0x03 ? 'network unreachable' : $r == 0x04 ? 'host unreachable' : $r == 0x05 ? 'connection refused' : $r == 0x06 ? 'TTL expired' : $r == 0x07 ? 'command not supported' : $r == 0x08 ? 'address type not supported' : $self->panic(); $self->fail('SOCKSv5', $err) if defined $err; my $len = $typ == 0x01 ? 4 : $typ == 0x03 ? unpack('C', $self->_xread($socket, 1)) : $typ == 0x04 ? 16 : $self->panic(); $self->_xread($socket, $len + 2); # consume (and ignore) the rest of the response return $socket; } else { $self->fail("Unsupported proxy protocol $proto"); } } # $self->_ssl_verify($self, $preverify_ok, $x509_ctx) # SSL verify callback function, see # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_verify.html sub _ssl_verify($$$) { my ($self, $ok, $x509_ctx) = @_; return 0 unless $x509_ctx; # reject my $depth = Net::SSLeay::X509_STORE_CTX_get_error_depth($x509_ctx); my $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($x509_ctx) or $self->_ssl_error("Can't get current certificate"); if ($self->{debug}) { $self->log("[$depth] preverify=$ok"); $self->log(' Issuer Name: ', Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_issuer_name($cert))); $self->log(' Subject Name: ', Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert))); } $ok = 1 unless $self->{SSL_verify} // die; # safety check, always set if ($depth == 0 and !exists $self->{_SSL_PEER_VERIFIED}) { if ($self->{debug}) { my $algo = 'sha256'; my $type = Net::SSLeay::EVP_get_digestbyname($algo) or $self->_ssl_error("Can't find MD value for name '$algo'"); $self->log('Peer certificate fingerprint: ' .$algo.'$'.unpack('H*', Net::SSLeay::X509_digest($cert, $type))); } if (defined (my $fprs = $self->{SSL_fingerprint})) { my $rv = 0; foreach my $fpr (split /\s+/, $fprs) { (my $algo, $fpr) = $fpr =~ /^([^\$]+)\$(.*)/ ? ($1, $2) : ('sha256', $fpr); my $digest = pack 'H*', ($fpr =~ tr/://rd); my $type = Net::SSLeay::EVP_get_digestbyname($algo) or $self->_ssl_error("Can't find MD value for name '$algo'"); my $pkey = Net::SSLeay::X509_get_X509_PUBKEY($cert); if (defined $pkey and Net::SSLeay::EVP_Digest($pkey, $type) eq $digest) { $self->log('Peer certificate matches pinned SPKI digest ', $algo .'$'. $fpr) if $self->{debug}; $rv = 1; last; } } unless ($rv) { $self->warn("Fingerprint doesn't match! MiTM in action?"); $ok = 0; } } $self->{_SSL_PEER_VERIFIED} = $ok; } return $ok; # 1=accept cert, 0=reject } my %SSL_proto; BEGIN { # TODO deprecated, remove in 0.6 sub _append_ssl_proto($$) { my ($k, $v) = @_; $SSL_proto{$k} = $v if defined $v; } _append_ssl_proto( "SSLv2", eval { Net::SSLeay::OP_NO_SSLv2() } ); _append_ssl_proto( "SSLv3", eval { Net::SSLeay::OP_NO_SSLv3() } ); _append_ssl_proto( "TLSv1", eval { Net::SSLeay::OP_NO_TLSv1() } ); _append_ssl_proto( "TLSv1.1", eval { Net::SSLeay::OP_NO_TLSv1_1() } ); _append_ssl_proto( "TLSv1.2", eval { Net::SSLeay::OP_NO_TLSv1_2() } ); _append_ssl_proto( "TLSv1.3", eval { Net::SSLeay::OP_NO_TLSv1_3() } ); } # see ssl/ssl_conf.c:protocol_from_string() in the OpenSSL source tree my %SSL_protocol_versions = ( "SSLv3" => eval { Net::SSLeay::SSL3_VERSION() } , "TLSv1" => eval { Net::SSLeay::TLS1_VERSION() } , "TLSv1.1" => eval { Net::SSLeay::TLS1_1_VERSION() } , "TLSv1.2" => eval { Net::SSLeay::TLS1_2_VERSION() } , "TLSv1.3" => eval { Net::SSLeay::TLS1_3_VERSION() } ); # $self->_start_ssl($socket) # Upgrade the $socket to SSL/TLS. sub _start_ssl($$) { my ($self, $socket) = @_; # need OpenSSL 1.1.0 or later for SSL_CTX_set_min_proto_version(3ssl), see # https://www.openssl.org/docs/man1.1.0/man3/SSL_CTX_set_min_proto_version.html $self->panic("SSL/TLS functions require OpenSSL 1.1.0 or later") if Net::SSLeay::OPENSSL_VERSION_NUMBER() < 0x1010000f; my $ctx = Net::SSLeay::CTX_new() or $self->panic("SSL_CTX_new(): $!"); $self->{SSL_verify} //= 1; # default is to perform certificate verification if (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') { $self->warn("Truncating non-empty output buffer (unauthenticated response injection?)"); undef $self->{_OUTBUF}; } my $ssl_options = Net::SSLeay::OP_SINGLE_DH_USE() | Net::SSLeay::OP_SINGLE_ECDH_USE(); $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION(); if (defined $self->{SSL_protocol_min} or defined $self->{SSL_protocol_max}) { my ($min, $max) = @$self{qw/SSL_protocol_min SSL_protocol_max/}; if (defined $min) { my $v = $SSL_protocol_versions{$min} // $self->panic("Unknown protocol version: $min"); $self->_ssl_error("CTX_set_min_proto_version()") unless Net::SSLeay::CTX_set_min_proto_version($ctx, $v) == 1; $self->log("Minimum SSL/TLS protocol version: ", $min) if $self->{debug}; } if (defined $max) { my $v = $SSL_protocol_versions{$max} // $self->panic("Unknown protocol version: $max"); $self->_ssl_error("CTX_set_max_proto_version()") unless Net::SSLeay::CTX_set_max_proto_version($ctx, $v) == 1; $self->log("Maximum SSL/TLS protocol version: ", $max) if $self->{debug}; } } elsif (defined (my $protos = $self->{SSL_protocols})) { # TODO deprecated, remove in 0.6 $self->warn("SSL_protocols is deprecated and will be removed in a future release! " . "Use SSL_protocol_{min,max} instead."); my ($proto_include, $proto_exclude) = (0, 0); foreach (split /\s+/, $protos) { my $neg = s/^!// ? 1 : 0; s/\.0$//; ($neg ? $proto_exclude : $proto_include) |= $SSL_proto{$_} // $self->panic("Unknown SSL protocol: $_"); } if ($proto_include != 0) { # exclude all protocols except those explictly included my $x = 0; $x |= $_ foreach values %SSL_proto; $x &= ~ $proto_include; $proto_exclude |= $x; } my @proto_exclude = grep { ($proto_exclude & $SSL_proto{$_}) != 0 } keys %SSL_proto; $self->log("Disabling SSL protocols: ".join(', ', sort @proto_exclude)) if $self->{debug}; $ssl_options |= $SSL_proto{$_} foreach @proto_exclude; } # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_options.html # TODO 0.6: move SSL_CTX_set_options() and SSL_CTX_set_mode() before SSL_CTX_set_{min,max}_proto_version() Net::SSLeay::CTX_set_options($ctx, $ssl_options); # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_mode.html Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() | Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() | Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation Net::SSLeay::MODE_RELEASE_BUFFERS() ); if (defined (my $str = $self->{SSL_cipherlist})) { $self->_ssl_error("SSL_CTX_set_cipher_list()") unless Net::SSLeay::CTX_set_cipher_list($ctx, $str) == 1; } if (defined (my $str = $self->{SSL_ciphersuites})) { $self->_ssl_error("SSL_CTX_set_ciphersuites()") unless Net::SSLeay::CTX_set_ciphersuites($ctx, $str) == 1; } my $vpm = Net::SSLeay::X509_VERIFY_PARAM_new() or $self->_ssl_error("X509_VERIFY_PARAM_new()"); my $purpose = Net::SSLeay::X509_PURPOSE_SSL_SERVER(); $self->_ssl_error("X509_VERIFY_PARAM_set_purpose()") unless Net::SSLeay::X509_VERIFY_PARAM_set_purpose($vpm, $purpose) == 1; $self->_ssl_error("CTX_set_purpose()") unless Net::SSLeay::CTX_set_purpose($ctx, $purpose) == 1; my $host = $self->{host} // $self->panic(); my ($hostip, $hostipfam) = _parse_hostip($host); if ($self->{SSL_verify}) { # verify certificate chain if (defined $self->{SSL_CAfile} or defined $self->{SSL_CApath}) { $self->_ssl_error("SSL_CTX_load_verify_locations()") unless Net::SSLeay::CTX_load_verify_locations($ctx, $self->{SSL_CAfile} // '', $self->{SSL_CApath} // '') == 1; } else { $self->log("Using default locations for trusted CA certificates") if $self->{debug}; $self->_ssl_error("SSL_CTX_set_default_verify_paths()") unless Net::SSLeay::CTX_set_default_verify_paths($ctx) == 1; } # verify DNS hostname or IP literal if (defined $hostipfam) { my $addr = Socket::inet_pton($hostipfam, $hostip) // $self->panic(); $self->_ssl_error("X509_VERIFY_PARAM_set1_ip()") unless Net::SSLeay::X509_VERIFY_PARAM_set1_ip($vpm, $addr) == 1; } else { $self->_ssl_error("X509_VERIFY_PARAM_set1_host()") unless Net::SSLeay::X509_VERIFY_PARAM_set1_host($vpm, $host) == 1; } } else { Net::SSLeay::CTX_set_verify_depth($ctx, 0); } Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER(), sub($$) {$self->_ssl_verify(@_)}); $self->_ssl_error("CTX_SSL_set1_param()") unless Net::SSLeay::CTX_set1_param($ctx, $vpm) == 1; my $ssl = Net::SSLeay::new($ctx) or $self->fail("SSL_new()"); $self->fail("SSL_set_fd()") unless Net::SSLeay::set_fd($ssl, fileno($socket)) == 1; # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) my $servername = $self->{SSL_hostname} // (defined $hostipfam ? "" : $host); if ($servername ne "") { $self->_ssl_error("SSL_set_tlsext_host_name($servername)") unless Net::SSLeay::set_tlsext_host_name($ssl, $servername) == 1; $self->log("Using SNI with name $servername") if $self->{debug}; } $self->_ssl_error("Can't initiate TLS/SSL handshake") unless Net::SSLeay::connect($ssl) == 1; $self->panic() unless $self->{_SSL_PEER_VERIFIED}; # sanity check $self->panic() if $self->{SSL_verify} and Net::SSLeay::get_verify_result($ssl) != Net::SSLeay::X509_V_OK(); Net::SSLeay::X509_VERIFY_PARAM_free($vpm); if ($self->{debug}) { $self->log(sprintf('SSL protocol: %s (0x%x)', , Net::SSLeay::get_version($ssl) , Net::SSLeay::version($ssl))); $self->log(sprintf('SSL cipher: %s (%d bits)' , Net::SSLeay::get_cipher($ssl) , Net::SSLeay::get_cipher_bits($ssl))); } @$self{qw/_SSL _SSL_CTX/} = ($ssl, $ctx); undef $self; # the verify callback has reference to $self, free it now } # $self->_getline([$length]) # Read a line from the handle and strip the trailing CRLF, optionally # after reading a literal of the given $length (default: 0). # In list context, return a pair ($literal, $line); otherwise only # return the $line. # /!\ Don't use this method with non-blocking IO! sub _getline($;$) { my $self = shift; my $len = shift // 0; my ($stdout, $ssl) = @$self{qw/S _SSL/}; $self->fail("Lost connection") unless $stdout->opened(); my (@lit, @line); while(1) { unless (defined $self->{_OUTBUF}) { my ($buf, $n); # nothing cached: read some more if (defined $ssl) { ($buf, $n) = Net::SSLeay::read($ssl, $BUFSIZE); } else { $n = sysread($stdout, $buf, $BUFSIZE, 0); } $self->_ssl_error("read: $!") unless defined $n; $self->_ssl_error("0 bytes read (got EOF)") unless $n > 0; # EOF $self->{_OUTRAWCOUNT} += $n; if (defined (my $i = $self->{_Z_INFLATE})) { my $r = $i->inflate($buf, $self->{_OUTBUF}); $self->panic("Inflation failed: $r ", $i->msg()) unless $r == Z_OK or $r == Z_STREAM_END; } else { $self->{_OUTBUF} = $buf; } } if ($len == 0) { # read a regular line: stop after the first \r\n if ((my $idx = 1 + index($self->{_OUTBUF}, "\n")) > 0) { # found the EOL, we're done my $lit = join '', @lit; my $line = join '', @line, substr($self->{_OUTBUF}, 0, $idx); $self->{_OUTBUF} = substr($self->{_OUTBUF}, $idx); $self->{_OUTCOUNT} += length($lit) + length($line); $line =~ s/$CRLF\z// or $self->panic($line); $self->logger('S: '.(@lit ? '[...]' : ''), $line) if $self->{debug}; return (wantarray ? (\$lit, $line) : $line); } else { push @line, $self->{_OUTBUF}; undef $self->{_OUTBUF}; } } elsif ($len > 0) { # $len bytes of literal bytes to read if ($len < length($self->{_OUTBUF})) { push @lit, substr($self->{_OUTBUF}, 0, $len, ''); $len = 0; } else { push @lit, $self->{_OUTBUF}; $len -= length($self->{_OUTBUF}); undef $self->{_OUTBUF}; } } } } # $self->_update_cache( ATTRIBUTE => VALUE, [...] ) # Update the internal cache for the currently selected mailbox with # the given attributes and values. sub _update_cache($%) { my $self = shift; $self->_update_cache_for($self->{_SELECTED}, @_); } # $self->_update_cache_for( $mailbox, ATTRIBUTE => VALUE, [...] ) # Update the internal cache for $mailbox with the given attributes and # values. sub _update_cache_for($$%) { my $self = shift; my $mailbox = shift // $self->panic(); my $cache = $self->{_CACHE}->{$mailbox} //= {}; my %status = @_; while (my ($k, $v) = each %status) { if ($k eq 'UIDVALIDITY') { # try to detect UIDVALIDITY changes early (before starting the sync) $self->fail("UIDVALIDITY changed! ($cache->{UIDVALIDITY} != $v) ". "Need to invalidate the UID cache for $mailbox.") if defined $cache->{UIDVALIDITY} and $cache->{UIDVALIDITY} != $v; $self->{_PCACHE}->{$mailbox}->{UIDVALIDITY} //= $v; } $cache->{$k} = $v; } } # $self->_updated_cache($mailbox) # Return true if there are pending updates for $mailbox, i.e., if one # of its internal cache's @attrs value differs from the persistent # cache's value. sub _updated_cache($$@) { my ($self, $mailbox, @attrs) = @_; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive my $cache = $self->{_CACHE}->{$mailbox} // return 1; my $pcache = $self->{_PCACHE}->{$mailbox} // return 1; foreach (@attrs) { return 1 unless $pcache->{$_} and defined $cache->{$_} and $pcache->{$_} == $cache->{$_}; } return 0; } # $self->_cmd_init($command) # Generate a new tag for the given $command, push both the # concatenation to the command buffer. $command can be a scalar or a # scalar reference. # Use the _cmd_extend and/or _cmd_extend_lit methods to extend the # command, and _cmd_flush to send it to the server. sub _cmd_init($$) { my $self = shift; my $tag = sprintf '%06d', $self->{_TAG}++; my $command = (defined $self->{_INBUF} ? $CRLF : '').$tag.' '.(ref $_[0] ? ${$_[0]} : $_[0]); $self->_cmd_extend(\$command); return $tag; } # $self->_cmd_extend($args) # Append $args to the command buffer. $args can be a scalar or a # scalar reference. If $args contains some literal(s) and the server # doesn't support LITERAL+, flush the command and wait for an answer # before each literal sub _cmd_extend($$) { my $self = shift; my $args = ref $_[0] ? $_[0] : \$_[0]; if ($self->{_LITPLUS} ne '') { # server supports LITERAL+: use $args as is $self->_cmd_extend_($args); } else { # server doesn't supports LITERAL+: flush the command before # each literal my ($offset, $litlen) = (0, 0); while ( (my $idx = index($$args, "\n", $offset+$litlen)) >= 0 ) { my $line = substr($$args, $offset, $idx+1-$offset); $line =~ s/\{([0-9]+)\+\}$CRLF\z/{$1}$CRLF/ or $self->panic(); $litlen = $1; $self->_cmd_flush(\$line); my $x = $self->_getline(); $x =~ /\A\+ / or $self->panic($x); $offset = $idx+1; } my $line = substr($$args, $offset); $self->_cmd_extend_(\$line); } } # $self->_cmd_extend_lit($lit) # Append the literal $lit to the command buffer. $lit must be a # scalar reference. sub _cmd_extend_lit($$) { my ($self, $lit) = @_; my $len = length($$lit); my $d = $self->{_Z_DEFLATE}; # create a full flush point for long literals, cf. RFC 4978 section 4 my $z_flush = $len > $BUFSIZE ? 1 : 0; my $strlen = "{$len$self->{_LITPLUS}}$CRLF"; if ($self->{_LITPLUS} ne '') { $self->_cmd_extend_(\$strlen); if ($z_flush and defined $d) { $d->flush(\$self->{_INBUF}, Z_FULL_FLUSH) == Z_OK or $self->panic("Can't flush deflation stream: ", $d->msg()); } } else { # server doesn't supports LITERAL+ $self->_cmd_flush(\$strlen, ($z_flush ? Z_FULL_FLUSH : ())); my $x = $self->_getline(); $x =~ /\A\+ / or $self->panic($x); } $self->_cmd_extend_($lit); if ($z_flush and defined $d) { $d->flush(\$self->{_INBUF}, Z_FULL_FLUSH) == Z_OK or $self->panic("Can't flush deflation stream: ", $d->msg()); } } # $self->_cmd_flush([$crlf], [$z_flush]) # Append $crlf (default: $CRLF) to the command buffer, flush the # deflation stream by creating a flush point of type $z_flush # (default: Z_SYNC_FLUSH) if there is a compression layer, and finally # send the command to the server. sub _cmd_flush($;$$) { my $self = shift; $self->_cmd_extend_( $_[0] // \$CRLF ); my $z_flush = $_[1] // Z_SYNC_FLUSH; # the flush point type to use my ($stdin, $ssl) = @$self{qw/S _SSL/}; if ($self->{debug}) { # remove $CRLF and literals my ($offset, $litlen) = (0, $self->{_INBUFDBGLEN} // 0); while ( (my $idx = index($self->{_INBUFDBG}, "\n", $offset+$litlen)) >= 0) { my $line = substr($self->{_INBUFDBG}, $offset+$litlen, $idx+1-$offset-$litlen); $line =~ s/$CRLF\z// or $self->panic(); $self->logger('C: ', ($litlen > 0) ? '[...]' : '', $line); $litlen = $line =~ /\{([0-9]+)(\+)?\}\z/ ? $1 : 0; $offset = $idx+1; } $self->panic() if $offset+$litlen < length($self->{_INBUFDBG}); undef $self->{_INBUFDBG}; $self->{_INBUFDBGLEN} = $litlen; } if (defined (my $d = $self->{_Z_DEFLATE})) { $d->flush(\$self->{_INBUF}, $z_flush) == Z_OK or $self->panic("Can't flush deflation stream: ", $d->msg()); } my ($offset, $length) = (0, length($self->{_INBUF})); while ($length > 0) { my $written = defined $ssl ? Net::SSLeay::write_partial($ssl, $offset, $length, $self->{_INBUF}) : syswrite($stdin, $self->{_INBUF}, $length, $offset); $self->_ssl_error("write: $!") unless defined $written and $written > 0; $offset += $written; $length -= $written; $self->{_INRAWCOUNT} += $written; } undef $self->{_INBUF}; } # $self->_cmd_extend_($args) # Append the scalar reference $args to the command buffer. Usually # one should use the higher-level method _cmd_extend as it takes care # of literals if the server doesn't support LITERAL+. sub _cmd_extend_($$) { my ($self, $args) = @_; $self->{_INCOUNT} += length($$args); # count IMAP traffic $self->{_INBUFDBG} .= $$args if $self->{debug}; if (defined (my $d = $self->{_Z_DEFLATE})) { $d->deflate($args, \$self->{_INBUF}) == Z_OK or $self->panic("Deflation failed: ", $d->msg()); } else { $self->{_INBUF} .= $$args; } } # $self->_send($command, [$callback]) # Send the given $command to the server, then wait for the response. # (The status condition and response text are respectively placed in # $IMAP_cond and $IMAP_text.) Each untagged response received in the # meantime is read, parsed and processed. The optional $callback, if # given, is executed with all untagged responses associated with the # command. # In void context, croak unless the server answers with a tagged 'OK' # response. Otherwise, return the condition status ('OK'/'NO'/'BAD'). sub _send($$;&) { my $self = shift; my $command = \$_[0]; my $callback = $_[1]; my $tag = $self->_cmd_init($command); $self->_cmd_flush(); my $cmd = $$command =~ /\AUID ($RE_ATOM_CHAR+) / ? $1 : $$command =~ /\A($RE_ATOM_CHAR+) / ? $1 : $$command; if (!defined $callback) { $self->_recv($tag, undef, $cmd); } else { my $set = $$command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1 : $$command =~ /\AUID SEARCH / ? $tag # for RFC 4466's tag-string : undef; $self->_recv($tag, $callback, $cmd, $set); } } # $self->_recv($tag, [$callback, $command, $set]) # Wait for a tagged response with the given $tag. The $callback, if # provided, is used to process each untagged response. $command and # $set can further limit the set of responses to apply the callback # to. sub _recv($$;&$$) { my ($self, $tag, $callback, $cmd, $set) = @_; my $r; # wait for the answer while (1) { my $x = $self->_getline(); if ($x =~ s/\A\Q$tag\E (OK|NO|BAD) //) { $IMAP_cond = $1; $IMAP_text = $1.' '.$x; $self->_resp_text($x); $self->fail($IMAP_text) unless defined wantarray or $IMAP_cond eq 'OK'; $r = $1; last; } else { $self->_resp($x, $callback, $cmd, $set); } } if (defined $self->{_SELECTED}) { my $mailbox = $self->{_SELECTED}; my $cache = $self->{_CACHE}->{$mailbox}; # can't keep track of the modification sequences $self->fail("Mailbox $mailbox doesn't support MODSEQ.") if $cache->{NOMODSEQ} and $self->_enabled('QRESYNC'); $self->fail("Mailbox $mailbox does not support persistent UIDs.") if defined $cache->{UIDNOTSTICKY}; } return $r; } # $self->_capable($capability, [...]) # Return true if each $capability is listed in the server's CAPABILITY # list. sub _capable($@) { my $self = shift; return 0 unless defined $self->{_CAPABILITIES}; foreach my $cap (@_) { return 0 unless grep {uc $cap eq uc $_} @{$self->{_CAPABILITIES}}; } return 1; } # $self->_capable($extension) # Return true if $extension has been enabled by the server, i.e., the # server sent an untagged ENABLED response including it. sub _enabled($$) { my $self = shift; my $ext = uc shift; grep {$ext eq uc $_} @{$self->{_ENABLED} // []}; } # $self->_open_mailbox($mailbox) # Initialize the internal and persistent caches for $mailbox, and mark # it as selected. sub _open_mailbox($$) { my $self = shift; my $mailbox = shift; # it is safe to wipe cached VANISHED responses or FLAG updates, # because interesting stuff must have made the mailbox dirty so # we'll get back to it $self->{_VANISHED} = []; $self->{_MODIFIED} = {}; $self->{_NEW} = 0; $self->{_SELECTED} = $mailbox; $self->{_CACHE}->{$mailbox} //= {}; # always reset EXISTS to keep track of new mails delete $self->{_CACHE}->{$mailbox}->{EXISTS}; } # $self->_select_or_examine($command, $mailbox, [$seqs, $UIDs]) # Issue a SELECT or EXAMINE command for the $mailbox. Upon success, # change the state to SELECTED, otherwise go back to AUTH. # The optional $seqs and $UIDs are used as Message Sequence Match # Data for the QRESYNC parameter to the $command. sub _select_or_examine($$$;$$) { my $self = shift; my $command = shift; my $mailbox = shift; my ($seqs, $uids) = @_; $mailbox = uc $mailbox eq 'INBOX' ? 'INBOX' : $mailbox; # INBOX is case-insensitive my $pcache = $self->{_PCACHE}->{$mailbox} //= {}; my $cache = $self->{_CACHE}->{$mailbox} //= {}; $cache->{UIDVALIDITY} = $pcache->{UIDVALIDITY} if defined $pcache->{UIDVALIDITY}; $command .= ' '.quote($mailbox); if ($self->_enabled('QRESYNC') and ($pcache->{HIGHESTMODSEQ} // 0) > 0 and ($pcache->{UIDNEXT} // 1) > 1) { $command .= " (QRESYNC ($pcache->{UIDVALIDITY} $pcache->{HIGHESTMODSEQ} " ."1:".($pcache->{UIDNEXT}-1); $command .= " ($seqs $uids)" if defined $seqs and defined $uids; $command .= "))"; } if ($self->{_STATE} eq 'SELECTED' and ($self->_capable('CONDSTORE') or $self->_capable('QRESYNC'))) { # A mailbox is currently selected and the server advertises # 'CONDSTORE' or 'QRESYNC' (RFC 7162). Delay the mailbox # selection until the [CLOSED] response code has been received: # all responses before the [CLOSED] response code refer to the # previous mailbox ($self->{_SELECTED}), while all subsequent # responses refer to the new mailbox $self->{_SELECTED_DELAYED}. $self->{_SELECTED_DELAYED} = $mailbox; } else { $self->_open_mailbox($mailbox); } $self->{_STATE} = 'AUTH'; $self->_send($command); $self->{_STATE} = 'SELECTED'; } sub _kibi($) { my $n = shift; if ($n < 1024) { $n; } elsif ($n < 1048576) { sprintf '%.2fK', $n / 1024.; } elsif ($n < 1073741824) { sprintf '%.2fM', $n / 1048576.; } else { sprintf '%.2fG', $n / 1073741824.; } } ############################################################################# # Parsing methods # # Parse an RFC 3501 (+extensions) resp-text, and update the cache when needed. sub _resp_text($$) { my $self = shift; local $_ = shift; if (/\A\[ALERT\] $RE_TEXT_CHAR+\z/) { $self->log($_); } elsif (/\A\[BADCHARSET .*\] $RE_TEXT_CHAR+\z/) { $self->fail($_); } elsif (/\A\[CAPABILITY((?: $RE_ATOM_CHAR+)+)\] $RE_TEXT_CHAR+\z/) { $self->{_CAPABILITIES} = [ split / /, ($1 =~ s/^ //r) ]; $self->{_LITPLUS} = (grep { uc $_ eq 'LITERAL+' } @{$self->{_CAPABILITIES}}) ? '+' : ''; } elsif (/\A\[PERMANENTFLAGS \(((?:(?:\\?$RE_ATOM_CHAR+|\\\*)(?: (?:\\?$RE_ATOM_CHAR+|\\\*))*))\)\] $RE_TEXT_CHAR+\z/) { $self->_update_cache( PERMANENTFLAGS => [ split / /, $1 ] ); } elsif (/\A\[(READ-ONLY|READ-WRITE)\] $RE_TEXT_CHAR+\z/) { $self->_update_cache($1 => 1); } elsif (/\A\[(UIDNEXT|UIDVALIDITY|UNSEEN) ([0-9]+)\] $RE_TEXT_CHAR+\z/) { $self->_update_cache($1 => $2); } elsif (/\A\[HIGHESTMODSEQ ([0-9]+)\] $RE_TEXT_CHAR+\z/) { # RFC 4551/7162 CONDSTORE/QRESYNC $self->_update_cache(HIGHESTMODSEQ => $1); } elsif (/\A\[NOMODSEQ\] $RE_TEXT_CHAR+\z/) { # RFC 4551/7162 CONDSTORE/QRESYNC $self->_update_cache(NOMODSEQ => 1); } elsif (/\A\[CLOSED\] $RE_TEXT_CHAR+\z/) { # RFC 7162 CONDSTORE/QRESYNC # Update the selected mailbox: previous responses refer to the # previous mailbox ($self->{_SELECTED}), while all subsequent # responses refer to the new mailbox $self->{_SELECTED_DELAYED}. my $mailbox = delete $self->{_SELECTED_DELAYED} // $self->panic(); $self->_open_mailbox($mailbox); } elsif (/\A\[(?:NOTIFICATIONOVERFLOW|BADEVENT .*)\] $RE_TEXT_CHAR+\z/) { # RFC 5465 NOTIFY $self->fail($_); } elsif (/\A\[UIDNOTSTICKY\] $RE_TEXT_CHAR+\z/) { # RFC 4315 UIDPLUS $self->_update_cache(UIDNOTSTICKY => 1); } } # Parse and consume an RFC 3501 nstring (string / "NIL"). sub _nstring($$) { my ($self, $stream) = @_; return $$stream =~ s/\ANIL// ? undef : $self->_string($stream); } # Parse and consume an RFC 3501 astring (1*ASTRING-CHAR / string). sub _astring($$) { my ($self, $stream) = @_; return $$stream =~ s/\A$RE_ASTRING_CHAR+//p ? ${^MATCH} : $self->_string($stream); } # Parse and consume an RFC 3501 list-mailbox (1*list-char / string). sub _list_mailbox($$) { my ($self, $stream) = @_; return $$stream =~ s/\A$RE_LIST_CHAR+//p ? ${^MATCH} : $self->_string($stream); } # Parse and consume an RFC 3501 string (quoted / literal). sub _string($$) { my ($self, $stream) = @_; if ($$stream =~ s/\A"((?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])*)"//) { # quoted my $str = $1; $str =~ s/\\([\x22\x5C])/$1/g; return $str; } elsif ($$stream =~ s/\A\{([0-9]+)\}\z//) { # literal (my $lit, $$stream) = $self->_getline($1); return $$lit; } else { $self->panic($$stream); } } # Parse and consume an RFC 3501 "(" 1*address ")" / "NIL". sub _addresses($$) { my ($self, $stream) = @_; return undef if $$stream =~ s/\ANIL//; my @addresses; $$stream =~ s/\A\(// or $self->panic($$stream); while ($$stream =~ s/\A ?\(//) { my @addr; push @addr, $self->_nstring($stream); # addr-name $$stream =~ s/\A // or $self->panic($$stream); push @addr, $self->_nstring($stream); # addr-adl $$stream =~ s/\A // or $self->panic($$stream); push @addr, $self->_nstring($stream); # addr-mailbox $$stream =~ s/\A // or $self->panic($$stream); push @addr, $self->_nstring($stream); # addr-host $$stream =~ s/\A\)// or $self->panic($$stream); push @addresses, \@addr; } $$stream =~ s/\A\)// or $self->panic($$stream); return \@addresses; } # Parse and consume an RFC 3501 envelope sub _envelope($$) { my ($self, $stream) = @_; $$stream =~ s/\A\(// or $self->panic($$stream); my @envelope; push @envelope, $self->_nstring($stream); # env-date $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_nstring($stream); # env-subject $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_addresses($stream); # env-from $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_addresses($stream); # env-sender $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_addresses($stream); # env-reply-to $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_addresses($stream); # env-to $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_addresses($stream); # env-cc $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_addresses($stream); # env-bcc $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_nstring($stream); # env-in-reply-to $$stream =~ s/\A // or $self->panic($$stream); push @envelope, $self->_nstring($stream); # env-message-id $$stream =~ s/\A\)// or $self->panic($$stream); return \@envelope; } # Parse and consume an RFC 4466 tagged-ext-comp plus a trailing parenthesis sub _tagged_ext_comp($$$) { my ($self, $stream, $ret) = @_; my $v = $$stream =~ s/\A\(// ? $self->_tagged_ext_comp(\$_, []) : $self->_astring(\$_); push @$ret, $v; if ($$stream =~ s/\A\)//) { return $ret; } elsif ($$stream =~ s/\A //) { $self->_tagged_ext_comp(\$_, $ret) } else { $self->panic($$stream); } } # $self->_resp($buf, [$callback, $cmd, $set] ) # Parse an untagged response line or a continuation request line. # (The trailing CRLF must be removed.) The internal cache is # automatically updated when needed. # If a command and callback are given, the callback is be executed # for each (parsed) responses associated with the command. sub _resp($$;&$$) { my $self = shift; local $_ = shift; my $callback = shift; my $cmd = shift; my $set = shift; my $cache = $self->{_CACHE}->{$self->{_SELECTED}} if defined $self->{_SELECTED}; if (s/\A\* //) { if (s/\ABYE //) { undef $self; } elsif (s/\A(?:OK|NO|BAD) //) { $self->_resp_text($_); $callback->($self->{_SELECTED}) if defined $self->{_SELECTED} and defined $callback and $cmd eq 'slurp'; } elsif (/\ACAPABILITY((?: $RE_ATOM_CHAR+)+)\z/) { $self->{_CAPABILITIES} = [ split / /, ($1 =~ s/^ //r) ]; } elsif (/\AFLAGS \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\)\z/) { $cache->{FLAGS} = [ split / /, $1 ]; } elsif (/\A([0-9]+) RECENT\z/) { $cache->{RECENT} = $1; } elsif (/\A([0-9]+) EXISTS\z/) { # /!\ $cache->{EXISTS} MUST NOT be defined on SELECT if (defined $cache->{EXISTS}) { $self->panic("Unexpected EXISTS shrink $1 < $cache->{EXISTS}!") if $1 < $cache->{EXISTS}; $self->{_NEW} += $1 - $cache->{EXISTS} if $1 > $cache->{EXISTS}; # new mails } $cache->{EXISTS} = $1; $callback->($self->{_SELECTED} // $self->panic(), EXISTS => $1) if defined $callback and $cmd eq 'slurp'; } elsif (/\A([0-9]+) EXPUNGE\z/) { $self->panic() unless defined $cache->{EXISTS}; # sanity check # /!\ No bookkeeping since there is no internal cache mapping sequence numbers to UIDs if ($self->_enabled('QRESYNC')) { $self->panic("$1 <= $cache->{EXISTS}") if $1 <= $cache->{EXISTS}; # sanity check $self->fail("RFC 7162 violation! Got an EXPUNGE response with QRESYNC enabled."); } # the new message was expunged before it was synced $self->{_NEW} = 0 if $self->{_NEW} == 1 and $cache->{EXISTS} == $1; $cache->{EXISTS}--; # explicit EXISTS responses are optional } elsif (/\ASEARCH((?: [0-9]+)*)\z/) { $callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH'; } elsif (s/\AESEARCH( |\z)/$1/) { my $tag = $1 if s/\A \(TAG \"($RE_ASTRING_CHAR+)\"\)//; my $uid = s/\A UID// ? "UID" : undef; my @ret; while ($_ ne '') { # RFC 4466 "tagged-ext-label" is a valid RFC 3501 "atom" s/\A ($RE_ATOM_CHAR+) // or $self->panic(); my $label = uc($1); my $value; if (s/\A([0-9,:]+)//) { # RFC 4466 tagged-ext-simple $value = $1; } elsif (s/\A\(//) { # RFC 4466 "(" [tagged-ext-comp] ")" $value = s/\A\)// ? [] : $self->_tagged_ext_comp(\$_, []); } else { $self->panic(); } # don't use a hash since some extensions might give more # than one response for a same key push @ret, $label => $value; } $callback->($uid, @ret) if defined $callback and $cmd eq 'SEARCH' and defined $set and $set eq $tag; } elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) { my ($delim, $attrs) = ($2, $1); my @attrs = defined $attrs ? split(/ /, $attrs) : (); my $mailbox = $self->_list_mailbox(\$_); $self->panic($_) unless $_ eq ''; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; $self->panic($_) if defined $delim and $delim !~ s/\A"\\?(.)"\z/$1/; $self->_update_cache_for($mailbox, DELIMITER => $delim); $self->_update_cache_for($mailbox, LIST_ATTRIBUTES => \@attrs); $callback->($mailbox, $delim, @attrs) if defined $callback and $cmd eq 'LIST'; } elsif (s/\ASTATUS //) { my $mailbox = $self->_astring(\$_); /\A \((\\?$RE_ATOM_CHAR+ [0-9]+(?: \\?$RE_ATOM_CHAR+ [0-9]+)*)?\)\z/ or $self->panic($_); my %status = split / /, $1; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive $self->panic("RFC 5465 violation! Missing HIGHESTMODSEQ data item in STATUS response") if $self->_enabled('QRESYNC') and !defined $status{HIGHESTMODSEQ} and defined $cmd and ($cmd eq 'NOTIFY' or $cmd eq 'slurp'); $self->_update_cache_for($mailbox, %status); if (defined $callback) { if ($cmd eq 'STATUS') { $callback->($mailbox, %status); } elsif ($cmd eq 'slurp') { $callback->($mailbox); } } } elsif (s/\A([0-9]+) FETCH \(//) { $cache->{EXISTS} = $1 if $1 > $cache->{EXISTS}; my ($seq, $first) = ($1, 1); my %mail; while ($_ ne ')') { unless (defined $first) { s/\A // or $self->panic($_); } if (s/\AUID ([0-9]+)//) { # always present, cf RFC 3501 section 6.4.8 $mail{UID} = $1; # the actual UIDNEXT is *at least* that $cache->{UIDNEXT} = $1+1 if !defined $cache->{UIDNEXT} or $cache->{UIDNEXT} <= $1; } if (s/\AMODSEQ \(([0-9]+)\)//) { # RFC 4551/7162 CONDSTORE/QRESYNC # always present in unsolicited FETCH responses if QRESYNC has been enabled $mail{MODSEQ} = $1; $cache->{HIGHESTMODSEQ} = $1 if !defined $cache->{HIGHESTMODSEQ} or $cache->{HIGHESTMODSEQ} < $1; } elsif (s/\AENVELOPE //) { $mail{ENVELOPE} = $self->_envelope(\$_); } elsif (s/\AINTERNALDATE "([^"]+)"//) { $mail{INTERNALDATE} = $1; } elsif (s/\A(?:RFC822|BODY\[\]) //) { $mail{RFC822} = \$self->_nstring(\$_); } elsif (s/\AFLAGS \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\)//) { $mail{FLAGS} = defined $1 ? [ split / /, $1 ] : []; } undef $first; } $self->panic() unless defined $mail{MODSEQ} or !$self->_enabled('QRESYNC'); # sanity check my $uid = $mail{UID}; if (!exists $mail{RFC822} and !exists $mail{ENVELOPE} and # ignore new mails defined $uid and # /!\ ignore unsolicited FETCH responses without UID, cf RFC 7162 section 3.2.4 (!exists $self->{_MODIFIED}->{$uid} or $self->{_MODIFIED}->{$uid}->[0] < $mail{MODSEQ} or ($self->{_MODIFIED}->{$uid}->[0] == $mail{MODSEQ} and !defined $self->{_MODIFIED}->{$uid}->[1]))) { my $flags = join ' ', sort(grep {lc $_ ne '\recent'} @{$mail{FLAGS}}) if defined $mail{FLAGS}; $self->{_MODIFIED}->{$uid} = [ $mail{MODSEQ}, $flags ]; } if (defined $callback) { if ($cmd eq 'FETCH' or $cmd eq 'STORE') { $callback->(\%mail) if defined $uid and in_set($uid, $set); } elsif ($cmd eq 'slurp') { $callback->($self->{_SELECTED} // $self->panic(), FETCH => $seq) } } } elsif (/\AENABLED((?: $RE_ATOM_CHAR+)+)\z/) { # RFC 5161 ENABLE $self->{_ENABLED} //= []; push @{$self->{_ENABLED}}, split(/ /, ($1 =~ s/^ //r)); } elsif (/\AVANISHED( \(EARLIER\))? ([0-9,:]+)\z/) { # RFC 7162 QRESYNC my $earlier = defined $1 ? 1 : 0; my $set = $2; my $mailbox = $self->{_SELECTED} // $self->panic(); my $pcache = $self->{_PCACHE}->{$mailbox}; foreach (split /,/, $set) { if (/\A([0-9]+)\z/) { $cache->{EXISTS}-- unless $earlier; # explicit EXISTS responses are optional $cache->{UIDNEXT} = $1+1 if $cache->{UIDNEXT} <= $1; # the actual UIDNEXT is *at least* that push @{$self->{_VANISHED}}, $1; } elsif (/\A([0-9]+):([0-9]+)\z/) { my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1); $cache->{EXISTS} -= $max-$min+1 unless $earlier; # explicit EXISTS responses are optional $cache->{UIDNEXT} = $max+1 if $cache->{UIDNEXT} <= $max; # the actual UIDNEXT is *at least* that push @{$self->{_VANISHED}}, ($min .. $max); } } $callback->($self->{_SELECTED} // $self->panic()) if defined $callback and $cmd eq 'slurp'; } } elsif (s/\A\+// and ($_ eq '' or s/\A //)) { # Microsoft Exchange Server 2010 violates RFC 3501 by skipping the trailing ' ' for empty resp-text if (defined $callback and $cmd eq 'AUTHENTICATE') { my $x = $callback->($_); $self->_cmd_extend(\$x); $self->_cmd_flush(); } } else { $self->panic("Unexpected response: ", $_); } } ############################################################################# return 1; interimap-0.5.8/pandoc2man.jq000077500000000000000000000010501500320172000160570ustar00rootroot00000000000000#!/usr/bin/jq -f def fixheaders: if .t == "Header" then .c[2][] |= (if .t == "Str" then .c |= ascii_upcase else . end) else . end; def fixlinks: if type == "object" then if .t == "Link" then if .c[2][0][0:7] == "mailto:" then . else .c[1][] end else map_values(fixlinks) end else if type == "array" then map(fixlinks) else . end end; { "pandoc-api-version" , meta , blocks: .blocks | map(fixheaders | fixlinks) } interimap-0.5.8/pullimap000077500000000000000000000331641500320172000152620ustar00rootroot00000000000000#!/usr/bin/perl -T #---------------------------------------------------------------------- # Pull mails from an IMAP mailbox and deliver them to an SMTP session # Copyright © 2016-2022 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . #---------------------------------------------------------------------- use v5.20.2; use strict; use warnings; our $VERSION = '0.5.8'; my $NAME = 'pullimap'; use Errno 'EINTR'; use Fcntl qw/O_CREAT O_RDWR O_DSYNC F_SETLK F_WRLCK SEEK_SET F_GETFD F_SETFD FD_CLOEXEC/; use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/; use List::Util 'first'; use Socket qw/PF_INET PF_INET6 SOCK_STREAM IPPROTO_TCP/; use lib "./lib"; use Net::IMAP::InterIMAP 0.5.8 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; delete @ENV{qw/IFS CDPATH ENV BASH_ENV/}; my %CONFIG; sub usage(;$) { my $rv = shift // 0; if ($rv) { print STDERR "Usage: $NAME [OPTIONS] SECTION\n" ."Try '$NAME --help' or consult the manpage for more information.\n"; } else { print STDERR "Usage: $NAME [OPTIONS] SECTION\n" ."Consult the manpage for more information.\n"; } exit $rv; } usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug+ help|h idle:i no-delivery/); usage(0) if $CONFIG{help}; usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_'; ####################################################################### # Read and validate configuration # my $CONF = do { my $conffile = delete($CONFIG{config}) // "config"; $conffile = xdg_basedir( XDG_CONFIG_HOME => ".config", $NAME, $conffile ); read_config( $conffile , [$ARGV[0]] , statefile => qr/\A(\P{Control}+)\z/ , mailbox => qr/\A([\x01-\x7F]+)\z/ , 'deliver-method' => qr/\A([ls]mtp:\[.*\]:\d+)\z/ , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/ , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/ , 'purge-after' => qr/\A(\d*)\z/ )->{$ARGV[0]}; }; my ($MAILBOX, $STATE); do { $MAILBOX = $CONF->{mailbox} // 'INBOX'; my $statefile = $CONF->{statefile} // $ARGV[0]; die "Missing option statefile" unless defined $statefile; $statefile = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $statefile ); my $mode = O_RDWR | O_DSYNC; # don't auto-create in long-lived mode $mode |= O_CREAT unless defined $CONFIG{idle}; sysopen($STATE, $statefile, $mode, 0600) or die "Can't open $statefile: $!"; # XXX we need to pack the struct flock manually: not portable! my $struct_flock = pack('s!s!l!l!i!', F_WRLCK, SEEK_SET, 0, 0, 0); fcntl($STATE, F_SETLK, $struct_flock) or die "Can't lock $statefile: $!"; my $flags = fcntl($STATE, F_GETFD, 0) or die "fcntl F_GETFD: $!"; fcntl($STATE, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!"; # We have no version number in the statefile, but if we ever need a # migration, we'll add a 1-byte header for the version number, and # assume version 1.0 if the size of the file is a multiple of 4 # bytes. (We can also use the fact that bytes 5 to 8 are never all 0.) }; ####################################################################### # Read a UID (32-bits integer) from the statefile, or undef if we're at # the end of the statefile sub readUID() { my $n = sysread($STATE, my $buf, 4) // die "read: $!"; return if $n == 0; # EOF # file length is a multiple of 4 bytes, and we always read 4 bytes at a time die "Corrupted state file!" if $n != 4; unpack('N', $buf); } # Write a UID (32-bits integer) to the statefile sub writeUID($) { my $uid = pack('N', shift); my $offset = 0; for ( my $offset = 0 ; $offset < 4 ; $offset += syswrite($STATE, $uid, 4-$offset, $offset) // die "write: $!" ) {} # no need to sync (or flush) since $STATE is opened with O_DSYNC } ####################################################################### # SMTP/LMTP part # my ($SMTP, $SMTP_PIPELINING); sub sendmail($$) { my ($from, $rfc822) = @_; unless (defined $SMTP) { # TODO we need to be able to reconnect when the server closes # the connection due to a timeout (RFC 5321 section 4.5.3.2) my ($fam, $addr) = (PF_INET, $CONF->{'deliver-method'} // 'smtp:[127.0.0.1]:25'); $addr =~ s/^([ls]mtp):// or die; my $ehlo = $1 eq 'lmtp' ? 'LHLO' : $1 eq 'smtp' ? 'EHLO' : die; $ehlo .= ' '. ($CONF->{'deliver-ehlo'} // 'localhost.localdomain'); my $port = $addr =~ s/:(\d+)$// ? $1 : die; $addr =~ s/^\[(.*)\]$/$1/ or die; $fam = PF_INET6 if $addr =~ /:/; $addr = Socket::inet_pton($fam, $addr) // die "Invalid address $addr\n"; my $sockaddr = $fam == PF_INET ? Socket::pack_sockaddr_in($port, $addr) : $fam == PF_INET6 ? Socket::pack_sockaddr_in6($port, $addr) : die; socket($SMTP, $fam, SOCK_STREAM, IPPROTO_TCP) or die "socket: $!"; until (connect($SMTP, $sockaddr)) { next if $! == EINTR; # try again if connect(2) was interrupted by a signal die "connect: $!"; } binmode($SMTP) // die "binmode: $!"; smtp_resp('220'); my @r = smtp_send($ehlo => '250'); $SMTP_PIPELINING = grep {$_ eq 'PIPELINING'} @r; # SMTP pipelining (RFC 2920) } my $rcpt = $CONF->{'deliver-rcpt'} // getpwuid($>) // die; # return codes are from RFC 5321 section 4.3.2 smtp_send( "MAIL FROM:<$from>" => '250' , "RCPT TO:<$rcpt>" => '250' , "DATA" => '354' ); print STDERR "C: [...]\n" if $CONFIG{debug}; if (!defined $$rfc822 or $$rfc822 eq "") { # RFC 5321 section 4.1.1.4: if there was no mail data, the first # "\r\n" ends the DATA command itself $SMTP->printflush("\r\n.\r\n") or die; } else { my $offset = 0; my $length = length($$rfc822); while ((my $end = index($$rfc822, "\r\n", $offset) + 2) != 1) { my $line = substr($$rfc822, $offset, $end-$offset); # RFC 5321 sec. 4.5.2: if the line starts with a dot, double it $line = ".".$line if substr($line, 0, 1) eq "."; $SMTP->print($line) or die; $offset = $end; } if ($offset < $length) { # the last line did not end with "\r\n"; add it in order to # have the receiving SMTP server recognize the "end of data" # condition. See RFC 5321 sec. 4.1.1.4 my $line = substr($$rfc822, $offset); $line = ".".$line if substr($line, 0, 1) eq "."; $SMTP->print($line, "\r\n") or die; } $SMTP->printflush(".\r\n") or die; } smtp_resp('250'); } sub smtp_resp($) { my $code = shift; my @resp; while(1) { local $_ = $SMTP->getline() // die; s/\r\n\z// or die "Invalid SMTP reply: $_"; print STDERR "S: $_\n" if $CONFIG{debug}; s/\A\Q$code\E([ -])// or die "SMTP error: Expected $code, got: $_\n"; push @resp, $_; return @resp if $1 eq ' '; } } sub smtp_send(@) { my (@cmd, @code, @r); while (@_) { push @cmd, shift // die; push @code, shift // die; } if ($SMTP_PIPELINING) { # SMTP pipelining (RFC 2920) print STDERR (map {"C: $_\n"} @cmd) if $CONFIG{debug}; $SMTP->printflush(map {"$_\r\n"} @cmd) or die; @r = smtp_resp($_) foreach @code; } else { foreach (@cmd) { print STDERR "C: $_\n" if $CONFIG{debug}; $SMTP->printflush("$_\r\n") or die; @r = smtp_resp(shift(@code)); } } return @r; } ####################################################################### # Initialize the cache from the statefile, then pull new messages from # the remote mailbox # my $IMAP = do { my %config = (%$CONF, %CONFIG{qw/quiet debug/}, name => $ARGV[0]); $config{keepalive} = 1 if defined $CONFIG{idle}; $config{'logger-prefix'} = "%?n?%?m?%n(%m)&%n?: ?"; delete $config{mailbox}; # use SELECTed mailbox in log messages Net::IMAP::InterIMAP::->new( %config ); }; # Remove messages with UID < UIDNEXT and INTERNALDATE at most # $CONF->{'purge-after'} days ago. my $LAST_PURGED; sub purge() { my $days = $CONF->{'purge-after'} // return; my ($uidnext) = $IMAP->get_cache('UIDNEXT'); return unless $days ne '' and 1<$uidnext; my $set = "1:".($uidnext-1); unless ($days == 0) { my $now = time; return if defined $LAST_PURGED and $now - $LAST_PURGED < 43200; # purge every 12h $LAST_PURGED = $now; my @now = gmtime($now - $days*86400); my @m = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; # RFC 3501's date-month my $date = sprintf("%02d-%s-%04d", $now[3], $m[$now[4]], $now[5]+1900); my $ext = $IMAP->incapable('ESEARCH') ? undef : [qw/COUNT ALL/]; my @uid = $IMAP->search((defined $ext ? "RETURN (".join(' ', @$ext).') ' : '') ."UID $set BEFORE $date"); my $count; if (defined $ext) { my ($uid_indicator, %resp) = @uid; $IMAP->panic() unless defined $uid_indicator and $uid_indicator = 'UID'; $count = $resp{COUNT} // $IMAP->panic(); $set = $resp{ALL}; # MUST NOT be present if there are no matches } else { $count = $#uid+1; $set = $count == 0 ? undef : compact_set(@uid); } $IMAP->log("Removing $count UID(s) $set") if $count > 0 and !$CONFIG{quiet}; } if (defined $set) { $IMAP->silent_store($set, '+', '\Deleted'); $IMAP->expunge($set); } # pull messages that have been received in the meantime pull() if $IMAP->has_new_mails($MAILBOX); } # Use BODY.PEEK[] so if something gets wrong, unpulled messages # won't be marked as \Seen in the mailbox my $ATTRS = "ENVELOPE INTERNALDATE"; $ATTRS .= " BODY.PEEK[]" unless $CONFIG{'no-delivery'}; my $RE_ATOM = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2F-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]+/; my $DOT_STRING = qr/\A$RE_ATOM(?:\.$RE_ATOM)*\z/; sub pull_callback($$) { my ($uids, $mail) = @_; return unless exists $mail->{RFC822} or $CONFIG{'no-delivery'}; # not for us my $uid = $mail->{UID}; my $e = $mail->{ENVELOPE}->[3]; my $sender = ''; if (defined $e and defined (my $l = $e->[0]->[2]) and defined (my $d = $e->[0]->[3])) { if ($l =~ $DOT_STRING) { $sender = $l.'@'.$d; } elsif ($l =~ /\A[\x20-\x7E]*\z/) { # quote the local part if not Dot-string (RFC 5321) $l =~ s/([\x22\x5C])/\\$1/g; # escape double-quote and backslash $sender = '"'.$l.'"@'.$d; } } $IMAP->log("UID $uid from <$sender> ($mail->{INTERNALDATE})") unless $CONFIG{quiet}; sendmail($sender, $mail->{RFC822}) unless $CONFIG{'no-delivery'}; push @$uids, $uid; writeUID($uid); } # Pull new messages from IMAP and deliver them to SMTP, then update the # statefile sub pull(;$) { my $ignore = shift // []; my @uid; my $callback = sub($) { pull_callback(\@uid, shift) }; do { # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids) in the statefile $IMAP->pull_new_messages($ATTRS, $callback, @$ignore); # now that everything has been deliverd, mark @ignore and @uid as \Seen $IMAP->silent_store(compact_set(@$ignore, @uid), '+', '\Seen') if @$ignore or @uid; } # repeat if we got a message in the meantime while ($IMAP->has_new_mails($MAILBOX)); # terminate the SMTP transmission channel gracefully, cf RFC 5321 section 4.5.3.2 smtp_send('QUIT' => '221') if defined $SMTP; undef $SMTP; # update the statefile my $p = sysseek($STATE, 4, SEEK_SET) // die "seek: $!"; die "Couldn't seek to 4" unless $p == 4; # safety check my ($uidnext) = $IMAP->get_cache('UIDNEXT'); writeUID($uidnext); truncate($STATE, 8) // die "truncate: $!"; } do { my $uidvalidity = readUID(); my $uidnext = readUID(); my $ignore = []; $IMAP->set_cache($MAILBOX, UIDVALIDITY => $uidvalidity, UIDNEXT => $uidnext); $IMAP->select($MAILBOX); unless (defined $uidvalidity) { ($uidvalidity) = $IMAP->get_cache('UIDVALIDITY'); # we were at pos 0 before the write, at pos 4 afterwards writeUID($uidvalidity); die if defined $uidnext; # sanity check } if (!defined $uidnext) { # we were at pos 4 before the write, at pos 8 afterwards writeUID(1); } else { # put the remaining UIDs in the @ignore list: these messages # have already been delivered, but the process exited before the # statefile was updated while (defined (my $uid = readUID())) { push @$ignore, $uid; } } pull($ignore); purge(); }; unless (defined $CONFIG{idle}) { $IMAP->logout(); exit 0; } $CONFIG{idle} = 1740 if defined $CONFIG{idle} and $CONFIG{idle} == 0; # 29 mins while(1) { pull() if $IMAP->idle($CONFIG{idle}, \&Net::IMAP::InterIMAP::has_new_mails); purge(); } interimap-0.5.8/pullimap.sample000066400000000000000000000012511500320172000165270ustar00rootroot00000000000000mailbox = INBOX deliver-method = smtp:[127.0.0.1]:25 #deliver-method = smtp:[127.0.0.1]:10024 purge-after = 90 # SSL options #SSL_verify = YES #SSL_protocol_min = TLSv1.2 [private] #type = imaps host = imap.private.org #port = 993 #proxy = socks5h://localhost:9050 username = guilhem password = xxxxxxxxxxxxxxxx #compress = YES #SSL_fingerprint = sha256$d9915f4ad35b76d9eb40f34abd5e8f61edfaad3bf20d5336dc28efa8cc3921ad [work] #type = imaps host = imap.work.com #port = 993 #proxy = socks5h://localhost:9050 username = guilhem password = xxxxxxxxxxxxxxxx #compress = YES #SSL_fingerprint = sha256$3956fd56921c02aeaffe4f8f576e802ee99ab5a096064f4fe7e6a0ad7b4b8a6e # vim:ft=dosini interimap-0.5.8/pullimap@.service000066400000000000000000000005521500320172000170110ustar00rootroot00000000000000[Unit] Description=Pull mails from an IMAP mailbox and deliver them to an SMTP session (instance %i) Documentation=man:pullimap(1) Documentation=https://guilhem.org/interimap/pullimap.1.html Wants=network-online.target After=network-online.target [Service] ExecStart=@bindir@/pullimap --idle %i RestartSec=2min Restart=always [Install] WantedBy=default.target interimap-0.5.8/tests/000077500000000000000000000000001500320172000146445ustar00rootroot00000000000000interimap-0.5.8/tests/auth-login/000077500000000000000000000000001500320172000167135ustar00rootroot00000000000000interimap-0.5.8/tests/auth-login/interimap.remote000066400000000000000000000001051500320172000221140ustar00rootroot00000000000000type = imap host = localhost port = 10143 STARTTLS = NO auth = login interimap-0.5.8/tests/auth-login/remote.conf000066400000000000000000000000711500320172000210530ustar00rootroot00000000000000!include conf.d/imapd.conf auth_mechanisms = plain login interimap-0.5.8/tests/auth-login/t000066400000000000000000000005011500320172000170750ustar00rootroot00000000000000for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done # check that credentials aren't leaked to the debug output interimap --debug || error grep -Fx "remote: C: xxx LOGIN [REDACTED]" <"$STDERR" || error check_mailbox_status "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/auth-logindisabled/000077500000000000000000000000001500320172000204035ustar00rootroot00000000000000interimap-0.5.8/tests/auth-logindisabled/interimap.remote000077700000000000000000000000001500320172000322252../auth-sasl-plain/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/auth-logindisabled/remote.conf000066400000000000000000000002021500320172000225370ustar00rootroot00000000000000!include conf.d/imapd.conf # trick dovecot into treating local connections as insecure imap_capability { LOGINDISABLED = yes } interimap-0.5.8/tests/auth-logindisabled/t000066400000000000000000000014231500320172000205710ustar00rootroot00000000000000! interimap --debug || error # double check the presence of 'LOGINDISABLED' in the preauth capability list grep -oE -m1 '^remote: S: \* OK \[CAPABILITY IMAP4rev1( [^]]*)? AUTH=[^]]*\]' <"$STDERR" >"$TMPDIR/capability" sed -ri 's/^remote: S: \* OK \[CAPABILITY (.*)\]$/\1/' "$TMPDIR/capability" tr " " "\\n" <"$TMPDIR/capability" >"$TMPDIR/capabilities" grep -Fx "IMAP4rev1" <"$TMPDIR/capabilities" || error grep -Fx "LOGINDISABLED" <"$TMPDIR/capabilities" || error ! grep -Fx "STARTTLS" <"$TMPDIR/capabilities" || error # otherwise we'd try to upgrade the connectionn # make sure we didn't send any credentials grep -Fx "remote: ERROR: Logins are disabled." <"$STDERR" || error ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/auth-noplaintext/000077500000000000000000000000001500320172000201505ustar00rootroot00000000000000interimap-0.5.8/tests/auth-noplaintext/interimap.remote000066400000000000000000000000521500320172000233520ustar00rootroot00000000000000type = imap host = localhost port = 10143 interimap-0.5.8/tests/auth-noplaintext/remote.conf000077700000000000000000000000001500320172000276642../auth-sasl-plain/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/auth-noplaintext/t000066400000000000000000000013161500320172000203370ustar00rootroot00000000000000! interimap --debug || error # double check the presence of 'STARTTLS' in the preauth capability list grep -oE -m1 '^remote: S: \* OK \[CAPABILITY IMAP4rev1( [^]]*)? AUTH=[^]]*\]' <"$STDERR" >"$TMPDIR/capability" sed -ri 's/^remote: S: \* OK \[CAPABILITY (.*)\]$/\1/' "$TMPDIR/capability" tr " " "\\n" <"$TMPDIR/capability" >"$TMPDIR/capabilities" grep -Fx "IMAP4rev1" <"$TMPDIR/capabilities" || error ! grep -Fx "STARTTLS" <"$TMPDIR/capabilities" || error # make sure we didn't send any credentials grep -Fx "remote: ERROR: Server did not advertise STARTTLS capability." <"$STDERR" || error ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/auth-sasl-plain-no-ir/000077500000000000000000000000001500320172000206705ustar00rootroot00000000000000interimap-0.5.8/tests/auth-sasl-plain-no-ir/interimap.remote000077700000000000000000000000001500320172000325122../auth-sasl-plain/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/auth-sasl-plain-no-ir/remote.conf000066400000000000000000000001201500320172000230230ustar00rootroot00000000000000!include conf.d/imapd.conf !include conf.d/interimap-required-capabilities.conf interimap-0.5.8/tests/auth-sasl-plain-no-ir/t000066400000000000000000000017711500320172000210640ustar00rootroot00000000000000n=1 # at least one message to send remotely sample_message | deliver -u "local" for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" [ "$u" = "remote" ] || n=$(( n+1 )) sample_message | deliver -u "$u" done # check that credentials aren't leaked to the debug output interimap --debug || error grep -Fx "remote: C: xxx AUTHENTICATE PLAIN [REDACTED]" <"$STDERR" || error # make sure we didn't use SASL-IR grep -oE -m1 '^remote: S: \* OK \[CAPABILITY IMAP4rev1( [^]]*)? AUTH=[^]]*\]' <"$STDERR" >"$TMPDIR/capability" sed -ri 's/^remote: S: \* OK \[CAPABILITY (.*)\]$/\1/' "$TMPDIR/capability" tr " " "\\n" <"$TMPDIR/capability" >"$TMPDIR/capabilities" grep -Fx "IMAP4rev1" <"$TMPDIR/capabilities" || error ! grep -Fx "SASL-IR" <"$TMPDIR/capabilities" || error # make sure all literals were synchronizing (and that we didn't use MULTIAPPEND) xcgrep "$n" -E "^remote(\(INBOX\))?: C: [0-9]+ APPEND INBOX .* \{[0-9]+\}$" <"$STDERR" check_mailbox_status "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/auth-sasl-plain/000077500000000000000000000000001500320172000176465ustar00rootroot00000000000000interimap-0.5.8/tests/auth-sasl-plain/interimap.remote000066400000000000000000000000701500320172000230500ustar00rootroot00000000000000type = imap host = localhost port = 10143 STARTTLS = NO interimap-0.5.8/tests/auth-sasl-plain/remote.conf000066400000000000000000000000331500320172000220040ustar00rootroot00000000000000!include conf.d/imapd.conf interimap-0.5.8/tests/auth-sasl-plain/t000066400000000000000000000005161500320172000200360ustar00rootroot00000000000000for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done # check that credentials aren't leaked to the debug output interimap --debug || error grep -Fx "remote: C: xxx AUTHENTICATE PLAIN [REDACTED]" <"$STDERR" || error check_mailbox_status "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/certs/000077500000000000000000000000001500320172000157645ustar00rootroot00000000000000interimap-0.5.8/tests/certs/.gitignore000066400000000000000000000000401500320172000177460ustar00rootroot00000000000000!/generate /*.key /*.crt /*.pem interimap-0.5.8/tests/certs/generate000077500000000000000000000034651500320172000175140ustar00rootroot00000000000000#!/bin/sh set -ue PATH="/usr/bin:/bin" export PATH BASEDIR="$(dirname -- "$0")" OU="InterIMAP test suite" cd "$BASEDIR" OPENSSL_CONF="./openssl.cnf" export OPENSSL_CONF cadir="$(mktemp --tmpdir --directory)" trap 'rm -rf -- "$cadir"' EXIT INT TERM genpkey() { local key="$1" shift openssl genpkey -out "$key" "$@" 2>&1 } # generate CA (we intentionally throw away the private key and serial # file to avoid reuse) genpkey "$cadir/ca.key" -algorithm RSA openssl req -new -x509 -rand /dev/urandom \ -subj "/OU=$OU/CN=Fake Root CA" \ -addext subjectKeyIdentifier="hash" \ -addext authorityKeyIdentifier="keyid:always,issuer" \ -addext basicConstraints="critical,CA:TRUE" \ -key "$cadir/ca.key" -out ./ca.crt SERIAL=1 new() { local key="$1" cn="$2" openssl req -new -rand /dev/urandom -key "$key" \ -subj "/OU=$OU/CN=$cn" ${3+-addext subjectAltName="$3"} \ -out "$cadir/new.csr" cat >"$cadir/new-ext.cnf" <<-EOF basicConstraints = critical, CA:FALSE keyUsage = critical, digitalSignature, keyEncipherment extendedKeyUsage = critical, serverAuth EOF if [ -n "${3+x}" ]; then printf "subjectAltName = %s\\n" "$3" >>"$cadir/new-ext.cnf" fi openssl x509 -req -in "$cadir/new.csr" -CA ./ca.crt -CAkey "$cadir/ca.key" \ -CAserial "$cadir/ca.srl" -CAcreateserial -extfile "$cadir/new-ext.cnf" 2>&1 } genpkey ./dovecot.rsa.key -algorithm RSA new ./dovecot.rsa.key "localhost" "DNS:localhost,DNS:ip6-localhost,IP:127.0.0.1,IP:::1" >./dovecot.rsa.crt genpkey ./dovecot.ecdsa.key -algorithm EC -pkeyopt ec_paramgen_curve:P-256 -pkeyopt ec_param_enc:named_curve new ./dovecot.ecdsa.key "localhost" >./dovecot.ecdsa.crt genpkey ./dovecot.rsa2.key -algorithm RSA new ./dovecot.rsa2.key "imap.example.net" "DNS:imap.example.net,DNS:localhost" >./dovecot.rsa2.crt interimap-0.5.8/tests/certs/openssl.cnf000066400000000000000000000001201500320172000201300ustar00rootroot00000000000000[ req ] distinguished_name = req_distinguished_name [ req_distinguished_name ] interimap-0.5.8/tests/compress/000077500000000000000000000000001500320172000164775ustar00rootroot00000000000000interimap-0.5.8/tests/compress/interimap.remote000077700000000000000000000000001500320172000303212../auth-sasl-plain/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/compress/remote.conf000077700000000000000000000000001500320172000262132../auth-sasl-plain/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/compress/t000066400000000000000000000010311500320172000166600ustar00rootroot00000000000000for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done # compression enabled by default interimap --debug || error grep -Fx "remote: C: 000001 COMPRESS DEFLATE" <"$STDERR" || error grep -E "^remote: S: 000001 OK( |$)" <"$STDERR" || error check_mailbox_status "INBOX" # can be disabled echo "compress = no" >>"$XDG_CONFIG_HOME/interimap/config" interimap --debug || error ! grep -E "^remote: C: [^[:blank:]]+ COMPRESS DEFLATE$" <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/condstore/000077500000000000000000000000001500320172000166445ustar00rootroot00000000000000interimap-0.5.8/tests/condstore/t000066400000000000000000000032161500320172000170340ustar00rootroot00000000000000TIMEOUT=60 N=4096 # test CONDSTORE/QRESYNC (behavior) in UID STORE commands, in particular # the UNCHANGEDSINCE test: populate, keep assiging keywords at random, # and make sure interimap is able to reconciliate the changes # populate (with dummy messages to speed things up) only one server # before initializing interimap, so UIDs concide with sequence numbers # and are identical on both servers for ((i = 0; i < N; i++)); do deliver -u "local" <<< . done interimap_init # assign a set of 16 tags; not more because in order to maximize the # likelyhood of conflicts we want UID STORE commands to use large sets declare -a FLAGS=(0 1 2 3 4 5 6 7 8 9 a b c d e f) # start a long-lived interimap process interimap --watch=1 & PID=$! trap "ptree_abort $PID" EXIT INT TERM timer=$(( $(date +%s) + TIMEOUT )) while [ $(date +%s) -le $timer ]; do a="$(shuf -n1 -e "add" "remove" "replace")" u="$(shuf -n1 -e "local" "remote")" f="$(shuf -n1 -e "${FLAGS[@]}")" seqs="$(shuf -n$((N/8)) -i1-$N)" # trigger changes on 1/8 of all messages doveadm -u "$u" flags "$a" --no-userdb-lookup "$f" mailbox "INBOX" "${seqs//$'\n'/,}" sleep "0.0$(shuf -n1 -i10-99)" # 10 to 99ms done sleep 5 ptree_abort $PID trap - EXIT INT TERM # make sure the list of uids for a given tag match flagged_uids() { local u="$1" f="$2" doveadm -u "$u" search --no-userdb-lookup mailbox "INBOX" keyword "$f" | cut -d" " -f2 | sort -n } for f in "${FLAGS[@]}"; do diff --label="local/$f" --label="remote/$f" -u -- \ <(flagged_uids "local" "$f") <(flagged_uids "remote" "$f") || error "UID list differs for keyword '$f'" done # vim: set filetype=bash : interimap-0.5.8/tests/config/000077500000000000000000000000001500320172000161115ustar00rootroot00000000000000interimap-0.5.8/tests/config/dovecot/000077500000000000000000000000001500320172000175545ustar00rootroot00000000000000interimap-0.5.8/tests/config/dovecot/dhparams.pem000066400000000000000000000006501500320172000220570ustar00rootroot00000000000000-----BEGIN DH PARAMETERS----- MIIBCAKCAQEA0J1dU8erRgIk4bMCBMLezjx32pcQpXrdNgl04dxZVxnJ5Ik2gGhA uQRbbZhAlHNHtFtp9s4TdQ3Ddrv9SuWXYul8U5BWbcxs4nOtwFU8912SfiuVr/kc 4ok2zQ1hdMODtaqWS2ZKBmwcuk4QM6e7fMEAkuZX+Dtf2u8bG5G9B7OL5LggYtrP cFVNQDtfhs64D+sUKJLWkgeg5NH6nbf+0Gs5a8v3/urHKvoxdVScGmKzF+LsFsBm ycQjYeVtA9gLr41mo80rrFysUQqZtNkbdkaXOIA2r9JGTYex1l/XaediR8J94ck9 dwAe2ubRqWcPjmoLJYQIPKiCbvXuJAd0wwIBAg== -----END DH PARAMETERS----- interimap-0.5.8/tests/config/dovecot/imapd.conf000066400000000000000000000004071500320172000215160ustar00rootroot00000000000000protocols { imap = yes } service imap-login { inet_listener imap { port = 10143 } inet_listener imaps { port = 10993 ssl = yes } } # we should avoid sending command lines that are too long imap_max_line_length = 8192 interimap-0.5.8/tests/config/dovecot/interimap-required-capabilities.conf000066400000000000000000000003311500320172000266550ustar00rootroot00000000000000# strict minimum of IMAP capabilities required for interimap to work # (in particular, no LITERAL+, MULTIAPPEND, COMPRESS=DEFLATE, SASL-IR) imap_capability = IMAP4rev1 ENABLE UIDPLUS LIST-EXTENDED QRESYNC LIST-STATUS interimap-0.5.8/tests/config/dovecot/lmtpd.conf000066400000000000000000000001431500320172000215410ustar00rootroot00000000000000protocols { lmtp = yes } service lmtp { inet_listener lmtp { port = 10024 } } interimap-0.5.8/tests/config/dovecot/ssl.conf000066400000000000000000000002761500320172000212310ustar00rootroot00000000000000ssl = required ssl_server_cert_file = dovecot.rsa.crt ssl_server_key_file = dovecot.rsa.key ssl_server_dh_file = dhparams.pem ssl_min_protocol = TLSv1.2 ssl_cipher_list = DEFAULT@SECLEVEL=2 interimap-0.5.8/tests/db-exclusive-lock/000077500000000000000000000000001500320172000201645ustar00rootroot00000000000000interimap-0.5.8/tests/db-exclusive-lock/t000066400000000000000000000007441500320172000203570ustar00rootroot00000000000000interimap_init # start a background process interimap --watch=60 & trap "ptree_abort $!" EXIT INT TERM # wait a short while so we have time to lock the database (ugly and racy...) sleep .5 # subsequent runs fail as we can't acquire the exclusive lock ! interimap || error grep -Ex "DBD::SQLite::db do failed: database is locked at (\S+/)?interimap line 181\." <"$STDERR" \ || error "Is \$DBH->do(\"PRAGMA locking_mode = EXCLUSIVE\"); at line 181?" # vim: set filetype=bash : interimap-0.5.8/tests/db-migration-0-1-foreign-key-violation/000077500000000000000000000000001500320172000237325ustar00rootroot00000000000000interimap-0.5.8/tests/db-migration-0-1-foreign-key-violation/t000066400000000000000000000015071500320172000241230ustar00rootroot00000000000000interimap_init grep -Fx "database: Created mailbox INBOX" <"$STDERR" || error "INBOX missing from DB" # empty table `mailboxes` and revert its schema to version 0 sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <<-EOF PRAGMA foreign_keys = OFF; PRAGMA user_version = 0; DROP TABLE mailboxes; CREATE TABLE mailboxes ( idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, mailbox TEXT NOT NULL CHECK (mailbox != '') UNIQUE, subscribed BOOLEAN NOT NULL ); EOF # now migration must fail due to broken referential integrity ! interimap || error grep -Fx "Upgrading database version from 0" <"$STDERR" || error "DB upgrade not attempted" grep -Fx "database: ERROR: Broken referential integrity! Refusing to commit changes." <"$STDERR" || error "DB upgrade successful despite broken refint" # vim: set filetype=bash : interimap-0.5.8/tests/db-no-create--watch/000077500000000000000000000000001500320172000202655ustar00rootroot00000000000000interimap-0.5.8/tests/db-no-create--watch/t000066400000000000000000000003531500320172000204540ustar00rootroot00000000000000! interimap --watch=60 || error grep -Ex "DBI connect\(.*\) failed: unable to open database file at (\S+/)?interimap line 177\." <"$STDERR" || error test \! -e "$XDG_DATA_HOME/interimap/remote.db" || error # vim: set filetype=bash : interimap-0.5.8/tests/db-upgrade-0-1-delim-mismatch/000077500000000000000000000000001500320172000220445ustar00rootroot00000000000000interimap-0.5.8/tests/db-upgrade-0-1-delim-mismatch/before.sql000077700000000000000000000000001500320172000305252../db-upgrade-0-1/before.sqlustar00rootroot00000000000000interimap-0.5.8/tests/db-upgrade-0-1-delim-mismatch/local.conf000066400000000000000000000000511500320172000240010ustar00rootroot00000000000000namespace inbox { separator = "\"" } interimap-0.5.8/tests/db-upgrade-0-1-delim-mismatch/remote.conf000066400000000000000000000000461500320172000242060ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/db-upgrade-0-1-delim-mismatch/t000066400000000000000000000005211500320172000222300ustar00rootroot00000000000000# import an existing non-migrated database sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <"$TESTDIR/before.sql" || error "Couldn't import DB" ! interimap || error grep -Fx 'ERROR: Local and remote hierachy delimiters differ (local "\"", remote "^"), refusing to update table `mailboxes`.' <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/db-upgrade-0-1/000077500000000000000000000000001500320172000171515ustar00rootroot00000000000000interimap-0.5.8/tests/db-upgrade-0-1/after.sql000066400000000000000000000023761500320172000210030ustar00rootroot00000000000000PRAGMA foreign_keys=OFF; BEGIN TRANSACTION; CREATE TABLE local (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); CREATE TABLE remote (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); CREATE TABLE mapping (idx INTEGER NOT NULL REFERENCES mailboxes(idx), lUID UNSIGNED INT NOT NULL CHECK (lUID > 0), rUID UNSIGNED INT NOT NULL CHECK (rUID > 0), PRIMARY KEY (idx,lUID), UNIQUE (idx,rUID)); CREATE TABLE IF NOT EXISTS "mailboxes" (idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, mailbox BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE, subscribed BOOLEAN NOT NULL); INSERT INTO mailboxes VALUES(1,X'61006231006332',0); INSERT INTO mailboxes VALUES(2,X'61006231006331',0); INSERT INTO mailboxes VALUES(3,X'494e424f58',0); INSERT INTO mailboxes VALUES(4,X'6132',0); INSERT INTO mailboxes VALUES(5,X'610062320063',0); DELETE FROM sqlite_sequence; INSERT INTO sqlite_sequence VALUES('mailboxes',5); COMMIT; interimap-0.5.8/tests/db-upgrade-0-1/before.sql000066400000000000000000000023021500320172000211310ustar00rootroot00000000000000PRAGMA foreign_keys=OFF; BEGIN TRANSACTION; CREATE TABLE mailboxes (idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, mailbox TEXT NOT NULL CHECK (mailbox != '') UNIQUE, subscribed BOOLEAN NOT NULL); INSERT INTO mailboxes VALUES(1,'a.b1.c2',0); INSERT INTO mailboxes VALUES(2,'a.b1.c1',0); INSERT INTO mailboxes VALUES(3,'INBOX',0); INSERT INTO mailboxes VALUES(4,'a2',0); INSERT INTO mailboxes VALUES(5,'a.b2.c',0); CREATE TABLE local (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); CREATE TABLE remote (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); CREATE TABLE mapping (idx INTEGER NOT NULL REFERENCES mailboxes(idx), lUID UNSIGNED INT NOT NULL CHECK (lUID > 0), rUID UNSIGNED INT NOT NULL CHECK (rUID > 0), PRIMARY KEY (idx,lUID), UNIQUE (idx,rUID)); DELETE FROM sqlite_sequence; INSERT INTO sqlite_sequence VALUES('mailboxes',5); COMMIT; interimap-0.5.8/tests/db-upgrade-0-1/local.conf000066400000000000000000000000461500320172000211120ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/db-upgrade-0-1/remote.conf000077700000000000000000000000001500320172000232472local.confustar00rootroot00000000000000interimap-0.5.8/tests/db-upgrade-0-1/t000066400000000000000000000024231500320172000173400ustar00rootroot00000000000000# create the mailboxes from the database doveadm -u "local" mailbox create --no-userdb-lookup "a.b1.c1" "a.b1.c2" "a.b2.c" "a2" doveadm -u "remote" mailbox create --no-userdb-lookup "a.b1.c1" "a.b1.c2" "a.b2.c" "a2" # import an existing non-migrated database sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <"$TESTDIR/before.sql" || error "Couldn't import DB" # migrate interimap || error "Couldn't upgrade DB" grep -Fx "Upgrading database version from 0" <"$STDERR" || error "Couldn't upgrade DB" check_mailboxes_status "a.b1.c1" "a.b1.c2" "a.b2.c" "a2" # verify that the new schema is as expected sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF DELETE FROM local; DELETE FROM remote; .dump EOF # re-import and dump the expected dump to work around SQLite format # differences across versions sqlite3 "$XDG_DATA_HOME/interimap/remote2.db" <"$TESTDIR/after.sql" sqlite3 "$XDG_DATA_HOME/interimap/remote2.db" >"$TMPDIR/dump-expected.sql" <<-EOF .dump EOF # XXX need 'user_version' PRAGMA in the dump for future migrations # http://sqlite.1065341.n5.nabble.com/dump-command-and-user-version-td101228.html diff -u --label="a/dump.sql" --label="b/dump.sql" \ "$TMPDIR/dump-expected.sql" "$TMPDIR/dump.sql" \ || error "DB dumps differ" # vim: set filetype=bash : interimap-0.5.8/tests/delete/000077500000000000000000000000001500320172000161065ustar00rootroot00000000000000interimap-0.5.8/tests/delete/local.conf000066400000000000000000000000461500320172000200470ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/delete/remote.conf000066400000000000000000000000461500320172000202500ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/delete/t000066400000000000000000000060461500320172000163020ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "foo.bar" "foo.bar.baz" for m in "foo.bar" "foo.bar.baz" "INBOX"; do sample_message | deliver -u "local" -- -m "$m" done interimap_init check_mailbox_list check_mailboxes_status "foo.bar" "foo.bar.baz" "INBOX" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF .dump EOF step_start "nonexistent source (no-op)" interimap --target="local,remote" --target="database" --delete "nonexistent" || error check_mailbox_list check_mailboxes_status "foo.bar" "foo.bar.baz" "INBOX" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF .dump EOF diff -u --label="a/dump.sql" --label="b/dump.sql" \ "$TMPDIR/dump.sql" "$TMPDIR/dump2.sql" || error "SQL dumps differ" step_done # foo.bar will become \NoSelect in local, per RFC 3501: "It is permitted # to delete a name that has inferior hierarchical names and does not # have the \Noselect mailbox name attribute. In this case, all messages # in that mailbox are removed, and the name will acquire the \Noselect # mailbox name attribute." step_start "mailbox with inferiors" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.sql" <<-EOF SELECT idx, mailbox FROM mailboxes WHERE mailbox != x'$(printf "%s\\0%s" "foo" "bar" | xxd -ps)' ORDER BY idx EOF interimap --target="local" --delete "foo.bar" check_mailbox_list check_mailboxes_status "foo.bar.baz" "INBOX" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF .dump EOF diff -u --label="a/dump.sql" --label="b/dump.sql" \ "$TMPDIR/dump.sql" "$TMPDIR/dump2.sql" || error "SQL dumps differ" ! doveadm -u "local" mailbox status --no-userdb-lookup uidvalidity "foo.bar" # gone doveadm -u "remote" mailbox status --no-userdb-lookup uidvalidity "foo^bar" # now delete from the remote server and the database interimap --delete "foo.bar" ! doveadm -u "local" mailbox status --no-userdb-lookup uidvalidity "foo.bar" ! doveadm -u "remote" mailbox status --no-userdb-lookup uidvalidity "foo^bar" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.sql" <<-EOF SELECT idx, mailbox FROM mailboxes ORDER BY idx EOF diff -u --label="a/mailboxes.sql" --label="b/mailboxes.sql" \ "$TMPDIR/mailboxes.sql" "$TMPDIR/mailboxes2.sql" || error "SQL dumps differ" check_mailbox_list check_mailboxes_status "foo.bar.baz" "INBOX" step_done step_start "INBOX (fail)" ! interimap --delete "InBoX" || error "deleted INBOX" grep -Fx "ERROR: INBOX can't be deleted" <"$STDERR" || error check_mailbox_list check_mailboxes_status "foo.bar.baz" "INBOX" step_done step_start "\\Noinferiors mailbox" interimap --delete "foo.bar.baz" ! doveadm -u "local" mailbox status --no-userdb-lookup uidvalidity "foo.bar.baz" ! doveadm -u "remote" mailbox status --no-userdb-lookup uidvalidity "foo^bar^baz" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF SELECT COUNT(*) FROM mailboxes EOF [ "$(< "$TMPDIR/count" )" -eq 1 ] || error "Not only INBOX left?" check_mailbox_list check_mailboxes_status "INBOX" step_done # vim: set filetype=bash : interimap-0.5.8/tests/delimiter-change/000077500000000000000000000000001500320172000200455ustar00rootroot00000000000000interimap-0.5.8/tests/delimiter-change/local.conf000077700000000000000000000000001500320172000265612../list-mailbox/local.confustar00rootroot00000000000000interimap-0.5.8/tests/delimiter-change/remote.conf000077700000000000000000000000001500320172000271632../list-mailbox/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/delimiter-change/t000066400000000000000000000026451500320172000202420ustar00rootroot00000000000000# create and populate some mailboxes doveadm -u "local" mailbox create --no-userdb-lookup -- "foo" "foo.bar" "baz" run() { local i m u s1="$1" s2="$2" m2 for ((i = 0; i < 16; i++)); do m="$(shuf -n1 -e -- "foo" "foo${s1}bar" "baz" "INBOX")" u="$(shuf -n1 -e -- "local" "remote")" [ "$u" = "local" ] && m2="$m" || m2="${m//"$s1"/$s2}" sample_message | deliver -u "$u" -- -m "$m2" done interimap --debug grep -Fxq "local: Using \"$s1\" as hierarchy delimiter" <"$STDERR" || error grep -Fxq "remote: Using \"$s2\" as hierarchy delimiter" <"$STDERR" || error check_mailbox_list "foo" "foo${s1}bar" "baz" "INBOX" check_mailboxes_status "foo" "foo${s1}bar" "baz" "INBOX" || error } run "." "?" # make sure interimap doesn't choke when the hierarchy delimiter changes # cf. https://www.imapwiki.org/ClientImplementation/MailboxList#Hierarchy_separators sed -ri "s,^(\\s*separator\\s*)=.*,separator = /," "$HOME_remote/.dovecot/config" run "." "/" sed -ri "s,^(\\s*separator\\s*)=.*,separator = /," "$HOME_local/.dovecot/config" run "/" "/" sed -ri "s,^(\\s*separator\\s*)=.*,separator = .," "$HOME_local/.dovecot/config" sed -ri "s,^(\\s*separator\\s*)=.*,separator = .," "$HOME_remote/.dovecot/config" run "." "." # ensure there were no duplicates n="$(doveadm -u "local" search --no-userdb-lookup all | wc -l)" [ "$n" -eq 64 ] || error "$n != 64" # vim: set filetype=bash : interimap-0.5.8/tests/ignore-mailbox/000077500000000000000000000000001500320172000175605ustar00rootroot00000000000000interimap-0.5.8/tests/ignore-mailbox/interimap.conf000066400000000000000000000000441500320172000224150ustar00rootroot00000000000000ignore-mailbox = ^virtual(?:\x00|$) interimap-0.5.8/tests/ignore-mailbox/local.conf000066400000000000000000000000461500320172000215210ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/ignore-mailbox/remote.conf000066400000000000000000000000461500320172000217220ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/ignore-mailbox/t000066400000000000000000000044641500320172000177560ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "foo" -- "-virtual" doveadm -u "remote" mailbox create --no-userdb-lookup "bar" -- "virtual-" interimap_init check_mailbox_list sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.sql" <<-EOF SELECT idx, mailbox FROM mailboxes ORDER BY idx EOF for ((i = 0; i < 16; i++)); do u="$(shuf -n1 -e "local" "remote")" # choose target at random m="$(shuf -n1 -e -- "INBOX" "foo" "bar")" sample_message | deliver -u "$u" -- -m "$m" done # create new mailboxes matching 'ignore-mailbox' doveadm -u "local" mailbox create --no-userdb-lookup "virtual" "virtual.foo" doveadm -u "remote" mailbox create --no-userdb-lookup "virtual^bar" for n in $(seq 1 "$(shuf -n1 -i1-8)"); do sample_message | deliver -u "local" -- -m "virtual" sample_message | deliver -u "local" -- -m "virtual.foo" done for n in $(seq 1 "$(shuf -n1 -i1-8)"); do sample_message | deliver -u "remote" -- -m "virtual^bar" done # no new mailbox should be created interimap || error sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.sql" <<-EOF SELECT idx, mailbox FROM mailboxes ORDER BY idx EOF diff -u --label="a/mailboxes.sql" --label="b/mailboxes.sql" \ "$TMPDIR/mailboxes.sql" "$TMPDIR/mailboxes2.sql" || error "SQL dumps differ" check_mailboxes_status "INBOX" "foo" "bar" # double check the unsubscribed mailboxes weren't copied ! doveadm -u "remote" mailbox status uidvalidity "virtual" || error ! doveadm -u "remote" mailbox status uidvalidity "virtual^foo" || error ! doveadm -u "local" mailbox status uidvalidity "virtual.bar" || error # ignored mailboxes are created when passed to the command line interimap "virtual" "virtual.bar" || error grep -Fx "database: Created mailbox virtual" <"$STDERR" || error grep -Fx "database: Created mailbox virtual.bar" <"$STDERR" || error grep -Fx "local: Created mailbox virtual.bar" <"$STDERR" || error grep -Fx "remote: Created mailbox virtual" <"$STDERR" || error sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.sql" <<-EOF SELECT idx, mailbox FROM mailboxes WHERE mailbox != x'$(printf "virtual" | xxd -ps)' AND mailbox != x'$(printf "%s\\0%s" "virtual" "foo" | xxd -ps)' ORDER BY idx EOF check_mailboxes_status "virtual" "virtual.bar" || error # vim: set filetype=bash : interimap-0.5.8/tests/interimap.list000066400000000000000000000050071500320172000175330ustar00rootroot00000000000000db-no-create--watch `interimap --watch` refuses to create the database db-exclusive-lock mutually exclusive DB access . DB schema upgrade (v0 -> v1) db-upgrade-0-1 migrate # may happen if the server(s) software or its configuration changed db-upgrade-0-1-delim-mismatch abort on hierarchy delimiter mismatch # foreign key checking was broken until v0.5 db-migration-0-1-foreign-key-violation abort on foreign key contraint violation . Mailbox deletion ... delete . Mailbox renaming rename-exists-db abort if target exists in the DB rename-exists-local abort if target exists locally rename-exists-remote abort if target exists remotely ... rename-simple ... rename-inferiors # try values beyond the signed integer limit largeint Large UIDVALIDITY/UIDNEXT/HIGHESTMODSEQ values . Mailbox synchronization ... sync-mailbox-list list-reference list-reference list-mailbox list-mailbox = foo "foo bar" "f\\\"o\x21o.*" "f\0o\0o" list-select-opts list-select-opts = SUBSCRIBED ignore-mailbox ignore-mailbox = ^virtual(?:\x00|$) delimiter-change doesn't choke on delimiter change resume Resume when aborted repair --repair . Authentication auth-sasl-plain AUTHENTICATE (SASL PLAIN) auth-sasl-plain-no-ir AUTHENTICATE (SASL PLAIN, no SASL-IR) auth-login LOGIN auth-logindisabled LOGINDISABLED auth-noplaintext abort when STARTTLS is not offered preauth-plaintext abort on MiTM via PREAUTH greeting compress COMPRESS=DEFLATE condstore CONDSTORE split-set Split large sets to avoid extra-long command lines . SSL/TLS starttls-logindisabled LOGINDISABLED STARTTLS starttls STARTTLS starttls-injection STARTTLS response injection tls SSL/TLS handshake ... tls-verify-peer tls-pin-fingerprint pubkey fingerprint pinning tls-rsa+ecdsa pubkey fingerprint pinning for dual-cert RSA+ECDSA tls-sni TLS servername extension (SNI) tls-protocols force TLS protocol versions tls-ciphers force TLS cipher list/suites . Live synchronization (60s) sync-live local/remote simulation sync-live-crippled local/remote simulation (crippled remote) sync-live-tls local/remote simulation (TLS remote) sync-live-multi local/remote1+remote2+remote3 simulation (3 local namespaces) interimap-0.5.8/tests/largeint/000077500000000000000000000000001500320172000164515ustar00rootroot00000000000000interimap-0.5.8/tests/largeint/t000066400000000000000000000047251500320172000166470ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "foo" "bar" "baz" doveadm -u "remote" mailbox create --no-userdb-lookup "foo" "bar" "baz" doveadm -u "local" mailbox update --no-userdb-lookup --uid-validity 1 "INBOX" doveadm -u "local" mailbox update --no-userdb-lookup --uid-validity 2147483647 "foo" # 2^31-1 doveadm -u "local" mailbox update --no-userdb-lookup --uid-validity 2147483648 "bar" # 2^31 doveadm -u "local" mailbox update --no-userdb-lookup --uid-validity 4294967295 "baz" # 2^32-1 doveadm -u "remote" mailbox update --no-userdb-lookup --uid-validity 4294967295 "INBOX" # 2^32-1 doveadm -u "remote" mailbox update --no-userdb-lookup --uid-validity 2147483648 "foo" # 2^31 doveadm -u "remote" mailbox update --no-userdb-lookup --uid-validity 2147483647 "bar" # 2^31-1 doveadm -u "remote" mailbox update --no-userdb-lookup --uid-validity 1 "baz" # run() { local u m i for ((i = 0; i < 64; i++)); do u="$(shuf -n1 -e "local" "remote")" # choose target at random m="$(shuf -n1 -e -- "INBOX" "foo" "bar" "baz")" sample_message | deliver -u "$u" -- -m "$m" done interimap || error check_mailbox_list check_mailbox_status "INBOX" "foo" "bar" "baz" } run # raise UIDNEXT AND HIGHESTMODSEQ close to the max values (resp. 2^32-1 och 2^63-1) # XXX as of dovecot 2.4 --min-highest-modseq rejects values higher than INT64_MAX instead of UINT64_MAX, # cf. str_parse_int64() doveadm -u "local" mailbox update --no-userdb-lookup --min-next-uid 2147483647 --min-highest-modseq 9223372036854775807 "INBOX" # 2^31-1, 2^63-1 doveadm -u "local" mailbox update --no-userdb-lookup --min-next-uid 2147483647 --min-highest-modseq 9223372036854775807 "foo" # 2^31-1, 2^63-1 doveadm -u "local" mailbox update --no-userdb-lookup --min-next-uid 2147483648 --min-highest-modseq 9223372036854775807 "bar" # 2^31, 2^63-1 doveadm -u "local" mailbox update --no-userdb-lookup --min-next-uid 2147483648 --min-highest-modseq 9223372036854775807 "baz" # 2^31, 2^63-1 doveadm -u "remote" mailbox update --no-userdb-lookup --min-next-uid 4294967168 --min-highest-modseq 9223372036854775807 "INBOX" # 2^32-128, 2^63-1 doveadm -u "remote" mailbox update --no-userdb-lookup --min-next-uid 2147483776 --min-highest-modseq 9223372036854775807 "foo" # 2^31+128, 2^63-1 doveadm -u "remote" mailbox update --no-userdb-lookup --min-next-uid 2147483648 --min-highest-modseq 9223372036854775807 "bar" # 2^31, 2^63-1 run # vim: set filetype=bash : interimap-0.5.8/tests/list-mailbox/000077500000000000000000000000001500320172000172505ustar00rootroot00000000000000interimap-0.5.8/tests/list-mailbox/interimap.conf000066400000000000000000000000671500320172000221120ustar00rootroot00000000000000list-mailbox = foo "foo bar" "f\\\"o\x21o.*" "f\0o\0o" interimap-0.5.8/tests/list-mailbox/local.conf000066400000000000000000000000461500320172000212110ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/list-mailbox/remote.conf000066400000000000000000000000461500320172000214120ustar00rootroot00000000000000namespace inbox { separator = ? } interimap-0.5.8/tests/list-mailbox/t000066400000000000000000000042221500320172000174360ustar00rootroot00000000000000# create and populate some mailboxes locally declare -a MAILBOXES=( "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" ) doveadm -u "local" mailbox create --no-userdb-lookup -- "${MAILBOXES[@]}" "foobad" "baz" "INBOX" for ((i = 0; i < 32; i++)); do m="$(shuf -n1 -e -- "${MAILBOXES[@]}" "foobad" "baz" "INBOX")" sample_message | deliver -u "local" -- -m "$m" done interimap_init for m in "${MAILBOXES[@]}"; do grep -Fx "remote: Created mailbox ${m//./?}" <"$STDERR" || error "${m//./?}" grep -Fx "database: Created mailbox $m" <"$STDERR" || error done # also check inferiors in the list, but exclude "foobad" and "baz" check_mailbox_list "${MAILBOXES[@]}" "INBOX" "f\\\"o!o" "f" "f.o" check_mailboxes_status "${MAILBOXES[@]}" || error # double check that "foobad" and "baz" weren't created ! doveadm -u "remote" mailbox status uidvalidity "foobad" || error ! doveadm -u "remote" mailbox status uidvalidity "baz" || error # check that "foobad" and "INBOX" aren't in the database sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF SELECT COUNT(*) FROM mailboxes WHERE mailbox = x'$(printf "%s" "foobad" | xxd -u -ps)' OR mailbox = x'$(printf "%s" "INBOX" | xxd -u -ps)' OR mailbox = x'$(printf "%s" "baz" | xxd -u -ps)' EOF [ $(< "$TMPDIR/count") -eq 0 ] || error # mailbox given on the command line overrides list-mailbox sample_message | deliver -u "local" -- -m "foobad" sample_message | deliver -u "local" -- -m "foo" interimap "foobad" || error ! grep -F "remote(foo): Added 1 UID(s)" <"$STDERR" || error check_mailbox_list "foobad" check_mailbox_status "foobad" interimap "foo" || error grep -F "remote(foo): Added 1 UID(s)" <"$STDERR" || error check_mailbox_status "foo" ! check_mailbox_list "baz" # finally, try a bunch of invalid 'list-mailbox' values to test the parser: # empty string, missing space between values, unterminated string for v in '""' '"f o o""bar"' '"f o o" "bar" "baz\" x'; do sed -ri "s/^(list-mailbox\\s*=\\s*).*/\\1${v//\\/\\\\}/" \ "$XDG_CONFIG_HOME/interimap/config" ! interimap || error grep -xF "Invalid value for list-mailbox: $v" <"$STDERR" done # vim: set filetype=bash : interimap-0.5.8/tests/list-reference/000077500000000000000000000000001500320172000175535ustar00rootroot00000000000000interimap-0.5.8/tests/list-reference/interimap.local000066400000000000000000000000261500320172000225550ustar00rootroot00000000000000list-reference = foo/ interimap-0.5.8/tests/list-reference/interimap.remote000066400000000000000000000000261500320172000227560ustar00rootroot00000000000000list-reference = bar\ interimap-0.5.8/tests/list-reference/local.conf000066400000000000000000000000461500320172000215140ustar00rootroot00000000000000namespace inbox { separator = / } interimap-0.5.8/tests/list-reference/remote.conf000066400000000000000000000000511500320172000217110ustar00rootroot00000000000000namespace inbox { separator = "\\" } interimap-0.5.8/tests/list-reference/t000066400000000000000000000035151500320172000177450ustar00rootroot00000000000000# create and populate some mailboxes in and out the respective list references doveadm -u "local" mailbox create --no-userdb-lookup "foo" "foobar" "foo/bar/baz" "foo/baz" "bar" "bar/baz" doveadm -u "remote" mailbox create --no-userdb-lookup "foo" "foobaz" "foo\\bar" "foo\\baz" "bar\\baz" "bar\\!" populate() { local i for ((i = 0; i < 32; i++)); do m="$(shuf -n1 -e -- "foo" "foobar" "foo/bar/baz" "foo/baz" "bar" "bar/baz")" sample_message | deliver -u "local" -- -m "$m" m="$(shuf -n1 -e -- "foo" "foobaz" "foo\\bar" "foo\\baz" "bar\\baz" "bar\\!")" sample_message | deliver -u "remote" -- -m "$m" done } populate interimap_init grep -Fx "database: Created mailbox bar/baz" <"$STDERR" || error grep -Fx "database: Created mailbox baz" <"$STDERR" || error grep -Fx "database: Created mailbox !" <"$STDERR" || error grep -Fx "local: Created mailbox foo/!" <"$STDERR" || error grep -Fx "remote: Created mailbox bar\\bar\\baz" <"$STDERR" || error verify() { # check that the mailbox lists match diff -u --label="local/mailboxes" --label="remote/mailboxes" \ <( doveadm -u "local" mailbox list | sed -n 's,^foo/,,p' | sort ) \ <( doveadm -u "remote" mailbox list | sed -n 's,^bar\\,,p' | tr '\\' '/' | sort ) \ || error "mailbox lists differ" for m in "bar/baz" "baz" "!"; do blob="x'$(printf "%s" "$m" | tr "/" "\\0" | xxd -c256 -u -ps)'" check_mailbox_status2 "$blob" "foo/$m" "remote" "bar\\${m//\//\\}" done } verify # add more messages and re-check populate interimap || error verify # double check that mailboxes outside references weren't created ! doveadm -u "local" mailbox status uidvalidity "foobaz" || error ! doveadm -u "remote" mailbox status uidvalidity "foobar" || error # vim: set filetype=bash : interimap-0.5.8/tests/list-select-opts/000077500000000000000000000000001500320172000200575ustar00rootroot00000000000000interimap-0.5.8/tests/list-select-opts/interimap.conf000066400000000000000000000000361500320172000227150ustar00rootroot00000000000000list-select-opts = SUBSCRIBED interimap-0.5.8/tests/list-select-opts/local.conf000066400000000000000000000000461500320172000220200ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/list-select-opts/remote.conf000066400000000000000000000000461500320172000222210ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/list-select-opts/t000066400000000000000000000037121500320172000202500ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup -s "INBOX" "foo.bar" doveadm -u "remote" mailbox create --no-userdb-lookup -s "INBOX" "bar" interimap_init check_mailbox_list sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.sql" <<-EOF SELECT idx, mailbox FROM mailboxes ORDER BY idx EOF for ((i = 0; i < 16; i++)); do u="$(shuf -n1 -e "local" "remote")" # choose target at random m="$(shuf -n1 -e -- "INBOX" "foo.bar" "bar")" sample_message | deliver -u "$u" -- -m "$m" done # create new unsubscribed mailboxes doveadm -u "local" mailbox create --no-userdb-lookup "foo" doveadm -u "remote" mailbox create --no-userdb-lookup "baz" for ((i = 0; i < 8; i++)); do u="$(shuf -n1 -e "local" "remote")" # choose target at random [ u="local" ] && m="foo" || m="baz" sample_message | deliver -u "$u" -- -m "$m" done # no new mailbox should be created interimap || error sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.sql" <<-EOF SELECT idx, mailbox FROM mailboxes ORDER BY idx EOF diff -u --label="a/mailboxes.sql" --label="b/mailboxes.sql" \ "$TMPDIR/mailboxes.sql" "$TMPDIR/mailboxes2.sql" || error "SQL dumps differ" check_mailboxes_status "INBOX" "foo.bar" "bar" # double check the unsubscribed mailboxes weren't copied ! doveadm -u "remote" mailbox status --no-userdb-lookup uidvalidity "foo" || error ! doveadm -u "local" mailbox status --no-userdb-lookup uidvalidity "baz" || error # reconcile when subcribed doveadm -u "local" mailbox subscribe --no-userdb-lookup "foo" doveadm -u "remote" mailbox subscribe --no-userdb-lookup "baz" interimap || error grep -Fx "database: Created mailbox foo" <"$STDERR" || error grep -Fx "database: Created mailbox baz" <"$STDERR" || error grep -Fx "local: Created mailbox baz" <"$STDERR" || error grep -Fx "remote: Created mailbox foo" <"$STDERR" || error check_mailbox_list check_mailboxes_status "INBOX" "foo" "foo.bar" "bar" "baz" # vim: set filetype=bash : interimap-0.5.8/tests/preauth-plaintext/000077500000000000000000000000001500320172000203225ustar00rootroot00000000000000interimap-0.5.8/tests/preauth-plaintext/imapd000077500000000000000000000025461500320172000213510ustar00rootroot00000000000000#!/usr/bin/perl -T use warnings; use strict; use Errno qw/EINTR/; use Socket qw/INADDR_LOOPBACK AF_INET SOCK_STREAM pack_sockaddr_in SOL_SOCKET SO_REUSEADDR SHUT_RDWR/; socket(my $S, AF_INET, SOCK_STREAM, 0) or die; setsockopt($S, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die; bind($S, pack_sockaddr_in(10143, INADDR_LOOPBACK)) or die "bind: $!\n"; listen($S, 1) or die "listen: $!"; while (1) { my $sockaddr = accept(my $conn, $S) or do { next if $! == EINTR; die "accept: $!"; }; # minimum CAPABILITY list, see tests/config/dovecot/interimap-required-capabilities.conf $conn->printflush("* PREAUTH [CAPABILITY IMAP4rev1 ENABLE UIDPLUS LIST-EXTENDED QRESYNC LIST-STATUS] IMAP4rev1 Server\r\n"); my $x; $x = $conn->getline() // next; $x =~ /\A(\S+) ENABLE QRESYNC\r\n/ or die; $conn->printflush("* ENABLED QRESYNC\r\n$1 OK ENABLE completed\r\n"); $x = $conn->getline() // next; $x =~ /\A(\S+) LIST .*\r\n/ or die; $conn->print("* LIST (\\Noselect) \"~\" \"\"\r\n"); $conn->print("* LIST () \"~\" INBOX\r\n"); $conn->print("* STATUS INBOX (UIDNEXT 1 UIDVALIDITY 1 HIGHESTMODSEQ 1)\r\n"); $conn->printflush("$1 OK LIST completed\r\n"); close($conn); } END { if (defined $S) { shutdown($S, SHUT_RDWR) or warn "shutdown: $!"; close($S) or print STDERR "close: $!\n"; } } interimap-0.5.8/tests/preauth-plaintext/interimap.remote000077700000000000000000000000001500320172000310222../starttls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/preauth-plaintext/t000066400000000000000000000014631500320172000205140ustar00rootroot00000000000000# Test IMAP MiTM via PREAUTH greeting # For background see CVE-2020-12398, CVE-2020-14093 and # https://gitlab.com/muttmua/mutt/commit/3e88866dc60b5fa6aaba6fd7c1710c12c1c3cd01 env -i USER="remote" HOME="$HOME_remote" "$TESTDIR/imapd" & PID=$! trap "ptree_abort $PID" EXIT INT TERM ! interimap --debug || error grep -Fx 'remote: ERROR: PREAUTH greeting on plaintext connection? MiTM in action? Aborting, set "STARTTLS = NO" to ignore.' <"$STDERR" || error ! grep '^remote: C: ' <"$STDERR" || error "wrote command in MiTM'ed PREAUTH connection!" # Ignore the warning when STARTTLS is explicitly disabled echo "STARTTLS = NO" >>"$XDG_CONFIG_HOME/interimap/config" interimap --debug || true grep -Fx "remote: S: * STATUS INBOX (UIDNEXT 1 UIDVALIDITY 1 HIGHESTMODSEQ 1)" <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/pullimap.list000066400000000000000000000000341500320172000173610ustar00rootroot00000000000000. pullimap ... pullimap interimap-0.5.8/tests/pullimap/000077500000000000000000000000001500320172000164675ustar00rootroot00000000000000interimap-0.5.8/tests/pullimap/interimap.remote000077700000000000000000000000001500320172000261112../tls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/pullimap/local.conf000066400000000000000000000000331500320172000204240ustar00rootroot00000000000000!include conf.d/lmtpd.conf interimap-0.5.8/tests/pullimap/pullimap.conf000066400000000000000000000000501500320172000211540ustar00rootroot00000000000000deliver-method = lmtp:[127.0.0.1]:10024 interimap-0.5.8/tests/pullimap/remote.conf000077700000000000000000000000001500320172000240032../tls/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/pullimap/t000066400000000000000000000111441500320172000166560ustar00rootroot00000000000000MAILBOX="INBOX" TIMEOUT=60 N=2048 step_start "\`pullimap --idle\` refuses to create the state file" ! pullimap --idle "remote" || error step_done step_start "\`pullimap\` creates statefile with mode 0600" pullimap "remote" || error if ! st="$(stat -c"%#a" -- "$XDG_DATA_HOME/pullimap/remote")" || [ "$st" != "0600" ]; then error "$XDG_DATA_HOME/pullimap/remote has mode $st != 0600" fi step_done step_start "\`pullimap\` locks its statefile" pullimap --idle "remote" & PID=$! trap "ptree_abort $PID" EXIT INT TERM # wait a short while so we have time to lock the database (ugly and racy...) sleep .5 ! pullimap "remote" || error grep -F "Can't lock $XDG_DATA_HOME/pullimap/remote: Resource temporarily unavailable at " <"$STDERR" || error ptree_abort $PID trap - EXIT INT TERM step_done # compare mailboxes (can't compare the RFC 3501 TEXT as the LMTPd inconditionally # adds a Return-Path: header -- and also Delivered-To: and Received: to by default) list_mails_sha256() { local u="$1" guid uid local fields="body date.sent imap.bodystructure imap.envelope" while read guid uid; do doveadm -u "$u" -f "flow" fetch --no-userdb-lookup "$fields" mailbox-guid "$guid" uid "$uid" | sha256sum done < <(doveadm -u "$u" search mailbox --no-userdb-lookup "$MAILBOX") | sort -f } check() { diff -u --label="local/mails" --label="remote/mails" \ <( list_mails_sha256 "local" ) \ <( list_mails_sha256 "remote" ) \ || error "mailboxes differ" } message_from() { local date="$(date +"%s.%N")" sender="$1" cat <<-EOF From: $sender To: Date: $(date -R -d@"$date") Message-ID: <$date@example.net> EOF xxd -ps -l8 /dev/urandom } step_start "Quote envelope sender address" declare -a senders=("sender" "first.last" "foo-bar" \"\" "\"x\\\" #&\\\\y\"") for s in "${senders[@]}"; do message_from "$s@example.net" | deliver -u "remote" -- -m "$MAILBOX" done pullimap "remote" || error check for s in "${senders[@]}"; do grep -F " from <$s@example.net> " <"$STDERR" || error "$s" done step_done step_start "Mail without data" deliver -u "remote" -- -m "$MAILBOX" foo . .bar ..baz EOF # we can't add a test for message data not ending with CRLF, because the # LMTP/SMTP client needs to add a CRLF so local and remote message # bodies would differ. that said, while such a message could be added # by IMAP and LDA, it's not valid for SMTP (RFC 5321 sec. 4.1.1.4) pullimap "remote" || error check step_done # make sure remote UIDs are 11-bytes long doveadm -u "remote" mailbox update --no-userdb-lookup --min-next-uid 1000000000 "$MAILBOX" # Add some messages and sync step_start "Fetching messages" for ((i = 0; i < 32; i++)); do sample_message | deliver -u "remote" -- -m "$MAILBOX" done pullimap "remote" || error check # same thing, but with some missing messages for ((i = 0; i < N; i+=2)); do sample_message | deliver -u "remote" -- -m "$MAILBOX" deliver -u "remote" -- -m "$MAILBOX" "$TMPDIR/unseen" [ ! -s "$TMPDIR/unseen" ] || error "\\Unseen messages left" step_done if [ $TIMEOUT -gt 0 ]; then step_start "--idle (${TIMEOUT}s)" pullimap --idle "remote" & PID=$! trap "ptree_abort $PID" EXIT INT TERM timer=$(( $(date +%s) + TIMEOUT )) while [ $(date +%s) -le $timer ]; do n="$(shuf -n1 -i1-5)" for (( i=0; i < n; i++)); do sample_message | deliver -u "remote" -- -m "$MAILBOX" done s=$(shuf -n1 -i1-1500) [ $s -ge 1000 ] && s="$(printf "1.%03d" $((s-1000)))" || s="$(printf "0.%03d" $s)" sleep "$s" done sleep 5 ptree_abort $PID trap - EXIT INT TERM check step_done fi step_start "Purging" echo "purge-after = 0" >>"$XDG_CONFIG_HOME/pullimap/config" for ((i = 0; i < 32; i++)); do sample_message | deliver -u "remote" -- -m "$MAILBOX" done pullimap "remote" doveadm -u "remote" search --no-userdb-lookup mailbox "$MAILBOX" all >"$TMPDIR/messages" [ ! -s "$TMPDIR/messages" ] || error "messages left" step_done # vim: set filetype=bash : interimap-0.5.8/tests/rename-exists-db/000077500000000000000000000000001500320172000200135ustar00rootroot00000000000000interimap-0.5.8/tests/rename-exists-db/local.conf000066400000000000000000000000461500320172000217540ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/rename-exists-db/remote.conf000066400000000000000000000000511500320172000221510ustar00rootroot00000000000000namespace inbox { separator = "\\" } interimap-0.5.8/tests/rename-exists-db/t000066400000000000000000000012131500320172000201760ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "root.from" "root.from.child" "t.o" doveadm -u "remote" mailbox create --no-userdb-lookup "root\\from" "root\\from\\child" "t\\o" interimap_init check_mailbox_list # delete a mailbox on both servers but leave it in the database, then try to use it as target for --rename doveadm -u "local" mailbox delete --no-userdb-lookup "t.o" doveadm -u "remote" mailbox delete --no-userdb-lookup "t\\o" ! interimap --rename "root.from" "t.o" || error grep -Fx 'database: ERROR: Mailbox t.o exists. Run `interimap --target=database --delete t.o` to delete.' <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/rename-exists-local/000077500000000000000000000000001500320172000205205ustar00rootroot00000000000000interimap-0.5.8/tests/rename-exists-local/local.conf000066400000000000000000000000461500320172000224610ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/rename-exists-local/remote.conf000066400000000000000000000000511500320172000226560ustar00rootroot00000000000000namespace inbox { separator = "\\" } interimap-0.5.8/tests/rename-exists-local/t000066400000000000000000000010521500320172000207040ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "root.from" "root.from.child" "t.o" doveadm -u "remote" mailbox create --no-userdb-lookup "root\\from" "root\\from\\child" interimap_init check_mailbox_list # delete a mailbox on the remote server, then try to use it as target for --rename doveadm -u "remote" mailbox delete --no-userdb-lookup "t\\o" ! interimap --rename "root.from" "t.o" || error grep -Fx 'local: ERROR: Mailbox t.o exists. Run `interimap --target=local --delete t.o` to delete.' <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/rename-exists-remote/000077500000000000000000000000001500320172000207215ustar00rootroot00000000000000interimap-0.5.8/tests/rename-exists-remote/local.conf000066400000000000000000000000461500320172000226620ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/rename-exists-remote/remote.conf000066400000000000000000000000511500320172000230570ustar00rootroot00000000000000namespace inbox { separator = "\\" } interimap-0.5.8/tests/rename-exists-remote/t000066400000000000000000000010611500320172000211050ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "root.from" "root.from.child" "t.o" doveadm -u "remote" mailbox create --no-userdb-lookup "root\\from" "root\\from\\child" "t\\o" interimap_init check_mailbox_list # delete a mailbox on the local server, then try to use it as target for --rename doveadm -u "local" mailbox delete --no-userdb-lookup "t.o" ! interimap --rename "root.from" "t.o" || error grep -Fx 'remote: ERROR: Mailbox t\o exists. Run `interimap --target=remote --delete t.o` to delete.' <"$STDERR" || remote # vim: set filetype=bash : interimap-0.5.8/tests/rename-inferiors/000077500000000000000000000000001500320172000201115ustar00rootroot00000000000000interimap-0.5.8/tests/rename-inferiors/local.conf000066400000000000000000000000461500320172000220520ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/rename-inferiors/remote.conf000066400000000000000000000000461500320172000222530ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/rename-inferiors/t000066400000000000000000000074701500320172000203070ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "root.from" "root.from.child" "root.from.child2" "root.from.child.grandchild" doveadm -u "remote" mailbox create --no-userdb-lookup "root^sibbling" "root^sibbling^grandchild" "root2" for m in "root.from" "root.from.child" "root.from.child2" "root.from.child.grandchild" "INBOX"; do sample_message | deliver -u "local" -- -m "$m" done for m in "root^sibbling" "root^sibbling^grandchild" "root2" "INBOX"; do sample_message | deliver -u "remote" -- -m "$m" done interimap_init check_mailboxes_status "root.from" "root.from.child" "root.from.child2" "root.from.child.grandchild" \ "root.sibbling" "root.sibbling.grandchild" "root2" "INBOX" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.csv" <<-EOF .mode csv SELECT idx, hex(mailbox) FROM mailboxes ORDER BY idx EOF step_start "non-existent source (no-op)" interimap --rename "nonexistent" "root" || error "Renamed non-existent mailbox?" check_mailbox_list step_done step_start "\\NonExistent target (fail)" ! interimap --rename "root2" "root" || error "Didn't abort on ALREADYEXISTS" grep -E "^local: ERROR: Couldn't rename mailbox root2: NO \[ALREADYEXISTS\] " <"$STDERR" check_mailbox_list step_done # rename 'root.from' to 'from.root', including inferiors step_start "existing source with inferiors" interimap --rename "root.from" "from.root" grep -Fx 'local: Renamed mailbox root.from to from.root' <"$STDERR" grep -Fx 'remote: Renamed mailbox root^from to from^root' <"$STDERR" grep -Fx 'database: Renamed mailbox root.from to from.root' <"$STDERR" check_mailbox_list check_mailboxes_status "from.root" "from.root.child" "from.root.child2" "from.root.child.grandchild" \ "root.sibbling" "root.sibbling.grandchild" "root2" "INBOX" before="$(printf "%s\\0%s" "root" "from" | xxd -u -ps)" after="$(printf "%s\\0%s" "from" "root" | xxd -u -ps)" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.csv" <<-EOF .mode csv SELECT idx, CASE WHEN mailbox = x'$after' OR hex(mailbox) LIKE '${after}00%' THEN '$before' || SUBSTR(hex(mailbox), $((${#after}+1))) ELSE hex(mailbox) END FROM mailboxes ORDER BY idx EOF diff -u --label="a/mailboxes.csv" --label="b/mailboxes.csv" \ "$TMPDIR/mailboxes.csv" "$TMPDIR/mailboxes2.csv" \ || error "Mailbox list differs" step_done # rename \NonExistent root and check that its children move step_start "\\NonExistent source with inferiors" interimap --rename "root" "newroot" grep -Fq 'local: Renamed mailbox root to newroot' <"$STDERR" grep -Fq 'remote: Renamed mailbox root to newroot' <"$STDERR" grep -Fq 'database: Renamed mailbox root to newroot' <"$STDERR" check_mailbox_list check_mailboxes_status "from.root" "from.root.child" "from.root.child2" "from.root.child.grandchild" \ "newroot.sibbling" "newroot.sibbling.grandchild" "root2" "INBOX" before2="$(printf "%s" "root" | xxd -u -ps)" after2="$(printf "%s" "newroot" | xxd -u -ps)" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes3.csv" <<-EOF .mode csv SELECT idx, CASE WHEN mailbox = x'$after' OR hex(mailbox) LIKE '${after}00%' THEN '$before' || SUBSTR(hex(mailbox), $((${#after}+1))) WHEN hex(mailbox) LIKE '${after2}00%' THEN '$before2' || SUBSTR(hex(mailbox), $((${#after2}+1))) ELSE hex(mailbox) END FROM mailboxes ORDER BY idx EOF diff -u --label="a/mailboxes.csv" --label="b/mailboxes.csv" \ "$TMPDIR/mailboxes2.csv" "$TMPDIR/mailboxes3.csv" \ || error "Mailbox list differs" step_done interimap check_mailbox_list check_mailboxes_status "from.root" "from.root.child" "from.root.child2" "from.root.child.grandchild" \ "newroot.sibbling" "newroot.sibbling.grandchild" "root2" "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/rename-simple/000077500000000000000000000000001500320172000174025ustar00rootroot00000000000000interimap-0.5.8/tests/rename-simple/t000066400000000000000000000033341500320172000175730ustar00rootroot00000000000000doveadm -u "local" mailbox create --no-userdb-lookup "foo" sample_message | deliver -u "local" -- -m "INBOX" sample_message | deliver -u "remote" -- -m "INBOX" sample_message | deliver -u "remote" -- -m "foo" interimap_init sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.csv" <<-EOF .mode csv SELECT idx, hex(mailbox) FROM mailboxes ORDER BY idx EOF step_start "non-existent source (no-op)" interimap --rename "nonexistent" "bar" || error "Rename non-existent mailbox?" check_mailbox_list step_done step_start "existing target (fail)" ! interimap --rename "nonexistent" "foo" || error "Overwrote target?" grep -Fx "local: ERROR: Mailbox foo exists. Run \`interimap --target=local --delete foo\` to delete." <"$STDERR" || error check_mailbox_list step_done step_start "INBOX" interimap --rename "INBOX" "baz" || error check_mailbox_list step_done step_start "\\Noinferiors mailbox" interimap --rename "foo" "bar" || error check_mailbox_list sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.csv" <<-EOF .mode csv SELECT idx, CASE WHEN mailbox = x'$(printf "baz" | xxd -u -ps)' THEN '$(printf "%s" "INBOX" | xxd -u -ps)' WHEN mailbox = x'$(printf "bar" | xxd -u -ps)' THEN '$(printf "%s" "foo" | xxd -u -ps)' ELSE hex(mailbox) END FROM mailboxes ORDER BY idx EOF diff -u --label="a/mailboxes.csv" --label="b/mailboxes.csv" \ "$TMPDIR/mailboxes.csv" "$TMPDIR/mailboxes2.csv" \ || error "Mailbox list differs" step_done interimap # recreated after renaming grep -Fx "database: Created mailbox INBOX" <"$STDERR" check_mailbox_list check_mailboxes_status "INBOX" "bar" "baz" # vim: set filetype=bash : interimap-0.5.8/tests/repair/000077500000000000000000000000001500320172000161265ustar00rootroot00000000000000interimap-0.5.8/tests/repair/local.conf000066400000000000000000000000461500320172000200670ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/repair/remote.conf000066400000000000000000000000461500320172000202700ustar00rootroot00000000000000namespace inbox { separator = ~ } interimap-0.5.8/tests/repair/t000066400000000000000000000115621500320172000163210ustar00rootroot00000000000000# create some mailboxes and populate them doveadm -u "local" mailbox create --no-userdb-lookup "foo.bar" doveadm -u "remote" mailbox create --no-userdb-lookup "foo~bar" "baz" for ((i = 0; i < 8; i++)); do sample_message | deliver -u "local" -- -m "foo.bar" sample_message | deliver -u "remote" -- -m "foo~bar" done for ((i = 0; i < 64; i++)); do sample_message | deliver -u "remote" -- -m "baz" done interimap_init check_mailbox_list check_mailboxes_status "foo.bar" "baz" "INBOX" # make more changes (flag updates, new massages, deletions) sample_message | deliver -u "remote" -- -m "INBOX" doveadm -u "local" expunge --no-userdb-lookup mailbox "baz" 1:10 doveadm -u "remote" expunge --no-userdb-lookup mailbox "baz" "$(seq -s"," 1 2 32),$(seq -s"," 40 2 64)" doveadm -u "local" expunge --no-userdb-lookup mailbox "foo.bar" 2,3,5:7,10 doveadm -u "remote" expunge --no-userdb-lookup mailbox "foo~bar" 4,5,7,10 doveadm -u "local" flags add --no-userdb-lookup "\\Answered" mailbox "foo.bar" 2,3,5:7,10 doveadm -u "remote" flags add --no-userdb-lookup "\\Seen" mailbox "foo~bar" 4,5,7 # spoof HIGHESTMODSEQ value in the database to make it look that we recorded the new changes already spoof() { local k="$1" v m hex="$(printf "%s\\0%s" "foo" "bar" | xxd -ps)" shift while [ $# -gt 0 ]; do [ "$1" = "local" ] && m="foo.bar" || m="$(printf "%s" "foo.bar" | tr "." "~")" v="$(doveadm -u "$1" -f flow mailbox status --no-userdb-lookup "${k,,[A-Z]}" "$m" | sed 's/.*=//')" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <<-EOF UPDATE \`$1\` SET $k = $v WHERE idx = (SELECT idx FROM mailboxes WHERE mailbox = x'$hex'); EOF shift done } spoof HIGHESTMODSEQ "local" "remote" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF .dump EOF doveadm -u "local" mailbox status --no-userdb-lookup "all" "foo.bar" >"$TMPDIR/foo-bar.status.local" doveadm -u "remote" mailbox status --no-userdb-lookup "all" "foo~bar" >"$TMPDIR/foo-bar.status.remote" # verify that without --repair interimap does nothing due to the spoofed HIGHESTMODSEQ values interimap "foo.bar" || error sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF .dump EOF doveadm -u "local" mailbox status --no-userdb-lookup all "foo.bar" >"$TMPDIR/foo-bar.status2.local" doveadm -u "remote" mailbox status --no-userdb-lookup all "foo~bar" >"$TMPDIR/foo-bar.status2.remote" diff -u --label="a/dump.sql" --label="b/dump.sql" "$TMPDIR/dump.sql" "$TMPDIR/dump2.sql" diff -u --label="a/foo_bar.local" --label="a/foo_bar.local" "$TMPDIR/foo-bar.status.local" "$TMPDIR/foo-bar.status2.local" diff -u --label="a/foo_bar.remote" --label="a/foo_bar.remote" "$TMPDIR/foo-bar.status.remote" "$TMPDIR/foo-bar.status2.remote" # deliver more messages and spoof UIDNEXT *on one side only* sample_message | deliver -u "local" -- -m "foo.bar" sample_message | deliver -u "remote" -- -m "foo~bar" spoof UIDNEXT "local" spoof HIGHESTMODSEQ "local" "remote" # now repair interimap --repair "baz" "foo.bar" || error # 6 updates with \Answered (luid 4,8,11:13,16), 2 of which (luid 12,13) vanished from remote # 3 updates with \Seen (ruid 6,8,10), 1 of which (uid 10) vanished from remote # luid 16 <-> ruid 8 has both \Answered and \Seen xcgrep 5 '^WARNING: Missed flag update in foo\.bar for ' <"$STDERR" xcgrep 5 '^WARNING: Conflicting flag update in foo\.bar ' <"$STDERR" # luid 2 <-> ruid 10 xcgrep 1 -E '^WARNING: Pair \(lUID,rUID\) = \([0-9]+,[0-9]+\) vanished from foo\.bar\. Repairing\.$' <"$STDERR" # 6-1 (luid 2 <-> ruid 10 is gone from both) xcgrep 5 -E '^local\(foo\.bar\): WARNING: UID [0-9]+ disappeared. Redownloading remote UID [0-9]+\.$' <"$STDERR" # 6-1 (luid 2 <-> ruid 10 is gone from both) xcgrep 3 -E '^remote\(foo~bar\): WARNING: UID [0-9]+ disappeared. Redownloading local UID [0-9]+\.$' <"$STDERR" grep -E '^local\(baz\): Removed 24 UID\(s\) ' <"$STDERR" || error grep -E '^remote\(baz\): Removed 5 UID\(s\) ' <"$STDERR" || error # hardcoding UIDs here is not very robust... grep -E '^local\(foo\.bar\): Updated flags \(\\Answered \\Seen\) for UID 16$' <"$STDERR" || error grep -E '^local\(foo\.bar\): Updated flags \(\\Seen\) for UID 14$' <"$STDERR" || error grep -E '^remote\(foo~bar\): Updated flags \(\\Answered \\Seen\) for UID 8$' <"$STDERR" || error grep -E '^remote\(foo~bar\): Updated flags \(\\Answered\) for UID 3,12,16$' <"$STDERR" || error # luid 17 xcgrep 1 -E '^remote\(foo~bar\): WARNING: No match for modified local UID [0-9]+. Redownloading\.' <"$STDERR" grep -E '^local\(foo\.bar\): Added 5 UID\(s\) ' <"$STDERR" || error grep -E '^remote\(foo~bar\): Added 4 UID\(s\) ' <"$STDERR" || error grep -E '^local\(foo\.bar\): Added 1 UID\(s\) ' <"$STDERR" || error # the new message check_mailbox_list check_mailboxes_status "baz" "foo.bar" interimap || error check_mailboxes_status "baz" "foo.bar" "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/resume/000077500000000000000000000000001500320172000161445ustar00rootroot00000000000000interimap-0.5.8/tests/resume/local.conf000066400000000000000000000000461500320172000201050ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/resume/remote.conf000066400000000000000000000000461500320172000203060ustar00rootroot00000000000000namespace inbox { separator = ~ } interimap-0.5.8/tests/resume/t000066400000000000000000000072451500320172000163420ustar00rootroot00000000000000# create and populate a bunch of mailboxes doveadm -u "local" mailbox create --no-userdb-lookup "foo" "foo.bar" "baz" for ((i = 0; i < 8; i++)); do sample_message | deliver -u "local" -- -m "foo" sample_message | deliver -u "local" -- -m "foo.bar" sample_message | deliver -u "local" -- -m "INBOX" done interimap_init check_mailbox_list check_mailboxes_status "foo" "foo.bar" "baz" "INBOX" # spoof UIDNEXT in the database set_uidnext() { local imap="$1" mailbox="$2" uidnext="$3" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <<-EOF UPDATE $imap SET UIDNEXT = $uidnext WHERE idx = ( SELECT idx FROM mailboxes WHERE mailbox = x'$mailbox' ); EOF } # spoof "foo"'s UIDVALIDITY and UIDNEXT values uidvalidity="$(doveadm -u "local" -f flow mailbox status --no-userdb-lookup uidvalidity "foo" | sed 's/.*=//')" [ $uidvalidity -eq 4294967295 ] && uidvalidity2=1 || uidvalidity2=$((uidvalidity+1)) doveadm -u "local" mailbox update --no-userdb-lookup --uid-validity "$uidvalidity2" "foo" set_uidnext "local" "$(printf "%s" "foo" | xxd -ps)" 1 # verify that interimap chokes on the UIDVALIDITY change without doing any changes sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF .dump EOF doveadm -u "local" mailbox status --no-userdb-lookup "all" "foo" >"$TMPDIR/foo.local" doveadm -u "remote" mailbox status --no-userdb-lookup "all" "foo" >"$TMPDIR/foo.remote" ! interimap || error grep -Fx "Resuming interrupted sync for foo" <"$STDERR" grep -Fx "local(foo): ERROR: UIDVALIDITY changed! ($uidvalidity2 != $uidvalidity) Need to invalidate the UID cache for foo." <"$STDERR" sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF .dump EOF doveadm -u "local" mailbox status --no-userdb-lookup "all" "foo" >"$TMPDIR/foo.local2" doveadm -u "remote" mailbox status --no-userdb-lookup "all" "foo" >"$TMPDIR/foo.remote2" diff -u --label="a/dump.sql" --label="b/dump.sql" "$TMPDIR/dump2.sql" "$TMPDIR/dump.sql" diff -u --label="a/foo.local" --label="b/foo.remote" "$TMPDIR/foo.local" "$TMPDIR/foo.local2" diff -u --label="a/foo.local" --label="b/foo.remote" "$TMPDIR/foo.remote" "$TMPDIR/foo.remote2" # spoof UIDNEXT values for INBOX (local+remote) and foo.bar (remote) set_uidnext "local" "$(printf "%s" "INBOX" | xxd -ps)" 2 set_uidnext "remote" "$(printf "%s" "INBOX" | xxd -ps)" 2 set_uidnext "remote" "$(printf "%s\\0%s" "foo" "bar" | xxd -ps)" 0 # set some flags and remove some messages for UIDs >2 doveadm -u "local" flags add --no-userdb-lookup "\\Seen" mailbox "INBOX" 6,7 doveadm -u "remote" flags add --no-userdb-lookup "\\Deleted" mailbox "INBOX" 6,8 doveadm -u "local" expunge --no-userdb-lookup mailbox "INBOX" 4,5 doveadm -u "remote" expunge --no-userdb-lookup mailbox "INBOX" 3,4 doveadm -u "remote" expunge --no-userdb-lookup mailbox "foo~bar" 5 # add new messages sample_message | deliver -u "local" -- -m "foo.bar" sample_message | deliver -u "remote" -- -m "foo~bar" sample_message | deliver -u "local" -- -m "baz" interimap "foo.bar" "InBoX" "baz" # ignore "foo" grep -Fx "Resuming interrupted sync for foo.bar" <"$STDERR" grep -Fx "Resuming interrupted sync for INBOX" <"$STDERR" check_mailbox_list check_mailboxes_status "foo.bar" "INBOX" "baz" # ignore "foo" # count entries in the mapping table sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF SELECT COUNT(*) FROM mapping NATURAL JOIN mailboxes WHERE mailbox != x'$(printf "%s" "foo" | xxd -ps)' GROUP BY idx ORDER BY mailbox; EOF # count messages: # INBOX: 8-2-1 = 5 # baz: 1 # foo.bar: 8-1+1+1 = 9 diff -u --label="a/count" --label="b/count" "$TMPDIR/count" - <<-EOF 5 1 9 EOF # vim: set filetype=bash : interimap-0.5.8/tests/run000077500000000000000000000407521500320172000154060ustar00rootroot00000000000000#!/bin/bash #---------------------------------------------------------------------- # Test suite for InterIMAP # Copyright © 2019 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . #---------------------------------------------------------------------- set -ue PATH=/usr/bin:/bin export PATH if [ $# -eq 0 ] || [ $# -gt 2 ]; then printf "Usage: %s TESTFILE [TESTNAME]\\n" "$0" >&2 exit 1 fi BASEDIR="$(dirname -- "$0")" TESTDIR="$BASEDIR/$1" TESTNAME="${2-$1}" if [ ! -d "$TESTDIR" ]; then printf "ERROR: Not a directory: %s\\n" "$TESTDIR" >&2 exit 1 fi # cleanup environment unset OPENSSL_CONF SSL_CERT_FILE SSL_CERT_DIR if [ -z "${INTERIMAP_PATH+x}" ]; then INTERIMAP_PATH="./" elif [ -n "$INTERIMAP_PATH" ]; then INTERIMAP_PATH="${INTERIMAP_PATH%/}/" fi ROOTDIR="$(mktemp --tmpdir="${TMPDIR:-/dev/shm}" --directory "$1.XXXXXXXXXX")" declare -a DOVECOT_SERVER=() trap cleanup EXIT INT TERM cleanup() { local pid c for c in "${DOVECOT_SERVER[@]}"; do if [ ! -f "$c" ] || ! env -i PATH="/usr/bin:/bin" doveadm -c "$c" stop; then pid="$(< "${c%/*}/run/master.pid")" kill -TERM "$pid" || printf "kill(1) exited with status %d\\n" "$?" >&2 fi done rm -rf -- "$ROOTDIR" } _STDOUT="$ROOTDIR/stdout" _STDERR="$ROOTDIR/stderr" TMPDIR="$ROOTDIR/tmp" STDERR="$(mktemp --tmpdir="$ROOTDIR" "stderr.XXXXXXXXXX")" mkdir -- "$TMPDIR" "$ROOTDIR/home" declare -a REMOTES=() # Set environment for the given user environ_set() { local user="$1" home eval home="\$HOME_$user" ENVIRON=( PATH="$PATH" USER="$user" HOME="$home" XDG_CONFIG_HOME="$home/.config" XDG_DATA_HOME="$home/.local/share" ) } # Prepare the test harness prepare() { declare -a ENVIRON=() local src cfg target u home n proto if [ -f "$TESTDIR/remotes" ] || [ -L "$TESTDIR/remotes" ]; then for cfg in $(seq 1 "$(< "$TESTDIR/remotes")"); do REMOTES+=( "remote$cfg" ) done else REMOTES+=( "remote" ) fi # copy dovecot config for u in "local" "${REMOTES[@]}"; do home="$ROOTDIR/$u/home" export "HOME_$u"="$home" environ_set "$u" mkdir -pm0700 -- "$home/.dovecot" cat >"$home/.dovecot/config" <<-EOF dovecot_config_version = 2.4.0 dovecot_storage_version = 2.4.0 log_path = $HOME_local/mail.log mail_home = $home mail_driver = sdbox mail_path = ~/inbox mailbox_list_index = yes ssl = no listen = 127.0.0.1, 127.0.1.1, ::1 namespace inbox { inbox = yes } EOF if [ -f "$TESTDIR/$u.conf" ] || [ -L "$TESTDIR/$u.conf" ]; then cat >>"$home/.dovecot/config" <"$TESTDIR/$u.conf" fi cp -aT -- "$BASEDIR/config/dovecot" "$home/.dovecot/conf.d" cp -at "$home/.dovecot/conf.d" -- "$BASEDIR/certs/ca.crt" "$BASEDIR/certs"/dovecot.* proto="$(env -i "${ENVIRON[@]}" doveconf -c "$home/.dovecot/config" -h protocols)" if [ -n "$proto" ]; then cat >>"$home/.dovecot/config" <<-EOF # https://doc.dovecot.org/latest/core/config/rootless.html#rootless-installation dovecot_config_version = 2.4.0 dovecot_storage_version = 2.4.0 base_dir = $home/.dovecot/run default_internal_user = $(id -un) default_internal_group = $(id -gn) default_login_user = $(id -un) service anvil { chroot = } service imap-login { chroot = } service stats { chroot = } passdb passwd-file { driver = passwd-file default_password_scheme = plain passwd_file_path = $home/.dovecot/users } userdb passwd-file { driver = passwd-file passwd_file_path = $home/.dovecot/users } EOF env -i PATH="/usr/bin:/bin" /usr/sbin/dovecot -c "$home/.dovecot/config" DOVECOT_SERVER+=( "$home/.dovecot/config" ) printf "%s:%s:::::\\n" "$u" "$(xxd -l16 -p "$home/.dovecot/users" fi mkdir -pm0755 -- "$home/.local/bin" cat >"$home/.local/bin/doveadm" <<-EOF #!/bin/sh exec env -i ${ENVIRON[@]@Q} \\ doveadm -c ${home@Q}/.dovecot/config "\$@" EOF chmod +x -- "$home/.local/bin/doveadm" done # copy interimap and pullimap configuration mkdir -pm0700 -- "$HOME_local/.local/share/interimap" "$HOME_local/.local/share/pullimap" mkdir -pm0700 -- "$HOME_local/.config/interimap" "$HOME_local/.config/pullimap" echo "deliver-rcpt = local" >>"$HOME_local/.config/pullimap/config" for u in "${REMOTES[@]}"; do n="${u#remote}" eval home="\$HOME_$u" cat >>"$HOME_local/.config/interimap/config$n" <<-EOF database = $u.db #logfile = $HOME_local/interimap$n.log EOF if [ -f "$TESTDIR/interimap$n.conf" ] || [ -L "$TESTDIR/interimap$n.conf" ]; then cat <"$TESTDIR/interimap$n.conf" >>"$HOME_local/.config/interimap/config$n" fi if [ -f "$TESTDIR/pullimap.conf" ] || [ -L "$TESTDIR/pullimap.conf" ]; then cat <"$TESTDIR/pullimap.conf" >>"$HOME_local/.config/pullimap/config" fi cat >>"$HOME_local/.config/interimap/config$n" <<-EOF [local] type = tunnel command = exec ${HOME_local@Q}/.local/bin/doveadm exec imap null-stderr = NO EOF if [ -f "$TESTDIR/interimap$n.local" ] || [ -L "$TESTDIR/interimap$n.local" ]; then cat <"$TESTDIR/interimap$n.local" >>"$HOME_local/.config/interimap/config$n" fi if [ -s "$home/.dovecot/users" ]; then cat <<-EOF username = $u password = $(awk -F: -vu="$u" '$1 == u {print $2}' <"$home/.dovecot/users") EOF else cat <<-EOF type = tunnel command = exec ${home@Q}/.local/bin/doveadm exec imap null-stderr = NO EOF fi >"$HOME_local/.$u.conf" if [ -f "$TESTDIR/interimap$n.remote" ] || [ -L "$TESTDIR/interimap$n.remote" ]; then cat <"$TESTDIR/interimap$n.remote" >>"$HOME_local/.$u.conf" fi { printf "\\n[remote]\\n"; cat <"$HOME_local/.$u.conf"; } >>"$HOME_local/.config/interimap/config$n" { printf "\\n[%s]\\n" "$u"; cat <"$HOME_local/.$u.conf"; } >>"$HOME_local/.config/pullimap/config" done } prepare # Wrappers for interimap(1) and doveadm(1) interimap() { _interimap_cmd "interimap" "$@"; } pullimap() { _interimap_cmd "pullimap" "$@"; } _interimap_cmd() { declare -a ENVIRON=() args=() local script="$1" rv=0 shift environ_set "local" [ -z "${OPENSSL_CONF+x}" ] || ENVIRON+=( OPENSSL_CONF="$OPENSSL_CONF" ) [ -z "${SSL_CERT_FILE+x}" ] || ENVIRON+=( SSL_CERT_FILE="$SSL_CERT_FILE" ) [ -z "${SSL_CERT_DIR+x}" ] || ENVIRON+=( SSL_CERT_DIR="$SSL_CERT_DIR" ) [ -z "${INTERIMAP_I:+x}" ] || args+=( perl -I"$INTERIMAP_I" -T ) args+=( "$INTERIMAP_PATH$script" "$@" ) #printf "I: Running \`%s\`\\n" "${args[*]}" >&3 env -i "${ENVIRON[@]}" "${args[@]}" 2>"$STDERR" || rv=$? cat <"$STDERR" >&2 return $rv } interimap_init() { local u="${1-remote}" local db="$XDG_DATA_HOME/interimap/$u.db" st local cfg="config${u#remote}" test \! -e "$db" || error "Database already exists" 1 interimap --config "$cfg" || error "Couldn't initialize interimap" 1 test -f "$db" || error "Database is still missing" 1 grep -Fx "Creating new schema in database file $db" <"$STDERR" || error "DB wasn't created" 1 if ! st="$(stat -c"%#a" -- "$db")" || [ "$st" != "0600" ]; then error "$db has mode $st != 0600" 1 fi } doveadm() { if [ $# -le 2 ] || [ "$1" != "-u" ]; then echo "Usage: doveadm -u USER ..." >&2 exit 1 fi local u="$2" home eval home="\$HOME_$u" shift 2 "$home/.local/bin/doveadm" "$@" } sqlite3() { command sqlite3 -init /dev/null "$@" } # Sample (random) message sample_message() { local date="$(date +"%s.%N")" cat <<-EOF From: <$(xxd -ps -l6 /dev/urandom)@example.net> To: Date: $(date -R -d@"$date") Message-ID: <$date@example.net> EOF local len="$(shuf -i1-4096 -n1)" xxd -ps -c30 -l"$len" /dev/urandom # 3 to 8329 bytes } # Wrapper for dovecot-lda(1) deliver() { declare -a argv while [ $# -gt 0 ] && [ "$1" != "--" ]; do argv+=( "$1" ) shift done if [ $# -gt 0 ] && [ "$1" = "--" ]; then shift fi doveadm "${argv[@]}" exec dovecot-lda -e "$@" } # Dump test results dump_test_result() { local below=">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" local above="<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<" local src u home declare -a ENVIRON=() for u in "local" "${REMOTES[@]}"; do environ_set "$u" eval home="\$HOME_$u" printf "%s dovecot configuration:\\n%s\\n" "$u" "$below" env -i "${ENVIRON[@]}" doveconf -c "$home/.dovecot/config" -n printf "%s\\n\\n" "$above" done for u in "${REMOTES[@]}"; do printf "interimap configuration (local <-> $u):\\n%s\\n" "$below" cat <"$HOME_local/.config/interimap/config${u#remote}" printf "%s\\n\\n" "$above" done printf "mail.log:\\n%s\\n" "$below" cat -- "$HOME_local/mail.log" 2>/dev/null || true printf "%s\\n\\n" "$above" printf "standard output:\\n%s\\n" "$below" cat <"$_STDOUT" printf "%s\\n\\n" "$above" printf "standard error:\\n%s\\n" "$below" cat <"$_STDERR" printf "%s\\n\\n" "$above" } # Check mailbox consistency between the local/remote server and interimap's database check_mailbox_status() { local mailbox="$1" lns="inbox" lsep lprefix rns="inbox" rsep rprefix lsep="$(doveconf -c "$HOME_local/.dovecot/config" -h "namespace/$lns/separator")" lprefix="$(doveconf -c "$HOME_local/.dovecot/config" -h "namespace/$lns/prefix")" rsep="$(doveconf -c "$HOME_remote/.dovecot/config" -h "namespace/$lns/separator")" rprefix="$(doveconf -c "$HOME_remote/.dovecot/config" -h "namespace/$lns/prefix")" local blob="x'$(printf "%s" "$mailbox" | tr "$lsep" "\\0" | xxd -c256 -ps)'" local rmailbox="$(printf "%s" "$mailbox" | tr "$lsep" "$rsep")" check_mailbox_status2 "$blob" "$lprefix$mailbox" "remote" "$rprefix$rmailbox" } check_mailbox_status2() { local blob="$1" lmailbox="$2" u="$3" rmailbox="$4" local lUIDVALIDITY lUIDNEXT lHIGHESTMODSEQ rUIDVALIDITY rUIDNEXT rHIGHESTMODSEQ read lUIDVALIDITY lUIDNEXT lHIGHESTMODSEQ rUIDVALIDITY rUIDNEXT rHIGHESTMODSEQ < <( sqlite3 "$XDG_DATA_HOME/interimap/$u.db" <<-EOF .mode csv .separator " " "\\n" SELECT l.UIDVALIDITY, l.UIDNEXT, l.HIGHESTMODSEQ, r.UIDVALIDITY, r.UIDNEXT, r.HIGHESTMODSEQ FROM mailboxes m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx WHERE mailbox = $blob EOF ) lHIGHESTMODSEQ="$(printf "%llu" "$lHIGHESTMODSEQ")" rHIGHESTMODSEQ="$(printf "%llu" "$rHIGHESTMODSEQ")" local MESSAGES read MESSAGES < <( sqlite3 "$XDG_DATA_HOME/interimap/$u.db" <<-EOF .mode csv .separator " " "\\n" SELECT COUNT(*) FROM mailboxes a JOIN mapping b ON a.idx = b.idx WHERE mailbox = $blob EOF ) check_mailbox_status_values "local" "$lmailbox" $lUIDVALIDITY $lUIDNEXT $lHIGHESTMODSEQ $MESSAGES check_mailbox_status_values "$u" "$rmailbox" $rUIDVALIDITY $rUIDNEXT $rHIGHESTMODSEQ $MESSAGES local a b a="$(doveadm -u "local" -f "flow" mailbox status --no-userdb-lookup "messages unseen vsize" -- "$lmailbox" | \ sed -nr '/.*\s+(\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+)$/ {s//\1/p;q}')" b="$(doveadm -u "$u" -f "flow" mailbox status --no-userdb-lookup "messages unseen vsize" -- "$rmailbox" | \ sed -nr '/.*\s+(\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+)$/ {s//\1/p;q}')" if [ "$a" != "$b" ]; then echo "Mailbox $lmailbox status differs: \"$a\" != \"$b\"" >&2 exit 1 fi } check_mailbox_status_values() { local user="$1" mailbox="$2" UIDVALIDITY="$3" UIDNEXT="$4" HIGHESTMODSEQ="$5" MESSAGES="$6" x xs v k xs="$(doveadm -u "$user" -f "flow" mailbox status --no-userdb-lookup "uidvalidity uidnext highestmodseq messages" -- "$mailbox" | \ sed -nr '/.*\s+(\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+)$/ {s//\1/p;q}')" [ -n "$xs" ] || exit 1 for x in $xs; do k="${x%%=*}" case "${k^^[a-z]}" in UIDVALIDITY) v="$UIDVALIDITY";; UIDNEXT) v="$UIDNEXT";; HIGHESTMODSEQ) v="$HIGHESTMODSEQ";; MESSAGES) v="$MESSAGES";; *) echo "Uh? $x" >&2; exit 1 esac if [ "${x#*=}" != "$v" ]; then echo "$user($mailbox): ${k^^[a-z]} doesn't match! ${x#*=} != $v" >&2 exit 1 fi done } check_mailboxes_status() { local mailbox for mailbox in "$@"; do check_mailbox_status "$mailbox" done } # Check mailbox list constency between the local and remote servers check_mailbox_list() { local m i lns="inbox" lsep lprefix rns="inbox" rsep rprefix sub= lsep="$(doveconf -c "$HOME_local/.dovecot/config" -h "namespace/$lns/separator")" lprefix="$(doveconf -c "$HOME_local/.dovecot/config" -h "namespace/$lns/prefix")" rsep="$(doveconf -c "$HOME_remote/.dovecot/config" -h "namespace/$lns/separator")" rprefix="$(doveconf -c "$HOME_remote/.dovecot/config" -h "namespace/$lns/prefix")" if [ $# -gt 0 ] && [ "$1" = "-s" ]; then sub="-s" shift fi declare -a lmailboxes=() rmailboxes=() if [ $# -eq 0 ]; then lmailboxes=( "${lprefix}*" ) rmailboxes=( "${rprefix}*" ) else for m in "$@"; do lmailboxes+=( "$lprefix$m" ) rmailboxes+=( "$rprefix${m//"$lsep"/"$rsep"}" ) done fi mapfile -t lmailboxes < <( doveadm -u "local" mailbox list --no-userdb-lookup $sub -- "${lmailboxes[@]}" ) for ((i = 0; i < ${#lmailboxes[@]}; i++)); do lmailboxes[i]="${lmailboxes[i]#"$lprefix"}" done mapfile -t rmailboxes < <( doveadm -u "remote" mailbox list --no-userdb-lookup $sub -- "${rmailboxes[@]}" ) for ((i = 0; i < ${#rmailboxes[@]}; i++)); do rmailboxes[i]="${rmailboxes[i]#"$rprefix"}" rmailboxes[i]="${rmailboxes[i]//"$rsep"/"$lsep"}" done local IFS=$'\n' diff -u --label="local/mailboxes" --label="remote/mailboxes" \ <( printf "%s" "${lmailboxes[*]}" | sort ) <( printf "%s" "${rmailboxes[*]}" | sort ) } # Wrapper for `grep -c` xcgrep() { local m="$1" n shift if ! n="$(grep -c "$@")" || [ $m -ne $n ]; then error "\`grep -c ${*@Q}\` failed ($m != $n)" 1 fi } error() { local err="${1+": $1"}" i=${2-0} printf "ERROR$err on file %s line %d\\n" "${BASH_SOURCE[i+1]}" ${BASH_LINENO[i]} >&2 exit 1 } ptree_abort() { local pid for pid in "$@"; do # kill a process and its children pkill -TERM -P "$pid" || printf "pkill(1) exited with status %d\\n" "$?" >&2 kill -TERM "$pid" || printf "kill(1) exited with status %d\\n" "$?" >&2 done wait } step_start() { printf "%s%s..." "${INDENT-}" "$1" >&3; } step_done() { passed >&3; } failed() { [ -t 1 ] && printf " \\x1B[1;31mFAILED\\x1B[0m\\n" || echo " FAILED" } passed() { [ -t 1 ] && printf " \\x1B[1;32mPASSED\\x1B[0m\\n" || echo " PASSED" } # Run test in a sub-shell declare -a ENVIRON=() environ_set "local" export TMPDIR TESTDIR INTERIMAP_PATH INTERIMAP_I STDERR "${ENVIRON[@]}" export -f environ_set doveadm interimap interimap_init pullimap _interimap_cmd export -f sqlite3 sample_message deliver ptree_abort step_start step_done passed export -f check_mailbox_status check_mailbox_status_values check_mailbox_status2 export -f check_mailboxes_status check_mailbox_list xcgrep error [ "$TESTNAME" = "..." ] || printf "%s%s..." "${INDENT-}" "$TESTNAME" if ! bash -ue "$TESTDIR/t" 3>&1 >"$_STDOUT" 2>"$_STDERR"; then failed [ "${QUIET-n}" = "y" ] || dump_test_result exit 1 else [ "$TESTNAME" = "..." ] || passed if grep -Paq "\\x00" -- "$_STDOUT" "$_STDERR"; then printf "\\tWARN: binary output (outstanding \\0)!\\n" fi exit 0 fi interimap-0.5.8/tests/run-all000077500000000000000000000036111500320172000161450ustar00rootroot00000000000000#!/bin/bash #---------------------------------------------------------------------- # Test suite for InterIMAP # Copyright © 2019 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . #---------------------------------------------------------------------- set -ue PATH=/usr/bin:/bin export PATH BASEDIR="$(dirname -- "$0")" RUN="$BASEDIR/run" list="$1" failed=0 while IFS="" read -r x; do if [[ "$x" =~ ^([[:blank:]]*)([^[:blank:]#]+)[[:blank:]]+(.*)$ ]]; then indent="${BASH_REMATCH[1]}" t="${BASH_REMATCH[2]}" desc="${BASH_REMATCH[3]}" if [ "$t" = "." ]; then printf "%s%s:\\n" "$indent" "$desc" continue elif [ "$t" = "..." ]; then t="$desc" desc="..." fi elif [[ "$x" =~ ^([[:blank:]]*)([^[:blank:]#]+)$ ]]; then indent="${BASH_REMATCH[1]}" t="${BASH_REMATCH[2]}" unset desc else continue fi if [ ! -d "$BASEDIR/$t" ]; then printf "WARN: %s does doesn't exist, skipping\\n" "$t" >&2 continue fi INDENT="$indent" "$RUN" "$t" ${desc+"$desc"} || failed=$(( failed+1 )) done <"$BASEDIR/$list" if [ $failed -eq 0 ]; then printf "All tests passed.\\n" exit 0 else printf "%d test(s) failed.\\n" $failed exit 1 fi interimap-0.5.8/tests/split-set/000077500000000000000000000000001500320172000165705ustar00rootroot00000000000000interimap-0.5.8/tests/split-set/interimap.remote000077700000000000000000000000001500320172000304122../auth-sasl-plain/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/split-set/remote.conf000077700000000000000000000000001500320172000263042../auth-sasl-plain/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/split-set/t000066400000000000000000000027421500320172000167630ustar00rootroot00000000000000N=2048 # XXX with COMPRESS=DEFLATE dovecot-imapd 2.3.4 hangs when the command # line exceeds 'imap_max_line_length' (or 8192, whichever is smaller) # bytes, instead of returning a tagged BAD response. # https://dovecot.org/pipermail/dovecot/2019-November/117522.html # set UIDNEXT to 10^9 so all uids are 10 chars long, otherwise we'd need # to add many more messages to obtain large sets doveadm -u "local" mailbox update --no-userdb-lookup --min-next-uid 1000000000 "INBOX" doveadm -u "remote" mailbox update --no-userdb-lookup --min-next-uid 1000000000 "INBOX" for ((i = 0; i < N; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done interimap_init check_mailbox_status "INBOX" # mark every other message as \Seen on the local server for ((i = 0; i < N; i+=2)); do doveadm -u "local" flags add --no-userdb-lookup "\\Seen" mailbox "INBOX" $((N-i)) done # send the changes to the remote; this results into an UID STORE set # representation of size 11*N/2-1, which exceeds $imap_max_line_length interimap check_mailbox_status "INBOX" # now expunge every other message on the remote server; this results # into large UID STORE and UID EXPUNGE set representation for ((i = 0; i < N; i+=2)); do doveadm -u "local" expunge --no-userdb-lookup mailbox "INBOX" $((N-i)) # add some more messages u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done interimap || error check_mailbox_status "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/starttls-injection/000077500000000000000000000000001500320172000205045ustar00rootroot00000000000000interimap-0.5.8/tests/starttls-injection/imapd000077500000000000000000000053751500320172000215360ustar00rootroot00000000000000#!/usr/bin/perl -T use warnings; use strict; use Errno qw/EINTR/; use Net::SSLeay qw/die_now/; use Socket qw/INADDR_LOOPBACK AF_INET SOCK_STREAM pack_sockaddr_in SOL_SOCKET SO_REUSEADDR SHUT_RDWR/; BEGIN { Net::SSLeay::load_error_strings(); Net::SSLeay::SSLeay_add_ssl_algorithms(); Net::SSLeay::randomize(); } socket(my $S, AF_INET, SOCK_STREAM, 0) or die; setsockopt($S, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die; bind($S, pack_sockaddr_in(10143, INADDR_LOOPBACK)) or die "bind: $!\n"; listen($S, 1) or die "listen: $!"; my $CONFDIR = $ENV{HOME} =~ /\A(\p{Print}+)\z/ ? "$1/.dovecot/conf.d" : die; my $CTX = Net::SSLeay::CTX_new() or die_now("SSL_CTX_new()"); Net::SSLeay::CTX_set_mode($CTX, Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() | Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() | Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation Net::SSLeay::MODE_RELEASE_BUFFERS() ); Net::SSLeay::CTX_use_PrivateKey_file($CTX, "$CONFDIR/dovecot.rsa.key", &Net::SSLeay::FILETYPE_PEM) or die_now("Can't load private key: $!"); Net::SSLeay::CTX_use_certificate_file($CTX, "$CONFDIR/dovecot.rsa.crt", &Net::SSLeay::FILETYPE_PEM) or die_now("Can't load certificate: $!"); while (1) { my $sockaddr = accept(my $conn, $S) or do { next if $! == EINTR; die "accept: $!"; }; $conn->printflush("* OK IMAP4rev1 Server\r\n"); $conn->getline() =~ /\A(\S+) CAPABILITY\r\n\z/ or die; $conn->printflush("* CAPABILITY IMAP4rev1 STARTTLS\r\n"); $conn->printflush("$1 OK CAPABILITY completed\r\n"); $conn->getline() =~ /\A(\S+) STARTTLS\r\n\z/ or die; # These responses preceed the TLS handshake hence are not authenticated! $conn->print("$1 OK Begin TLS\r\n"); $conn->print("* CAPABILITY IMAP4rev1 LOGINDISABLED X-injected\r\n"); # Note: tag format must match Net::IMAP::InterIMAP->_cmd_init() $conn->printf("%06d OK CAPABILITY injected\r\n", $1+1); $conn->flush(); my $ssl = Net::SSLeay::new($CTX) or die_now("SSL_new()"); die_now("SSL_set_fd()") unless Net::SSLeay::set_fd($ssl, $conn) == 1; die_now("SSL_accept()") unless Net::SSLeay::accept($ssl); Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) CAPABILITY\r\n\z/ or die_now("SSL_read()"); Net::SSLeay::ssl_write_CRLF($ssl, "* CAPABILITY IMAP4rev1 AUTH=LOGIN\r\n$1 OK CAPABILITY completed"); Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) LOGIN .*\r\n\z/ or die_now("SSL_read()"); Net::SSLeay::ssl_write_CRLF($ssl, "$1 OK [CAPABILITY IMAP4rev1] LOGIN completed"); Net::SSLeay::free($ssl); close($conn); last; } END { Net::SSLeay::CTX_free($CTX) if defined $CTX; if (defined $S) { shutdown($S, SHUT_RDWR) or warn "shutdown: $!"; close($S) or print STDERR "close: $!\n"; } } interimap-0.5.8/tests/starttls-injection/interimap.remote000077700000000000000000000000001500320172000312042../starttls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/starttls-injection/remote.conf000066400000000000000000000001441500320172000226450ustar00rootroot00000000000000protocols { imap = yes } service imap-login { inet_listener imap { port = 0 } } interimap-0.5.8/tests/starttls-injection/t000066400000000000000000000015201500320172000206700ustar00rootroot00000000000000# Test unauthenticated response injection after the STARTTLS response # For background see https://gitlab.com/muttmua/mutt/-/issues/248 env -i USER="remote" HOME="$HOME_remote" "$TESTDIR/imapd" & PID=$! trap "ptree_abort $PID" EXIT INT TERM ! interimap --debug || error # Make sure we show a warning but ignore ignore (unauthenticated) injected responses ! grep -E 'remote: S: .*[ -]injected$' <"$STDERR" || error "unauthenticated response injection" grep -Fx 'remote: WARNING: Truncating non-empty output buffer (unauthenticated response injection?)' <"$STDERR" || error ! grep -Fx 'remote: ERROR: Logins are disabled.' <"$STDERR" || error "injected capability wasn't ignored" grep -Fx 'remote: ERROR: Server did not advertise ENABLE (RFC 5161) capability.' <"$STDERR" || error "injected capability wasn't ignored" # vim: set filetype=bash : interimap-0.5.8/tests/starttls-logindisabled/000077500000000000000000000000001500320172000213225ustar00rootroot00000000000000interimap-0.5.8/tests/starttls-logindisabled/interimap.remote000066400000000000000000000000721500320172000245260ustar00rootroot00000000000000type = imap host = 127.0.0.1 port = 10143 SSL_verify = no interimap-0.5.8/tests/starttls-logindisabled/remote.conf000066400000000000000000000002331500320172000234620ustar00rootroot00000000000000!include conf.d/imapd.conf !include conf.d/ssl.conf # trick dovecot into treating local connections as insecure imap_capability { LOGINDISABLED = yes } interimap-0.5.8/tests/starttls-logindisabled/t000066400000000000000000000015311500320172000215100ustar00rootroot00000000000000interimap --debug || true # double check the presence of 'LOGINDISABLED' and 'STARTTLS' in the preauth capability list grep -oE -m1 '^remote: S: \* OK \[CAPABILITY IMAP4rev1( [^]]*)? AUTH=[^]]*\]' <"$STDERR" >"$TMPDIR/capability" sed -ri 's/^remote: S: \* OK \[CAPABILITY (.*)\]$/\1/' "$TMPDIR/capability" tr " " "\\n" <"$TMPDIR/capability" >"$TMPDIR/capabilities" grep -Fx "IMAP4rev1" <"$TMPDIR/capabilities" || error grep -Fx "LOGINDISABLED" <"$TMPDIR/capabilities" || error # make sure we upgraded the connection and check the capability again grep -Fx "STARTTLS" <"$TMPDIR/capabilities" || error grep -Fx "remote: C: 000000 STARTTLS" <"$STDERR" || error grep -Fx "remote: C: 000001 CAPABILITY" <"$STDERR" || error # can't go further as the capability string still has the manually # enforced 'LOGINDISABLED' # vim: set filetype=bash : interimap-0.5.8/tests/starttls/000077500000000000000000000000001500320172000165245ustar00rootroot00000000000000interimap-0.5.8/tests/starttls/interimap.remote000066400000000000000000000000721500320172000217300ustar00rootroot00000000000000type = imap host = 127.0.0.1 port = 10143 SSL_verify = no interimap-0.5.8/tests/starttls/remote.conf000066400000000000000000000000641500320172000206660ustar00rootroot00000000000000!include conf.d/imapd.conf !include conf.d/ssl.conf interimap-0.5.8/tests/starttls/t000066400000000000000000000023611500320172000167140ustar00rootroot00000000000000ssl_server_cert_file="$(doveconf -c "$HOME_remote/.dovecot/config" -hx ssl_server/cert_file)" X509_SHA256="$(openssl x509 -in "$ssl_server_cert_file" -noout -fingerprint -sha256 \ | sed -rn "/^.*=\\s*/ {s///p;q}" | tr -d : | tr "[A-Z]" "[a-z]")" for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done interimap --debug || error # double check the presence of 'STARTTLS' in the preauth capability list grep -oE -m1 '^remote: S: \* OK \[CAPABILITY IMAP4rev1( [^]]*)? AUTH=[^]]*\]' <"$STDERR" >"$TMPDIR/capability" sed -ri 's/^remote: S: \* OK \[CAPABILITY (.*)\]$/\1/' "$TMPDIR/capability" tr " " "\\n" <"$TMPDIR/capability" >"$TMPDIR/capabilities" grep -Fx "IMAP4rev1" <"$TMPDIR/capabilities" || error grep -Fx "STARTTLS" <"$TMPDIR/capabilities" || error # make sure we upgraded the connection and check the capability again grep -Fx "remote: C: 000000 STARTTLS" <"$STDERR" || error grep -Fx "remote: C: 000001 CAPABILITY" <"$STDERR" || error grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" <"$STDERR" || error grep "^remote: SSL protocol: TLSv" <"$STDERR" || error grep "^remote: SSL cipher: " <"$STDERR" || error check_mailbox_status "INBOX" # vim: set filetype=bash : interimap-0.5.8/tests/sync-live-crippled/000077500000000000000000000000001500320172000203555ustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-crippled/interimap.remote000077700000000000000000000000001500320172000321772../auth-sasl-plain/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-crippled/local.conf000077700000000000000000000000001500320172000263762../sync-live/local.confustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-crippled/remote.conf000066400000000000000000000001671500320172000225230ustar00rootroot00000000000000namespace inbox { separator = ^ } !include conf.d/imapd.conf !include conf.d/interimap-required-capabilities.conf interimap-0.5.8/tests/sync-live-crippled/t000077700000000000000000000000001500320172000230502../sync-live/tustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-multi/000077500000000000000000000000001500320172000177055ustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-multi/interimap1.local000066400000000000000000000000261500320172000227700ustar00rootroot00000000000000list-reference = foo/ interimap-0.5.8/tests/sync-live-multi/interimap2.local000066400000000000000000000000261500320172000227710ustar00rootroot00000000000000list-reference = bar/ interimap-0.5.8/tests/sync-live-multi/interimap3.local000066400000000000000000000000261500320172000227720ustar00rootroot00000000000000list-reference = baz/ interimap-0.5.8/tests/sync-live-multi/local.conf000066400000000000000000000011171500320172000216460ustar00rootroot00000000000000namespace inbox { separator = / mail_driver = sdbox mail_path = ~/inbox inbox = yes list = yes } namespace foo { separator = / prefix = foo/ mail_driver = sdbox mail_path = ~/foo inbox = no list = yes } namespace bar { separator = / prefix = bar/ mail_driver = sdbox mail_path = ~/bar inbox = no list = yes } namespace baz { separator = / prefix = baz/ mail_driver = sdbox mail_path = ~/baz inbox = no list = yes } interimap-0.5.8/tests/sync-live-multi/remote1.conf000066400000000000000000000000461500320172000221300ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/sync-live-multi/remote2.conf000066400000000000000000000000511500320172000221250ustar00rootroot00000000000000namespace inbox { separator = "\\" } interimap-0.5.8/tests/sync-live-multi/remote3.conf000066400000000000000000000000501500320172000221250ustar00rootroot00000000000000namespace inbox { separator = "?" } interimap-0.5.8/tests/sync-live-multi/remotes000066400000000000000000000000021500320172000212760ustar00rootroot000000000000003 interimap-0.5.8/tests/sync-live-multi/t000066400000000000000000000113261500320172000200760ustar00rootroot00000000000000TIMEOUT=60 # mailbox list (as seen on local) and alphabet declare -a MAILBOXES=( "INBOX" ) ALPHABET=() str="#+-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz" for ((i=0; i < ${#str}; i++)); do ALPHABET[i]="${str:i:1}" done declare -a TARGETS=( "local" "remote1" "remote2" "remote3" ) # create databases interimap_init "remote1" interimap_init "remote2" interimap_init "remote3" # start long-lived interimap processes declare -a PID=() trap 'ptree_abort ${PID[@]}' EXIT INT TERM interimap --config="config1" --watch=1 & PID+=( $! ) interimap --config="config2" --watch=1 & PID+=( $! ) interimap --config="config3" --watch=1 & PID+=( $! ) timer=$(( $(date +%s) + TIMEOUT )) while [ $(date +%s) -le $timer ]; do # create new mailbox with 10% probability if [ $(shuf -n1 -i0-9) -eq 0 ]; then u="$(shuf -n1 -e -- "${TARGETS[@]}")" # choose target at random case "$u" in local) ns="$(shuf -n1 -e "foo/" "bar/" "baz/")";; remote1) ns="foo/";; remote2) ns="bar/";; remote3) ns="baz/";; *) error "Uh?";; esac m= d=$(shuf -n1 -i1-3) # random depth for (( i=0; i < d; i++)); do l=$(shuf -n1 -i1-16) m="${m:+$m/}$(shuf -n "$l" -e -- "${ALPHABET[@]}" | tr -d '\n')" done MAILBOXES+=( "$ns$m" ) case "$u" in local) m="$ns$m";; remote1) m="${m//\//^}";; remote2) m="${m//\//\\}";; remote3) m="${m//\//\?}";; *) error "Uh?";; esac doveadm -u "$u" mailbox create --no-userdb-lookup -- "$m" fi # EXPUNGE some messages u="$(shuf -n1 -e -- "${TARGETS[@]}")" # choose target at random n="$(shuf -n1 -i0-3)" while read guid uid; do doveadm -u "$u" expunge --no-userdb-lookup mailbox-guid "$guid" uid "$uid" done < <(doveadm -u "$u" search --no-userdb-lookup all | shuf -n "$n") # mark some existing messages as read (toggle \Seen flag as unlike other # flags it's easier to query and check_mailboxes_status checks it) u="$(shuf -n1 -e -- "${TARGETS[@]}")" # choose target at random n="$(shuf -n1 -i0-9)" while read guid uid; do a="$(shuf -n1 -e add remove replace)" doveadm -u "$u" flags "$a" --no-userdb-lookup "\\Seen" mailbox-guid "$guid" uid "$uid" done < <(doveadm -u "$u" search --no-userdb-lookup all | shuf -n "$n") # select at random a mailbox where to deliver some messages u="$(shuf -n1 -e "local" "remote")" # choose target at random m="$(shuf -n1 -e -- "${MAILBOXES[@]}")" if [ "$u" = "remote" ]; then case "$m" in foo/*) u="remote1"; m="${m#foo/}"; m="${m//\//^}";; bar/*) u="remote2"; m="${m#bar/}"; m="${m//\//\\}";; baz/*) u="remote3"; m="${m#baz/}"; m="${m//\//\?}";; INBOX) u="$(shuf -n1 -e "remote1" "remote2" "remote3")";; *) error "Uh? $m";; esac fi # deliver between 1 and 5 messages to the chosen mailbox n="$(shuf -n1 -i1-5)" for (( i=0; i < n; i++)); do sample_message | deliver -u "$u" -- -m "$m" done # sleep a little bit (sometimes beyond --watch timer, sometimes not) s=$(shuf -n1 -i1-1500) [ $s -ge 1000 ] && s="$(printf "1.%03d" $((s-1000)))" || s="$(printf "0.%03d" $s)" sleep "$s" done # wait a little longer so interimap has time to run loop() again and # synchronize outstanding changes, then terminate the processes we # started above sleep 5 ptree_abort ${PID[@]} trap - EXIT INT TERM # check that the mailbox lists match diff -u --label="local/mailboxes" --label="remote1/mailboxes" \ <( doveadm -u "local" mailbox list --no-userdb-lookup | sed -n "s,^foo/,,p" | sort ) \ <( doveadm -u "remote1" mailbox list --no-userdb-lookup | tr '^' '/' | sort ) diff -u --label="local/mailboxes" --label="remote2/mailboxes" \ <( doveadm -u "local" mailbox list --no-userdb-lookup | sed -n "s,^bar/,,p" | sort ) \ <( doveadm -u "remote2" mailbox list --no-userdb-lookup | tr '\\' '/' | sort ) diff -u --label="local/mailboxes" --label="remote3/mailboxes" \ <( doveadm -u "local" mailbox list --no-userdb-lookup | sed -n "s,^baz/,,p" | sort ) \ <( doveadm -u "remote3" mailbox list --no-userdb-lookup | tr '?' '/' | sort ) for m in "${MAILBOXES[@]}"; do case "$m" in foo/*) u="remote1"; mb="${m#foo/}"; mr="${mb//\//^}";; bar/*) u="remote2"; mb="${m#bar/}"; mr="${mb//\//\\}";; baz/*) u="remote3"; mb="${m#baz/}"; mr="${mb//\//\?}";; INBOX) continue;; *) error "Uh? $m";; esac blob="x'$(printf "%s" "$mb" | tr "/" "\\0" | xxd -c256 -ps)'" check_mailbox_status2 "$blob" "$m" "$u" "$mr" done # vim: set filetype=bash : interimap-0.5.8/tests/sync-live-tls/000077500000000000000000000000001500320172000173555ustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-tls/interimap.remote000077700000000000000000000000001500320172000267772../tls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-tls/local.conf000077700000000000000000000000001500320172000253762../sync-live/local.confustar00rootroot00000000000000interimap-0.5.8/tests/sync-live-tls/remote.conf000066400000000000000000000001331500320172000215140ustar00rootroot00000000000000namespace inbox { separator = ^ } !include conf.d/imapd.conf !include conf.d/ssl.conf interimap-0.5.8/tests/sync-live-tls/t000077700000000000000000000000001500320172000220502../sync-live/tustar00rootroot00000000000000interimap-0.5.8/tests/sync-live/000077500000000000000000000000001500320172000165555ustar00rootroot00000000000000interimap-0.5.8/tests/sync-live/local.conf000066400000000000000000000000461500320172000205160ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/sync-live/remote.conf000066400000000000000000000000461500320172000207170ustar00rootroot00000000000000namespace inbox { separator = ^ } interimap-0.5.8/tests/sync-live/t000066400000000000000000000052171500320172000167500ustar00rootroot00000000000000TIMEOUT=60 # mailbox list and alphabet (exclude &, / and ~, which dovecot treats specially) declare -a MAILBOXES=( "INBOX" ) ALPHABET=() str="!\"#\$'()+,-0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]_\`abcdefghijklmnopqrstuvwxyz{|}" for ((i=0; i < ${#str}; i++)); do ALPHABET[i]="${str:i:1}" done interimap_init # start a long-lived interimap process interimap --watch=1 & PID=$! trap "ptree_abort $PID" EXIT INT TERM timer=$(( $(date +%s) + TIMEOUT )) while [ $(date +%s) -le $timer ]; do # create new mailbox with 10% probability if [ $(shuf -n1 -i0-9) -eq 0 ]; then m= d=$(shuf -n1 -i1-3) # random depth for (( i=0; i < d; i++)); do l=$(shuf -n1 -i1-16) m="${m:+$m.}$(shuf -n "$l" -e -- "${ALPHABET[@]}" | tr -d '\n')" done MAILBOXES+=( "$m" ) u="$(shuf -n1 -e "local" "remote")" # choose target at random [ "$u" = "local" ] || m="${m//./^}" doveadm -u "$u" mailbox create --no-userdb-lookup -- "$m" fi # EXPUNGE some messages u="$(shuf -n1 -e "local" "remote")" # choose target at random n="$(shuf -n1 -i0-3)" while read guid uid; do doveadm -u "$u" expunge --no-userdb-lookup mailbox-guid "$guid" uid "$uid" done < <(doveadm -u "$u" search --no-userdb-lookup all | shuf -n "$n") # mark some existing messages as read (toggle \Seen flag as unlike other # flags it's easier to query and check_mailboxes_status checks it) u="$(shuf -n1 -e "local" "remote")" # choose target at random n="$(shuf -n1 -i0-9)" while read guid uid; do a="$(shuf -n1 -e add remove replace)" doveadm -u "$u" flags "$a" --no-userdb-lookup "\\Seen" mailbox-guid "$guid" uid "$uid" done < <(doveadm -u "$u" search --no-userdb-lookup all | shuf -n "$n") # select at random a mailbox where to deliver some messages u="$(shuf -n1 -e "local" "remote")" # choose target at random m="$(shuf -n1 -e -- "${MAILBOXES[@]}")" [ "$u" = "local" ] || m="${m//./^}" # deliver between 1 and 5 messages to the chosen mailbox n="$(shuf -n1 -i1-5)" for (( i=0; i < n; i++)); do sample_message | deliver -u "$u" -- -m "$m" done # sleep a little bit (sometimes beyond --watch timer, sometimes not) s=$(shuf -n1 -i1-1500) [ $s -ge 1000 ] && s="$(printf "1.%03d" $((s-1000)))" || s="$(printf "0.%03d" $s)" sleep "$s" done # wait a little longer so interimap has time to run loop() again and # synchronize outstanding changes, then terminate the process we started # above sleep 5 ptree_abort $PID trap - EXIT INT TERM check_mailbox_list check_mailboxes_status "${MAILBOXES[@]}" # vim: set filetype=bash : interimap-0.5.8/tests/sync-mailbox-list/000077500000000000000000000000001500320172000202225ustar00rootroot00000000000000interimap-0.5.8/tests/sync-mailbox-list/local.conf000066400000000000000000000000461500320172000221630ustar00rootroot00000000000000namespace inbox { separator = . } interimap-0.5.8/tests/sync-mailbox-list/remote.conf000066400000000000000000000000461500320172000223640ustar00rootroot00000000000000namespace inbox { separator = ~ } interimap-0.5.8/tests/sync-mailbox-list/t000066400000000000000000000066241500320172000204200ustar00rootroot00000000000000# pre-create some mailboxes and susbscribe to some # foo: present on both, subscribed to both # bar: present on both, subscribed to local only # baz: present on both, subscribed to remote only # foo.bar: present on local only # foo.baz: present on remote only doveadm -u "local" mailbox create --no-userdb-lookup "foo" "bar" "baz" "foo.bar" "fo!o [b*a%r]" doveadm -u "local" mailbox subscribe --no-userdb-lookup "foo" "bar" doveadm -u "remote" mailbox create --no-userdb-lookup "foo" "bar" "baz" "foo~baz" "foo]bar" doveadm -u "remote" mailbox subscribe --no-userdb-lookup "foo" "baz" populate() { local i for ((i = 0; i < 32; i++)); do m="$(shuf -n1 -e -- "foo" "bar" "baz" "foo.bar" "fo!o [b*a%r]")" sample_message | deliver -u "local" -- -m "$m" m="$(shuf -n1 -e -- "foo" "bar" "baz" "foo~baz" "foo]bar")" sample_message | deliver -u "remote" -- -m "$m" done } verify() { check_mailbox_list || error check_mailboxes_status "foo" "bar" "baz" "foo.bar" "foo.baz" "INBOX" "fo!o [b*a%r]" "foo]bar" } populate step_start "pre-subscribtions" interimap_init grep -Fx "local: Subscribe to baz" <"$STDERR" || error grep -Fx "remote: Subscribe to bar" <"$STDERR" || error grep -Fx "local: Created mailbox foo.baz" <"$STDERR" || error grep -Fx "remote: Created mailbox foo~bar" <"$STDERR" || error step_done # ensure the mailbox list is synchronized step_start "mailbox list and content" verify check_mailbox_list -s step_done # delete a mailbox on one server and verify that synchronization fails as it's still in the database step_start "aborts if present in database" for u in "local" "remote"; do [ "$u" = "local" ] && { m="foo.bar"; m2="$m"; } || { m="foo.baz"; m2="foo~baz"; } doveadm -u "$u" mailbox delete --no-userdb-lookup "$m2" ! interimap || error grep -Fx "database: ERROR: Mailbox $m exists. Run \`interimap --target=database --delete $m\` to delete." <"$STDERR" interimap --target="database" --delete "$m" || error grep -Fx "database: Removed mailbox $m" <"$STDERR" || error interimap || error # create again grep -Fx "database: Created mailbox $m" <"$STDERR" || error grep -Fx "$u: Created mailbox $m2" <"$STDERR" || error done verify check_mailbox_list -s step_done # (un)subscribe from some mailboxes, including a non-existent one step_start "new (un)subscribtions" doveadm -u "local" mailbox unsubscribe --no-userdb-lookup "foo" doveadm -u "remote" mailbox unsubscribe --no-userdb-lookup "bar" doveadm -u "local" mailbox subscribe --no-userdb-lookup "foo.bar" "foo.nonexistent" "foo.baz" doveadm -u "remote" mailbox subscribe --no-userdb-lookup "foo~bar" "bar~nonexistent" populate interimap grep -Fx "remote: Unsubscribe to foo" <"$STDERR" grep -Fx "local: Unsubscribe to bar" <"$STDERR" grep -Fx "remote: Subscribe to foo~baz" <"$STDERR" verify check_mailbox_list -s $(doveadm -u "local" mailbox list --no-userdb-lookup) # exclude "foo.nonexistent" and "bar~nonexistent" # check that "baz", "foo.bar" and "foo.baz" are the only subscribed mailboxes sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF SELECT COUNT(*) FROM mailboxes WHERE subscribed <> (mailbox IN ( x'$(printf "%s" "baz" | xxd -ps)', x'$(printf "%s\\0%s" "foo" "bar" | xxd -ps)', x'$(printf "%s\\0%s" "foo" "baz" | xxd -ps)' )) EOF [ $(< "$TMPDIR/count") -eq 0 ] || error step_done # vim: set filetype=bash : interimap-0.5.8/tests/tls-ciphers/000077500000000000000000000000001500320172000171015ustar00rootroot00000000000000interimap-0.5.8/tests/tls-ciphers/interimap.remote000077700000000000000000000000001500320172000265232../tls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/tls-ciphers/remote.conf000077700000000000000000000000001500320172000244152../tls/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/tls-ciphers/t000066400000000000000000000022041500320172000172650ustar00rootroot00000000000000# backup config install -m0600 "$XDG_CONFIG_HOME/interimap/config" "$XDG_CONFIG_HOME/interimap/config~" with_remote_config() { install -m0600 "$XDG_CONFIG_HOME/interimap/config~" "$XDG_CONFIG_HOME/interimap/config" cat >>"$XDG_CONFIG_HOME/interimap/config" } with_remote_config <<-EOF SSL_protocol_max = TLSv1.2 SSL_cipherlist = DHE-RSA-AES128-SHA256:ALL:!COMPLEMENTOFDEFAULT:!eNULL EOF interimap --debug || error grep -Fx "remote: SSL cipher: DHE-RSA-AES128-SHA256 (128 bits)" <"$STDERR" || error with_remote_config <<-EOF SSL_protocol_max = TLSv1.2 SSL_cipherlist = NONEXISTENT:ECDHE-RSA-AES256-SHA384:ALL:!COMPLEMENTOFDEFAULT:!eNULL SSL_ciphersuites = TLS_CHACHA20_POLY1305_SHA256:TLS_AES_128_GCM_SHA256 EOF interimap --debug || error grep -Fx "remote: SSL cipher: ECDHE-RSA-AES256-SHA384 (256 bits)" <"$STDERR" || error with_remote_config <<-EOF SSL_protocol_min = TLSv1.3 SSL_cipherlist = DHE-RSA-AES128-SHA256 SSL_ciphersuites = TLS_CHACHA20_POLY1305_SHA256:TLS_AES_128_GCM_SHA256 EOF interimap --debug || error grep -Fx "remote: SSL cipher: TLS_CHACHA20_POLY1305_SHA256 (256 bits)" <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/tls-pin-fingerprint/000077500000000000000000000000001500320172000205575ustar00rootroot00000000000000interimap-0.5.8/tests/tls-pin-fingerprint/interimap.remote000077700000000000000000000000001500320172000302012../tls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/tls-pin-fingerprint/remote.conf000077700000000000000000000000001500320172000260732../tls/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/tls-pin-fingerprint/t000066400000000000000000000055021500320172000207470ustar00rootroot00000000000000ssl_server_cert_file="$(doveconf -c "$HOME_remote/.dovecot/config" -hx ssl_server/cert_file)" PKEY_SHA256="$(openssl x509 -in "$ssl_server_cert_file" -pubkey \ | openssl pkey -in /dev/stdin -pubin -outform DER \ | openssl dgst -sha256 | sed -rn "/^.*=\\s*/ {s///p;q}")" INVALID_FPR="sha256\$deadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeef" INVALID_FPR2="sha256\$deadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbee2" # backup config install -m0600 "$XDG_CONFIG_HOME/interimap/config" "$XDG_CONFIG_HOME/interimap/config~" with_remote_config() { install -m0600 "$XDG_CONFIG_HOME/interimap/config~" "$XDG_CONFIG_HOME/interimap/config" cat >>"$XDG_CONFIG_HOME/interimap/config" } # pinned valid fingerprint with_remote_config <<-EOF SSL_fingerprint = sha256\$$PKEY_SHA256 EOF for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done interimap_init check_mailbox_status "INBOX" # with default algorithm (SHA256) with_remote_config <<-EOF SSL_fingerprint = $INVALID_FPR $PKEY_SHA256 EOF interimap --debug || error grep -Fx "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_SHA256" <"$STDERR" || error # and now an invalid one with_remote_config <<-EOF SSL_fingerprint = $INVALID_FPR EOF ! interimap --debug || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error grep -Fx "remote: WARNING: Fingerprint doesn't match! MiTM in action?" <"$STDERR" || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # make sure we didn't send any credentials or started speaking IMAP ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error grep -Fx "remote: IMAP traffic (bytes): recv 0 sent 0" <"$STDERR" || error # two invalid ones with_remote_config <<-EOF SSL_fingerprint = $INVALID_FPR $INVALID_FPR2 EOF ! interimap --debug || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error grep -Fx "remote: WARNING: Fingerprint doesn't match! MiTM in action?" <"$STDERR" || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # make sure we didn't send any credentials or started speaking IMAP ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error grep -Fx "remote: IMAP traffic (bytes): recv 0 sent 0" <"$STDERR" || error # valid + invalid with_remote_config <<-EOF SSL_fingerprint = sha256\$$PKEY_SHA256 $INVALID_FPR EOF interimap --debug || error grep -Fx "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_SHA256" <"$STDERR" || error # invalid + valid with_remote_config <<-EOF SSL_fingerprint = $INVALID_FPR sha256\$$PKEY_SHA256 EOF interimap --debug || error grep -Fx "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_SHA256" <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/tls-protocols/000077500000000000000000000000001500320172000174705ustar00rootroot00000000000000interimap-0.5.8/tests/tls-protocols/interimap.remote000077700000000000000000000000001500320172000271122../tls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/tls-protocols/openssl.cnf000066400000000000000000000004541500320172000216460ustar00rootroot00000000000000# as we want to test TLSv1 we need to set MinProtocol=None, see # see /usr/share/doc/libssl1.1/NEWS.Debian.gz openssl_conf = default_conf [default_conf] ssl_conf = ssl_sect [ssl_sect] system_default = system_default_sect [system_default_sect] MinProtocol = None CipherString = DEFAULT@SECLEVEL=0 interimap-0.5.8/tests/tls-protocols/remote.conf000066400000000000000000000001621500320172000216310ustar00rootroot00000000000000!include conf.d/imapd.conf !include conf.d/ssl.conf ssl_min_protocol = TLSv1 ssl_cipher_list = DEFAULT@SECLEVEL=0 interimap-0.5.8/tests/tls-protocols/t000066400000000000000000000107771500320172000176720ustar00rootroot00000000000000# system default interimap --debug || error ! grep -E "^remote: Disabling SSL protocols: " <"$STDERR" || error # TODO deprecated ! grep -E "^remote: Minimum SSL/TLS protocol version: " <"$STDERR" || error ! grep -E "^remote: Maximum SSL/TLS protocol version: " <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv" <"$STDERR" || error # load custom OpenSSL configuration to allow TLS protocol version <=1.1 export OPENSSL_CONF="$TESTDIR/openssl.cnf" # backup config install -m0600 "$XDG_CONFIG_HOME/interimap/config" "$XDG_CONFIG_HOME/interimap/config~" with_remote_tls_protocols() { install -m0600 "$XDG_CONFIG_HOME/interimap/config~" "$XDG_CONFIG_HOME/interimap/config" printf "SSL_protocols = %s\\n" "$*" >>"$XDG_CONFIG_HOME/interimap/config" } # disable TLSv1.2 and earlier with_remote_tls_protocols "!SSLv2" "!SSLv3" "!TLSv1" "!TLSv1.1" "!TLSv1.2" interimap --debug || error grep -Fx "remote: Disabling SSL protocols: SSLv3, TLSv1, TLSv1.1, TLSv1.2" <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv1\.3 " <"$STDERR" || error interimap || error grep -E "^remote: WARNING: SSL_protocols is deprecated " <"$STDERR" || error "no deprecation warning" # force TLSv1.2 with_remote_tls_protocols "TLSv1.2" interimap --debug || error grep -Fx "remote: Disabling SSL protocols: SSLv3, TLSv1, TLSv1.1, TLSv1.3" <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv1\.2 " <"$STDERR" || error # force TLSv1 to TLSv1.2 with_remote_tls_protocols "TLSv1" "TLSv1.1" "TLSv1.2" interimap --debug || error grep -Fx "remote: Disabling SSL protocols: SSLv3, TLSv1.3" <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv(1\.[12])? " <"$STDERR" || error # force SSLv2 and SSLv3; this fails due to dovecot's ssl_min_protocol=TLSv1 with_remote_tls_protocols "SSLv2" "SSLv3" ! interimap --debug || error grep -Fx "remote: Disabling SSL protocols: TLSv1, TLSv1.1, TLSv1.2, TLSv1.3" <"$STDERR" || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # make sure we didn't send any credentials or started speaking IMAP ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error grep -Fx "remote: IMAP traffic (bytes): recv 0 sent 0" <"$STDERR" || error # new interface: SSL_protocol_{min,max} with_remote_tls_protocol_min_max() { install -m0600 "$XDG_CONFIG_HOME/interimap/config~" "$XDG_CONFIG_HOME/interimap/config" if [ -n "${1-}" ]; then printf "SSL_protocol_min = %s\\n" "$1" >>"$XDG_CONFIG_HOME/interimap/config" fi if [ -n "${2-}" ]; then printf "SSL_protocol_max = %s\\n" "$2" >>"$XDG_CONFIG_HOME/interimap/config" fi } # disable TLSv1.2 and earlier # XXX this test assumes that TLSv1.3 is the highest version supported with_remote_tls_protocol_min_max "TLSv1.3" interimap --debug || error grep -Fx "remote: Minimum SSL/TLS protocol version: TLSv1.3" <"$STDERR" || error ! grep -E "^remote: Maximum SSL/TLS protocol version: " <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv1\.3 " <"$STDERR" || error # force TLSv1.2 with_remote_tls_protocol_min_max "TLSv1.2" "TLSv1.2" interimap --debug || error grep -Fx "remote: Minimum SSL/TLS protocol version: TLSv1.2" <"$STDERR" || error grep -Fx "remote: Maximum SSL/TLS protocol version: TLSv1.2" <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv1\.2 " <"$STDERR" || error # disable TLSv1.2 and later with_remote_tls_protocol_min_max "" "TLSv1.1" interimap --debug || error ! grep -E "^remote: Minimum SSL/TLS protocol version: " <"$STDERR" || error grep -Fx "remote: Maximum SSL/TLS protocol version: TLSv1.1" <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv1\.1 " <"$STDERR" || error # force SSLv3 to to TLSv1.1 with_remote_tls_protocol_min_max "SSLv3" "TLSv1.1" interimap --debug || error grep -Fx "remote: Minimum SSL/TLS protocol version: SSLv3" <"$STDERR" || error grep -Fx "remote: Maximum SSL/TLS protocol version: TLSv1.1" <"$STDERR" || error grep -E "^remote: SSL protocol: TLSv1(\.1)? " <"$STDERR" || error # force SSLv3; this fails due to dovecot's ssl_min_protocol=TLSv1 with_remote_tls_protocol_min_max "SSLv3" "SSLv3" ! interimap --debug || error grep -Fx "remote: Minimum SSL/TLS protocol version: SSLv3" <"$STDERR" || error grep -Fx "remote: Maximum SSL/TLS protocol version: SSLv3" <"$STDERR" || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # make sure we didn't send any credentials or started speaking IMAP ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error grep -Fx "remote: IMAP traffic (bytes): recv 0 sent 0" <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/tls-rsa+ecdsa/000077500000000000000000000000001500320172000173045ustar00rootroot00000000000000interimap-0.5.8/tests/tls-rsa+ecdsa/interimap.remote000077700000000000000000000000001500320172000267262../tls/interimap.remoteustar00rootroot00000000000000interimap-0.5.8/tests/tls-rsa+ecdsa/remote.conf000066400000000000000000000002341500320172000214450ustar00rootroot00000000000000!include conf.d/imapd.conf !include conf.d/ssl.conf ssl_server_alt_cert_file = conf.d/dovecot.ecdsa.crt ssl_server_alt_key_file = conf.d/dovecot.ecdsa.key interimap-0.5.8/tests/tls-rsa+ecdsa/t000066400000000000000000000045001500320172000174710ustar00rootroot00000000000000doveconf_remote() { local p k="$1" p="$(doveconf -c "$HOME_remote/.dovecot/config" -hx "$1")" cat <"$p" } pkey_sha256() { openssl x509 -in /dev/stdin -pubkey \ | openssl pkey -in /dev/stdin -pubin -outform DER \ | openssl dgst -sha256 | sed -rn "/^.*=\\s*/ {s///p;q}" } x509_sha256() { openssl x509 -in /dev/stdin -noout -fingerprint -sha256 \ | sed -rn "/^.*=\\s*/ {s///p;q}" | tr -d : | tr "[A-Z]" "[a-z]" } PKEY_SHA256="$(doveconf_remote ssl_server/cert_file | pkey_sha256)" X509_SHA256="$(doveconf_remote ssl_server/cert_file | x509_sha256)" PKEY_ALT_SHA256="$(doveconf_remote ssl_server/alt_cert_file | pkey_sha256)" X509_ALT_SHA256="$(doveconf_remote ssl_server/alt_cert_file | x509_sha256)" # pinned valid fingerprints cat >>"$XDG_CONFIG_HOME/interimap/config" <<-EOF SSL_fingerprint = sha256\$$PKEY_SHA256 sha256\$$PKEY_ALT_SHA256 EOF for ((i = 0; i < 32; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done interimap_init check_mailbox_status "INBOX" interimap --debug || error # which peer certificate is used is up to libssl grep -Fx -e "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" \ -e "remote: Peer certificate fingerprint: sha256\$$X509_ALT_SHA256" \ <"$STDERR" || error grep -Fx -e "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_SHA256" \ -e "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_ALT_SHA256" \ <"$STDERR" || error # force RSA # XXX we also have to force TLS <=1.2 here as the TLSv1.3 ciphersuites # don't specify the certificate type (nor key exchange) cat >>"$XDG_CONFIG_HOME/interimap/config" <<-EOF SSL_protocol_max = TLSv1.2 SSL_cipherlist = EECDH+AESGCM+aRSA EOF interimap --debug || error grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" <"$STDERR" || error grep -Fx "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_SHA256" <"$STDERR" || error # force ECDSA sed -i "s/^SSL_cipherlist\\s*=.*/SSL_cipherlist = EECDH+AESGCM+aECDSA/" -- "$XDG_CONFIG_HOME/interimap/config" interimap --debug || error grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_ALT_SHA256" <"$STDERR" || error grep -Fx "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_ALT_SHA256" <"$STDERR" || error # vim: set filetype=bash : interimap-0.5.8/tests/tls-sni/000077500000000000000000000000001500320172000162355ustar00rootroot00000000000000interimap-0.5.8/tests/tls-sni/interimap.remote000066400000000000000000000000521500320172000214370ustar00rootroot00000000000000type = imaps port = 10993 SSL_verify = no interimap-0.5.8/tests/tls-sni/remote.conf000066400000000000000000000002721500320172000204000ustar00rootroot00000000000000!include conf.d/imapd.conf !include conf.d/ssl.conf local_name imap.example.net { ssl_server_cert_file = conf.d/dovecot.rsa2.crt ssl_server_key_file = conf.d/dovecot.rsa2.key } interimap-0.5.8/tests/tls-sni/t000066400000000000000000000057011500320172000164260ustar00rootroot00000000000000SERVERNAME="imap.example.net" # cf local_name{} section in the dovecot config ssl_server_cert_file="$(doveconf -c "$HOME_remote/.dovecot/config" -hx ssl_server/cert_file)" X509_SHA256="$(openssl x509 -in "$ssl_server_cert_file" -noout -fingerprint -sha256 \ | sed -rn "/^.*=\\s*/ {s///p;q}" | tr -d : | tr "[A-Z]" "[a-z]")" ssl_server_cert_file2="$(doveconf -c "$HOME_remote/.dovecot/config" -f local_name="$SERVERNAME" -hx ssl_server/cert_file)" X509_2_SHA256="$(openssl x509 -in "$ssl_server_cert_file2" -noout -fingerprint -sha256 \ | sed -rn "/^.*=\\s*/ {s///p;q}" | tr -d : | tr "[A-Z]" "[a-z]")" # check that empty SSL_hostname disables SNI echo "SSL_hostname =" >>"$XDG_CONFIG_HOME/interimap/config" interimap --debug || error ! grep "^remote: Using SNI with name " <"$STDERR" || error "Empty SSL_hostname didn't disable SNI" # default servername is the host value sed -i "/^SSL_hostname\\s*=/d" -- "$XDG_CONFIG_HOME/interimap/config" interimap --debug || error grep -Fx "remote: Using SNI with name localhost" <"$STDERR" || error "No default SNI" grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" <"$STDERR" || error # verify that SNI is not used when host is an IP echo "host = __INVALID__" >>"$XDG_CONFIG_HOME/interimap/config" for ip in "127.0.0.1" "[::1]"; do sed -i "s/^host\\s*=.*/host = $ip/" -- "$XDG_CONFIG_HOME/interimap/config" interimap --debug || error ! grep "^remote: Using SNI with name " <"$STDERR" || error "Using SNI with IP $ip" grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" <"$STDERR" || error done # verify that SNI actually works (ie we're served the right cert) sni_ok() { grep -Fx "remote: Using SNI with name $SERVERNAME" <"$STDERR" || error grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_2_SHA256" <"$STDERR" || error } echo "SSL_hostname = $SERVERNAME" >>"$XDG_CONFIG_HOME/interimap/config" interimap --debug || error sni_ok ## make sure SSL_hostname doesn't affect certificate verification ## # bad CA, bad host sed -i "s/^host\\s*=.*/host = 127.0.0.1/" -- "$XDG_CONFIG_HOME/interimap/config" sed -i "s/^SSL_verify\\s*=.*/SSL_verify = YES/" -- "$XDG_CONFIG_HOME/interimap/config" ! interimap --debug || error sni_ok grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # good CA, bad host echo "SSL_CAfile = $HOME/.dovecot/conf.d/ca.crt" >>"$XDG_CONFIG_HOME/interimap/config" ! interimap --debug || error sni_ok grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # bad CA, good host sed -i "/^SSL_CAfile\\s*=/d" -- "$XDG_CONFIG_HOME/interimap/config" sed -i "s/^host\\s*=.*/host = localhost/" -- "$XDG_CONFIG_HOME/interimap/config" ! interimap --debug || error sni_ok grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error # good CA, good host echo "SSL_CAfile = $HOME/.dovecot/conf.d/ca.crt" >>"$XDG_CONFIG_HOME/interimap/config" interimap --debug || error sni_ok # vim: set filetype=bash : interimap-0.5.8/tests/tls-verify-peer/000077500000000000000000000000001500320172000177015ustar00rootroot00000000000000interimap-0.5.8/tests/tls-verify-peer/interimap.remote000066400000000000000000000000151500320172000231020ustar00rootroot00000000000000port = 10993 interimap-0.5.8/tests/tls-verify-peer/remote.conf000077700000000000000000000000001500320172000252152../tls/remote.confustar00rootroot00000000000000interimap-0.5.8/tests/tls-verify-peer/t000066400000000000000000000117541500320172000200770ustar00rootroot00000000000000ssl_server_cert_file="$(doveconf -c "$HOME_remote/.dovecot/config" -hx ssl_server/cert_file)" X509_SHA256="$(openssl x509 -in "$ssl_server_cert_file" -noout -fingerprint -sha256 \ | sed -rn "/^.*=\\s*/ {s///p;q}" | tr -d : | tr "[A-Z]" "[a-z]")" PKEY_SHA256="$(openssl x509 -in "$ssl_server_cert_file" -pubkey \ | openssl pkey -in /dev/stdin -pubin -outform DER \ | openssl dgst -sha256 | sed -rn "/^.*=\\s*/ {s///p;q}")" unverified_peer() { ! interimap --debug || error # make sure we aborted the handshake immediately after connecting grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" <"$STDERR" || error grep -Fx "remote: ERROR: Can't initiate TLS/SSL handshake" <"$STDERR" || error sed -nr "s/remote: \[[0-9]+\] (preverify=[0-9]+)$/\1/p" <"$STDERR" >"$TMPDIR/preverify" [ -s "$TMPDIR/preverify" ] || error ! grep -Fvx "preverify=0" <"$TMPDIR/preverify" || error # make sure we didn't send any credentials or started speaking IMAP ! grep -E "^remote: C: .* (AUTHENTICATE|LOGIN) " <"$STDERR" || error grep -Fx "remote: IMAP traffic (bytes): recv 0 sent 0" <"$STDERR" || error } verified_peer() { local i u for ((i = 0; i < 4; i++)); do u="$(shuf -n1 -e "local" "remote")" sample_message | deliver -u "$u" done interimap --debug || error grep -Fx "remote: Peer certificate fingerprint: sha256\$$X509_SHA256" <"$STDERR" || error sed -nr "s/remote: \[[0-9]+\] (preverify=[0-9]+)$/\1/p" <"$STDERR" >"$TMPDIR/preverify" [ -s "$TMPDIR/preverify" ] || error ! grep -Fvx "preverify=1" <"$TMPDIR/preverify" || error grep "^remote: SSL protocol: TLSv" <"$STDERR" || error grep "^remote: SSL cipher: " <"$STDERR" || error check_mailbox_status "INBOX" } # backup config install -m0600 -- "$XDG_CONFIG_HOME/interimap/config" "$XDG_CONFIG_HOME/interimap/config~" with_remote_config() { install -m0600 -- "$XDG_CONFIG_HOME/interimap/config~" "$XDG_CONFIG_HOME/interimap/config" cat >>"$XDG_CONFIG_HOME/interimap/config" } step_start "peer verification enabled by default" # assume our fake root CA is not among OpenSSL's default trusted CAs unverified_peer grep -Fx "remote: Using default locations for trusted CA certificates" <"$STDERR" || error step_done step_start "peer verification result honored when pinned pubkey matches" with_remote_config <<-EOF SSL_fingerprint = sha256\$$PKEY_SHA256 EOF unverified_peer grep -Fx "remote: Using default locations for trusted CA certificates" <"$STDERR" || error grep -Fx "remote: Peer certificate matches pinned SPKI digest sha256\$$PKEY_SHA256" <"$STDERR" || error step_done capath=$(mktemp --tmpdir="$TMPDIR" --directory capath.XXXXXX) cp -T -- ~/.dovecot/conf.d/ca.crt "$capath/ca-certificates.crt" step_start "SSL_CAfile/\$SSL_CERT_FILE" # verify that an error is raised when CAfile can't be loaded # (it's not the case for $SSL_CERT_FILE, cf. SSL_CTX_load_verify_locations(3ssl)) with_remote_config <<<"SSL_CAfile = /nonexistent" ! interimap --debug || error grep -Fx "remote: ERROR: SSL_CTX_load_verify_locations()" <"$STDERR" || error grep -Fx "remote: IMAP traffic (bytes): recv 0 sent 0" <"$STDERR" || error if [ -f "/etc/ssl/certs/ca-certificates.crt" ]; then # assume our fake root CA is not there with_remote_config <<<"SSL_CAfile = /etc/ssl/certs/ca-certificates.crt" unverified_peer fi # default host (localhost) is the CN (and also subjectAltName) with_remote_config <<<"SSL_CAfile = $capath/ca-certificates.crt" verified_peer with_remote_config