diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+ 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
+.
diff --git a/Network/AdHoc/Channel.hs b/Network/AdHoc/Channel.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/Channel.hs
@@ -0,0 +1,65 @@
+-- |
+-- Maintainer: Stephan Friedrichs, Henning Guenther
+module Network.AdHoc.Channel (
+ -- * Channel names
+ ChannelName,
+ mkChannelName,
+ anonymous,
+ validateChannelName,
+ -- * Channel ids
+ ChannelID(..)
+) where
+
+import Data.Char
+import Data.Ord
+import qualified Data.Set as Set
+
+-- | The 'ChannelName' type, see 'mkChannelName'.
+newtype ChannelName = ChannelName String
+
+-- | Creates a new 'ChannelName'.
+mkChannelName :: String -> ChannelName
+mkChannelName = ChannelName
+
+-- | Returns the ordering-relevant 'String' of the 'ChannelName'.
+getOrd :: ChannelName -> String
+getOrd (ChannelName n) = map toLower n
+
+-- | The anonymous 'ChannelName'
+anonymous :: ChannelName
+anonymous = mkChannelName "Anonymous"
+
+-- | Check 'ChannelName' for validity. Return 'Nothing' if it is alright,
+-- 'Just' err if it is illegal (err is the reason for that).
+validateChannelName :: ChannelName -> Maybe String
+validateChannelName cname
+ | len < 1 = Just "Sorry, the channel name may not be empty."
+ | len > 16 = Just "Sorry, the channel name is limited to 16 characters."
+ | and (map ((flip Set.member) allowed) str) = Nothing
+ | otherwise = Just $ "Sorry, only the following characters are suported in channel names:\n\n"
+ ++ "\tLetters\tA - Z and a - z\n"
+ ++ "\tDigits\t0 - 9\n"
+ ++ "\tUnderscore '_', hyphen '-' and dot '.'"
+ where
+ allowed = Set.fromList $ ['a'..'z'] ++ ['0'..'9'] ++ ['_', '.', '-']
+ str = getOrd cname
+ len = length str
+
+instance Show ChannelName where
+ show (ChannelName n) = n
+
+instance Eq ChannelName where
+ c1 == c2 = EQ == compare c1 c2
+
+instance Ord ChannelName where
+ compare = comparing getOrd
+
+-- | The unique 'ChannelID' type identifying each channel.
+data ChannelID = ChannelID
+ { channelValue :: String -- ^ A locally set value, unique per host.
+ , channelHost :: String -- ^ The hostname of the 'ChannelID'.
+ } deriving (Eq, Ord)
+
+instance Show ChannelID where
+ show cid = channelValue cid ++ "@" ++ channelHost cid
+
diff --git a/Network/AdHoc/Encryption.hs b/Network/AdHoc/Encryption.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/Encryption.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+-- |
+-- Maintainer: Henning Guenther
+module Network.AdHoc.Encryption
+ (Encrypted(..)
+ ,Encryptable(..)
+ ,RSAEncrypted(..)
+ ,RSAEncryptable(..)
+ ,pack64
+ ,unpack64
+ ,generateDESKey
+ ,checkParity
+ ,splitBlock
+ ) where
+
+import Data.Bits
+import qualified Data.ByteString as BS (ByteString(), length)
+import qualified Data.ByteString.Char8 as BSC
+import Data.List (foldl')
+import Data.Word
+import System.Random
+import Codec.Utils (fromOctets)
+import qualified Codec.Encryption as Encryption (encrypt,decrypt)
+import Codec.Encryption hiding (encrypt,decrypt)
+import qualified Codec.Encryption.PKCS1 as PKCS1
+import Network.GnuTLS.X509
+import System.Random
+
+-- | Represents encrypted data.
+data Encrypted a = Encrypted
+ {encryptedIV :: Word64
+ ,encryptedData :: BS.ByteString
+ } deriving (Show,Eq)
+
+-- | Represents data encrypted by RSA.
+data RSAEncrypted a = RSAEncrypted
+ {rsaData :: BS.ByteString
+ } deriving (Show,Eq)
+
+-- | A class of types that can be encrypted with 64 bit keys and initial vectors.
+class Encryptable a where
+ -- | Encrypts an object into an 'Encrypted' object
+ encrypt :: Word64 -- ^ The key to use
+ -> Word64 -- ^ The initial vector
+ -> a -- ^ The object to be encrypted
+ -> Encrypted a
+ -- | Reverses the encrypt operation
+ decrypt :: Word64 -- ^ The key to use
+ -> Encrypted a -- ^ The encrypted content to be decrypted
+ -> Maybe a
+
+-- | A class of types that can be encrypted with RSA.
+class RSAEncryptable a where
+ rsaEncrypt :: RandomGen g => g -- ^ Random generator to generate padding
+ -> Certificate -- ^ The 'Certificate' to use for encryption
+ -> a -- ^ Data to be encrypted
+ -> RSAEncrypted a
+ rsaDecrypt :: PrivateKey -> RSAEncrypted a -> Maybe a
+
+instance Encryptable BS.ByteString where
+ encrypt key iv str = Encrypted iv
+ (Encryption.encrypt CipherDES ModeCBC key iv (pkcs5 str))
+ decrypt key (Encrypted iv dat) = Encryption.decrypt CipherDES ModeCBC key iv dat >>= unpkcs5
+
+instance Encryptable String where
+ encrypt key iv str = coerceEncrypted $ encrypt key iv (BSC.pack str)
+ decrypt key dat = decrypt key (coerceEncrypted dat) >>= return.(BSC.unpack)
+
+coerceEncrypted :: Encrypted a -> Encrypted b
+coerceEncrypted (Encrypted iv dat) = Encrypted iv dat
+
+-- | Packs a stream of 8-bit Words into a stream of 64-bit Words.
+pack64 :: [Word8] -> [Word64]
+pack64 [] = []
+pack64 lst = let
+ (now,later) = splitAt 8 lst
+ val = fromOctets (256::Int) now
+ in val:pack64 later
+
+-- | Converts a list of 64-bit words into a list of 8-bit words.
+unpack64 :: [Word64] -> [Word8]
+unpack64 = concatMap (\x -> map (fromIntegral.(shiftR x)) [56,48..0])
+
+-- | Randomly creates a key for DES.
+generateDESKey :: RandomGen g => g -> (Word64,g)
+generateDESKey gen = foldl' (\(v,g) _ -> let
+ (cv,ng) = genParityWord8 g
+ in ((shiftL v 8) .|. (fromIntegral cv),ng)) (0,gen) [(0::Int)..7]
+
+genParityWord8 :: RandomGen g => g -> (Word8,g)
+genParityWord8 gen = let
+ (v,ngen) = randomR (0,255::Int) gen
+ in (mkWord8Parity $ fromIntegral v,ngen)
+
+checkParity :: Bits a => a -> Bool
+checkParity wrd = testBit (sum [shiftR wrd x | x <- [0..((bitSize wrd)-1)]]) 0
+
+mkWord8Parity :: Word8 -> Word8
+mkWord8Parity wrd = let
+ res = sum [ shiftR wrd x | x <- [0..6]]
+ in if testBit res 0
+ then clearBit wrd 7
+ else setBit wrd 7
+
+instance RSAEncryptable String where
+ rsaEncrypt gen cert str = coerceRSAEncrypted $ rsaEncrypt gen cert (BSC.pack str)
+ rsaDecrypt key dat = fmap BSC.unpack $ rsaDecrypt key (coerceRSAEncrypted dat)
+
+instance RSAEncryptable BS.ByteString where
+ rsaEncrypt gen cert str = RSAEncrypted $ standardRSAEncrypt gen cert str
+ rsaDecrypt key (RSAEncrypted dat) = standardRSADecrypt key dat
+
+instance RSAEncryptable Word64 where
+ rsaEncrypt gen cert wrd = coerceRSAEncrypted $ rsaEncrypt gen cert (PKCS1.i2osp 8 wrd)
+ rsaDecrypt key enc = fmap PKCS1.os2ip $ rsaDecrypt key (coerceRSAEncrypted enc)
+
+coerceRSAEncrypted :: RSAEncrypted a -> RSAEncrypted b
+coerceRSAEncrypted (RSAEncrypted dat) = RSAEncrypted dat
+
+splitBlock :: Int -> [Word8] -> [[Word8]]
+splitBlock _ [] = []
+splitBlock size wrd = let (x,xs) = splitAt size wrd in x:(splitBlock size xs)
+
+standardRSAEncrypt :: RandomGen g => g -> Certificate -> BS.ByteString -> BS.ByteString
+standardRSAEncrypt gen cert str = case certificateRSAParameters cert of
+ Left err -> error ("Internal GnuTLS error: "++show err)
+ Right (n,e) -> let
+ pkey = PKCS1.PublicKey (PKCS1.os2ip n) (PKCS1.os2ip e)
+ in PKCS1.encrypt (BS.length n) pkey gen str
+
+standardRSADecrypt :: PrivateKey -> BS.ByteString -> Maybe BS.ByteString
+standardRSADecrypt key str = case privateKeyRSAParameters key of
+ Left err -> error ("Internal GnuTLS error: "++show err)
+ Right (n,_,d,p,q,u) -> let
+ skey = PKCS1.PrivateKey $ Right $ PKCS1.PrivateKeyComplex
+ (PKCS1.os2ip n) (PKCS1.os2ip d) (PKCS1.os2ip p) (PKCS1.os2ip q) (PKCS1.os2ip u)
+ in PKCS1.decrypt (BS.length n) skey str
+
+{-
+rsaPkcs1Encrypt :: RandomGen g => g -> ([Word8],[Word8]) -> [Word8] -> [Word8]
+rsaPkcs1Encrypt gen (m,e) str
+ | length str > length m - 11 = error "message too long"
+ | otherwise = let
+ ps = take (length m - length str - 3) (map fromIntegral $ randomRs (1,255) gen)
+ em = 0x00:0x02:(ps++[0x00]++str)
+ in RSA.encrypt (m,e) em
+
+rsaPkcs1Decrypt :: ([Word8],[Word8]) -> [Word8] -> [Word8]
+rsaPkcs1Decrypt (m,d) str = let
+ em = RSA.decrypt (m,d) str
+ in case em of
+ (0x00:0x02:rest) -> let
+ (ps,m) = break (==0) rest
+ in if length ps < 8
+ then []
+ else drop 1 m
+ _ -> []-}
diff --git a/Network/AdHoc/Generator.hs b/Network/AdHoc/Generator.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/Generator.hs
@@ -0,0 +1,343 @@
+{-# LANGUAGE FlexibleContexts, RelaxedPolyRec #-}
+-- | Maintainer: Martin Wegner
+-- Date: 2007-06-15
+
+module Network.AdHoc.Generator
+ ( generateMessage
+ , generateMessage'
+ , genRootElem
+ , genAnonymous
+ , genObscure
+ )
+ where
+
+import Codec.Binary.Base64
+
+import Data.ByteString hiding (map,concat,head,tail,takeWhile)
+import qualified Data.ByteString as BS
+import Data.Char
+import Codec.Binary.UTF8.String (encodeString)
+import Data.Word
+import Data.Time
+import Network.GnuTLS hiding (CipherUnknown)
+import Network.GnuTLS.X509
+import System.Locale (defaultTimeLocale)
+import Text.XML.HaXml.Escape
+import Text.XML.HaXml.Types
+import Text.XML.HaXml.XmlContent
+
+import Network.AdHoc.Channel
+import Network.AdHoc.Encryption
+import Network.AdHoc.Message
+import Network.AdHoc.MessageID
+import Network.AdHoc.Signature
+import Network.AdHoc.UserID
+import Network.AdHoc.XMLRenderer
+
+-- | This structure represents an abstract element tree to be used for generating the XML afterwards.
+-- It is designed for the special needs of the protocol schema and thus not as common as the HaXML
+-- structures.
+data AbstractElement = AbstractElement (String, [ (String, String) ], Either String [ AbstractElement ]) deriving (Show)
+
+--
+-- Time helper function
+--
+
+showTime :: UTCTime -> String
+showTime = (takeWhile (/='.')).(formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S") -- XXX: The takeWhile is only required in older versions of the time package
+
+--
+-- Signature creation helper functions
+--
+
+genStringToSign :: AbstractElement -> String
+genStringToSign (AbstractElement (name, _, children))
+ = case children of
+ Left strn -> if name == "receiver" then "" else strn
+ Right elems -> concat $ map genStringToSign elems
+
+genSignature :: AbstractElement -> PrivateKey -> ByteString
+genSignature elm key
+ = let signed = (signData key DigMd5 (encodeString $ genStringToSign elm)) in
+ case signed of
+ Left err -> error $ "Internal GnuTLS error: " ++ show err
+ Right bs -> bs
+
+--
+-- Common helper functions for generating the tree
+--
+
+genXMLCont :: Element () -> Content()
+genXMLCont elm = CElem elm ()
+
+genXMLElem :: AbstractElement -> Element ()
+genXMLElem (AbstractElement (name, attributes, children))
+ = Elem name [ mkAttr (fst a) (snd a) | a <- attributes ] content
+ where
+ content = case children of
+ Left str -> [ CString False str () ]
+ Right elems -> genXMLElems elems
+
+genXMLElems :: [ AbstractElement ] -> [ Content () ]
+genXMLElems = map (genXMLCont.genXMLElem)
+
+-- Helper functions for generating the internal abstract tree
+
+-- | Takes the given element and puts it into the root element of a message.
+genRootElem :: String -> AbstractElement -> Bool -> Maybe Delay -> TTL -> InternalSignature -> AbstractElement
+genRootElem name elm flood delay ttl sign
+ = AbstractElement (name, attributes, Right [ elm ])
+ where
+ delayAttr = case delay of
+ Just d -> [ ("delay", (show d)) ]
+ Nothing -> []
+ defaultAttributes =
+ [
+ ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"),
+ ("xsi:schemaLocation", "http://www.ibr.cs.tu-bs.de/chat-message http://www.ibr.cs.tu-bs.de/courses/ss07/sep-cm/protocol/chat-message.xsd"),
+ ("xmlns", "http://www.ibr.cs.tu-bs.de/chat-message"),
+ ("flood", (map toLower $ show flood)),
+ ("ttl", (show ttl))
+ ]
+ signature = case sign of
+ Left key -> Just (Signature MD5 (genSignature elm key))
+ Right (Just (rsign, _)) -> Just rsign
+ _ -> Nothing
+ signAttr = case signature of
+ Just (Signature t s) -> [ ("signtype", show t), ("signature", encode $ unpack s) ]
+ Nothing -> []
+ attributes = delayAttr++defaultAttributes++signAttr
+
+genRootElemDefault :: AbstractElement -> AbstractElement
+genRootElemDefault elm = genRootElem "chat-message" elm False Nothing 360 (Right Nothing)
+
+str :: String -> String -> AbstractElement
+str n v = AbstractElement (n, [], Left v)
+
+--
+-- Generate internal abstract tree for the different nested messages
+--
+
+-- ACK
+genAck :: UserID -> MessageID -> AbstractElement
+genAck userID msgID = AbstractElement ("ack", [], Right [ str "sender" (show userID), str "messageid" msgID ])
+
+-- HELLO
+genHello :: MessageID -> [ UserID ] -> Int -> Maybe String -> AbstractElement
+genHello msgid senders version greeting
+ = AbstractElement ("hello", [], Right (senders'++[ str "messageid" msgid, str "version" (show version) ]++lGreeting))
+ where
+ senders' = map ((str "sender").show) senders
+ lGreeting = case greeting of
+ Just rgreeting -> [ str "greeting" rgreeting ]
+ Nothing -> []
+
+-- ROUTING
+genRouting :: MessageID -> [ (UserID, Int) ] -> AbstractElement
+genRouting msgid routes
+ = AbstractElement ("routing", [], Right ([ str "messageid" msgid ]++destinations))
+ where
+ destinations = [ AbstractElement ("destination", [], Right [ str "user" (show user), str "hops" (show hops) ]) | (user, hops) <- routes ]
+
+-- GETCERTIFICATE
+genGetCertificate :: UserID -> MessageID -> UserID -> AbstractElement
+genGetCertificate sender msgID for
+ = AbstractElement ("getcertificate", [], Right [ str "sender" (show sender), str "receiver" (show for), str "messageid" msgID ])
+
+-- CERTIFICATE
+genCertificate :: UserID -> MessageID -> [ UserID ] -> UserID -> [ Word8 ] -> AbstractElement
+genCertificate sender msgID receivers for certData
+ = AbstractElement ("certificate", [], Right ([ sender' ]++receivers'++[ msgID' ]++[ certificate ]))
+ where
+ sender' = str "sender" (show sender)
+ receivers' = map ((str "receiver").show) receivers
+ msgID' = str "messageid" msgID
+ certificate = AbstractElement ("certificate", [], Right ([ str "user" (show for), str "data" (encode certData) ]))
+
+-- GETKEY
+genGetKey :: UserID -> MessageID -> UserID -> ChannelName -> ChannelID -> AbstractElement
+genGetKey sender msgID receiver cname cid
+ = AbstractElement ("getkey", [], Right elems)
+ where
+ elems = [
+ str "sender" (show sender), str "receiver" (show receiver), str "messageid" msgID,
+ str "channel" (show cname), str "channelid" (show cid)
+ ]
+
+-- KEY
+genKey :: UserID -> MessageID -> UserID -> ChannelName -> ChannelID -> CipherType -> ByteString -> AbstractElement
+genKey sender msgID receiver cname cid cipher key
+ = AbstractElement ("key", [], Right elems)
+ where
+ cipher' = case cipher of
+ CipherDES_CBC -> "DES-CBC"
+ CipherNone -> "NONE"
+ CipherUnknown str -> str
+ elems = [
+ str "sender" (show sender), str "receiver" (show receiver), str "messageid" msgID,
+ str "channel" (show cname), str "channelid" (show cid), str "cipher" cipher', str "key" (encode (unpack key))
+ ]
+
+-- OBSCURE
+-- | Generates the tree of 'AbstractElement's for an obscure message.
+genObscure :: UserID -> Maybe MessageID -> ByteString -> AbstractElement
+genObscure receiver msgID obscData
+ = AbstractElement ("obscure", [], Right ([ str "receiver" (show receiver) ]++messageID++[ str "text" (encode $ unpack obscData) ]))
+ where
+ messageID = case msgID of
+ Just rmsgID -> [ str "messageid" rmsgID ]
+ Nothing -> []
+
+-- attachment
+genAttachment :: Attachment -> AbstractElement
+genAttachment (Attachment filename appType fileData)
+ = AbstractElement ("attachment", [], Right children)
+ where
+ children = [
+ str "filename" filename, str "applicationtype" appType,
+ str "data" (encode $ BS.unpack fileData)
+ ]
+
+genEncryptedAttachment :: EncryptedAttachment -> AbstractElement
+genEncryptedAttachment (EncryptedAttachment filename appType fileData)
+ = AbstractElement ("attachment", ivAttr, Right children)
+ where
+ ivAttr = [ ("iv", encode (unpack64 [ encryptedIV filename ])) ]
+ children = [
+ str "filename" (encode $ BS.unpack $ encryptedData filename),
+ str "applicationtype" (encode $ BS.unpack $ encryptedData appType),
+ str "data" (encode $ BS.unpack $ encryptedData fileData)
+ ]
+
+-- MESSAGE text and attachment's
+genMessageContent :: MessageContent -> (AbstractElement, [ AbstractElement ])
+genMessageContent cont
+ = case cont of
+ UnencryptedMessage txt attach -> (str "text" txt,map genAttachment attach)
+ EncryptedMessage txt attach -> (
+ AbstractElement ("text" ,[ ("iv", encode $ unpack64 [encryptedIV txt]) ],Left (encode $ BS.unpack $ encryptedData txt)),
+ map genEncryptedAttachment attach
+ )
+
+-- MESSAGE
+genMessage :: Maybe UserID -> Maybe MessageID -> [ UserID ] -> Maybe (ChannelName, ChannelID) -> MessageContent -> UTCTime -> AbstractElement
+genMessage sender msgID receivers chan cont time
+ = AbstractElement ("message", [], Right (sender'++receivers'++messageID++others++channel++[ elemText ]++attachments))
+ where
+ sender' = case sender of
+ Just rsender -> [ str "sender" (show rsender) ]
+ Nothing -> []
+ receivers' = map ((str "receiver").show) receivers
+ messageID = case msgID of
+ Just rmsgID -> [ str "messageid" rmsgID ]
+ Nothing -> []
+ others = [ str "timestamp" (showTime time) ]
+ channel = case chan of
+ Nothing -> []
+ Just (cname, cid) -> [ str "channel" (show cname), str "channelid" (show cid) ]
+ (elemText, attachments)
+ = genMessageContent cont
+
+-- NACK
+genNack :: UserID -> MessageID -> Routed TargetContent ExternalSignature -> AbstractElement
+genNack sender msgID routed
+ = AbstractElement ("nack", [], Right (others++[ message ]))
+ where
+ -- Nested message is named "message" instead of "chat-message":
+ message = generateElementFromRouted "message" routed
+ others = [ str "sender" (show sender), str "messageid" msgID ]
+
+-- CHANNEL
+genChannel :: UserID -> MessageID -> ChannelName -> ChannelID -> String -> [ UserID ] -> Bool -> AbstractElement
+genChannel sender msgID cname cid title members private
+ = AbstractElement ("channel", [ ("closed", map toLower (show private)) ], Right (others++members'))
+ where
+ others = [
+ str "sender" (show sender), str "messageid" msgID,
+ str "channel" (show cname), str "channelid" (show cid), str "description" title
+ ]
+ members' = map ((str "member").show) members
+
+-- JOIN/LEAVE
+genJoinLeave :: String -> UserID -> MessageID -> ChannelName -> ChannelID -> AbstractElement
+genJoinLeave what who msgID cname cid
+ = AbstractElement (what, [], Right [ str "sender" (show who), str "messageid" msgID, str "channel" (show cname), str "channelid" (show cid) ])
+
+-- MESSAGE to channel "Anonymous"
+-- | Generates the tree of 'AbstractElement's for an anonymous message.
+genAnonymous :: Bool -> Maybe UserID -> Maybe MessageID -> String -> [ Attachment ] -> UTCTime -> AbstractElement
+genAnonymous showChan sender msgID text attachments time
+ = genMessage sender msgID [] channel (UnencryptedMessage text attachments) time
+ where
+ channel = if showChan
+ then Just (anonymous,ChannelID "Anonymous" "Anonymous")
+ else Nothing
+
+generateElementFromRouted :: ToInternalSignature sig => String -> Routed TargetContent sig -> AbstractElement
+generateElementFromRouted name (Routed ttl user messageID content sign)
+ = genRootElem name elm False delay ttl (toInternal sign)
+ where
+ elm = case content of
+ GetCertificate for
+ -> genGetCertificate user messageID for
+ Certificate receivers for certData
+ -> genCertificate user messageID receivers for (unpack certData)
+ GetKey receiver cname cid
+ -> genGetKey user messageID receiver cname cid
+ Key receiver cname cid cipher key
+ -> genKey user messageID receiver cname cid cipher (rsaData key)
+ Message receivers cname cid cont time _
+ -> genMessage (Just user) (Just messageID) receivers (Just (cname, cid)) cont time
+ Nack routed
+ -> genNack user messageID routed
+ delay = case content of
+ Message _ _ _ _ _ rdelay -> Just rdelay
+ _ -> Nothing
+
+--
+-- Generate internal abstract tree for messages represented by InternalMessage
+--
+
+generateElementWithMsgID :: InternalMessage -> MessageID -> AbstractElement
+generateElementWithMsgID _ _ = undefined
+
+generateElement :: [MessageID] -> InternalMessage -> (AbstractElement,[MessageID])
+generateElement ids (Ack userID messageID) = (genRootElemDefault $ genAck userID messageID, ids)
+generateElement ids (Hello receivers version greeting)
+ = (genRootElemDefault $ genHello (head ids) receivers version greeting, tail ids)
+generateElement ids (Routing routes) = (genRootElemDefault $ genRouting (head ids) routes, tail ids)
+generateElement ids (Target routed) = (generateElementFromRouted "chat-message" routed, ids)
+generateElement ids (Flood (Routed ttl sender messageID content sign))
+ = (genRootElem "chat-message" elm True delay ttl sign, ids)
+ where
+ elm = case content of
+ Channel cname cid title members private -> genChannel sender messageID cname cid title members private
+ Join cname cid -> genJoinLeave "join" sender messageID cname cid
+ Leave cname cid -> genJoinLeave "leave" sender messageID cname cid
+ Anonymous text attachments time _ -> genAnonymous True (Just sender) (Just messageID) text attachments time
+ delay = case content of
+ Anonymous _ _ _ rdelay -> Just rdelay
+ _ -> Nothing
+generateElement ids (Obscure (Routed ttl receiver messageID content ()))
+ = (genRootElem "chat-message" (genObscure receiver (Just messageID) (rsaData content)) False Nothing ttl (Right Nothing), ids)
+
+--
+-- Generate XML document tree for messages represented by InternalMessage
+--
+
+generateDocument :: Element () -> Document()
+generateDocument elm
+ = Document
+ (Prolog (Just (XMLDecl "1.0" (Just (EncodingDecl "utf-8")) Nothing)) [] Nothing [])
+ emptyST
+ (xmlEscape escaper elm)
+ []
+
+-- | Takes an 'AbstractElement' and generates the XML document from it.
+generateMessage' :: AbstractElement -> String
+generateMessage' = encodeString . renderDocument . generateDocument . genXMLElem
+
+-- | Takes an 'InternalMessage' and generates the XML document from it.
+generateMessage :: [MessageID] -> InternalMessage -> (String,[MessageID])
+generateMessage ids msg = let (el,nids) = (generateElement ids msg) in (generateMessage' el,nids)
+
diff --git a/Network/AdHoc/Message.hs b/Network/AdHoc/Message.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/Message.hs
@@ -0,0 +1,195 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- This module contains types representing the different kinds of
+-- messages defined by the protocol.
+module Network.AdHoc.Message where
+
+import Data.ByteString as BS
+import Data.Word
+import Data.Time.Clock
+import Data.Maybe
+import Data.Time.LocalTime ()
+
+import Network.AdHoc.Channel
+import Network.AdHoc.Encryption
+import Network.AdHoc.MessageID
+import Network.AdHoc.UserID
+import Network.AdHoc.Signature
+
+-- | Specifies the encryption algorithm used to encrypt a message
+data CipherType
+ = CipherDES_CBC
+ | CipherNone
+ | CipherUnknown String -- ^ An unknown cipher was used
+ deriving (Show,Eq)
+
+-- | TimeToLive has a maximum of 360, so 16 bit unsigned is enough to hold it
+type TTL = Word16
+
+-- | The message-delay can be represented by this type.
+type Delay = Word
+
+-- | An attachmet as defined in the protocoll.
+data Attachment = Attachment
+ {attachmentFilename :: String -- ^ Name of the attached file
+ ,attachmentAppType :: String -- ^ Mime-type of the very same
+ ,attachmentContent :: BS.ByteString -- ^ The actual content of the file
+ } deriving (Show,Eq)
+
+-- | An attachment that has been encrypted.
+data EncryptedAttachment = EncryptedAttachment
+ {encryptedAttachmentFilename :: Encrypted String -- ^ Encrypted filename
+ ,encryptedAttachmentAppType :: Encrypted String -- ^ Encrypted mime-type
+ ,encryptedAttachmentContent :: Encrypted BS.ByteString -- ^ Encrypted content
+ } deriving (Show,Eq)
+
+-- | Uses DES to encrypt an 'Attachment'.
+encryptAttachment :: Word64 -- ^ Key
+ -> Word64 -- ^ IV
+ -> Attachment -- ^ 'Attachment' to be encrypted
+ -> EncryptedAttachment
+encryptAttachment key iv (Attachment name tp cont) = EncryptedAttachment
+ (encrypt key iv name)
+ (encrypt key iv tp)
+ (encrypt key iv cont)
+
+-- | Uses DES to decrypt an 'EncryptedAttachment'.
+decryptAttachment :: Word64 -- ^ Key
+ -> EncryptedAttachment -- ^ Encrypted attachment
+ -> Maybe Attachment -- ^ 'Nothing' at failure, 'Just' when successful
+decryptAttachment key (EncryptedAttachment name tp cont) = do
+ rname <- decrypt key name
+ rtp <- decrypt key tp
+ rcont <- decrypt key cont
+ return $ Attachment rname rtp rcont
+
+-- | A class of messages that can be routed.
+data Routed a sign = Routed
+ {routedTTL :: TTL -- ^ The time-to-live of the message
+ ,routedUserID :: UserID -- ^ Receiver of the routed message
+ ,routedMsgID :: MessageID -- ^ ID of the routed message
+ ,routedContent :: a -- ^ The actual content of the message
+ ,routedSignature :: sign -- ^ Signature of the message
+ } deriving (Show,Eq)
+
+-- | An unsigned message.
+type UnsignedMessage = ProtocolMessage NoSignature
+
+-- | An internal message that is subject to internal signature guidelines.
+type InternalMessage = ProtocolMessage InternalSignature
+
+-- | An external message.
+type ExternalMessage = ProtocolMessage ExternalSignature
+
+-- | Basic protocol message representation.
+data ProtocolMessage sign
+ = Hello
+ {helloSenders :: [UserID]
+ ,helloVersion :: Int
+ ,helloGreeting :: Maybe String
+ } -- ^ Informs about a user on the sending node, giving the user-id, the protocol version and a friendly greeting
+ | Ack
+ {ackSender :: UserID
+ ,ackMsgId :: MessageID
+ } -- ^ Sender of the original message and the sended message-id
+ | Routing
+ {routingRoutes :: [(UserID, Int)]
+ }-- ^ Routing informations, a list of users and how much hops it takes to reach them
+ | Target (Routed TargetContent sign) -- ^ Messages with one specified receiver
+ | Flood (Routed FloodContent sign) -- ^ Messages flooded through the network
+ | Obscure (Routed (RSAEncrypted String) ()) -- ^ Obscure messages
+ deriving (Show,Eq)
+
+-- | Messages directed to a specified receiver.
+data TargetContent
+ = Nack (Routed TargetContent ExternalSignature) -- ^ Negative ACK
+ | GetCertificate
+ {getCertificateFor :: UserID
+ } -- ^ Requesting a certificate
+ | Certificate
+ {certificateReceivers :: [UserID]
+ ,certificateFor :: UserID
+ ,certificateData :: BS.ByteString
+ } -- ^ Transmitting a certificate
+ | Message
+ {messageReceivers :: [UserID]
+ ,messageChannelName :: ChannelName
+ ,messageChannelID :: ChannelID
+ ,messageContent :: MessageContent
+ ,messageTime :: UTCTime
+ ,messageDelay :: Delay
+ } -- ^ A chat message
+ | GetKey
+ {getKeyReceiver :: UserID
+ ,getKeyChannelName :: ChannelName
+ ,getKeyChannelID :: ChannelID
+ } -- ^ Key request for a private channel
+ | Key
+ {keyReceiver :: UserID
+ ,keyChannelName :: ChannelName
+ ,keyChannelID :: ChannelID
+ ,keyCipherType :: CipherType
+ ,keyKey :: RSAEncrypted Word64
+ } -- ^ Key message for a private channel
+ deriving (Show,Eq)
+
+-- | Messages flooded throughout the entire network.
+data FloodContent
+ = Channel
+ {channelChannelName :: ChannelName
+ ,channelChannelID :: ChannelID
+ ,channelChannelTitle :: String
+ ,channelUsers :: [UserID]
+ ,channelPrivate :: Bool
+ } -- ^ Channel announcements
+ | Join
+ {joinChannelName :: ChannelName
+ ,joinChannelID :: ChannelID
+ } -- ^ Join message for a channel
+ | Leave
+ {leaveChannelName :: ChannelName
+ ,leaveChannelID :: ChannelID
+ } -- ^ The users leaves a channel
+ | Anonymous
+ {anonymousText :: String
+ ,anonymousAttachments :: [Attachment]
+ ,anonymousTime :: UTCTime
+ ,anonymousDelay :: Delay
+ } -- ^ An anonymous message that has been unpacked and will be flooded
+ deriving (Show,Eq)
+
+-- | A messages content can either be encrypted or not.
+data MessageContent
+ = EncryptedMessage (Encrypted String) [EncryptedAttachment]
+ | UnencryptedMessage String [Attachment]
+ deriving (Show,Eq)
+
+-- | Decrements the time-to-live of a message. If it sinks under zero,
+-- 'Nothing' is returned. 'Just' @msg@ otherwise, where @msg@ has a
+-- decremented ttl.
+decrementTTL :: Routed a sign -> Maybe (Routed a sign)
+decrementTTL (Routed ttl user mid cont sig)
+ | ttl == 0 = Nothing
+ | otherwise = Just (Routed (ttl-1) user mid cont sig)
+
+-- | Extracts the information from a message, that indicates, where to
+-- route it.
+routeTo :: Routed TargetContent sign -> [UserID]
+routeTo (Routed _ _ _ (Nack (Routed _ from _ _ _)) _) = [from]
+routeTo (Routed _ _ _ (GetCertificate for) _) = [for]
+routeTo (Routed _ _ _ (Certificate receivers _ _) _) = receivers
+routeTo (Routed _ _ _ (Message receivers _ _ _ _ _) _) = receivers
+routeTo (Routed _ _ _ (GetKey receiver _ _) _) = [receiver]
+routeTo (Routed _ _ _ (Key receiver _ _ _ _) _) = [receiver]
+
+instance Functor (Routed a) where
+ fmap f (Routed ttl user msgid cont sig) = Routed ttl user msgid cont (f sig)
+
+instance Functor ProtocolMessage where
+ fmap _ (Hello recv vers greet) = Hello recv vers greet
+ fmap _ (Ack send msgid) = Ack send msgid
+ fmap _ (Routing rt) = Routing rt
+ fmap f (Target rt) = Target (fmap f rt)
+ fmap f (Flood x) = Flood (fmap f x)
+ fmap _ (Obscure rt) = Obscure rt
diff --git a/Network/AdHoc/MessageID.hs b/Network/AdHoc/MessageID.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/MessageID.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE ExistentialQuantification #-}
+-- | Maintainer: Stephan Friedrichs, Henning Guenther
+module Network.AdHoc.MessageID
+ (MessageID
+ ,MessageIDGenerator
+ ,counter
+ ,scrambler
+ ,hasher
+ ) where
+
+import Data.List as List
+import qualified Data.Digest.SHA512 as SHA512
+import qualified Codec.Binary.Base64 as Base64
+import Codec.Utils
+import System.Random
+
+-- | This is just a 'String'.
+type MessageID = String
+
+-- | Generate an infinite(!) stream of 'MessageID's.
+type MessageIDGenerator g = g -> [MessageID]
+
+-- | Simplest possible generator type: counts from 0 upwards. Very insecure.
+counter :: MessageIDGenerator g
+counter _ = fmap show [(0::Int)..]
+
+-- | Generates a stream of 'MessageID's by shuffling a sorted stream couting from 0 upwards (@[0..]@).
+-- @scrambler n g@ would randomly remove the i-th element (where i is a random number between 0 and n)
+-- from the sorted list and place it at the head of the result list. It deals with the following
+-- elements in the same way.
+scrambler :: RandomGen g => Int -> MessageIDGenerator g
+scrambler offset gen = fmap show $ scramble gen offset [(0::Int)..]
+
+-- | Generates a stream of IDs by hashing an up-counting number and a random number with SHA512.
+hasher :: RandomGen g => MessageIDGenerator g
+hasher gen = fmap ((Base64.encode).(SHA512.hash)) (zipWith (++) (fmap (toOctets (256::Int)) [(0::Int)..]) (fmap toTwosComp (randoms gen::[Int])))
+
+-- | Scrambles an infinite(!) list. The result will be a permutation of the original list.
+-- The higher the offset (second argument), the further elements can occur from their
+-- original indices.
+scramble :: RandomGen g => g -> Int -> [a] -> [a]
+scramble gen offset xs = let
+ (r, gen') = randomR (0, offset) gen
+ (left, x:right) = List.splitAt r xs
+ xs' = scramble gen' offset (left ++ right)
+ in x : xs'
diff --git a/Network/AdHoc/ParserStrict.hs b/Network/AdHoc/ParserStrict.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/ParserStrict.hs
@@ -0,0 +1,323 @@
+-- |
+-- Maintainer: Henning Guenther
+--
+-- A module containing functions to parse the XML specified by the
+-- protocol into the internal message types.
+module Network.AdHoc.ParserStrict
+ (parseMessageNoValidate
+ ,parseMessage
+ ,parseInnerMessage) where
+
+import Codec.Binary.Base64
+import Control.Monad
+import qualified Data.ByteString as BS
+import Data.ByteString (pack)
+import Data.Char
+import Data.Time.Clock
+import Data.Time.Calendar
+import Data.List as List
+import Data.Word
+
+import Text.XML.HaXml.Escape
+import Text.XML.HaXml.Types
+import Text.XML.HaXml.Posn (Posn)
+
+import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.XML
+import Text.ParserCombinators.Parsec.Error (messageString,errorMessages)
+
+import Network.AdHoc.Channel
+import Network.AdHoc.Encryption
+import Network.AdHoc.Message
+import Network.AdHoc.Signature
+import Network.AdHoc.UserID
+import Network.AdHoc.XMLRenderer(escaper)
+
+-- | Parses a message without verifying the signature. It must only be
+-- used for testing or debugging issues!
+parseMessageNoValidate :: Document Posn -> Either String ExternalMessage
+parseMessageNoValidate = parseMessage (\_ _ _ -> CertificateMissing (error "Try not to validate messages generated by parseMessageNoValidate, STUPID!"))
+
+-- | Given a validation function for signatures, this function parses an XML
+-- 'Document' into an 'ExternalMessage'.
+parseMessage :: (String -> Signature -> UserID -> SignatureStatus) -- ^ A validation function for signatures.
+ -> Document Posn -- ^ The XML 'Document' to be parsed.
+ -> Either String ExternalMessage -- ^ 'Left' @err@ on failure, @err@ describs the error. 'Right' msg on success.
+parseMessage check (Document _ _ elems _)
+ | name == "chat-message" = either ((Left) . show) (Right) $
+ parse (parseMessage' check attrs) "" [ el | el@(CElem _ _) <- conts]
+ | otherwise = Left "root element must be \"chat-message\""
+ where
+ Elem name attrs conts = xmlUnEscape escaper elems
+
+-- | Parses an Obscure-message.
+parseInnerMessage :: Document Posn -- ^ The XML 'Document' to be parsed.
+ -> Either String (Either (UserID,RSAEncrypted String) (UTCTime,String,[Attachment])) -- ^ 'Left' @err@ in case of a parsing failure;
+ -- 'Right' @msg@ on success. @msg@ either is one more obscured message or
+ -- the final message to be flooded.
+parseInnerMessage (Document _ _ elems _)
+ | name == "chat-message" = either ((Left).show) (Right) $ parse (do
+ Elem elname _ elconts <- element
+ recurse (case elname of
+ "obscure" -> do
+ recv <- parseUserID "receiver"
+ txt <- stringElement "text" >>= base64dec "text"
+ return (Left (recv,RSAEncrypted $ pack txt))
+ "message" -> do
+ time <- parseTimestamp
+ optional (stringElement "messageid")
+ optional (stringElement "channel")
+ optional parseChannelID
+ txt <- namedElement "text" >>= recurse text
+ attach <- many parseUnencryptedAttachment
+ return (Right (time,txt,attach))
+ _ -> fail $ "content in obscure message must be \"obscure\" or \"message\", but not \""++elname++"\""
+ ) elconts
+ ) "" [ el | el@(CElem _ _) <- conts]
+ | otherwise = Left "root element must be \"chat-message\""
+ where
+ Elem name _ conts = xmlUnEscape stdXmlEscaper elems
+
+
+parseTimestamp :: XMLParser UTCTime
+parseTimestamp = stringElement "timestamp" >>= \str -> case parse parseDate "" str of
+ Left err -> fail $ "error in timestamp: "++(unlines $ map messageString $ errorMessages err)
+ Right res -> return res
+
+parseID :: String -> (String -> String -> a) -> XMLParser a
+parseID name constr = stringElement name >>= \str -> case break (=='@') str of
+ ([],_) -> fail "no name"
+ (_,[]) -> fail "no hostname"
+ (_,[_]) -> fail "no hostname"
+ (user,host) -> do
+ unless (all isValidUserChar user)
+ (fail $ "name "++show user++" contains illegal chars")
+ unless (all isValidUserChar host)
+ (fail $ "hostname "++show host++" contains illegal chars")
+ return $ constr user host
+ where
+ isValidUserChar c = isAlphaNum c || c `elem` ['_','.','-']
+
+parseUserID :: String -> XMLParser UserID
+parseUserID name = parseID name UserID
+
+parseChannelID :: XMLParser ChannelID
+parseChannelID = parseID "channelid" ChannelID
+
+parseAttachment :: XMLParser (Either Attachment EncryptedAttachment)
+parseAttachment = do
+ (attrs,conts) <- namedElementWithAttrs "attachment"
+ recurseElements (do
+ fn <- stringElement "filename"
+ apptype <- stringElement "applicationtype"
+ dat <- stringElement "data" >>= base64dec "data"
+ case getIV attrs of
+ Nothing -> return $ Left $ Attachment fn apptype (pack dat)
+ Just iv -> case pack64 iv of
+ [riv] -> do
+ rfn <- base64dec "filename" fn
+ rapptype <- base64dec "apptype" apptype
+ return $ Right $ EncryptedAttachment
+ (Encrypted riv (pack rfn))
+ (Encrypted riv (pack rapptype))
+ (Encrypted riv (pack dat))
+ _ -> fail "initialization vector is corrupt"
+ ) conts
+
+parseUnencryptedAttachment :: XMLParser Attachment
+parseUnencryptedAttachment = parseAttachment >>= either return (const pzero) "unencrypted attachment"
+
+parseEncryptedAttachment :: XMLParser EncryptedAttachment
+parseEncryptedAttachment = parseAttachment >>= either (const pzero) return "encrypted attachment"
+
+getIV :: [Attribute] -> Maybe [Word8]
+getIV attrs = List.lookup "iv" attrs >>= decode.show
+
+parseMessage' :: (String -> Signature -> UserID -> SignatureStatus) -> [Attribute] -> XMLParser ExternalMessage
+parseMessage' check attrs = do
+ hashstr <- fmap getHashString $ getInput
+ Elem name el_attrs conts <- element
+ let getTTL = case fmap show $ List.lookup "ttl" attrs of
+ Just val -> if all isDigit val
+ then return (read val)
+ else fail $ "invalid ttl value \""++val++"\"(must be a number)"
+ Nothing -> return 1
+ let signature' user = do
+ sgntyp <- fmap (\tp -> case show tp of
+ "MD5" -> MD5
+ str -> SignUnknown str) (List.lookup "signtype" attrs)
+ sgn <- fmap BS.pack $ List.lookup "signature" attrs >>= decode . show
+ let rsgn = Signature sgntyp sgn
+ return (rsgn,check hashstr rsgn user)
+ let routed name gen recv_gen = do
+ ttl <- getTTL
+ user <- parseUserID name
+ recv <- recv_gen
+ msgid <- stringElement "messageid"
+ res <- gen recv
+ return $ Routed ttl user msgid res (signature' user)
+ let target gen = do
+ res <- routed "sender" (const gen) (return ())
+ return $ Target res
+ let targetMany gen = do
+ res <- routed "sender" gen (many $ parseUserID "receiver")
+ return $ Target res
+ let targetOne gen = do
+ res <- routed "sender" gen (parseUserID "receiver")
+ return $ Target res
+ let flood gen = do
+ res <- routed "sender" (const gen) (return ())
+ return $ Flood res
+ let jl gen = recurseElements (flood $ do
+ cname <- stringElement "channel"
+ cid <- parseChannelID
+ return (gen (mkChannelName cname) cid))
+ case name of
+ "ack" -> recurseElements (do
+ sender <- parseUserID "sender"
+ msgid <- stringElement "messageid"
+ return $ Ack sender msgid) conts
+ "hello" -> recurseElements (do
+ senders <- many (parseUserID "sender")
+ optional $ stringElement "messageid"
+ vers <- stringElement "version" >>= \str -> if (all isDigit str)
+ then return (read str)
+ else fail $ "invalid version \""++str++"\"(must be a number)"
+ greeting <- option Nothing (stringElement "greeting" >>= return.Just)
+ return $ Hello senders vers greeting) conts
+ "nack" -> recurseElements (target $ do
+ (sub_attrs,sub_conts) <- namedElementWithAttrs "message"
+ submsg <- recurseElements (parseMessage' check sub_attrs) sub_conts
+ case submsg of
+ Target rt -> return (Nack rt)
+ _ -> fail $ "nack must contain getcertificate-, certificate, getkey-, key-, message- or obscure-message"
+ ) conts
+ "channel" -> recurseElements (flood $ do
+ cname <- stringElement "channel"
+ cid <- parseChannelID
+ descr <- stringElement "description"
+ let closed = case fmap show $ List.lookup "closed" el_attrs of
+ Just "true" -> True
+ Just "1" -> True
+ _ -> False
+ members <- many (parseUserID "member")
+ return $ Channel (mkChannelName cname) cid descr members closed) conts
+ "join" -> jl Join conts
+ "leave" -> jl Leave conts
+ "message" -> recurseElements (targetMany $ \recv -> do
+ delay <- case fmap show $ List.lookup "delay" attrs of
+ Nothing -> return 0
+ Just str -> if all isDigit str
+ then return $ read str
+ else fail $ "invalid delay attribute \""++str++"\"(must be a number)"
+ time <- parseTimestamp
+ cname <- option "anonymous" $ stringElement "channel"
+ cid <- option (ChannelID "anonymous" "anonymous") parseChannelID
+ (text_attrs,text_conts) <- namedElementWithAttrs "text"
+ text <- recurse (text <|> return "") text_conts -- Allow empty text node
+ content <- case getIV text_attrs of
+ Nothing -> do
+ attach <- many parseUnencryptedAttachment
+ return $ UnencryptedMessage text attach
+ Just iv -> case pack64 iv of
+ [riv] -> do
+ attach <- many parseEncryptedAttachment
+ rtext <- case decode text of
+ Nothing -> fail "text element contains invalid bas64 data"
+ Just r -> return r
+ return $ EncryptedMessage
+ (Encrypted riv (pack rtext))
+ attach
+ [] -> do
+ attach <- many parseUnencryptedAttachment
+ return $ UnencryptedMessage text attach
+ _ -> fail $ "invalid initialization vector: "++show iv
+ return $ Message recv (mkChannelName cname) cid content time delay) conts >>= anonymousCheck
+ "routing" -> recurseElements (do
+-- msgid <- stringElement "messageid"
+ dest <- many $ namedElement "destination" >>= recurseElements (do
+ user <- parseUserID "user"
+ hops <- stringElement "hops" >>= \str -> if all isDigit str
+ then return (read str)
+ else fail $ "invalid hops value \""++str++"\"(must be a number)"
+ return (user,hops))
+ return $ Routing dest) conts
+ "obscure" -> recurseElements (do
+ ttl <- getTTL
+ recv <- parseUserID "receiver"
+ msgid <- stringElement "messageid"
+ text <- fmap pack $ stringElement "text" >>= base64dec "text"
+ return $ Obscure (Routed ttl recv msgid (RSAEncrypted text) ())) conts
+ "getcertificate" -> recurseElements (targetOne $ \for -> return (GetCertificate for)) conts
+ "certificate" -> recurseElements (targetMany $ \recv -> do
+ (for,cert) <- namedElement "certificate" >>= recurseElements (do
+ cert_user <- parseUserID "user"
+ cert_data <- stringElement "data" >>= base64dec "data"
+ return (cert_user,cert_data))
+ return $ Certificate recv for (BS.pack cert)) conts
+ "getkey" -> recurseElements (targetOne $ \recv -> do
+ cname <- stringElement "channel"
+ cid <- parseChannelID
+ return $ GetKey recv (mkChannelName cname) cid) conts
+ "key" -> recurseElements (targetOne $ \recv -> do
+ cname <- stringElement "channel"
+ cid <- parseChannelID
+ cipher_type <- stringElement "cipher" >>= (\str -> return $ case str of
+ "DES-CBC" -> CipherDES_CBC
+ "NONE" -> CipherNone
+ _ -> CipherUnknown str)
+ key <- fmap pack $ stringElement "key" >>= base64dec "key"
+ return $ Key recv (mkChannelName cname) cid cipher_type (RSAEncrypted key)) conts
+ _ -> fail $ "unknown message type \""++name++"\""
+
+anonymousCheck :: ExternalMessage -> XMLParser ExternalMessage
+anonymousCheck x@(Target (Routed ttl user msgid (Message _ cname _ (UnencryptedMessage text attach) time delay) sig))
+ = if cname == anonymous
+ then return $ Flood (Routed ttl user msgid (Anonymous text attach time delay) sig)
+ else return x
+anonymousCheck x = return x
+
+parseDate :: Parser UTCTime
+parseDate = do
+ yearFactor <- option 1 (char '-' >> return (-1))
+ year <- count 4 digit >>= return.read
+ char '-'
+ month <- count 2 digit >>= return.read
+ when (month > 12 || month == 0) (fail "invalid month")
+ char '-'
+ day <- count 2 digit >>= return.read
+ when (day > 31 || day == 0) (fail "invalid day")
+ char 'T'
+ hour <- count 2 digit >>= return.read
+ when (hour > 23) (fail "invalid hour")
+ char ':'
+ minute <- count 2 digit >>= return.read
+ when (minute > 59) (fail "invalid minute")
+ char ':'
+ second <- count 2 digit >>= return.read
+ when (second > 59) (fail "invalid seconds")
+-- picos <- option (0::Int) $ char '.' >> many1 digit >>= return . read
+ option (0::Int) $ char '.' >> many1 digit >>= return . read
+ timezone <- option (0, 0) parseTimezone
+ return $ UTCTime (fromGregorian (yearFactor * year) month day) (fromInteger $ second + (minute - (snd timezone)) * 60 + (hour - (fst timezone)) * 3600)
+
+parseTimezone :: (Read n, Num n, Ord n) => Parser (n, n)
+parseTimezone = do
+ c <- anyChar
+ case c of
+ 'Z' -> return (0,0)
+ '+' -> offset
+ '-' -> offset >>= \(a, b) -> return (negate a, negate b)
+ _ -> fail "invalid timezone"
+ where offset = do
+ hour <- count 2 digit >>= return.read
+ when (hour > 14) (fail "invalid timezone")
+ char ':'
+ minute <- count 2 digit >>= return.read
+ when (minute > 59) (fail "invalid timezone")
+ return (hour, minute)
+
+base64dec :: String -> String -> GenParser a s [Word8]
+base64dec name str = case decode str of
+ Nothing -> fail $ "'"++name++"' element contains invalid base64 data"
+ Just r -> return r
diff --git a/Network/AdHoc/Routing.hs b/Network/AdHoc/Routing.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/Routing.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
+-- |
+-- Maintainer: Stephan Friedrichs, Henning Guenther
+module Network.AdHoc.Routing (
+ RoutingStrategy(..),
+ Addressed(..)
+) where
+
+import Network.AdHoc.UserID
+
+import Data.List as List
+import Data.Map as Map
+import Data.Word
+import Network.Socket
+import Network.AdHoc.Message
+import Network.AdHoc.Encryption
+
+-- | This class abstracts routing strategies for data-structures like 'Barracuda.RoutingTable.SimpleRT'.
+-- Minimal definition: one of 'routeSingle' or 'routeMulti'.
+class RoutingStrategy rs where
+ -- | Tries to find a route for a given user. The 'SockAddr' is the starting
+ -- point of the route.
+ routeSingle :: UserID -> rs -> Maybe SockAddr
+ routeSingle uid strat = let mp = fst (routeMulti [uid] strat) in case Map.keys mp of
+ k:_ -> Just k
+ _ -> Nothing
+ -- | Find routes for many users. The first object in the tuple maps nodes to a
+ -- list of users that should be reached over it. The second one is a list of
+ -- users that couldn't be reached.
+ routeMulti :: [UserID] -> rs -> (Map SockAddr [UserID],[UserID])
+ routeMulti users strat = foldl (\(mp,nor) user -> case routeSingle user strat of
+ Nothing -> (mp,user:nor)
+ Just addr -> (Map.alter ((Just).maybe [user] (user:)) addr mp,nor)) (Map.empty, []) users
+
+-- | Abstracts addressed contents that can be sent to (several) users.
+class Addressed a where
+ -- | Routes an 'Addressed' datagram.
+ route :: RoutingStrategy r =>
+ r -- ^ The 'RoutingStrategy' to locate users.
+ -> a -- ^ The data to be routed.
+ -> (Map SockAddr a, Maybe a) -- ^ Starting-points and target-data of routes and,
+ -- optionally, an addressed, failed-to-route datagram.
+
+instance Addressed (Routed (RSAEncrypted String) sign) where
+ route strategy rt = routingSingleMap (routedUserID rt) rt strategy
+instance Addressed (Routed TargetContent sign) where
+ route s rt@(Routed _ _ _ cont _) = case cont of
+ Nack srt -> routingSingleMap (routedUserID srt) rt s
+ GetCertificate for -> routingSingleMap for rt s
+ Certificate recv _ _ -> routingMultiMap recv (\nrecv -> rt
+ {routedContent = cont {certificateReceivers = nrecv}}) s
+ Message recv _ _ _ _ _ -> routingMultiMap recv (\nrecv -> rt
+ {routedContent = cont {messageReceivers = nrecv}}) s
+ GetKey recv _ _ -> routingSingleMap recv rt s
+ Key recv _ _ _ _ -> routingSingleMap recv rt s
+
+routingSingleMap :: RoutingStrategy rs => UserID -> Routed t sign -> rs -> (Map SockAddr (Routed t sign),Maybe (Routed t sign))
+routingSingleMap user obj = (maybe (Map.empty,Just obj) (\raddr -> (Map.singleton raddr obj,Nothing))).(routeSingle user)
+
+routingMultiMap :: RoutingStrategy rs => [UserID] -> ([UserID] -> Routed t sign) -> rs -> (Map SockAddr (Routed t sign),Maybe (Routed t sign))
+routingMultiMap users f s = let
+ (succ,nor) = routeMulti users s
+ in (Map.map f succ,case nor of
+ [] -> Nothing
+ _ -> Just (f nor))
+
+instance Ord SockAddr where
+ compare (SockAddrUnix a) (SockAddrUnix b) = compare a b
+ compare (SockAddrUnix _) (SockAddrInet _ _) = LT
+ compare (SockAddrInet _ _) (SockAddrUnix _) = GT
+ compare (SockAddrInet p1 h1) (SockAddrInet p2 h2) = case compare h1 h2 of
+ EQ -> compare p1 p2
+ x -> x
diff --git a/Network/AdHoc/Signature.hs b/Network/AdHoc/Signature.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/Signature.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+-- |
+-- Maintainer: Henning Guenther
+--
+-- This module is a helper for signature checking. It gives the text
+-- that needs to be hashed in order to create or verify a signature.
+module Network.AdHoc.Signature
+ (Signature(..)
+ ,SignType(..)
+ ,SignatureStatus(..)
+ ,NoSignature
+ ,InternalSignature
+ ,ExternalSignature
+ ,ToInternalSignature(..)
+ ,getHashString
+ ,verifySignature
+ ) where
+
+import Data.ByteString hiding (foldl,concatMap)
+import Text.XML.HaXml.Types
+import Codec.Binary.UTF8.String (encodeString)
+import qualified Network.GnuTLS.X509 as X509
+
+-- | A raw signature.
+data Signature = Signature
+ {sign_type :: SignType -- ^ The type of the signature
+ ,signature :: ByteString -- ^ The actual signature
+ }
+ deriving (Show,Eq)
+
+-- | Specifies the signature algorithm used to sign a message.
+data SignType
+ = MD5 -- ^ MD5 has been used to sign the message
+ | SignUnknown String -- ^ An unknown signature algorithm was used
+ deriving (Show,Eq)
+
+-- | This type represents the possible results of verifying a signature.
+data SignatureStatus
+ = SignatureOK -- ^ The signature was valid
+ | SignatureWrong -- ^ The signature was invalid
+ | CertificateMissing (X509.Certificate -> SignatureStatus) -- ^ The signature could not be
+ -- checked, becuase a 'X509.Certificate' was missing. The function
+ -- is a callback to be called when the missing certificate has been
+ -- acquired.
+
+instance Show SignatureStatus where
+ show SignatureOK = "SignatureOK"
+ show SignatureWrong = "SignatureWrong"
+ show (CertificateMissing _) = "CertificateMissing"
+
+instance Eq SignatureStatus where
+ SignatureOK == SignatureOK = True
+ SignatureWrong == SignatureWrong = True
+ _ == _ = False
+
+-- | No signature has been given.
+type NoSignature = ()
+
+-- | The message has been locally created, so we know the private key.
+type InternalSignature = Either X509.PrivateKey ExternalSignature
+
+-- | The signature has been received via network. The signature might be
+-- knwon or not.
+type ExternalSignature = Maybe (Signature,SignatureStatus)
+
+-- | A class of types that have an internal signature status.
+class ToInternalSignature s where
+ toInternal :: s -> InternalSignature
+
+instance ToInternalSignature NoSignature where
+ toInternal _ = Right Nothing
+
+instance ToInternalSignature ExternalSignature where
+ toInternal = Right
+
+instance ToInternalSignature InternalSignature where
+ toInternal = id
+
+-- | Given a certificate, this function verifies the Signature of a 'String'.
+verifySignature :: String -> Signature -> X509.Certificate -> SignatureStatus
+verifySignature str sig cert = case X509.verifySignature cert (encodeString str) (signature sig) of
+ Left _ -> CertificateMissing (verifySignature (encodeString str) sig)
+ Right False -> SignatureWrong
+ Right True -> SignatureOK
+
+-- | Calculates the concatenation of all text nodes in the list of contents, except for receiver elements
+getHashString :: [Content i] -> String
+getHashString = concatMap getHashStringContent
+
+getHashStringContent :: Content i -> String
+getHashStringContent (CElem (Elem "receiver" _ _) _) = "" -- As given by standard
+getHashStringContent (CElem (Elem _ _ conts) _) = getHashString conts
+getHashStringContent (CString _ str _) = str
+getHashStringContent _ = ""
+
+-- getHashStringDocument :: Document i -> String
+-- getHashStringDocument (Document _ _ (Elem _ _ conts) _) = getHashString conts
diff --git a/Network/AdHoc/UserID.hs b/Network/AdHoc/UserID.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/UserID.hs
@@ -0,0 +1,25 @@
+-- |
+-- Maintainer: Stephan Friedrichs
+module Network.AdHoc.UserID (
+ UserID(..)
+) where
+
+import Data.Char
+
+-- | Identifies a user in the network.
+data UserID = UserID
+ { userName :: String -- ^ The users name.
+ , userHost :: String -- ^ The users host.
+ }
+
+instance Show UserID where
+ show uid = (userName uid) ++ "@" ++ (userHost uid)
+
+instance Eq UserID where
+ u1 == u2 = EQ == compare u1 u2
+
+instance Ord UserID where
+ compare (UserID n1 h1) (UserID n2 h2) = case compare (map toLower h1) (map toLower h2) of
+ EQ -> compare n1 n2
+ x -> x
+
diff --git a/Network/AdHoc/XMLRenderer.hs b/Network/AdHoc/XMLRenderer.hs
new file mode 100644
--- /dev/null
+++ b/Network/AdHoc/XMLRenderer.hs
@@ -0,0 +1,96 @@
+-- | A module used to render an XML 'Document'.
+module Network.AdHoc.XMLRenderer
+ (renderDocument
+ ,escaper
+ ) where
+
+import Data.List(concatMap)
+import Text.XML.HaXml.Types
+import Text.XML.HaXml.Escape (XmlEscaper,mkXmlEscaper)
+
+-- | An escaper used to escape special characters, e.g. \'<\', from XML.
+escaper :: XmlEscaper
+escaper = mkXmlEscaper
+ [('<',"lt")
+ ,('>',"gt")
+ ,('&',"amp")
+ ,('\'',"apos")
+ ,('\"',"quot")] (\ch -> case ch of
+ '<' -> True
+ '>' -> True
+ '&' -> True
+ '\'' -> True
+ '\"' -> True
+ _ -> False)
+
+-- | Given a 'Document', this function converts it into a fully valid XML
+-- 'String'.
+renderDocument :: Document i -> String
+renderDocument (Document prolog tab root msc)
+ = renderProlog prolog
+ ++ renderSymtab tab
+ ++ renderElement root
+ ++ concatMap renderMisc msc
+
+renderProlog :: Prolog -> String
+renderProlog (Prolog decl msc1 dtd msc2)
+ = maybe "" renderXMLDecl decl
+ ++ concatMap renderMisc msc1
+ ++ maybe "" renderDocTypeDecl dtd
+ ++ concatMap renderMisc msc2
+
+xmlEscape :: String -> String
+xmlEscape ('<':xs) = "<"++xmlEscape xs
+xmlEscape ('>':xs) = ">"++xmlEscape xs
+xmlEscape ('\"':xs) = """++xmlEscape xs
+xmlEscape (x:xs) = x:(xmlEscape xs)
+xmlEscape "" = ""
+
+renderXMLDecl :: XMLDecl -> String
+renderXMLDecl (XMLDecl vers encdec st)
+ = " " encoding=\""++xmlEscape decl++"\"") encdec)
+ ++(maybe "" (\rst -> " standalone=\""++if rst then "yes" else "no"++"\"") st)
+ ++"?>"
+
+renderMisc :: Misc -> String
+renderMisc (Comment str) = ""
+renderMisc (PI (target,str)) = ""
+
+renderDocTypeDecl :: DocTypeDecl -> String
+renderDocTypeDecl = error "renderDocTypeDecl isn't implemented"
+-- renderDocTypeDecl (DTD name ext markup) = " String
+-- renderExternalID (SYSTEM (SystemLiteral str)) = "SYSTEM \""++xmlEscape str++"\""
+-- renderExternalID (PUBLIC (PubidLiteral str) (SystemLiteral str2)) = "PUBLIC \""++xmlEscape str++"\" \""++xmlEscape str2++"\""
+
+-- renderMarkupDecl :: MarkupDecl -> String
+-- renderMarkupDecl (Element (ElementDecl name ))
+
+renderSymtab :: SymTab EntityDef -> String
+renderSymtab = const ""
+
+renderElement :: Element i -> String
+renderElement (Elem name attrs cont)
+ = "<"++name
+ ++ concatMap renderAttribute attrs
+ ++ (if null cont
+ then "/>"
+ else ">"++concatMap renderContent cont++"")
+
+renderAttribute :: Attribute -> String
+renderAttribute (name,val) = " "++name++"=\""++renderAttValue val++"\""
+
+renderAttValue :: AttValue -> String
+renderAttValue (AttValue els) = concatMap (either xmlEscape renderReference) els
+
+renderReference :: Reference -> String
+renderReference (RefEntity str) = "&"++str++";"
+renderReference (RefChar num) = "&#"++show num++";"
+
+renderContent :: Content i -> String
+renderContent (CElem el _) = renderElement el
+renderContent (CString _ cd _) = xmlEscape cd
+renderContent (CRef ref _) = renderReference ref
+renderContent (CMisc msc _) = renderMisc msc
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,5 @@
+module Main where
+
+import Distribution.Simple
+
+main = defaultMain
diff --git a/adhoc-network.cabal b/adhoc-network.cabal
new file mode 100644
--- /dev/null
+++ b/adhoc-network.cabal
@@ -0,0 +1,45 @@
+Name: adhoc-network
+Version: 1.0.2
+License: GPL
+License-File: LICENSE
+Author: Stephan Friedrichs,
+ Henning Günther,
+ Oliver Mielentz,
+ Martin Wegner
+
+Stability: Beta
+Category: Network
+Synopsis: Ad-hoc P2P network protocol
+Description: This is a library for ad hoc P2p networking, developed for the Barracuda
+ chat client (by Stephan Friedrichs,
+ Henning Günther, Oliver Mielentz and Martin Wegner).
+ .
+ This library implements the RFCs (see for example
+ ).
+ .
+ The Darcs repository can be found at
+Homepage: http://sep07.mroot.net/
+
+Build-Depends: base>=3, containers, network, old-locale, random, time, parsec, bytestring>0.9, HaXml>1.0,
+ utf8-string, dataenc, Crypto>4, hsgnutls>=0.2.3-barracuda, pkcs1>=1.0.2, xml-parsec>=1.0.2
+Build-Type: Simple
+
+Extensions: ExistentialQuantification,
+ FlexibleContexts,
+ FlexibleInstances,
+ RelaxedPolyRec,
+ TypeSynonymInstances
+
+Exposed-Modules:
+ Network.AdHoc.Channel
+ Network.AdHoc.Encryption
+ Network.AdHoc.Generator
+ Network.AdHoc.Message
+ Network.AdHoc.MessageID
+ Network.AdHoc.ParserStrict
+ Network.AdHoc.Routing
+ Network.AdHoc.Signature
+ Network.AdHoc.UserID
+ Network.AdHoc.XMLRenderer
+ghc-options: -Wall
+