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 +674/−0
- Hellnet.hs +45/−0
- Hellnet/Crypto.hs +82/−0
- Hellnet/Files.hs +44/−0
- Hellnet/Meta.hs +76/−0
- Hellnet/Network.hs +367/−0
- Hellnet/Storage.hs +256/−0
- Hellnet/URI.hs +79/−0
- Hellnet/Utils.hs +178/−0
- Setup.hs +3/−0
- hell-fsck.hs +37/−0
- hell-get.hs +73/−0
- hell-insert.hs +75/−0
- hell-meta.hs +190/−0
- hell-nodes.hs +57/−0
- hell-serve.hs +84/−0
- hellnet.cabal +39/−0
+ 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