diff --git a/AGPL b/AGPL new file mode 100644 --- /dev/null +++ b/AGPL @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,13 @@ +keysafe (0.20160819) unstable; urgency=medium + + * First release of keysafe. This is not yet ready for production use. + * Network support is not yet implemented, but --store-local works for + testing with local data storage. + * Data backed up with keysafe version 0.* will not be able to be restored + by any later version! Once the data format stabalizes, keysafe version + 1 data will be supported by every later version. + * Argon2 hashes are not yet tuned for modern hardware, but only for my + laptop. So, cracking cost estimates may be low. To help with this + tuning, run `keysafe --bechmark` and send the output to me. + + -- Joey Hess Fri, 19 Aug 2016 19:41:06 -0400 diff --git a/CmdLine.hs b/CmdLine.hs new file mode 100644 --- /dev/null +++ b/CmdLine.hs @@ -0,0 +1,108 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module CmdLine where + +import Types +import Tunables +import qualified Gpg +import Options.Applicative +import qualified Data.ByteString.UTF8 as BU8 +import System.Directory + +data CmdLine = CmdLine + { mode :: Maybe Mode + , secretkeysource :: Maybe SecretKeySource + , localstorage :: Bool + , gui :: Bool + , testMode :: Bool + , customShareParams :: Maybe ShareParams + } + +data Mode = Backup | Restore | UploadQueued | Benchmark + deriving (Show) + +parse :: Parser CmdLine +parse = CmdLine + <$> optional (backup <|> restore <|> uploadqueued <|> benchmark) + <*> optional (gpgswitch <|> fileswitch) + <*> localstorageswitch + <*> guiswitch + <*> testmodeswitch + <*> optional (ShareParams <$> totalobjects <*> neededobjects) + where + backup = flag' Backup + ( long "backup" + <> help "Store a secret key in keysafe." + ) + restore = flag' Restore + ( long "restore" + <> help "Retrieve a secret key from keysafe." + ) + uploadqueued = flag' UploadQueued + ( long "uploadqueued" + <> help "Upload any data to servers that was queued by a previous --backup run." + ) + benchmark = flag' Benchmark + ( long "benchmark" + <> help "Benchmark speed of keysafe's cryptographic primitives." + ) + gpgswitch = GpgKey . KeyId . BU8.fromString <$> strOption + ( long "gpgkeyid" + <> metavar "KEYID" + <> help "Specify keyid of gpg key to back up or restore. (When this option is used to back up a key, it must also be used at restore time.)" + ) + fileswitch = KeyFile <$> strOption + ( long "keyfile" + <> metavar "FILE" + <> help "Specify secret key file to back up or restore. (The same filename must be used to restore a key as was used to back it up.)" + ) + localstorageswitch = switch + ( long "store-local" + <> help "Store data locally, in ~/.keysafe/objects/local/. (The default is to store data in the cloud.)" + ) + testmodeswitch = switch + ( long "testmode" + <> help "Avoid using expensive cryptographic operations to secure data. Use for testing only, not with real secret keys." + ) + guiswitch = switch + ( long "gui" + <> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise." + ) + totalobjects = option auto + ( long "totalshares" + <> metavar "M" + <> help ("Configure the number of shares to split encrypted secret key into. Default: " ++ show (totalObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)") + ) + neededobjects = option auto + ( long "neededshares" + <> metavar "N" + <> help ("Configure the number of shares needed to restore. Default: " ++ show (neededObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)") + ) + +get :: IO CmdLine +get = execParser opts + where + opts = info (helper <*> parse) + ( fullDesc + <> header "keysafe - securely back up secret keys" + ) + +-- | When a mode is not specified on the command line, +-- default to backing up if a secret key exists, and otherwise restoring. +selectMode :: CmdLine -> IO Mode +selectMode cmdline = case mode cmdline of + Just m -> return m + Nothing -> case secretkeysource cmdline of + Just (KeyFile f) -> present <$> doesFileExist f + _ -> present . not . null <$> Gpg.listSecretKeys + where + present True = Backup + present False = Restore + +customizeShareParams :: CmdLine -> Tunables -> Tunables +customizeShareParams cmdline t = case customShareParams cmdline of + Nothing -> t + Just ps -> t { shareParams = ps } diff --git a/Cost.hs b/Cost.hs new file mode 100644 --- /dev/null +++ b/Cost.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Cost ( + module Cost, + module Types.Cost +) where + +import Types.Cost + +-- | Cost in seconds, with the type of hardware needed. +totalCost :: Cost op -> (Seconds, [UsingHardware]) +totalCost (CPUCost s) = (s, [UsingCPU]) + +raiseCostPower :: Cost c -> Entropy e -> Cost c +raiseCostPower c (Entropy e) = adjustCost c (* 2^e) + +adjustCost :: Cost c -> (Seconds -> Seconds) -> Cost c +adjustCost (CPUCost s) f = CPUCost (f s) + +castCost :: Cost a -> Cost b +castCost (CPUCost s) = CPUCost s + +-- | CostCalc for a brute force linear search through an entropy space +-- in which each step entails paying a cost. +-- +-- On average, the solution will be found half way through. +-- This is equivilant to one bit less of entropy. +bruteForceLinearSearch :: Cost step -> CostCalc BruteForceOp t +bruteForceLinearSearch stepcost e = + castCost stepcost `raiseCostPower` reduceEntropy e 1 + +-- | Estimate of cost of a brute force attack. +estimateBruteforceOf :: Bruteforceable t a => t -> Entropy a -> Cost BruteForceOp +estimateBruteforceOf t e = getBruteCostCalc t e + +data DataCenterPrice = DataCenterPrice + { instanceCpuCores :: Integer + , instanceCostPerHour :: Cents + } + +-- August 2016 spot pricing: 36 CPU core c4.8xlarge at 33c/hour +spotAWS :: DataCenterPrice +spotAWS = DataCenterPrice + { instanceCpuCores = 36 + , instanceCostPerHour = Cents 33 + } + +-- | Estimate of cost of brute force attack using a datacenter. +-- +-- Note that this assumes that CPU cores and GPU cores are of equal number, +-- which is unlikely to be the case; typically there will be many more +-- cores than GPUs. So, this underestimates the price to brute force +-- operations which run faster on GPUs. +estimateAttackCost :: DataCenterPrice -> Cost BruteForceOp -> Dollars +estimateAttackCost dc opcost = centsToDollars $ costcents + where + (Seconds cpuseconds) = fst (totalCost opcost) + cpuyears = cpuseconds `div` (60*60*24*365) + costpercpuyear = Cents $ + fromIntegral (instanceCostPerHour dc) * 24 * 365 + `div` instanceCpuCores dc + costcents = Cents cpuyears * costpercpuyear + +newtype Cents = Cents Integer + deriving (Num, Integral, Enum, Real, Ord, Eq, Show) + +newtype Dollars = Dollars Integer + deriving (Num, Integral, Enum, Real, Ord, Eq) + +instance Show Dollars where + show (Dollars n) = go + [ (1000000000000, "trillion") + , (1000000000, "billion") + , (1000000, "million") + , (1000, "thousand") + ] + where + go [] = "$" ++ show n + go ((d, u):us) + | n >= d = + let n' = n `div` d + in "$" ++ show n' ++ " " ++ u + | otherwise = go us + +centsToDollars :: Cents -> Dollars +centsToDollars (Cents c) = Dollars (c `div` 100) + +type Year = Integer + +-- | Apply Moore's law to show how a cost might vary over time. +costOverTime :: Dollars -> Year -> [(Dollars, Year)] +costOverTime (Dollars currcost) thisyear = + (Dollars currcost, thisyear) : map calc otheryears + where + otheryears = [thisyear+1, thisyear+5, thisyear+10] + calc y = + let monthdelta = (fromIntegral ((y * 12) - (thisyear * 12))) :: Double + cost = floor $ fromIntegral currcost / 2 ** (monthdelta / 18) + in (Dollars cost, y) + +costOverTimeTable :: Dollars -> Year -> [String] +costOverTimeTable cost thisyear = go [] thisyear $ costOverTime cost thisyear + where + go t _ [] = reverse t + go t yprev ((c, y):ys) = + let s = " in " ++ show y ++ ": " ++ show c + in if yprev < y - 1 + then go (s:" ...":t) y ys + else go (s:t) y ys diff --git a/Crypto/Argon2.hs b/Crypto/Argon2.hs new file mode 100644 --- /dev/null +++ b/Crypto/Argon2.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE RecordWildCards #-} + +{-| + +"Crypto.Argon2" provides bindings to the + of Argon2, +the password-hashing function that won the +. + +The main entry points to this module are 'hashEncoded', which produces a +crypt-like ASCII output; and 'hash' which produces a 'BS.ByteString' (a stream +of bytes). Argon2 is a configurable hash function, and can be configured by +supplying a particular set of 'HashOptions' - 'defaultHashOptions' should provide +a good starting point. See 'HashOptions' for more documentation on the particular +parameters that can be adjusted. + +For access directly to the C interface, see "Crypto.Argon2.FFI". + +-} + +{- + +Copyright (c) 2016, Ollie Charles + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ollie Charles nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + -} + +module Crypto.Argon2 + ( -- * Computing hashes + hashEncoded, hash, + -- * Verification + verify, + -- * Configuring hashing + HashOptions(..), Argon2Variant(..), defaultHashOptions, + -- * Exceptions + Argon2Exception(..)) + where + +import GHC.Generics (Generic) +import Control.Exception +import Data.Typeable +import Foreign +import Foreign.C +import System.IO.Unsafe (unsafePerformIO) +import qualified Crypto.Argon2.FFI as FFI +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- | Which variant of Argon2 to use. You should choose the variant that is most +-- applicable to your intention to hash inputs. +data Argon2Variant + = Argon2i -- ^ Argon2i uses data-independent memory access, which is preferred + -- for password hashing and password-based key derivation. Argon2i + -- is slower as it makes more passes over the memory to protect from + -- tradeoff attacks. + | Argon2d -- ^ Argon2d is faster and uses data-depending memory access, which + -- makes it suitable for cryptocurrencies and applications with no + -- threats from side-channel timing attacks. + deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum) + +-- | Parameters that can be adjusted to change the runtime performance of the +-- hashing. +data HashOptions = + HashOptions {hashIterations :: !Word32 -- ^ The time cost, which defines the amount of computation realized and therefore the execution time, given in number of iterations. + -- + -- 'FFI.ARGON2_MIN_TIME' <= 'hashIterations' <= 'FFI.ARGON2_MAX_TIME' + ,hashMemory :: !Word32 -- ^ The memory cost, which defines the memory usage, given in kibibytes. + -- + -- max 'FFI.ARGON2_MIN_MEMORY' (8 * 'hashParallelism') <= 'hashMemory' <= 'FFI.ARGON2_MAX_MEMORY' + ,hashParallelism :: !Word32 -- ^ A parallelism degree, which defines the number of parallel threads. + -- + -- 'FFI.ARGON2_MIN_LANES' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_LANES' && 'FFI.ARGON_MIN_THREADS' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_THREADS' + ,hashVariant :: !Argon2Variant -- ^ Which version of Argon2 to use. + } + deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable) + +-- | A set of default 'HashOptions', taken from the @argon2@ executable. +-- +-- @ +-- 'defaultHashOptions' :: 'HashOptions' +-- 'defaultHashOptions' = +-- 'HashOptions' {'hashIterations' = 1 +-- ,'hashMemory' = 2 ^ 17 +-- ,'hashParallelism' = 4 +-- ,'hashVariant' = 'Argon2i'} +-- @ +defaultHashOptions :: HashOptions +defaultHashOptions = + HashOptions {hashIterations = 1 + ,hashMemory = 2 ^ (17 :: Integer) + ,hashParallelism = 4 + ,hashVariant = Argon2i} + +-- | Encode a password with a given salt and 'HashOptions' and produce a textual +-- encoding of the result. +hashEncoded :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate. + -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes. + -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes. + -> T.Text -- ^ The encoded password hash. +hashEncoded options password salt = + unsafePerformIO + (hashEncoded' options password salt FFI.argon2i_hash_encoded FFI.argon2d_hash_encoded) + +-- | Encode a password with a given salt and 'HashOptions' and produce a stream +-- of bytes. +hash :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate. + -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes. + -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes. + -> BS.ByteString -- ^ The un-encoded password hash. +hash options password salt = + unsafePerformIO (hash' options password salt FFI.argon2i_hash_raw FFI.argon2d_hash_raw) + +variant :: a -> a -> Argon2Variant -> a +variant a _ Argon2i = a +variant _ b Argon2d = b +{-# INLINE variant #-} + +-- | Not all 'HashOptions' can necessarily be used to compute hashes. If you +-- supply invalid 'HashOptions' (or hashing otherwise fails) a 'Argon2Exception' +-- will be throw. +data Argon2Exception + = -- | The length of the supplied password is outside the range supported by @libargon2@. + Argon2PasswordLengthOutOfRange !Word64 -- ^ The erroneous length. + | -- | The length of the supplied salt is outside the range supported by @libargon2@. + Argon2SaltLengthOutOfRange !Word64 -- ^ The erroneous length. + | -- | Either too much or too little memory was requested via 'hashMemory'. + Argon2MemoryUseOutOfRange !Word32 -- ^ The erroneous 'hashMemory' value. + | -- | Either too few or too many iterations were requested via 'hashIterations'. + Argon2IterationCountOutOfRange !Word32 -- ^ The erroneous 'hashIterations' value. + | -- | Either too much or too little parallelism was requested via 'hasParallelism'. + Argon2ParallelismOutOfRange !Word32 -- ^ The erroneous 'hashParallelism' value. + | -- | An unexpected exception was throw. Please ! + Argon2Exception !Int32 -- ^ The =libargon2= error code. + deriving (Typeable, Show) + +instance Exception Argon2Exception + +type Argon2Encoded = Word32 -> Word32 -> Word32 -> CString -> Word64 -> CString -> Word64 -> Word64 -> CString -> Word64 -> IO Int32 + +hashEncoded' :: HashOptions + -> BS.ByteString + -> BS.ByteString + -> Argon2Encoded + -> Argon2Encoded + -> IO T.Text +hashEncoded' options@HashOptions{..} password salt argon2i argon2d = + do let saltLen = fromIntegral (BS.length salt) + passwordLen = fromIntegral (BS.length password) + outLen = + (BS.length salt * 4 + 32 * 4 + + length ("$argon2x$m=,t=,p=$$" :: String) + + 3 * 3) + out <- mallocBytes outLen + res <- + BS.useAsCString password $ + \password' -> + BS.useAsCString salt $ + \salt' -> + argon2 hashIterations + hashMemory + hashParallelism + password' + passwordLen + salt' + saltLen + 64 + out + (fromIntegral outLen) + handleSuccessCode res options password salt + fmap T.decodeUtf8 (BS.packCString out) + where argon2 = variant argon2i argon2d hashVariant + +type Argon2Unencoded = Word32 -> Word32 -> Word32 -> CString -> Word64 -> CString -> Word64 -> CString -> Word64 -> IO Int32 + +hash' :: HashOptions + -> BS.ByteString + -> BS.ByteString + -> Argon2Unencoded + -> Argon2Unencoded + -> IO BS.ByteString +hash' options@HashOptions{..} password salt argon2i argon2d = + do let saltLen = fromIntegral (BS.length salt) + passwordLen = fromIntegral (BS.length password) + outLen = 512 + out <- mallocBytes outLen + res <- + BS.useAsCString password $ + \password' -> + BS.useAsCString salt $ + \salt' -> + argon2 hashIterations + hashMemory + hashParallelism + password' + passwordLen + salt' + saltLen + out + (fromIntegral outLen) + handleSuccessCode res options password salt + BS.packCString out + where argon2 = variant argon2i argon2d hashVariant + +handleSuccessCode :: Int32 + -> HashOptions + -> BS.ByteString + -> BS.ByteString + -> IO () +handleSuccessCode res HashOptions{..} password salt = + let saltLen = fromIntegral (BS.length salt) + passwordLen = fromIntegral (BS.length password) + in case res of + a + | a `elem` [FFI.ARGON2_OK] -> return () + | a `elem` [FFI.ARGON2_SALT_TOO_SHORT,FFI.ARGON2_SALT_TOO_LONG] -> + throwIO (Argon2SaltLengthOutOfRange saltLen) + | a `elem` [FFI.ARGON2_PWD_TOO_SHORT,FFI.ARGON2_PWD_TOO_LONG] -> + throwIO (Argon2PasswordLengthOutOfRange passwordLen) + | a `elem` [FFI.ARGON2_TIME_TOO_SMALL,FFI.ARGON2_TIME_TOO_LARGE] -> + throwIO (Argon2IterationCountOutOfRange hashIterations) + | a `elem` [FFI.ARGON2_MEMORY_TOO_LITTLE,FFI.ARGON2_MEMORY_TOO_MUCH] -> + throwIO (Argon2MemoryUseOutOfRange hashMemory) + | a `elem` + [FFI.ARGON2_LANES_TOO_FEW + ,FFI.ARGON2_LANES_TOO_MANY + ,FFI.ARGON2_THREADS_TOO_FEW + ,FFI.ARGON2_THREADS_TOO_MANY] -> + throwIO (Argon2ParallelismOutOfRange hashParallelism) + | otherwise -> throwIO (Argon2Exception a) + +-- | Verify that a given password could result in a given hash output. +-- Automatically determines the correct 'HashOptions' based on the +-- encoded hash (as produced by 'hashEncoded'). +verify + :: T.Text -> BS.ByteString -> Bool +verify encoded password = + unsafePerformIO + (BS.useAsCString password $ + \pwd -> + BS.useAsCString (T.encodeUtf8 encoded) $ + \enc -> + do res <- + (variant FFI.argon2i_verify FFI.argon2d_verify v) enc + pwd + (fromIntegral (BS.length password)) + return (res == FFI.ARGON2_OK)) + where v | T.pack "$argon2i" `T.isPrefixOf` encoded = Argon2i + | otherwise = Argon2d diff --git a/Crypto/Argon2/FFI.hsc b/Crypto/Argon2/FFI.hsc new file mode 100644 --- /dev/null +++ b/Crypto/Argon2/FFI.hsc @@ -0,0 +1,127 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE PatternSynonyms #-} + +module Crypto.Argon2.FFI where + +#include +#include + +{- + +Copyright (c) 2016, Ollie Charles + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ollie Charles nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + -} + +import Foreign +import Foreign.C + +foreign import ccall unsafe "argon2.h argon2i_hash_encoded" argon2i_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (# type const size_t) -> (#type const size_t) -> CString -> (#type const size_t) -> IO (#type int) + +foreign import ccall unsafe "argon2.h argon2i_hash_raw" argon2i_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (#type size_t) -> Ptr c -> (#type const size_t) -> IO (#type int) + +foreign import ccall unsafe "argon2.h argon2d_hash_encoded" argon2d_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (# type const size_t) -> (#type const size_t) -> CString -> (#type const size_t) -> IO (#type int) + +foreign import ccall unsafe "argon2.h argon2d_hash_raw" argon2d_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> (#type const size_t) -> Ptr b -> (#type size_t) -> Ptr c -> (#type const size_t) -> IO (#type int) + +foreign import ccall unsafe "argon2.h argon2i_verify" argon2i_verify :: CString -> Ptr a -> (#type const size_t) -> IO (#type int) + +foreign import ccall unsafe "argon2.h argon2d_verify" argon2d_verify :: CString -> Ptr a -> (#type const size_t) -> IO (#type int) + +pattern ARGON2_OK = (#const ARGON2_OK) +pattern ARGON2_OUTPUT_PTR_NULL = (#const ARGON2_OUTPUT_PTR_NULL) +pattern ARGON2_OUTPUT_TOO_SHORT = (#const ARGON2_OUTPUT_TOO_SHORT) +pattern ARGON2_OUTPUT_TOO_LONG = (#const ARGON2_OUTPUT_TOO_LONG) +pattern ARGON2_PWD_TOO_SHORT = (#const ARGON2_PWD_TOO_SHORT) +pattern ARGON2_PWD_TOO_LONG = (#const ARGON2_PWD_TOO_LONG) +pattern ARGON2_SALT_TOO_SHORT = (#const ARGON2_SALT_TOO_SHORT) +pattern ARGON2_SALT_TOO_LONG = (#const ARGON2_SALT_TOO_LONG) +pattern ARGON2_AD_TOO_SHORT = (#const ARGON2_AD_TOO_SHORT) +pattern ARGON2_AD_TOO_LONG = (#const ARGON2_AD_TOO_LONG) +pattern ARGON2_SECRET_TOO_SHORT = (#const ARGON2_SECRET_TOO_SHORT) +pattern ARGON2_SECRET_TOO_LONG = (#const ARGON2_SECRET_TOO_LONG) +pattern ARGON2_TIME_TOO_SMALL = (#const ARGON2_TIME_TOO_SMALL) +pattern ARGON2_TIME_TOO_LARGE = (#const ARGON2_TIME_TOO_LARGE) +pattern ARGON2_MEMORY_TOO_LITTLE = (#const ARGON2_MEMORY_TOO_LITTLE) +pattern ARGON2_MEMORY_TOO_MUCH = (#const ARGON2_MEMORY_TOO_MUCH) +pattern ARGON2_LANES_TOO_FEW = (#const ARGON2_LANES_TOO_FEW) +pattern ARGON2_LANES_TOO_MANY = (#const ARGON2_LANES_TOO_MANY) +pattern ARGON2_PWD_PTR_MISMATCH = (#const ARGON2_PWD_PTR_MISMATCH) +pattern ARGON2_SALT_PTR_MISMATCH = (#const ARGON2_SALT_PTR_MISMATCH) +pattern ARGON2_SECRET_PTR_MISMATCH = (#const ARGON2_SECRET_PTR_MISMATCH) +pattern ARGON2_AD_PTR_MISMATCH = (#const ARGON2_AD_PTR_MISMATCH) +pattern ARGON2_MEMORY_ALLOCATION_ERROR = (#const ARGON2_MEMORY_ALLOCATION_ERROR) +pattern ARGON2_FREE_MEMORY_CBK_NULL = (#const ARGON2_FREE_MEMORY_CBK_NULL) +pattern ARGON2_ALLOCATE_MEMORY_CBK_NULL = (#const ARGON2_ALLOCATE_MEMORY_CBK_NULL) +pattern ARGON2_INCORRECT_PARAMETER = (#const ARGON2_INCORRECT_PARAMETER) +pattern ARGON2_INCORRECT_TYPE = (#const ARGON2_INCORRECT_TYPE) +pattern ARGON2_OUT_PTR_MISMATCH = (#const ARGON2_OUT_PTR_MISMATCH) +pattern ARGON2_THREADS_TOO_FEW = (#const ARGON2_THREADS_TOO_FEW) +pattern ARGON2_THREADS_TOO_MANY = (#const ARGON2_THREADS_TOO_MANY) +pattern ARGON2_MISSING_ARGS = (#const ARGON2_MISSING_ARGS) +pattern ARGON2_ENCODING_FAIL = (#const ARGON2_ENCODING_FAIL) +pattern ARGON2_DECODING_FAIL = (#const ARGON2_DECODING_FAIL) + +pattern ARGON2_MIN_LANES = (#const ARGON2_MIN_LANES) +pattern ARGON2_MAX_LANES = (#const ARGON2_MAX_LANES) + +pattern ARGON2_MIN_THREADS = (#const ARGON2_MIN_THREADS) +pattern ARGON2_MAX_THREADS = (#const ARGON2_MAX_THREADS) + +pattern ARGON2_SYNC_POINTS = (#const ARGON2_SYNC_POINTS) + +pattern ARGON2_MIN_OUTLEN = (#const ARGON2_MIN_OUTLEN) +pattern ARGON2_MAX_OUTLEN = (#const ARGON2_MAX_OUTLEN) + +pattern ARGON2_MIN_MEMORY = (#const ARGON2_MIN_MEMORY) + +pattern ARGON2_MAX_MEMORY_BITS = (#const ARGON2_MAX_MEMORY_BITS) +pattern ARGON2_MAX_MEMORY = (#const ARGON2_MAX_MEMORY) + +pattern ARGON2_MIN_TIME = (#const ARGON2_MIN_TIME) +pattern ARGON2_MAX_TIME = (#const ARGON2_MAX_TIME) + +pattern ARGON2_MIN_PWD_LENGTH = (#const ARGON2_MIN_PWD_LENGTH) +pattern ARGON2_MAX_PWD_LENGTH = (#const ARGON2_MAX_PWD_LENGTH) + +pattern ARGON2_MIN_AD_LENGTH = (#const ARGON2_MIN_AD_LENGTH) +pattern ARGON2_MAX_AD_LENGTH = (#const ARGON2_MAX_AD_LENGTH) + +pattern ARGON2_MIN_SALT_LENGTH = (#const ARGON2_MIN_SALT_LENGTH) +pattern ARGON2_MAX_SALT_LENGTH = (#const ARGON2_MAX_SALT_LENGTH) + +pattern ARGON2_MIN_SECRET = (#const ARGON2_MIN_SECRET) +pattern ARGON2_MAX_SECRET = (#const ARGON2_MAX_SECRET) + +pattern ARGON2_FLAG_CLEAR_PASSWORD = (#const ARGON2_FLAG_CLEAR_PASSWORD) +pattern ARGON2_FLAG_CLEAR_SECRET = (#const ARGON2_FLAG_CLEAR_SECRET) +pattern ARGON2_FLAG_CLEAR_MEMORY = (#const ARGON2_FLAG_CLEAR_MEMORY) +pattern ARGON2_DEFAULT_FLAGS = (#const ARGON2_DEFAULT_FLAGS) diff --git a/Crypto/SecretSharing/Internal.hs b/Crypto/SecretSharing/Internal.hs new file mode 100644 --- /dev/null +++ b/Crypto/SecretSharing/Internal.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} +----------------------------------------------------------------------------- +-- | +-- Module : Crypto.SecretSharing.Internal +-- Copyright : Peter Robinson 2014 +-- License : LGPL +-- +-- Maintainer : Peter Robinson +-- Stability : experimental +-- Portability : portable +-- +----------------------------------------------------------------------------- + +module Crypto.SecretSharing.Internal +where +import Math.Polynomial.Interpolation + +import Data.ByteString.Lazy( ByteString ) +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.List as L +import Data.Char +import Data.Vector( Vector ) +import qualified Data.Vector as V +import Data.Typeable +import Control.Exception +import Control.Monad +import Data.Binary( Binary ) +import GHC.Generics +import Data.FiniteField.PrimeField as PF +import Data.FiniteField.Base(FiniteField,order) +import System.Random.Dice + + + +-- | A share of an encoded byte. +data ByteShare = ByteShare + { shareId :: !Int -- ^ the index of this share + , reconstructionThreshold :: !Int -- ^ number of shares required for + -- reconstruction + , shareValue :: !Int -- ^ the value of p(shareId) where p(x) is the + -- generated (secret) polynomial + } + deriving(Typeable,Eq,Generic) + +instance Show ByteShare where + show = show . shareValue + +-- | A share of the encoded secret. +data Share = Share + { theShare :: ![ByteShare] } + deriving(Typeable,Eq,Generic) + +instance Show Share where + show s = show (shareId $ head $ theShare s,BLC.pack $ map (chr . shareValue) $ theShare s) + +instance Binary ByteShare +instance Binary Share + +-- | Encodes a 'ByteString' as a list of n shares, m of which are required for +-- reconstruction. +-- Lives in the 'IO' to access a random source. +encode :: Int -- ^ m + -> Int -- ^ n + -> ByteString -- ^ the secret that we want to share + -> IO [Share] -- a list of n-shares (per byte) +encode m n bstr + | n >= prime || m > n = throw $ AssertionFailed $ + "encode: require n < " ++ show prime ++ " and m<=n." + | BL.null bstr = return [] + | otherwise = do + let len = max 1 ((fromIntegral $ BL.length bstr) * (m-1)) + coeffs <- (groupInto (m-1) . map fromIntegral . take len ) + `liftM` (getDiceRolls prime len) + let byteVecs = zipWith (encodeByte m n) coeffs $ + map fromIntegral $ BL.unpack bstr + return [ Share $ map (V.! (i-1)) byteVecs | i <- [1..n] ] + + +-- | Reconstructs a (secret) bytestring from a list of (at least @m@) shares. +-- Throws 'AssertionFailed' if the number of shares is too small. +decode :: [Share] -- ^ list of at least @m@ shares + -> ByteString -- ^ reconstructed secret +decode [] = BL.pack [] +decode shares@((Share s):_) + | length shares < reconstructionThreshold (head s) = throw $ AssertionFailed + "decode: not enough shares for reconstruction." + | otherwise = + let origLength = length s in + let byteVecs = map (V.fromList . theShare) shares in + let byteShares = [ map ((V.! (i-1))) byteVecs | i <- [1..origLength] ] in + BL.pack . map (fromInteger . PF.toInteger . number) + . map decodeByte $ byteShares + + +encodeByte :: Int -> Int -> Polyn -> FField -> Vector ByteShare +encodeByte m n coeffs secret = + V.fromList[ ByteShare i m $ fromInteger . PF.toInteger . number $ + evalPolynomial (secret:coeffs) (fromIntegral i::FField) + | i <- [1..n] + ] + + +decodeByte :: [ByteShare] -> FField +decodeByte ss = + let m = reconstructionThreshold $ head ss in + if length ss < m + then throw $ AssertionFailed "decodeByte: insufficient number of shares for reconstruction!" + else + let shares = take m ss + pts = map (\s -> (fromIntegral $ shareId s,fromIntegral $ shareValue s)) + shares + in + polyInterp pts 0 + + +-- | Groups a list into blocks of certain size. Running time: /O(n)/ +groupInto :: Int -> [a] -> [[a]] +groupInto num as + | num < 0 = throw $ AssertionFailed "groupInto: Need positive number as argument." + | otherwise = + let (fs,ss) = L.splitAt num as in + if L.null ss + then [fs] + else fs : groupInto num ss + + +-- | A finite prime field. All computations are performed in this field. +-- +-- This is modified from the secret-sharing library to use 256 +-- instead of 1021. That allows values in the field to be efficiently +-- packed into bytes. It's beleived that the finite field can be a power of +-- a prime number (in this case, 2). +newtype FField = FField { number :: $(primeField $ fromIntegral (256 :: Integer)) } + deriving(Show,Read,Ord,Eq,Num,Fractional,Generic,Typeable,FiniteField) + + +-- | The size of the finite field +prime :: Int +prime = fromInteger $ order (0 :: FField) + + +-- | A polynomial over the finite field given as a list of coefficients. +type Polyn = [FField] + +-- | Evaluates the polynomial at a given point. +evalPolynomial :: Polyn -> FField -> FField +evalPolynomial coeffs x = + foldr (\c res -> c + (x * res)) 0 coeffs +-- let clist = zipWith (\pow c -> (\x -> c * (x^pow))) [0..] coeffs +-- in L.foldl' (+) 0 [ c x | c <- clist ] + diff --git a/Encryption.hs b/Encryption.hs new file mode 100644 --- /dev/null +++ b/Encryption.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Encryption where + +import Types +import Tunables +import Cost +import ExpensiveHash +import Data.Monoid +import Data.Maybe +import Data.Word +import qualified Raaz +import qualified Raaz.Cipher.AES as Raaz +import qualified Raaz.Cipher.Internal as Raaz +import qualified Data.Text.Encoding as E +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.UTF8 as BU8 +import Text.Read + +type AesKey = Raaz.KEY256 + +cipher :: Raaz.AES 256 'Raaz.CBC +cipher = Raaz.aes256cbc + +encrypt :: Tunables -> KeyEncryptionKey -> SecretKey -> EncryptedSecretKey +encrypt tunables kek (SecretKey secret) = + EncryptedSecretKey (chunk (objectSize tunables) b) (keyBruteForceCalc kek) + where + -- Raaz does not seem to provide a high-level interface + -- for AES encryption, so use unsafeEncrypt. The use of + -- EncryptableBytes makes sure it's provided with a + -- multiple of the AES block size. + b = Raaz.unsafeEncrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) $ + getEncryptableBytes $ encodeEncryptableBytes tunables secret + +data DecryptResult + = DecryptSuccess SecretKey + | DecryptIncomplete KeyEncryptionKey + -- ^ Returned when the EncryptedSecretKey is truncated. + | DecryptFailed + +instance Show DecryptResult where + show (DecryptSuccess _) = "DecryptSuccess" + show (DecryptIncomplete _) = "DecryptIncomplete" + show DecryptFailed = "DecryptFailed" + +decrypt :: KeyEncryptionKey -> EncryptedSecretKey -> DecryptResult +decrypt kek (EncryptedSecretKey cs _) = case decodeEncryptableBytes pbs of + Nothing -> DecryptFailed + Just (DecodeSuccess secretkey) -> DecryptSuccess (SecretKey secretkey) + Just DecodeIncomplete -> DecryptIncomplete kek + where + pbs = EncryptableBytes $ + Raaz.unsafeDecrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) b + b = B.concat cs + +-- | Tries each candidate key in turn until one unlocks the encrypted data. +tryDecrypt :: Candidates KeyEncryptionKey -> EncryptedSecretKey -> DecryptResult +tryDecrypt (Candidates l _ _) esk = go l + where + go [] = DecryptFailed + go (kek:rest) = case decrypt kek esk of + DecryptFailed -> go rest + r -> r + +-- | An AES key, which is used to encrypt the secret key that is stored +-- in keysafe. +data KeyEncryptionKey = KeyEncryptionKey + { keyEncryptionKey :: AesKey + , keyEncryptionIV :: Raaz.IV + , keyCreationCost :: Cost CreationOp + , keyDecryptionCost :: Cost DecryptionOp + , keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword + } + +instance HasCreationCost KeyEncryptionKey where + getCreationCost = keyCreationCost + +instance HasDecryptionCost KeyEncryptionKey where + getDecryptionCost = keyDecryptionCost + +instance Bruteforceable KeyEncryptionKey UnknownPassword where + getBruteCostCalc = keyBruteForceCalc + +data Candidates a = Candidates [a] (Cost CreationOp) (Cost DecryptionOp) + +instance HasCreationCost (Candidates a) where + getCreationCost (Candidates _ c _) = c + +instance HasDecryptionCost (Candidates a) where + getDecryptionCost (Candidates _ _ c) = c + +-- | The ExpensiveHash of the Password used as the KeyEncryptionKey +-- +-- Name is used as a salt, to prevent rainbow table attacks. +-- +-- A random prefix is added to the salt, to force an attacker to +-- run the hash repeatedly. +genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey +genKeyEncryptionKey tunables name password = do + prg <- Raaz.newPRG () :: IO Raaz.SystemPRG + saltprefix <- genRandomSaltPrefix prg tunables + return $ head $ + genKeyEncryptionKeys [saltprefix] tunables name password + +-- | A stream of KeyEncryptionKeys, using the specified salt prefixes. +genKeyEncryptionKeys :: [SaltPrefix] -> Tunables -> Name -> Password -> [KeyEncryptionKey] +genKeyEncryptionKeys saltprefixes tunables (Name name) (Password password) = + map mk saltprefixes + where + iv = genIV (Name name) + -- To brute force data encrypted with a key, + -- an attacker needs to pay the decryptcost for + -- each password checked. + bruteforcecalc = bruteForceLinearSearch decryptcost + decryptcost = castCost $ randomSaltBytesBruteForceCost kektunables + kektunables = keyEncryptionKeyTunable tunables + + mk saltprefix = KeyEncryptionKey (hashToAESKey hash) iv (getCreationCost hash) decryptcost bruteforcecalc + where + salt = Salt (saltprefix <> name) + hash = expensiveHash (keyEncryptionKeyHash kektunables) salt password + +-- | A stream of all the key encryption keys that need to be tried to +-- decrypt. +candidateKeyEncryptionKeys :: Tunables -> Name -> Password -> Candidates KeyEncryptionKey +candidateKeyEncryptionKeys tunables name password = + let ks@(k:_) = genKeyEncryptionKeys saltprefixes tunables name password + in Candidates ks (getCreationCost k) (getDecryptionCost k) + where + saltprefixes = allByteStringsOfLength $ + randomSaltBytes $ keyEncryptionKeyTunable tunables + +allByteStringsOfLength :: Int -> [B.ByteString] +allByteStringsOfLength = go [] + where + go ws n + | n == 0 = return (B.pack ws) + | otherwise = do + w <- [0..255] + go (w:ws) (n-1) + +chunk :: Int -> B.ByteString -> [B.ByteString] +chunk n = go [] + where + go cs b + | B.length b <= n = reverse (b:cs) + | otherwise = + let (h, t) = B.splitAt n b + in go (h:cs) t + +-- Use the sha256 of the name (truncated) as the IV. +genIV :: Name -> Raaz.IV +genIV (Name name) = + fromMaybe (error "genIV fromByteString failed") $ + Raaz.fromByteString $ B.take ivlen $ + Raaz.toByteString $ Raaz.sha256 name + where + ivlen = fromIntegral $ Raaz.byteSize (undefined :: Raaz.IV) + +type SaltPrefix = B.ByteString + +genRandomSaltPrefix :: Raaz.SystemPRG -> Tunables -> IO SaltPrefix +genRandomSaltPrefix prg tunables = go [] + (randomSaltBytes $ keyEncryptionKeyTunable tunables) + where + go ws 0 = return (B.pack ws) + go ws n = do + b <- Raaz.random prg :: IO Word8 + go (b:ws) (n-1) + +instance Raaz.Random Word8 + +-- | Make an AES key out of a hash value. +-- +-- Since the ExpensiveHash value is ascii encoded, and has a common prefix, +-- it does not have a high entropy in every byte, and its length is longer +-- than the AES key length. To deal with this, use the SHA256 of +-- the ExpensiveHash, as a bytestring. +hashToAESKey :: ExpensiveHash -> AesKey +hashToAESKey (ExpensiveHash _ t) = + fromMaybe (error "hashToAESKey fromByteString failed") $ + Raaz.fromByteString b + where + b = B.take (fromIntegral $ Raaz.byteSize (undefined :: AesKey)) $ + Raaz.toByteString $ Raaz.sha256 (E.encodeUtf8 t) + +-- | A bytestring that can be AES encrypted. +-- +-- It is padded to a multiple of the objectSize with NULs. +-- Since objectSize is a multiple of the AES blocksize, so is this. +-- +-- Format is: +-- +-- sizeNULsizeshaNULdatashaNULdata +-- +-- The size gives the length of the data. If the data is shorter +-- than that, we know that the bytestring is truncated. +-- +-- The datasha is the sha256 of the data. This is checked when decoding +-- to guard against corruption. +-- +-- The sizesha is the sha256 of the size. This is included as a sanity +-- check that the right key was used to decrypt it. It's not unlikely +-- that using the wrong key could result in a bytestring that starts +-- with wrongsizeNUL, but it's astronomically unlikely that the +-- sizesha matches in this case. +newtype EncryptableBytes = EncryptableBytes { getEncryptableBytes :: B.ByteString } + deriving (Show) + +encodeEncryptableBytes :: Tunables -> B.ByteString -> EncryptableBytes +encodeEncryptableBytes tunables content = EncryptableBytes $ + padBytes (objectSize tunables) $ B.intercalate sep + [ size + , sha size + , sha content + , content + ] + where + size = B8.pack (show (B.length content)) + sep = B.singleton 0 + +-- | Encoded, so that it does not contain any NULs. +sha :: B.ByteString -> B.ByteString +sha = BU8.fromString . Raaz.showBase16 . Raaz.sha256 + +padBytes :: Int -> B.ByteString -> B.ByteString +padBytes n b = b <> padding + where + len = B.length b + r = len `rem` n + padding + | r == 0 = B.empty + | otherwise = B.replicate (n - r) 0 + +data DecodeResult + = DecodeSuccess B.ByteString + | DecodeIncomplete + deriving (Show) + +decodeEncryptableBytes :: EncryptableBytes -> Maybe DecodeResult +decodeEncryptableBytes (EncryptableBytes b) = do + (sizeb, rest) <- getword b + (sizesha, rest') <- getword rest + (contentsha, rest'') <- getword rest' + if sha sizeb /= sizesha + then Nothing + else do + size <- readMaybe (B8.unpack sizeb) + let content = B.take size rest'' + if B.length content /= size + then return DecodeIncomplete + else if sha content /= contentsha + then Nothing + else return (DecodeSuccess content) + where + getword d = case B.break (== 0) d of + (w, rest) + | B.null w || B.null rest-> Nothing + | otherwise -> Just (w, B.drop 1 rest) diff --git a/Entropy.hs b/Entropy.hs new file mode 100644 --- /dev/null +++ b/Entropy.hs @@ -0,0 +1,24 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Entropy where + +import Types +import Types.Cost +import qualified Data.ByteString.UTF8 as B +import Text.Password.Strength (estimate, UserDict) + +-- | Calculation of the entropy of a password. +-- Uses zxcvbn so takes word lists, and other entropy weakening problems +-- into account. +passwordEntropy :: Password -> UserDict -> Entropy UnknownPassword +passwordEntropy (Password p) userdict = Entropy $ floor $ + estimate (B.toString p) userdict + +-- | Naive calculation of the entropy of a name. +-- Assumes that the attacker is not targeting a particular list of names. +nameEntropy :: Name -> Entropy UnknownName +nameEntropy (Name n) = Entropy $ floor $ + estimate (B.toString n) [] diff --git a/ExpensiveHash.hs b/ExpensiveHash.hs new file mode 100644 --- /dev/null +++ b/ExpensiveHash.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module ExpensiveHash where + +import Types +import Tunables +import Cost +import Serialization () +import qualified Data.Text as T +import qualified Data.ByteString as B +import qualified Crypto.Argon2 as Argon2 +import Raaz.Core.Encode +import Data.Time.Clock +import Control.DeepSeq +import Control.Monad +import Data.Monoid + +-- | A hash that is expensive to calculate. +-- +-- This is a lynchpin of keysafe's security, because using this hash +-- as an encryption key forces brute force attackers to generate +-- hashes over and over again, taking a very long time. +data ExpensiveHash = ExpensiveHash (Cost CreationOp) T.Text + deriving (Show) + +instance HasCreationCost ExpensiveHash where + getCreationCost (ExpensiveHash c _) = c + +data Salt t = Salt t + +expensiveHash :: Encodable t => ExpensiveHashTunable -> Salt t -> B.ByteString -> ExpensiveHash +expensiveHash (UseArgon2 cost opts) (Salt s) b = ExpensiveHash cost $ + -- Using hashEncoded here and not hash, + -- because of this bug: + -- https://github.com/ocharles/argon2/issues/3 + Argon2.hashEncoded opts b argonsalt + where + -- argon salt cannot be shorter than 8 bytes, so pad with spaces. + argonsalt = + let sb = toByteString s + in sb <> B.replicate (8 - B.length sb ) 32 + +benchmarkExpensiveHash :: Int -> ExpensiveHashTunable -> Cost op -> IO (BenchmarkResult (Cost op)) +benchmarkExpensiveHash rounds tunables expected = do + start <- getCurrentTime + forM_ [1..rounds] $ \_ -> do + let ExpensiveHash _ t = expensiveHash tunables + (Salt (GpgKey (KeyId ("dummy" :: B.ByteString)))) + ("himom" :: B.ByteString) + t `deepseq` return () + end <- getCurrentTime + let diff = floor $ end `diffUTCTime` start + let actual = CPUCost $ Seconds diff + return $ BenchmarkResult + { expectedBenchmark = expected + , actualBenchmark = actual + } + +benchmarkTunables :: Tunables -> IO () +benchmarkTunables tunables = do + putStrLn "/proc/cpuinfo:" + putStrLn =<< readFile "/proc/cpuinfo" + putStrLn "Note that expected times are for 1 core machine." + putStrLn "If this machine has 2 cores, the actual times should be half the expected times." + putStrLn "Benchmarking 16 rounds of key generation hash..." + print =<< benchmarkExpensiveHash 16 + (keyEncryptionKeyHash $ keyEncryptionKeyTunable tunables) + (mapCost (`div` 16) $ randomSaltBytesBruteForceCost $ keyEncryptionKeyTunable tunables) + putStrLn "Benchmarking 1 round of name generation hash..." + print =<< benchmarkExpensiveHash 1 + (nameGenerationHash $ nameGenerationTunable tunables) + (getexpected $ nameGenerationHash $ nameGenerationTunable tunables) + where + getexpected (UseArgon2 cost _) = cost diff --git a/Gpg.hs b/Gpg.hs new file mode 100644 --- /dev/null +++ b/Gpg.hs @@ -0,0 +1,71 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE OverloadedStrings, BangPatterns #-} + +module Gpg where + +import Types +import UI +import System.Process +import Data.List.Split +import Data.Maybe +import System.IO +import System.Exit +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BU8 + +-- | Pick gpg secret key to back up. +-- +-- If there is only one gpg secret key, +-- the choice is obvious. Otherwise prompt the user with a list. +getKeyToBackup :: UI -> IO SecretKey +getKeyToBackup ui = go =<< Gpg.listSecretKeys + where + go [] = do + showError ui "You have no gpg secret keys to back up." + error "Aborting on no gpg secret keys." + go [(_, kid)] = Gpg.getSecretKey kid + go l = maybe (error "Canceled") Gpg.getSecretKey + =<< promptKeyId ui "Pick gpg secret key" + "Pick gpg secret key to back up:" l + +-- | Use when the gpg keyid will not be known at restore time. +anyKey :: SecretKeySource +anyKey = GpgKey (KeyId "") + +listSecretKeys :: IO [(Name, KeyId)] +listSecretKeys = mapMaybe parse . lines <$> readProcess "gpg" + ["--batch", "--with-colons", "--list-secret-keys"] "" + where + parse l = case splitOn ":" l of + ("sec":_:_:_:kid:_:_:_:_:n:_) -> Just + (Name (BU8.fromString n), KeyId (BU8.fromString kid)) + _ -> Nothing + +getSecretKey :: KeyId -> IO SecretKey +getSecretKey (KeyId kid) = do + (_, Just hout, _, ph) <- createProcess (proc "gpg" ps) + { std_out = CreatePipe } + secretkey <- SecretKey <$> B.hGetContents hout + exitcode <- waitForProcess ph + case exitcode of + ExitSuccess -> return secretkey + _ -> error "gpg --export-secret-key failed" + where + ps = ["--batch", "--export-secret-key", BU8.toString kid] + +writeSecretKey :: SecretKey -> IO () +writeSecretKey (SecretKey b) = do + (Just hin, _, _, ph) <- createProcess (proc "gpg" ps) + { std_in = CreatePipe } + B.hPut hin b + hClose hin + exitcode <- waitForProcess ph + case exitcode of + ExitSuccess -> return () + _ -> error "gpg --import failed" + where + ps = ["--batch", "--import"] diff --git a/SecretKey.hs b/SecretKey.hs new file mode 100644 --- /dev/null +++ b/SecretKey.hs @@ -0,0 +1,26 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module SecretKey where + +import Types +import qualified Gpg +import qualified Data.ByteString as B +import System.IO +import System.Posix.IO + +getSecretKey :: SecretKeySource -> IO SecretKey +getSecretKey (GpgKey kid) = Gpg.getSecretKey kid +getSecretKey (KeyFile f) = SecretKey <$> B.readFile f + +-- | Can throw exception if the secret key already exists. +writeSecretKey :: SecretKeySource -> SecretKey -> IO () +writeSecretKey (GpgKey _) secretkey = Gpg.writeSecretKey secretkey +writeSecretKey (KeyFile f) (SecretKey b) = do + fd <- openFd f WriteOnly (Just 0o666) + (defaultFileFlags { exclusive = True } ) + h <- fdToHandle fd + B.hPut h b + hClose h diff --git a/Serialization.hs b/Serialization.hs new file mode 100644 --- /dev/null +++ b/Serialization.hs @@ -0,0 +1,54 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Serialization where + +import Types +import Raaz.Core.Encode +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BU8 +import Data.Monoid +import Data.Word + +-- | A SecretKeySource is serialized in the form "keytype value". +-- For example "gpg C910D9222512E3C7", or "file path". +instance Encodable SecretKeySource where + toByteString (GpgKey (KeyId b)) = + "gpg" <> B.singleton sepChar <> b + toByteString (KeyFile f) = + "file" <> B.singleton sepChar <> BU8.fromString f + fromByteString b = case B.break (== sepChar) b of + (t, rest) + | B.null rest -> Nothing + | otherwise -> + let i = B.drop 1 rest + in case t of + "gpg" -> Just $ GpgKey (KeyId i) + "file" -> Just $ KeyFile (BU8.toString i) + _ -> Nothing + +instance Encodable Name where + toByteString (Name n) = n + fromByteString = Just . Name + +instance Encodable StorableObjectIdent where + toByteString (StorableObjectIdent i) = i + fromByteString = Just . StorableObjectIdent + +instance Encodable StorableObject where + toByteString (StorableObject b) = b + fromByteString = Just . StorableObject + +-- | A share is serialized without its share number. This prevents +-- an attacker from partitioning their shares by share number. +instance Encodable Share where + toByteString (Share _n o) = toByteString o + fromByteString _ = Nothing + +sepChar :: Word8 +sepChar = 32 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -fno-warn-tabs #-} + +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Setup +import Distribution.Simple.Utils (installOrdinaryFiles, rawSystemExit) +import Distribution.PackageDescription (PackageDescription(..)) +import Distribution.Verbosity (Verbosity) +import System.Info +import System.FilePath + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { postCopy = myPostCopy + } + +myPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO () +myPostCopy _ flags pkg lbi = if System.Info.os /= "mingw32" + then installManpages dest verbosity pkg lbi + else return () + where + dest = fromFlag $ copyDest flags + verbosity = fromFlag $ copyVerbosity flags + +{- See http://www.haskell.org/haskellwiki/Cabal/Developer-FAQ#Installing_manpages -} +installManpages :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO () +installManpages copyDest verbosity pkg lbi = + installOrdinaryFiles verbosity dstManDir [(".", "keysafe.1")] + where + dstManDir = mandir (absoluteInstallDirs pkg lbi copyDest) "man1" diff --git a/Share.hs b/Share.hs new file mode 100644 --- /dev/null +++ b/Share.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Share where + +import Types +import Tunables +import ExpensiveHash +import Cost +import qualified Crypto.SecretSharing.Internal as SS +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Raaz.Core.Encode as Raaz +import qualified Raaz.Hash.Sha256 as Raaz +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import qualified Data.Set as S +import Data.Monoid + +data ShareIdents = ShareIdents + { identsStream :: [S.Set StorableObjectIdent] + -- ^ Each item in the infinite list is the idents to + -- use for the shares of a chunk of data. + , identsCreationCost :: Cost CreationOp + , identsBruteForceCalc :: CostCalc BruteForceOp UnknownName + } + +nextShareIdents :: ShareIdents -> (S.Set StorableObjectIdent, ShareIdents) +nextShareIdents sis = + let (s:rest) = identsStream sis + in (s, sis { identsStream = rest }) + +instance HasCreationCost ShareIdents where + getCreationCost = identsCreationCost + +instance Bruteforceable ShareIdents UnknownName where + getBruteCostCalc = identsBruteForceCalc + +-- | Generates identifiers to use for storing shares. +-- +-- This is an expensive operation, to make it difficult for an attacker +-- to brute force known/guessed names and find matching shares. +-- The keyid or filename is used as a salt, to avoid collisions +-- when the same name is chosen for multiple keys. +shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents +shareIdents tunables (Name name) keyid = + ShareIdents (segmentbyshare idents) creationcost bruteforcecalc + where + (ExpensiveHash creationcost basename) = + expensiveHash hashtunables (Salt keyid) name + mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $ + E.encodeUtf8 $ basename <> T.pack (show n) + mksha :: B.ByteString -> Raaz.Base16 + mksha = Raaz.encode . Raaz.sha256 + bruteforcecalc = bruteForceLinearSearch creationcost + hashtunables = nameGenerationHash $ nameGenerationTunable tunables + idents = map mk ([1..] :: [Integer]) + m = totalObjects (shareParams tunables) + segmentbyshare l = + let (shareis, l') = splitAt m l + in S.fromList shareis : segmentbyshare l' + +-- | Generates shares of an EncryptedSecretKey. +-- Each chunk of the key creates its own set of shares. +genShares :: EncryptedSecretKey -> Tunables -> IO [S.Set Share] +genShares (EncryptedSecretKey cs _) tunables = do + shares <- mapM encode cs + return $ map (S.fromList . map (uncurry Share) . zip [1..]) shares + where + encode :: B.ByteString -> IO [StorableObject] + encode b = map (StorableObject . encodeShare) + <$> SS.encode + (neededObjects $ shareParams tunables) + (totalObjects $ shareParams tunables) + (BL.fromStrict b) + +-- | If not enough sets of shares are provided, the EncryptedSecretKey may +-- be incomplete, only containing some chunks of the key +combineShares :: Tunables -> [S.Set Share] -> Either String EncryptedSecretKey +combineShares tunables shares + | null shares || any null shares || any (\l -> length l < sharesneeded) shares = + Left "Not enough shares are currently available to reconstruct your data." + | otherwise = Right $ mk $ + map (BL.toStrict . SS.decode . map decodeshare . S.toList) shares + where + mk cs = EncryptedSecretKey cs unknownCostCalc + decodeshare (Share sharenum so) = decodeShare sharenum sharesneeded $ + fromStorableObject so + sharesneeded = neededObjects (shareParams tunables) + +-- | This efficient encoding relies on the share using a finite field of +-- size 256, so it maps directly to bytes. +-- +-- Note that this does not include the share number in the encoded +-- bytestring. This prevents an attacker from partitioning their shares +-- by share number. +encodeShare :: SS.Share -> B.ByteString +encodeShare = B.pack . map (fromIntegral . SS.shareValue) . SS.theShare + +decodeShare :: Int -> Int -> B.ByteString -> SS.Share +decodeShare sharenum sharesneeded = SS.Share . map mk . B.unpack + where + mk w = SS.ByteShare + { SS.shareId = sharenum + , SS.reconstructionThreshold = sharesneeded + , SS.shareValue = fromIntegral w + } diff --git a/Storage.hs b/Storage.hs new file mode 100644 --- /dev/null +++ b/Storage.hs @@ -0,0 +1,105 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Storage (module Storage, module Types.Storage) where + +import Types +import Types.Storage +import Share +import Storage.Local +import Storage.Network +import Data.Monoid +import Data.Maybe +import System.FilePath +import Control.Monad +import qualified Data.Set as S + +allStorageLocations :: IO StorageLocations +allStorageLocations = do + servers <- networkServers + return $ StorageLocations $ + map networkStorage servers <> map uploadQueue servers + +localStorageLocations :: StorageLocations +localStorageLocations = StorageLocations $ + map (localStorage . ("local" ) . show) + [1..100 :: Int] + +type UpdateProgress = IO () + +-- | Stores the shares amoung the storage locations. Each location +-- gets at most one share from each set. +-- +-- TODO: Add shuffling and queueing/chaffing to prevent +-- correlation of related shares. +storeShares :: StorageLocations -> ShareIdents -> [S.Set Share] -> UpdateProgress -> IO StoreResult +storeShares (StorageLocations locs) allsis shares updateprogress = do + (r, usedlocs) <- go allsis shares [] + _ <- mapM_ obscureShares usedlocs + return r + where + go sis (s:rest) usedlocs = do + let (is, sis') = nextShareIdents sis + (r, usedlocs') <- storeset locs [] Nothing (zip (S.toList is) (S.toList s)) + case r of + StoreSuccess -> go sis' rest (usedlocs ++ usedlocs') + _ -> return (r, usedlocs ++ usedlocs') + go _ [] usedlocs = return (StoreSuccess, usedlocs) + + storeset _ usedlocs _ [] = return (StoreSuccess, usedlocs) + storeset [] usedlocs lasterr _ = + return (fromMaybe (StoreFailure "no storage locations") lasterr, usedlocs) + storeset (loc:otherlocs) usedlocs _ ((i, s):rest) = do + r <- storeShare loc i s + case r of + StoreSuccess -> do + _ <- updateprogress + storeset otherlocs (loc:usedlocs) Nothing rest + -- Give up if any location complains a share + -- already exists, because we have a name conflict. + StoreAlreadyExists -> return (StoreAlreadyExists, usedlocs) + -- Try storing it somewhere else on failure. + StoreFailure _ -> + storeset otherlocs usedlocs (Just r) ((i, s):rest) + +-- | Retrieves one set of shares from the storage locations. +-- Returns all the shares it can find, which may not be enough, +-- and the remaining Shareidents, to use to get subsequent sets. +-- +-- Assumes that each location only contains one share. So, once a +-- share has been found on a location, can avoid asking that location +-- for any other shares. +retrieveShares :: StorageLocations -> ShareIdents -> UpdateProgress -> IO (S.Set Share, ShareIdents) +retrieveShares (StorageLocations locs) sis updateprogress = do + let (is, sis') = nextShareIdents sis + let want = zip [1..] (S.toList is) + (shares, usedlocs, _unusedlocs) <- go locs [] want [] + _ <- mapM_ obscureShares usedlocs + return (S.fromList shares, sis') + where + go unusedlocs usedlocs [] shares = return (shares, usedlocs, unusedlocs) + go [] usedlocs _ shares = return (shares, usedlocs, []) + go (loc:otherlocs) usedlocs ((n, i):rest) shares = do + r <- retrieveShare loc n i + case r of + RetrieveSuccess s -> do + _ <- updateprogress + go otherlocs (loc:usedlocs) rest (s:shares) + RetrieveFailure _ -> do + -- Try to get the share from other locations. + (shares', usedlocs', unusedlocs) <- + go otherlocs usedlocs [(n, i)] shares + -- May need to ask the location that didn't + -- have the share for a later share, but + -- ask it last. This way, the first + -- location on the list can't deny having + -- all shares and so learn the idents of + -- all of them. + go (unusedlocs++[loc]) usedlocs' rest shares' + +uploadQueued :: IO () +uploadQueued = do + servers <- networkServers + forM_ servers $ \s -> moveShares (uploadQueue s) (networkStorage s) diff --git a/Storage/Local.hs b/Storage/Local.hs new file mode 100644 --- /dev/null +++ b/Storage/Local.hs @@ -0,0 +1,138 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Storage.Local (localStorage, uploadQueue) where + +import Types +import Types.Storage +import Storage.Network (Server(..)) +import Serialization () +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as U8 +import Data.Monoid +import Data.List +import System.Posix.User +import System.IO +import System.Directory +import System.Posix +import System.FilePath +import Raaz.Core.Encode +import Control.DeepSeq +import Control.Exception +import Control.Monad + +newtype Section = Section String + +localStorage :: String -> Storage +localStorage n = Storage + { storeShare = store section + , retrieveShare = retrieve section + , obscureShares = obscure section + , countShares = count section + , moveShares = move section + } + where + section = Section n + +uploadQueue :: Server -> Storage +uploadQueue s = localStorage ("uploadqueue" serverName s) + +store :: Section -> StorableObjectIdent -> Share -> IO StoreResult +store section i s = onError (StoreFailure . show) $ do + dir <- shareDir section + createDirectoryIfMissing True dir + let dest = dir shareFile i + exists <- doesFileExist dest + if exists + then return StoreAlreadyExists + else do + let tmp = dest ++ ".tmp" + fd <- openFd tmp WriteOnly (Just 0o400) + (defaultFileFlags { exclusive = True } ) + h <- fdToHandle fd + B.hPut h (toByteString s) + hClose h + renameFile tmp dest + return StoreSuccess + +retrieve :: Section -> ShareNum -> StorableObjectIdent -> IO RetrieveResult +retrieve section n i = onError (RetrieveFailure . show) $ do + dir <- shareDir section + fd <- openFd (dir shareFile i) ReadOnly Nothing defaultFileFlags + h <- fdToHandle fd + b <- B.hGetContents h + b `deepseq` hClose h + return $ RetrieveSuccess $ Share n (StorableObject b) + +-- | Set atime and mtime to epoch, to obscure access and modification +-- patterns. +-- +-- There is no way to set the ctime to the epoch, but setting the other +-- times does at least set it to the current time, which makes all +-- currently stored files look alike. +-- +-- Note that the contents of shares is never changed, so it's ok to set the +-- mtime to the epoch; backup programs won't be confused. +obscure :: Section -> IO ObscureResult +obscure section = onError (ObscureFailure . show) $ do + dir <- shareDir section + fs <- filter isShareFile <$> getDirectoryContents dir + mapM_ (\f -> setFileTimes (dir f) 0 0) fs + return ObscureSuccess + +count :: Section -> IO CountResult +count section = onError (CountFailure . show) $ do + dir <- shareDir section + CountResult . genericLength . filter isShareFile + <$> getDirectoryContents dir + +move :: Section -> Storage -> IO () +move section storage = do + dir <- shareDir section + fs <- getDirectoryContents dir + forM_ fs $ \f -> case fromShareFile f of + Nothing -> return () + Just i -> do + -- Use a dummy share number of 0; it doesn't + -- matter because we're not going to be + -- recombining the share, just sending its contents + -- on the the server. + r <- retrieve section 0 i + case r of + RetrieveFailure _ -> return () + RetrieveSuccess share -> do + s <- storeShare storage i share + case s of + StoreFailure _ -> return () + _ -> removeFile f + +onError :: (IOException -> a) -> IO a -> IO a +onError f a = do + v <- try a + return $ case v of + Left e -> f e + Right r -> r + +shareDir :: Section -> IO FilePath +shareDir (Section section) = do + u <- getUserEntryForID =<< getEffectiveUserID + return $ homeDirectory u dotdir section + +shareFile :: StorableObjectIdent -> FilePath +shareFile i = U8.toString (toByteString i) <> ext + +fromShareFile :: FilePath -> Maybe StorableObjectIdent +fromShareFile f + | isShareFile f = fromByteString $ U8.fromString $ dropExtension f + | otherwise = Nothing + +isShareFile :: FilePath -> Bool +isShareFile f = ext `isSuffixOf` f + +ext :: String +ext = ".keysafe" + +dotdir :: FilePath +dotdir = ".keysafe" "objects" diff --git a/Storage/Network.hs b/Storage/Network.hs new file mode 100644 --- /dev/null +++ b/Storage/Network.hs @@ -0,0 +1,43 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE OverloadedStrings #-} + +module Storage.Network (Server(..), networkServers, networkStorage) where + +import Types +import Types.Storage + +newtype Server = Server { serverName :: String } + +networkServers :: IO [Server] +networkServers = return [] -- none yet + +networkStorage :: Server -> Storage +networkStorage server = Storage + { storeShare = store server + , retrieveShare = retrieve server + , obscureShares = obscure server + , countShares = count server + , moveShares = move server + } + +store :: Server -> StorableObjectIdent -> Share -> IO StoreResult +store _server _i _s = return $ StoreFailure "network storage not implemented yet" + +retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult +retrieve _server _n _i = return $ RetrieveFailure "network storage not implemented yet" + +-- | Servers should automatically obscure, so do nothing. +-- (Could upload chaff.) +obscure :: Server -> IO ObscureResult +obscure _ = return ObscureSuccess + +count :: Server -> IO CountResult +count _server = return $ CountFailure "network storage not implemented yet" + +-- | Not needed for servers. +move :: Server -> Storage -> IO () +move _ _ = return () diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,11 @@ +* test suite (eg, test basic storage and restore of various size data) +* tune hashes on more powerful hardware than thermal throttling laptop +* store to servers +* Run --uploadqueued periodically (systemd timer?) +* improve restore progress bar points (update after every hash try) +* Keep secret keys in locked memory until they're encrypted. + (Raaz makes this possible to do.) + Would be nice, but not super-important, since gpg secret keys + are passphrase protected anyway.. +* If we retrieved enough shares successfully, but decrypt failed, must + be a wrong password, so prompt for re-entry and retry with those shares. diff --git a/Tunables.hs b/Tunables.hs new file mode 100644 --- /dev/null +++ b/Tunables.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Tunables where + +import Cost +import qualified Crypto.Argon2 as Argon2 + +-- | To determine the tunables used for a key name the expensive hash of the +-- name is calculated, using a particular configuration, and if the +-- object names it generates are available, we know the tunables. +-- +-- Since this process is expensive, it's important that the most commonly +-- used tunables come first, so that the expensive hash does not have to be +-- calculated repatedly. +-- +-- The reason for using this expensive method of encoding the tunables +-- is that it prevents attacks where related objects are correlated based +-- on their tunables. +knownTunings :: [(ExpensiveHashTunable, Tunables)] +knownTunings = map (\t -> (nameGenerationHash (nameGenerationTunable t), t)) + [ defaultTunables + ] + +-- | keysafe stores data for a long time, and needs to be able to process +-- data from a long time ago when restoring a key. We don't want to be +-- locked into old choices of crypto primitives etc forever. +-- +-- So, every parameter that can be tuned is configured in this data +-- structure. +data Tunables = Tunables + { shareParams :: ShareParams + , objectSize :: Int + -- ^ a StorableObject is exactly this many bytes in size + -- (must be a multiple of AES block size 16, and cannot be smaller + -- than 256 bytes) + , nameGenerationTunable :: NameGenerationTunable + , keyEncryptionKeyTunable :: KeyEncryptionKeyTunable + , encryptionTunable :: EncryptionTunable + } + deriving (Show) + +-- | Parameters for shareing. The secret is split into +-- N objects, such that only M are needed to reconstruct it. +data ShareParams = ShareParams + { totalObjects :: Int -- ^ N + , neededObjects :: Int -- ^ M + } + deriving (Show) + +-- | An expensive hash, which makes brute-forcing hard. +-- +-- The creation cost estimate must be manually tuned to match the +-- hash options. Use benchmarkTunables to check this. +data ExpensiveHashTunable = UseArgon2 (Cost CreationOp) Argon2.HashOptions + deriving (Show) + +data NameGenerationTunable = NameGenerationTunable + { nameGenerationHash :: ExpensiveHashTunable + } + deriving (Show) + +-- | How to generate the encryption key used to encrypt the secret key. +-- This is an expensive hash of the password, but not a super expensive +-- hash, because a password brute forcing attacker needs to run the hash +-- 256 times per random salt byte. +data KeyEncryptionKeyTunable = KeyEncryptionKeyTunable + { keyEncryptionKeyHash :: ExpensiveHashTunable + , randomSaltBytes :: Int + , randomSaltBytesBruteForceCost :: Cost BruteForceOp + } + deriving (Show) + +-- | What encryption to use. +data EncryptionTunable = UseAES256 + deriving (Show) + +defaultTunables :: Tunables +defaultTunables = Tunables + { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 } + , objectSize = 1024*64 -- 64 kb + -- The nameGenerationHash was benchmarked at 661 seconds CPU time + -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. + -- Since cost is measured per core, we double that. + , nameGenerationTunable = NameGenerationTunable + { nameGenerationHash = argon2 10000 (CPUCost (Seconds (2*600))) + } + , keyEncryptionKeyTunable = KeyEncryptionKeyTunable + { keyEncryptionKeyHash = argon2 115 (CPUCost (Seconds 0)) + , randomSaltBytes = 1 + -- The keyEncryptionKeyHash is run 256 times per + -- random salt byte to brute-force, and its parameters + -- were chosen so the total brute forcing time is 50 minutes, + -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. + -- Since cost is measured per core, we double that. + , randomSaltBytesBruteForceCost = CPUCost (Seconds (2*50*60)) + } + , encryptionTunable = UseAES256 + } + where + argon2 i c = UseArgon2 c $ Argon2.HashOptions + { Argon2.hashIterations = i + , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread + , Argon2.hashParallelism = 4 -- 4 threads + , Argon2.hashVariant = Argon2.Argon2i + } + +-- | Dials back hash difficulty, lies about costs. +-- Not for production use! +testModeTunables :: Tunables +testModeTunables = Tunables + { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 } + , objectSize = 1024*64 + , nameGenerationTunable = NameGenerationTunable + { nameGenerationHash = weakargon2 (CPUCost (Seconds (2*600))) + } + , keyEncryptionKeyTunable = KeyEncryptionKeyTunable + { keyEncryptionKeyHash = weakargon2 (CPUCost (Seconds 0)) + , randomSaltBytes = 1 + , randomSaltBytesBruteForceCost = CPUCost (Seconds (2*50*60)) + } + , encryptionTunable = UseAES256 + } + where + weakargon2 c = UseArgon2 c Argon2.defaultHashOptions diff --git a/Types.hs b/Types.hs new file mode 100644 --- /dev/null +++ b/Types.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Types where + +import Types.Cost +import qualified Data.ByteString as B +import Data.String +import Control.DeepSeq + +-- | keysafe stores secret keys. +newtype SecretKey = SecretKey B.ByteString + +-- | The secret key, encrypted with a password, in fixed size chunks. +data EncryptedSecretKey = EncryptedSecretKey [B.ByteString] (CostCalc BruteForceOp UnknownPassword) + +instance NFData EncryptedSecretKey where + rnf (EncryptedSecretKey cs _) = rnf cs + +instance Show EncryptedSecretKey where + show (EncryptedSecretKey cs _) = show cs + +instance Bruteforceable EncryptedSecretKey UnknownPassword where + getBruteCostCalc (EncryptedSecretKey _ cc) = cc + +-- | An object in a form suitable to be stored on a keysafe server. +newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString } + deriving (Show, Eq, Ord) + +-- | An identifier for a StorableObject +newtype StorableObjectIdent = StorableObjectIdent B.ByteString + deriving (Show, Eq, Ord, NFData) + +-- | A Shamir secret share, with a known number (N of M). +data Share = Share ShareNum StorableObject + deriving (Eq, Ord) + +type ShareNum = Int + +-- | A password used to encrypt a key stored in keysafe. +newtype Password = Password B.ByteString + deriving (IsString) + +-- | A name associated with a key stored in keysafe. +newtype Name = Name B.ByteString + deriving (Show, Monoid) + +-- | Source of the secret key stored in keysafe. +data SecretKeySource = GpgKey KeyId | KeyFile FilePath + deriving (Show) + +-- | The keyid is any value that is unique to a private key, and can be +-- looked up somehow without knowing the private key. +-- +-- A gpg keyid is the obvious example. +data KeyId = KeyId B.ByteString + deriving (Show) + +data BenchmarkResult t = BenchmarkResult { expectedBenchmark :: t, actualBenchmark :: t } + deriving (Show) diff --git a/Types/Cost.hs b/Types/Cost.hs new file mode 100644 --- /dev/null +++ b/Types/Cost.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, EmptyDataDecls #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Types.Cost where + +-- | An estimated cost to perform an operation. +data Cost op + = CPUCost Seconds -- ^ using 1 CPU core + deriving (Show, Eq, Ord) + +unknownCost :: Cost op +unknownCost = CPUCost (Seconds 0) + +newtype Seconds = Seconds Integer + deriving (Num, Eq, Ord, Show) + +data UsingHardware = UsingCPU | UsingGPU | UsingASIC + deriving (Show) + +instance Monoid (Cost t) where + mempty = CPUCost (Seconds 0) + CPUCost (Seconds a) `mappend` CPUCost (Seconds b) = + CPUCost (Seconds (a+b)) + +mapCost :: (Integer -> Integer) -> Cost op -> Cost op +mapCost f (CPUCost (Seconds n)) = CPUCost (Seconds (f n)) + +showCostMinutes :: Cost op -> String +showCostMinutes (CPUCost (Seconds n)) + | n < 61 = "1 minute" + | otherwise = show (n `div` 60) ++ " minutes" + +-- | Operations whose cost can be measured. +data DecryptionOp +data CreationOp +data BruteForceOp + +-- | Things that track their creation cost. +class HasCreationCost t where + getCreationCost :: t -> Cost CreationOp + +-- | Things that track their decryption cost. +class HasDecryptionCost t where + getDecryptionCost :: t -> Cost DecryptionOp + +-- | Calculation of a cost that depends on some amount of entropy. +type CostCalc op t = Entropy t -> Cost op + +unknownCostCalc :: CostCalc op t +unknownCostCalc = \_e -> error "No cost calculation available" + +-- | Number of bits of entropy +newtype Entropy t = Entropy Int + deriving (Num, Show) + +class CalcEntropy d t where + calcEntropy :: d -> Entropy t + +-- | Entropy can never go negative when subtracting bits from it. +reduceEntropy :: Entropy t -> Int -> Entropy t +reduceEntropy (Entropy a) b = Entropy (max 0 (a - b)) + +-- | Things that can be brute-forced track their CostCalc. +class Bruteforceable t a where + getBruteCostCalc :: t -> CostCalc BruteForceOp a + +-- | Things that can have entropy +data UnknownPassword +data UnknownName diff --git a/Types/Storage.hs b/Types/Storage.hs new file mode 100644 --- /dev/null +++ b/Types/Storage.hs @@ -0,0 +1,42 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Types.Storage where + +import Types + +-- | All known locations where shares can be stored, ordered with +-- preferred locations first. +newtype StorageLocations = StorageLocations [Storage] + deriving (Monoid) + +-- | Storage interface. This can be used both for local storage, +-- an upload queue, or a remote server. +-- +-- Note that there is no interface to enumerate shares. +-- This is intentional; servers should not allow that. +data Storage = Storage + { storeShare :: StorableObjectIdent -> Share -> IO StoreResult + , retrieveShare :: ShareNum -> StorableObjectIdent -> IO RetrieveResult + , obscureShares :: IO ObscureResult + -- ^ Run after making some calls to storeShare/retrieveShare, + -- to avoid correlation attacks. + , countShares :: IO CountResult + , moveShares :: Storage -> IO () + -- ^ Tries to move all shares from this storage to another one. + } + +data StoreResult = StoreSuccess | StoreAlreadyExists | StoreFailure String + deriving (Show) + +data RetrieveResult = RetrieveSuccess Share | RetrieveFailure String + +data ObscureResult = ObscureSuccess | ObscureFailure String + deriving (Show) + +data CountResult = CountResult Integer | CountFailure String + deriving (Show) diff --git a/Types/UI.hs b/Types/UI.hs new file mode 100644 --- /dev/null +++ b/Types/UI.hs @@ -0,0 +1,27 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE RankNTypes #-} + +module Types.UI where + +import Types + +data UI = UI + { isAvailable :: IO Bool + , showError :: Desc -> IO () + , showInfo :: Title -> Desc -> IO () + , promptQuestion :: Title -> Desc -> Question -> IO Bool + , promptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name) + , promptPassword :: Bool -> Title -> Desc -> IO (Maybe Password) + , promptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId) + , withProgress :: forall a. Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a + } + +type Title = String +type Desc = String +type Percent = Int +type Problem = String +type Question = String diff --git a/UI.hs b/UI.hs new file mode 100644 --- /dev/null +++ b/UI.hs @@ -0,0 +1,44 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE BangPatterns #-} + +module UI (module UI, module Types.UI) where + +import Types.UI +import Control.Monad +import UI.Zenity +import UI.Readline +import Control.Concurrent.MVar + +availableUIs :: IO [UI] +availableUIs = filterM isAvailable [readlineUI, zenityUI] + +selectUI :: Bool -> IO UI +selectUI needgui + | needgui = do + ok <- isAvailable zenityUI + if ok + then return zenityUI + else error "zenitty is not installed, GUI not available" + | otherwise = do + l <- availableUIs + case l of + (u:_) -> return u + [] -> error "Neither zenity nor the readline UI are available" + +-- Adds a percent to whatever amount the progress bar is at. +type AddPercent = Percent -> IO () + +withProgressIncremental :: UI -> Title -> Desc -> (AddPercent -> IO a) -> IO a +withProgressIncremental ui title desc a = + withProgress ui title desc $ \setpercent -> do + v <- newMVar 0 + let addpercent = \p -> do + oldp <- takeMVar v + let !newp = oldp + p + putMVar v newp + setpercent newp + a addpercent diff --git a/UI/Readline.hs b/UI/Readline.hs new file mode 100644 --- /dev/null +++ b/UI/Readline.hs @@ -0,0 +1,167 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module UI.Readline (readlineUI) where + +import Types.UI +import Types +import System.Console.Readline +import System.Posix.Terminal +import System.Posix.IO +import Control.Exception +import System.IO +import Data.List +import Data.Char +import Text.Read +import Control.Monad +import qualified Data.ByteString.UTF8 as BU8 + +readlineUI :: UI +readlineUI = UI + { isAvailable = queryTerminal stdInput + , showError = myShowError + , showInfo = myShowInfo + , promptQuestion = myPromptQuestion + , promptName = myPromptName + , promptPassword = myPromptPassword + , promptKeyId = myPromptKeyId + , withProgress = myWithProgress + } + +myShowError :: Desc -> IO () +myShowError desc = do + hPutStrLn stderr $ "Error: " ++ desc + _ <- readline "[Press Enter]" + putStrLn "" + +myShowInfo :: Title -> Desc -> IO () +myShowInfo title desc = do + showTitle title + putStrLn desc + putStrLn "" + +myPromptQuestion :: Title -> Desc -> Question -> IO Bool +myPromptQuestion title desc question = bracket_ setup cleanup go + where + setup = do + showTitle title + putStrLn desc + cleanup = putStrLn "" + go = do + mresp <- readline $ question ++ " [y/n] " + case mresp of + Just s + | "y" `isPrefixOf` (map toLower s) -> + return True + | "n" `isPrefixOf` (map toLower s) -> + return False + _ -> do + putStrLn "Please enter 'y' or 'n'" + go + +myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name) +myPromptName title desc suggested checkproblem = + bracket_ setup cleanup go + where + setup = do + showTitle title + putStrLn desc + cleanup = putStrLn "" + go = do + case suggested of + Nothing -> return () + Just (Name b) -> addHistory (BU8.toString b) + mname <- readline "Name> " + case mname of + Just s -> do + addHistory s + let n = Name $ BU8.fromString s + case checkproblem n of + Nothing -> do + putStrLn "" + return $ Just n + Just problem -> do + putStrLn problem + go + Nothing -> return Nothing + +myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password) +myPromptPassword confirm title desc = bracket setup cleanup (const prompt) + where + setup = do + showTitle title + putStrLn desc + origattr <- getTerminalAttributes stdInput + let newattr = origattr `withoutMode` EnableEcho + setTerminalAttributes stdInput newattr Immediately + return origattr + cleanup origattr = do + setTerminalAttributes stdInput origattr Immediately + putStrLn "" + prompt = do + putStr "Enter password> " + hFlush stdout + p1 <- getLine + putStrLn "" + if confirm + then promptconfirm p1 + else return $ mkpassword p1 + promptconfirm p1 = do + putStr "Confirm password> " + hFlush stdout + p2 <- getLine + putStrLn "" + if p1 /= p2 + then do + putStrLn "Passwords didn't match, try again..." + prompt + else do + putStrLn "" + return $ mkpassword p1 + mkpassword = Just . Password . BU8.fromString + +myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId) +myPromptKeyId _ _ [] = return Nothing +myPromptKeyId title desc l = do + showTitle title + putStrLn desc + putStrLn "" + forM_ nl $ \(n, ((Name name), (KeyId kid))) -> + putStrLn $ show n ++ ".\t" ++ BU8.toString name ++ " (keyid " ++ BU8.toString kid ++ ")" + prompt + where + nl = zip [1 :: Integer ..] l + prompt = do + putStr "Enter number> " + hFlush stdout + r <- getLine + putStrLn "" + case readMaybe r of + Just n + | n > 0 && n <= length l -> do + putStrLn "" + return $ Just $ snd (l !! pred n) + _ -> do + putStrLn $ "Enter a number from 1 to " ++ show (length l) + prompt + +myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a +myWithProgress title desc a = bracket_ setup cleanup (a sendpercent) + where + setup = do + showTitle title + putStrLn desc + sendpercent p = do + putStr (show p ++ "% ") + hFlush stdout + cleanup = do + putStrLn "done" + putStrLn "" + +showTitle :: Title -> IO () +showTitle title = do + putStrLn title + putStrLn (replicate (length title) '-') + putStrLn "" diff --git a/UI/Zenity.hs b/UI/Zenity.hs new file mode 100644 --- /dev/null +++ b/UI/Zenity.hs @@ -0,0 +1,171 @@ +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module UI.Zenity (zenityUI) where + +import Types +import Types.UI +import Control.Monad +import System.Process +import Control.Exception +import System.IO +import System.FilePath +import System.Directory +import System.Exit +import qualified Data.ByteString.UTF8 as BU8 + +zenityUI :: UI +zenityUI = UI + { isAvailable = do + ps <- getSearchPath + loc <- filterM (\p -> doesFileExist (p "zenity")) ps + return (not (null loc)) + , showError = myShowError + , showInfo = myShowInfo + , promptQuestion = myPromptQuestion + , promptName = myPromptName + , promptPassword = myPromptPassword + , promptKeyId = myPromptKeyId + , withProgress = myWithProgress + } + +myShowError :: Desc -> IO () +myShowError desc = bracket go cleanup (\_ -> return ()) + where + go = runZenity + [ "--error" + , "--title", "keysafe" + , "--text", "Error: " ++ desc + ] + cleanup h = do + _ <- waitZenity h + return () + +myShowInfo :: Title -> Desc -> IO () +myShowInfo title desc = bracket go cleanup (\_ -> return ()) + where + go = runZenity + [ "--info" + , "--title", title + , "--text", desc + ] + cleanup h = do + _ <- waitZenity h + return () + +myPromptQuestion :: Title -> Desc -> Question -> IO Bool +myPromptQuestion title desc question = do + h <- runZenity + [ "--question" + , "--title", title + , "--text", desc ++ "\n" ++ question + ] + (_, ok) <- waitZenity h + return ok + +myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name) +myPromptName title desc suggested checkproblem = go "" + where + go extradesc = do + h <- runZenity + [ "--entry" + , "--title", title + , "--text", desc ++ "\n" ++ extradesc + , "--entry-text", case suggested of + Nothing -> "" + Just (Name b) -> BU8.toString b + ] + (ret, ok) <- waitZenity h + if ok + then + let n = Name $ BU8.fromString ret + in case checkproblem n of + Nothing -> return $ Just n + Just problem -> go problem + else return Nothing + +myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password) +myPromptPassword confirm title desc = go "" + where + go extradesc = do + h <- runZenity $ + [ "--forms" + , "--title", title + , "--text", desc ++ "\n" ++ extradesc ++ "\n" + , "--separator", "\BEL" + , "--add-password", "Enter password" + ] ++ if confirm + then [ "--add-password", "Confirm password" ] + else [] + (ret, ok) <- waitZenity h + if ok + then if confirm + then + let (p1, _:p2) = break (== '\BEL') ret + in if p1 /= p2 + then go "Passwords didn't match, try again..." + else return $ Just $ Password $ BU8.fromString p1 + else return $ Just $ Password $ BU8.fromString ret + else return Nothing + +myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId) +myPromptKeyId _ _ [] = return Nothing +myPromptKeyId title desc l = do + h <- runZenity $ + [ "--list" + , "--title", title + , "--text", desc + , "--column", "gpg secret key name" + , "--column", "keyid" + , "--print-column", "ALL" + , "--separator", "\BEL" + , "--width", "500" + ] ++ concatMap (\(Name n, KeyId kid) -> [BU8.toString n, BU8.toString kid]) l + (ret, ok) <- waitZenity h + if ok + then do + let (_n, _:kid) = break (== '\BEL') ret + return $ Just (KeyId (BU8.fromString kid)) + else return Nothing + +myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a +myWithProgress title desc a = bracket setup teardown (a . sendpercent) + where + setup = do + h <- runZenity + [ "--progress" + , "--title", title + , "--text", desc + , "--auto-close" + , "--auto-kill" + ] + return h + sendpercent h p = sendZenity h (show p) + teardown h = do + _ <- waitZenity h + return () + +data ZenityHandle = ZenityHandle Handle Handle ProcessHandle + +runZenity :: [String] -> IO ZenityHandle +runZenity ps = do + (Just hin, Just hout, Nothing, ph) <- createProcess + (proc "zenity" ps) + { std_out = CreatePipe + , std_in = CreatePipe + } + return $ ZenityHandle hin hout ph + +sendZenity :: ZenityHandle -> String -> IO () +sendZenity (ZenityHandle hin _ _) s = do + hPutStrLn hin s + hFlush hin + +waitZenity :: ZenityHandle -> IO (String, Bool) +waitZenity (ZenityHandle hin hout ph) = do + hClose hin + ret <- hGetContents hout + exit <- waitForProcess ph + return (takeWhile (/= '\n') ret, exit == ExitSuccess) diff --git a/keysafe.1 b/keysafe.1 new file mode 100644 --- /dev/null +++ b/keysafe.1 @@ -0,0 +1,93 @@ +.\" -*- nroff -*- +.TH keysafe 1 "Commands" +.SH NAME +keysafe \- securely back up secret keys +.SH SYNOPSIS +.B keysafe [options] +.SH DESCRIPTION +.I keysafe +securely backs up a gpg secret key or other short secret to the cloud. +.PP +This is not intended for storing Debian Developer keys that yield root on +ten million systems. It's about making it possible for users to use gpg who +currently don't, and who would find it too hard to use paperkey(1) to back +up and restore their key as they reinstall their laptop. +.PP +To get started with keysafe, you can run it without any options. If your +account has a gpg secret key, keysafe will prompt you for a password to +protect it with, and a name to store it under, and will back it up securely +to the cloud. +.PP +To restore from the backup, just run keysafe from an account that does not +have a gpg secret key (or use the --restore option to force restore mode). +Keysafe will prompt for the same name and password, and restore the key. +.PP +Note that the backup operation takes half an hour or so, +and the restore operation takes an hour or so. Keysafe encrypts +the secret key with the password in a way that takes a lot of computation +to decrypt. This makes it hard for an attacker to crack your password, +because each guess they make costs them. +.PP +Keysafe is designed so that it should take millions of dollars of computer +time to crack any fairly good password. With a truely good +password, such as four random words, the cracking cost should be many +trillions of dollars. Keysafe checks your password strength (using the +zxcvbn library), and shows an estimate of the cost to crack your password, +before backing up the key. +.PP +Whether it's safe to store your gpg secret key in the cloud is your +own decision. Keysafe comes with no warranty. +.SH OPTIONS +.PP +.IP --backup +Force backup mode. This is the default if you have a gpg secret key. +.PP +.IP --restore +Force restore mode. This is the default if you do not have a gpg secret +key. +.PP +.IP --uploadqueued +Upload any data to servers that was queued by a previous keysafe run. +This is designed to be put in a cron job. +.PP +.IP --gpgkeyid KEYID +Specify keyid of gpg key to back up or restore. This is useful if you +have multiple gpg keys. But, when this option is used to back up a key, +you have to also provide it to restore that key. +.PP +.IP --keyfile FILE +To back up anything other than a gpg secret key, use this option. +To restore from the backup, you must use this same option, and pass the +exact same filename. +.PP +.IP --totalshares M --neededshares N +These options have to be specified together. +The default values are --totalshares 3 --neededshares 2. +Keysafe uses Shamir secret sharing to create M shares of the encrypted +secret key, and each share is stored in a different server. +To restore the data, only N of the shares are needed. If you specify +these options when backing up a secret key, you also must specify them +with the same values to restore that secret key. +.PP +.IP --store-local +Store data locally, in ~/.keysafe/objects/local/. +(The default is to store data in the cloud.) +The local data storage consists of 3 (--totalshares) subdirectories, +which hold the shares of the encrypted secret key. So, you can each +subdirectory to a separate storage location, and then to restore the key, +copy 2 (--neededshares) of them back into place. +.PP +.IP --gui +Enable graphical user interface. This is the default unless keysafe +was run from a terminal. The GUI currently is implemented using zenity(1). +.PP +.IP --benchmark +Benchmark speed of keysafe's cryptographic primitives. +.PP +.IP --testmode +Avoid using expensive cryptographic operations to secure data. +Use for testing only, not with real secret keys. +.SH SEE ALSO + +.SH AUTHOR +Joey Hess diff --git a/keysafe.cabal b/keysafe.cabal new file mode 100644 --- /dev/null +++ b/keysafe.cabal @@ -0,0 +1,86 @@ +Name: keysafe +Version: 0.20160819 +Cabal-Version: >= 1.8 +Maintainer: Joey Hess +Author: Joey Hess +Stability: Experimental +Copyright: 2016 Joey Hess +License: AGPL-3 +Homepage: https://joeyh.name/code/keysafe/ +Category: Utility +Build-Type: Custom +Synopsis: back up a secret key securely to the cloud +Description: + Keysafe backs up a secret key to several cloud servers, split up + so that no one server can access the whole secret by itself. + . + A password is used to encrypt the data, and it is made expensive + to decrypt, so password cracking is infeasibly expensive. +License-File: AGPL +Extra-Source-Files: + CHANGELOG + TODO + keysafe.1 + +Executable keysafe + Main-Is: keysafe.hs + GHC-Options: -Wall -fno-warn-tabs -O2 + Build-Depends: + base (>= 4.5 && < 5.0) + , bytestring == 0.10.* + , deepseq == 1.4.* + , random == 1.1.* + , raaz == 0.0.2 + , time == 1.5.* + , containers == 0.5.* + , binary == 0.7.* + , text == 1.2.* + , utf8-string == 1.0.* + , unix == 2.7.* + , filepath == 1.4.* + , split == 0.2.* + , directory == 1.2.* + , process == 1.2.* + , optparse-applicative == 0.12.* + , readline == 1.0.* + , zxcvbn-c == 1.0.* + + -- Inlined to change the finite field size to 256 + -- for efficient serialization. + -- secret-sharing == 1.0.* + , dice-entropy-conduit >= 1.0.0.0 + , binary >=0.5.1.1 + , vector >=0.10.11.0 + , finite-field >=0.8.0 + , polynomial >= 0.7.1 + -- Temporarily inlined due to https://github.com/ocharles/argon2/issues/3 + -- argon2 == 1.1.* + Extra-Libraries: argon2 + Other-Modules: + Crypto.Argon2.FFI + Crypto.Argon2 + CmdLine + Cost + Crypto.SecretSharing.Internal + Encryption + Entropy + ExpensiveHash + Gpg + SecretKey + Serialization + Share + Storage + Storage.Local + Storage.Network + Tunables + Types + Types.Cost + Types.Storage + Types.UI + UI + UI.Readline + UI.Zenity + +source-repository head + type: git + location: git://git.joeyh.name/keysafe.git diff --git a/keysafe.hs b/keysafe.hs new file mode 100644 --- /dev/null +++ b/keysafe.hs @@ -0,0 +1,293 @@ +{-# LANGUAGE OverloadedStrings, BangPatterns #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Main where + +import Types +import Tunables +import qualified CmdLine +import UI +import Encryption +import Entropy +import ExpensiveHash +import Cost +import SecretKey +import Share +import Storage +import qualified Gpg +import Data.Maybe +import Data.Time.Clock +import Data.Time.Calendar +import Data.Monoid +import Control.DeepSeq +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BU8 +import qualified Data.Set as S +import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID) + +main :: IO () +main = do + cmdline <- CmdLine.get + ui <- selectUI (CmdLine.gui cmdline) + let mkt = CmdLine.customizeShareParams cmdline + (tunables, possibletunables) <- if CmdLine.testMode cmdline + then do + showInfo ui "Test mode" + "Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!" + return (mkt testModeTunables, [mkt testModeTunables]) + else return (mkt defaultTunables, map (mkt . snd) knownTunings) + storagelocations <- if CmdLine.localstorage cmdline + then return localStorageLocations + else allStorageLocations + dispatch cmdline ui storagelocations tunables possibletunables + +dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO () +dispatch cmdline ui storagelocations tunables possibletunables = do + mode <- CmdLine.selectMode cmdline + go mode (CmdLine.secretkeysource cmdline) + where + go CmdLine.Backup (Just secretkeysource) = + backup storagelocations ui tunables secretkeysource + =<< getSecretKey secretkeysource + go CmdLine.Restore (Just secretkeydest) = + restore storagelocations ui possibletunables secretkeydest + go CmdLine.Backup Nothing = + backup storagelocations ui tunables Gpg.anyKey + =<< Gpg.getKeyToBackup ui + go CmdLine.Restore Nothing = + restore storagelocations ui possibletunables Gpg.anyKey + go CmdLine.UploadQueued _ = + uploadQueued + go CmdLine.Benchmark _ = + benchmarkTunables tunables + +backup :: StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () +backup storagelocations ui tunables secretkeysource secretkey = do + username <- userName + Name theirname <- fromMaybe (error "Aborting on no username") + <$> promptName ui "Enter your name" + usernamedesc (Just username) validateName + go theirname + where + go theirname = do + Name othername <- fromMaybe (error "aborting on no othername") + <$> promptName ui "Enter other name" + othernamedesc Nothing validateName + let name = Name (theirname <> " " <> othername) + kek <- promptkek name + let sis = shareIdents tunables name secretkeysource + let cost = getCreationCost kek <> getCreationCost sis + r <- withProgressIncremental ui "Encrypting and storing data" + (encryptdesc cost) $ \addpercent -> do + let esk = encrypt tunables kek secretkey + shares <- genShares esk tunables + _ <- esk `deepseq` addpercent 25 + _ <- sis `seq` addpercent 25 + let step = 50 `div` sum (map S.size shares) + storeShares storagelocations sis shares (addpercent step) + case r of + StoreSuccess -> showInfo ui "Success" "Your secret key was successfully encrypted and backed up." + StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s) + StoreAlreadyExists -> do + showError ui $ unlines + [ "Another secret key is already being stored under the name you entered." + , "Please try again with a different name." + ] + go theirname + promptkek name = do + password <- fromMaybe (error "Aborting on no password") + <$> promptPassword ui True "Enter password" passworddesc + kek <- genKeyEncryptionKey tunables name password + username <- userName + let badwords = concatMap namewords [name, username] + let crackcost = estimateAttackCost spotAWS $ + estimateBruteforceOf kek $ + passwordEntropy password badwords + let mincost = Dollars 100000 + if crackcost < mincost + then do + showError ui $ "Weak password! It would cost only " ++ show crackcost ++ " to crack the password. Please think of a better one. More words would be good.." + promptkek name + else do + (thisyear, _, _) <- toGregorian . utctDay + <$> getCurrentTime + ok <- promptQuestion ui "Password strength estimate" + (crackdesc crackcost thisyear) + "Is your password strong enough?" + if ok + then return kek + else promptkek name + namewords (Name nb) = words (BU8.toString nb) + keydesc = case secretkeysource of + GpgKey _ -> "gpg secret key" + KeyFile _ -> "secret key" + usernamedesc = unlines + [ "Keysafe is going to backup your " ++ keydesc ++ " securely." + , "" + , "You will be prompted for some information. To restore your " ++ keydesc + , "at a later date, you will need to remember and enter the same information." + , "" + , "To get started, what is your name?" + ] + othernamedesc = unlines + [ "Now think of another name, which not many people know." + , "This will be used to make it hard for anyone else to find" + , "the backup of your " ++ keydesc ++ "." + , "" + , "Some suggestions:" + , "" + , otherNameSuggestions + , "" + , "Make sure to pick a name you will remember later," + , "when you restore your " ++ keydesc ++ "." + ] + passworddesc = unlines + [ "Pick a password that will be used to protect your secret key." + , "" + , "It's very important that this password be hard to guess." + , "" + , "And, it needs to be one that you will be able to remember years from now" + , "in order to restore your secret key." + ] + crackdesc crackcost thisyear = unlines $ + "Rough estimate of the cost to crack your password: " : + costOverTimeTable crackcost thisyear + encryptdesc cost = unlines + [ "This will probably take around " ++ showCostMinutes cost + , "" + , "(It's a feature that this takes a while; it makes it hard" + , "for anyone to find your data, or crack your password.)" + , "" + , "Please wait..." + ] + +otherNameSuggestions :: String +otherNameSuggestions = unlines $ map (" * " ++) + [ "Your high-school sweetheart." + , "Your first pet." + , "Your favorite teacher." + , "Your college roomate." + , "A place you like to visit." + ] + +restore :: StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO () +restore storagelocations ui possibletunables secretkeydest = do + username <- userName + Name theirname <- fromMaybe (error "Aborting on no username") + <$> promptName ui "Enter your name" + namedesc (Just username) validateName + Name othername <- fromMaybe (error "aborting on no othername") + <$> promptName ui "Enter other name" + othernamedesc Nothing validateName + let name = Name (theirname <> " " <> othername) + password <- fromMaybe (error "Aborting on no password") + <$> promptPassword ui True "Enter password" passworddesc + + let mksis tunables = shareIdents tunables name secretkeydest + r <- downloadInitialShares storagelocations ui mksis possibletunables + case r of + Nothing -> showError ui "No shares could be downloaded. Perhaps you entered the wrong name or password?" + Just (tunables, shares, sis) -> do + let candidatekeys = candidateKeyEncryptionKeys tunables name password + let cost = getCreationCost candidatekeys + <> castCost (getDecryptionCost candidatekeys) + case combineShares tunables [shares] of + Left e -> showError ui e + Right esk -> do + final <- withProgress ui "Decrypting" + (decryptdesc cost) $ \setpercent -> + go tunables [shares] sis setpercent $ + tryDecrypt candidatekeys esk + final + where + go tunables firstshares sis setpercent r = case r of + DecryptFailed -> return $ + showError ui "Decryption failed! Unknown why it would fail at this point." + DecryptSuccess secretkey -> do + _ <- setpercent 100 + writeSecretKey secretkeydest secretkey + return $ + showInfo ui "Success" "Your secret key was successfully restored!" + DecryptIncomplete kek -> do + -- Download shares for another chunk. + (nextshares, sis') <- retrieveShares storagelocations sis (return ()) + let shares = firstshares ++ [nextshares] + case combineShares tunables shares of + Left e -> return $ showError ui e + Right esk -> + go tunables shares sis' setpercent $ + decrypt kek esk + namedesc = unlines + [ "When you backed up your secret key, you entered some information." + , "To restore it, you'll need to remember what you entered back then." + , "" + , "To get started, what is your name?" + ] + othernamedesc = unlines + [ "What other name did you enter when you backed up your secret key?" + , "" + , "Back then, you were given some suggestions, like these:" + , "" + , otherNameSuggestions + ] + passworddesc = unlines + [ "Enter the password to unlock your secret key." + ] + decryptdesc cost = unlines + [ "This will probably take around " ++ showCostMinutes cost + , "" + , "(It's a feature that this takes so long; it prevents cracking your password.)" + , "" + , "Please wait..." + ] + +-- | Try each possible tunable until the initial set of +-- shares are found, the return the shares, and +-- ShareIdents to download subsequent sets. +downloadInitialShares + :: StorageLocations + -> UI + -> (Tunables -> ShareIdents) + -> [Tunables] + -> IO (Maybe (Tunables, S.Set Share, ShareIdents)) +downloadInitialShares storagelocations ui mksis possibletunables = + withProgressIncremental ui "Downloading encrypted data" message $ \addpercent -> do + go possibletunables addpercent + where + go [] _ = return Nothing + go (tunables:othertunables) addpercent = do + -- Just calculating the hash to generate the stream of idents + -- probably takes most of the time. + let !sis = mksis tunables + addpercent 50 + let m = totalObjects (shareParams tunables) + let step = 50 `div` m + (shares, sis') <- retrieveShares storagelocations sis (addpercent step) + if S.null shares + then go othertunables addpercent + else return $ Just (tunables, shares, sis') + + possiblesis = map mksis possibletunables + message = unlines + [ "This will probably take around " + ++ showCostMinutes (mconcat $ map getCreationCost possiblesis) + , "" + , "(It's a feature that this takes a while; it makes it hard" + , "for anyone else to find your data.)" + , "" + , "Please wait..." + ] + +validateName :: Name -> Maybe Problem +validateName (Name n) + | B.length n < 2 = Just "The name should be at least 2 letters long." + | otherwise = Nothing + +userName :: IO Name +userName = do + u <- getUserEntryForID =<< getEffectiveUserID + return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)