pax_global_header00006660000000000000000000000064122132645030014510gustar00rootroot0000000000000052 comment=e072844199313e27742e43d4ebf1f0b0b5d01387 msva-perl-0.9.2/000077500000000000000000000000001221326450300134265ustar00rootroot00000000000000msva-perl-0.9.2/.gitignore000066400000000000000000000000071221326450300154130ustar00rootroot00000000000000*~ *.1 msva-perl-0.9.2/COPYING000066400000000000000000001043741221326450300144720ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . msva-perl-0.9.2/Changelog000066400000000000000000000142241221326450300152430ustar00rootroot00000000000000msva-perl (0.9.2) upstream; * tweak POD to declare charset * openpgp2x509: a bit more clean up and features (needs more work) * handle multiple keyserver entries in gpg.conf gracefully (closes MS #6252) * also accept DOS-style CR/LF line endings in PEM-encoded X.509 certs * msva-query-agent: produce newline-terminated output. -- Daniel Kahn Gillmor Mon, 09 Sep 2013 01:16:47 -0400 msva-perl (0.9.1) upstream; * Bug Fix Release: * Fix error when msva-perl is run without arguments. * Correct internal version number. -- Daniel Kahn Gillmor Sun, 09 Sep 2012 15:15:34 -0400 msva-perl (0.9) upstream; [ Jameson Rollins ] * Add "e-mail" context (checks for signing capability instead of authentication) (closes MS #2688) * Add "openpgp4fpr" pkc type for providing OpenPGP v4 fingerprint * Add --version option to msva-query-agent [ David Bremner ] * Code refactoring: - Crypt::Monkeysphere::MSVA::Logger into Crypt::Monkeysphere::Logger - new Crypt::Monkeysphere::Validator - unit tests and unit test harness [ Daniel Kahn Gillmor ] * Now depending on Crypt::X509 0.50 for pubkey components directly. * Crypt::Monkeysphere::OpenPGP for helper functions in packet generation and parsing. * Parse and make use of X.509 PGPExtension if present in X.509 public key carrier. * Fix HUP server restart when used with Net::Server >= 0.99 * Crypt::Monkeysphere::Keytrans has the start of some key/certificate conversion routines. * Fix socket detection when used with Net::Server >= 2.00, which can bind to multiple sockets * depend on Net::Server >= 2.00 * change launcher approach -- daemon is now child process, so that daemon failures won't kill X11 session * scanning and prompting for changes is now optional (defaults to off) -- Daniel Kahn Gillmor Wed, 25 Jul 2012 13:12:55 -0400 msva-perl (0.8) upstream; * Minor bugfix release! * Avoid indirect object creation (thanks to intrigeri for pointing this out). * Bug fix for unused option provided to gpgkeys_hkpms. * Allow use of hkpms keyservers from gpg.conf * Allow the use of ports in hostnames (closes MS # 2665) * Do not report self-sigs as other certifiers (but report valid, non-matching identities independently) (closes MS # 2569) * List certifiers only once (closes MS # 2573) * Enable the use of --keyserver-options http-proxy for gpgkeys_hkpms (includes support for socks proxies) (closes MS # 2677) -- Daniel Kahn Gillmor Mon, 20 Dec 2010 04:04:15 -0500 msva-perl (0.7) upstream; * udpated msva-query-agent documentation * added gpgkeys_hkpms for monkeysphere-authenticated HKPS access (closes MS #2016) -- Daniel Kahn Gillmor Tue, 07 Dec 2010 21:34:23 -0500 msva-perl (0.6) upstream; * Add new element to JSON syntax allowing request to override keyserver_policy (closes MS #2542) * Do not kill off child handling processes on HUP -- let them finish their queries. * Refactor logging code * If we have Gtk2, Linux::Inotify2, and AnyEvent, we should monitor for updates and prompt the user when we notice one. (closes MS #2540) * Added tests/basic, as a simple test of a few functions (closes MS #2537) * fixed double-prompting on sites that have more than one User ID (closes MS #2567) * report server implementation name and version with every query (closes MS #2564) * support x509pem, opensshpubkey, and rfc4716 PKC formats in addition to x509der (addresses MS #2566) * add new peer type categorization (closes MS #2568) -- peers of type client can have much more flexible names than regular hostnames we look for for servers. -- Daniel Kahn Gillmor Sun, 14 Nov 2010 03:04:13 -0500 msva-perl (0.5) upstream; * If ${MSVA_KEYSERVER} is unset or blank, default to using keyserver from ${GNUPGHOME}/gpg.conf if that file exists. (addresses MS #2080) * Under Linux, report details about the requesting process if we can learn them from /proc (closes MS #2005) * Conditionally rely on Gtk2 perl module -- no marginal UI without it, but you can also install the MSVA now without needing to pull in a bunch of Gtk libs (closes MS #2514) * Sending a SIGHUP to the running server now re-execs it cleanly, keeping the same port assignments and monitoring the same child process. This can be used to upgrade running msva instances after a package update (closes MS #2532) -- Daniel Kahn Gillmor Tue, 12 Oct 2010 03:50:02 -0400 msva-perl (0.4) upstream; * removed dependency on monkeysphere package -- just invoke GnuPG directly (needs GnuPG::Interface, Regexp::Common) (closes MS #2034) * adds MSVA_KEYSERVER_POLICY and MSVA_KEYSERVER environment variables. * added a marginal UI (needs Gtk2 perl module) (closes MS #2004) * Filter incoming uids to match a strict regex (closes MS #2270) * Trivially untaint the environment for the single child process (closes MS #2461) -- Daniel Kahn Gillmor Mon, 04 Oct 2010 01:06:52 -0400 msva-perl (0.3) upstream; * packaging re-organization * properly closing piped monkeysphere call * restore default SIGCHLD handling for exec'ed subprocess (Closes: MS #2414) -- Daniel Kahn Gillmor Wed, 16 Jun 2010 02:29:06 -0400 msva-perl (0.2) upstream; * can now be invoked with a sub-command; will run until subcommand completes, and then terminate with the same return code (this is similar to the ssh-agent technique, and enables inclusion in Xsession.d; see monkeysphere 0.29 package for automatic startup). * chooses arbitrary open port by default (can still be specified with MSVA_PORT environment variable) * minimized logging spew by default. * now shipping README.schema (notes about possible future MSVA implementations) * cleanup Makefile and distribution strategies. -- Daniel Kahn Gillmor Mon, 15 Mar 2010 14:25:42 -0400 msva-perl (0.1) upstream; * first release. -- Daniel Kahn Gillmor Tue, 09 Mar 2010 00:08:54 -0500 msva-perl-0.9.2/Crypt/000077500000000000000000000000001221326450300145275ustar00rootroot00000000000000msva-perl-0.9.2/Crypt/Monkeysphere/000077500000000000000000000000001221326450300172005ustar00rootroot00000000000000msva-perl-0.9.2/Crypt/Monkeysphere/Keyserver.pm000066400000000000000000000113041221326450300215140ustar00rootroot00000000000000package Crypt::Monkeysphere::Keyserver; use IO::File; use GnuPG::Handles; use GnuPG::Interface; use File::HomeDir; use Config::General; use Regexp::Common qw /net/; use POSIX; use strict; use warnings; use parent qw(Crypt::Monkeysphere::Logger); use Crypt::Monkeysphere::Util qw(untaint); our $default_keyserver='hkp://pool.sks-keyservers.net'; =pod =head2 new Create a new Crypt::Monkeysphere::Keyserver instance Arguments Param hash, all optional. keyserver => URL gnupg => GnuPG::Interface object (plus arguments for Crypt::Monkeysphere::Logger::new) =cut sub new { my $class=shift; my %opts=@_; my $self=$class->SUPER::new($opts{loglevel} || 'info'); # gnupg should be initialized first, before figuring out # what keyserver to use. $self->{gnupg} = $opts{gnupg} || new GnuPG::Interface(); $self->{keyserver} = $opts{keyserver} || $self->_get_keyserver(); return $self; } sub _get_keyserver{ my $self=shift; my $gpghome=$self->{gnupg}->options->homedir; if (!defined($gpghome)) { if (exists $ENV{GNUPGHOME} and $ENV{GNUPGHOME} ne '') { # We might be running in taint mode, but we assume that is about # data coming from the network, and that the local environment # is generally trustworthy. $gpghome = untaint($ENV{GNUPGHOME}); } else { my $userhome=File::HomeDir->my_home; if (defined($userhome)) { $gpghome = File::Spec->catfile($userhome, '.gnupg'); } } } if (defined $gpghome) { return $self->_read_keyserver_from_gpg_conf($gpghome) || $default_keyserver; } else { return $default_keyserver; } } sub _read_keyserver_from_gpg_conf() { my $self=shift; my $gpghome=shift; my $gpgconf = File::Spec->catfile($gpghome, 'gpg.conf'); if (-f $gpgconf) { if (-r $gpgconf) { my %gpgconfig = Config::General::ParseConfig($gpgconf); if (! defined $gpgconfig{keyserver}) { $self->log('debug', "No keyserver line found in GnuPG configuration file (%s)\n", $gpgconf); } else { if (ref($gpgconfig{keyserver}) eq 'ARRAY') { # use the last keyserver entry if there is more than one. $self->log('debug', "more than one keyserver line found in GnuPG configuration file (%s), using last one found\n", $gpgconf); $gpgconfig{keyserver} = pop(@{$gpgconfig{keyserver}}); } if ($gpgconfig{keyserver} =~ /^(((hkps?|hkpms|finger|ldap):\/\/)?$RE{net}{domain})$/) { $self->log('debug', "Using keyserver %s from the GnuPG configuration file (%s)\n", $1, $gpgconf); return $1; } else { $self->log('error', "Not a valid keyserver (from gpg config %s):\n %s\n", $gpgconf, $gpgconfig{keyserver}); } } } else { $self->log('error', "The GnuPG configuration file (%s) is not readable\n", $gpgconf); } } else { $self->log('info', "Did not find GnuPG configuration file while looking for keyserver '%s'\n", $gpgconf); } return undef; } sub fetch_uid { my $self= shift; my $uid = shift || croak("uid argument mandatory"); my $ks=$self->{keyserver}; my $gnupg=$self->{gnupg}; my $cmd = IO::Handle::->new(); my $out = IO::Handle::->new(); my $nul = IO::File::->new("< /dev/null"); $self->log('debug', "start ks query to %s for UserID: %s\n", $ks, $uid); my $pid = $gnupg->wrap_call ( handles => GnuPG::Handles::->new( command => $cmd, stdout => $out, stderr => $nul ), command_args => [ '='.$uid ], commands => [ '--keyserver', $ks, qw( --no-tty --with-colons --search ) ] ); while (my $line = $out->getline()) { $self->log('debug', "from ks query: (%d) %s", $cmd->fileno, $line); if ($line =~ /^info:(\d+):(\d+)/ ) { $cmd->print(join(' ', ($1..$2))."\n"); $self->log('debug', 'to ks query: '.join(' ', ($1..$2))."\n"); last; } } # FIXME: can we do something to avoid hanging forever? waitpid($pid, 0); $self->log('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); } sub fetch_fpr { my $self = shift; my $fpr = shift || croak("fpr argument mandatory"); my $ks=$self->{keyserver}; my $gnupg=$self->{gnupg}; my $cmd = IO::Handle::->new(); my $nul = IO::File::->new("< /dev/null"); $self->log('debug', "start ks query to %s for fingerprint: %s\n", $ks, $fpr); my $pid = $gnupg->wrap_call ( handles => GnuPG::Handles::->new( command => $cmd, stdout => $nul, stderr => $nul ), command_args => [ '0x'.$fpr ], commands => [ '--keyserver', $ks, qw( --no-tty --recv-keys ) ] ); # FIXME: can we do something to avoid hanging forever? waitpid($pid, 0); $self->log('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); } 1; msva-perl-0.9.2/Crypt/Monkeysphere/Keytrans.pm000066400000000000000000000044411221326450300213410ustar00rootroot00000000000000package Crypt::Monkeysphere::Keytrans; use strict; use warnings; use Math::BigInt; use Carp; use MIME::Base64; use Exporter qw(import); our @EXPORT_OK=qw(GnuPGKey_to_OpenSSH_pub GnuPGKey_to_OpenSSH_fpr); # takes a Math::BigInt and returns it properly packed for openssh output. sub openssh_mpi_pack { my $num = shift; my $val = $num->as_hex(); $val =~ s/^0x//; # ensure we've got an even multiple of 2 nybbles here. $val = '0'.$val if (length($val) % 2); $val = pack('H*', $val); # packed binary ones-complement representation of the value. my $mpilen = length($val); my $ret = pack('N', $mpilen); # if the first bit of the leading byte is high, we should include a # 0 byte: if (ord($val) & 0x80) { $ret = pack('NC', $mpilen+1, 0); } return $ret.$val; } # this output is not base64-encoded yet. Pass it through # encode_base64($output, '') if you want to make a file. sub openssh_rsa_pubkey_pack { my ($modulus, $exponent) = @_; return openssh_mpi_pack(Math::BigInt->new('0x'.unpack('H*', "ssh-rsa"))). openssh_mpi_pack($exponent). openssh_mpi_pack($modulus); } # calculate/print the fingerprint of an openssh-style keyblob: sub sshfpr { my $keyblob = shift; use Digest::MD5; return join(':', map({unpack("H*", $_)} split(//, Digest::MD5::md5($keyblob)))); } =pod =head2 GnuPGKey_to_OpenSSH_fpr Find the openssh compatible fingerprint of an (RSA) GnuPG::Key B you will need to add add bits and (RSA) to the string to exactly match the output of ssh-keygen -l. =head3 Arguments key - GnuPG::Key object =cut sub GnuPGKey_to_OpenSSH_fpr { my $key = shift; croak("not a GnuPG::Key!") unless($key->isa('GnuPG::Key')); croak("Not an RSA key!") unless $key->algo_num == 1; return sshfpr(openssh_rsa_pubkey_pack(@{$key->pubkey_data}), ''); } =pod =head2 GnuPGKey_to_OpenSSH_pub Translate a GnuPG::Key to a string suitable for an OpenSSH .pub file B you will need to add "ssh-rsa " to the front to make OpenSSH recognize it. =head3 Arguments key - GnuPG::Key object =cut sub GnuPGKey_to_OpenSSH_pub { my $key = shift; croak("not a GnuPG::Key!") unless($key->isa('GnuPG::Key')); croak("Not an RSA key!") unless $key->algo_num == 1; return encode_base64(openssh_rsa_pubkey_pack(@{$key->pubkey_data}), ''); } 1; msva-perl-0.9.2/Crypt/Monkeysphere/Logger.pm000066400000000000000000000055251221326450300207640ustar00rootroot00000000000000#---------------------------------------------------------------------- # Monkeysphere Validation Agent, Perl version # Marginal User Interface for reasonable prompting # Copyright © 2010 Daniel Kahn Gillmor , # Matthew James Goins , # Jameson Graef Rollins , # Elliot Winard # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # #---------------------------------------------------------------------- { package Crypt::Monkeysphere::Logger; use strict; use warnings; # Net::Server log_level goes from 0 to 4 # this is scaled to match. my %loglevels = ( 'silent' => 0, 'quiet' => 0.25, 'fatal' => 0.5, 'error' => 1, 'info' => 2, 'verbose' => 3, 'debug' => 4, 'debug1' => 4, 'debug2' => 5, 'debug3' => 6, ); sub log { my $self = shift; my $msglevel = shift; $msglevel = 'error' if (! defined($msglevel)); if ($loglevels{lc($msglevel)} <= $self->{loglevel}) { printf STDERR @_; } }; sub get_log_level { my $self = shift; return $self->{loglevel}; } sub set_log_level { my $self = shift; my $loglevel = shift; my $logval = $loglevels{lc($loglevel)}; if (defined($logval)) { $self->{loglevel} = $logval; } else { $self->log('error', "Invalid log level: '%s' (log level not changed)\n", $loglevel); } } sub more_verbose { my $self = shift; my $increment = shift; $increment = 1 if (!defined $increment); $self->{loglevel} += $increment; } # let the user test to see if we're noisier than this level # directly: sub is_logging_at { my $self = shift; my $qlevel = shift; return ($loglevels{lc($qlevel)} <= $self->{loglevel}); } sub new { my $class = shift; my $loglevel = shift; my $self = {loglevel => $loglevels{defined($loglevel) ? lc($loglevel) : 'error'}}; $self->{loglevel} = $loglevels{error} if (!defined $self->{loglevel}); bless ($self, $class); return $self; } 1; } msva-perl-0.9.2/Crypt/Monkeysphere/MSVA.pm000077500000000000000000000747031221326450300203220ustar00rootroot00000000000000# Monkeysphere Validation Agent, Perl version # Copyright © 2010 Daniel Kahn Gillmor , # Jameson Rollins # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . { package Crypt::Monkeysphere::MSVA; use strict; use warnings; use vars qw($VERSION); use parent qw(HTTP::Server::Simple::CGI); use Crypt::Monkeysphere::Validator; use Crypt::X509 0.50; use Regexp::Common qw /net/; use MIME::Base64; use IO::Socket; use IO::File; use Socket; use File::Spec; use File::HomeDir; use Config::General; use Crypt::Monkeysphere::MSVA::MarginalUI; use Crypt::Monkeysphere::Logger; use Crypt::Monkeysphere::Util qw(untaint); use Crypt::Monkeysphere::MSVA::Monitor; use Crypt::Monkeysphere::OpenPGP; use JSON; use POSIX qw(strftime); # we need the version of GnuPG::Interface that knows about pubkey_data, etc: use GnuPG::Interface 0.43; $VERSION = '0.9.2'; my $gnupg = GnuPG::Interface::->new(); $gnupg->options->quiet(1); $gnupg->options->batch(1); my %dispatch = ( '/' => { handler => \&noop, methods => { 'GET' => 1 }, }, '/reviewcert' => { handler => \&reviewcert, methods => { 'POST' => 1 }, }, '/extracerts' => { handler => \&extracerts, methods => { 'POST' => 1 }, }, ); my $default_keyserver_policy = 'unlessvalid'; my $logger = Crypt::Monkeysphere::Logger->new($ENV{MSVA_LOG_LEVEL}); sub logger { return $logger; } sub net_server { return 'Net::Server::MSVA'; }; sub msvalog { return $logger->log(@_); }; sub new { my $class = shift; my $port = 0; if (exists $ENV{MSVA_PORT} and $ENV{MSVA_PORT} ne '') { msvalog('debug', "MSVA_PORT set to %s\n", $ENV{MSVA_PORT}); $port = $ENV{MSVA_PORT} + 0; die sprintf("not a reasonable port %d", $port) if (($port >= 65536) || $port <= 0); } # start the server on requested port my $self = $class->SUPER::new($port); if (! exists $ENV{MSVA_PORT}) { # we can't pass port 0 to the constructor because it evaluates # to false, so HTTP::Server::Simple just uses its internal # default of 8080. But if we want to select an arbitrary open # port, we *can* set it here. $self->port(0); } $self->{allowed_uids} = {}; if (exists $ENV{MSVA_ALLOWED_USERS} and $ENV{MSVA_ALLOWED_USERS} ne '') { msvalog('verbose', "MSVA_ALLOWED_USERS environment variable is set.\nLimiting access to specified users.\n"); foreach my $user (split(/ +/, $ENV{MSVA_ALLOWED_USERS})) { my ($name, $passwd, $uid); if ($user =~ /^[0-9]+$/) { $uid = $user + 0; # force to integer } else { ($name,$passwd,$uid) = getpwnam($user); } if (defined $uid) { msvalog('verbose', "Allowing access from user ID %d\n", $uid); $self->{allowed_uids}->{$uid} = $user; } else { msvalog('error', "Could not find user '%d'; not allowing\n", $user); } } } else { # default is to allow access only to the current user $self->{allowed_uids}->{POSIX::getuid()} = 'self'; } bless ($self, $class); return $self; } sub noop { my $self = shift; my $cgi = shift; return '200 OK', { available => JSON::true, protoversion => 1, }; } # return an arrayref of processes which we can detect that have the # given socket open (the socket is specified with its inode) sub getpidswithsocketinode { my $sockid = shift; if (! defined ($sockid)) { msvalog('verbose', "No client socket ID to check. The MSVA is probably not running as a service.\n"); return []; } # this appears to be how Linux symlinks open sockets in /proc/*/fd, # as of at least 2.6.26: my $socktarget = sprintf('socket:[%d]', $sockid); my @pids; my $procfs; if (opendir($procfs, '/proc')) { foreach my $pid (grep { /^\d+$/ } readdir($procfs)) { my $procdir = sprintf('/proc/%d', $pid); if (-d $procdir) { my $procfds; if (opendir($procfds, sprintf('/proc/%d/fd', $pid))) { foreach my $procfd (grep { /^\d+$/ } readdir($procfds)) { my $fd = sprintf('/proc/%d/fd/%d', $pid, $procfd); if (-l $fd) { #my ($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($fd); my $targ = readlink($fd); push @pids, $pid if ($targ eq $socktarget); } } closedir($procfds); } } } closedir($procfs); } # FIXME: this whole business is very linux-specific, i think. i # wonder how to get this info in other OSes? return \@pids; } # return {uid => X, inode => Y}, meaning the numeric ID of the peer # on the other end of $socket, "socket inode" identifying the peer's # open network socket. each value could be undef if unknown. sub get_client_info { my $socket = shift; my $sock = IO::Socket::->new_from_fd($socket, 'r'); # check SO_PEERCRED -- if this was a TCP socket, Linux # might not be able to support SO_PEERCRED (even on the loopback), # though apparently some kernels (Solaris?) are able to. my $clientid; my $remotesocketinode; my $socktype = $sock->sockopt(SO_TYPE) or die "could not get SO_TYPE info"; if (defined $socktype) { msvalog('debug', "sockopt(SO_TYPE) = %d\n", $socktype); } else { msvalog('verbose', "sockopt(SO_TYPE) returned undefined.\n"); } my $peercred = $sock->sockopt(SO_PEERCRED) or die "could not get SO_PEERCRED info"; my $client = $sock->peername(); my $family = sockaddr_family($client); # should be AF_UNIX (a.k.a. AF_LOCAL) or AF_INET msvalog('verbose', "socket family: %d\nsocket type: %d\n", $family, $socktype); if ($peercred) { # FIXME: on i386 linux, this appears to be three ints, according to # /usr/include/linux/socket.h. What about other platforms? my ($pid, $uid, $gid) = unpack('iii', $peercred); msvalog('verbose', "SO_PEERCRED: pid: %u, uid: %u, gid: %u\n", $pid, $uid, $gid, ); if ($pid != 0 && $uid != 0) { # then we can accept it: $clientid = $uid; } # FIXME: can we get the socket inode as well this way? } # another option in Linux would be to parse the contents of # /proc/net/tcp to find the uid of the peer process based on that # information. if (! defined $clientid) { msvalog('verbose', "SO_PEERCRED failed, digging around in /proc/net/tcp\n"); my $proto; if ($family == AF_INET) { $proto = ''; } elsif ($family == AF_INET6) { $proto = '6'; } if (defined $proto) { if ($socktype == &SOCK_STREAM) { $proto = 'tcp'.$proto; } elsif ($socktype == &SOCK_DGRAM) { $proto = 'udp'.$proto; } else { undef $proto; } if (defined $proto) { my ($port, $iaddr) = unpack_sockaddr_in($client); my $iaddrstring = unpack("H*", reverse($iaddr)); msvalog('verbose', "Port: %04x\nAddr: %s\n", $port, $iaddrstring); my $remmatch = lc(sprintf("%s:%04x", $iaddrstring, $port)); my $infofile = '/proc/net/'.$proto; my $f = IO::File::->new(); if ( $f->open('< '.$infofile)) { my @header = split(/ +/, <$f>); my ($localaddrix, $uidix, $inodeix); my $ix = 0; my $skipcount = 0; while ($ix <= $#header) { $localaddrix = $ix - $skipcount if (lc($header[$ix]) eq 'local_address'); $uidix = $ix - $skipcount if (lc($header[$ix]) eq 'uid'); $inodeix = $ix - $skipcount if (lc($header[$ix]) eq 'inode'); $skipcount++ if (lc($header[$ix]) eq 'tx_queue') or (lc($header[$ix]) eq 'tr'); # these headers don't actually result in a new column during the data rows $ix++; } if (!defined $localaddrix) { msvalog('info', "Could not find local_address field in %s; unable to determine peer UID\n", $infofile); } elsif (!defined $uidix) { msvalog('info', "Could not find uid field in %s; unable to determine peer UID\n", $infofile); } elsif (!defined $inodeix) { msvalog('info', "Could not find inode field in %s; unable to determine peer network socket inode\n", $infofile); } else { msvalog('debug', "local_address: %d; uid: %d\n", $localaddrix,$uidix); while (my @line = split(/ +/,<$f>)) { if (lc($line[$localaddrix]) eq $remmatch) { if (defined $clientid) { msvalog('error', "Warning! found more than one remote uid! (%s and %s\n", $clientid, $line[$uidix]); } else { $clientid = $line[$uidix]; $remotesocketinode = $line[$inodeix]; msvalog('info', "remote peer is uid %d (inode %d)\n", $clientid, $remotesocketinode); } } } msvalog('error', "Warning! could not find peer information in %s. Not verifying.\n", $infofile) unless defined $clientid; } } else { # FIXME: we couldn't read the file. what should we # do besides warning? msvalog('info', "Could not read %s; unable to determine peer UID\n", $infofile); } } } } return { 'uid' => $clientid, 'inode' => $remotesocketinode }; } sub handle_request { my $self = shift; my $cgi = shift; # This is part of a spawned child process. We don't want the # child process to destroy the update monitor when it terminates. $self->{updatemonitor}->forget() if exists $self->{updatemonitor} && defined $self->{updatemonitor}; my $clientinfo = get_client_info(select); my $clientuid = $clientinfo->{uid}; if (defined $clientuid) { # test that this is an allowed user: if (exists $self->{allowed_uids}->{$clientuid}) { msvalog('verbose', "Allowing access from uid %d (%s)\n", $clientuid, $self->{allowed_uids}->{$clientuid}); } else { msvalog('error', "MSVA client connection from uid %d, forbidden.\n", $clientuid); printf("HTTP/1.0 403 Forbidden -- peer does not match local user ID\r\nContent-Type: text/plain\r\nDate: %s\r\n\r\nHTTP/1.1 403 Not Found -- peer does not match the local user ID. Are you sure the agent is running as the same user?\r\n", strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())),); return; } } my $path = $cgi->path_info(); my $handler = $dispatch{$path}; if (ref($handler) eq "HASH") { if (! exists $handler->{methods}->{$cgi->request_method()}) { printf("HTTP/1.0 405 Method not allowed\r\nAllow: %s\r\nDate: %s\r\n", join(', ', keys(%{$handler->{methods}})), strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time()))); } elsif (ref($handler->{handler}) ne "CODE") { printf("HTTP/1.0 500 Server Error\r\nDate: %s\r\n", strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time()))); } else { my $data = {}; my $ctype = $cgi->content_type(); msvalog('verbose', "Got %s %s (Content-Type: %s)\n", $cgi->request_method(), $path, defined $ctype ? $ctype : '**none supplied**'); if (defined $ctype) { my @ctypes = split(/; */, $ctype); $ctype = shift @ctypes; if ($ctype eq 'application/json') { $data = from_json($cgi->param('POSTDATA')); } }; my ($status, $object) = $handler->{handler}($data, $clientinfo); if (ref($object) eq 'HASH' && ! defined $object->{server}) { $object->{server} = sprintf("MSVA-Perl %s", $VERSION); } my $ret = to_json($object); msvalog('info', "returning: %s\n", $ret); printf("HTTP/1.0 %s\r\nDate: %s\r\nContent-Type: application/json\r\n\r\n%s", $status, strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())), $ret); } } else { printf("HTTP/1.0 404 Not Found -- not handled by Monkeysphere validation agent\r\nContent-Type: text/plain\r\nDate: %s\r\n\r\nHTTP/1.0 404 Not Found -- the path:\r\n %s\r\nis not handled by the MonkeySphere validation agent.\r\nPlease try one of the following paths instead:\r\n\r\n%s\r\n", strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())), $path, ' * '.join("\r\n * ", keys %dispatch) ); } } sub get_keyserver_policy { if (exists $ENV{MSVA_KEYSERVER_POLICY} and $ENV{MSVA_KEYSERVER_POLICY} ne '') { if ($ENV{MSVA_KEYSERVER_POLICY} =~ /^(always|never|unlessvalid)$/) { return $1; } msvalog('error', "Not a valid MSVA_KEYSERVER_POLICY):\n %s\n", $ENV{MSVA_KEYSERVER_POLICY}); } return $default_keyserver_policy; } sub get_keyserver { # We should read from (first hit wins): # the environment if (exists $ENV{MSVA_KEYSERVER} and $ENV{MSVA_KEYSERVER} ne '') { if ($ENV{MSVA_KEYSERVER} =~ /^(((hkps?|hkpms|finger|ldap):\/\/)?$RE{net}{domain})$/) { return $1; } msvalog('error', "Not a valid keyserver (from MSVA_KEYSERVER):\n %s\n", $ENV{MSVA_KEYSERVER}); } # FIXME: some msva.conf or monkeysphere.conf file (system and user?) # let the keyserver routines choose. return undef; } ################################################## ## PKC KEY EXTRACTION ############################ sub pkcextractkey { my $data = shift; my $key; if (lc($data->{pkc}->{type}) eq 'x509der') { $key = der2key(join('', map(chr, @{$data->{pkc}->{data}}))); } elsif (lc($data->{pkc}->{type}) eq 'x509pem') { $key = der2key(pem2der($data->{pkc}->{data})); } elsif (lc($data->{pkc}->{type}) eq 'opensshpubkey') { $key = opensshpubkey2key($data->{pkc}->{data}); } elsif (lc($data->{pkc}->{type}) eq 'rfc4716') { $key = rfc47162key($data->{pkc}->{data}); } else { $key->{error} = sprintf("Don't know this public key carrier type: %s", $data->{pkc}->{type}); } if (exists $key->{error}) { return $key; } # make sure that the returned integers are Math::BigInts: $key->{exponent} = Math::BigInt::->new($key->{exponent}) unless (ref($key->{exponent})); $key->{modulus} = Math::BigInt::->new($key->{modulus}) unless (ref($key->{modulus})); msvalog('debug', "pubkey info:\nmodulus: %s\nexponent: %s\n", $key->{modulus}->as_hex(), $key->{exponent}->as_hex(), ); if ($key->{modulus}->copy()->blog(2) < 1000) { $key->{error} = sprintf('Public key size is less than 1000 bits (was: %d bits)', $key->{modulus}->copy()->blog(2)); } return $key; } sub der2key { my $rawdata = shift; my $cert = Crypt::X509::->new(cert => $rawdata); my $key = {error => 'I do not know what happened here'}; if ($cert->error) { $key->{error} = sprintf("Error decoding X.509 certificate: %s", $cert->error); } else { msvalog('verbose', "cert subject: %s\n", $cert->subject_cn()); msvalog('verbose', "cert issuer: %s\n", (defined $cert->issuer_cn() ? $cert->issuer_cn() : '')); msvalog('verbose', "cert pubkey algo: %s\n", $cert->PubKeyAlg()); msvalog('verbose', "cert pubkey: %s\n", unpack('H*', $cert->pubkey())); if ($cert->PubKeyAlg() ne 'RSA') { $key->{error} = sprintf('public key was algo "%s" (OID %s). MSVA.pl only supports RSA', $cert->PubKeyAlg(), $cert->pubkey_algorithm); } else { msvalog('debug', "decoding ASN.1 pubkey\n"); $key = $cert->pubkey_components(); if (! defined $key) { msvalog('verbose', "failed to decode %s\n", unpack('H*', $cert->pubkey())); $key = {error => 'failed to decode the public key'}; } else { # ensure these are Math::BigInts! $key->{exponent} = Math::BigInt::->new($key->{exponent}) unless (ref($key->{exponent})); $key->{modulus} = Math::BigInt::->new($key->{modulus}) unless (ref($key->{modulus})); my $pgpext = $cert->PGPExtension(); if (defined $pgpext) { $key->{openpgp4fpr} = Crypt::Monkeysphere::OpenPGP::fingerprint($key, $pgpext); msvalog('verbose', "OpenPGP Fingerprint (derived from X.509 cert): 0x%s\n", uc(unpack("H*", $key->{openpgp4fpr}))); } } } } return $key; } sub pem2der { my $pem = shift; my @lines = split(/\r?\n/, $pem); my @goodlines = (); my $ready = 0; foreach my $line (@lines) { if ($line eq '-----END CERTIFICATE-----') { last; } elsif ($ready) { push @goodlines, $line; } elsif ($line eq '-----BEGIN CERTIFICATE-----') { $ready = 1; } } msvalog('debug', "%d lines of base64:\n%s\n", $#goodlines + 1, join("\n", @goodlines)); return decode_base64(join('', @goodlines)); } sub opensshpubkey2key { my $data = shift; # FIXME: do we care that the label matches the type of key? my ($label, $prop) = split(/ +/, $data); my $out = parse_rfc4716body($prop); return $out; } sub rfc47162key { my $data = shift; my @goodlines; my $continuation = ''; my $state = 'outside'; foreach my $line (split(/\n/, $data)) { last if ($state eq 'body' && $line eq '---- END SSH2 PUBLIC KEY ----'); if ($state eq 'outside' && $line eq '---- BEGIN SSH2 PUBLIC KEY ----') { $state = 'header'; next; } if ($state eq 'header') { $line = $continuation.$line; $continuation = ''; if ($line =~ /^(.*)\\$/) { $continuation = $1; next; } if (! ($line =~ /:/)) { $state = 'body'; } } push(@goodlines, $line) if ($state eq 'body'); } msvalog('debug', "Found %d lines of RFC4716 body:\n%s\n", scalar(@goodlines), join("\n", @goodlines)); my $out = parse_rfc4716body(join('', @goodlines)); return $out; } sub parse_rfc4716body { my $data = shift; return undef unless defined($data); $data = decode_base64($data) or return undef; msvalog('debug', "key properties: %s\n", unpack('H*', $data)); my $out = [ ]; while (length($data) > 4) { my $size = unpack('N', substr($data, 0, 4)); msvalog('debug', "size: 0x%08x\n", $size); return undef if (length($data) < $size + 4); push(@{$out}, substr($data, 4, $size)); $data = substr($data, 4 + $size); } if ($out->[0] ne "ssh-rsa") { return {error => 'Not an RSA key'}; } if (scalar(@{$out}) != 3) { return {error => 'Does not contain the right number of bigints for RSA'}; } return { exponent => Math::BigInt->from_hex('0x'.unpack('H*', $out->[1])), modulus => Math::BigInt->from_hex('0x'.unpack('H*', $out->[2])), } ; } ## PKC KEY EXTRACTION ############################ ################################################## sub reviewcert { my $data = shift; my $clientinfo = shift; return if !ref $data; msvalog('verbose', "reviewing data...\n"); my $status = '200 OK'; my $ret = { valid => JSON::false, message => 'Unknown failure', }; # check that there actually is key data if ($data->{pkc}->{data} eq '') { $ret->{message} = sprintf("Key data empty."); return $status,$ret; } # check context string if ($data->{context} =~ /^(https|ssh|smtp|ike|postgresql|imaps|imap|submission|e-mail)$/) { $data->{context} = $1; } else { msvalog('error', "invalid context: %s\n", $data->{context}); $ret->{message} = sprintf("Invalid/unknown context: %s", $data->{context}); return $status,$ret; } msvalog('verbose', "context: %s\n", $data->{context}); # checkout peer string # old-style just passed a string as a peer, rather than # peer: { name: 'whatever', 'type': 'client' } $data->{peer} = { name => $data->{peer} } if (ref($data->{peer}) ne 'HASH'); if (defined($data->{peer}->{type})) { if ($data->{peer}->{type} =~ /^(client|server|peer)$/) { $data->{peer}->{type} = $1; } else { msvalog('error', "invalid peer type string: %s\n", $data->{peer}->{type}); $ret->{message} = sprintf("Invalid peer type string: %s", $data->{peer}->{type}); return $status,$ret; } } my $prefix = $data->{context}.'://'; if ($data->{context} eq 'e-mail' || (defined $data->{peer}->{type} && $data->{peer}->{type} eq 'client' && # ike and smtp clients are effectively other servers, so we'll # exclude them: $data->{context} !~ /^(ike|smtp)$/)) { $prefix = ''; # clients can have any one-line User ID without NULL characters # and leading or trailing whitespace if ($data->{peer}->{name} =~ /^([^[:space:]][^\n\0]*[^[:space:]]|[^\0[:space:]])$/) { $data->{peer}->{name} = $1; } else { msvalog('error', "invalid client peer name string: %s\n", $data->{peer}->{name}); $ret->{message} = sprintf("Invalid client peer name string: %s", $data->{peer}->{name}); return $status,$ret; } } elsif ($data->{peer}->{name} =~ /^($RE{net}{domain}(:[[:digit:]]+)?)$/) { $data->{peer}->{name} = $1; } else { msvalog('error', "invalid peer name string: %s\n", $data->{peer}->{name}); $ret->{message} = sprintf("Invalid peer name string: %s", $data->{peer}->{name}); return $status,$ret; } msvalog('verbose', "peer: %s\n", $data->{peer}->{name}); # generate uid string my $uid = $prefix.$data->{peer}->{name}; msvalog('verbose', "user ID: %s\n", $uid); # extract key or openpgp fingerprint from PKC my $fpr; my $key; if (lc($data->{pkc}->{type}) eq 'openpgp4fpr') { if ($data->{pkc}->{data} =~ /^(0x)?([[:xdigit:]]{40})$/) { $data->{pkc}->{data} = uc($2); $fpr = $data->{pkc}->{data}; } else { msvalog('error', "invalid OpenPGP v4 fingerprint: %s\n",$data->{pkc}->{data}); $ret->{message} = sprintf("Invalid OpenPGP v4 fingerprint."); return $status,$ret; } } else { # extract key from PKC $key = pkcextractkey($data); if (exists $key->{error}) { $ret->{message} = $key->{error}; return $status,$ret; } $fpr = uc(unpack('H*', $key->{openpgp4fpr})) if (exists $key->{openpgp4fpr}); } msvalog('verbose', "OpenPGP v4 fingerprint: %s\n",$fpr) if defined $fpr; # determine keyserver policy my $kspolicy; if (defined $data->{keyserverpolicy} && $data->{keyserverpolicy} =~ /^(always|never|unlessvalid)$/) { $kspolicy = $1; msvalog("verbose", "using requested keyserver policy: %s\n", $1); } else { $kspolicy = get_keyserver_policy(); } msvalog('debug', "keyserver policy: %s\n", $kspolicy); # needed because $gnupg spawns child processes $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin'; $ret->{message} = sprintf('Failed to validate "%s" through the OpenPGP Web of Trust.', $uid); my $validator=new Crypt::Monkeysphere::Validator(kspolicy=>$kspolicy, context=>$data->{context}, keyserver=>get_keyserver(), gnupg=>$gnupg, logger=>$logger); my $uid_query=$validator->lookup(uid=>$uid,fpr=>$fpr,key=>$key); # only show the marginal UI if the UID of the corresponding # key is not fully valid. if (defined($uid_query->{valid_key})) { $ret->{valid} = JSON::true; $ret->{message} = sprintf('Successfully validated "%s" through the OpenPGP Web of Trust.', $uid); } else { my $resp = Crypt::Monkeysphere::MSVA::MarginalUI->ask_the_user($gnupg, $uid, $uid_query->{subvalid_keys}, getpidswithsocketinode($clientinfo->{inode}), $logger); msvalog('info', "response: %s\n", $resp); if ($resp) { $ret->{valid} = JSON::true; $ret->{message} = sprintf('Manually validated "%s" through the OpenPGP Web of Trust.', $uid); } } return $status,$ret; } sub pre_loop_hook { my $self = shift; my $server = shift; $self->spawn_as_child($server); } sub pre_accept_hook { my $self = shift; my $server = shift; $self->parent_changed($server) if (defined $self->{parent_pid} && getppid() != $self->{parent_pid}); } sub parent_changed { my $self = shift; my $server = shift; msvalog('verbose', "parent %d went away; exiting.\n", $self->{parent_pid}); $server->set_exit_status(0); $server->server_close(); } sub child_dies { my $self = shift; my $pid = shift; my $server = shift; msvalog('debug', "Subprocess %d terminated.\n", $pid); if (exists $self->{updatemonitor} && defined $self->{updatemonitor}->getchildpid() && $self->{updatemonitor}->getchildpid() == $pid) { my $exitstatus = POSIX::WEXITSTATUS($?); msvalog('verbose', "Update monitoring process (%d) terminated with code %d.\n", $pid, $exitstatus); if (0 == $exitstatus) { msvalog('info', "Reloading MSVA due to update request.\n"); # sending self a SIGHUP: kill(1, $$); } else { msvalog('error', "Update monitoring process (%d) died unexpectedly with code %d.\nNo longer monitoring for updates; please send HUP manually.\n", $pid, $exitstatus); # it died for some other weird reason; should we respawn it? # FIXME: i'm worried that re-spawning would create a # potentially abusive loop, if there are legit, repeatable # reasons for the failure. # $self->{updatemonitor}->spawn(); # instead, we'll just avoid trying to kill the next process with this PID: $self->{updatemonitor}->forget(); } } } sub post_bind_hook { my $self = shift; my $server = shift; $server->{server}->{leave_children_open_on_hup} = 1; my $socketcount = @{ $server->{server}->{sock} }; # note: we're assuming here that if there are more than one socket # open (e.g. IPv6 and IPv4, or multiple IP addresses of the same # family), they all share the same port number as socket 0. if ( $socketcount < 1 ) { msvalog('error', "%d sockets open; should have been at least 1.\n", $socketcount); $server->set_exit_status(10); $server->server_close(); } if (!defined($self->port) || $self->port == 0) { my $port = @{ $server->{server}->{sock} }[0]->sockport(); if (! defined($port)) { msvalog('error', "got undefined port.\nRecording as 0.\n", $port); $port = 0; } elsif (($port < 1) || ($port >= 65536)) { msvalog('error', "got nonsense port: %d.\nRecording as 0.\n", $port); $port = 0; } elsif ((exists $ENV{MSVA_PORT}) && (($ENV{MSVA_PORT} + 0) != $port)) { msvalog('error', "Explicitly requested port %d, but got port: %d.", ($ENV{MSVA_PORT}+0), $port); $server->set_exit_status(13); $server->server_close(); } $self->port($port); } } sub spawn_as_child { my $self = shift; my $server = shift; if ((exists $ENV{MSVA_PARENT_PID}) && ($ENV{MSVA_PARENT_PID} ne '')) { # this is most likely a re-exec. msvalog('info', "This appears to be a re-exec, continuing with parent pid %d\n", $ENV{MSVA_PARENT_PID}); $self->{parent_pid} = $ENV{MSVA_PARENT_PID} + 0; } elsif ($#ARGV >= 0) { $self->{parent_pid} = 0; # indicate that we are planning to fork. # avoid ignoring SIGCHLD right before we fork. $SIG{CHLD} = sub { my $val; while (defined($val = POSIX::waitpid(-1, POSIX::WNOHANG)) && $val > 0) { $self->child_dies($val, $server); } }; my $pid = $$; my $fork = fork(); if (! defined $fork) { msvalog('error', "could not fork\n"); } else { if (! $fork) { msvalog('debug', "daemon has PID %d, parent has PID %d\n", $$, $pid); $self->{parent_pid} = $pid; # ppid is set in Net::Server::Fork's post_configure; we're # past post_configure by here, and we're about to change # process IDs before assuming the role of a forking server, # so we should set it properly: $server->{server}->{ppid} = $$; $ENV{MSVA_PARENT_PID} = $pid; } else { msvalog('verbose', "PID %d executing: \n", $$); for my $arg (@ARGV) { msvalog('verbose', " %s\n", $arg); } # untaint the environment for the parent process # see: https://labs.riseup.net/code/issues/2461 foreach my $e (keys %ENV) { $ENV{$e} = untaint($ENV{$e}); } my @args; foreach (@ARGV) { push @args, untaint($_); } # restore default SIGCHLD handling: $SIG{CHLD} = 'DEFAULT'; $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET} = sprintf('http://127.0.0.1:%d', $self->port); exec(@args) or exit 111; } } } else { printf("MONKEYSPHERE_VALIDATION_AGENT_SOCKET=http://127.0.0.1:%d;\nexport MONKEYSPHERE_VALIDATION_AGENT_SOCKET;\n", $self->port); # FIXME: consider daemonizing here to behave more like # ssh-agent. maybe avoid backgrounding by setting # MSVA_NO_BACKGROUND. }; if (exists $ENV{MSVA_MONITOR_CHANGES} && $ENV{MSVA_MONITOR_CHANGES} eq 'true') { $self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor::->new($logger); } else { msvalog('verbose', "Not monitoring for changes\n"); } } sub extracerts { my $data = shift; return '500 not yet implemented', { }; } 1; } msva-perl-0.9.2/Crypt/Monkeysphere/MSVA/000077500000000000000000000000001221326450300177465ustar00rootroot00000000000000msva-perl-0.9.2/Crypt/Monkeysphere/MSVA/Client.pm000066400000000000000000000101231221326450300215170ustar00rootroot00000000000000#---------------------------------------------------------------------- # Monkeysphere Validation Agent, Perl version # Marginal User Interface for reasonable prompting # Copyright © 2010 Daniel Kahn Gillmor , # Matthew James Goins , # Jameson Graef Rollins , # Elliot Winard # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # #---------------------------------------------------------------------- { package Crypt::Monkeysphere::MSVA::Client; use strict; use warnings; use JSON; use Crypt::Monkeysphere::Logger; use LWP::UserAgent; use HTTP::Request; use Module::Load::Conditional; sub log { my $self = shift; $self->{logger}->log(@_); } sub agent_info { my $self = shift; my $requesturl = $self->{socket} . '/'; my $request = HTTP::Request->new('GET', $requesturl); $self->log('debug', "Contacting MSVA at %s\n", $requesturl); my $response = $self->{ua}->request($request); my $status = $response->status_line; my $ret; if ($status eq '200 OK') { $ret = from_json($response->content); } return $status, $ret; } sub query_agent { my $self = shift; my $context = shift; my $peer = shift; my $peertype = shift; my $pkctype = shift; my $pkcdata = shift; my $keyserverpolicy = shift; my $apd = $self->create_apd($context, $peer, $peertype, $pkctype, $pkcdata, $keyserverpolicy); my $apdjson = to_json($apd); my $headers = HTTP::Headers->new( 'Content-Type' => 'application/json', 'Content-Length' => length($apdjson), 'Connection' => 'close', 'Accept' => 'application/json', ); my $requesturl = $self->{socket} . '/reviewcert'; my $request = HTTP::Request->new( 'POST', $requesturl, $headers, $apdjson, ); $self->log('debug', "Contacting MSVA at %s\n", $requesturl); my $response = $self->{ua}->request($request); my $status = $response->status_line; my $ret; if ($status eq '200 OK') { $ret = from_json($response->content); } return $status, $ret; } sub create_apd { my $self = shift; my $context = shift; my $peer = shift; my $peertype = shift; my $pkctype = shift; my $pkcdata = shift; my $keyserverpolicy = shift; $self->log('debug', "context: %s\n", $context); $self->log('debug', "peer: %s\n", $peer); $self->log('debug', "pkctype: %s\n", $pkctype); my $transformed_data; if ($pkctype eq 'x509der') { # remap raw der data into numeric array $transformed_data = [map(ord, split(//,$pkcdata))]; } else { $transformed_data = $pkcdata; } my $ret = { context => $context, peer => { name => $peer}, pkc => { type => $pkctype, data => $transformed_data, }, }; $ret->{peer}->{type} = $peertype if (defined $peertype); $ret->{keyserverpolicy} = $keyserverpolicy if (defined $keyserverpolicy); return $ret; }; sub new { my $class = shift; my %args = @_; my $self = {}; $self->{logger} = Crypt::Monkeysphere::Logger->new($args{log_level}); $self->{socket} = $args{socket}; $self->{socket} = 'http://127.0.0.1:8901' if (! defined $self->{socket} or $self->{socket} eq ''); # create the user agent $self->{ua} = LWP::UserAgent->new; bless ($self,$class); return $self; } 1; } msva-perl-0.9.2/Crypt/Monkeysphere/MSVA/MarginalUI.pm000077500000000000000000000261241221326450300223040ustar00rootroot00000000000000#---------------------------------------------------------------------- # Monkeysphere Validation Agent, Perl version # Marginal User Interface for reasonable prompting # Copyright © 2010 Daniel Kahn Gillmor , # Matthew James Goins , # Jameson Graef Rollins , # Elliot Winard # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # #---------------------------------------------------------------------- { package Crypt::Monkeysphere::MSVA::MarginalUI; use strict; use warnings; use IO::File; use Module::Load::Conditional; sub ask_the_user { my $self = shift; my $gnupg = shift; my $uid = shift; my $fprs = shift; my $clientpids = shift; my $logger = shift; my @subvalid_key_fprs = @{$fprs}; $logger->log('debug', "%d subvalid_key_fprs\n", $#subvalid_key_fprs+1); if (! Module::Load::Conditional::can_load('modules' => { 'Gtk2' => undef })) { $logger->log('info', "Gtk2 Perl module is unavailable, so no marginal UI presented\n"); return 0; } foreach my $keyfpr (@subvalid_key_fprs) { $keyfpr->{fingerprint}->as_hex_string() =~ /([[:xdigit:]]{0,40})/; my $fprx = '0x' . $1; $logger->log('debug', "checking on %s\n", $fprx); foreach my $gpgkey ($gnupg->get_public_keys_with_sigs($fprx)) { $logger->log('debug', "found key %.40s\n", $gpgkey->fingerprint->as_hex_string); my @valid_certifiers = (); my @marginal_certifiers = (); my @valid_other_userids = (); my @marginal_other_userids = (); # FIXME: if there are multiple keys in the OpenPGP WoT # with the same key material and the same User ID # attached, we'll be throwing multiple prompts per query # (until the user selects one or cancels them all). # That's a mess, but i'm not sure what the better thing # to do is. foreach my $user_id ($gpgkey->user_ids) { $logger->log('debug', "found EE User ID %s\n", $user_id->as_string); my @vcertifiers = (); my @mcertifiers = (); if ($user_id->as_string eq $uid) { # get a list of the certifiers of the relevant User ID for the key foreach my $cert (@{$user_id->signatures}) { if ($cert->hex_id =~ /^([A-Fa-f0-9]{16})$/) { my $certid = $1; # disregard self-certifications (see MS # 2569): if (lc($certid) eq lc(substr($keyfpr->{fingerprint}->as_hex_string(), -16))) { $logger->log('debug', "found self-sig 0x%.16s\n", $certid); next; } $logger->log('debug', "found certifier 0x%.16s\n", $certid); if ($cert->is_valid()) { foreach my $certifier ($gnupg->get_public_keys(sprintf('0x%.40s!', $certid))) { my $valid_cuid = 0; my $marginal = undef; foreach my $cuid ($certifier->user_ids) { # grab the first full or ultimate user ID on # this certifier's key: if ($cuid->validity =~ /^[fu]$/) { if (0 == grep { $_->{key_id} eq $cert->hex_id && $_->{user_id} eq $cuid->as_string ; } @vcertifiers) { push(@vcertifiers, { key_id => $cert->hex_id, user_id => $cuid->as_string, } ); $valid_cuid = 1; }; last; } elsif ((!defined ($marginal)) && $cuid->validity =~ /^[m]$/) { if (0 == grep { $_->{key_id} eq $cert->hex_id && $_->{user_id} eq $cuid->as_string ; } @mcertifiers) { $marginal = { key_id => $cert->hex_id, user_id => $cuid->as_string, }; } } } push(@mcertifiers, $marginal) if (! $valid_cuid && defined $marginal); } } } else { $logger->log('error', "certifier ID does not fit expected pattern '%s'\n", $cert->hex_id); } } push(@valid_certifiers,@vcertifiers); push(@marginal_certifiers,@mcertifiers); } else { ## do we care at all about other User IDs on this key? if ($user_id->validity() =~ /^[fu]$/) { push(@valid_other_userids, $user_id->as_string()); $logger->log('verbose', "Found valid alternate user ID '%s'\n", $user_id->as_string()); } elsif ($user_id->validity() =~ /^[m]$/) { push(@marginal_other_userids, $user_id->as_string()); $logger->log('debug', "Found marginally-valid alternate user ID '%s'\n", $user_id->as_string()); } } } # We now know the list of fully/ultimately-valid # certifiers, and a separate list of marginally-valid # certifiers. if ($#valid_certifiers < 0) { $logger->log('info', "No valid certifiers, so no marginal UI\n"); } else { my $certifier_list = join("\n", map { sprintf("%s [%s]", $_->{user_id}, $_->{key_id}, ) } @valid_certifiers); my $others = ''; if ($#valid_other_userids >= 0) { $others = sprintf(' The certificate also has the following valid (but non-matching) identities: %s ', join("\n", @valid_other_userids)); } # FIXME: should we do something with marginally-valid # User IDs (@marginal_other_user_ids)? my $msg = sprintf("The matching key for \"%s\" is not %svalid. The certificate is certified by: %s %s Would you like to temporarily accept this certificate for this peer?", $uid, ('m' eq $keyfpr->{val} ? 'fully ' : ''), $certifier_list, $others, ); my $tip = sprintf("Peer's User ID: %s Peer's OpenPGP key fingerprint: 0x%.40s GnuPG calculated validity for the peer: %s", $uid, $keyfpr->{fingerprint}->as_hex_string, $keyfpr->{val}, ); # FIXME: what about revoked certifications? # FIXME: what about expired certifications? # FIXME: what about certifications ostensibly made in the future? my @clienttext; foreach my $clientpid (@{$clientpids}) { my $cmd = ''; # FIXME: not very portable my $procfh; $procfh = IO::File::->new(sprintf('/proc/%d/cmdline', $clientpid)); if (defined $procfh) { $cmd = <$procfh>; $procfh->close; # FIXME: maybe there's a better way to display this textually # that doesn't conflate spaces with argument delimiters? $cmd = join(' ', split(/\0/, $cmd)); } push @clienttext, sprintf("Process %d (%s)", $clientpid, $cmd); } if ($#clienttext >= 0) { $tip = sprintf("%s\n\nRequested by:\n%s\n", $tip, join("\n", @clienttext)); } $logger->log('info', "%s\n", $msg); $logger->log('verbose', "%s\n", $tip); my $resp = prompt($uid, $msg, $tip); if ($resp) { return $resp; } } # FIXME: not doing anything with @marginal_certifiers # -- that'd be yet more queries to gpg :( } } return 0; } sub prompt { my $peer = shift; my $labeltxt = shift; my $tip = shift; require Gtk2; Gtk2->init(); # create a new dialog with some buttons - one stock, one not. my $dialog = Gtk2::Dialog->new(sprintf('Monkeysphere validation agent [%s]', $peer), undef, [], 'gtk-no' => 'cancel', 'gtk-yes' => 'ok'); my $label = Gtk2::Label->new($labeltxt); # make the text in the dialog box selectable $label->set('selectable', 1); $label->show(); my $button = Gtk2::Button->new_with_label($peer); $button->show(); my $tipshowing = 0; my $tooltips = Gtk2::Tooltips->new(); $tooltips->set_tip($label, $tip); $dialog->get_content_area()->add($button); $dialog->get_content_area()->add($label); my ($width, $height) = $dialog->get_size(); $button->signal_connect('clicked', sub { # FIXME: for some reason, $label->set_text($labeltxt."\n\n".$tip) throws this error: # Insecure dependency in eval_sv() while running with -T switch at Crypt/Monkeysphere/MSVA/MarginalUI.pm line 180. # the workaround here (remove, destroy, re-create) seems to work, though. $dialog->get_content_area()->remove($label); $label->destroy(); $tipshowing = ! $tipshowing; if (!$tipshowing) { $label = Gtk2::Label->new($labeltxt); $tooltips->set_tip($label, $tip); $dialog->resize($width, $height); } else { $label = Gtk2::Label->new($tip."\n\n".$labeltxt); } $label->set('selectable', 1); $label->show(); $dialog->get_content_area()->add($label); }); my $resp = 0; my $icon_file = '/usr/share/pixmaps/monkeysphere-icon.png'; $dialog->set_default_icon_from_file($icon_file) if (-r $icon_file); $dialog->set_default_response('cancel'); # set initial kbd input focus on "No" also: ($dialog->get_action_area()->get_children())[1]->grab_focus(); my $response = $dialog->run(); if ($response eq 'ok') { $resp = 1; } # we'll let the fact that the process is about to terminate # destroy the window. so lazy! return $resp; } 1; } msva-perl-0.9.2/Crypt/Monkeysphere/MSVA/Monitor.pm000066400000000000000000000140071221326450300217350ustar00rootroot00000000000000#---------------------------------------------------------------------- # Monkeysphere Validation Agent, Perl version # Marginal User Interface for reasonable prompting # Copyright © 2010 Daniel Kahn Gillmor , # Matthew James Goins , # Jameson Graef Rollins , # Elliot Winard # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # #---------------------------------------------------------------------- { package Crypt::Monkeysphere::MSVA::Monitor; use Module::Load::Conditional; use strict; use warnings; sub createwindow { my $self = shift; require Gtk2; Gtk2->init(); $self->{dialog} = Gtk2::Dialog->new("Monkeysphere Validation Agent updated!", undef, [], 'gtk-no' => 'cancel', 'gtk-yes' => 'ok'); my $icon_file = '/usr/share/pixmaps/monkeysphere-icon.png'; $self->{dialog}->set_default_icon_from_file($icon_file) if (-r $icon_file); $self->{dialog}->set_default_response('ok'); my $label = Gtk2::Label->new("Some components of the running Monkeysphere Validation Agent have been updated. Would you like to restart the validation agent?"); $label->show(); $self->{dialog}->get_content_area()->add($label); $self->{dialog}->signal_connect(response => sub { my ($dialog,$resp) = @_; $self->button_clicked($resp); }); $self->{dialog}->signal_connect(delete_event => sub { $self->button_clicked('cancel'); return 1; }); } sub button_clicked { my $self = shift; my $resp = shift; if ($resp eq 'ok') { # if the user wants to restart the validation agent, we should terminate # so that our parent gets a SIGCHLD. exit 0; } else { $self->{dialog}->hide(); } } sub prompt { my $self = shift; $self->{dialog}->show(); } sub spawn { my $self = shift; if (! Module::Load::Conditional::can_load('modules' => { 'Gtk2' => undef, 'AnyEvent' => undef, 'Linux::Inotify2' => undef, })) { $self->{logger}->log('info', "Not spawning a monitoring process; issue 'kill -s HUP %d' to restart after upgrades.\nInstall Perl modules Gtk2, AnyEvent, and Linux::Inotify2 for automated restarts on upgrades.\n", $$); return; } my $fork = fork(); if (! defined $fork) { $self->{logger}->log('error', "Failed to spawn monitoring process\n"); return; } if ($fork) { $self->{monitorpid} = $fork; $self->{logger}->log('debug', "spawned monitoring process pid %d\n", $self->{monitorpid}); return; } else { $self->childmain(); } } sub childmain { my $self = shift; $0 = 'MSVA (perl) Upgrade Monitor'; $self->{files} = [ $0, values(%INC) ]; $self->{logger}->log('debug3', "setting up monitoring on these files:\n%s\n", join("\n", @{$self->{files}})); # close all filedescriptors except for std{in,out,err}: # see http://markmail.org/message/mlbnvfa7ds25az2u close $_ for map { /^(?:ARGV|std(?:err|out|in)|STD(?:ERR|OUT|IN))$/ ? () : *{$::{$_}}{IO} || () } keys %::; $self->createwindow(); require Linux::Inotify2; $self->{inotify} = Linux::Inotify2::->new() or die "unable to create new inotify object: $!"; my $flags = 0xc06; # FIXME: couldn't figure out how to get these to work in "strict subs" mode: # my $flags = Linux::Inotify2::IN_MODIFY | # Linux::Inotify2::IN_ATTRIB | # Linux::Inotify2::IN_DELETE_SELF | # Linux::Inotify2::IN_MOVE_SELF; foreach my $file (@{$self->{files}}) { $self->{inotify}->watch($file, $flags, sub { $self->prompt(); }); } require AnyEvent; my $inotify_w = AnyEvent->io ( fh => $self->{inotify}->fileno, poll => 'r', cb => sub { $self->changed }, ); my $w = AnyEvent->signal(signal => 'TERM', cb => sub { exit 1; }); Gtk2->main(); $self->{logger}->log('error', "Got to the end of the monitor process somehow\n"); # if we get here, we want to terminate with non-zero exit 1; } sub changed { my $self = shift; $self->{logger}->log('debug', "changed!\n"); $self->{inotify}->poll(); } # forget about cleaning up the monitoring child (e.g. we only want # the parent process to know about this) sub forget { my $self = shift; undef $self->{monitorpid}; } sub getchildpid { my $self = shift; return $self->{monitorpid}; } sub DESTROY { my $self = shift; if (defined $self->{monitorpid}) { kill('TERM', $self->{monitorpid}); my $oldexit = $?; waitpid($self->{monitorpid}, 0); $? = $oldexit; undef($self->{monitorpid}); } } sub new { my $class = shift; my $logger = shift; my $self = { monitorpid => undef, logger => $logger, }; bless ($self, $class); $self->spawn(); return $self; } 1; } msva-perl-0.9.2/Crypt/Monkeysphere/OpenPGP.pm000066400000000000000000000154511221326450300210140ustar00rootroot00000000000000package Crypt::Monkeysphere::OpenPGP; use strict; use warnings; use Math::BigInt; use Digest::SHA; ## WARNING! This entire module has an unstable API at the moment. ## Please do not rely on it, as it may change in the near future. my $tables = { # see RFC 4880 section 9.1 (ignoring deprecated algorithms for now) asym_algos => { rsa => 1, elgamal => 16, dsa => 17, }, # see RFC 4880 section 9.2 ciphers => { plaintext => 0, idea => 1, tripledes => 2, cast5 => 3, blowfish => 4, aes128 => 7, aes192 => 8, aes256 => 9, twofish => 10, }, # see RFC 4880 section 9.3 compression => { uncompressed => 0, zip => 1, zlib => 2, bzip2 => 3, }, # see RFC 4880 section 9.4 digests => { md5 => 1, sha1 => 2, ripemd160 => 3, sha256 => 8, sha384 => 9, sha512 => 10, sha224 => 11, }, # see RFC 4880 section 5.2.3.21 usage_flags => { certify => 0x01, sign => 0x02, encrypt_comms => 0x04, encrypt_storage => 0x08, encrypt => 0x0c, ## both comms and storage split => 0x10, # the private key is split via secret sharing authenticate => 0x20, shared => 0x80, # more than one person holds the entire private key }, # see RFC 4880 section 4.3 packet_types => { pubkey_enc_session => 1, sig => 2, symkey_enc_session => 3, onepass_sig => 4, seckey => 5, pubkey => 6, sec_subkey => 7, compressed_data => 8, symenc_data => 9, marker => 10, literal => 11, trust => 12, uid => 13, pub_subkey => 14, uat => 17, symenc_w_integrity => 18, mdc => 19, }, # see RFC 4880 section 5.2.1 sig_types => { binary_doc => 0x00, text_doc => 0x01, standalone => 0x02, generic_certification => 0x10, persona_certification => 0x11, casual_certification => 0x12, positive_certification => 0x13, subkey_binding => 0x18, primary_key_binding => 0x19, key_signature => 0x1f, key_revocation => 0x20, subkey_revocation => 0x28, certification_revocation => 0x30, timestamp => 0x40, thirdparty => 0x50, }, # see RFC 4880 section 5.2.3.23 revocation_reasons => { no_reason_specified => 0, key_superseded => 1, key_compromised => 2, key_retired => 3, user_id_no_longer_valid => 32, }, # see RFC 4880 section 5.2.3.1 subpacket_types => { sig_creation_time => 2, sig_expiration_time => 3, exportable => 4, trust_sig => 5, regex => 6, revocable => 7, key_expiration_time => 9, preferred_cipher => 11, revocation_key => 12, issuer => 16, notation => 20, preferred_digest => 21, preferred_compression => 22, keyserver_prefs => 23, preferred_keyserver => 24, primary_uid => 25, policy_uri => 26, usage_flags => 27, signers_uid => 28, revocation_reason => 29, features => 30, signature_target => 31, embedded_signature => 32, }, # bitstring (see RFC 4880 section 5.2.3.24) features => { mdc => 0x01 }, # bitstring (see RFC 4880 5.2.3.17) keyserver_prefs => { nomodify => 0x80 }, }; # takes a Math::BigInt, returns it formatted as OpenPGP MPI # (RFC 4880 section 3.2) sub mpi_pack { my $num = shift; my $hex = $num->as_hex(); $hex =~ s/^0x//; # ensure we've got an even multiple of 2 nybbles here. $hex = '0'.$hex if (length($hex) % 2); my $val = pack('H*', $hex); my $mpilen = length($val)*8; # this is a kludgy way to get the number of significant bits in the # first byte: my $bitsinfirstbyte = length(sprintf("%b", ord($val))); $mpilen -= (8 - $bitsinfirstbyte); return pack('n', $mpilen).$val; } sub make_rsa_pub_key_body { my $key = shift; my $key_timestamp = shift; return pack('CN', 4, $key_timestamp). pack('C', $tables->{asym_algos}->{rsa}). mpi_pack($key->{modulus}). mpi_pack($key->{exponent}); } sub fingerprint { my $key = shift; my $key_timestamp = shift; my $rsabody = make_rsa_pub_key_body($key, $key_timestamp); return Digest::SHA::sha1(pack('Cn', 0x99, length($rsabody)).$rsabody); } 1; msva-perl-0.9.2/Crypt/Monkeysphere/Util.pm000066400000000000000000000004271221326450300204560ustar00rootroot00000000000000package Crypt::Monkeysphere::Util; use strict; use warnings; use Exporter qw(import); our @EXPORT_OK=qw(untaint); # use sparingly! We want to keep taint mode around for the data we # get over the network. sub untaint { my $x = shift; $x =~ /^(.*)$/ ; return $1; } 1; msva-perl-0.9.2/Crypt/Monkeysphere/Validator.pm000066400000000000000000000126021221326450300214640ustar00rootroot00000000000000package Crypt::Monkeysphere::Validator; use Carp; use strict; use warnings; use parent 'Crypt::Monkeysphere::Keyserver'; =pod =head2 new Create a new Crypt::Monkeysphere::Validator instance Arguments Param hash, all optional. context => 'e-mail|https|ssh|...' control what counts as suitable user IDs and key capabilities. kspolicy => 'always|never|unlessvalid' when to fetch keys and key updates from keyserver. (plus arguments for Crypt::Monkeysphere::{Keyserver,Logger}::new ) =head2 lookup Arguments Param hash. uid => (mandatory) OpenPGP User ID desired. fpr => fingerprint of the key to compare key => hash of pubkey parameters as Math::BigInt values one of either fpr or key must be supplied. Return Value Returns a hashref If the lookup succeeded, then the hashref has a key named valid_key that points to a hashref { fingerprint => $fpr, val => $validity }. If no fully-valid keys+userid were found, but some keys matched with less-than-valid user IDs, then the hashref has a key named subvalid_keys that points to an arrayref of { fingerprint => $fpr, val => $validity } hashrefs. =cut sub new { my $class=shift; my %opts=@_; my $self=$class->SUPER::new(%opts); $self->{context}=$opts{context} || 'ssh'; $self->{kspolicy}=$opts{kspolicy} || 'unlessvalid'; return $self; } sub test_capable { my $self=shift; my $subkey=shift; if ($self->{context} eq 'e-mail') { if ($subkey->usage_flags =~ /s/) { $self->log('verbose', "...and is signing-capable...\n"); return 1; } else { $self->log('verbose', "...but is not signing-capable (%s).\n",$subkey->usage_flags); } } else { if ($subkey->usage_flags =~ /a/) { $self->log('verbose', "...and is authentication-capable...\n"); return 1; } else { $self->log('verbose', "...but is not authentication-capable (%s).\n",$subkey->usage_flags); } } return 0; } sub _tryquery { my $self=shift; my %args=@_; my $uid=$args{uid} || croak "uid argument is mandatory"; my $fpr=$args{fpr}; my $key=$args{key}; defined($fpr) || defined($key) || croak "Must supply either a fingerprint or a key"; my $subvalid_keys = []; my $gpgquery = defined($fpr) ? '0x'.$fpr : '='.$uid; foreach my $gpgkey ($self->{gnupg}->get_public_keys($gpgquery)) { my $validity = '-'; foreach my $tryuid ($gpgkey->user_ids) { if ($tryuid->as_string eq $uid) { $validity = $tryuid->validity; } } # treat primary keys just like subkeys: foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) { if ((defined($key) && $self->keycomp($key, $subkey)) || (defined($fpr) && ($subkey->fingerprint->as_hex_string eq $fpr))) { $self->log('verbose', "key 0x%s matches...\n",$subkey->hex_id); if ($self->test_capable($subkey) ) { if ($validity =~ /^[fu]$/) { $self->log('verbose', "...and is fully valid!\n"); # we have a key that matches with a valid userid -- no need to look further. return {valid_key => { fingerprint => $subkey->fingerprint, val => $validity }}; } else { $self->log('verbose', "...but is not fully valid (%s).\n",$validity); push(@{$subvalid_keys}, {fingerprint => $subkey->fingerprint, val => $validity }); } } } } } return { subvalid_keys => $subvalid_keys }; } sub lookup { my $self=shift; my %opts=@_; if ($self->{kspolicy} eq 'unlessvalid') { my $ret = $self->_tryquery(uid => $opts{uid}, fpr => $opts{fpr}, key => $opts{key}); return $ret if exists($ret->{valid_key}); }; if ($self->{kspolicy} ne 'never') { if (defined($opts{fpr})) { $self->fetch_fpr($opts{fpr}); } else { $self->fetch_uid($opts{uid}); } } return $self->_tryquery(uid => $opts{uid}, fpr => $opts{fpr}, key => $opts{key}); } sub valid_binding { my $self = shift; my $uid = shift; my $gpgkey = shift; my $validity = '-'; foreach my $tryuid ($gpgkey->user_ids) { if ($tryuid->as_string eq $uid) { return 1 if $tryuid->validity =~ /^[fu]$/; } } return 0; } =pod =head2 findall Find all keys with appropriate capabilities and valid bindings to the given uid. =cut sub findall{ my $self=shift; my $uid=shift; $self->fetch_uid($uid) if ($self->{kspolicy} eq 'always'); my @keys = $self->_findall($uid); if (scalar(@keys) == 0 and $self->{kspolicy} eq 'unlessvalid'){ $self->fetch_uid($uid); @keys=$self->_findall($uid); } return @keys; } sub _findall { my $self=shift; my $uid=shift; my @keys; my $x = 0; foreach my $gpgkey ($self->{gnupg}->get_public_keys('='.$uid)) { if ($self->valid_binding($uid, $gpgkey)) { foreach my $subkey ($gpgkey, @{$gpgkey->subkeys()}) { if ($self->test_capable($subkey) ) { $self->log('verbose', "key 0x%s is capable...\n",$subkey->hex_id); push(@keys, $subkey); } } } } return @keys; } sub keycomp { my $self=shift; my $rsakey = shift; my $gpgkey = shift; if ($gpgkey->algo_num != 1) { my $self->log('verbose', "Monkeysphere only does RSA keys. This key is algorithm #%d\n", $gpgkey->algo_num); } else { if ($rsakey->{exponent}->bcmp($gpgkey->pubkey_data->[1]) == 0 && $rsakey->{modulus}->bcmp($gpgkey->pubkey_data->[0]) == 0) { return 1; } } return 0; } 1; msva-perl-0.9.2/Makefile000077500000000000000000000015401221326450300150710ustar00rootroot00000000000000#!/usr/bin/make -f # Makefile for msva-perl # © 2010 Daniel Kahn Gillmor # Licensed under GPL v3 or later VERSION := $(shell dpkg-parsechangelog -lChangelog | grep ^Version: | cut -f2 -d\ ) DEBIAN_VERSION=`dpkg-parsechangelog | grep ^Version: | cut -f2 -d\ ` MANPAGES=msva-perl.1 msva-query-agent.1 all: $(MANPAGES) Crypt/Monkeysphere/MSVA.pm %.1: % pod2man $< $@ Crypt/Monkeysphere/MSVA.pm: Changelog sed -i "s/^ \\\$$VERSION = '[a-z0-9.~A-Z]*';$$/ \$$VERSION = '$(VERSION)';/" $@ clean: rm -f $(MANPAGES) debian-package: git buildpackage -uc -us upstream-tag: git tag -s msva-perl/$(VERSION) -m "releasing msva-perl version $(VERSION)" debian-tag: git tag -s msva-perl_debian/$(DEBIAN_VERSION) -m "tagging msva-perl debian packaging version $(DEBIAN_VERSION)" .PHONY: upstream-tag debian-package debian-tag all clean msva-perl-0.9.2/Net/000077500000000000000000000000001221326450300141545ustar00rootroot00000000000000msva-perl-0.9.2/Net/Server/000077500000000000000000000000001221326450300154225ustar00rootroot00000000000000msva-perl-0.9.2/Net/Server/MSVA.pm000066400000000000000000000037461221326450300165400ustar00rootroot00000000000000#!/usr/bin/perl -wT # Net::Server implementation for Monkeysphere Validation Agent # Copyright © 2010 Daniel Kahn Gillmor # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . { package Net::Server::MSVA; use strict; use base qw(Net::Server::Fork); use Net::Server 2.000 (); my $msva; # guarantee initial failure -- this will be cleared after we bind # successfully. my $exit_status = 13; sub post_bind_hook { my $self = shift; # if we got here, then the binding was successful. $exit_status = 0; $msva->post_bind_hook($self, @_); } sub pre_loop_hook { my $self = shift; $msva->pre_loop_hook($self, @_); } sub pre_accept_hook { my $self = shift; $msva->pre_accept_hook($self, @_); } sub set_exit_status { my $self = shift; $exit_status = shift; } # FIXME: this is an override of an undocumented interface of # Net::Server. it would be better to use a documented hook, if # https://rt.cpan.org/Public/Bug/Display.html?id=55485 was resolved sub delete_child { my $self = shift; my $pid = shift; $msva->child_dies($pid, $self); $self->SUPER::delete_child($pid, @_); } sub server_exit { my $self = shift; exit $exit_status; } sub run { my $self = shift; my $options = { @_ }; if (exists $options->{msva}) { $msva = $options->{msva}; }; $self->SUPER::run(@_); } 1; } msva-perl-0.9.2/README.schema000066400000000000000000000014121221326450300155430ustar00rootroot00000000000000HYPOTHETICAL DOCS ---------------- These notes describe what a hypothetical schema for a self-implemented Monkeysphere Validation Agent (with no reliance on gpg) might look like. This describes only the relational tables that might be relevant, and it is in some kind of pseudo-SQL. Public Key Carriers { x509 certs { cert, raw id#, } openpgp certs { cert, raw id#, } raw public keys { raw id#, key, revoked?, } } OpenPGP subkeys { key, raw id#, } ownertrust { raw id#, quantity, depth, uid, scope, } certs { issuer (pkc), subject (pkc), uid, expiry, add'l data, } exceptions { uid, pkc, context, expiry } config vars { preferred keyserver, preferred digest algorithms, et cetera, } msva-perl-0.9.2/gpgkeys_hkpms000077500000000000000000000255621221326450300162410ustar00rootroot00000000000000#!/usr/bin/perl -w # hkpms transport -- HKP-over-TLS, authenticated by monkeysphere use strict; use warnings; # Author: Daniel Kahn Gillmor # Copyright: 2010 # License: GPL v3+ # (you should have received a COPYING file with this distribution) { package Crypt::Monkeysphere::MSVA::HKPMS; use POSIX; use Crypt::Monkeysphere::Logger; use Crypt::Monkeysphere::MSVA::Client; use Regexp::Common qw /net/; use Module::Load::Conditional; sub parse_input { my $self = shift; my $input = shift; my $inheaders = 1; foreach my $line (split(/\n/, $input)) { if ($inheaders) { if ($line eq '') { $inheaders = 0; } else { next if ($line =~ /^#/); my @args = split(/ /, $line); my $cmd = shift @args; $self->{config}->{lc($cmd)} = join(' ', @args); if (lc($cmd) eq 'option') { my $opt = lc($args[0]); if ($opt eq 'debug') { $self->{logger}->set_log_level('debug'); } elsif ($opt eq 'verbose') { $self->{logger}->more_verbose(); } elsif ($opt eq 'no-check-cert') { $self->{logger}->log('error', "Received no-check-cert option. Why are you bothering with hkpms if you aren't checking?\n"); $self->{actually_check} = 0; } elsif ($opt eq 'check-cert') { $self->{actually_check} = 1; } elsif ($opt =~ /^http-proxy=(.*)/) { my $hp = $1; if ($hp =~ /^(socks|http|https):\/\/($RE{net}{domain}|$RE{net}{IPv4}):([[:digit:]]+)\/?$/) { if ('socks' eq $1) { if ( ! Module::Load::Conditional::check_install(module => 'LWP::Protocol::socks')) { $self->{logger}->log('error', "Requesting a socks proxy for hkpms, but LWP::Protocol::socks is not installed.\nThis will likely fail.\n"); } } $self->{proxy} = sprintf('%s://%s:%s', $1, $2, $3); } else { $self->{logger}->log('error', "Failed to make sense of this http-proxy address: '%s'; ignoring.\n", $hp); } } else { $self->{logger}->log('error', "Received '%s' as an option, but gpgkeys_hkpms does not implement it. Ignoring...\n", $opt); } # FIXME: consider other keyserver-options from gpg(1). # in particular, the following might be interesting: # timeout # include-revoked # include-disabled # ca-cert-file } } } else { push(@{$self->{args}}, $line); } } } sub verify_cert { my $self = shift; my ($ok, $ctxstore, $certname, $error, $cert) = @_; my $certpem = Net::SSLeay::PEM_get_string_X509($cert); my ($status, $ret); if (exists $self->{cache}->{$certpem}) { ($status, $ret) = @{$self->{cache}->{$certpem}}; $self->{logger}->log('debug', "Found response in cache\n"); } else { # use Crypt::Monkeysphere::MSVA::Client if available: if (defined($self->{client})) { # because we really don't want to create some sort of MSVA loop: ($status, $ret) = $self->{client}->query_agent('https', $self->{config}->{host}, 'server', 'x509pem', $certpem, 'never'); } else { use Crypt::Monkeysphere::MSVA; $self->{logger}->log('verbose', "Could not find a running agent (MONKEYSPHERE_VALIDATION_AGENT_SOCKET env var).\nFalling back to in-process certificate checks.\n"); # If there is no running agent, we might want to be able to fall # back here. # FIXME: this is hackery! we're just calling daemon-internal code # (and it's not a stable API): my $data = {peer => { name => $self->{config}->{host}, type => 'server' }, context => 'https', pkc => { type => 'x509pem', data => $certpem }, keyserverpolicy => 'never', # because we really don't want to create some sort of MSVA loop }; my $clientinfo = { uid => POSIX::geteuid(), inode => undef }; ($status, $ret) = Crypt::Monkeysphere::MSVA::reviewcert($data, $clientinfo); } # make a cache of the cert if it verifies once, since this seems # to get called 3 times by perl for some reason. (see # https://bugs.debian.org/606249) $self->{cache}->{$certpem} = [ $status, $ret ]; if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) { $self->{logger}->log('verbose', "Monkeysphere HKPMS Certificate validation succeeded:\n %s\n", $ret->{message}); } else { my $m = '[undefined]'; $m = $ret->{message} if (defined($ret->{message})); $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n %s\n", $m); } } if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) { return 1; } else { return 0; } } sub query { my $self = shift; # FIXME: i'd like to pass this debug argument to IO::Socket::SSL, # but i don't know how to do that. # i get 'Variable "@iosslargs" will not stay shared' if i try to call # use IO::Socket::SSL 1.37 @iosslargs; my @iosslargs = (); if ($self->{logger}->get_log_level() >= 4) { push @iosslargs, sprintf("debug%d", int($self->{logger}->get_log_level() - 3)); } # versions earlier than 1.35 can fail open: bad news!. # 1.37 lets us set ca_path and ca_file to undef, which is what we want. use IO::Socket::SSL 1.37; use Net::SSLeay; use LWP::UserAgent; use URI; IO::Socket::SSL::set_ctx_defaults( verify_callback => sub { $self->verify_cert(@_); }, verify_mode => 0x03, ca_path => undef, ca_file => undef, ); my $ua = LWP::UserAgent::->new(); if (exists($self->{proxy})) { $self->{logger}->log('verbose', "Using http-proxy: %s\n", $self->{proxy}); $ua->proxy([qw(http https)] => $self->{proxy}); } else { # if no proxy was explicitly set, use the environment: $ua->env_proxy(); } printf("VERSION 1\nPROGRAM %s gpgkeys_hkpms msva-perl/%s\n", $self->{config}->{program}, # this is kind of cheating :/ $Crypt::Monkeysphere::MSVA::VERSION); $self->{logger}->log('debug', "command: %s\n", $self->{config}->{command}); if (lc($self->{config}->{command}) eq 'search') { # for COMMAND = SEARCH, we want op=index, and we want to rejoin all args with spaces. my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host})); my $arg = join(' ', @{$self->{args}}); $uri->query_form(op => 'index', options => 'mr', search => $arg, ); $arg =~ s/\n/ /g ; # swap out newlines for spaces printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg); $self->{logger}->log('debug', "URI: %s\n", $uri); my $resp = $ua->get($uri); if ($resp->is_success) { print($resp->decoded_content); } else { # FIXME: handle errors better $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line); } printf("\n%s %s END\n", $self->{config}->{command}, $arg); } elsif (lc($self->{config}->{command}) eq 'get') { # for COMMAND = GET, we want op=get, and we want to issue each query separately. my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host})); foreach my $arg (@{$self->{args}}) { printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg); $uri->query_form(op => 'get', options => 'mr', search => $arg, ); my $resp = $ua->get($uri); if ($resp->is_success) { print($resp->decoded_content); } else { # FIXME: handle errors better $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line); } printf("\n%s %s END\n", $self->{config}->{command}, $arg); } } elsif (lc($self->{config}->{command}) eq 'send') { $self->{logger}->log('debug', "Sending keys"); # walk the input looking for "KEY E403BC1A17856FB7 BEGIN" lines. my @keydata; my $keyid; foreach my $arg (@{$self->{args}}) { if ($arg =~ /^KEY ([a-fA-F0-9]+) BEGIN\s*$/) { @keydata = (); $keyid = $1; $self->{logger}->log('debug', "Found KEY BEGIN line (%s)\n", $keyid); } elsif (defined($keyid)) { if ($arg eq sprintf('KEY %s END', $keyid)) { $self->{logger}->log('debug', "Found KEY END line with %d lines of data elapsed\n", scalar(@keydata)); # for sending keys, we want to POST to /pks/add, with a keytext variable. my $uri = URI::->new(sprintf('https://%s/pks/add', $self->{config}->{host})); my $resp = $ua->post($uri, {keytext => join("\n", @keydata)}); if ($resp->is_success) { printf("\n%s", $resp->decoded_content); } else { # FIXME: handle errors better $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line); } printf("\nKEY %s SENT\n", $keyid); @keydata = (); $keyid = undef; } else { push @keydata, $arg; } } else { $self->{logger}->log('debug2', "Found garbage line\n"); } } if (defined($keyid)) { $self->{logger}->log('error', "Never got a 'KEY %s END' line, discarding.\n", $keyid); } } else { # are there other commands we might want? $self->{logger}->log('error', "Unknown command %s\n", $self->{config}->{command}); } } sub new { my $class = shift; my $default_log_level = 'error'; my $client; if (exists($ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET})) { $client = Crypt::Monkeysphere::MSVA::Client::->new( socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET}, log_level => $default_log_level, ); } my $self = { config => { }, args => [ ], logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::Logger::->new($default_log_level)), cache => { }, client => $client, actually_check => 1, }; bless ($self, $class); return $self; } 1; } my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS::->new(); my $input = # load gpg instructions from stdin: do { local $/; # slurp! ; }; $hkpms->parse_input($input); $hkpms->query(); msva-perl-0.9.2/monkeysphere-icon.png000066400000000000000000000016511221326450300175760ustar00rootroot00000000000000PNG  IHDRasRGBcIDAT8e]L[uϽ{{o/0XF'Y0ٌ٘YXD]}јhH|ڃ/>BxYb g\DAQVK)m{oO$prrawO#Z=$\= "WUn=[[_(dG9z X,mFجVQ?A,CF_aYdXHJ$rvV(r\l:;>wqsqH X-, ii E RfʕCréNj.'O^3DèuTxA[{ƣհE>eeE3[MOLj0$>5 (XJQLpBE(>w> Q8Fd O=ƙ^7jwW$Lŝt -n'6Qp8S r *QA_cA=x8Pa ӟD ]}=9sCE:WS"9Bvpzć6?g Ib|1Zi [6$"^q2+Hj  _k#%: ~% y GCc,^eķːe|_G 4½+4D޾| ؝E0'I! # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . use warnings; use strict; use Crypt::Monkeysphere::MSVA; my $server = Crypt::Monkeysphere::MSVA->new(); $server->run(host=>'127.0.0.1', log_level=> $server->logger->get_log_level(), user => POSIX::geteuid(), # explicitly choose regular user and group (avoids spew) group => POSIX::getegid(), msva=>$server); __END__ =encoding utf8 =head1 NAME msva-perl - Perl implementation of a Monkeysphere Validation Agent =head1 SYNOPSIS msva-perl [ COMMAND [ ARGS ... ] ] =head1 ABSTRACT msva-perl provides a Perl implementation of the Monkeysphere Validation Agent, a certificate validation service. =head1 INTRODUCTION The Monkeysphere Validation Agent offers a local service for tools to validate certificates (both X.509 and OpenPGP) and other public keys. Clients of the validation agent query it with a public key carrier (a raw public key, or some flavor of certificate), the supposed name of the remote peer offering the pubkey, and the context in which the validation check is relevant (e.g. ssh, https, etc). The validation agent then tells the client whether it was able to successfully validate the peer's use of the public key in the given context. =head1 USAGE Launched with no arguments, msva-perl simply runs and listens forever. Launched with arguments, it sets up a listener, spawns a subprocess using the supplied command and arguments, but with the MONKEYSPHERE_VALIDATION_AGENT_SOCKET environment variable set to refer to its listener. When the subprocess terminates, msva-perl tears down the listener and exits as well, returning the same value as the subprocess. This is a similar invocation pattern to that of ssh-agent(1). =head1 ENVIRONMENT VARIABLES msva-perl is configured by means of environment variables. =over 4 =item MSVA_LOG_LEVEL msva-perl logs messages about its operation to stderr. MSVA_LOG_LEVEL controls its verbosity, and should be one of (in increasing verbosity): silent, quiet, fatal, error, info, verbose, debug, debug1, debug2, debug3. Default is 'error'. =item MSVA_ALLOWED_USERS If your system is capable of it, msva-perl tries to figure out the owner of the connecting client. If MSVA_ALLOWED_USERS is unset, msva-perl will only permit connections from the user msva is running as. If you set MSVA_ALLOWED_USERS, msva-perl will treat it as a list of local users (by name or user ID) who are allowed to connect. =item MSVA_PORT msva-perl listens on a local TCP socket to facilitate access. You can choose what port to bind to by setting MSVA_PORT. Default is to bind on an arbitrary open port. =item MSVA_KEYSERVER msva-perl will request information from OpenPGP keyservers. Set MSVA_KEYSERVER to declare the keyserver you want it to check with. If this variable is blank or unset, and your gpg.conf contains a keyserver declaration, it will use the GnuPG configuration. Failing that, the default is 'hkp://pool.sks-keyservers.net'. =item MSVA_KEYSERVER_POLICY msva-perl must decide when to check with keyservers (for new keys, revocation certificates, new certifications, etc). There are three possible options: 'always' means to check with the keyserver on every query it receives. 'never' means to never check with a keyserver. 'unlessvalid' will only check with the keyserver on a specific query if no keys are already locally known to be valid for the requested peer. Default is 'unlessvalid'. =item MSVA_MONITOR_CHANGES Under graphical environments such as X11, msva-perl is capable of monitoring for changes in its underlying code and can prompt the user to restart the daemon when some of the underlying code changes. Setting this environmnt variable to 'true' enables this monitoring and prompting behavior. Default is 'false'. =back =head1 COMMUNICATION PROTOCOL DETAILS Communications with the Monkeysphere Validation Agent are in the form of JSON requests over plain HTTP. Responses from the agent are also JSON objects. For details on the structure of the requests and responses, please see http://web.monkeysphere.info/validation-agent/protocol =head1 SECURITY CONSIDERATIONS msva-perl deliberately binds to the IPv4 loopback (on 127.0.0.1) so that remote users do not get access to the daemon. On systems (like Linux) which report ownership of TCP sockets in /proc/net/tcp, msva-perl will refuse access from random users (see MSVA_ALLOWED_USERS above). =head1 SEE ALSO monkeysphere(1), monkeysphere(7), ssh-agent(1) =head1 BUGS AND FEEDBACK Bugs or feature requests for msva-perl should be filed with the Monkeysphere project's bug tracker at https://labs.riseup.net/code/projects/monkeysphere/issues/ =head1 AUTHORS AND CONTRIBUTORS Daniel Kahn Gillmor Edkg@fifthhorseman.net The Monkeysphere Team http://web.monkeysphere.info/ =head1 COPYRIGHT AND LICENSE Copyright © Daniel Kahn Gillmor and others from the Monkeysphere team. msva-perl is free software, distributed under the GNU Public License, version 3 or later. msva-perl-0.9.2/msva-query-agent000077500000000000000000000133061221326450300165640ustar00rootroot00000000000000#!/usr/bin/perl -wT # Monkeysphere Validation Agent Client, Perl version # Copyright © 2010 Jameson Greaf Rollins # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . use warnings; use strict; use Crypt::Monkeysphere::MSVA::Client; sub usage { my $name = shift; printf STDERR ("Usage: %s CONTEXT PEER PKC_TYPE [PEER_TYPE] < PKC_DATA %s CONTEXT PEER PKC_TYPE PEER_TYPE PKC_DATA %s --version ", $name, $name, $name); } my $context = shift; if ((!defined($context)) || $context eq '--help') { usage($0); exit (defined($context) ? 0 : 1); } elsif ($context eq '--version') { my $client = Crypt::Monkeysphere::MSVA::Client->new( socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET}, log_level => $ENV{MSVA_LOG_LEVEL}, ); my ($status,$ret) = $client->agent_info(); $client->log('verbose', "status: %s\n", $status); if (defined $ret) { printf("%s\n", $ret->{server}); exit 0; } exit 1; } my $peer = shift; my $pkctype = shift; my $peertype = shift; my $pkcdata = shift; if (!defined $pkcdata) { # load raw pkc data from stdin $pkcdata = do { local $/; # slurp! ; }; } my $client = Crypt::Monkeysphere::MSVA::Client->new( socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET}, log_level => $ENV{MSVA_LOG_LEVEL}, ); my ($status,$ret) = $client->query_agent($context,$peer,$peertype,$pkctype,$pkcdata); $client->log('verbose', "status: %s\n", $status); if (defined $ret) { $client->log('info', "valid: %s\n", $ret->{valid}); $client->log('info', "server: %s\n", $ret->{server}); printf("%s", $ret->{message}); if ($ret->{valid}) { exit 0 } else { exit 1; } } else { printf("%s\n", $status); exit 100; } __END__ =encoding utf8 =head1 NAME msva-query-agent - query a Monkeysphere Validation Agent =head1 SYNOPSIS msva-query-agent CONTEXT PEER PKC_TYPE [PEER_TYPE] < /path/to/public_key_carrier msva-query-agent CONTEXT PEER PKC_TYPE PEER_TYPE PKC_DATA msva-query-agent --version =head1 ABSTRACT msva-query-agent validates certificates for a given use by querying a running Monkeysphere Validation Agent. =head1 USAGE msva-query-agent reads a certificate from standard input, and posts it to the running Monkeysphere Validation Agent. The return code indicates the validity (as determined by the agent) of the certificate for the specified purpose. The agent's return message (if any) is emitted on stdout. The various arguments are: =over 4 =item CONTEXT Context in which the certificate is being validated (e.g. 'https', 'ssh', 'ike') =item PEER The name of the intended peer. When validating a certificate for a service, supply the host's full DNS name (e.g. 'foo.example.net') =item PKC_TYPE The format of public key carrier data provided on standard input (e.g. 'x509der', 'x509pem', 'opensshpubkey', 'rfc4716', 'openpgp4fpr') =item PEER_TYPE The type of peer we are inquiring about (e.g. 'client', 'server', 'peer'). This argument is optional and defaults will be used (based on CONTEXT) if it is not supplied. =item PKC_DATA This is the actual public key carrier data itself. If less than five arguments are given, then the PKC_DATA is expected on stdin. If five arguments are given, the fifth argument is interpreted as the PKC_DATA. This is likely only useful for supplying an OpenPGP fingerprint with the 'openpgp4fpr' type. =back =head1 RETURN CODE If the certificate is valid for the requested peer in the given context, the return code is 0. Otherwise, the return code is 1. =head1 ENVIRONMENT VARIABLES msva-query-agent's behavior is controlled by environment variables: =over 4 =item MONKEYSPHERE_VALIDATION_AGENT_SOCKET Socket over which to query the validation agent. If unset, the default value is 'http://127.0.0.1:8901'. =item MSVA_LOG_LEVEL Log messages about its operation to stderr. MSVA_LOG_LEVEL controls its verbosity, and should be one of (in increasing verbosity): silent, quiet, fatal, error, info, verbose, debug, debug1, debug2, debug3. Default is 'error'. =back =head1 COMMUNICATION PROTOCOL DETAILS Communications with the Monkeysphere Validation Agent are in the form of JSON requests over plain HTTP. Responses from the agent are also JSON objects. For details on the structure of the requests and responses, please see http://web.monkeysphere.info/validation-agent/protocol =head1 SEE ALSO msva-perl(1), monkeysphere(1), monkeysphere(7) =head1 BUGS AND FEEDBACK Bugs or feature requests for msva-perl and associated tools should be filed with the Monkeysphere project's bug tracker at https://labs.riseup.net/code/projects/monkeysphere/issues/ =head1 AUTHORS AND CONTRIBUTORS Jameson Graef Rollins Ejrollins@finestructure.net Daniel Kahn Gillmor Edkg@fifthhorseman.net The Monkeysphere Team http://web.monkeysphere.info/ =head1 COPYRIGHT AND LICENSE Copyright © 2010, Jameson Graef Rollins and others from the Monkeysphere team. msva-query-agent is free software, distributed under the GNU Public License, version 3 or later. msva-perl-0.9.2/msva.protocol.README000066400000000000000000000032671221326450300171230ustar00rootroot000000000000002010-01-05 18:21:59-0500 ------------------------ msva is the Monkeysphere Validation Agent. Its goal is to simplify bindings between cryptographic tokens and the real-world entities that humans actually care about. In its current form, the validation agent is conceived of as a minimalistic HTTP server that accepts two different requests: GET / -- initial contact query, protocol version compatibility. (no query parameters) (returns: protoversion, server, available) POST /reviewcert -- request validation of a certificate (required query parameters: uid, context, pkc) (optional query parameters: keyserverpolicy) (returns: valid, message) Query parameters are posted as a JSON blob (*not* as www-form-encoded). The variables that are returned are application/json as well. (PKC means: public key carrier: raw key, OpenPGP cert, or X.509 cert) (UID means: User ID (similar to OpenPGP)) (context means: (this is too vague right now) something like "this certificate was used to try to identify an HTTPS server") (keyserverpolicy is optional; it states an advisory preference for how/whether the agent should contact the keyserver network for information about the key. The options are `always`, `never`, and `unlessvalid` (see the `msva-perl(1)` man page section about the `KEYSERVER_POLICY` environment variable for more details). Be aware that the agent may disregard, override, or simply not implement this preference.) Full details on the Monkeysphere Validation Agent protocol should be available at http://web.monkeysphere.info/validation-agent/protocol Authors: Daniel Kahn Gillmor Matthew James Goins Jameson Rollins msva-perl-0.9.2/openpgp2x509000077500000000000000000000430321221326450300155360ustar00rootroot00000000000000#!/usr/bin/perl # Author: Daniel Kahn Gillmor # Copyright: 2011, 2013 # License: GPL-3+ # Usage (two examples): # openpgp2x509 'Daniel Kahn Gillmor ' # openpgp2x509 ssh://lair.fifthhorseman.net # Each invocation will produce a series of PEM-encoded X.509 # certificates on stdout corresponding to keys that are well-bound to # the specified OpenPGP User ID. # This tool should detect (based on the form of the User ID) what kind # of X.509 certificate to produce # It only emits certificates for OpenPGP keys that are marked with the # "Authentication" usage flag. FIXME: make the usage flag selection # adjustable by an environment variable or something. # WARNING: This is very rough code! the interface WILL change # dramatically. The only thing I can commit to keeping stable are the # OIDs. use strict; use warnings; use Crypt::X509 0.50; use Math::BigInt; use GnuPG::Interface 0.43; use Regexp::Common qw /net/; use MIME::Base64; my $cert = Crypt::X509::_init('Certificate'); $cert->configure('encode' => { 'time' => 'raw' } ); my $pgpe = Crypt::X509::_init('PGPExtension'); $pgpe->configure('encode' => { 'time' => 'raw' } ); my $san = Crypt::X509::_init('SubjectAltName'); $san->configure('encode' => { 'time' => 'raw' } ); my $rsapubkeyinfo = Crypt::X509::_init('RSAPubKeyInfo'); my $dntypes = { 'CN' => '2.5.4.3', # common name 'emailAddress' => '1.2.840.113549.1.9.1', # e-mail address -- DEPRECATED. should use subjectAltName instead. 'C' => '2.5.4.6', # country 'ST' => '2.5.4.8', # state 'L' => '2.5.4.7', # locality 'O' => '2.5.4.10', # organization 'OU' => '2.5.4.11', # organization unit (often used as a comment) 'PSEUDO' => '2.5.4.65', # pseudonym (used for the parenthetical "comment" in the conventional OpenPGP User ID) }; my $algos = { 'RSA' => '1.2.840.113549.1.1.1', 'RSAwithMD2' => '1.2.840.113549.1.1.2', 'RSAwithMD4' => '1.2.840.113549.1.1.3', 'RSAwithMD5' => '1.2.840.113549.1.1.4', 'RSAwithSHA1' => '1.2.840.113549.1.1.5', 'OAEP' => '1.2.840.113549.1.1.6', 'RSAwithSHA256' => '1.2.840.113549.1.1.11', 'RSAwithSHA384' => '1.2.840.113549.1.1.12', 'RSAwithSHA512' => '1.2.840.113549.1.1.13', 'RSAwithSHA224' => '1.2.840.113549.1.1.14', 'NullSignatureUseOpenPGP' => '1.3.6.1.4.1.37210.1.1', 'OpenPGPCertificateEmbedded' => '1.3.6.1.4.1.37210.1.2', }; # NullSignatureUseOpenPGP: this X509 certificate is not # self-verifiable. It must be verified by fetching certificate # material from OpenPGP keyservers or from the user's private OpenPGP # keyring. # The identity material and usage in the OpenPGP keyservers SHOULD be # tested against the context in which the certificate is being used. # If no context information is explicitly available to the # implementation checking the certificate's validity, the # implementation MUST assume that the context is the full set of # possible contexts asserted by the X.509 material itself (is this # doable?) # 0) certificate validity ambiguity -- X.509 certificates are # generally considered to be entirely valid or entirely invalid. # OpenPGP certificates can have some User IDs that are valid, and # others that are not. If an implementation is asked to return a # simple boolean response to a validity inquiry, without knowing # the context in which the certificate was proposed for use, it # MUST validate the full conjunction of all assertions made in the # X.509 certificate itself in order to return "true". # OpenPGPCertificateEmbedded: the "signature" material in the X.509 # certificate is actually a set of OpenPGP packets corresponding to a # complete "transferable public key" as specified in # https://tools.ietf.org/html/rfc4880#section-11.1 , in "raw" # (non-ascii-armored) form. # If it were implemented, it would be the same as # NullSignatureUseOpenPGP, but with the OpenPGP material transported # in-band in addition. ## NOTE: There is no implementation of the OpenPGPCertificateEmbedded, ## and maybe there never will be. Another approach would be to ## transmitting OpenPGP signature packets in the TLS channel itself, ## with an extension comparable to OCSP stapling. # the OpenPGPCertificateEmbedded concept has a few downsides: # 1) data duplication -- the X.509 Subject Public Key material is # repeated (either in the primary key packet, or in one of the # subkey packets). The X.509 Subject material (and any # subjectAltNames) are also duplicated in the User ID packets. # This increases the size of the certificate. It also creates # potential inconsistencies. If the X.509 Subject Public Key # material is not found found in the OpenPGP Transferable Public # Key (either as a primary key or as a subkey), conforming # implementations MUST reject the certificate. # 2) the requirement for out-of-band verification is not entirely # removed, since conformant implementations may want to check the # public keyservers for things like revocation certificates. # this is a 5 followed by a 0. it fits into the "Parameters" section # of an ASN.1 algorithmIdentifier object. what does this mean? # I think it means the NULL type. my $noparams = sprintf('%c%c', 5, 0); my $extensions = { 'PGPExtension' => '1.3.6.1.4.1.3401.8.1.1', 'subjectAltName' => '2.5.29.17', # https://tools.ietf.org/html/rfc5280#section-4.2.1.6 }; my $gnupg = GnuPG::Interface::->new(); $gnupg->options->quiet(1); $gnupg->options->batch(1); sub err { printf STDERR @_; } sub ts2Time { my $ts = shift; if (!defined($ts)) { # see https://tools.ietf.org/html/rfc5280#section-4.1.2.5 return {'generalTime' => '99991231235959Z' }; } else { my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($ts); $year += 1900; if (($year < 1950) || ($year >= 2050)) { return {'generalTime' => sprintf('%04d%02d%02d%02d%02d%02dZ', $year, $mon+1, $mday, $hour, $min, $sec) }; } else { return {'utcTime' => sprintf('%02d%02d%02d%02d%02d%02dZ', ($year%100), $mon+1, $mday, $hour, $min, $sec) }; } } } sub ts2ISO8601 { my $ts = shift; $ts = time() if (!defined($ts)); my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($ts); $year += 1900; return sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ', $year, $mon+1, $mday, $hour, $min, $sec); }; sub makeX509CertForUserID { my $userid = shift; my $hostname; my $protocol; my $emailaddress; my $humanname; my $comment; my $subject; my $ret = []; my @subjectAltNames; if ($userid =~ /^\s+/) { err("We will not process User IDs with leading whitespace\n"); return $ret; } if ($userid =~ /\s+$/) { err("We will not process User IDs with trailing whitespace\n"); return $ret; } if ($userid =~ /\n/) { err("We will not process User IDs containing newlines\n"); return $ret; } # FIXME: do we want to rule out any other forms of User ID? if ($userid =~ /^([^()]*)\s+(\((.*)\)\s+)?<([^><@\s]+\@$RE{net}{domain})>$/ ) { # this is a typical/expected OpenPGP User ID. $humanname = $1; $comment = $3; $emailaddress = $4; # We're stripping arbitrary amounts of whitespace between the # name, the comment, and the e-mail address here. if that # whitespace is anything but " " then the OpenPGP User ID will not # be reconstructible from the string. my $reconstructeduid; if (defined($comment)) { $reconstructeduid = sprintf('%s (%s) <%s>', $humanname, $comment, $emailaddress); } else { $reconstructeduid = sprintf('%s <%s>', $humanname, $emailaddress); } if ($userid ne $reconstructeduid) { err("This OpenPGP User ID could not be reconstructed from the X.509 certificate we would generate. Maybe a whitespace issue?\n"); return $ret; } $subject = [ [ { 'type' => $dntypes->{'CN'}, 'value' => { 'utf8String' => $humanname, }, } ], ]; push(@{ $subject }, [ { 'type' => $dntypes->{'PSEUDO'}, 'value' => { 'utf8String' => $comment } } ] ) if defined($comment); push(@subjectAltNames, { 'rfc822Name' => $emailaddress }); } elsif ($userid =~ /^(https|ssh|smtps?|ike|postgresql|imaps?|submission):\/\/($RE{net}{domain})$/) { $protocol = $1; $hostname = $2; $subject = [ [ { 'type' => $dntypes->{'CN'}, 'value' => { 'printableString' => $hostname }, } ] ]; push(@subjectAltNames, { 'dNSName' => $hostname }); } else { # Maybe we just assume this is a bare Human Name? # what if it's a human name plus a comment? should we treat the # comment like a pseudonym, as above? err("Assuming '%s' is a bare human name.\n", $userid); $humanname = $userid; $subject = [ [ { 'type' => $dntypes->{'CN'}, 'value' => { 'printableString' => $humanname, }, } ], ]; } foreach my $gpgkey ($gnupg->get_public_keys('='.$userid)) { my $validity = '-'; my @sans; foreach my $tryuid ($gpgkey->user_ids) { if ($tryuid->as_string eq $userid) { $validity = $tryuid->validity; } if (defined($protocol) && ($tryuid->validity =~ /^[fu]$/) && ($tryuid =~ /^$protocol\:\/\/($RE{net}{domain})/ )) { push(@sans, $2); } } if ($validity !~ /^[fu]$/) { err("key 0x%s only has validity %s for User ID '%s' (needs full or ultimate validity)\n", $gpgkey->fingerprint->as_hex_string, $validity, $userid); next; } # treat primary keys just like subkeys: foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) { if ($subkey->{algo_num} != 1) { err("key 0x%s is algorithm %d (not RSA) -- we currently only handle RSA\n", $subkey->fingerprint->as_hex_string, $subkey->algo_num); next; } # FIXME: reject/skip over revoked keys. if (defined($subkey->{expiration_date}) && $subkey->{expiration_date} <= time()) { err("key 0x%s is expired -- skipping\n", $subkey->fingerprint->as_hex_string); next; } if ($subkey->{usage_flags} =~ /D/) { err("key 0x%s is disabled -- skipping\n", $subkey->fingerprint->as_hex_string); next; } if ($subkey->{usage_flags} !~ /a/) { err("key 0x%s is not authentication-capable -- skipping\n", $subkey->fingerprint->as_hex_string); next } err("making certificate for key 0x%s\n", $subkey->fingerprint->as_hex_string); my $pubkey = { 'modulus' => @{$subkey->pubkey_data}[0], 'exponent' => @{$subkey->pubkey_data}[1], }; my $vnotbefore = $subkey->creation_date; my $vnotafter = $subkey->expiration_date; # expiration date should be the minimum of the primary key and the subkey: if (!defined($vnotafter)) { $vnotafter = $gpgkey->expiration_date; } elsif (defined($gpgkey->expiration_date)) { $vnotafter = $gpgkey->expiration_date if ($gpgkey->expiration_date < $vnotafter); } my $cnotbefore = ts2Time($vnotbefore); my $cnotafter = ts2Time($vnotafter); my $pgpeval = $pgpe->encode({ 'version' => 0, 'keyCreation' => $cnotbefore }); print $pgpe->{error} if (!defined($pgpeval)); my $pubkeybitstring = $rsapubkeyinfo->encode($pubkey); print $rsapubkeyinfo->{error} if (!defined($pubkeybitstring)); my @extensions; push(@extensions, { 'extnID' => $extensions->{'PGPExtension'}, 'extnValue' => $pgpeval }); if (@subjectAltNames) { my $saneval = $san->encode(\@subjectAltNames); print $san->{error} if (!defined($saneval)); push(@extensions, { 'extnID' => $extensions->{'subjectAltName'}, 'extnValue' => $saneval }); } # FIXME: base some keyUsage extensions on the type of User ID # and on the usage flags of the key in question. # if 'a' is present # if protocol =~ /^https|smtps?|postgresql|imaps?|submission$/ then set TLS server eKU + ??? # if protocol eq 'ike' then ??? (ask micah) # if protocol =~ /^smtps?$/ then set TLS client + ??? # if defined($humanname) then set TLS client + ??? # if 'e' is present: # ??? # if 's' is present: # ??? # if 'c' is present: I think we should never specify CA:TRUE or # CA:FALSE in these certificates, since (a) we do not expect # these keys to actually be making X.509-style certifications, # but (b) we also don't want to assert that they can't make # any certifications whatsoever. # FIXME: add subjectAltName that matches the type of information # we believe we're working with (see the cert-id draft). # if @sans is present, should we add them as subjectAltNames? i # don't think so. this certificate should be just for the User # ID requested. The user can always make another certificate # for the other user IDs and use that one. my $newcert = { 'tbsCertificate' => { 'version' => 2, # 0 == version 1, 1 == version 2, 2 == version 3 # this is a convenient way to pass the fpr too. 'serialNumber' => Math::BigInt->new('0x'.$subkey->fingerprint->as_hex_string), 'subjectPublicKeyInfo' => { 'algorithm' => { 'parameters' => $noparams, 'algorithm' => $algos->{'RSA'}, }, 'subjectPublicKey' => $pubkeybitstring, }, 'validity' => { 'notAfter' => $cnotafter, 'notBefore' => $cnotbefore, }, 'signature' => { # maybe we should make up our own "signature algorithm" here? 'parameters' => $noparams, 'algorithm' => $algos->{'NullSignatureUseOpenPGP'} }, 'subject' => { 'rdnSequence' => $subject, }, 'issuer' => { 'rdnSequence' => [ [ { 'type' => $dntypes->{'OU'}, 'value' => { 'printableString' => sprintf('Please check the OpenPGP keyservers for certification information. (certificate generated on %s)', ts2ISO8601(time())) }, } ] ], }, 'extensions' => \@extensions, }, 'signature' => 'use OpenPGP', 'signatureAlgorithm' => { 'parameters' => $noparams, 'algorithm' => $algos->{'NullSignatureUseOpenPGP'} } }; my $dd = $cert->encode($newcert); push(@{$ret}, { 'der' => $dd, 'fpr' => $subkey->fingerprint->as_hex_string}); } } return $ret; } foreach $cert ( @{ makeX509CertForUserID($ARGV[0]) } ) { if (defined($ENV{OPENPGP2X509_EMIT_PKCS12})) { # FIXME: figure out how to do this with certtool instead of openssl; # the PKCS12 files i've tried to generate from certtool --to-p12 # can't be loaded by iceweasel for some reason. # FIXME: don't do this horrific shell nastiness. be nicer! $ENV{CERTOUTPUT} = sprintf("-----BEGIN CERTIFICATE-----\n%s-----END CERTIFICATE-----\n", encode_base64($cert->{'der'})); $ENV{FPR} = $cert->{'fpr'}; $ENV{OPENPGP_UID} = $ARGV[0]; # Note that while pkcs12(1ssl) claims that the order doesn't # matter, in fact, this doesn't work if you emit the certificate # before you emit the key. system('(gpg --export-options export-reset-subkey-passwd --export-secret-subkeys "0x$FPR"\! |'. 'openpgp2ssh "$FPR" && printf "%s" "$CERTOUTPUT") |'. 'openssl pkcs12 -export -name "$OPENPGP_UID"'); } else { printf("-----BEGIN CERTIFICATE-----\n%s-----END CERTIFICATE-----\n", encode_base64($cert->{'der'})); } } msva-perl-0.9.2/test-msva000077500000000000000000000007721221326450300153050ustar00rootroot00000000000000#!/bin/sh # this script exists so that you can launch the msva perl scripts # directly from your development environment without having to install # anything. # it appears to be necessary because of some weirdness in how # HTTP::Server::Simple interacts with Net::Server -- otherwise, i # wouldn't need to shuffle all these files around. # Author: Daniel Kahn Gillmor # Date: 2010-03-11 14:53:07-0500 dir=$(dirname "$0") cmd="$1" shift exec perl -wT -I"$dir" "$dir"/"$cmd" "$@" msva-perl-0.9.2/tests/000077500000000000000000000000001221326450300145705ustar00rootroot00000000000000msva-perl-0.9.2/tests/basic000077500000000000000000000144561221326450300156110ustar00rootroot00000000000000#!/bin/bash # simple set of tests to exercise the msva. # these tests currently depend on the user having the following tools # installed locally: # monkeysphere (for pem2openpgp) # openssl (for openssl req) # openssh-client (for ssh-keygen) # gpg (for obvious reasons) # bash (yes, this test script isn't posix-compliant) # note that this test requires the ability to bind on the loopback # interface, which might not be possible in some build environments. # Author: Daniel Kahn Gillmor # Copyright: 2010 # License: This is licensed under the GPL v3 or later # (see the top-level COPYING file in this distribution) set -e srcdir=$(dirname $0)/.. REPS=5 CERTTYPES="x509pem x509der opensshpubkey rfc4716 openpgp4fpr" printf "testing %d reps of simple/quick true/false:\n" "$REPS" for n in $(seq 1 "$REPS") ; do "${srcdir}"/test-msva msva-perl true printf "+" ! "${srcdir}"/test-msva msva-perl false printf "-" done printf "\ndone\n" WORKDIR=$(mktemp -d) mkdir -m 0700 "${WORKDIR}/"{pkc,sec,gnupg} touch "${WORKDIR}/gnupg/gpg.conf" export GNUPGHOME="${WORKDIR}/gnupg" if gpg --quick-random --version ; then GPGQR=--quick-random elif gpg --debug-quick-random --version ; then GPGQR=--debug-quick-random else GPGQR= fi # make a CA printf "Key-Type: RSA\nKey-Length: 1024\nKey-Usage: sign\nName-Real: MSVA Test Certificate Authority (DO NOT USE!)\n" | gpg --batch --no-tty $GPGQR --gen-key # make 3 websites (X, Y, and Z) with self-signed certs: for name in x y z ; do openssl req -x509 -subj "/CN=${name}.example.net/" -nodes -sha256 -newkey rsa:1024 -keyout "${WORKDIR}/sec/${name}.key" -outform DER -out "${WORKDIR}/pkc/${name}.x509der" chmod 0400 "${WORKDIR}/sec/${name}.key" openssl x509 -inform DER -outform PEM < "${WORKDIR}/pkc/${name}.x509der" > "${WORKDIR}/pkc/${name}.x509pem" ssh-keygen -y -P '' -f "${WORKDIR}/sec/${name}.key" > "${WORKDIR}/pkc/${name}.opensshpubkey" ssh-keygen -e -P '' -f "${WORKDIR}/sec/${name}.key" > "${WORKDIR}/pkc/${name}.rfc4716" done # make 2 client certs (A and B) with self-signed certs for name in a b ; do openssl req -x509 -subj "/eMail=${name}@example.net/CN=${name}/" -nodes -sha256 -newkey rsa:1024 -keyout "${WORKDIR}/sec/${name}.key" -outform DER -out "${WORKDIR}/pkc/${name}.x509der" chmod 0400 "${WORKDIR}/sec/${name}.key" openssl x509 -inform DER -outform PEM < "${WORKDIR}/pkc/${name}.x509der" > "${WORKDIR}/pkc/${name}.x509pem" ssh-keygen -y -P '' -f "${WORKDIR}/sec/${name}.key" > "${WORKDIR}/pkc/${name}.opensshpubkey" ssh-keygen -e -P '' -f "${WORKDIR}/sec/${name}.key" > "${WORKDIR}/pkc/${name}.rfc4716" done # translate X and Y's keys into OpenPGP cert for name in x y; do uid="https://${name}.example.net" PEM2OPENPGP_USAGE_FLAGS=authenticate pem2openpgp "$uid" < "${WORKDIR}/sec/${name}.key" | gpg --import # export fingerprint for openpgp4fpr gpg --with-colons --fingerprint "=${uid}" | grep '^fpr:' | cut -d: -f10 > "${WORKDIR}/pkc/${name}.openpgp4fpr" done # touch an empty openpgp4fpr file for z, who is not supposed to be in # the monkeysphere at all, and therefore has no openpgp4fpr touch "${WORKDIR}/pkc/z.openpgp4fpr" # and the same for the clients A and B for name in a b; do uid="${name} <${name}@example.net>" # make user keys 'a' and 's' capable PEM2OPENPGP_USAGE_FLAGS=authenticate,sign pem2openpgp "$uid" < "${WORKDIR}/sec/${name}.key" | gpg --import # export fingerprint for openpgp4fpr gpg --with-colons --fingerprint "=${uid}" | grep '^fpr:' | cut -d: -f10 > "${WORKDIR}/pkc/${name}.openpgp4fpr" done runtests() { # X should not validate as X or Y or Z: for name in x y z; do for ctype in $CERTTYPES; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${name}.example.net" "${ctype}" < "${WORKDIR}/pkc/x.${ctype}" echo done done # A shouldn't validate as A or B: for name in a b; do for ctype in $CERTTYPES; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${name} <${name}@example.net>" "${ctype}" client < "${WORKDIR}/pkc/a.${ctype}" echo done done # certify X and A's OpenPGP cert with CA gpg --batch --yes --sign-key https://x.example.net gpg --batch --yes --sign-key a@example.net echo "Testing bad data:" # it should fail if we pass it the wrong kind of data: ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https x.example.net "x509der" < "${WORKDIR}/pkc/x.x509pem" echo ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https x.example.net "x509pem" < "${WORKDIR}/pkc/x.x509der" echo echo "Done testing bad data." for ctype in $CERTTYPES; do # X should now validate as X "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https x.example.net "${ctype}" < "${WORKDIR}/pkc/x.${ctype}" echo "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https 'a ' "${ctype}" client < "${WORKDIR}/pkc/a.${ctype}" # also test "e-mail" context "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent e-mail 'a ' "${ctype}" < "${WORKDIR}/pkc/a.${ctype}" # but X should not validate as Y or Z: for name in x y z; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${name}.example.net" "${ctype}" < "${WORKDIR}/pkc/x.${ctype}" echo done # and A shouldn't validate as B: ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "b " "${ctype}" client < "${WORKDIR}/pkc/a.${ctype}" echo # neither Y nor Z should validate as any of them: for src in y z; do for targ in x y z; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${targ}.example.net" "${ctype}" < "${WORKDIR}/pkc/${src}.${ctype}" echo done done # B should also still not validate as itself: ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "b " "${ctype}" client < "${WORKDIR}/pkc/b.${ctype}" echo done } set -x MSVA_KEYSERVER_POLICY=never runtests set +x echo "Completed all tests as expected!" rm -rf "$WORKDIR" msva-perl-0.9.2/unit-tests/000077500000000000000000000000001221326450300155455ustar00rootroot00000000000000msva-perl-0.9.2/unit-tests/10.keyserver/000077500000000000000000000000001221326450300200035ustar00rootroot00000000000000msva-perl-0.9.2/unit-tests/10.keyserver/10.gnupghome.t000066400000000000000000000027341221326450300224060ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Keyserver; use GnuPG::Interface; use File::Temp qw(tempdir); use strict; use warnings; my $fpr='762B57BB784206AD'; plan tests =>9; { $ENV{HOME}='/nonexistant'; my $ks = new Crypt::Monkeysphere::Keyserver(); isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); is($ks->{keyserver},$Crypt::Monkeysphere::Keyserver::default_keyserver); } my $tempdir = tempdir("/tmp/unitXXXXX", CLEANUP=> 1); my $gnupg = new GnuPG::Interface(); my $testks = 'hkp://keys.gnupg.net'; $gnupg->options->hash_init(homedir=>$tempdir); is($gnupg->options->homedir,$tempdir); open GPGCONF, '>', "$tempdir/gpg.conf"; print GPGCONF "keyserver $testks\n"; close GPGCONF; my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, loglevel=>'debug'); isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); is($ks->{keyserver},$testks); open GPGCONF, '>', "$tempdir/gpg.conf"; print GPGCONF "keyserver $testks\n"; print GPGCONF "keyserver $testks.example\n"; close GPGCONF; $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, loglevel=>'debug'); isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); is($ks->{keyserver},"$testks.example"); open GPGCONF, '>', "$tempdir/gpg.conf"; close GPGCONF; $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, loglevel=>'debug'); isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); is($ks->{keyserver},$Crypt::Monkeysphere::Keyserver::default_keyserver); msva-perl-0.9.2/unit-tests/10.keyserver/20.fetch_fpr.t000066400000000000000000000011431221326450300223470ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Keyserver; use GnuPG::Interface; use File::Temp qw(tempdir); my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net'; my $fpr='762B57BB784206AD'; plan tests =>2; my $tempdir = tempdir("unitXXXXX", CLEANUP=> 1); my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$tempdir); my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, keyserver=>$keyserver, loglevel=>'debug'); isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); $ks->fetch_fpr($fpr); is(scalar($gnupg->get_public_keys('0x'.$fpr)),1); msva-perl-0.9.2/unit-tests/10.keyserver/20.fetch_uid.t000066400000000000000000000013231221326450300223410ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Keyserver; use GnuPG::Interface; use File::Temp qw(tempdir); use strict; my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net'; my $uid='David Bremner '; plan tests =>2; my $tempdir = tempdir("unitXXXXX", CLEANUP=> 1); my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$tempdir); my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, keyserver=>$keyserver, loglevel=>'debug'); isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); $ks->fetch_uid($uid); my $count=0; grep { $count += ($_ eq '784206AD') } (map { $_->short_hex_id } ($gnupg->get_public_keys('='.$uid))); is($count,1); msva-perl-0.9.2/unit-tests/20.validator/000077500000000000000000000000001221326450300177525ustar00rootroot00000000000000msva-perl-0.9.2/unit-tests/20.validator/10.findall.t000066400000000000000000000012431221326450300217670ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Validator; use GnuPG::Interface; use File::Temp qw(tempdir); use Data::Dumper; use strict; my $gpgdir = $ENV{MSTEST_GNUPGHOME}; unless (defined $gpgdir && -d $gpgdir){ plan skip_all => "Preseeded GPGHOME not found"; goto end; } my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$gpgdir); my $validator=new Crypt::Monkeysphere::Validator(gnupg=>$gnupg, kspolicy=>'never', loglevel=>'debug'); plan tests =>2; isa_ok($validator,'Crypt::Monkeysphere::Validator'); my $uid='Joe Tester '; my @keys=$validator->findall($uid); ok(scalar @keys >= 3); end: msva-perl-0.9.2/unit-tests/20.validator/20.lookup.t000066400000000000000000000015041221326450300216700ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Validator; use GnuPG::Interface; use File::Temp qw(tempdir); use Data::Dumper; use strict; my $uid='David Bremner '; plan tests =>2; my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net'; my $tempdir = tempdir("unitXXXXX", CLEANUP=> 1); my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$tempdir, extra_args =>[ qw(--trusted-key 762B57BB784206AD)] ); my $validator=new Crypt::Monkeysphere::Validator(gnupg=>$gnupg, keyserver=>$keyserver, loglevel=>'debug'); isa_ok($validator,'Crypt::Monkeysphere::Validator'); my $return=$validator->lookup(uid=>$uid,fpr=>'F8841978E8FA6FC65D3405155A5EA5837BD0B401'); print Dumper($return) if ($ENV{MSTEST_DEBUG}); ok(defined($return->{valid_key})); msva-perl-0.9.2/unit-tests/30.fingerprints/000077500000000000000000000000001221326450300205005ustar00rootroot00000000000000msva-perl-0.9.2/unit-tests/30.fingerprints/fpr.t000066400000000000000000000011771221326450300214620ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::OpenPGP; use Data::Dumper; use strict; my $timestamp = 1299825212; my $key = { modulus => Math::BigInt->new('0xcceb95c3c00b8a12c9de4829a803302f76549a50ee9b7ee58ee3a75ed1839d77d2f57b766e9954581d64eb5599ae98326a028831fbadad8065d63bc5a7b8d831e06d363fd9954f271fda1d746674b0ad6e8dff9fc5ddd4608bdf95760372f50897637a379079f3eb2544099a4511fc8af8e5992e15df8eac619b58a9970a3bdb'), exponent => Math::BigInt->new('0x10001'), }; plan tests =>1; is(unpack('H*', Crypt::Monkeysphere::OpenPGP::fingerprint($key, $timestamp)),"10cc971bbbb37b9152e8e759a2882699b47c6497"); msva-perl-0.9.2/unit-tests/40.keytrans/000077500000000000000000000000001221326450300176275ustar00rootroot00000000000000msva-perl-0.9.2/unit-tests/40.keytrans/01.openssh_pack.t000066400000000000000000000024071221326450300227130ustar00rootroot00000000000000# -*- perl -*- use Test::More; use strict; use warnings; use Crypt::Monkeysphere::Keytrans; use MIME::Base64; use File::Temp qw(tempdir); plan tests =>1; # this is dkg's ssh pubkey: my $exp = Math::BigInt->new('0x10001'); my $mod = Math::BigInt->new('0xBC358E82F23E5660301E5DBB370B42FD3EBAFE700B8E82F928798C0BA55DE5F96B984C2EA6D0BA67699E7777DA3FAF9CEA29A2030B81761603F8714E76AA2905A8DA2BAAFB19DEC147032E57585B6F4B3B1A4531942A1B3E635E1328AA50D98FA8CA7B2E64537CC26E0DE94F197A97854FE7C3B4F04F4FD96BCE8A311B2767CB0DB6E3A2D1871EE3B6B6309C0322EFCF9D3D30533575509B9A071C0C03A4B9C480D7B7E628BBF2A6714A54B5AA77F05CA7CDADD45A7C2C070DEB51F15122660B15919D7919A299E38D6BBD762C2E4BB306A0B506C7917DA3C0619E6116ADE290FDB35BA24D279212F24F097D1F70326B9207C27E536A29FEAA022504371CC01B'); my $sshpubkey = 'AAAAB3NzaC1yc2EAAAADAQABAAABAQC8NY6C8j5WYDAeXbs3C0L9Prr+cAuOgvkoeYwLpV3l+WuYTC6m0LpnaZ53d9o/r5zqKaIDC4F2FgP4cU52qikFqNorqvsZ3sFHAy5XWFtvSzsaRTGUKhs+Y14TKKpQ2Y+oynsuZFN8wm4N6U8ZepeFT+fDtPBPT9lrzooxGydnyw2246LRhx7jtrYwnAMi78+dPTBTNXVQm5oHHAwDpLnEgNe35ii78qZxSlS1qnfwXKfNrdRafCwHDetR8VEiZgsVkZ15GaKZ441rvXYsLkuzBqC1BseRfaPAYZ5hFq3ikP2zW6JNJ5IS8k8JfR9wMmuSB8J+U2op/qoCJQQ3HMAb'; my $out = encode_base64(Crypt::Monkeysphere::Keytrans::openssh_rsa_pubkey_pack($mod, $exp), ''); is($out, $sshpubkey); msva-perl-0.9.2/unit-tests/40.keytrans/10.openpgp2ssh.t000066400000000000000000000032061221326450300225040ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Keytrans qw(GnuPGKey_to_OpenSSH_pub); use GnuPG::Interface; use File::Temp qw(tempdir); plan tests => 1; my $tempdir = tempdir("unitXXXXX", CLEANUP => 1); my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$tempdir); my $openpgpdata = " -----BEGIN PGP PUBLIC KEY BLOCK----- Version: GnuPG v1.4.11 (GNU/Linux) mI0ETa5YiwEEALJhsHgLEokvKM+d1oAAy+oaDywLWsbqzuCCqu5h9Hu7MYxeGmTA tg8fXatgXEBUUe+e1i1aF94kTqcqcS5M+71ce2yHNyxl7U0pGVMOPiFiRVKK8x/7 wE2LTaPHhskc8kkKrxoJMbXmn0Oq5wn8xLkidIsVE+AyQ+HbD9C7UAnhABEBAAG0 NXRlc3Qga2V5IChETyBOT1QgVVNFISkgPHRlc3RAZXhhbXBsZS5uZXQ+IChJTlNF Q1VSRSEpiL4EEwECACgFAk2uWIsCGwMFCQABUYAGCwkIBwMCBhUIAgkKCwQWAgMB Ah4BAheAAAoJEEi/A6Yee54PGcID/iL1tRDgFnNaNNdEpChbjrWcoCIQOIw2VvYH UJY3oiKPWv/f8NMOylFLBG9pjDUd96wkimUvAKccPDwuhwMQq+KTcDPZXm8AeeUX IMHmPE33qqvifV9dFGlIGa4a3tmGjJvjhKmNSJGJWG9wRK3C2BrJdQVF9sk2FHXd 1nlddMRV =MxOB -----END PGP PUBLIC KEY BLOCK----- "; my $sshdata = "AAAAB3NzaC1yc2EAAAADAQABAAAAgQCyYbB4CxKJLyjPndaAAMvqGg8sC1rG6s7ggqruYfR7uzGMXhpkwLYPH12rYFxAVFHvntYtWhfeJE6nKnEuTPu9XHtshzcsZe1NKRlTDj4hYkVSivMf+8BNi02jx4bJHPJJCq8aCTG15p9DqucJ/MS5InSLFRPgMkPh2w/Qu1AJ4Q=="; my $input = IO::Handle->new(); my $output = IO::Handle->new(); my $handles = GnuPG::Handles->new(stdin => $input, stdout => $output, stderr => $output); my $pid = $gnupg->import_keys(handles => $handles); $input->write($openpgpdata); $input->close(); waitpid($pid, 0); my @keys = $gnupg->get_public_keys(); foreach $key (@keys) { my $output = GnuPGKey_to_OpenSSH_pub($key); is($sshdata, $output); } msva-perl-0.9.2/unit-tests/40.keytrans/20.sshfpr.t000066400000000000000000000027441221326450300215500ustar00rootroot00000000000000# -*- perl -*- use Test::More; use Crypt::Monkeysphere::Keytrans qw(GnuPGKey_to_OpenSSH_fpr); use GnuPG::Interface; use File::Temp qw(tempdir); plan tests => 1; my $tempdir = tempdir("unitXXXXX", CLEANUP => 1); my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$tempdir); my $openpgpdata = " -----BEGIN PGP PUBLIC KEY BLOCK----- Version: GnuPG v1.4.11 (GNU/Linux) mI0ETa5YiwEEALJhsHgLEokvKM+d1oAAy+oaDywLWsbqzuCCqu5h9Hu7MYxeGmTA tg8fXatgXEBUUe+e1i1aF94kTqcqcS5M+71ce2yHNyxl7U0pGVMOPiFiRVKK8x/7 wE2LTaPHhskc8kkKrxoJMbXmn0Oq5wn8xLkidIsVE+AyQ+HbD9C7UAnhABEBAAG0 NXRlc3Qga2V5IChETyBOT1QgVVNFISkgPHRlc3RAZXhhbXBsZS5uZXQ+IChJTlNF Q1VSRSEpiL4EEwECACgFAk2uWIsCGwMFCQABUYAGCwkIBwMCBhUIAgkKCwQWAgMB Ah4BAheAAAoJEEi/A6Yee54PGcID/iL1tRDgFnNaNNdEpChbjrWcoCIQOIw2VvYH UJY3oiKPWv/f8NMOylFLBG9pjDUd96wkimUvAKccPDwuhwMQq+KTcDPZXm8AeeUX IMHmPE33qqvifV9dFGlIGa4a3tmGjJvjhKmNSJGJWG9wRK3C2BrJdQVF9sk2FHXd 1nlddMRV =MxOB -----END PGP PUBLIC KEY BLOCK----- "; my $sshdata = "e6:b3:db:be:c6:5d:f7:65:f2:bb:6e:06:69:36:f5:e5"; my $input = IO::Handle->new(); my $output = IO::Handle->new(); my $handles = GnuPG::Handles->new(stdin => $input, stdout => $output, stderr => $output); my $pid = $gnupg->import_keys(handles => $handles); $input->write($openpgpdata); $input->close(); waitpid($pid, 0); my @keys = $gnupg->get_public_keys(); foreach $key (@keys) { my $output = GnuPGKey_to_OpenSSH_fpr($key); is($sshdata, $output); } msva-perl-0.9.2/unit-tests/README000066400000000000000000000001441221326450300164240ustar00rootroot00000000000000To run all unit tests, perl run-tests.pl to run a subset, perl run-tests.pl dir1 [dir2..] msva-perl-0.9.2/unit-tests/TODO000066400000000000000000000003341221326450300162350ustar00rootroot00000000000000 The following are currently not tested - subvalid keys for a userid - multiple subkeys from the same primary key - multiple uids on the same key -- David Bremner , Wed, 23 Mar 2011 20:40:14 -0300 msva-perl-0.9.2/unit-tests/keys.txt000066400000000000000000000014361221326450300172650ustar00rootroot00000000000000# For use with gpg --batch --gen-key Key-Type: DSA Key-Length: 1024 Subkey-Type: ELG-E Subkey-Length: 1024 Name-Real: Joe Tester Name-Email: joe@example.net Expire-Date: 0 Key-Type: RSA Key-Length: 2048 Key-Usage: sign Subkey-Type: RSA Subkey-Length: 1024 Subkey-Usage: auth Name-Real: Joe Tester Name-Email: joe@example.net Expire-Date: 0 Key-Type: RSA Key-Length: 2048 Key-Usage: sign Subkey-Type: RSA Subkey-Length: 1024 Subkey-Usage: sign Name-Real: Joe Tester Name-Email: joe@example.net Expire-Date: 0 Key-Type: RSA Key-Length: 2048 Key-Usage: auth Name-Real: Joe Tester Name-Email: joe@example.net Expire-Date: 0 Key-Type: RSA Key-Length: 2048 Key-Usage: encrypt Subkey-Type: RSA Subkey-Length: 1024 Subkey-Usage: auth Name-Real: Joe Tester Name-Email: jojo@example.net Expire-Date: 0 msva-perl-0.9.2/unit-tests/run-tests.pl000066400000000000000000000023611221326450300200500ustar00rootroot00000000000000#!/usr/bin/perl use strict; use TAP::Harness; use File::Find; use FindBin; use GnuPG::Interface; use GnuPG::Handles; use File::Temp qw(tempdir); my $BINDIR; BEGIN { $BINDIR = $FindBin::Bin; } { # Generate Keys from template file my $tempdir = tempdir("/tmp/test-gnupgXXXXX", CLEANUP=> 1); my $gnupg = new GnuPG::Interface(); $gnupg->options->hash_init(homedir=>$tempdir,batch=>1); my $GPGQR=''; if (system qw(gpg --quick-random --version) ==0) { $GPGQR='--quick-random'; } elsif (system qw(gpg --debug-quick-random --version) ==0) { $GPGQR='--debug-quick-random'; } print STDERR "WARNING: no quick random option found. Tests may hang!\n" unless(scalar $GPGQR); my $pid = $gnupg->wrap_call( commands=>[qw(--gen-key --batch),$GPGQR], command_args=>[$BINDIR.'/keys.txt'], handles=>new GnuPG::Handles() ); waitpid $pid,0; $ENV{MSTEST_GNUPGHOME}=$tempdir; } my @dirs = scalar(@ARGV) > 0 ? @ARGV : ($BINDIR); my @tests; sub wanted { push (@tests,$File::Find::name) if -f && m/.*\.t$/; } find(\&wanted, @dirs); @tests=sort @tests; print STDERR "found ",scalar(@tests)," tests\n"; my $harness = TAP::Harness->new( { verbosity => 1, lib => [ $BINDIR.'/..'] }); $harness->runtests(@tests); 1;