--- /dev/null
+/Makefile.old
+/pm_to_blib
+/MYMETA.yml
+/Makefile
+/blib
+/cover_db
+*.gz
--- /dev/null
+ GNU AFFERO GENERAL PUBLIC LICENSE
+ Version 3, 19 November 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are 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.
+
+ 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.
+
+ Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+ A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+ The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+ An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing under
+this license.
+
+ 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 Affero 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. Remote Network Interaction; Use with the GNU General Public License.
+
+ Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your version
+supports such interaction) an opportunity to receive the Corresponding
+Source of your version by providing access to the Corresponding Source
+from a network server at no charge, through some standard or customary
+means of facilitating copying of software. This Corresponding Source
+shall include the Corresponding Source for any work covered by version 3
+of the GNU General Public License that is incorporated pursuant to the
+following paragraph.
+
+ 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 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 work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU Affero 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 Affero 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 Affero 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 Affero 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero 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 Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for the
+specific requirements.
+
+ 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 AGPL, see
+<http://www.gnu.org/licenses/>.
--- /dev/null
+*.1
+*.5
+*.7
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+all::
+
+INSTALL = install
+PANDOC = pandoc
+PANDOC_OPTS = -f markdown --email-obfuscation=none
+pandoc = $(PANDOC) $(PANDOC_OPTS)
+
+m1 =
+m1 += ssoma
+m1 += ssoma-mda
+m1 += ssoma-rm
+
+m5 =
+m5 += ssoma_repository
+
+m7 =
+
+man1 := $(addsuffix .1, $(m1))
+man5 := $(addsuffix .5, $(m5))
+man7 := $(addsuffix .7, $(m7))
+
+all:: man
+
+man: $(man1) $(man5) $(man7)
+
+prefix ?= $(HOME)
+mandir ?= $(prefix)/share/man
+man1dir = $(mandir)/man1
+man5dir = $(mandir)/man5
+man7dir = $(mandir)/man7
+
+install-man: man
+ test -z "$(man1)" || $(INSTALL) -d -m 755 $(DESTDIR)$(man1dir)
+ test -z "$(man5)" || $(INSTALL) -d -m 755 $(DESTDIR)$(man5dir)
+ test -z "$(man7)" || $(INSTALL) -d -m 755 $(DESTDIR)$(man7dir)
+ test -z "$(man1)" || $(INSTALL) -m 644 $(man1) $(DESTDIR)$(man1dir)
+ test -z "$(man5)" || $(INSTALL) -m 644 $(man5) $(DESTDIR)$(man5dir)
+ test -z "$(man7)" || $(INSTALL) -m 644 $(man7) $(DESTDIR)$(man7dir)
+%.1 %.5 %.7 : %.txt
+ $(pandoc) -s -t man < $< > $@+ && mv $@+ $@
+
+clean::
+ $(RM) $(man1) $(man5) $(man7)
--- /dev/null
+% ssoma-mda(1) ssoma user manual
+
+# NAME
+
+ssoma-mda - mail delivery agent for ssoma
+
+# SYNOPSIS
+
+ssoma-mda /path/to/ssoma/repository.git < message
+
+# DESCRIPTION
+
+ssoma-mda delivers messages to a git repository as described by
+ssoma_repository(5). It reads messages from STDIN and takes no
+command-line arguments. It may be invoked by the MTA (mail transport
+agent, e.g. postfix or exim) or as part of another MDA (e.g. procmail or
+maildrop)
+
+ssoma-mda takes no command-line options and does not alter its own
+permissions. This must be done by the MTA or MDA which invokes
+ssoma-mda.
+
+# FILES
+
+See ssoma_repository(5) for details.
+
+# ENVIRONMENT
+
+ssoma-mda depends on no environment variables
+
+# CONTACT
+
+All feedback welcome via plain-text mail to <ssoma@public-inbox.org>\
+The mail archives are hosted at git://public-inbox.org/ssoma
+See ssoma(1) for instructions on how to subscribe.
+
+# COPYRIGHT
+
+Copyright 2013, Eric Wong <normalperson@yhbt.net> and all contributors.\
+License: AGPLv3 or later <http://www.gnu.org/licenses/agpl-3.0.txt>
+
+# SEE ALSO
+
+git(1), ssoma(1), ssoma_repository(5)
--- /dev/null
+% ssoma-rm(1) ssoma user manual
+
+# NAME
+
+ssoma-rm - remove messages from a ssoma repository
+
+# SYNOPSIS
+
+ssoma-rm /path/to/ssoma/repository.git < message
+
+# DESCRIPTION
+
+ssoma-rm removes messages from a ssoma repository. It only deletes
+messages which match the Message-ID, Subject, and body of the email.
+Thus the output of "ssoma cat" is ideal for ssoma-rm. ssoma-rm only
+works on the latest HEAD (refs/heads/master) of the ssoma repository.
+It does not remove the message from history, but prevents future users
+of "ssoma sync" from seeing the message in their mailbox.
+
+# CONTACT
+
+All feedback welcome via plain-text mail to <ssoma@public-inbox.org>\
+The mail archives are hosted at git://public-inbox.org/ssoma
+See ssoma(1) for instructions on how to subscribe.
+
+# COPYRIGHT
+
+Copyright 2013, Eric Wong <normalperson@yhbt.net> and all contributors.\
+License: AGPLv3 or later <http://www.gnu.org/licenses/agpl-3.0.txt>
+
+# SEE ALSO
+
+git(1), ssoma(1), ssoma_repository(5)
--- /dev/null
+% ssoma(1) ssoma user manual
+
+# NAME
+
+ssoma - mail archive synchronization and extraction client
+
+# SYNOPSIS
+
+ssoma add LISTNAME URL maildir:/path/to/maildir/
+ssoma add LISTNAME URL mbox:/path/to/mbox
+ssoma add LISTNAME URL imap://USER@HOST/INBOX
+ssoma sync [LISTNAME]
+ssoma cat MESSAGE-ID [LISTNAME|GIT_DIR]
+
+# DESCRIPTION
+
+The client component of ssoma may be used to sync and export mail to Maildir
+or mbox(5) from any published ssoma git repository.
+
+* add LISTNAME URL DESTINATION
+
+This starts a subscription to a mailing list by configuring a git
+repository. LISTNAME is a name of your choosing. It must only consist
+of alphanumeric characters, underscores, periods and dashes, and must start
+and end with an alphanumeric character. URL is the URL to a git repository,
+this supports all URLs git(7) supports. DESTINATION is the local
+destination to extract mail to. This may be a maildir:, mbox: path,
+or an imap:// or imaps:// URL.
+.
+The repository is stored in ~/.ssoma/$LISTNAME.git If at any time
+a user wishes to stop following the list, just remove the git repository
+from your file system.
+.
+IMAP users may configure the imap.pass and imap.tunnel variables in
+~/.ssoma/$LISTNAME.git/config in the same way as git-imap-send(1).
+Remember to restrict permissions to ~/.ssoma/$LISTNAME.git/config
+if you are storing a password in it.
+
+* sync [LISTNAME]
+
+This clones/fetches from the remote git repository into the local
+repository and extracts messages into destinations configured with the
+"add" sub-command. If LISTNAME is not given, all list subscriptions are
+synchronized. If LISTNAME is given, only subscriptions for a given LISTNAME
+is synchronized.
+
+* cat MESSAGE-ID [LISTNAME|GIT_DIR]
+
+This outputs the message matching MESSAGE-ID to stdout (in mbox format).
+If LISTNAME is given, this limits the Message-ID search to that list.
+.
+Specifying a GIT_DIR in place of LISTNAME is also possible, this is
+intended for administrators using ssoma-rm(1).
+
+# FILES
+
+All client-side git repositories are stored in ~/.ssoma/$LISTNAME.git/
+See ssoma_repository(5) for details.
+
+# ENVIRONMENT VARIABLES
+
+SSOMA_HOME may be used to override the default ~/.ssoma/ directory.
+This is useful for testing, but not recommended otherwise.
+
+# CONTACT
+
+All feedback welcome via plain-text mail to <ssoma@public-inbox.org>\
+The mail archives are hosted at git://public-inbox.org/ssoma
+You may subscribe using ssoma:
+
+ ssoma add ssoma git://public-inbox.org/ssoma mbox:/path/to/mbox
+ ssoma sync ssoma
+
+# SOURCE CODE
+
+ git clone git://bogomips.org/ssoma
+
+# COPYRIGHT
+
+Copyright 2013, Eric Wong <normalperson@yhbt.net> and all contributors.\
+License: AGPLv3 or later <http://www.gnu.org/licenses/agpl-3.0.txt>
+
+# SEE ALSO
+
+git(1), ssoma_repository(5), ssoma-rm(1)
--- /dev/null
+% ssoma_repository(5) ssoma user manual
+
+# NAME
+
+ssoma_repository - repository and tree description for ssoma
+
+# DESCRIPTION
+
+ssoma uses a git repository to store each email as a git blob. The tree
+filename of the blob is based on the SHA1 hexdigest of the Message-Id
+header. A commit is made for each message delivered. The commit SHA-1
+identifier is used by ssoma clients to track synchronization state.
+
+# PATHNAMES IN TREES
+
+A Message-Id may be extremely long and also contain slashes, so using
+them as a path name is challenging. Instead we use the SHA-1 hexdigest
+of the Message-Id (including the "<" and ">") to generate a path name.
+Leading and trailing white space in the Message-Id header is ignored
+for hashing.
+
+A message with Message-Id of: <20131106023245.GA20224@dcvr.yhbt.net>
+
+Would be stored as: 21/4527ce3741f50bb9afa65e7c5003c8a8ddc4b1
+
+Thus it is easy to look up the contents of a message matching a given
+a Message-Id.
+
+# CONFLICTS
+
+Message-Id is a unique-enough identifier for practical purposes, but
+they may still conflict (especially in case of malicious clients and
+timing issues). In the case of identical Message-Id and different
+messages, the blob shall become a tree with multiple messages.
+Likewise, if there is a (rare) SHA-1 conflict on different Message-Id
+headers, the tree will contain each message (with different Message-Id
+headers).
+
+Thus the blobs for conflicting Message-Ids will be the SHA-1 hexdigest
+of the Subject header and raw body (no extra whitespace delimiting the
+two).
+
+ PFX=21/4527ce3741f50bb9afa65e7c5003c8a8ddc4b1
+
+ $PFX/287d8b67bf8ebdb30e34cb4ca9995dbd465f37aa # first copy
+ $PFX/287d8b67bf8ebdb30e34cb4ca9995dbd465f37ab # second copy
+ $PFX/287d8b67bf8ebdb30e34cb4ca9995dbd465f37ac # third copy
+
+# LOCKING
+
+fcntl(2) locking exclusively locks the empty $GIT_DIR/ssoma.lock file
+for all non-atomic operations.
+
+# EXAMPLE INPUT FLOW (SERVER-SIDE MDA)
+
+1. Message is delivered to a mail transport agent (MTA)
+1a. (optional) reject/discard spam, this should run before ssoma-lda
+1b. (optional) reject/strip unwanted attachments
+
+ssoma-mda handles all steps once invoked.
+
+2. Mail transport agent invokes ssoma-mda
+3. reads message via stdin, extracting Message-Id
+4. acquires fcntl lock on $GIT_DIR/ssoma.lock
+5. creates or updates the blob of associated 2/38 SHA-1 path
+6. updates the index and commits
+7. releases $GIT_DIR/ssoma.lock
+
+ssoma-mda can also be used as an inotify(7) trigger to monitor maildirs,
+and the ability to monitor IMAP mailboxes using IDLE will be available
+in the future.
+
+# GIT REPOSITORIES (SERVERS)
+
+ssoma uses bare git repositories on both servers and clients.
+
+Using the git-init(1) command with --bare is the recommend method
+of creating a git repository on a server:
+
+ git init --bare /path/to/wherever/you/want.git
+
+There are no standardized paths for servers, administrators make
+all the choices regarding git repository locations.
+
+Special files in $GIT_DIR on the server:
+
+* $GIT_DIR/ssoma.index - a git index file used for MDA updates,
+: The normal git index (in $GIT_DIR/index) is not used at all as
+ there is typically no working tree.
+
+* $GIT_DIR/ssoma.lock - empty file for fcntl(2) locking
+: This is necessary to ensure the index and commits are updated
+ consistently and multiple processes running MDA do not step on
+ each other.
+
+# GIT REPOSITORIES (CLIENTS)
+
+ssoma uses bare git repositories for clients (as well as servers).
+
+The default is to use GIT_DIR=~/.ssoma/$LISTNAME.git in the user's home
+directory. This is a bare git repository with two additional files:
+
+* $GIT_DIR/ssoma.lock - empty lock file, same as used by ssoma-mda(1)
+* $GIT_DIR/ssoma.state - a git-config(1) format file used by ssoma(1)
+
+Each client $GIT_DIR may have multiple mbox/maildir/command targets.
+It is possible for a client to extract the mail stored in the git
+repository to multiple mboxes for compatibility with a variety of
+different tools.
+
+# $GIT_DIR/ssoma.state format.
+
+ ; "local" is the default name (analogous to "origin" with remotes)
+ [target "local"]
+ path = /path/to/mbox
+
+ ; this tells ssoma where to start the next import from
+ ; this means ssoma will not redundantly import old
+ ; messages and the user is free to move/delete old
+ ; messages from the mbox.
+ last-imported = 33eaf25f43fd73d8f4f7b0a066b689809d733191
+
+ ; "alt" is a user-defined name, in case a user wants to output
+ ; the repo in several formats
+ [target "alt"]
+ ; note the trailing '/' to denote the maildir path,
+ ; the Email::LocalDelivery Perl module depends on this
+ ; trailing slash to identify it as a maildir
+ path = /path/to/maildir/
+ last-imported = 950815b313a4e616c6fe39f46b2e894b51d7d62f
+
+ ; users may also choose to pipe to an arbitrary command of their
+ ; choice, this filter may behave like an MDA (and implement
+ ; filtering). Tools like procmail(1)/maildrop(1) may be
+ ; invoked here.
+ [target "script"]
+ command = /path/to/executable/which/reads-mail-from-stdin
+ last-imported = 950815b313a4e616c6fe39f46b2e894b51d7d62f
+
+# EXAMPLE OUTPUT FLOW (CLIENT)
+
+1. clone or fetches to bare git repo (GIT_DIR=~/.ssoma/$LISTNAME.git)
+2. checks for last-imported commit in ~/.ssoma/$LISTNAME.git/ssoma.state
+3. diffs last-imported commit with current HEAD
+4. imports new emails to mbox/maildir since last-imported up to current HEAD
+5. updates last-imported commit
+
+# CAVEATS
+
+It is NOT recommended to check out the working directory of a git.
+there may be many files.
+
+It is impossible to completely expunge messages, even spam, as git
+retains full history. Projects may (with adequate notice) cycle to new
+repositories/branches with history cleaned up via git-filter-branch(1).
+This is up to the administrators.
+
+# COPYRIGHT
+
+Copyright 2013, Eric Wong <normalperson@yhbt.net> and all contributors.\
+License: AGPLv3 or later <http://www.gnu.org/licenses/agpl-3.0.txt>
--- /dev/null
+standard MakeMaker installation (Perl)
+--------------------------------------
+
+ perl Makefile.PL
+ make
+ make test
+ make install # root permissions may be needed
+
+Requirements (MUA client)
+-------------------------
+* git
+* Perl and several modules:
+ - Email::LocalDelivery
+ - Email::Simple
+ - Net::IMAP::Simple
+ - Digest::SHA
+* any MUA capable of reading/importing IMAP, mbox(5) or Maildir
+
+Requirements (server MDA)
+-------------------------
+* git
+* MTA - postfix is recommended
+* Perl and several modules:
+ - Email::Simple
+ - File::FcntlLock
+ - Digest::SHA
+
+Copyright
+---------
+Copyright 2013, Eric Wong <normalperson@yhbt.net> and all contributors.
+License: AGPLv3 or later <http://www.gnu.org/licenses/agpl-3.0.txt>
--- /dev/null
+.gitignore
+COPYING
+Documentation/.gitignore
+Documentation/GNUmakefile
+Documentation/ssoma-mda.txt
+Documentation/ssoma-rm.txt
+Documentation/ssoma.txt
+Documentation/ssoma_repository.txt
+INSTALL
+Makefile.PL
+README
+lib/Ssoma/Extractor.pm
+lib/Ssoma/Git.pm
+lib/Ssoma/GitIndexInfo.pm
+lib/Ssoma/IMAP.pm
+lib/Ssoma/MDA.pm
+lib/Ssoma/Remover.pm
+ssoma
+ssoma-mda
+ssoma-rm
+t/all.t
+t/extractor.t
+t/git.t
+t/imap.t
+t/mda-badheaders.t
+t/mda-conflict.t
+t/mda-missing-mid.t
+t/remover.t
--- /dev/null
+#!/usr/bin/perl
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# Note: this may be rewritten in another language in the future,
+# so don't depend on any public Perl API
+use strict;
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'ssoma',
+ VERSION => '0.0.0',
+ AUTHOR => 'Eric Wong <normalperson@yhbt.net>',
+ ABSTRACT => 'some sort of mail archiver',
+ EXE_FILES => [qw/ssoma-mda ssoma ssoma-rm/],
+ PREREQ_PM => {
+ 'Email::LocalDelivery' => 0,
+ 'Email::Simple' => 0,
+ 'File::FcntlLock' => 0,
+ 'Net::IMAP::Simple' => 0,
+ 'Digest::SHA' => 0,
+ },
+);
+
+sub MY::postamble {
+ <<'EOF';
+RSYNC_DEST = ssoma.public-inbox.org:/srv/ssoma/
+docs = INSTALL README COPYING $(shell git ls-files Documentation/ '*.txt')
+gz_docs = $(addsuffix .gz, $(docs))
+%.gz: %
+ gzip -9 --rsyncable < $< > $@+
+ touch -r $< $@+
+ mv $@+ $@
+
+gz-docs: $(gz_docs)
+rsync-docs:
+ git set-file-times $(docs)
+ $(MAKE) gz-docs
+ rsync --chmod=Fugo=r -av $(gz_docs) $(docs) $(RSYNC_DEST)
+
+EOF
+}
--- /dev/null
+ssoma - some sort of mail archiver
+----------------------------------
+
+ssoma is a git-based mail archiver and transport. Email is injected via
+ssoma-mda(1) (MDA: mail delivery agent) on a server and may be shared
+(via git) and extracted to mbox, Maildir, or IMAP via ssoma(1). It
+exists primarily as the mechanism for public-inbox.org, but may easily
+be used for other projects.
+
+See http://public-inbox.org/ for more information on how ssoma is used.
+
+Features
+--------
+* stores email in git, so readers have a full history of the mailing list
+* mail user-agent (MUA) users may choose from IMAP, mbox(5), and Maildir
+* uses only well-documented and easy-to-implement data formats
+
+Requirements (MUA client)
+-------------------------
+* git
+* Perl and several modules:
+ - Email::LocalDelivery
+ - Email::Simple
+ - Net::IMAP::Simple
+ - Digest::SHA
+* any MUA capable of reading/importing IMAP, mbox(5) or Maildir archives
+
+Requirements (server MDA)
+-------------------------
+* git
+* MTA - postfix is recommended
+* Perl and several modules:
+ - Email::Simple
+ - File::FcntlLock
+ - Digest::SHA
+
+Hacking
+-------
+Source code is available via git:
+
+ git clone git://bogomips.org/ssoma
+
+See below for contact info.
+
+Contact
+-------
+We are happy to see feedback of all types via plain-text email.
+Please email comments, user/developer discussion, patches, bug reports,
+and pull requests to our public ssoma instance at:
+
+ ssoma@public-inbox.org
+
+Please Cc: all recipients when replying (this is not a requirement of
+ssoma itself, but a good idea since we do not require subscription).
+This also makes it easier to rope in folks of tangentially related
+projects we depend on (e.g. git developers on git@vger.kernel.org).
+
+You can subscribe via ssoma, LISTNAME is a name of your choosing:
+
+ URL=git://public-inbox.org/ssoma
+ LISTNAME=ssoma
+
+ # to initialize a maildir (this may be a new or existing maildir,
+ # ssoma will not touch existing messages)
+ # If you prefer mbox, use mbox:/path/to/mbox as the last argument
+ ssoma add $LISTNAME $URL maildir:/path/to/maildir
+
+ # read with your favorite MUA (only using mutt as an example)
+ mutt -f /path/to/maildir # (or /path/to/mbox)
+
+ # to keep your mbox or maildir up-to-date, periodically run the following:
+ ssoma sync $LISTNAME
+
+ # your MUA may modify and delete messages from the maildir or mbox,
+ # this does not affect ssoma functionality at all
+
+ # to sync all your ssoma subscriptions
+ ssoma sync
+
+Mail repository format
+----------------------
+If you are uncomfortable running code in ssoma for any reason and
+would rather read directly from the git repository, the following
+document describes it:
+
+ http://ssoma.public-inbox.org/ssoma_repository.txt
+
+Copyright
+---------
+Copyright 2013, Eric Wong <normalperson@yhbt.net> and all contributors.
+License: AGPLv3 or later <http://www.gnu.org/licenses/agpl-3.0.txt>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero 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 Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public License
+along with this program. If not, see <http://www.gnu.org/licenses/>.
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# Extracts mail to an Mbox or Maildir
+package Ssoma::Extractor;
+use strict;
+use warnings;
+use Ssoma::Git;
+use Email::LocalDelivery;
+
+sub new {
+ my ($class, $git) = @_;
+ bless { git => $git, ref => "refs/heads/master" }, $class;
+}
+
+# runs a command which returns a list of files, no file name sanitization
+# here needed since all of the path names stored in git trees are controlled
+# by us (and based on SHA-1 hexdigest)
+sub _flist {
+ my ($cmd) = @_;
+ my @rv = `$cmd`;
+ $? == 0 or die "$cmd failed: $?\n";
+ chomp @rv;
+ \@rv
+}
+
+sub _extract {
+ my ($self, $target) = @_;
+ my $git = $self->{git};
+
+ # read all of the state file
+ my $state = "$git->{git_dir}/ssoma.state";
+ my $cfg = $git->config_list($state);
+
+ my $pkey = "target.$target.path";
+ my $path = $cfg->{$pkey};
+
+ my $ckey = "target.$target.command";
+ my $command = $cfg->{$ckey};
+
+ my $ikey = "target.$target.imap";
+ my $imap = $cfg->{$ikey};
+
+ my $lkey = "target.$target.last-imported";
+ my $last = $cfg->{$lkey};
+
+ my $ref = $self->{ref};
+ my $tip = $git->qx_sha1("git rev-parse $ref^0");
+
+ my $new; # arrayref of new file pathnames in a git tree
+
+ if (defined $last) {
+ # only inject newly-added
+ $last =~ /\A[a-f0-9]{40}\z/ or die "$lkey invalid in $state\n";
+
+ # we don't want blob->tree conflict resolution in MDA
+ # tricking us into extracting the same message twice;
+ # MDA will keep the original in sufficiently-identical messages
+ my $cmd = "git diff-tree -r --name-only -M100% --diff-filter=A";
+ $new = _flist("$cmd $last $tip");
+ } else {
+ # new maildir or mbox (to us), import everything in the
+ # current tree
+ $new = _flist("git ls-tree -r --name-only $tip");
+ }
+
+ my $i = 0;
+ $i++ if defined $command;
+ $i++ if defined $path;
+ $i++ if defined $imap;
+ ($i > 1) and die
+ "only one of $pkey, $ckey, or $ikey may be defined in $state\n";
+
+ if (defined $command) {
+ $self->_run_for_each($command, $tip, $new)
+ } elsif (defined $path) {
+ $self->_deliver_each($path, $tip, $new);
+ } elsif (defined $imap) {
+ $self->_imap_deliver_each($tip, $new);
+ } else {
+ die "neither $pkey, $ckey, nor $ikey are defined in $state\n";
+ }
+
+ # update the last-imported var
+ {
+ local $ENV{GIT_CONFIG} = $state;
+ my $rv = system(qw/git config/, $lkey, $tip);
+ $rv == 0 or die "git config $lkey $tip failed: $? ($rv)\n";
+ }
+}
+
+# deliver to mbox or maildir, Email::LocalDelivery determines the type of
+# folder (via Email::FolderType) via trailing trailing slash for maildir
+# (and lack of trailing slash for mbox). Ezmlm and MH formats are not
+# currently supported by Email::LocalDelivery.
+sub _deliver_each {
+ my ($self, $dest, $tip, $new) = @_;
+ my $git = $self->{git};
+ foreach my $path (@$new) {
+ _deliver_die($git->cat_blob("$tip:$path"), $dest);
+ }
+}
+
+# just pipe the blob message to $command, bypassing Perl,
+# so there's no validation at all
+sub _run_for_each {
+ my ($self, $command, $tip, $new) = @_;
+ my $git = $self->{git};
+ foreach my $path (@$new) {
+ my $cmd = "git cat-file blob $tip:$path | $command";
+ my $rv = system($cmd);
+ $rv == 0 or die "delivery command: $cmd failed: $? ($rv)\n";
+ }
+}
+
+sub _imap_deliver_each {
+ my ($self, $tip, $new) = @_;
+ my $git = $self->{git};
+ require Ssoma::IMAP;
+ my $imap = Ssoma::IMAP->new($git);
+ foreach my $path (@$new) {
+ $imap->imap_deliver($git->cat_blob("$tip:$path"));
+ }
+ $imap->quit;
+}
+
+sub extract {
+ my ($self, $target) = @_;
+ $self->{git}->tmp_git_do(sub { $self->_extract($target) });
+}
+
+sub _deliver_die {
+ my @rv = Email::LocalDelivery->deliver(@_);
+ (scalar @rv == 1 && -f $rv[0]) or
+ die "delivery to $_[1] failed: $!\n";
+}
+
+# implements "ssoma cat MESSAGE-ID"
+sub midextract {
+ my ($self, $message_id, $mbox) = @_;
+ $self->{git}->tmp_git_do(sub {
+ # leaving <> out of Message-IDs on the command-line is
+ # common and practical since it frees the user from
+ # quoting/escaping in most cases, so do not require
+ # Message-Ids have <> around themh
+ if ($message_id =~ /\A<.+>\z/) { # rare
+ $self->_midextract($message_id, $mbox);
+ } else { # common
+ eval { # try with additional <> first
+ my $tmpid = "<$message_id>";
+ $self->_midextract($tmpid, $mbox);
+ };
+ $self->_midextract($message_id, $mbox) if $@;
+ }
+ });
+}
+
+sub _midextract {
+ my ($self, $message_id, $mbox) = @_;
+ my $git = $self->{git};
+ my $path = $git->mid2path($message_id);
+ my $ref = $self->{ref};
+ my $tip = $git->qx_sha1("git rev-parse $ref^0");
+ my $obj = "$tip:$path";
+ my $type = $git->type($obj);
+ if ($type eq "tree") { # unlikely
+ $git->each_in_tree($obj, sub {
+ my ($blob_id, $xpath) = ($1, $2);
+ _deliver_die($git->cat_blob($blob_id), $mbox);
+ });
+ } elsif ($type eq "blob") {
+ _deliver_die($git->cat_blob($obj), $mbox);
+ } else {
+ die "unhandled type: $type (obj=$obj)\n";
+ }
+}
+
+1;
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# Note: some trivial code here stolen from git-svn + Perl modules distributed
+# with git. I wrote these long ago and I retain my copyright to it, so I'm
+# within my right to relicense as AGPLv3+
+#
+# Not using Git.pm and friends directly because some git installations may use
+# a different Perl than this (and I might end up rewriting this entirely
+# in C at a later time...)
+package Ssoma::Git;
+use strict;
+use warnings;
+use File::Path qw/mkpath/;
+use IO::Handle;
+use Fcntl;
+use File::FcntlLock;
+use Email::Simple;
+use Digest::SHA qw/sha1_hex/;
+
+# Future versions of Ssoma will always be able to handle this version, at least
+our $REPO_VERSION = 1;
+
+sub new {
+ my ($class, $git_dir) = @_;
+ bless {
+ git_dir => $git_dir,
+ index => "$git_dir/ssoma.index",
+ }, $class;
+}
+
+# initialize a git repository
+sub init_db {
+ my ($self, @opts) = @_;
+
+ my @cmd = (qw(git init --bare), @opts);
+ push @cmd, $self->{git_dir};
+
+ system(@cmd) == 0 or die join(' ', @cmd)." failed: $?\n";
+
+ $self->tmp_git_do(sub {
+ @cmd = (qw(git config ssoma.repoversion), $REPO_VERSION);
+ system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";
+ });
+}
+
+sub lockfile { $_[0]->{git_dir} . "/ssoma.lock" }
+
+sub sync_do {
+ my ($self, $sub) = @_;
+
+ my $fs = File::FcntlLock->new;
+ $fs->l_type(F_WRLCK);
+ $fs->l_type(SEEK_CUR);
+ $fs->l_start(0);
+ $fs->l_len(0);
+
+ my $path = $self->lockfile;
+ my $lock;
+
+ # we must not race here because this is concurrent:
+ sysopen($lock, $path, O_WRONLY) or
+ sysopen($lock, $path, O_CREAT|O_EXCL|O_WRONLY) or
+ sysopen($lock, $path, O_WRONLY) or
+ die "failed to open lock $path: $!\n";
+
+ # wait for other processes to be done
+ $fs->lock($lock, F_SETLKW) or die "lock failed: " . $fs->error . "\n";
+
+ # run the sub!
+ my @ret = eval { &$sub };
+ my $err = $@;
+
+ # these would happen anyways, but be explicit so we can detect errors
+ $fs->lock($lock, F_UNLCK) or die "unlock failed: " . $fs->error . "\n";
+ close $lock or die "close lockfile($path) failed: $!\n";
+
+ die $err if $err;
+
+ wantarray ? @ret : $ret[0];
+}
+
+# perform sub with the given GIT_DIR
+sub tmp_git_do {
+ my ($self, $sub) = @_;
+ local $ENV{GIT_DIR} = $self->{git_dir};
+ &$sub;
+}
+
+# perform sub with a temporary index
+sub tmp_index_do {
+ my ($self, $sub) = @_;
+ local $ENV{GIT_INDEX_FILE} = $self->{index};
+
+ my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#);
+ mkpath([$dir]) unless -d $dir;
+ -d $dir or die "$dir creation failed $!\n";
+ &$sub;
+}
+
+# bidirectional pipe, output would be SHA-1 hexdigest
+sub bidi_sha1 {
+ my ($self, @cmd) = @_;
+ my $sub = pop @cmd;
+ my $cmd = join(' ', @cmd);
+ my ($in_0, $in_1, $out_0, $out_1);
+
+ pipe($in_0, $in_1) or die "pipe failed: $!\n";
+ pipe($out_0, $out_1) or die "pipe failed: $!\n";
+
+ my $pid = fork;
+ defined $pid or die "fork failed: $!\n";
+
+ if ($pid == 0) {
+ open STDIN, '<&', $in_0 or die "redirect stdin failed: $!\n";
+ open STDOUT, '>&', $out_1 or die "redirect stdout failed: $!\n";
+ exec @cmd;
+ die "exec($cmd) failed: $!\n";
+ }
+
+ close $in_0 or die "close in_0 failed: $!\n";
+ close $out_1 or die "close out_1 failed: $!\n";
+ $sub->($in_1);
+ close $in_1 or die "close in_1 failed: $!\n";
+ my $sha1 = <$out_0>;
+ close $out_0 or die "close out_0 failed: $!\n";
+ waitpid($pid, 0) or die "waitpid $pid failed: $!\n";
+ $? == 0 or die "$cmd failed: $?\n";
+ chomp $sha1;
+ $sha1 =~ /\A[a-f0-9]{40}\z/i or die "not a SHA-1: $sha1\n";
+ $sha1;
+}
+
+# run a command described by str and return the SHA-1 hexdigest output
+sub qx_sha1 {
+ my ($self, $str) = @_;
+ my $sha1 = `$str`;
+
+ die "$str failed: $?\n" if $?;
+ chomp $sha1;
+ $sha1 =~ /\A[a-f0-9]{40}\z/i or
+ die "not a SHA-1 hexdigest from: $str\n";
+ $sha1;
+}
+
+# returns a blob identifier the new message
+sub simple_to_blob {
+ my ($self, $simple) = @_;
+ $self->bidi_sha1(qw/git hash-object -w --stdin/, sub {
+ my ($io) = @_;
+ print $io $simple->as_string or die "print failed: $!\n";
+ });
+}
+
+# converts the given object name to an Email::Simple object
+sub blob_to_simple {
+ my ($self, $obj) = @_;
+ Email::Simple->new($self->cat_blob($obj));
+}
+
+# returns key-value pairs of config directives in a hash
+sub config_list {
+ my ($self, $file) = @_;
+
+ local $ENV{GIT_CONFIG} = $file;
+
+ my @cfg = `git config -l`;
+ $? == 0 or die "git config -l failed: $?\n";
+ chomp @cfg;
+ my %rv = map { split(/=/, $_, 2) } @cfg;
+ \%rv;
+}
+
+# used to hash the relevant portions of a message when there are conflicts
+sub hash_simple2 {
+ my ($self, $simple) = @_;
+ my $dig = Digest::SHA->new("SHA-1");
+ $dig->add($simple->header("Subject"));
+ $dig->add($simple->body);
+ $dig->hexdigest;
+}
+
+# we currently only compare messages for equality based on
+# Message-ID, Subject: header and body, nothing else.
+# both args are Email::Simple objects
+sub simple_eq {
+ my ($self, $cur, $new) = @_;
+
+ (($cur->header("Subject") eq $new->header("Subject")) &&
+ ($cur->body eq $new->body));
+}
+
+# kills leading/trailing space in-place
+sub stripws {
+ $_[0] =~ s/\A\s*//;
+ $_[0] =~ s/\s*\z//;
+}
+
+sub mid2path {
+ my ($self, $message_id) = @_;
+ stripws($message_id);
+ my $hex = sha1_hex($message_id);
+ $hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or
+ die "BUG: not a SHA-1 hex: $hex";
+ "$1/$2";
+}
+
+sub cat_blob {
+ my ($self, $blob_id) = @_;
+ my $cmd = "git cat-file blob $blob_id";
+ my $str = `$cmd`;
+ die "$cmd failed: $?\n" if $?;
+ $str;
+}
+
+sub type {
+ my ($self, $obj) = @_;
+ my $cmd = "git cat-file -t $obj";
+ my $str = `$cmd`;
+ die "$cmd failed: $?\n" if $?;
+ chomp $str;
+ $str;
+}
+
+# only used for conflict resolution
+sub each_in_tree {
+ my ($self, $obj, $sub) = @_;
+ my $cmd = "git ls-tree $obj";
+ my @tree = `$cmd`;
+ $? == 0 or die "$cmd failed: $!\n";
+ my $x40 = '[a-f0-9]{40}';
+ foreach my $line (@tree) {
+ if ($line =~ m!\A100644 blob ($x40)\t($x40)$!o) {
+ my ($blob_id, $path) = ($1, $2);
+ $sub->($blob_id, $path);
+ } else {
+ warn "unexpected: bad line from $cmd:\n$line";
+ }
+ }
+}
+
+sub commit_index {
+ my ($self, $gii, $need_parent, $ref, $message) = @_;
+
+ # this is basically what git commit(1) does,
+ # but we use git plumbing, not porcelain
+ $gii->done;
+ my $tree = $self->qx_sha1("git write-tree");
+
+ # can't rely on qx_sha1 since we initial commit may not have a parent
+ my $cmd = "git rev-parse $ref^0";
+ my $parent;
+ if ($need_parent) {
+ $parent = $self->qx_sha1($cmd);
+ } else {
+ $parent = eval { $self->qx_sha1("$cmd 2>/dev/null") };
+ if (defined $parent && $parent !~ /\A[a-f0-9]{40}\z/) {
+ die "$cmd returned bad SHA-1: $parent\n";
+ }
+ }
+
+ # make the commit
+ my @cmd = (qw/git commit-tree -m/, $message);
+ push @cmd, '-p', $parent if $parent;
+ push @cmd, $tree;
+ my $commit = $self->qx_sha1(join(' ', @cmd));
+
+ # update the ref
+ @cmd = (qw/git update-ref/, $ref, $commit);
+ push @cmd, $parent if $parent; # verification
+ system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";
+
+ # gc if needed
+ @cmd = qw/git gc --auto/;
+ system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";
+}
+
+1;
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# Note: some trivial code here stolen from git-svn + Perl modules distributed
+# with git. I wrote these long ago I retain my copyright to it, so I'm within
+# my right to relicense as AGPLv3+
+#
+# Not using Git.pm and friends directly because some git installations may use
+# a different Perl than this (and I might end up rewriting this entirely
+# in another language).
+
+package Ssoma::GitIndexInfo;
+use strict;
+use warnings;
+
+sub new {
+ my ($class) = @_;
+ my $pid = open my $gui, '|-';
+ defined $pid or die "failed to pipe + fork: $!\n";
+ if ($pid == 0) {
+ exec(qw/git update-index -z --index-info/);
+ die "exec failed: $!\n";
+ }
+ bless { gui => $gui, pid => $pid, nr => 0}, $class;
+}
+
+sub remove {
+ my ($self, $path) = @_;
+ print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0" or
+ die "failed to print to git update-index pipe: $!\n";
+ ++$self->{nr};
+}
+
+sub update {
+ my ($self, $mode, $hash, $path) = @_;
+ print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0" or
+ die "failed to print to git update-index pipe: $!\n";
+ ++$self->{nr};
+}
+
+sub done {
+ my ($self) = @_;
+ close $self->{gui} or die "close pipe: $!\n";
+ $? == 0 or die "git update-index failed: $?\n";
+}
+
+1;
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# IMAP delivery module, used by Ssoma::Extractor if Email::LocalDelivery
+# is not available. Since we are dependent on git, we use the same config
+# settings as those used by git-imap-send(1)
+package Ssoma::IMAP;
+use strict;
+use warnings;
+use Ssoma::Git;
+use Net::IMAP::Simple;
+
+sub new {
+ my ($class, $git) = @_;
+ my $file = "$git->{git_dir}/config";
+ my $cfg = $git->config_list($file);
+ my %opts = ();
+ my $self = bless { opts => \%opts }, $class;
+ foreach my $k (qw/folder host user pass port tunnel/) {
+ $self->{$k} = $cfg->{"imap.$k"};
+ }
+
+ check_unsupported($git, $cfg);
+
+ my $imap;
+ if ((my $host = $self->{host})) {
+ $host =~ s!imap://!!;
+ $host =~ s!imaps://!! and $opts{use_ssl} = 1;
+ my $port = $self->{port};
+ $host .= ":$port" if defined $port;
+ $self->get_pass($host);
+ $imap = Net::IMAP::Simple->new($host, %opts) or conn_fail();
+ $imap->login($self->{user}, $self->{pass}) or
+ die "Login failed: " . $imap->errstr . "\n";
+ } elsif ((my $tunnel = $self->{tunnel})) {
+ # XXX not tested
+ $host = "cmd:$tunnel";
+ $imap = Net::IMAP::Simple->new($host, %opts) or conn_fail();
+ } else {
+ die "neither imap.host nor imap.tunnel set in $file\n";
+ }
+ $self->{imap} = $imap;
+ $self;
+}
+
+sub imap_deliver {
+ my ($self, $msg) = @_;
+ $self->{imap}->put($self->{folder}, $msg);
+}
+
+sub check_unsupported {
+ my ($git, $cfg) = @_;
+
+ if ((my $sslverify = $cfg->{"imap.sslverify"})) {
+ local $ENV{GIT_CONFIG} = "$git->{git_dir}/config";
+ $sslverify = `git config --bool imap.sslverify`;
+ chomp $sslverify;
+ if ($sslverify eq "false") {
+ die "imap.sslverify=false not supported\n";
+ }
+ }
+
+ if (defined $cfg->{"imap.authmethod"}) {
+ die "imap.authMethod not supported by Net::IMAP::Simple\n";
+ }
+}
+
+sub get_pass {
+ my ($self, $host) = @_;
+
+ return if defined $self->{pass};
+ my $pass = "";
+
+ print STDERR "$self->{user}\@$host password:";
+ STDERR->flush;
+ my $readkey;
+ eval {
+ require Term::ReadKey;
+ Term::ReadKey::ReadMode('noecho');
+ };
+ if ($@) {
+ my $cmd = 'stty -echo';
+ print STDERR "Term::ReadKey not available, using `$cmd'\n";
+ system($cmd) and die "$cmd failed: $?\n";
+ $pass = <STDIN>;
+ $cmd = 'stty echo';
+ system($cmd) and die "$cmd failed: $?\n";
+ chomp $pass;
+ } else {
+ # read the password
+ while (defined(my $key = Term::ReadKey::ReadKey(0))) {
+ last if $key =~ /[\012\015]/; # [\r\n]
+ $pass .= $key;
+ }
+ Term::ReadKey::ReadMode('restore');
+ }
+ print STDERR "\n";
+ STDERR->flush;
+
+ $self->{pass} = $pass;
+}
+
+sub conn_fail {
+ die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
+}
+
+sub quit {
+ my ($self) = @_;
+ $self->{imap}->quit;
+}
+
+1;
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# Mail Delivery Agent module, delivers mail into a ssoma git repo
+package Ssoma::MDA;
+use strict;
+use warnings;
+use Ssoma::GitIndexInfo;
+
+sub new {
+ my ($class, $git) = @_;
+ bless { git => $git, ref => "refs/heads/master" }, $class;
+}
+
+# may convert existing blob to a tree
+# returns false if message already exists
+# returns true on successful delivery
+sub blob_upgrade {
+ my ($self, $gii, $new, $path) = @_;
+
+ my $git = $self->{git};
+ my $obj = "$self->{ref}^0:$path";
+ my $cur = $git->blob_to_simple($obj);
+
+ # do nothing if the messages match:
+ return 0 if $git->simple_eq($cur, $new);
+
+ # kill the old blob
+ $gii->remove($path);
+
+ # implicitly create a new tree via index with two messages
+ foreach my $simple ($cur, $new) {
+ my $id = $git->simple_to_blob($simple);
+ my $path2 = $git->hash_simple2($simple);
+ $gii->update("100644", $id, "$path/$path2");
+ }
+ 1;
+}
+
+# used to update existing trees, which only happen when we have Message-ID
+# conflicts
+sub tree_update {
+ my ($self, $gii, $new, $path) = @_;
+ my $git = $self->{git};
+ my $obj = "$self->{ref}^0:$path";
+ my $cmd = "git ls-tree $obj";
+ my @tree = `$cmd`;
+ $? == 0 or die "$cmd failed: $!\n";
+ chomp @tree;
+
+ my $id = $git->simple_to_blob($new);
+ my $path2 = $git->hash_simple2($new);
+
+ # go through the existing tree and look for duplicates
+ foreach my $line (@tree) {
+ $line =~ m!\A100644 blob ([a-f0-9]{40})\t(([a-f0-9]{40}))\z! or
+ die "corrupt repo: bad line from $cmd: $line\n";
+ my ($xid, $xpath2) = ($1, $2);
+
+ # do nothing if most of the message matches
+ return 0 if $path2 eq $xpath2 || $id eq $xid;
+ }
+
+ # no duplicates found, add to the index
+ $gii->update("100644", $id, "$path/$path2");
+}
+
+# this appends the given message-id to the git repo, requires locking
+# (Ssoma::Git::sync_do)
+sub append {
+ my ($self, $path, $simple) = @_;
+
+ my $git = $self->{git};
+ my $ref = $self->{ref};
+
+ # $path is a path name we generated, so it's sanitized
+ my $gii = Ssoma::GitIndexInfo->new;
+
+ my $obj = "$ref^0:$path";
+ my $cmd = "git cat-file -t $obj";
+ my $type = `$cmd 2>/dev/null`;
+
+ if ($? == 0) { # rare, object already exists
+ chomp $type;
+
+ # we return undef here if the message already exists
+ if ($type eq "blob") {
+ # this may upgrade the existing blob to a tree
+ $self->blob_upgrade($gii, $simple, $path) or return;
+ } elsif ($type eq "tree") {
+ # possibly add object to an existing tree
+ $self->tree_update($gii, $simple, $path) or return;
+ } else {
+ # we're screwed if a commit/tag has the same SHA-1
+ die "CONFLICT: `$cmd' returned: $type\n";
+ }
+ } else { # new message, just create a blob, common
+ my $id = $git->simple_to_blob($simple);
+ $gii->update('100644', $id, $path);
+ }
+ $git->commit_index($gii, 0, $ref, "mda");
+}
+
+# the main entry point takes an Email::Simple object
+sub deliver {
+ my ($self, $simple) = @_;
+ my $git = $self->{git};
+
+ # convert the Message-ID into a path
+ my $mid = $simple->header("Message-ID");
+
+ # if there's no Message-ID, generate one to avoid too many conflicts
+ # leading to trees
+ if (!defined $mid || $mid =~ /\A\s*\z/) {
+ $mid = '<' . $git->hash_simple2($simple) . '@localhost>';
+ $simple->header_set("Message-ID", $mid);
+ }
+ my $path = $git->mid2path($mid);
+
+ # kill potentially confusing/misleading headers
+ foreach my $d (qw(status lines content-length)) {
+ $simple->header_set($d);
+ }
+
+ my $sub = sub {
+ $git->tmp_index_do(sub {
+ $self->append($path, $simple);
+ });
+ };
+ $git->sync_do(sub { $git->tmp_git_do($sub) });
+}
+
+1;
--- /dev/null
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+package Ssoma::Remover;
+use strict;
+use warnings;
+use Ssoma::Git;
+use Ssoma::GitIndexInfo;
+
+sub new {
+ my ($class, $git) = @_;
+ bless { git => $git, ref => "refs/heads/master" }, $class;
+}
+
+sub remove_simple {
+ my ($self, $simple) = @_;
+ my $git = $self->{git};
+ my $sub = sub {
+ $git->tmp_index_do(sub {
+ $self->_remove($simple);
+ });
+ };
+ $git->sync_do(sub { $git->tmp_git_do($sub) });
+}
+
+# remove an Email::Simple object from the current index
+sub _remove {
+ my ($self, $simple) = @_;
+ my $git = $self->{git};
+ my $path = $git->mid2path($simple->header("Message-ID"));
+ my $ref = $self->{ref};
+ my $tip = $git->qx_sha1("git rev-parse $ref^0");
+ my $obj = "$tip:$path";
+ my $type = $git->type($obj);
+ my (@keep, @remove);
+ if ($type eq "tree") { # unlikely
+ $git->each_in_tree($obj, sub {
+ my ($blob_id, $xpath) = ($1, $2);
+ my $tmp = $git->blob_to_simple($blob_id);
+ if ($git->simple_eq($simple, $tmp)) {
+ push @remove, "$path/$xpath";
+ } else {
+ push @keep, $blob_id;
+ }
+ });
+ } elsif ($type eq "blob") { # likely
+ my $tmp = $git->blob_to_simple($obj);
+ if ($git->simple_eq($simple, $tmp)) {
+ push @remove, $path;
+ }
+ } else {
+ die "unhandled type=$type for obj=$obj\n";
+ }
+
+ my $gii = Ssoma::GitIndexInfo->new;
+ foreach my $rm (@remove) { $gii->remove($rm) }
+
+ if (scalar(@keep) == 1) { # convert tree back to blob
+ my $blob_id = $keep[0];
+ $gii->remove($path);
+ $gii->update('100644', $blob_id, $path);
+ } elsif ((scalar(@keep) == 0) && ($type eq "tree")) {
+ # this is not possible unless simple_eq changes over time
+ $gii->remove($path);
+ } # else: do nothing if (@keep > 1)
+
+ # commit changes
+ $git->commit_index($gii, 1, $ref, 'rm');
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# This is the normal command-line client for users
+use strict;
+use warnings;
+use Getopt::Long;
+use Ssoma::Git;
+use Ssoma::Extractor;
+use File::Path::Expand qw/expand_filename/;
+use File::Path qw/make_path/;
+use File::Temp qw/tempfile/;
+use File::Spec qw//;
+use Email::LocalDelivery;
+Getopt::Long::Configure("require_order", "pass_through");
+our %opts;
+GetOptions(
+ "help|h" => \$opts{help},
+ "quiet|q" => \$opts{quiet},
+ "force|f" => \$opts{force},
+) or usage(1);
+
+$ENV{SSOMA_HOME} ||= expand_filename("~/.ssoma/");
+
+# these expand automatically to the associated cmd_$name, so "add"
+# calls cmd_add, "sync" calls cmd_sync, and so forth
+our %cmd = (
+ "add" => {
+ doc => "start watching a new list",
+ arg => "LISTNAME URL TYPE:/path/to/destination [TARGET]",
+ long => "TYPE must be one of 'maildir', 'mbox', 'imap' ".
+ "or 'command'",
+ },
+ "sync" => {
+ doc => "sync target(s) for existing LISTNAME",
+ arg => "[LISTNAME] [TARGET]",
+ },
+ "cat" => {
+ doc => "show a message by Message-ID",
+ arg => "MESSAGE-ID [LISTNAME|GIT_DIR]",
+ },
+);
+
+my $cmd = shift @ARGV;
+usage("", 1) unless defined $cmd;
+$cmd eq "help" and usage("", 0);
+$cmd{$cmd} or usage("", 1);
+
+my $cmd_sub = eval {
+ no strict 'refs';
+ *{"cmd_$cmd"};
+} or die "BUG: $cmd not implemented\n";
+
+$cmd_sub->(@ARGV);
+exit 0;
+
+sub usage {
+ my ($cmd, $exit) = @_;
+ my $fd = $exit ? \*STDERR : \*STDOUT;
+ print $fd "Usage: ssoma <command> [options] [arguments]\n";
+
+ print $fd "Available commands:\n" unless $cmd;
+
+ foreach my $c (sort keys %cmd) {
+ next if $cmd && $cmd ne $c;
+ my $pad = 'A10';
+ print $fd ' ', pack($pad, $c), $cmd{$c}->{doc}, "\n";
+ print $fd ' ', pack($pad, ''), $cmd{$c}->{arg}, "\n";
+
+ my $long = $cmd{$c}->{long};
+ if ($long) {
+ print $fd ' ', pack($pad, ''), $long, "\n";
+ }
+
+ my $opt = $cmd{$c}->{opt} or next;
+ foreach my $s (sort keys %$opt) {
+ # prints out arguments as they should be passed:
+ my $x = s#[:=]s$## ? '<arg>' :
+ (s#[:=]i$## ? '<num>' : '');
+ print $fd ' ' x 21, join(', ', map { length $s > 1 ?
+ "--$s" : "-$s" }
+ split /\|/, $s)," $x\n";
+ }
+ }
+ exit $exit;
+}
+
+sub check_listname {
+ my ($name) = @_;
+
+ $name =~ /\A[a-zA-Z0-9]/ or die
+ "LISTNAME must start with an alphanumeric char\n";
+ $name =~ /[a-zA-Z0-9]\z/ or die
+ "LISTNAME must end with an alphanumeric char\n";
+ $name =~ /\A[\w\.\-]+\z/ or die
+ "LISTNAME must only contain alphanumerics, dashes, periods and underscores\n";
+}
+
+sub cmd_add {
+ my ($listname, $url, $dest, $target) = @_;
+ (defined($url) && defined($listname) && defined($dest)) or
+ usage("add", 1);
+
+ check_listname($listname);
+
+ $dest =~ /\A(mbox|maildir|command|imaps?):(.+)\z/ or
+ die usage("add", 1);
+
+ my ($type, $path) = ($1, $2);
+ my $imap;
+
+ if ($type =~ /\Aimaps?\z/) {
+ $imap = 1;
+ } else {
+ $path = File::Spec->rel2abs($path);
+ }
+
+ # Email::LocalDelivery relies on this trailing slash for
+ # maildir distinction
+ if (($type eq "maildir") && ($path !~ m!/\z!)) {
+ $path .= "/";
+ } elsif (($type eq "mbox") && ($path =~ m!/\z!)) {
+ die "mbox `$path' must not end with a trailing slash\n";
+ }
+
+ $target = "local" unless defined $target;
+
+ my $dir = "$ENV{SSOMA_HOME}/$listname.git";
+ make_path($ENV{SSOMA_HOME});
+ my $git = Ssoma::Git->new($dir);
+ my @init_args;
+ push @init_args, '-q' if $opts{quiet};
+ $git->init_db(@init_args);
+ my $state = "$git->{git_dir}/ssoma.state";
+
+ if ($imap) {
+ local $ENV{GIT_CONFIG} = "$git->{git_dir}/config";
+ require URI;
+
+ # no imap:// support in URI, yet, but URI has ftp://
+ # for passwords
+ my $uri = $dest;
+ $uri =~ s{\A(imaps?):}{ftp:};
+ my $scheme = $1;
+ my $u = URI->new($uri);
+
+ $u->scheme or die "no scheme from $dest\n";
+ defined(my $host = $u->host) or die "no host from $dest\n";
+ my $port = $u->_port;
+ x(qw/git config imap.port/, $port) if (defined $port);
+ x(qw/git config imap.host/, "$scheme://$host");
+
+ defined(my $user = $u->user) or die "no user in $dest\n";;
+ x(qw/git config imap.user/, $user);
+ my $p = $u->password;
+ warn_imap_pass($ENV{GIT_CONFIG}) if (defined $p);
+
+ my $path = $u->path;
+ defined $path or $path = "INBOX";
+ $path =~ s!\A/!!; # no leading slash
+ x(qw/git config imap.folder/, $path);
+
+ # this only needs to be set for Extractor to follow
+ local $ENV{GIT_CONFIG} = $state;
+ x(qw/git config/, "target.$target.imap", "true");
+ } else {
+ local $ENV{GIT_CONFIG} = $state;
+ my $cfg = $type eq "command" ? "command" : "path";
+ x(qw/git config/, "target.$target.$cfg", $path);
+ }
+
+ $git->tmp_git_do(sub {
+ x(qw/git remote add --mirror=fetch origin/, $url);
+ });
+}
+
+sub foreach_list {
+ my ($sub) = @_;
+ foreach my $dir (<$ENV{SSOMA_HOME}/*.git>) {
+ -d $dir or next;
+ $sub->($dir);
+ }
+}
+
+sub cmd_sync {
+ my ($listname, @targets) = @_;
+ if (defined $listname) {
+ check_listname($listname);
+ do_sync("$ENV{SSOMA_HOME}/$listname.git", \@targets);
+ } else {
+ foreach_list(sub { do_sync($_[0], []) });
+ }
+}
+
+sub cmd_cat {
+ my ($message_id, $listname) = @_;
+
+ # write to a temporary mbox because Email::LocalDelivery works
+ # that way.
+ my ($fh, $mbox) = tempfile(TMPDIR => 1, SUFFIX => '.mbox');
+
+ if (defined $listname) {
+ my $path = -d $listname ? $listname
+ : "$ENV{SSOMA_HOME}/$listname.git";
+ do_cat($path, $message_id, $mbox);
+ } else {
+ foreach_list(sub { do_cat($_[0], $message_id, $mbox, 1) });
+ }
+ unlink $mbox or warn "error unlinking $mbox: $!\n";
+
+ foreach (<$fh>) {
+ print $_ or warn "failed printing to stdout: $!\n";
+ }
+ close $fh or die "error closing $mbox: $!\n";
+}
+
+sub do_sync {
+ my ($dir, $targets) = @_;
+ my $git = Ssoma::Git->new($dir);
+ my $ex = Ssoma::Extractor->new($git);
+
+ # no targets? sync all of them
+ if (scalar(@$targets) == 0) {
+ my $cfg = $git->config_list("$git->{git_dir}/ssoma.state");
+ my %t;
+ foreach my $k (keys %$cfg) {
+ $k =~ /\Atarget\.(\w+)\.(?:path|imap|command)\z/
+ or next;
+ $t{$1} = 1;
+ }
+ @$targets = keys %t;
+ }
+
+ $git->tmp_git_do(sub {
+ my @cmd = qw/git fetch/;
+ push @cmd, '-q' if $opts{quiet};
+ push @cmd, '-f' if $opts{force};
+ x(@cmd);
+ });
+
+ foreach my $target (@$targets) {
+ $ex->extract($target);
+ }
+}
+
+sub x {
+ system(@_) and die join(' ', @_). " failed: $?\n";
+}
+
+sub warn_imap_pass {
+ my ($file) = @_;
+ print STDERR <<EOF
+ignoring IMAP password given on command-line
+ensure $file is not world-readable before editing
+$file to set imap.pass
+EOF
+}
+
+sub do_cat {
+ my ($dir, $message_id, $mbox, $missing_ok) = @_;
+ my $git = Ssoma::Git->new($dir);
+ my $ex = Ssoma::Extractor->new($git);
+ $ex->midextract($message_id, $mbox, $missing_ok);
+}
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# This is the command-line mail delivery agent for servers.
+# Try to keep this small as it may be invoked frequently for each message
+# delivered.
+my $usage = "ssoma-mda /path/to/git/repo < /path/to/rfc2822_message";
+use strict;
+use warnings;
+use Ssoma::MDA;
+use Ssoma::Git;
+use Email::Simple;
+my $repo = shift @ARGV or die "Usage: $usage\n";
+my $git = Ssoma::Git->new($repo);
+my $mda = Ssoma::MDA->new($git);
+my $simple;
+{
+ local $/;
+ $simple = Email::Simple->new(<>);
+}
+$mda->deliver($simple);
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# this is intended for server administrators, so it takes an absolute
+# path (however this may be run by clients, too).
+my $usage = "ssoma-rm /path/to/git/repo < /path/to/rfc2822_message";
+use strict;
+use warnings;
+use Ssoma::Git;
+use Ssoma::Remover;
+my $dir = shift or die "usage: $usage\n";
+my $git = Ssoma::Git->new($dir);
+my $rm = Ssoma::Remover->new($git);
+my $simple;
+{
+ local $/; # slurp message from stdin
+ $simple = Email::Simple->new(<>);
+};
+$rm->remove_simple($simple);
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+# test all command-line interfaces at once
+my $mda = "blib/script/ssoma-mda";
+my $cli = "blib/script/ssoma";
+my $rm = "blib/script/ssoma-rm";
+my $tmp = tempdir(CLEANUP => 1);
+use File::Temp qw/tempdir/;
+use Email::Simple;
+
+ok(-x $mda, "$mda is executable");
+ok(-x $cli, "$cli is executable");
+
+{
+ # instantiate new git repo
+ my $git_dir = "$tmp/input.git";
+ system(qw/git init -q --bare/, $git_dir) == 0 or
+ die "git init -q --bare $git_dir failed: $?\n";
+ ok(-d $git_dir && -f "$git_dir/config", "$git_dir exists and is bare");
+
+ # deliver the message
+ my $simple = Email::Simple->new(<<'EOF');
+From: me@example.com
+To: u@example.com
+Message-Id: <666@example.com>
+Subject: zzz
+
+OMFG
+EOF
+ my $pid = open my $pipe, '|-';
+ defined $pid or die "failed to pipe + fork: $!\n";
+ if ($pid == 0) {
+ exec($mda, $git_dir);
+ die "exec failed: $!\n";
+ }
+ print $pipe $simple->as_string or die "print failed: $!\n";
+ close $pipe or die "close pipe failed: $!\n";
+ is($?, 0, "$mda exited successfully");
+}
+
+{
+ my $mbox = "$tmp/mbox";
+ local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
+ my $name = "test";
+ my @cmd = ($cli, '-q', "add", $name, "$tmp/input.git", "mbox:$mbox");
+ is(system(@cmd), 0, "add list with ssoma(1)");
+
+ {
+ use Ssoma::Git;
+ my $git_dir = "$ENV{SSOMA_HOME}/$name.git";
+ my $git = Ssoma::Git->new($git_dir);
+ my $cfg = $git->config_list("$git_dir/ssoma.state");
+ is(scalar keys %$cfg, 1, "only one key");
+ like($cfg->{"target.local.path"}, qr{\A/},
+ "target.local.path is absolute");
+ like($cfg->{"target.local.path"}, qr{\Q$mbox\E\z},
+ "target.local.path points to mbox");
+
+ $cfg = $git->config_list("$git_dir/config");
+ is($cfg->{"core.bare"}, "true", "repo is bare");
+ }
+
+ @cmd = ($cli, '-q', "sync");
+ is(system(@cmd), 0, "sync list with ssoma(1)");
+
+ open(my $fh, '<', $mbox) or die "open $mbox: $!\n";
+ my @lines = <$fh>;
+ is(scalar grep(/^Subject: zzz/, @lines), 1, "email delivered");
+ close $fh or die "close $mbox: $!\n";
+}
+
+{
+ # deliver an additional message
+ my $simple = Email::Simple->new(<<'EOF');
+From: moi@example.com
+To: you@example.com
+Message-Id: <666666@example.com>
+Subject: xxx
+
+OMFG
+EOF
+ my $pid = open my $pipe, '|-';
+ defined $pid or die "failed to pipe + fork: $!\n";
+ if ($pid == 0) {
+ exec($mda, "$tmp/input.git");
+ die "exec failed: $!\n";
+ }
+ print $pipe $simple->as_string or die "print failed: $!\n";
+ close $pipe or die "close pipe failed: $!\n";
+ is($?, 0, "$mda exited successfully");
+}
+
+# ensure new message is delivered
+{
+ my $mbox = "$tmp/mbox";
+ local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
+ my $name = "test";
+
+ my @cmd = ($cli, '-q', "sync", $name);
+ is(system(@cmd), 0, "sync $name list with ssoma(1)");
+
+ open(my $fh, '<', $mbox) or die "open $mbox: $!\n";
+ my @lines = <$fh>;
+ is(scalar grep(/^Subject: xxx/, @lines), 1, "email delivered");
+ is(scalar grep(/^Subject: zzz/, @lines), 1, "email delivered");
+ close $fh or die "close $mbox: $!\n";
+}
+
+# ssoma cat functionality
+{
+ local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
+ my @full = `$cli cat \\<666\@example.com\\>`;
+ my $from = shift @full;
+ like($from, qr/^From /, "ssoma cat mbox has From_ line");
+ is(scalar grep(/^Message-Id: <666\@example\.com>/, @full), 1,
+ "correct message returned from ssoma cat");
+ my @lazy = `$cli cat 666\@example.com`;
+ $from = shift @lazy;
+ like($from, qr/^From /, "ssoma cat (lazy) mbox has From_ line");
+ is(join('', @lazy), join('', @full),
+ "lazy ssoma cat invocation w/o <> works");
+}
+
+# ssoma cat with a repo path
+{
+ my @full = `$cli cat \\<666\@example.com\\> $tmp/input.git`;
+ my $from = shift @full;
+ like($from, qr/^From /, "ssoma cat mbox has From_ line");
+ is(scalar grep(/^Message-Id: <666\@example\.com>/, @full), 1,
+ "correct message returned from ssoma cat");
+}
+
+# duplicate message delivered to MDA (for "ssoma cat" dup handling)
+{
+ # deliver the message
+ my $dup = Email::Simple->new(<<'EOF');
+From: me@example.com
+To: u@example.com
+Message-Id: <666@example.com>
+Subject: duplicate
+
+EOF
+ use Ssoma::MDA;
+ use Ssoma::Git;
+ Ssoma::MDA->new(Ssoma::Git->new("$tmp/input.git"))->deliver($dup);
+}
+
+# test ssoma cat on a duplicate
+{
+ my $mbox = "$tmp/mbox";
+ local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
+ my $name = "test";
+ my @cmd = ($cli, "-q", "sync", $name);
+ is(system(@cmd), 0, "sync $name with ssoma(1)");
+
+ my @both = `$cli cat \\<666\@example.com\\>`;
+ is(scalar grep(/^Message-Id: <666\@example\.com>/, @both), 2,
+ "correct messages returned from ssoma cat");
+ is(scalar grep(/^From /, @both), 2,
+ "From_ line from both messages returned from ssoma cat");
+ my @s = sort grep(/^Subject: /, @both);
+ my @x = ("Subject: duplicate\n", "Subject: zzz\n");
+ is_deeply(\@s, \@x, "subjects are correct in mbox");
+}
+
+# test ssoma-rm functionality
+{
+ my $git_dir = "$tmp/input.git";
+ my @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is(scalar @tree, 3, "three messages sitting in a tree");
+
+ # deliver the message to ssoma-rm
+ my $simple = Email::Simple->new(<<'EOF');
+From: me@example.com
+To: u@example.com
+Message-Id: <666@example.com>
+Subject: zzz
+
+OMFG
+EOF
+ my $pid = open my $pipe, '|-';
+ defined $pid or die "failed to pipe + fork: $!\n";
+ if ($pid == 0) {
+ exec($rm, $git_dir);
+ die "exec failed: $!\n";
+ }
+ print $pipe $simple->as_string or die "print failed: $!\n";
+ close $pipe or die "close pipe failed: $!\n";
+ is($?, 0, "$rm exited successfully");
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is(scalar @tree, 2, "two messages sitting in a tree");
+}
+
+done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use Ssoma::Extractor;
+use Ssoma::Git;
+use Ssoma::MDA;
+use File::Temp qw/tempdir/;
+
+my $mdadir = tempdir(CLEANUP => 1);
+my $outdir = tempdir(CLEANUP => 1);
+
+my $outgit = Ssoma::Git->new("$outdir/git");
+my $ex = Ssoma::Extractor->new($outgit);
+my $maildir = "$outdir/maildir/";
+my $mailbox = "$outdir/mbox";
+
+my $mdagit = Ssoma::Git->new("$mdadir/gittest");
+$mdagit->init_db;
+my $mda = Ssoma::MDA->new($mdagit);
+my $email = Email::Simple->new(<<'EOF');
+From: U <u@example.com>
+To: Me <me@example.com>
+Message-Id: <666@example.com>
+Subject: :o
+
+HIHI
+EOF
+
+$mda->deliver($email);
+
+{
+ my @cmd = (qw/git clone -q --mirror/,
+ $mdagit->{git_dir}, $outgit->{git_dir});
+ is(system(@cmd), 0, "extractor repository cloned");
+}
+
+{
+ local $ENV{GIT_CONFIG} = "$outgit->{git_dir}/ssoma.state";
+ is(system(qw/git config target.mydir.path/, $maildir), 0,
+ "setup maildir");
+}
+
+
+my $check_last = sub {
+ my ($key) = @_;
+ local $ENV{GIT_CONFIG} = "$outgit->{git_dir}/ssoma.state";
+ my $last = `git config $key`;
+ is($?, 0, "git config succeeds");
+ like($last, qr/^[a-f0-9]{40}$/, "last-imported is a SHA1");
+};
+
+{
+ $ex->extract("mydir");
+ my @new = <$outdir/maildir/new/*>;
+ is(scalar @new, 1, "one file now exists in maildir");
+ my $f = $new[0];
+ open my $fh, '<', $f or die "opening $f failed: $!\n";
+ local $/;
+ my $s = <$fh>;
+ my $simple = Email::Simple->new($s);
+ is($simple->header('message-id'), '<666@example.com>',
+ "delivered message-id matches");
+ $check_last->("target.mydir.last-imported");
+ unlink $f or die "failed to unlink $f: $!\n";
+}
+
+{
+ local $ENV{GIT_CONFIG} = "$outgit->{git_dir}/ssoma.state";
+ is(system(qw/git config target.mybox.path/, $mailbox), 0,
+ "setup mailbox");
+}
+
+{
+ $ex->extract("mybox");
+ open my $fh, '<', $mailbox or die "opening $mailbox failed: $!\n";
+ local $/;
+ my $s = <$fh>;
+ my $simple = Email::Simple->new($s);
+ is($simple->header('message-id'), '<666@example.com>',
+ "delivered message-id matches");
+ $check_last->("target.mybox.last-imported");
+}
+
+my $another = Email::Simple->new(<<'EOF');
+From: U <u@example.com>
+To: Me <me@example.com>
+Message-Id: <666666@example.com>
+Subject: byebye
+
+*yawn*
+EOF
+$mda->deliver($another);
+
+{
+ local $ENV{GIT_DIR} = $outgit->{git_dir};
+ is(system("git fetch -q"), 0, "fetching updates succeeds");
+}
+
+# ensure we can update maildir without adding old messages
+{
+
+ $ex->extract("mydir");
+ my @new = <$outdir/maildir/new/*>;
+ is(scalar @new, 1, "one new file now exists in maildir");
+ my $f = $new[0];
+ open my $fh, '<', $f or die "opening $f failed: $!\n";
+ local $/;
+ my $s = <$fh>;
+ my $simple = Email::Simple->new($s);
+ is($simple->header('message-id'), '<666666@example.com>',
+ "delivered message-id matches");
+ is($simple->body, "*yawn*\n", "body matches");
+ $check_last->("target.mydir.last-imported");
+ unlink $f or die "failed to unlink $f: $!\n"; # for next test
+}
+
+# ensure we can update mmbox without adding old messages
+{
+
+ $ex->extract("mybox");
+ open my $fh, '<', $mailbox or die "opening $mailbox failed: $!\n";
+ my @lines = <$fh>;
+ my @subjects = grep /^Subject:/, @lines;
+ my @from_ = grep /^From /, @lines;
+ is(scalar @subjects, 2, "2 subjects in mbox");
+ is(scalar @from_, 2, "2 From_ lines in mbox");
+
+ $check_last->("target.mydir.last-imported");
+}
+
+# ensure we can handle conflicts w/o reimporting when the MDA
+# upgrades a blob to a tree.
+my $conflict = Email::Simple->new(<<'EOF');
+From: U <u@example.com>
+To: Me <me@example.com>
+Message-Id: <666666@example.com>
+Subject: BYE
+
+*YAWN*
+EOF
+$mda->deliver($conflict);
+
+{
+ local $ENV{GIT_DIR} = $outgit->{git_dir};
+ is(system("git fetch -q"), 0, "fetching updates succeeds");
+}
+
+# ensure we can update maildir without adding old messages even on a
+# message-id conflict
+{
+
+ $ex->extract("mydir");
+ my @new = <$outdir/maildir/new/*>;
+ is(scalar @new, 1, "one new file now exists in maildir");
+ my $f = $new[0];
+ open my $fh, '<', $f or die "opening $f failed: $!\n";
+ local $/;
+ my $s = <$fh>;
+ my $simple = Email::Simple->new($s);
+ is($simple->header('message-id'), '<666666@example.com>',
+ "delivered conflicting message-id matches");
+ is($simple->body, "*YAWN*\n", "body matches on conflict");
+ $check_last->("target.mydir.last-imported");
+}
+
+# ensure we can pipe to commands
+{
+ {
+ my $cat = "cat >> $outdir/cat.out";
+ local $ENV{GIT_CONFIG} = "$outgit->{git_dir}/ssoma.state";
+ is(system(qw/git config target.cat.command/, $cat), 0,
+ "setup delivery command");
+ }
+
+ $ex->extract("cat");
+ my $f = "$outdir/cat.out";
+ open my $fh, '<', $f or die "open $f failed: $!\n";
+ my @lines = <$fh>;
+ my @subjects = grep /^Subject:/, @lines;
+ my @from = grep /^From:/, @lines;
+ my @mid = grep /^Message-Id:/i, @lines;
+ is(scalar @subjects, 3, "3 subjects in dump");
+ is(scalar @mid, 3, "3 message-ids in dump");
+ is(scalar @from, 3, "3 From: lines in dump");
+
+ $check_last->("target.cat.last-imported");
+}
+
+done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use Ssoma::Git;
+use Ssoma::GitIndexInfo;
+use File::Temp qw/tempdir/;
+my $tmpdir = tempdir(CLEANUP => 1);
+my $git = Ssoma::Git->new("$tmpdir/gittest");
+
+$git->init_db;
+ok(-d "$tmpdir/gittest", "git repo created");
+
+{
+ my $v = `GIT_DIR=$tmpdir/gittest git config ssoma.repoversion`;
+ is(0, $?, "git config succeeded");
+ chomp($v);
+ is(1, $v, "ssoma.repoversion is set to 1");
+}
+
+is(0, $git->tmp_git_do(sub { system(qw(git config ssoma.test foo)) }),
+ "setting config works");
+
+is("foo\n", $git->tmp_git_do(sub { `git config ssoma.test` }),
+ "reading config works");
+
+$git->tmp_git_do(sub {
+ my $commit;
+ $git->tmp_index_do(sub {
+ my $gii = Ssoma::GitIndexInfo->new;
+
+ my $sha1 = `echo hello world | git hash-object -w --stdin`;
+ is(0, $?, "hashed one object");
+ chomp $sha1;
+
+ is(1, $gii->update(100644, $sha1, 'hello/world'),
+ "add hashed object to index");
+ $gii = undef;
+
+ my $tree = `git write-tree`;
+ is(0, $?, "wrote tree out");
+ chomp $tree;
+
+ $commit = `git commit-tree -m 'hi' $tree`;
+ is(0, $?, "committed tree");
+ chomp $commit;
+
+ is(0, system(qw(git update-ref refs/heads/master), $commit),
+ "updated ref");
+ });
+});
+
+{
+ is($git->mid2path("<hello world>"),
+ $git->mid2path("\t<hello world>\t"),
+ "mid2path ignores leading/trailing whitespace");
+}
+
+done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+require_ok("Ssoma::IMAP");
+done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use Ssoma::MDA;
+use Ssoma::Git;
+use Email::Simple;
+use Digest::SHA qw/sha1_hex/;
+use File::Temp qw/tempdir/;
+
+my $tmpdir = tempdir(CLEANUP => 1);
+my $git = Ssoma::Git->new("$tmpdir/gittest");
+$git->init_db;
+my $mda = Ssoma::MDA->new($git);
+
+my $email = Email::Simple->new("From: U <u\@example.com>\n\nHIHI\n");
+my %headers = (
+ "To" => "Me <me\@example.com>",
+ "From" => "You <you\@example.com>",
+ "Message-ID" => "<666\@example.com>",
+ "Subject" => ":o",
+ "Status" => "RO",
+ "Lines" => "666",
+ "Content-Length" => "666",
+);
+
+my %discard = map { $_ => 1 } qw(Status Lines Content-Length);
+
+while (my ($key, $val) = each %headers) {
+ $email->header_set($key, $val);
+}
+
+$mda->deliver($email);
+
+local $ENV{GIT_DIR} = "$tmpdir/gittest";
+
+my $blob_id = sha1_hex("<666\@example.com>");
+my ($dir, $base) = ($blob_id =~ m!\A([a-f0-9]{2})([a-f0-9]{38})\z!);
+ok(defined $dir && defined $base, "bad sha1: $blob_id");
+
+my $raw = `git cat-file blob HEAD:$dir/$base`;
+is(0, $?, "git cat-file returned: $?");
+
+my $delivered = Email::Simple->new($raw);
+is("HIHI\n", $delivered->body, "body matches");
+
+while (my ($key, $val) = each %headers) {
+ if ($discard{$key}) {
+ is($delivered->header($key), undef, "header $key discarded");
+ } else {
+ is($delivered->header($key), $val, "header $key not discarded");
+ }
+}
+
+done_testing();
+
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use Ssoma::MDA;
+use Ssoma::Git;
+use Email::Simple;
+use Digest::SHA qw/sha1_hex/;
+use File::Temp qw/tempdir/;
+
+my $tmpdir = tempdir(CLEANUP => 1);
+my $git = Ssoma::Git->new("$tmpdir/gittest");
+$git->init_db;
+my $mda = Ssoma::MDA->new($git);
+
+my $email = Email::Simple->new("From: U <u\@example.com>\n\nHIHI\n");
+$email->header_set("To", "Me <me\@example.com>");
+$email->header_set("Subject", ":o");
+$email->header_set("Message-ID", "<12345\@example.com>");
+
+$mda->deliver($email);
+
+local $ENV{GIT_DIR} = "$tmpdir/gittest";
+my @orig = `git rev-list HEAD`;
+is(1, scalar @orig, "one revision exists");
+
+# deliver a second message
+$email->header_set("message-ID", "<666\@example.com>");
+$email->body_set("BYEBYE\nBYEYBE\n");
+
+$mda->deliver($email);
+
+# validate delivery results and history
+my @two = ` git rev-list HEAD`;
+is(2, scalar @two, "two revisions exist");
+is($orig[0], $two[1], "history is correct");
+
+my @tree = `git ls-tree -r HEAD`;
+is(0, $?, "git ls-tree -r HEAD succeeded");
+chomp @tree;
+is(2, scalar @tree, "two entries in tree");
+
+# ensure path Message-ID -> path mapping works
+foreach my $line (@tree) {
+ my ($mode, $type, $blob, $path) = split(/\s+/, $line);;
+ my $raw = `git cat-file blob $blob`;
+ my $simple = Email::Simple->new($raw);
+ my $mid = $simple->header("message-id");
+ my $path_sha1 = $path;
+ $path_sha1 =~ tr!/!!d;
+ is($path_sha1, sha1_hex($mid), "path mapping works $mid");
+}
+
+# delivery again with identical Message-ID
+$mda->deliver($email);
+
+# duplicate detected
+chomp(my @curr = `git ls-tree -r HEAD`);
+is_deeply(\@tree, \@curr, "duplicate not stored");
+
+# repeat message-ID but different content
+$email->body_set("different\n");
+$mda->deliver($email);
+
+my @prev = @curr;
+my @prev_blobs = map { (split(/\s+/, $_))[2] } @prev;
+
+chomp(@curr = `git ls-tree -r HEAD`);
+my %curr_blobs = map { (split(/\s+/, $_))[2] => 1 } @curr;
+is(3, scalar @curr, "mismatch stored with identical Message-ID");
+
+foreach my $prev (@prev_blobs) {
+ ok(delete $curr_blobs{$prev}, "prev=$prev blob exists");
+}
+
+my @only = keys %curr_blobs;
+is(1, scalar @only, "one new blob stored");
+
+my $body_3 = "3rd message with identical Message-ID, ridiculous\n";
+$email->body_set($body_3);
+$mda->deliver($email);
+
+@prev = @curr;
+@prev_blobs = map { (split(/\s+/, $_))[2] } @prev;
+chomp(@curr = `git ls-tree -r HEAD`);
+%curr_blobs = map { (split(/\s+/, $_))[2] => 1 } @curr;
+is(4, scalar @curr, "another stored with identical Message-ID");
+
+foreach my $prev (@prev_blobs) {
+ ok(delete $curr_blobs{$prev}, "prev=$prev blob exists");
+}
+@only = keys %curr_blobs;
+is(1, scalar @only, "one new blob stored");
+
+my $want = sha1_hex($email->header("Subject") . $email->body);
+my @want = grep(m!/\Q$want\E!, @curr);
+is(1, scalar @want, "wanted message is unique");
+my $blob = (split(/\s+/, $want[0]))[2];
+my $s = `git cat-file blob $blob`;
+$s = Email::Simple->new($s);
+is("<666\@example.com>", $s->header("message-id"), "MID matches");
+is($body_3, $s->body, "body matches");
+
+done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use Ssoma::MDA;
+use Ssoma::Git;
+use Email::Simple;
+use File::Temp qw/tempdir/;
+my $tmpdir = tempdir(CLEANUP => 1);
+my $git = Ssoma::Git->new("$tmpdir/gittest");
+$git->init_db;
+my $mda = Ssoma::MDA->new($git);
+my $email = Email::Simple->new("From: U <u\@example.com>\n\nHIHI\n");
+$mda->deliver($email);
+
+local $ENV{GIT_DIR} = "$tmpdir/gittest";
+my @tree = `git ls-tree -r HEAD`;
+is(scalar @tree, 1, "one item in tree");
+my @line = split(/\s+/, $tree[0]);
+my $msg = Email::Simple->new($git->cat_blob($line[2]));
+like($msg->header("message-id"), qr/\A<[a-f0-9]{40}\@localhost>\z/,
+ "message-id generated for message missing it");
+
+done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use Ssoma::MDA;
+use Ssoma::Git;
+use Ssoma::Remover;
+use Email::Simple;
+use Digest::SHA qw/sha1_hex/;
+use File::Temp qw/tempdir/;
+
+my $tmpdir = tempdir(CLEANUP => 1);
+my $git_dir = "$tmpdir/gittest";
+my $git = Ssoma::Git->new($git_dir);
+$git->init_db;
+my $mda = Ssoma::MDA->new($git);
+my $rm = Ssoma::Remover->new($git);
+my @tree;
+
+{
+ my $email = Email::Simple->new(<<'EOF');
+From: me@example.com
+To: u@example.com
+Message-Id: <666@example.com>
+Subject: zzz
+
+OMFG
+EOF
+
+ $mda->deliver($email);
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ is(scalar @tree, 1, "message delivered");
+
+ # simple removal
+ $rm->remove_simple($email);
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ is(scalar @tree, 0, "tree is now empty after removal");
+
+ $mda->deliver($email);
+ $email->body_set("conflict");
+ $mda->deliver($email);
+
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ is(scalar @tree, 2, "both messages stored");
+
+ # remove only one (the concflicting one)
+ $rm->remove_simple($email);
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ is(scalar @tree, 1, "one removed, one exists");
+
+ my @line = split(/\s+/, $tree[0]);
+ is($line[1], "blob", "back to one blob");
+ my $cur = `GIT_DIR=$git_dir git cat-file blob $line[2]`;
+ like($cur, qr/OMFG/, "kept original");
+ $email->body_set("OMFG\n");
+ $rm->remove_simple($email);
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ is(scalar @tree, 0, "last removed");
+
+ my @seq = qw(1 2 3);
+ foreach my $i (@seq) {
+ $email->body_set("$i\n");
+ $mda->deliver($email);
+ }
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ is(scalar @tree, scalar @seq, "several messages exist");
+
+ my $expect = 3;
+ foreach my $i (@seq) {
+ $email->body_set("$i\n");
+ $rm->remove_simple($email);
+ @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
+ is($?, 0, "no error from git ls-tree");
+ $expect--;
+ is(scalar @tree, $expect, "$expect messages left");
+ }
+}
+
+done_testing();
projects / ssoma-mda.git / commitdiff