packages feed

hellnet (empty) → 0.1

raw patch · 17 files changed

+2359/−0 lines, 17 filesdep +Cryptodep +HTTPdep +Lucusetup-changed

Dependencies added: Crypto, HTTP, Lucu, RSA, base, bytestring, containers, directory, filepath, haskell98, hjpath, hjson, mtl, network, old-locale, parsec, pretty, process, random, regex-posix, safe, time, unix, uri, utf8-string

Files

+ COPYING view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU 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.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU 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 <http://www.gnu.org/licenses/>.++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:++    <program>  Copyright (C) <year>  <name of author>+    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+<http://www.gnu.org/licenses/>.++  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+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Hellnet.hs view
@@ -0,0 +1,45 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++module Hellnet where++import Codec.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++type Hash = [Octet]+type Chunk = BSL.ByteString+type Key = [Octet]+type Node = (String, Int)+type NodeID = Hash+type KeyID = Hash+type Signature = BSL.ByteString++hashSize :: Int+hashSize = 64++chunkSize :: Int+chunkSize = 256 * 1024++hashesPerChunk :: Int+hashesPerChunk = (chunkSize `div` hashSize) - 1++encKeySize :: Int+encKeySize = 32++numThreads :: Int+numThreads = 4
+ Hellnet/Crypto.hs view
@@ -0,0 +1,82 @@+module Hellnet.Crypto (+	decryptAsym+	, decryptSym+	, encryptAsym+	, encryptAsym'+	, encryptSym+	, Hellnet.Crypto.hash+	, signAsym+	, verifyAsym+	) where++import Codec.Crypto.RSA as RSA+import Codec.Encryption.AES as AES+import Codec.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.UTF8 as BUL+import qualified Data.ByteString.Char8 as BS8+import Data.Digest.SHA512 as SHA512+import Data.LargeWord+import System.Random+import qualified Data.Map as Map+import Hellnet+import Text.HJson as JSON+import Safe+import System.Posix.Files++decryptSym :: [Octet] -> BSL.ByteString -> BSL.ByteString+decryptSym key os = BSL.pack $  listToOctets $ map (AES.decrypt ((fromOctets 256 key) :: Word256)) $ listFromOctets $ BSL.unpack os++encryptSym :: [Octet] -> BSL.ByteString -> BSL.ByteString+encryptSym key os = BSL.pack $ listToOctets $ map (AES.encrypt ((fromOctets 256 key) :: Word256)) $ listFromOctets $ BSL.unpack os++instance Jsonable PublicKey where+	toJson pk = toJson $ Map.fromList [+		("public_size", fromIntegral $ public_size pk)+		, ("public_n", public_n pk)+		, ("public_e", public_e pk)+		]+	fromJson (JObject objMap) =+		let lookups = (Map.lookup "public_size" objMap+			, Map.lookup "public_n" objMap+			, Map.lookup "public_e" objMap) in+				case lookups of+					(Just (JNumber public_sizeR)+						, Just (JNumber public_nR)+						, Just (JNumber public_eR)+						) -> Just PublicKey { public_size = round public_sizeR, public_n = round public_nR, public_e = round public_eR }+					otherwise -> Nothing+	fromJson _ = Nothing++instance Jsonable PrivateKey where+	toJson pk = toJson $ Map.fromList [+		("private_size", fromIntegral $ private_size pk)+		, ("private_n", private_n pk)+		, ("private_d", private_d pk)+		]+	fromJson (JObject objMap) =+		let lookups = (Map.lookup "private_size" objMap+			, Map.lookup "private_n" objMap+			, Map.lookup "private_d" objMap) in+				case lookups of+					(Just (JNumber private_sizeR)+						, Just (JNumber private_nR)+						, Just (JNumber private_dR)+						) -> Just PrivateKey { private_size = round private_sizeR, private_n = round private_nR, private_d = round private_dR }+					otherwise -> Nothing+	fromJson _ = Nothing++encryptAsym :: PublicKey -> BSL.ByteString -> IO BSL.ByteString+encryptAsym pk msg = do+	gen <- newStdGen+	let (res, _) = RSA.encrypt gen pk msg+	return res++encryptAsym' :: RandomGen g => g -> PublicKey -> BSL.ByteString -> (BSL.ByteString, g)+encryptAsym' = RSA.encrypt+decryptAsym = RSA.decrypt+signAsym = RSA.sign+verifyAsym = RSA.verify++hash = SHA512.hash . BSL.unpack
+ Hellnet/Files.hs view
@@ -0,0 +1,44 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++module Hellnet.Files (insertFile, downloadFile) where++import Codec.Utils+import Data.Maybe+import Hellnet+import Hellnet.Storage+import Hellnet.URI+import Hellnet.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++insertFile :: Maybe Key -> FilePath -> IO [Octet]+insertFile encKey fname  = do+	conts <- BSL.readFile fname+	hsh <- insertFileContentsLazy encKey conts+	return hsh++getChunkAppendToFile :: Maybe Key -> FilePath -> Hash -> IO ()+getChunkAppendToFile encKey fname hsh = do+	conts <- getChunk encKey hsh+	maybe (error ("chunk not found in storage: " ++ (hashToHex hsh))) (BSL.appendFile fname) conts++downloadFile :: Maybe Key -> FilePath -> [Hash] -> IO ()+downloadFile encKey fname hs = do+	writeFile fname ""+	mapM (getChunkAppendToFile encKey fname) hs+	return ()
+ Hellnet/Meta.hs view
@@ -0,0 +1,76 @@+module Hellnet.Meta (Meta(..), fromByteString, toByteString, emptyMeta) where++import Codec.Crypto.RSA+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Data.ByteString.UTF8 as BU+import qualified Data.ByteString.Lazy.UTF8 as BUL+import qualified Data.Map as Map+import Data.Maybe+import Debug.Trace+import Hellnet+import Hellnet.Utils+import Hellnet.URI+import Text.HJson as Json+import Text.JSON.JPath++data Meta = Meta {+	keyID :: KeyID -- ^ Public key ID+	, metaName :: String -- ^ Meta name+	, timestamp :: Integer -- ^ Updated timestamp+	, contentURI :: HellnetURI -- ^ Meta content location+	, message :: Maybe BSL.ByteString -- ^ JSON as ByteString+	, signature :: Maybe Signature -- ^ Digital signature+	} deriving (Eq, Show)++emptyMeta = Meta {+	keyID = [] -- ^ Public key ID+	, metaName = "" -- ^ Meta name+	, timestamp = 0 -- ^ Updated timestamp+	, contentURI = ChunkURI [] Nothing Nothing -- ^ Meta content location+	, message = Nothing -- ^ JSON as ByteString+	, signature = Nothing -- ^ Digital signature+}++instance Jsonable Meta where+	fromJson v = let+		keyIDV = jPath' "key" v;+		timestampV = jPath' "updated" v;+		nameV = jPath' "name" v;+		contentV = jPath' "content" v in+			case [keyIDV, timestampV, nameV, contentV] of+				[	[JString keyHash]+					, [JNumber timestampF]+					, [JString nameS]+					, [JString contentURI]+					] -> maybe (Nothing) (\u -> Just $ Meta {+						keyID = hexToHash keyHash+						, metaName = nameS+						, timestamp = (round timestampF)+						, contentURI = u+						, signature = Nothing+						, message = Nothing}) (parseHellnetURI contentURI)+				otherwise -> Nothing+	toJson m = toJson $ Map.fromList [+		("key", toJson $ hashToHex $ keyID m)+		, ("updated", toJson $ timestamp m)+		, ("name", toJson $ metaName m)+		, ("content", toJson $ show $ contentURI m)+		]++fromByteString :: BSL.ByteString -> Maybe Meta+fromByteString bs = let+	(s, sigTail) = breakLazySubstring (BSL8.pack "\n\n") bs;+	sig = BSL.drop 2 sigTail+	js = BUL.toString s+	pM = either (const Nothing) (fromJson) $ Json.fromString js in+		case pM of+			Nothing -> Nothing+			Just preMeta -> Just $ preMeta { message = Just s, signature = Just sig}++toByteString :: Meta -> BSL.ByteString+toByteString m = case (message m, signature m) of+	(Just msg, Just sig) -> BSL.concat [msg, BSL8.pack "\n\n", sig]+	otherwise -> BSL.empty
+ Hellnet/Network.hs view
@@ -0,0 +1,367 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++module Hellnet.Network (+	addNode+	, fetchChunk+	, fetchChunks+	, fetchFile+	, fetchMeta+	, fetchMetaFromNode+	, fetchNodeListFromNode+	, findChunk+	, findChunks+	, findFile+	, findKey+	, findMetaContent+	, findMetaContent'+	, findMetaContentByName+	, findMetaContentByName'+	, findMetaValue+	, findURI+	, getContactLog+	, getNodesList+	, handshakeWithNode+	, queryNodeGet+	, updateNodeContactTime+	, verifyMeta+	, writeContactLog+	, writeNodesList+	) where++import Codec.Crypto.RSA as RSA+import Codec.Utils+import Control.Concurrent+import Control.Monad+import qualified Control.Exception as Ex+import qualified Data.ByteString.UTF8 as BU+import qualified Data.ByteString.Lazy.UTF8 as BUL+import Data.List+import Data.Maybe+import Data.Map (Map(..))+import qualified Data.Map as Map+import Debug.Trace+import Hellnet+import Hellnet.Crypto+import Hellnet.Meta as Meta+import Hellnet.Storage+import Hellnet.URI+import Hellnet.Utils+import Network.HTTP+import Network.HTTP.Base+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Data.ByteString.Lazy.UTF8 as BUL+import Random+import Safe+import System.IO.Error+import Text.HJson as JSON+import Text.JSON.JPath++getNodesList :: IO [Node]+getNodesList = do+	listfile <- getFile =<< toFullPath "nodelist"+	let nodes = maybe (Nothing) (readMay . BSL8.unpack) listfile+	return $ maybe [] (id) nodes++writeNodesList :: [Node] -> IO ()+writeNodesList ns = do+	storeFile "nodelist" $ BSL8.pack $ show ns++-- | adds node to list if it isn't already there, returns true+-- | otherwise returns false+addNode :: Node -> IO Bool+addNode node = do+	nL <- getNodesList+	if node `elem` nL then return False+		else do+			writeNodesList (node:nL)+			return True++-- | retrieves pieces using servers node list and returns list of pieces that are unavailable.+fetchChunks :: [Hash] -> IO [Hash]+fetchChunks cs = do+	nodes <- getNodesList+	decoys <- mapM (const genHash) [0..(((length cs) `div` 3) + 1)]+	let decoys' = decoys \\ cs+	chunks <- shuffle (cs ++ decoys')+	let todos = splitFor numThreads chunks+	workers <- mapM (forkChild) $ map (fetchChunksFromNodes nodes) todos+	nps <- mapM (takeMVar) workers+	return ((concat nps) \\ decoys')++-- | for usage in workers+fetchChunksFromNodes :: [Node] -> [Hash] -> IO [Hash]+fetchChunksFromNodes ns cs = do+	nodes <- shuffle ns+	let fs = map (fetchChunksFromNode) ns+	return =<< filtM fs cs++fetchChunksFromNode :: Node -> [Hash] -> IO [Hash]+fetchChunksFromNode s cs = filterM (fetchChunk' s) cs++fetchChunk' :: Node -> Hash -> IO Bool+fetchChunk' s p = do+	b <- fetchChunk s p+	return (not b)++-- | retrieves chunk using server, returns success status+fetchChunk :: Node -> Hash -> IO Bool+fetchChunk node p = do+	let chunkID = hashToHex p+	let reqString = "chunks/" ++ (take 2 chunkID) ++ "/" ++ (drop 2 chunkID)+	req <- queryNodeGet reqString node+	maybe (return False)+		(\r -> do+			chID <- insertChunk Nothing r+			if (chID == p) then+				return True+				else do+					purgeChunk chID+					return False+			) req++-- | find file, returns either not found chunks or file in lazy ByteString+findFile :: Maybe Key -> Hash -> IO (Either [Hash] BSL.ByteString)+findFile key hsh = do+	link <- findChunk key hsh+	maybe (return (Left [hsh])) (\l -> do+		res <- findFile' key l+		return res+		) link++findFile' :: Maybe Key -> Chunk -> IO (Either [Hash] BSL.ByteString)+findFile' key cs = do+	let chs = splitBslFor hashSize cs+	chs' <- findChunks key $ map (BSL.unpack) chs+	either (return . Left)+		(\c -> if (length chs) == (hashesPerChunk + 1) then do+			f <- findFile' key (last c)+			either (return . Left) (\ff -> return $ Right $ BSL.concat [BSL.concat $ init c, ff]) f+			else+			return $ Right $ BSL.concat c+		) chs'++-- | tries to locate chunks, returns either list of unavailable ones or list of chunks' content+findChunks :: Maybe Key -> [Hash] -> IO (Either [Hash] [Chunk])+findChunks key chs = do+	res <- mapM (getChunk key) chs+	let unavailable = map (fst) (filter ((== Nothing) . snd) (zip chs res))+	if null unavailable then+		return (Right (catMaybes res))+		else do+			fromNet <- fetchChunks unavailable+			if null fromNet then do+				chs' <- mapM (getChunk key) chs+				return (Right (catMaybes chs'))+				else+				return (Left fromNet)++findChunk :: Maybe Key -> Hash -> IO (Maybe Chunk)+findChunk key hsh = do+	fC <- findChunks key [hsh]+	either (const (return Nothing)) (return . Just . head) fC++-- | prepares file for collecting from storage, returns either list of unavailable chunks or unrolled filelink+fetchFile :: Maybe Key -> Hash -> IO (Either [Hash] [Hash])+fetchFile encKey hsh = do+	link <- findChunk encKey hsh+	maybe (return (Left [hsh])) (\l -> do+		res <- fetchFile' encKey l+		return res+		) link++fetchFile' :: Maybe Key -> Chunk -> IO (Either [Hash] [Hash])+fetchFile' encKey cs = do+	let chs = splitFor hashSize $ BSL.unpack cs+	stored <- filterM (isStored) chs+	chs' <- if stored /= chs then+		fetchChunks chs+		else+		return []+	if	not (null chs') then do+		return (Left chs')+		else+		if (length chs) == (hashesPerChunk + 1) then do+			c <- getChunk encKey $ last chs+			f <- fetchFile' encKey $ unjust c+			return (either (Left) (Right . ((++) (init chs))) f)+			else+			return (Right chs)++queryNodeGet :: String -> Node -> IO (Maybe BSL.ByteString)+queryNodeGet s node = do+	rep <- ((return . Just) =<< simpleHTTP (mkRequest GET $ mkUrl node s)) `catch` const (return Nothing)+	return $ maybe Nothing (either (const Nothing) (\rsp -> if rspCode rsp == (2,0,0) then Just (rspBody rsp) else Nothing)) rep++queryNodePost :: String -> [(String, String)] -> Node -> IO (Maybe BSL.ByteString)+queryNodePost s fields node = do+	let dat = BSL8.pack $ urlEncodeVars fields+	let url = mkUrl node s+	let request = (mkRequest POST url :: Request BSL.ByteString) {rqBody=dat, rqHeaders=[Header HdrContentType "application/x-www-form-urlencoded",+		Header HdrContentLength $ show $ BSL8.length dat]}+	rep <- ((return . Just) =<< simpleHTTP request) `catch` const (return Nothing)+	return $ maybe Nothing (either (const Nothing) (\rsp -> if rspCode rsp == (2,0,0) then Just (rspBody rsp) else Nothing)) rep++-- | Perform handshake with node. Return Left (error message) if connection failed or Right (handshake success)+handshakeWithNode :: Node -> IO (Either String Bool)+handshakeWithNode node = do+	sP <- getFile "serverport"+	result <- maybe (return $ Left "Server not running?") (\serverPort -> do+		res <- queryNodePost "handshake" [("port", BSL8.unpack serverPort)] node+		return $ maybe (Left "Failed to contact node") (\r -> Right $ (BSL8.unpack r) `elem` ["OK","EXISTS"]) res+		) sP+	return result++updateNodeContactTime :: String -> Integer -> IO ()+updateNodeContactTime hst tim = do+	tehLog <- getContactLog+	writeContactLog (Map.insert hst tim tehLog)++getContactLog :: IO (Map String Integer)+getContactLog = do+	fil <- getFile "contactlog"+	let res = maybe (Nothing) (readMay . BSL8.unpack) fil+	return $ maybe (Map.fromList []) (id) res++writeContactLog :: (Map String Integer) -> IO ()+writeContactLog l = storeFile "contactlog" (BSL8.pack $ show l)++-- | Verify meta's signature+-- | Returns Nothing if public key was not found or Just (check result)+verifyMeta :: Meta -> IO (Maybe Bool)+verifyMeta meta+	| isNothing (signature meta) = return $ Just False+	| isNothing (message meta) = return Nothing+	| otherwise = do+		let (Just msg, Just sig) = (message meta, signature meta)+		keyChunk <- findChunk Nothing (keyID meta)+		maybe (return Nothing) (\ch -> do+			let str = BUL.toString ch+			either (const (return Nothing)) (\j -> do+				maybe (return Nothing) (\k -> do+					return $ Just $ verifyAsym k msg sig+					) $ fromJson j+				) $ JSON.fromString str+			) keyChunk++fetchMeta :: KeyID -> String -> IO Bool+fetchMeta keyId mName = do+	nodes <- getNodesList >>= shuffle+	currentVersion <- getMeta keyId mName+	fetched <- fetchMetaFromNodes nodes currentVersion keyId mName+	case fetched of+		Nothing -> return False+		Just m -> do+			verified <- verifyMeta m+			case verified of+				Just True -> do+					storeMeta m+					return True+				otherwise -> return False++fetchMetaFromNodes :: [Node] -- ^ Nodes' list+	-> Maybe Meta -- ^ Current (latest) version of this meta+	-> KeyID -- ^ Meta's public key ID+	-> String -- ^ Meta name+	-> IO (Maybe Meta)+fetchMetaFromNodes (n:ns) currentVersion k s = do+	fetched <- fetchMetaFromNode n k s+	case fetched of+		Just a -> case currentVersion of+			Nothing -> fetchMetaFromNodes ns fetched k s+			Just b -> let newerVersion = if timestamp a > timestamp b then a else b+				in fetchMetaFromNodes ns (Just newerVersion) k s+		Nothing -> fetchMetaFromNodes ns currentVersion k s+fetchMetaFromNodes [] cv _ _ = return cv++fetchMetaFromNode :: Node -> KeyID -> String -> IO (Maybe Meta)+fetchMetaFromNode node keyId mName = do+	result <- queryNodeGet (intercalate "/" ["meta", hashToHex keyId, mName]) node+	maybe (return Nothing) (\bs -> do+		let meta = Meta.fromByteString bs+		return meta+		) result++findMetaContent :: Meta -> IO (Maybe Json)+findMetaContent m = do+	cont <- findMetaContent' m+	return $ case cont of+		Nothing -> Nothing+		Just s -> case JSON.fromString s of+			Left _ -> Nothing+			Right js -> Just js++findMetaContent' :: Meta -> IO (Maybe String)+findMetaContent' m = do+	cont <- findURI (contentURI m)+	return $ case cont of+		Nothing -> Nothing+		Just bs -> case JSON.fromString (BUL.toString bs) of+			Left _ -> Nothing+			Right js -> Just $ BUL.toString bs++findMetaContentByName :: KeyID -> String -> IO (Maybe Json)+findMetaContentByName kid mname = do+	metaM <- getMeta kid mname+	case metaM of+		Nothing -> return Nothing+		Just meta -> findMetaContent meta++findMetaContentByName' :: KeyID -> String -> IO (Maybe String)+findMetaContentByName' kid mname = do+	metaM <- getMeta kid mname+	case metaM of+		Nothing -> return Nothing+		Just meta -> findMetaContent' meta++findMetaValue :: KeyID -- ^ public key ID+	-> String -- ^ Meta name+	-> String -- ^ Meta JPath+	-> IO (Maybe [Json]) -- ^ Results or Nothing if meta was not found+findMetaValue keyId mName mPath = do+	meta <- getMeta keyId mName+	case meta of+		Nothing -> return Nothing+		Just m -> do+			cont <- findMetaContent m+			case cont of+				Nothing -> return Nothing+				Just j -> return $ Just $ jPath' mPath j++fetchNodeListFromNode :: Node -> IO [Node]+fetchNodeListFromNode node = do+	results <- queryNodeGet "/nodelist" node+	return (fromMaybe [] (maybe Nothing (readMay . BSL8.unpack) results))++findURI :: HellnetURI -> IO (Maybe BSL.ByteString)+findURI uri = case uri of+	(ChunkURI hsh key fname) -> do+		findChunk key hsh+	(FileURI hsh key fname) -> do+		fil <- findFile key hsh+		return $ either (const Nothing) (Just) fil+	otherwise -> return Nothing++findKey :: KeyID -> IO (Maybe PublicKey)+findKey kid = do+	ch <- findChunk Nothing kid+	return $ case ch of+		Nothing -> Nothing+		Just chunk -> either (const Nothing) (fromJson) $ JSON.fromString $ BUL.toString $ chunk
+ Hellnet/Storage.hs view
@@ -0,0 +1,256 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances #-}++module Hellnet.Storage (+	Hellnet.Storage.generateKeyPair+	, getChunk+	, getDirectory+	, getDirectory'+	, getFile+	, getFile'+	, getKeyAliases+	, getMeta+	, getMetaNames+	, getPrivateKey+	, hashToPath+	, insertChunk+	, insertData+	, insertFileContents+	, insertFileContentsLazy+	, isStored+	, purgeChunk+	, regenMeta+	, resolveKeyName+	, storeFile+	, storeFile'+	, storeKeyAliases+	, storeMeta+	, storePrivateKey+	, toFullPath+	) where++import Codec.Crypto.RSA as RSA+import Codec.Utils+import Control.Monad+import Data.Digest.SHA512 as SHA512+import Data.Foldable hiding (concat)+import Data.List+import Data.Maybe+import Hellnet+import Hellnet.Crypto+import Hellnet.Meta as Meta+import Hellnet.URI+import Hellnet.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BU+import qualified Data.ByteString.Lazy.UTF8 as BUL+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Map as Map+import System.Directory+import System.FilePath+import System.IO+import System.IO.Error+import System.Posix.Files+import System.Random+import Text.JSON.JPath+import Text.HJson as JSON++hashAndAppend :: Maybe Key -> Chunk -> Chunk -> IO Chunk+hashAndAppend encKey a b+	| BSL.null b = return a+	| otherwise = do+		bHash <- insertChunk encKey b+		return (BSL.append a $ BSL.pack bHash)++insertFileContentsLazy :: Maybe Key -> BSL.ByteString -> IO Hash+insertFileContentsLazy encKey bs = do+	let chunks = splitBslFor chunkSize bs+	chunkHashes <- mapM (insertChunk encKey) chunks+	let fileLink = splitFor hashesPerChunk chunkHashes+	let fileLinkChunks = Prelude.map (BSL.pack . flatten) fileLink+		where flatten a = Prelude.foldl1 (++) a+	fileLinkHead <- foldrM (hashAndAppend encKey) BSL.empty (fileLinkChunks)+	fileLinkHash <- insertChunk encKey fileLinkHead+	return fileLinkHash++insertFileContents :: Maybe Key -> BS.ByteString -> IO Hash+insertFileContents k b = insertFileContentsLazy k (BSL.pack $ BS.unpack b)++insertChunk :: Maybe Key -> Chunk -> IO Hash+insertChunk encKey ch = do+	let chunk = maybe (ch) ((flip encryptSym) ch) encKey+	let chunkDigestRaw = Hellnet.Crypto.hash chunk+	let chunkDigest = hashToHex chunkDigestRaw+	let fullPath = joinPath ["store", (Prelude.take 2 chunkDigest), (Prelude.drop 2 chunkDigest)]+	storeFile fullPath (chunk)+	return chunkDigestRaw++getChunk :: Maybe Key -> Hash -> IO (Maybe Chunk)+getChunk key hsh = do+	let chunkKey = hashToHex hsh+	fil <- getFile' ["store", (Prelude.take 2 chunkKey), (Prelude.drop 2 chunkKey)]+	return $ maybe Nothing (\conts -> Just (maybe (conts) (\k -> decryptSym k conts) key)) fil++toFullPath :: FilePath -> IO FilePath+toFullPath fpath = do+	dirEnv <- safeGetEnv "HELLNET_HOME"+	dir <- maybe (getAppUserDataDirectory "hellnet") (return) dirEnv+	return (joinPath [dir,fpath])++storeFile :: FilePath -> BSL.ByteString -> IO ()+storeFile fpath dat = do+	fullPath <- toFullPath fpath+	createDirectoryIfMissing True (dropFileName fullPath)+	(tmpf, tmph) <- openTempFile "/tmp" "helltemp"+	BSL.hPut tmph dat+	hFlush tmph+	hClose tmph+	let copyMove = do+		copyFile tmpf fullPath+		removeFile tmpf+	catch (renameFile tmpf fullPath) (\e -> copyMove)++storeFile' :: [String] -> BSL.ByteString -> IO ()+storeFile' fs = storeFile (joinPath fs)++getFile :: FilePath -> IO (Maybe BSL.ByteString)+getFile fpath = do+	fullPath <- toFullPath fpath+	catch (do+		conts <- BSL.readFile fullPath+		return (Just conts)) (const (return Nothing))++getFile' :: [String] -> IO (Maybe BSL.ByteString)+getFile' fs = getFile (joinPath fs)++purgeChunk :: Hash -> IO ()+purgeChunk hsh = do+	let hexHsh = hashToHex hsh+	fpath <- toFullPath (joinPath ["store", (Prelude.take 2 hexHsh), (Prelude.drop 2 hexHsh)])+	removeFile fpath++hashToPath :: Hash -> IO FilePath+hashToPath hsh = let hexHsh = hashToHex hsh in toFullPath (joinPath ["store", (Prelude.take 2 hexHsh), (Prelude.drop 2 hexHsh)])++isStored :: Hash -> IO Bool+isStored hsh = do+	fp <- hashToPath hsh+	return =<< (doesFileExist fp)++getMeta :: KeyID -> String -> IO (Maybe Meta)+getMeta keyId mName = do+	mFile <- getFile' ["meta", hashToHex keyId, mName]+	return $ maybe (Nothing) (Meta.fromByteString) mFile++getMetaNames :: KeyID -> IO [String]+getMetaNames keyid = do+	let path = ["meta", hashToHex keyid]+	res <- getDirectory' path+	return $ fromMaybe [] res++modifyMeta :: KeyID -- ^ public key ID+	-> String -- ^ Meta name+	-> String -- ^ Meta JPath+	-> (Json -> Json) -- ^ JSON modifier function+	-> Bool -- Whether meta was successfully modified+modifyMeta = undefined++storeMeta :: Meta -> IO ()+storeMeta m = storeFile' ["meta", hashToHex (keyID m), metaName m] $ Meta.toByteString m++getDirectory :: FilePath -> IO (Maybe [FilePath])+getDirectory fpath = do+	fullPath <- toFullPath fpath+	exists <- doesDirectoryExist fullPath+	if exists then do+		conts <- getDirectoryContents fullPath+		return $ Just $ conts \\ [".", ".."]+		else+		return Nothing++getDirectory' :: [FilePath] -> IO (Maybe [FilePath])+getDirectory' = getDirectory . joinPath++insertData :: Maybe Key -> BSL.ByteString -> IO HellnetURI+insertData encKey dat = if BSL.null $ BSL.drop (256 * 1024) dat then do+	hsh <- insertChunk encKey dat+	return $ ChunkURI hsh encKey Nothing+	else do+	hsh <- insertFileContentsLazy encKey dat+	return $ FileURI hsh encKey Nothing++storePrivateKey :: KeyID -> PrivateKey -> IO ()+storePrivateKey kid pKey = do+	let bs = BUL.fromString $ JSON.toString $ toJson pKey+	storeFile' ["privatekeys", hashToHex kid] bs+	fPath <- toFullPath $ joinPath ["privatekeys", hashToHex kid]+	setFileMode fPath $ unionFileModes ownerWriteMode ownerReadMode++generateKeyPair :: IO KeyID+generateKeyPair = do+	g <- newStdGen+	let (pub, priv, _) = RSA.generateKeyPair g 1024+	hsh <- insertChunk Nothing $ BUL.fromString $ JSON.toString $ toJson pub+	storePrivateKey hsh priv+	return hsh++getPrivateKey :: KeyID -> IO (Maybe PrivateKey)+getPrivateKey kid = do+	fil <- getFile' ["privatekeys", hashToHex kid]+	return $ case fil of+		Nothing -> Nothing+		Just k -> either (const Nothing) (fromJson) $ JSON.fromString $ BUL.toString k++regenMeta :: Meta -> IO (Maybe Meta)+regenMeta meta = do+	pKeyM <- getPrivateKey (keyID meta)+	case pKeyM of+		Nothing -> return Nothing+		Just pKey -> do+			updatedV <- getUnixTime+			let sigV = BUL.fromString "FOOBAR"+			let messageV = BUL.fromString $ toString $ toJson $ meta {timestamp = updatedV}+			let sigV = signAsym pKey messageV+			return $ Just $ meta {timestamp = updatedV, message = Just messageV, signature = Just sigV}++instance Jsonable (Map.Map String KeyID) where+	toJson m = JObject $ Map.map (stringifyValue) m where+		stringifyValue v = JString $ hashToHex v+	fromJson (JObject m) = Just $ Map.map (hexToHash . unStringifyValue) m where+		unStringifyValue (JString v) = v+		unStringifyValue _ = ""+	fromJson _ = Nothing++getKeyAliases :: IO (Map.Map String KeyID)+getKeyAliases = do+	aliasesFileM <- getFile "keyaliases"+	return $ case aliasesFileM of+		Nothing -> Map.empty+		Just aliasesFile -> case JSON.fromString $ BUL.toString aliasesFile of+			Left _ -> Map.empty+			Right j -> fromMaybe (Map.empty) $ fromJson j++storeKeyAliases :: Map.Map String KeyID -> IO ()+storeKeyAliases m = storeFile "keyaliases" $ BUL.fromString $ JSON.toString $ toJson m++resolveKeyName :: String -> IO KeyID+resolveKeyName name = do+	aliases <- getKeyAliases+	return $ fromMaybe (hexToHash name) $ Map.lookup name aliases
+ Hellnet/URI.hs view
@@ -0,0 +1,79 @@+module Hellnet.URI (parseHellnetURI, HellnetURI(..)) where++import Data.List+import Data.Maybe+import Hellnet+import Hellnet.Utils+import Safe+import Text.ParserCombinators.Parsec+import Text.Show+import Text.URI++data HellnetURI =+	ChunkURI Hash -- ^ Chunk hash+		(Maybe Key) -- ^ Encryption key+		(Maybe String) -- ^ File name+	| FileURI Hash -- ^ Filelink's start hash+		(Maybe Key) -- ^ Encryption key+		(Maybe String) -- ^ File name+	| MetaURI KeyID -- ^ Meta public key ID+		String -- ^ Meta name+		String -- ^ Meta path+		(Maybe Key) -- ^ Encryption key+		(Maybe String) -- ^ File name+			deriving (Eq)++instance Show HellnetURI where+	show u = show uri where+		uri = case u of+			(ChunkURI hsh key fname) -> nullURI {+				uriScheme = Just "hell"+				, uriRegName = Just "chunk"+				, uriPath = "/" ++ hashToHex hsh+				, uriQuery = let ps = ([] ++ maybeToPairs key (hashToHex) "key"  ++ maybeToPairs fname (id) "name") in if null ps then Nothing else Just (pairsToQuery ps)+				}+			(FileURI hsh key fname) -> nullURI {+				uriScheme = Just "hell"+				, uriRegName = Just "file"+				, uriPath = "/" ++ hashToHex hsh+				, uriQuery = let ps = ([] ++ maybeToPairs key (hashToHex) "key"  ++ maybeToPairs fname (id) "name") in if null ps then Nothing else Just (pairsToQuery ps)+				}+			(MetaURI kid mname mpath key fname) -> nullURI {+				uriScheme = Just "hell"+				, uriRegName = Just "meta"+				, uriPath = "/" ++ intercalate "/" [hashToHex kid, mname, mpath]+				, uriQuery = let ps = ([] ++ maybeToPairs key (hashToHex) "key"  ++ maybeToPairs fname (id) "name") in if null ps then Nothing else Just (pairsToQuery ps)+				}+	showList = showListWith (const show)++parseHellnetURI :: String -> Maybe HellnetURI+parseHellnetURI s = let+	parsed = parseURI s in+		maybe (Nothing) (parseHellnetURI') parsed++parseHellnetURI' :: URI -> Maybe HellnetURI+parseHellnetURI' u = let+	params = uriQueryItems u in+		if uriScheme u == Just "hell" then+			let key = maybe (Nothing) (Just . hexToHash) $ lookup "key" params;+				fname = lookup "name" params in+					case fromMaybe "" (uriRegName u) of+						"chunk" -> let hsh = hexToHash $ tailSafe $ uriPath u in+								Just $ ChunkURI hsh key fname+						"file" -> let hsh = hexToHash $ tailSafe $ uriPath u in+								Just $ FileURI hsh key fname+						"meta" -> let splitPath = explode '/' $ tailSafe $ uriPath u in+							if length splitPath < 2 then Nothing+								else+								let keyId = hexToHash $ head splitPath;+									metaName = splitPath !! 1;+									metaPath = intercalate "/" $ drop 2 splitPath in+										Just $ MetaURI keyId metaName metaPath key fname+						otherwise -> Nothing+			else Nothing++-- this is for constructing pairlists from maybes+maybeToPairs :: Maybe a -> (a -> String) -> String -> [(String, String)]+maybeToPairs a f name = maybe ([]) (\x -> [(uriescape name, uriescape (f x))]) a++uriescape = escapeString (okInQuery)
+ Hellnet/Utils.hs view
@@ -0,0 +1,178 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++module Hellnet.Utils (+	breakLazySubstring+	, discard+	, explode+	, filt+	, filtM+	, forkChild+	, genHash+	, genKey+	, getUnixTime+	, hashToHex+	, hexToHash+	, mkUrl+	, processOptions+	, relaxByteString+	, safeGetEnv+	, shuffle+	, simpleOpts+	, splitBsFor+	, splitBslFor+	, splitFor+	, splitInTwo+	, stringToOctets+	, unjust+	)  where++import Codec.Text.Raw+import Codec.Utils+import Control.Concurrent+import qualified Control.Exception as Ex+import Data.Foldable (foldlM)+import Data.LargeWord+import Data.List+import Data.Time+import Data.Word+import Hellnet+import Network.URI+import Numeric+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BU+import qualified Data.ByteString.Char8 as BS8 (unpack,pack)+import qualified Data.ByteString.Lazy as BSL+import Random+import Safe+import System.Environment+import System.IO.Error+import System.Locale+import Text.PrettyPrint.HughesPJ (render)++unjust :: (Maybe a) -> a+unjust (Just a) = a++hashToHex :: [Octet] -> String+hashToHex x = render (hexdumpBy "" 666 x)++hexToHash :: String -> [Octet]+hexToHash s = map (fst . head . readHex) (splitFor 2 s)++splitFor :: Int -> [a] -> [[a]]+splitFor _ [] = []+splitFor n xs = (take n xs) : (splitFor n (drop n xs))++-- splitBsFor :: Int -> BS -> [BS]+splitBsFor n xs = if BS.null xs then+	[]+	else+	(BS.take n xs) : (splitBsFor n (BS.drop n xs))++splitBslFor :: Int -> BSL.ByteString -> [BSL.ByteString]+splitBslFor n xs = if BSL.null xs then+	[]+	else+	(BSL.take (fromIntegral n) xs) : (splitBslFor n (BSL.drop (fromIntegral n) xs))++stringToOctets :: String -> [Octet]+stringToOctets s = BS.unpack $ BU.fromString s++-- | filters list of values through list of filters+filt fs xs = foldl (flip ($)) xs fs++-- | filt for monads+filtM fs xs = foldlM (flip ($)) xs fs++-- | shuffles list+shuffle :: [a] -> IO [a]+shuffle xs = do+	gen <- newStdGen+	let zipd = zip xs (take (length xs) ((randoms gen) :: [Float]))+	return (map (fst) (sortBy (\a b -> (snd a) `compare` (snd b)) zipd))++genHash :: IO Hash+genHash = do+	gen <- newStdGen+	return (map (fromIntegral) (take hashSize (randomRs (0,255) gen) :: [Int]))++-- | discards return value and to make matters worse, taint the result+discard :: a -> IO ()+discard _ = return ()++-- | generates random encryption key+genKey :: IO Key+genKey = do+	gen <- newStdGen+	return (map (fromIntegral) (take encKeySize (randomRs (0,255) gen) :: [Int]))++-- | parses command line options, splits flags and args+simpleOpts :: [String] -> ([String], [String])+simpleOpts ss = partition ((== '-') . head) ss++forkChild :: IO a -> IO (MVar a)+forkChild m = do+	v <- newEmptyMVar+	forkIO $ putMVar v =<< m+	return v++-- | Splits string in two by certain char+splitInTwo :: Char -> String -> (String, String)+splitInTwo c s = let broken = break (== c) s in ((fst broken), (tail $ snd broken))++-- | handy func for optParse+processOptions def = foldl (flip ($)) def++-- | Makes URI for node+mkUrl :: Node -> String -> Network.URI.URI+mkUrl (h,p) s = let (pa, qe) = break (== '?') s in URI { -- FIXME: blah!+	uriScheme = "http:"+	, uriAuthority = Just URIAuth {+		uriUserInfo = ""+		, uriRegName = h+		, uriPort = ':' : show p+		}+	, uriPath = pa+	, uriQuery = qe+	, uriFragment = ""+	}++-- | Good old explode()+explode :: Char -> String -> [String]+explode c = unfoldr (\s -> if null s then Nothing else Just (takeWhile (/=c) s, (tailSafe . dropWhile (/=c)) s))++-- | Get current UNIX time+getUnixTime :: IO Integer+getUnixTime = do+	tim <- getCurrentTime+	return $ read $ formatTime defaultTimeLocale "%s" tim++relaxByteString :: BS.ByteString -> BSL.ByteString+relaxByteString = BSL.pack . BS.unpack++breakLazySubstring :: BSL.ByteString -- ^ String to search for+               -> BSL.ByteString -- ^ String to search in+               -> (BSL.ByteString,BSL.ByteString) -- ^ Head and tail of string broken at substring+breakLazySubstring pat src = search 0 src+	where+		search n s+			| BSL.null s = (src,BSL.empty) -- not found+			| pat `BSL.isPrefixOf` s = (BSL.take n src,s)+			| otherwise = search (n+1) (BSL.tail s)++safeGetEnv :: String -> IO (Maybe String)+safeGetEnv name = catch (getEnv name >>= (return . Just)) (\e -> if isDoesNotExistError e then return Nothing else ioError e)
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runghc+import Distribution.Simple+main = defaultMain
+ hell-fsck.hs view
@@ -0,0 +1,37 @@+import qualified Data.ByteString as BS+import Hellnet+import Hellnet.Storage+import Data.Char+import Hellnet.Utils+import Data.Digest.SHA512 as SHA512+import Data.List+import System.Directory+import System.FilePath++filterDots = return . filter (all (isAlphaNum))++checkHashesInDirectory d = do+	putStr $ d ++ "..."+	dfp <- (toFullPath $ "store" </> d)+	dirConts <- getDirectoryContents dfp >>= filterDots+	mapM (checkChunk) $ zip (repeat d) dirConts++checkChunk (d, c) = do+	let hsh = hexToHash (d++c)+	fp <- toFullPath $ joinPath ["store", d, c]+	dat <- BS.readFile fp+	if BS.length dat > chunkSize then do+		putStrLn $ "\nChunk " ++ d ++ c ++" is too big, removing"+		removeFile fp+		else if SHA512.hash (BS.unpack dat) == hsh then+			return ()+			else do+			putStrLn $ "\nHash mismatch in " ++ d ++ c ++ ", removing"+			removeFile fp++main = do+	putStrLn "Checking store: "+	storePath <- toFullPath "store"+	storeConts <- getDirectoryContents storePath >>= filterDots+	mapM (checkHashesInDirectory) $ sort storeConts+	putStrLn "done"
+ hell-get.hs view
@@ -0,0 +1,73 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++import Control.Monad+import Data.List+import Hellnet+import Hellnet.Files+import Hellnet.Network+import Hellnet.Storage+import Hellnet.URI+import Hellnet.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import System.Console.GetOpt+import System.Directory+import System.Environment (getArgs)+import System.IO.Error+import System.Random++data Opts = Opts { deintegrateFile :: Bool }++options :: [OptDescr (Opts -> Opts)]+options = [+	Option ['d'] ["deintegrate"]+		(NoArg (\o -> o {deintegrateFile = True}) ) "Remove random chunks of file after fetching (increases deniability, decreases seedability)"+	]++defaultOptions = Opts { deintegrateFile = False }++main = do+	args <- getArgs+	let (optz, argz, errs) = getOpt Permute options args+	let opts = processOptions defaultOptions optz+	if Prelude.null argz then+		Prelude.putStrLn "Usage: hell-get <hell:// uri>"+		else do+			let uri = parseHellnetURI $ head argz+			case uri of+				Nothing -> fail "Incorrect URI"+				Just (ChunkURI hsh key fname) -> do+					let filename = maybe "/dev/stdout" (id) fname+					conts <- findChunk key hsh+					maybe (fail "Chunk not found in network") (BSL.writeFile filename) conts+				Just (FileURI hsh key fname) -> do+					let filename = maybe "/dev/stdout" (id) fname+					fil <- fetchFile key hsh+					either (\nf -> (error ("File couldn't be completely found in network. Not found chunks: " ++ (intercalate "\n" (map (hashToHex) nf))) )) (\hs -> do+					downloadFile key filename hs+					when (deintegrateFile opts) (do+						toDelete <- filterM (const $ do+							rnd <- randomIO :: IO Float+							return (rnd > 0.8)+							) hs+						mapM_ (purgeChunk) toDelete+						)+					return ()+					) fil+				otherwise -> fail "URI type not implemented yet"
+ hell-insert.hs view
@@ -0,0 +1,75 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++import Codec.Utils+import Control.Monad+import Hellnet+import Hellnet.Files+import Hellnet.Storage+import Hellnet.URI+import Hellnet.Utils+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Char8 as BS8 (unpack,pack)+import System.Console.GetOpt+import System.Environment (getArgs)+import System.FilePath+import System.IO++data Opts = Opts {encKey :: Maybe Key, encrypt :: Bool,  chunk :: Bool}++options :: [OptDescr (Opts -> Opts)]+options = [+	Option ['e'] ["encrypt"]+		(OptArg (\s o -> o {encKey = maybe (Nothing) (Just . hexToHash) s, encrypt = True}) "key") "Encrypt (optionally with specified key)",+	Option ['c'] ["chunk"]+		(NoArg (\o -> o {chunk = True})) "Add file as single chunk (Only for files < 256 kB)"+	]++defaultOptions = Opts {encKey = Nothing, encrypt = False, chunk = False}+++insertFilePrintHash :: Maybe [Octet] ->  FilePath -> IO ()+insertFilePrintHash encKey fname = do+	let filename = last (splitPath fname)+	hsh <- insertFile encKey fname+	let url = FileURI hsh encKey (Just filename)+	putStrLn $ show url++insertChunkPrintHash :: Maybe [Octet] -> FilePath -> IO ()+insertChunkPrintHash encKey fname = do+	let filename = last (splitPath fname)+	dat <- BSL.readFile fname+	when (not $ BSL.null $ BSL.drop (fromIntegral chunkSize) dat) (fail $ "Too large to insert as chunk: " ++ fname)+	hsh <- insertChunk encKey dat+	let+	let url = ChunkURI hsh encKey (Just filename)+	putStrLn $ show url++main = do+	args <- getArgs+ 	let (opts, argz, errs) = getOpt Permute options args+	let optz = processOptions defaultOptions opts+	when (or [(not . null $ errs), (null argz)]) (fail $ (usageInfo "Usage: hell-insert [file] file1 [file2...]" options) ++ concat errs)+	theKey <- if encrypt optz then+		maybe (genKey >>= return . Just) (return . Just) (encKey optz)+		else+		return Nothing+	if chunk optz then+		mapM (insertChunkPrintHash theKey) argz+		else+		mapM (insertFilePrintHash theKey) argz
+ hell-meta.hs view
@@ -0,0 +1,190 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++import Control.Monad+import qualified Data.ByteString.Lazy.UTF8 as BUL+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Map as Map+import Data.List+import Data.Maybe+import Hellnet+import Hellnet.Meta as Meta+import Hellnet.Network+import Hellnet.Storage+import Hellnet.Utils+import System.Console.GetOpt+import System.Environment+import System.Exit+import System.IO+import System.Cmd+import Text.HJson as JSON++data Opts = Opts {+	encrypt :: Bool,+	encKey :: Maybe Key,+	updateMeta :: Bool+	}++options :: [OptDescr (Opts -> Opts)]+options = [+	Option ['e'] ["encrypt"]+		(OptArg (\s o ->  o {encrypt = True, encKey = maybe (Nothing) (Just . hexToHash) s}) "key") "Encrypt content (optionally with specified key)",+	Option ['u'] ["update-meta"]+		(NoArg (\o -> o {updateMeta = True})) "Automatically update meta before retrieval"+	]++defaultOptions = Opts {+	encrypt = False,+	encKey = Nothing,+	updateMeta = False+	}++fetchMetaPrintResult :: KeyID -> String -> IO ()+fetchMetaPrintResult keyid mname = do+	result <- fetchMeta keyid mname+	let metaName = hashToHex (take 10 keyid) ++ ".../" ++ mname+	putStrLn $ case result of+		True -> "Meta "++ metaName ++" updated"+		False -> "Meta "++ metaName ++" unchanged"++main = do+	argz <- getArgs+	keyAliases <- getKeyAliases+	let (optz, args, errs) = getOpt Permute options argz+	let opts = processOptions defaultOptions optz+	theKey <- if encrypt opts then+		(return . Just) =<< (maybe (genKey) (return) $ encKey opts)+		else+		return Nothing+	case args of+		["update", keyidHex, mname] -> do+			keyid <- resolveKeyName keyidHex+			fetchMetaPrintResult keyid mname+		["update", keyidHex] -> do+			keyid <- resolveKeyName keyidHex+			allmeta <- getMetaNames keyid+			mapM_ (fetchMetaPrintResult keyid) allmeta+		["get", keyidHex, mname, mpath] -> do+			keyid <- resolveKeyName keyidHex+			when (updateMeta opts) (fetchMeta keyid mname >> return ())+			vs <- findMetaValue keyid mname mpath+			case vs of+				Nothing -> error "Meta not found"+				Just a -> mapM_ (putStrLn . JSON.toString) $ a+		["get", keyidHex, mname] -> do+			keyid <- resolveKeyName keyidHex+			when (updateMeta opts) (fetchMeta keyid mname >> return ())+			metaM <- getMeta keyid mname+			case metaM of+				Nothing -> error "Meta not found"+				Just meta -> do+					contentM <- findMetaContent' meta+					case contentM of+						Nothing -> error "Meta content not found"+						Just content -> putStr content+		["get", keyidHex] -> do+			keyid <- resolveKeyName keyidHex+			vs <- getMetaNames keyid+			mapM_ (putStrLn) vs+		["edit", keyidHex, mname] -> do+			keyid <- resolveKeyName keyidHex+			when (updateMeta opts) (fetchMeta keyid mname >> return ())+			v <- getMeta keyid mname+			case v of+				Nothing -> error "Meta not found"+				Just meta -> do+					cont <- findMetaContent' meta+					case cont of+						Nothing -> error "Meta content not found"+						Just cs -> do+							(fP, hdl) <- openTempFile "/tmp" "hellnetmeta"+							hPutStr hdl cs+							hClose hdl+							returnCode <- rawSystem "editor" [fP]+							case returnCode of+								ExitFailure i -> error $ "editor failed with code: " ++ show i+								ExitSuccess -> do+									modified <- readFile fP+									case JSON.fromString modified of+										Left errmsg -> error $ "JSON parsing error: " ++ errmsg+										Right _ -> do+											uri <- insertData theKey (BUL.fromString modified)+											newmetaM <- regenMeta $ meta {contentURI = uri}+											case newmetaM of+												Nothing -> error "Failed to re-sign meta"+												Just newmeta -> storeMeta newmeta+		["replace", keyidHex, mname] -> do+			keyid <- resolveKeyName keyidHex+			when (updateMeta opts) (fetchMeta keyid mname >> return ())+			contentV <- getContents+			case JSON.fromString contentV of+				Left errmsg -> error $ "JSON parsing error: " ++ errmsg+				Right _ -> do+					contentURIV <- insertData theKey (BUL.fromString contentV)+					newMetaM <- regenMeta Meta {+						contentURI = contentURIV,+						keyID = keyid,+						timestamp = 0,+						message = Nothing,+						signature = Nothing,+						metaName = mname+						}+					case newMetaM of+						Nothing -> error "Failed to sign meta"+						Just newMeta -> storeMeta newMeta+		["genkey"] -> do+			putStrLn "Generating keys..."+			keyID <- generateKeyPair+			putStrLn $ "Your key ID is " ++ hashToHex keyID+		["new", keyidHex, mname] -> do+			keyid <- resolveKeyName keyidHex+			emptyUri <- insertData theKey $ BUL.fromString "{}"+			newMetaM <- regenMeta Meta {+				contentURI = emptyUri,+				keyID = keyid,+				timestamp = 0,+				message = Nothing,+				signature = Nothing,+				metaName = mname+				}+			case newMetaM of+				Nothing -> error "Failed to sign meta"+				Just newMeta -> storeMeta newMeta+		["alias", "add", name, keyidHex] -> do+			keyid <- resolveKeyName keyidHex+			storeKeyAliases $ Map.insert name keyid keyAliases+		["alias", "rm", name] -> do+			storeKeyAliases $ Map.delete name keyAliases+		["alias", "show", name] -> do+			putStrLn $ maybe (error "Alias not found") (hashToHex) $ Map.lookup name keyAliases+		["alias", "list"] -> do+			mapM_ (\(k, v) -> putStrLn $ k ++ ": " ++ hashToHex v) $ Map.toList keyAliases+		otherwise ->+			let usageStrings =  [ "",+				"update <key id> [<meta name>]    -- Update selected meta or all metas signed by key",+				"get <key id>                     -- output all meta names signed by key, one per line",+				"get <key id> <meta name>         -- display contents of meta",+				"get <key id> <meta name> <jpath> -- Display results of running jPath expression on meta content, one result per line",+				"edit <key id> <meta name>        -- launches `editor` to edit specified meta",+				"replace <key id> <meta name>     -- replaces meta contents with data from STDIN.",+				"genkey                           -- generates new key pair, displays key ID",+				"new <key id> <meta name>         -- creates new empty meta",+				"alias add <name> <key id>        -- adds new key alias",+				"alias rm <name>                  -- removes key alias",+				"alias show <name>                -- resolves alias to key id",+				"alias list                       -- shows all the aliases with their names"+				] in error $ usageInfo (intercalate "\n" $ map ("hell-meta "++) usageStrings) options ++ concat errs
+ hell-nodes.hs view
@@ -0,0 +1,57 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++{-# LANGUAGE BangPatterns #-}++import Control.Monad+import qualified Data.Set as Set+import Hellnet.Network+import Hellnet.Storage+import System.Environment++node h p = ( h, read p :: Int )++main = do+	!nodes <- getNodesList+	args <- getArgs+	case args of+		["add", host, port] -> writeNodesList (node host port : nodes)+		["rm", host, port] -> writeNodesList (dropWhile (== node host port) nodes)+		["clear"] -> writeNodesList []+		["list"] -> print nodes+		["handshake", host, port] -> do+			result <- handshakeWithNode (node host port)+			case result of+				Left errmsg -> do+					putStrLn $ "Handshake failed: " ++ errmsg+				Right True  -> do+					putStrLn "Handshake successful"+					addNode $ node host port+					return ()+				Right False -> do+					putStrLn "Handshake failed: port not open?"+		["discover"] -> do+			when (null nodes) (fail "Need at least one pre-discovered node! Use `hell-nodes handshake` to manually discover one")+			moreNodes <- mapM (fetchNodeListFromNode) nodes+			!nodes2 <- getNodesList -- Because we need it after discovery, to reduce desync+			let nset = Set.unions $ map (Set.fromList) (moreNodes)+			putStrLn $ show (length $ Set.toList $ Set.difference nset $ Set.fromList nodes2) ++ " new nodes discovered"+			writeNodesList $ Set.toList $ Set.union (Set.fromList nodes2) nset+			putStrLn "Handshaking..."+			results <- mapM (handshakeWithNode) $ Set.toList nset+			putStrLn $ (show $ length $ filter (== Right True) results) ++ " out of " ++ (show $ length results) ++ " handshakes successful."+		otherwise -> putStrLn "Usage: hell-nodes {add,rm,clear,list, discover} <host> <port>"
+ hell-serve.hs view
@@ -0,0 +1,84 @@+--------------------------------------------------------------------------------+--     This file is part of Hellnet+--+--     Hellnet 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.+--+--     Hellnet 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 Hellnet.  If not, see <http://www.gnu.org/licenses/>.+--------------------------------------------------------------------------------++import Control.Monad.Trans+import Control.Monad+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.UTF8 as BUL+import Hellnet.Storage+import Hellnet.Network+import Network.HTTP.Lucu as Lucu+import Network+import System.Environment++handShakeOut = do+	fD <- inputForm(1000)+	host <- getRemoteAddr'+	let fMap = Map.fromList $ map (\fd -> (fdName fd, fdContent fd)) fD+	if "port" `Map.member` fMap && (not $ host `elem` ["localhost","127.0.0.1"]) then do+		let node = (host, read $ BUL.toString $ Map.findWithDefault (BUL.fromString "0") "port" fMap)+		res <- liftIO $ queryNodeGet "hello" node+		if res /= Nothing then do+			r <- liftIO $ addNode node+			if r then output "OK"+				else output "EXISTS"+			else output "FAIL"+		else+		setStatus NotAcceptable++main = do+	args <- getArgs+	let port = if length args == 0 then+		6666+		else+		fromIntegral (read (head args) :: Int) :: PortNumber+	let config = defaultConfig { cnfServerPort = PortNumber port };+	chunksPath <- toFullPath "store"+	metaPath <- toFullPath "meta"+	publicPath <- toFullPath "public.dsa"+	nodelistPath <- toFullPath "nodelist"+	let handShakeRes = ResourceDef {+		resUsesNativeThread = False,+		resIsGreedy = True,+		resGet = Nothing,+		resHead = Nothing,+		resPost = Just handShakeOut,+		resPut = Nothing,+		resDelete = Nothing+		}+	let helloRes = ResourceDef {+		resUsesNativeThread = False,+		resIsGreedy = True,+		resGet = Just $ output "Why, hello",+		resHead = Nothing,+		resPost = Nothing,+		resPut = Nothing,+		resDelete = Nothing+		}+	let resources = mkResTree [+		(["chunks"], staticDir chunksPath)+		,(["meta"], staticDir metaPath)+		,(["hello"], helloRes)+		,(["handshake"], handShakeRes)+		,(["nodelist"], staticFile nodelistPath)+		]+	storeFile "serverport" (BUL.fromString $ show port)+	putStrLn $ "Listening on port " ++ show port+	runHttpd config resources []
+ hellnet.cabal view
@@ -0,0 +1,39 @@+Name: hellnet+Version: 0.1+Synopsis: Simple, distributed, anonymous data sharing network.+Author: Voker57+Maintainer: voker57@gmail.com+Build-type: Simple+Cabal-version: >= 1.4+License: GPL-3+License-file: COPYING+Homepage: http://bitcheese.net/wiki/hellnet/hspawn+Description: Hellnet is a project to create simple, distributed, anonymous data sharing network.+Category: Network+library+ Exposed-Modules: Hellnet+  Hellnet.Crypto+  Hellnet.Files+  Hellnet.Utils+  Hellnet.Storage+  Hellnet.Meta+  Hellnet.Network+  Hellnet.URI+ Build-Depends: base >= 4.2 && < 5, Crypto, bytestring, pretty, filepath, directory, haskell98, HTTP >= 4000, hjpath >= 2.0, hjson >= 1.1, safe >= 0.2, old-locale, time, unix, parsec >= 3.0.0, random, process, utf8-string, RSA, uri >= 0.1.2+Executable hell-insert+ Main-is: hell-insert.hs+ Build-Depends: base+Executable hell-get+ Main-is: hell-get.hs+ Build-Depends: regex-posix+Executable hell-meta+ Main-is: hell-meta.hs+Executable hell-nodes+ Main-is: hell-nodes.hs+ Build-Depends: base+Executable hell-fsck+ Main-is: hell-fsck.hs+ Build-Depends: base+Executable hell-serve+ Main-is: hell-serve.hs+ Build-depends: Lucu >=0.4.1, network, mtl, containers