pax_global_header00006660000000000000000000000064130714031440014507gustar00rootroot0000000000000052 comment=36bd09c123887cdc287ea052b36659bf096cd095 belenios-1.4+dfsg/000077500000000000000000000000001307140314400140725ustar00rootroot00000000000000belenios-1.4+dfsg/.gitignore000066400000000000000000000000261307140314400160600ustar00rootroot00000000000000*~ _build _run env.sh belenios-1.4+dfsg/.ocamlinit000066400000000000000000000010571307140314400160550ustar00rootroot00000000000000#use "topfind";; #require "zarith";; #require "calendar";; #require "uuidm";; #require "atdgen";; #require "yojson";; #require "cryptokit";; #camlp4o;; #require "lwt.unix";; #require "lwt.syntax";; #directory "_build/src/lib";; #load "lib.cma";; let pp_print_datetime ppf x = Format.pp_print_string ppf (Serializable_builtin_j.string_of_datetime x) ;; let pp_print_uuid ppf x = Format.pp_print_string ppf (Serializable_builtin_j.string_of_uuid x) ;; #install_printer Z.pp_print;; #install_printer pp_print_datetime;; #install_printer pp_print_uuid;; belenios-1.4+dfsg/AUTHORS000066400000000000000000000002151307140314400151400ustar00rootroot00000000000000Main developer: - Stéphane Glondu Comments, review: - Pierrick Gaudry - Véronique Cortier Logo: - Alicia Filipiak CSS: - Vincent Cheval belenios-1.4+dfsg/CHANGES.md000066400000000000000000000110441307140314400154640ustar00rootroot000000000000001.4 (2017-04-05) ================ * Add a debug mode, which has the possibility to use /dev/urandom as source of entropy * Check encrypted tally in "belenios-tool verify" * Add a sample script to send credentials * Web server: + Introduce a limit on the number of mails sent at once. This effectively limits the number of voters in the general case. + Give a link to the future election to the credential authority and trustees + For each mailto template, add a direct link. This makes life easier for situations where complex mailto links are not supported. 1.3 (2017-02-01) ================ * Add support for blank votes * More diagnostics in verify-diff * Web server: + Do not log out of CAS + Automatically log out after a vote + Add Italian translation 1.2 (2016-10-05) ================ * Change the default group parameters to avoid possible trapdoors. The new ones are generated using FIPS 186-4. * Web server: + The administrator can choose the language(s) of mails sent by the server + The administrator can import trustees from a previous election + Question editor: it is now possible to insert and remove questions and answers anywhere + Add Romanian translation * Command-line tool: + Add --url option to election subcommands (in particular verify) + Add a "verify-diff" command to belenios-tool 1.1 (2016-07-25) ================ * Web server: + Internationalization of voter-facing interfaces - add French and German translations + Add a confirmation page for election finalization + Add cookie disclaimer + Add templates for mails to trustees + Add the Belenios logo and use www.belenios.org in links + Add OpenID Connect authentication for administrators * Command-line tool: + Issue a proper warning when a result is missing + Support result files where decryption factors are not in the same order as trustee public keys 1.0 (2016-04-22) ================ * Many changes in the web server: + Add election_missing_voters: it is now possible to see the list of people who did not vote (new link in election administration page). + Hide the login box when it is not relevant: We do no longer show login links in the top right hand corner of the page. The voter is automatically invited to log in when he is about to cast a vote. + Do no longer show warning when window.crypto is unavailable (this warning appeared on IE8). + In admin page, show tallied elections in a new section. + In admin page, sort (finalized) elections by finalization time. + Add a form to regenerate and mail a password. + Generating trustee keys is more resilient to momentary lack of entropy. + Change default question to make the blank choice explicit. + Print number of accepted ballots on the result page. + Add the possibility to specify a login attached to an email address. E-mail address and logins must be specified in the following way: foo@example.com,login. When login is not specified, the address is used as login. This feature is useful mainly for CAS authentication. + Voters (and passwords) can be imported from another (finalized) election. + Send a confirmation email after a successful vote. + Add a new notion of "archived" elections. + Pretty page for records. + An e-mail address can be attached to trustees. + Do not propose dummy authentication for new elections. 0.2 (2014-04-09) ================ * Major overhaul of the web server: + changes in configuration items + cleaner isolation between elections + add per-site and per-election administration pages + elections imported from the configuration file must be explicitly listed (no more directory scanning) + authentication is more modular + changes in CAS authentication method: - invoke credential requestor with `renew=true` - do not assume CAS paths start with `/cas/` + change in the password authentication method: - the password file must be uploaded via the web server (no more reading on-disk file) before the method is used for the first time + automatic logout after successful ballot casting + online creation of election * Remove hardcoded default group 0.1.1 (2014-02-13) ================== * New subcommands in belenios-tool: "mkelection" and "election vote" * Add a demo (bash) script to simulate a whole election * Prettier URLs for election pseudo-files * Fix compatibility with reverse-proxies 0.1 (2014-01-13) ================ * First public release belenios-1.4+dfsg/COPYING000066400000000000000000001033301307140314400151250ustar00rootroot00000000000000 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 . belenios-1.4+dfsg/INSTALL.md000066400000000000000000000175611307140314400155340ustar00rootroot00000000000000Belenios compilation instructions ================================= The easy way ------------ Belenios is written in OCaml and has some dependencies towards third-party OCaml libraries. The easiest and most portable way to compile Belenios from source is to use [OPAM](http://opam.ocamlpro.com/), which is a package manager for OCaml projects. The non-OCaml prerequisites are: * a POSIX system with a C compiler * [GMP](http://gmplib.org/) * [PCRE](http://www.pcre.org/) * [pkg-config](http://www.freedesktop.org/wiki/Software/pkg-config/) * [m4](https://www.gnu.org/software/m4/) * [SQLite3](https://www.sqlite.org/) * [OpenSSL](https://www.openssl.org/) * [Wget](https://www.gnu.org/software/wget/) or [curl](http://curl.haxx.se/) * [Unzip](http://www.info-zip.org/UnZip.html) * [aspcud](http://www.cs.uni-potsdam.de/wv/aspcud/) (optional) * [ncurses](http://invisible-island.net/ncurses/) * [uuidgen](https://www.kernel.org/pub/linux/utils/util-linux/) These libraries and tools are pretty common, and might be directly part of your operating system. On [Debian](http://www.debian.org/) and its derivatives, they can be installed with the following command: apt-get install build-essential libgmp-dev libpcre3-dev pkg-config m4 libssl-dev libsqlite3-dev wget ca-certificates unzip aspcud libncurses-dev uuid-runtime If you are unfamiliar with OCaml or OPAM, we provide an `opam-bootstrap.sh` shell script that creates a whole, hopefully self-contained, OCaml+OPAM install, and then installs all the dependencies of Belenios, everything into a single directory. You can choose the directory by setting the `BELENIOS_SYSROOT` environment variable, or it will take `~/.belenios` by default. Just run: ./opam-bootstrap.sh On a modern desktop system, this needs approximately 10 minutes and 1 gigabyte of disk space. If everything goes successfully, follow the given instructions to update your shell environment, then run: make all and you can skip the next two sections and go directly to the _Documentation_ section. You can also compile a debug version by using the `BELENIOS_DEBUG` environment variable: BELENIOS_DEBUG=1 make all Note that this version may introduce vulnerabilities and should not be used in production! To make sure everything went well, you can run tests: make check If you are familiar with OCaml, please read the `opam-bootstrap.sh` shell script, or the following two sections to compile Belenios with your existing OCaml installation. Command-line tool ----------------- To compile the command-line tool, you will need: * [OCaml](http://caml.inria.fr/) * [Findlib](http://projects.camlcity.org/projects/findlib.html) * [Zarith](https://forge.ocamlcore.org/projects/zarith/) * [Calendar](http://calendar.forge.ocamlcore.org/) * [Uuidm](http://erratique.ch/software/uuidm) * [Cryptokit](https://forge.ocamlcore.org/projects/cryptokit/) * [Atdgen](http://mjambon.com/atdgen) * [Yojson](http://mjambon.com/yojson.html) * [Cmdliner](http://erratique.ch/software/cmdliner) With OPAM, these dependencies can be installed with the following command: opam install atdgen zarith cryptokit uuidm calendar cmdliner Once all the dependencies have been installed, the command-line tool can be compiled with: make It produces a single executable, `belenios-tool`, in the `_build/` directory. You can install it in your `PATH` (which we will assume in the guides), or refer to it with a full path. Web server ---------- The web server has the following additional dependencies: * [Eliom](http://ocsigen.org/eliom/) * [Csv](https://forge.ocamlcore.org/projects/csv/) With OPAM, you can install them with: opam install eliom csv Once all the dependencies have been installed, the Eliom module can be compiled with: make all It will produce a single Eliom module, `server.cma`, in the `_build/src/web` directory. See `demo/ocsigenserver.conf.in` for an ocsigenserver configuration template, and the _Server administrator's guide_ for more information on how to use it. Documentation ------------- To generate HTML files from `.md` ones, you will need: * [Markdown](http://daringfireball.net/projects/markdown/) Additionnaly, you will need LaTeX to compile the specification. On Debian-based systems, you can install the dependencies needed to compile the documentation with: sudo apt-get install markdown texlive Once all the dependencies have been installed, the documentation can be compiled with: make doc Compilation using only official Debian packages ----------------------------------------------- At the time of writing (05 Apr 2016), you need the development version of Debian (or Ubuntu) to be able to compile Belenios using only official Debian packages. On Ubuntu, you need to enable the "Universe" repository. Instead of using OPAM, the dependencies of Belenios can then be installed with: sudo apt-get install libatdgen-ocaml-dev libzarith-ocaml-dev libcryptokit-ocaml-dev libuuidm-ocaml-dev libcalendar-ocaml-dev libcmdliner-ocaml-dev sudo apt-get install ocsigenserver eliom libcsv-ocaml-dev Compiling on Windows using Cygwin --------------------------------- Windows is not yet a fully supported platform, but you can compile at least the command-line tool on Windows + 32-bit [Cygwin](http://cygwin.com/index.html). You might need the following packages: * curl * dos2unix * flexdll * gcc-core * gcc-g++ * git * gmp * libgmp-devel * libncursesw-devel * libpcre-devel * libsqlite3-devel * m4 * make * ocaml * ocaml-base * ocaml-camlp4 * ocaml-compiler-libs * openssh * patch * pkg-config * zlib-devel With these packages installed, you should be able to install OPAM by following its [installation instructions from sources](http://opam.ocaml.org/doc/Install.html#FromSources). Once OPAM is installed, follow the instructions in the _Command-line tool_ section above. Troubleshooting --------------- ### OCamlDuce incompatibility OCamlDuce is an optional transitive dependency of Belenios, but Belenios does not use it. If OCamlDuce was installed outside of OPAM (e.g. via your system package manager), you may face issues. You can work around them by uninstalling OCamlDuce and restarting the installation procedure. ### Missing sources The instructions outlined in this document and in the `opam-bootstrap.sh` script imply downloading files from third-party servers. Sometimes, these servers can be down. For example, you can get: =-=-= Installing ocamlnet.3.7.3 =-=-= ocamlnet.3.7.3 Downloading http://download.camlcity.org/download/ocamlnet-3.7.3.tar.gz [ERROR] http://download.camlcity.org/download/ocamlnet-3.7.3.tar.gz is not available ===== ERROR while installing ocamlnet.3.7.3 ===== Could not get the source for ocamlnet.3.7.3. This can be worked around with the following steps: * source the generated `env.sh` file (you must adapt it if you use an incompatible shell such as tcsh); * download the file from an alternate source (for example [Debian source packages](http://www.debian.org/distrib/packages)); * run `opam pin ` (in the example above, `` would be `ocamlnet`); * resume the installation by running again the `opam install` command found in `opam-bootstrap.sh`; * follow the instructions given at the end of `opam-bootstrap.sh`. ### Errors while compiling ocsigenserver If ocsigenserver fails to install because of a SSL-related error: * edit `opam-bootstrap.sh` by adding ` ssl=0.5.2` to the `opam install` call; * run `./opam-bootstrap.sh`. An alternative could be to install aspcud before running `opam-bootstrap.sh`. ### Errors while compiling Belenios itself If you succeeded installing all dependencies, but you get errors while compiling Belenios, maybe you installed an incompatible version of a dependency. The `opam-bootstrap.sh` script is tuned to install only compatible versions; you can have a look at it to get these versions. belenios-1.4+dfsg/Makefile000066400000000000000000000017511307140314400155360ustar00rootroot00000000000000minimal: ocamlbuild minimal.otarget all: ocamlbuild all.otarget check: all demo/demo.sh clean: ocamlbuild -clean rm -f *~ tree: _build/tree.html _build/tree.html: _build/_digests mkdir -p _build tree -o $@ -H '..' -I '_build|_run|*~' .PHONY: doc doc: ocamlbuild doc.otarget $(MAKE) doc/specification.pdf doc/specification.pdf: doc/specification.tex cd doc && for u in 1 2 3; do pdflatex specification.tex; done archive: @if [ `git status --porcelain | grep -v '^?? ' | wc -l ` -eq 0 ]; then \ COMMIT_ID=`git describe --tags`; \ VERSION=`cat VERSION`; \ if [ "$$(printf $$COMMIT_ID | head -c$$(printf $$VERSION | wc -c))" = "$$VERSION" ]; then \ git archive --prefix=belenios-$$COMMIT_ID/ $$COMMIT_ID | gzip -9n > ../belenios-$$COMMIT_ID.tar.gz; \ ln -sf belenios-$$COMMIT_ID.tar.gz ../belenios.tar.gz; \ ls -l ../belenios.tar.gz; \ else \ echo "VERSION is not up-to-date!"; exit 1; \ fi; \ else \ echo "The tree is not clean!"; exit 1; \ fi belenios-1.4+dfsg/README.md000066400000000000000000000063161307140314400153570ustar00rootroot00000000000000Belenios ======== Introduction ------------ Belenios is a verifiable voting system that partly implements the Helios-C protocol described [here](http://eprint.iacr.org/2013/177), which is itself derived from [Helios](http://vote.heliosvoting.org). It consists of a command-line tool and a web server. Both use the same backend and can be used to organize elections and perform verifications. They employ messages formatted in a common format, a specification of which is available in doc/specification.tex. Compilation instructions are provided in INSTALL.md. Election overview ----------------- An election involves several roles: an administrator, a credential authority, trustees and voters. For maximum security, each of these roles must be performed by a different entity. An election can be summarized as follows: 1. The administrator initiates the process. 2. The credential authority generates one credential per voter; he sends the private part to each voter and all public parts to the administrator. 3. Each trustee generates a keypair and sends his/her public key to the administrator. 4. The administrator collects all public credentials and trustees' public keys and sets up the election. 5. The administrator opens the election. 6. Each voter votes; the administrator collects, checks and publishes all the ballots. 7. The administrator closes the election. 8. Trustees collectively decrypt the result. 9. The administrator announces the result of the election. The command-line tool --------------------- Each step can be performed with the help of the command-line tool. The tool is also the most convenient way to exercise the verifiability capabilities of the system. More information in doc/tool.md. The web server -------------- The whole process can be executed using the web server. Each step can be done with a browser. In this case, the formal "administrator" role above is typically shared between the server and a human operator. The server can also assume the roles of credential authority and trustee. Therefore, in its simplest (and weakest) form, an election involves only an operator henceforth called "election administrator" (usually distinct from the person who sets up and administrates the server itself) and voters. In its strongest form, an election involves the election administrator, a credential authority, (at least) two trustees and voters. More information in doc/web.md. Legal ----- ### Internal code By "internal code", we mean everything that is not in the `ext/` directory. Copyright © 2012-2016 Inria 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, with the additional exemption that compiling, linking, and/or using OpenSSL is allowed. 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. ### External code Please refer to each file for accurate copyright and licensing information. belenios-1.4+dfsg/RELEASE_NOTES.md000066400000000000000000000010311307140314400164370ustar00rootroot000000000000001.1 === * To upgrade a web server running version 1.0, you need to delete the Ocsipersist store (by default the `ocsidb` file referred in the configuration file). This will archive all finalized elections, and delete all unfinalized elections (i.e. the elections being prepared). Additionally, you should clean up the data directory (the one referred in the `` directive in the configuration file) by removing all temporary files (run `rm *.*` in this directory) and private keys (`rm */private_key.json`). belenios-1.4+dfsg/VERSION000066400000000000000000000000041307140314400151340ustar00rootroot000000000000001.4 belenios-1.4+dfsg/_tags000066400000000000000000000012021307140314400151050ustar00rootroot00000000000000<**/*.{ml,mli,byte,native,odoc}>: debug, annot, package(uuidm), package(atdgen), package(yojson) : package(zarith), package(calendar), package(cryptokit) : thread, package(eliom.server), package(lwt.ppx), package(csv) : package(zarith), package(calendar), package(cryptokit), package(cmdliner), use_platform-native or or : package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), package(lwt.syntax), use_platform-js <**/*serializable_j.ml>: warn(-32) true: warn(A-4-6-29-44-48), safe_string belenios-1.4+dfsg/all.itarget000066400000000000000000000004321307140314400162220ustar00rootroot00000000000000minimal.otarget src/lib/lib.cma src/web/server.cma src/static/logo.png src/static/placeholder.png src/static/belenios-tool.html.otarget src/static/vote.html.otarget src/static/tool_js_tkeygen.js src/static/tool_js_credgen.js src/static/tool_js_questions.js src/static/tool_js_pd.js belenios-1.4+dfsg/api.odocl000066400000000000000000000000571307140314400156670ustar00rootroot00000000000000Serializable_t Signatures Group_field Election belenios-1.4+dfsg/contrib/000077500000000000000000000000001307140314400155325ustar00rootroot00000000000000belenios-1.4+dfsg/contrib/send_credentials.py000077500000000000000000000050651307140314400214230ustar00rootroot00000000000000#!/usr/bin/env python3 import smtplib from email.mime.text import MIMEText from string import Template import time import getpass # In DEGUB mode, emails are sent to this address instead of the true one. # (typically the address of the credential authority) DEBUG=False DEBUG_MAIL='bozo.leclown@example.com' # Edit the following according to your election: FROM='bozo.leclown@example.com' # can be the email of the credential authority SUBJECT='Élection du meilleur cookie: votre matériel de vote' UUID='7af1a378-ed25-481a-9775-7b1a7e55c746' # Your outgoing email configuration: SMTP='smtp.example.com' username='bozo' password = getpass.getpass("please type your password: ") # name of the file where to read the credentials CODE_FILE='codefile.txt' # Edit the email template: TEMPLATE=Template(""" Bonjour, Nous vous invitons à participer à l'élection du meilleur cookie à l'adresse suivante: https://belenios.loria.fr/elections/$UUID/ Vous aurez besoin de vos identifiants LDAP ou de votre login/mot de passe, mais aussi du code de vote personnel (appelé "credential") que voici : $ELECTION_CODE Le scrutin est ouvert du 1 avril à 9h au 2 avril à 18h. Veillez bien à aller au bout des 6 étapes pour que votre vote soit pris en compte. Un mail de confirmation vous sera envoyé. Pour rappel, il y a deux candidats : Maïté et Amandine. Merci de votre participation ========================================================== Hello, You are listed as a voter for the election of the best cookie. Please visit the following link: https://belenios.loria.fr/elections/$UUID/ You will need your LDAP or login / password, and also the following credential (personal code): $ELECTION_CODE The election is open from April 1st, 9am to April 2nd, 6pm. Be sure to go through the 6 steps to ensure that your vote is taken into account. A confirmation email will be sent. Reminder: there are two candidates Maïté and Amandine. Thank you for your participation. """) # Real stuf starts here. Pretty short, isn't it? with open(CODE_FILE) as cf: d = dict(UUID=UUID) s = smtplib.SMTP(SMTP) s.starttls() s.login(username, password) for line in cf: l = line.split() d['ELECTION_CODE']=l[1] msg = MIMEText(TEMPLATE.substitute(d)) email=l[0].split(",")[0] msg['Subject'] = SUBJECT msg['From'] = FROM if DEBUG: msg['To'] = DEBUG_MAIL else: msg['To'] = email s.send_message(msg) time.sleep(0.2) # short delay; might need more for very large election s.quit() belenios-1.4+dfsg/demo/000077500000000000000000000000001307140314400150165ustar00rootroot00000000000000belenios-1.4+dfsg/demo/data/000077500000000000000000000000001307140314400157275ustar00rootroot00000000000000belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/000077500000000000000000000000001307140314400222605ustar00rootroot00000000000000belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/election.json000066400000000000000000000044541307140314400247640ustar00rootroot00000000000000{"description":"This is a test election.","name":"Test election","public_key":{"group":{"g":"14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533","p":"16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071","q":"61329566248342901292543872769978950870633559608669337131139375508370458778917"},"y":"14635082878118572654479921080249944001812293038810422159343238089595479240882299219246906288014009621479772514986719666120580071805977517512709536449580704387040200602501172760388225540685840285411774228955056554894778199335402959258815158862988075365242410449387167116346296481514414882426546780519521778091037414413395238663990507052035474205192620851516755387953867800973935897054822286902740224243498380336367014173394548123266419420289185997583417780349142205089750866593480737143971921887353321220824821931497851896766898090557192411266787781010869883177247094501345068629045693383217704047201748215908551010065"},"questions":[{"answers":["a","b","c","d","e"],"min":0,"max":1,"question":"Question 1?"},{"answers":["a","b","c","d","e","f"],"min":2,"max":3,"question":"Question 2?"},{"answers":["a","b","c"],"min":1,"max":1,"question":"Question 3?"}],"uuid":"6d122f00-2650-4de8-87de-30037a21f943","short_name":"test"} belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/hashed_public_creds.txt000066400000000000000000000013541307140314400267760ustar00rootroot0000000000000010 78fbc40b46a0d8fbd0959bcabbd960d118db07095c0a463ca87fccf059b8715e 11 1c6cc6bd8015c298d23fe6c8e6f0e3c40e80b1c01a51516fcad653a8e44e558b 12 b4be90a3583a4deeb8012b6905df2420a86e7b1d06906a1d9fb9695efaea5ffb 13 fab1383f26d4029d0750cde3ce3c23b926b53117fcec63132a86ca82685abdb1 14 4ad432b511490a52101d9267787a37d1292f6d514bc5475dee90627d4a1a4691 15 9951422ac5b6ee9e27c677092ca078ed50aefe56ee4a01675a2bc2a3e75cb812 16 4dbdc1f056584694f852185f8e5543db6e2a1af3d5535d41e5df766db28d33a5 17 72bef7daf72605177be48c6c33309d5cfc81c409a20173d1714762e719001e4c 18 d812d6a43fe42d464ed0a9d530777834fcccc3a4a6b6fb85026ec3027b70c9f3 19 8aff557fe1e1a924b3c2cf4c15c56a195cd5a31c5650d840d5fb9c31b52b7fbf 20 6279249bf13b16f2f27387513270ac7312e9141f4088d8801a090685e12777bd belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/metadata.json000066400000000000000000000001731307140314400247340ustar00rootroot00000000000000{"owner":{"domain":"demo","name":"admin"},"auth_config":[{"auth_system":"dummy","auth_instance":"demo","auth_config":[]}]} belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/private_creds.txt000066400000000000000000000003211307140314400256470ustar00rootroot0000000000000010 HsqB3C3y62Ekq4D 11 p6daZwYojpKg1Ja 12 qGnAWQdTbw2TVxf 13 Bn8t5PtC9EDC5wd 14 cF4uzN1qRWGkPQW 15 Ak7yGRGcxC5EN9o 16 MbJL9tXDnX2KuA8 17 GDkn18MG1Y8d6AE 18 xZifA2wkZVzANyh 19 NukC6hSSm7AU25N 20 FSCHesimUonmFcX belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/private_keys.jsons000066400000000000000000000002371307140314400260450ustar00rootroot00000000000000"9600046171371266358328616343161466905101638659943090708733129049062697628544" "53655776381189087226481245629930397938597271135267524399539248211815395676810" belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/public_creds.txt000066400000000000000000000152061307140314400254630ustar00rootroot0000000000000012821148605952984544760889842541783652995936458797805359873185240470923998658741906650004571172973116730280167928180381707306158430093669866569466802522854974307338320319664261287166086053060812214922094495366373891610300137781219875304026158467314207520155759278469663560134035556654418797256292553637317160630332371863419391125494940751655295712149753455314957562093905105374009329418829591150209548637139210636319865210434820182897099554681003882753620340365557282722129604553566811810001408342402194765830196780197107862545710930140361966586030469793371536305101406153820619823355956607130182541702013930841341521 12916210039107128665462871982817523017879074124921228210811731905234984800289629620126369202737920406641613398086092285204754736564479157220216059870418683973912513767227564136990498803655822850300268201745266868832668543635328203949126432435084428569537222093862881965869331957143068779286098078732495796290700680480266285365620904937223330428222246309454647369898608122387876955705105543698897510404309689993259288111314365073719516106026372856771460113434169212700530434270567020417429451005263293929579947893785338211022272023044177081309504149242022600418854645076879742120472365207081560762903739082212605886587 14674864957339153852505913711939706040267825580247016902336000933896030304875356396275561693529722847130790286501672133854563299332702327120144246050113541693308768371219102843300891427941565331808303386652072484814509565983392753138003678245713355639255100357927131221177328159635348568699468841601501535356022622353158198218355574179173130172628103918248763723241863179728392154280944649289690591095983355137971480233514386802388050339823761441824866215512398271797017898979737471538260059022177549235405761100861908921968361718176091279726090483444169137877349168121897279033787677304057001785684121694666659973512 2221355242458157707021840469698299737474912907235158809140700540189330012054803534654837102221100003391420953420194694622728848790567038956551258836171783356235032810099670637844909974615303163216025500854811145569649589253199249753873501217588248019680775470134459649733815263990838262049871552913886868001068216855220751643985244743798925161009381402114076683483862306729750535020230928029950208895359407217113230269665172177802110253776595800192383509890507741306791260213028328559318123573915067694364162370445115210040265678263995848373685144907553394523781082701945812585323541699238238449921061906081888525763 2932347112123979279950158982087198655433552938220417023380816267001934863819001007522790840469001768338025593319860644274272934631553789389056335674963598499889998920105398023042976449861390044991657481091662252664879480013971382087274329403561227622710676167819191513822010616561252801626013782927724383598028779790744500263232235960132419349064564935665563669840911346281236341963502883075149974702725735940286404803437417732023855435189144636492636288930231509229739340519636939181143187014927614313426013372473754155278928702652041557595686818577286801988065078853241828523560039837183564574609976172394350521138 4082932203753073754417844744117522411410290571464179286216056344656379974026921764651697120445244508572518004752905214981083405160527317987755675986659150943921870595831562213246465535543260427796984086516821441251300260388937417209905897285783649400566143816526377845002598929064896248512185493968741088788162694313299162906987477790390468125177494182529895266055568002708726318562845117127339432819472348438035138662351316018714511802574486139515987912515041829772197663776556539922441546337076526308591086313023035422070423613203169890852348954379649345243166612059044085704467200109401839505943752955885814326960 4357979345745019164137298295975820492006083194777597416940569360943624562812954088842405641207440165847815793265076745909348480568868633142340117232015720969603952747454628450925308755707551651046973859378834688613892180600924054507402367183807224356075212054800172994767900918553185772386827644002323955269011205926376149862988597178570326479642870843651137052133527962324049264429589390074620528189480679565796463310750956854050733523862411350841598623724893620868094354005140670696278533709278257726275577882202492627050001012222673085378794203636223895600069014246074545395174576890404850883802055157198529345202 5741008643571559481915100969776655993651502567740380069796921724693341298664237324988659681470550570276411944723678396976290132132011658285900979749779365244156795722582435307537106638312184967179637297484368915527703141318458194842750727266867121531776186782006845518120335912981045971698432210797372311438796929301619249586252984271439761809612761084460288644117495694862197967144326335232466773968059435098764334529903518788712623545999858433274075755874300622992770251766083588508815874746204923476442364091278122920430098864103224159314576915898203242403026732539012267713803573680076954870797446479736890576730 7501865618256637074408041134128157679617467968206426848463227439745391551821960264456613700629297709181227781916325929022537053109093814905176606403988549708366825032253903031858355294215808193663694310463361937606946654468823047420217362044504416130330519457671413345697887345996861518765584342208928067361698673608413671971809159752271479860165852314100855050800484634454653619715040102457635504331240973958150154916175216859036650810019453462035198930647815263151850295651483990038310226388626811212627805282446164410158337154965878861614113143876772737552114558727420280422537877212083692913726159486491362561436 9469333065238600523561998838217015564584879582017726086519390367999547696516572568174845463450385161920162807372115893045192364950476425579694432007806129673715117816866647253508596438862970680902015493326939047590087214113823321897008000701860082715983132974077957685982126511257631708173978813176607909609955183512341952743032914943209779703475829476805601448900960658761483625396788665300441537467920004044596053104424665268627131497699738580567565334260414360462562013584919491403125339432052448867851854762934078160818129933591083109181505571731287550392154625364765907604124588454078140865209343171920759318759 9913418346634216632818377836292472538914380697506100471418516491471021631483277833968210636650323719537724627791467049533922407911645409779670497849777911543320304294457396501546734295357184648171227241306807211089266481287460057841005042519111569259185125973842871923974704043080198008794227796751850975230191930970912077450640645426907622282708744105967835507535146071395383632299850723306813477725951201628369206166107400574930183333401444126783384104588120551368056442896471383087680510781270106112787311210923217374404237916485781875145691988847907863214914963561283710204486155012684658508992353877375741020693 belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/public_keys.jsons000066400000000000000000000031621307140314400256510ustar00rootroot00000000000000{"pok":{"challenge":"49253835875688215480303040712975641939449998725720650273890574275119699892199","response":"35960270992659874796390333476558071240144894347474659693404398510944635277001"},"public_key":"4130309479050310785588803003799175864250543971804189793968919324200477734697810059763631539438036073038178926714422709506063553893435956871413894188503965023132707149869964218525713102804650128526336351566034852371736441155704862791610920288413996488876905272045597984516135393344109876056562216520594230353546877387569956101851195763843192089450155590369315352762650709712686551945735518323900111749060580699773743676201562383303645381103627778440460854101752273860535798354116608436622497825222346944292638416506142723226423289655984068152092273348967894185615781393847933926595940678779516218466876036558072035268"} {"pok":{"challenge":"41565449212291247652921537420346114660658332454116526238513560067875507128079","response":"14440376305059194868705326348923866406701380798837611269349528384987551722927"},"public_key":"5215560899172444407130424319213683694051000716257457119130381566360174029617501243974443328385840893843828396429566437986143187766540097743809858735292442828221080192297727742120718566721438190244611216917472468446934752906450013257316406265121307296224119775915481819794715887505265725215570958192145278933724483926678341611259431220856601820908061113574158011315602495397285249047526691738424611247906328472423148071255520485683052002968460988700719115849891775375265752593433544571311921664618697422430109727500355400015726425499435588069406310231185025013708018711724117187751385851843858607124369613952623078809"} belenios-1.4+dfsg/demo/data/6d122f00-2650-4de8-87de-30037a21f943/voters.txt000066400000000000000000000003211307140314400243370ustar00rootroot00000000000000user10@example.com user11@example.com user12@example.com user13@example.com user14@example.com user15@example.com user16@example.com user17@example.com user18@example.com user19@example.com user20@example.com belenios-1.4+dfsg/demo/data/index.json000066400000000000000000000001031307140314400177230ustar00rootroot00000000000000[{"dir":"6d122f00-2650-4de8-87de-30037a21f943","featured":"true"}] belenios-1.4+dfsg/demo/demo.sh000077500000000000000000000040221307140314400162770ustar00rootroot00000000000000#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$PWD} belenios-tool () { $BELENIOS/_build/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } header "Setup election" UUID=`uuidgen` echo "UUID of the election is $UUID" DIR=$BELENIOS/demo/data/$UUID mkdir $DIR cd $DIR # Common options uuid="--uuid $UUID" group="--group $BELENIOS/demo/groups/default.json" # Generate credentials belenios-tool credgen $uuid $group --count 5 mv *.pubcreds public_creds.txt mv *.privcreds private_creds.txt # Generate trustee keys belenios-tool trustee-keygen $group belenios-tool trustee-keygen $group belenios-tool trustee-keygen $group cat *.pubkey > public_keys.jsons # Generate election parameters belenios-tool mkelection $uuid $group --template $BELENIOS/demo/templates/questions.json header "Simulate votes" cat > votes.txt <&2 echo >&2 done > ballots.tmp mv ballots.tmp ballots.jsons header "Perform verification" belenios-tool verify header "Simulate and verify update" tdir="$(mktemp -d)" cp election.json public_creds.txt public_keys.jsons "$tdir" head -n3 ballots.jsons > "$tdir/ballots.jsons" belenios-tool verify-diff --dir1="$tdir" --dir2=. rm -rf "$tdir" header "Perform decryption" for u in *.privkey; do belenios-tool decrypt --privkey $u echo >&2 done > partial_decryptions.tmp mv partial_decryptions.tmp partial_decryptions.jsons header "Finalize tally" belenios-tool finalize header "Perform final verification" belenios-tool verify echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR/result.json" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-1.4+dfsg/demo/groups/000077500000000000000000000000001307140314400163355ustar00rootroot00000000000000belenios-1.4+dfsg/demo/groups/default.json000066400000000000000000000024651307140314400206630ustar00rootroot00000000000000{"g":"2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627","p":"20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719","q":"78571733251071885079927659812671450121821421258408794611510081919805623223441"} belenios-1.4+dfsg/demo/groups/rfc3526-2048.json000066400000000000000000000023521307140314400207170ustar00rootroot00000000000000{"g":"2","p":"32317006071311007300338913926423828248817941241140239112842009751400741706634354222619689417363569347117901737909704191754605873209195028853758986185622153212175412514901774520270235796078236248884246189477587641105928646099411723245426622522193230540919037680524235519125679715870117001058055877651038861847280257976054903569732561526167081339361799541336476559160368317896729073178384589680639671900977202194168647225871031411336429319536193471636533209717077448227988588565369208645296636077250268955505928362751121174096972998068410554359584866583291642136218231078990999448652468262416972035911852507045361090559","q":"16158503035655503650169456963211914124408970620570119556421004875700370853317177111309844708681784673558950868954852095877302936604597514426879493092811076606087706257450887260135117898039118124442123094738793820552964323049705861622713311261096615270459518840262117759562839857935058500529027938825519430923640128988027451784866280763083540669680899770668238279580184158948364536589192294840319835950488601097084323612935515705668214659768096735818266604858538724113994294282684604322648318038625134477752964181375560587048486499034205277179792433291645821068109115539495499724326234131208486017955926253522680545279"} belenios-1.4+dfsg/demo/groups/weak.json000066400000000000000000000000361307140314400201560ustar00rootroot00000000000000{"g":"2","p":"263","q":"131"} belenios-1.4+dfsg/demo/ocsigenserver.conf.in000066400000000000000000000031321307140314400211470ustar00rootroot00000000000000 8001 _RUNDIR_/log _RUNDIR_/lib _RUNDIR_/upload 128kB _TMPDIR_/run/ocsigenserver_command utf-8 belenios-1.4+dfsg/demo/password_db.csv000066400000000000000000000006751307140314400200520ustar00rootroot00000000000000user1,oofeibae,ea66a656b159beaec4a10e6a2b18abf0ff348d1bd74dcb9019bc763b2df67c27,phiexoey user2,laigezae,5a4230902e6dfb96e5b0ebe71b1ce88e9b37f8802dc075d046e62985e14909d2,eiseesho user3,ivoorool,41c0f0c2e4b7db2d3d0e7e586bd8c31342eefec60d695a55395879dd6ff0357b,heethiax user4,ceedohgh,c235819606ff698aa44cde97fc94ec8b91aeea8b0b68c137238dedae4c33ab01,liuyeige user5,yeorogai,7727130f59b76646d4c3d6a9f3b6f4bede8a85210cb54bda913737c3e376168b,feoridee belenios-1.4+dfsg/demo/run-server.sh000077500000000000000000000013051307140314400174640ustar00rootroot00000000000000#!/bin/sh if [ ! -d _build ]; then echo "This script should be run from the root of the (built) source tree!" exit 1 fi BELENIOS_RUNDIR=${BELENIOS_RUNDIR:-_run} BELENIOS_TMPDIR=${BELENIOS_TMPDIR:-/tmp/belenios} OCAML_STDLIBDIR=$(ocamlc -where) mkdir -p \ $BELENIOS_RUNDIR/etc \ $BELENIOS_RUNDIR/log \ $BELENIOS_RUNDIR/lib \ $BELENIOS_RUNDIR/upload \ $BELENIOS_RUNDIR/spool \ $BELENIOS_TMPDIR/run sed \ -e "s@_OCAML_STDLIBDIR_@$OCAML_STDLIBDIR@g" \ -e "s@_TMPDIR_@$BELENIOS_TMPDIR@g" \ -e "s@_RUNDIR_@$BELENIOS_RUNDIR@g" \ -e "s@_SRCDIR_@$PWD@g" \ demo/ocsigenserver.conf.in > $BELENIOS_RUNDIR/etc/ocsigenserver.conf ocsigenserver -c $BELENIOS_RUNDIR/etc/ocsigenserver.conf "$@" belenios-1.4+dfsg/demo/templates/000077500000000000000000000000001307140314400170145ustar00rootroot00000000000000belenios-1.4+dfsg/demo/templates/questions.json000066400000000000000000000004021307140314400217350ustar00rootroot00000000000000{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"},{"answers":["Answer 1","Answer 2"],"blank":true,"min":1,"max":1,"question":"Question 2?"}]} belenios-1.4+dfsg/doc.itarget000066400000000000000000000000741307140314400162210ustar00rootroot00000000000000api.docdir/index.html README.html INSTALL.html CHANGES.html belenios-1.4+dfsg/doc/000077500000000000000000000000001307140314400146375ustar00rootroot00000000000000belenios-1.4+dfsg/doc/.gitignore000066400000000000000000000000361307140314400166260ustar00rootroot00000000000000*.aux *.log *.out *.toc *.pdf belenios-1.4+dfsg/doc/fips.sage000066400000000000000000000036551307140314400164520ustar00rootroot00000000000000import hashlib ###################################################################### ### Generate p and q according to FIPS 186-4, section A.1.1.2 L = 2048 N = 256 seedlen = 358 # not used outlen = 256 seed = "Belenios: Verifiable online voting system " def stringToInt(string): seq = [ ord(x) for x in string] res = ZZ(seq, 256) return res def intToString(number): seq = number.digits(base=256) seq = [ chr(x) for x in seq ] return reduce(lambda a, b: a + b, seq) # hash integer to an integer with SHA256 def Hash(number): string = intToString(number) return int(hashlib.sha256(string).hexdigest(), 16) assert seedlen >= N n = (L/outlen).n().ceiling() - 1 b = L-1-(n*outlen) count = 0 found = False while True: domain_parameter_seed = stringToInt(seed + str(count)) U = Hash(domain_parameter_seed) % 2^(N-1) q = 2^(N-1) + U + 1 - (U % 2) count += 1 if q.is_prime(): break offset = 1 counter = 0 while counter < 4*L: V = [ Hash(domain_parameter_seed + offset + j) for j in range(0,n+1) ] W = V[0] for j in range(1, n): W += V[j]*2^(outlen*j) W += (V[n] % 2^b)*2^(n*outlen) X = W + 2^(L-1) c = X % (2*q) p = X - (c-1) if p > 2^(L-1) and p.is_pseudoprime(): found = True break offset = offset + n + 1 counter += 1 if found: print "p = " + str(p) print "q = " + str(q) print "domain_parameter_seed = " + str(domain_parameter_seed) print "counter = " + str(counter) else: print "Not found" ###################################################################### ### Generate g according to section A.2.3 index = 0 N = q.nbits() e = (p-1)//q count = 1 U = count + 2^16*(index + 2^16*(0x6767656E + 2^32*domain_parameter_seed)) W = Hash(U) g = int(GF(p, proof=False)(W)^e) assert g >= 2 print "g = " + str(g) print "Checking primality of p (not only pseudo-primality), this will take some time..." assert p.is_prime() belenios-1.4+dfsg/doc/specification.tex000066400000000000000000000646011307140314400202100ustar00rootroot00000000000000\documentclass[a4paper]{article} \usepackage{a4wide} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{lmodern} \usepackage{amsmath} \usepackage{bbm} \usepackage{hyperref} \newcommand{\version}{0.2} \newcommand{\F}{\mathbbm{F}} \newcommand{\G}{\mathbbm{G}} \newcommand{\Z}{\mathbbm{Z}} \newcommand{\N}{\mathbbm{N}} \newcommand{\I}{\mathbbm{I}} \newcommand{\B}{\mathbbm{B}} \newcommand{\public}{\textsf{public}} \newcommand{\shuffle}{\textsf{shuffle}} \newcommand{\basesixfour}{\textsf{BASE64}} \newcommand{\shatwo}{\textsf{SHA256}} \newcommand{\jstring}{\texttt{string}} \newcommand{\uuid}{\texttt{uuid}} \newcommand{\tpk}{\texttt{trustee\_public\_key}} \newcommand{\election}{\texttt{election}} \newcommand{\ballot}{\texttt{ballot}} \newcommand{\etally}{\texttt{encrypted\_tally}} \newcommand{\pdecryption}{\texttt{partial\_decryption}} \newcommand{\result}{\texttt{result}} \title{Belenios specification} \date{Version~\version} \author{Stéphane Glondu} \begin{document} \maketitle \tableofcontents \section{Introduction} This document is a specification of the voting protocol implemented in Belenios v\version. More discussion, theoretical explanations and bibliographical references can be found in a technical report available online.\footnote{\url{http://eprint.iacr.org/2013/177}} The Belenios protocol is very similar to Helios (with a signature added to ballots and different zero-knowledge proofs) and Helios-C (with the distributed key generation of trustees of Helios, without threshold support). The cryptography involved in Belenios needs a cyclic group $\G$ where discrete logarithms are hard to compute. We will denote by $g$ a generator and $q$ its order. We use a multiplicative notation for the group operation. For practical purposes, we use a multiplicative subgroup of $\F^*_p$ (hence, all exponentiations are implicitly done modulo $p$). We suppose the group parameters are agreed on beforehand. Default group parameters are given as examples in section~\ref{default-group}. \section{Parties} \begin{itemize} \item $S$: voting server \item $A$: server administrator \item $C$: credential authority \item $T_1,\dots,T_m$: trustees \item $V_1,\dots,V_n$: voters \end{itemize} \section{Processes} \label{processes} \subsection{Election setup} \label{election-setup} \begin{enumerate} \item $A$ generates a fresh \hyperref[basic-types]{$\uuid$} $u$ and sends it to $C$ \item $C$ generates \hyperref[credentials]{credentials} $c_1,\dots,c_n$ and computes $L=\shuffle(\public(c_1),\dots,\public(c_n))$ \item for $j\in[1\dots n]$, $C$ sends $c_j$ to $V_j$ \item $C$ forgets $c_1,\dots,c_n$ \item $C$ forgets the mapping between $j$ and $\public(c_j)$ if credential recovery is not needed \item $C$ sends $L$ to $A$ \item for $z\in[1\dots m]$, \begin{enumerate} \item $T_z$ generates a \hyperref[trustee-keys]{$\tpk$} $k_z$ and sends it to $A$ \item $A$ checks $k_z$ \end{enumerate} \item $A$ combines all the trustee public keys into the election public key $y$ \item $A$ creates the \hyperref[elections]{$\election$} $E$ \item $A$ loads $E$ and $L$ into $S$ and starts it \end{enumerate} \subsection{Vote} \begin{enumerate} \item $V$ gets $E$ \item $V$ creates a \hyperref[ballots]{$\ballot$} $b$ and submits it to $S$ \item $S$ validates $b$ and publishes it \end{enumerate} \subsection{Credential recovery} \begin{enumerate} \item $V$ contacts $C$ \item $C$ looks up $V$'s public credential $\public(c_i)$ and generates a new credential $c'_i$ \item $C$ sends $c'_i$ to $V$ and forgets it \item $C$ sends $\public(c_i)$ and $\public(c'_i)$ to $A$ \item $A$ checks that $\public(c_i)$ has not been used and replaces it by $\public(c'_i)$ in $L$ \end{enumerate} \subsection{Tally} \begin{enumerate} \item $A$ stops $S$ and computes the \hyperref[tally]{$\etally$} $\Pi$ \item for $z\in[1\dots m]$, \begin{enumerate} \item $A$ sends $\Pi$ to $T_z$ \item $T_z$ generates a \hyperref[tally]{$\pdecryption$} $\delta_z$ and sends it to $A$ \item $A$ verifies $\delta_z$ \end{enumerate} \item $A$ combines all the partial decryptions, computes and publishes the election \hyperref[election-result]{\result} \end{enumerate} \section{Messages} \label{messages} \subsection{Conventions} Structured data is encoded in JSON (RFC 4627). There is no specific requirement on the formatting and order of fields, but care must be taken when hashes are computed. We use the notation $\textsf{field}(o)$ to access the field \textsf{field} of $o$. \subsection{Basic types} \label{basic-types} \begin{itemize} \item $\jstring$: JSON string \item $\uuid$: UUID (see RFC 4122), encoded as a JSON string \item $\I$: small integer, encoded as a JSON number \item $\B$: boolean, encoded as a JSON boolean \item $\N$, $\Z_q$, $\G$: big integer, written in base 10 and encoded as a JSON string \end{itemize} \subsection{Common structures} \label{common} \newcommand{\pk}{\texttt{public\_key}} \newcommand{\sk}{\texttt{private\_key}} \newcommand{\proof}{\texttt{proof}} \newcommand{\iproof}{\texttt{iproof}} \newcommand{\ciphertext}{\texttt{ciphertext}} \newcommand{\pklabel}{\textsf{public\_key}} \newcommand{\pok}{\textsf{pok}} \newcommand{\challenge}{\textsf{challenge}} \newcommand{\response}{\textsf{response}} \newcommand{\alphalabel}{\textsf{alpha}} \newcommand{\betalabel}{\textsf{beta}} \newcommand{\Hash}{\mathcal{H}} \begin{gather*} \proof=\left\{ \begin{array}{rcl} \challenge&:&\Z_q\\ \response&:&\Z_q \end{array} \right\} \qquad \ciphertext=\left\{ \begin{array}{rcl} \alphalabel&:&\G\\ \betalabel&:&\G \end{array} \right\} \end{gather*} \subsection{Trustee keys} \label{trustee-keys} \begin{gather*} \pk=\G\qquad\sk=\Z_q\\ \tpk=\left\{ \begin{array}{rcl} \pok&:&\proof\\ \pklabel&:&\pk \end{array} \right\} \end{gather*} A private key is a random number $x$ modulo $q$. The corresponding $\pklabel$ is $X=g^x$. A $\tpk$ is a bundle of this public key with a \hyperref[common]{$\proof$} of knowledge computed as follows: \begin{enumerate} \item pick a random $w\in\Z_q$ \item compute $A=g^w$ \item $\challenge=\Hash_\pok(X,A)\mod q$ \item $\response=w+x\times\challenge\mod q$ \end{enumerate} where $\Hash_\pok$ is computed as follows: \[\Hash_\pok(X,A) = \shatwo(\verb=pok|=X\verb=|=A) \] where $\pok$ and the vertical bars are verbatim and numbers are written in base 10. The result is interpreted as a 256-bit big-endian number. The proof is verified as follows: \begin{enumerate} \item compute $A={g^\response}/{y^\challenge}$ \item check that $\challenge=\Hash_\pok(\pklabel,A)\mod q$ \end{enumerate} \subsection{Credentials} \label{credentials} \newcommand{\secret}{\texttt{secret}} A secret \emph{credential} $c$ is a 15-character string, where characters are taken from the set: \[\texttt{123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz}\] The first 14 characters are random, and the last one is a checksum to detect typing errors. To compute the checksum, each character is interpreted as a base 58 digit: $\texttt{1}$ is $0$, $\texttt{2}$ is $1$, \dots, $\texttt{z}$ is $57$. The first 14 characters are interpreted as a big-endian number $c_1$ The checksum is $53-c_1\mod 53$. From this string, a secret exponent $s=\secret(c)$ is derived by using PBKDF2 (RFC 2898) with: \begin{itemize} \item $c$ as password; \item HMAC-SHA256 (RFC 2104, FIPS PUB 180-2) as pseudorandom function; \item the $\uuid$ (interpreted as a 16-byte array) of the election as salt; \item $1000$ iterations \end{itemize} and an output size of 1 block, which is interpreted as a big-endian 256-bit number and then reduced modulo $q$ to form $s$. From this secret exponent, a public key $\public(c)=g^s$ is computed. \subsection{Election} \label{elections} \newcommand{\question}{\texttt{question}} \begin{gather*} \texttt{wrapped\_pk}=\left\{ \begin{array}{rcl} \textsf{g}&:&\G\\ \textsf{p}&:&\N\\ \textsf{q}&:&\N\\ \textsf{y}&:&\G \end{array} \right\} \end{gather*} The election public key, which is denoted by $y$ thoughout this document, is computed by multiplying all the public keys of the trustees, and bundled with the group parameters in a \texttt{wrapped\_pk} structure. \newcommand{\blank}{\textsf{blank}} \newcommand{\minlabel}{\textsf{min}} \newcommand{\maxlabel}{\textsf{max}} \newcommand{\answers}{\textsf{answers}} \begin{gather*} \question=\left\{ \begin{array}{rcl} \answers&:&\jstring^\ast\\ ?\blank&:&\B\\ \minlabel&:&\I\\ \maxlabel&:&\I\\ \textsf{question}&:&\jstring \end{array} \right\} \qquad \election=\left\{ \begin{array}{rcl} \textsf{description}&:&\jstring\\ \textsf{name}&:&\jstring\\ \textsf{public\_key}&:&\texttt{wrapped\_pk}\\ \textsf{questions}&:&\texttt{question}^\ast\\ \textsf{uuid}&:&\texttt{uuid} \end{array} \right\} \end{gather*} The $\blank$ field of $\question$ is optional. When present and true, the voter can vote blank for this question. In a blank vote, all answers are set to $0$ regardless of the values of $\minlabel$ and $\maxlabel$ ($\minlabel$ doesn't need to be $0$). \newcommand{\answer}{\texttt{answer}} \newcommand{\signature}{\texttt{signature}} \newcommand{\iproofs}{\textsf{individual\_proofs}} \newcommand{\oproof}{\textsf{overall\_proof}} \newcommand{\bproof}{\textsf{blank\_proof}} \newcommand{\choices}{\textsf{choices}} \newcommand{\iprove}{\textsf{iprove}} During an election, the following data needs to be public in order to verify the setup phase and to validate ballots: \begin{itemize} \item the $\election$ structure described above; \item all the $\tpk$s that were generated during the \hyperref[election-setup]{setup phase}; \item the set $L$ of public credentials. \end{itemize} \subsection{Encrypted answers} \label{answers} \begin{gather*} \answer=\left\{ \begin{array}{rcl} \choices&:&\ciphertext^\ast\\ \iproofs&:&\iproof^\ast\\ \oproof&:&\iproof\\ ?\bproof&:&\proof^2 \end{array} \right\} \end{gather*} An answer to a \hyperref[elections]{$\question$} is the vector $\choices$ of encrypted weights given to each answer. When $\blank$ is false (or absent), a blank vote is not allowed and this vector has the same length as $\answers$; otherwise, a blank vote is allowed and this vector has an additionnal leading weight corresponding to whether the vote is blank or not. Each weight comes with a proof (in \iproofs, same length as \choices) that it is $0$ or $1$. The whole answer also comes with additional proofs that weights respect constraints. More concretely, each weight $m\in[0\dots1]$ is encrypted into a $\ciphertext$ as follows: \begin{enumerate} \item pick a random $r\in\Z_q$ \item $\alphalabel=g^r$ \item $\betalabel=y^rg^m$ \end{enumerate} where $y$ is the election public key. To compute the proofs, the voter needs a \hyperref[credentials]{credential} $c$. Let $s=\secret(c)$, and $S=g^s$ written in base 10. The individual proof that $m\in[0\dots1]$ is computed by running $\iprove(S,r,m,0,1)$ (see section~\ref{iproof}). When a blank vote is not allowed, $\oproof$ proves that $M\in[\minlabel\dots\maxlabel]$ and is computed by running $\iprove(S,R,M-\minlabel,\minlabel,\dots,\maxlabel)$ where $R$ is the sum of the $r$ used in ciphertexts, and $M$ the sum of the $m$. There is no $\bproof$. When a blank vote is allowed, and there are $n$ choices, the answer is modeled as a vector $(m_0,m_1,\dotsc,m_n)$, when $m_0$ is whether this is a blank vote or not, and $m_i$ (for $i>0$) is whether choice $i$ has been selected. Each $m_i$ is encrypted and proven equal to $0$ or $1$ as above. Let $m_\Sigma=m_1+\dotsb+m_n$. The additionnal proofs are as follows: \begin{itemize} \item $\bproof$ proves that $m_0=0\lor m_\Sigma=0$; \item $\oproof$ proves that $m_0=1\lor m_\Sigma\in[\minlabel\dots\maxlabel]$. \end{itemize} They are computed as described in section~\ref{bproof}. \subsection{Proofs of interval membership} \label{iproof} \begin{gather*} \iproof=\proof^\ast \end{gather*} Given a pair $(\alpha,\beta)$ of group elements, one can prove that it has the form $(g^r,y^rg^{M_i})$ with $M_i\in[M_0,\dots,M_k]$ by creating a sequence of $\proof$s $\pi_0,\dots,\pi_k$ with the following procedure, parameterised by a group element $S$: \begin{enumerate} \item for $j\neq i$: \begin{enumerate} \item create $\pi_j$ with a random $\challenge$ and a random $\response$ \item compute \[A_j=\frac{g^\response}{\alpha^\challenge}\quad\text{and}\quad B_j=\frac{y^\response}{(\beta/g^{M_j})^\challenge}\] \end{enumerate} \item $\pi_i$ is created as follows: \begin{enumerate} \item pick a random $w\in\Z_q$ \item compute $A_i=g^w$ and $B_i=y^w$ \item $\challenge(\pi_i)=\Hash_\iprove(S,\alpha,\beta,A_0,B_0,\dots,A_k,B_k)-\sum_{j\neq i}\challenge(\pi_j)\mod q$ \item $\response(\pi_i)=w+r\times\challenge(\pi_i)\mod q$ \end{enumerate} \end{enumerate} In the above, $\Hash_\iprove$ is computed as follows: \[\Hash_\iprove(S,\alpha,\beta,A_0,B_0,\dots,A_k,B_k)=\shatwo(\verb=prove|=S\verb=|=\alpha\verb=,=\beta\verb=|=A_0\verb=,=B_0\verb=,=\dots\verb=,=A_k\verb=,=B_k)\mod q\] where \verb=prove=, the vertical bars and the commas are verbatim and numbers are written in base 10. The result is interpreted as a 256-bit big-endian number. We will denote the whole procedure by $\iprove(S,r,i,M_0,\dots,M_k)$. The proof is verified as follows: \begin{enumerate} \item for $j\in[0\dots k]$, compute \[A_j=\frac{g^{\response(\pi_j)}}{\alpha^{\challenge(\pi_j)}}\quad\text{and}\quad B_j=\frac{y^{\response(\pi_j)}}{(\beta/g^{M_j})^{\challenge(\pi_j)}}\] \item check that \[\Hash_\iprove(S,\alpha,\beta,A_0,B_0,\dots,A_k,B_k)=\sum_{j\in[0\dots k]}\challenge(\pi_j)\mod q\] \end{enumerate} \subsection{Proofs of possibly-blank votes} \label{bproof} In this section, we suppose: \[ (\alpha_0,\beta_0)=(g^{r_0},y^{r_0}g^{m_0}) \quad\text{and}\quad (\alpha_\Sigma,\beta_\Sigma)=(g^{r_\Sigma},y^{r_\Sigma}g^{m_\Sigma}) \] Note that $\alpha_\Sigma$, $\beta_\Sigma$ and $r_\Sigma$ can be easily computed from the encryptions of $m_1,\dotsc,m_n$ and their associated secrets. Additionnally, let $P$ be the string ``$g\verb=,=y\verb=,=\alpha_0\verb=,=\beta_0\verb=,=\alpha_\Sigma\verb=,=\beta_\Sigma$'', where the commas are verbatim and the numbers are written in base 10. Let also $M_1,\dotsc,M_k$ be the sequence $\minlabel,\dots,\maxlabel$ ($k=\maxlabel-\minlabel+1$). \subsubsection{Non-blank votes ($m_0=0$)} \label{non-blank-votes} \paragraph{Computing \bproof} In $m_0=0\lor m_\Sigma=0$, the first case is true. The proof $\bproof$ of the whole statement is the couple of proofs $(\pi_0,\pi_\Sigma)$ built as follows: \begin{enumerate} \item pick random $\challenge(\pi_\Sigma)$ and $\response(\pi_\Sigma)$ in $\Z_q$ \item compute $A_\Sigma=g^{\response(\pi_\Sigma)}\times\alpha_\Sigma^{\challenge(\pi_\Sigma)}$ and $B_\Sigma=y^{\response(\pi_\Sigma)}\times\beta_\Sigma^{\challenge(\pi_\Sigma)}$ \item pick a random $w$ in $\Z_q$ \item compute $A_0=g^w$ and $B_0=y^w$ \item compute \[\challenge(\pi_0)=\Hash_{\mathsf{bproof0}}(S,P,A_0,B_0,A_\Sigma,B_\Sigma)-\challenge(\pi_\Sigma)\mod q\] \item compute $\response(\pi_0)=w-r_0\times\challenge(\pi_0)\mod q$ \end{enumerate} In the above, $\Hash_{\mathsf{bproof0}}$ is computed as follows: \[\Hash_{\mathsf{bproof0}}(\dotsc)= \shatwo(\verb=bproof0|=S\verb=|=P\verb=|=A_0\verb=,=B_0\verb=,=A_\Sigma\verb=,=B_\Sigma)\mod q\] where \verb=bproof0=, the vertical bars and the commas are verbatim and numbers are written in base 10. The result is interpreted as a 256-bit big-endian number. \paragraph{Computing \oproof} In $m_0=1\lor m_\Sigma\in[M_1\dots M_k]$, the second case is true. Let $i$ be such that $m_\Sigma=M_i$. The proof of the whole statement is a $(k+1)$-tuple $(\pi_0,\pi_1,\dotsc,\pi_k)$ built as follows: \begin{enumerate} \item pick random $\challenge(\pi_0)$ and $\response(\pi_0)$ in $\Z_q$ \item compute $A_0=g^{\response(\pi_0)}\times\alpha_0^{\challenge(\pi_0)}$ and $B_0=y^{\response(\pi_0)}\times(\beta_0/g)^{\challenge(\pi_0)}$ \item for $j>0$ and $j\neq i$: \begin{enumerate} \item create $\pi_j$ with a random $\challenge$ and a random $\response$ in $\Z_q$ \item compute $A_j={g^\response}\times{\alpha_\Sigma^\challenge}$ and $B_j={y^\response}\times{(\beta_\Sigma/g^{M_j})^\challenge}$ \end{enumerate} \item pick a random $w\in\Z_q$ \item compute $A_i=g^w$ and $B_i=y^w$ \item compute \[\challenge(\pi_i)=\Hash_{\textsf{bproof1}}(S,P,A_0,B_0,\dots,A_k,B_k)-\sum_{j\neq i}\challenge(\pi_j)\mod q\] \item compute $\response(\pi_i)=w-r_\Sigma\times\challenge(\pi_i)\mod q$ \end{enumerate} In the above, $\Hash_{\mathsf{bproof1}}$ is computed as follows: \[\Hash_{\mathsf{bproof1}}(\dotsc)= \shatwo(\verb=bproof1|=S\verb=|=P\verb=|=A_0\verb=,=B_0\verb=,=\dotsc\verb=,=A_k\verb=,=B_k)\mod q\] where \verb=bproof1=, the vertical bars and the commas are verbatim and numbers are written in base 10. The result is interpreted as a 256-bit big-endian number. \subsubsection{Blank votes ($m_0=1$)} \paragraph{Computing \bproof} In $m_0=0\lor m_\Sigma=0$, the second case is true. The proof $\bproof$ of the whole statement is the couple of proofs $(\pi_0,\pi_\Sigma)$ built as in section~\ref{non-blank-votes}, but exchanging subscripts $0$ and $\Sigma$ everywhere except in the call to $\Hash_{\textsf{bproof0}}$. \paragraph{Computing \oproof} In $m_0=1\lor m_\Sigma\in[M_1\dots M_k]$, the first case is true. The proof of the whole statement is a $(k+1)$-tuple $(\pi_0,\pi_1,\dotsc,\pi_k)$ built as follows: \begin{enumerate} \item for $j>0$: \begin{enumerate} \item create $\pi_j$ with a random $\challenge$ and a random $\response$ in $\Z_q$ \item compute $A_j={g^\response}\times{\alpha_\Sigma^\challenge}$ and $B_j={y^\response}\times{(\beta_\Sigma/g^{M_j})^\challenge}$ \end{enumerate} \item pick a random $w\in\Z_q$ \item compute $A_0=g^w$ and $B_0=y^w$ \item compute \[\challenge(\pi_0)=\Hash_{\textsf{bproof1}}(S,P,A_0,B_0,\dots,A_k,B_k)-\sum_{j>0}\challenge(\pi_j)\mod q\] \item compute $\response(\pi_0)=w-r_0\times\challenge(\pi_0)\mod q$ \end{enumerate} \subsubsection{Verifying proofs} \paragraph{Verifying \bproof} A proof of $m_0=0\lor m_\Sigma=0$ is a couple of proofs $(\pi_0,\pi_\Sigma)$ such that the following procedure passes: \begin{enumerate} \item compute $A_0=g^{\response(\pi_0)}\times\alpha_0^{\challenge(\pi_0)}$ and $B_0=y^{\response(\pi_0)}\times\beta_0^{\challenge(\pi_0)}$ \item compute $A_\Sigma=g^{\response(\pi_\Sigma)}\times\alpha_\Sigma^{\challenge(\pi_\Sigma)}$ and $B_\Sigma=y^{\response(\pi_\Sigma)}\times\beta_\Sigma^{\challenge(\pi_\Sigma)}$ \item check that \[\Hash_{\mathsf{bproof0}}(S,P,A_0,B_0,A_\Sigma,B_\Sigma)=\challenge(\pi_0)+\challenge(\pi_\Sigma)\mod q\] \end{enumerate} \paragraph{Verifying \oproof} A proof of $m_0=1\lor m_\Sigma\in[M_1\dots M_k]$ is a $(k+1)$-tuple $(\pi_0,\pi_1,\dotsc,\pi_k)$ such that the following procedure passes: \begin{enumerate} \item compute $A_0=g^{\response(\pi_0)}\times\alpha_0^{\challenge(\pi_0)}$ and $B_0=y^{\response(\pi_0)}\times(\beta_0/g)^{\challenge(\pi_0)}$ \item for $j>0$, compute \[A_j=g^{\response(\pi_j)}\times\alpha_j^{\challenge(\pi_j)} \quad\text{and}\quad B_j=y^{\response(\pi_j)}\times(\beta_j/g^{M_j})^{\challenge(\pi_j)}\] \item check that \[\Hash_{\textsf{bproof1}}(S,P,A_0,B_0,\dots,A_k,B_k)=\sum_{j=0}^k\challenge(\pi_j)\mod q\] \end{enumerate} \subsection{Signatures} \label{signatures} \begin{gather*} \signature=\left\{ \begin{array}{rcl} \pklabel&:&\pk\\ \challenge&:&\Z_q\\ \response&:&\Z_q \end{array} \right\} \end{gather*} \newcommand{\siglabel}{\textsf{signature}} Each ballot contains a digital signature to avoid ballot stuffing. The signature needs a \hyperref[credentials]{credential} $c$ and uses all the \ciphertext{}s $\gamma_1,\dots,\gamma_l$ that appear in the ballot ($l$ is the sum of the lengths of $\choices$). It is computed as follows: \begin{enumerate} \item compute $s=\secret(c)$ \item pick a random $w\in\Z_q$ \item compute $A=g^w$ \item $\pklabel=g^s$ \item $\challenge=\Hash_\siglabel(\pklabel,A,\gamma_1,\dots,\gamma_l)\mod q$ \item $\response=w-s\times\challenge\mod q$ \end{enumerate} In the above, $\Hash_\siglabel$ is computed as follows: \[ \Hash_\siglabel(S,A,\gamma_1,\dots,\gamma_l)=\shatwo(\verb=sig|=S\verb=|=A\verb=|=\alphalabel(\gamma_1)\verb=,=\betalabel(\gamma_1)\verb=,=\dots\verb=,=\alphalabel(\gamma_l)\verb=,=\betalabel(\gamma_l)) \] where \verb=sig=, the vertical bars and commas are verbatim and numbers are written in base 10. The result is interpreted as a 256-bit big-endian number. Signatures are verified as follows: \begin{enumerate} \item compute $A=g^\response\times \pklabel^\challenge$ \item check that $\challenge=\Hash_\siglabel(\pklabel,A,\gamma_1,\dots,\gamma_l)\mod q$ \end{enumerate} \subsection{Ballots} \label{ballots} \newcommand{\json}{\textsf{JSON}} \begin{gather*} \ballot=\left\{ \begin{array}{rcl} \answers&:&\hyperref[answers]{\answer}^\ast\\ \textsf{election\_hash}&:&\jstring\\ \textsf{election\_uuid}&:&\uuid\\ \siglabel&:&\hyperref[signatures]{\signature} \end{array} \right\} \end{gather*} The so-called hash (or \emph{fingerprint}) of the election is computed with the function $\Hash_\json$: \[ \Hash_\json(J)=\basesixfour(\shatwo(J)) \] Where $J$ is the serialization (done by the server) of the $\election$ structure. The same hashing function is used on a serialization (done by the voting client) of the $\ballot$ structure to produce a so-called \emph{smart ballot tracker}. \subsection{Tally} \label{tally} \begin{gather*} \etally=\ciphertext^\ast{}^\ast \end{gather*} The encrypted tally is the pointwise product of the ciphertexts of all accepted ballots: \[ \begin{array}{rcl} \alphalabel(\etally_{i,j})&=&\prod\alphalabel(\choices(\answers(\ballot)_i)_j)\\ \betalabel(\etally_{i,j})&=&\prod\betalabel(\choices(\answers(\ballot)_i)_j) \end{array} \] \newcommand{\dfactors}{\textsf{decryption\_factors}} \newcommand{\dproofs}{\textsf{decryption\_proofs}} \newcommand{\decrypt}{\textsf{decrypt}} \begin{gather*} \pdecryption=\left\{ \begin{array}{rcl} \dfactors&:&\G^\ast{}^\ast\\ \dproofs&:&\proof^\ast{}^\ast \end{array} \right\} \end{gather*} From the encrypted tally, each trustee computes a partial decryption using the \hyperref[trustee-keys]{private key} $x$ (and the corresponding public key $X=g^x$) he generated during election setup. It consists of so-called decryption factors: \[ \dfactors_{i,j}=\alphalabel(\etally_{i,j})^x \] and proofs that they were correctly computed. Each $\dproofs_{i,j}$ is computed as follows: \begin{enumerate} \item pick a random $w\in\Z_q$ \item compute $A=g^w$ and $B=\alphalabel(\etally_{i,j})^w$ \item $\challenge=\Hash_\decrypt(X,A,B)$ \item $\response=w+x\times\challenge\mod q$ \end{enumerate} In the above, $\Hash_\decrypt$ is computed as follows: \[ \Hash_\decrypt(X,A,B)=\shatwo(\verb=decrypt|=X\verb=|=A\verb=,=B)\mod q \] where \verb=decrypt=, the vertical bars and the comma are verbatim and numbers are written in base 10. The result is interpreted as a 256-bit big-endian number. These proofs are verified using the $\tpk$ structure $k$ that the trustee sent to the administrator during the election setup: \begin{enumerate} \item compute \[ A=\frac{g^\response}{\pklabel(k)^\challenge} \quad\text{and}\quad B=\frac{\alphalabel(\etally_{i,j})^\response}{\dfactors_{i,j}^\challenge} \] \item check that $\Hash_\decrypt(\pklabel(k),A,B)=\challenge$ \end{enumerate} \subsection{Election result} \label{election-result} \newcommand{\ntallied}{\textsf{num\_tallied}} \newcommand{\etallylabel}{\textsf{encrypted\_tally}} \newcommand{\pdlabel}{\textsf{partial\_decryptions}} \newcommand{\resultlabel}{\textsf{result}} \begin{gather*} \result=\left\{ \begin{array}{rcl} \ntallied&:&\I\\ \etallylabel&:&\etally\\ \pdlabel&:&\pdecryption^\ast\\ \resultlabel&:&\I^\ast{}^\ast \end{array} \right\} \end{gather*} The decryption factors are combined for each ciphertext to build synthetic ones: \[ F_{i,j}=\prod_{z\in[1\dots m]}\pdlabel_{z,i,j} \] where $m$ is the number of trustees. The $\resultlabel$ field of the $\result$ structure is then computed as follows: \[ \resultlabel_{i,j}=\log_g\left(\frac{\betalabel(\etallylabel_{i,j})}{F_{i,j}}\right) \] Here, the discrete logarithm can be easily computed because it is bounded by $\ntallied$. After the election, the following data needs to be public in order to verify the tally: \begin{itemize} \item the $\election$ structure; \item all the $\tpk$s that were generated during the \hyperref[election-setup]{setup phase}; \item the set of public credentials; \item the set of ballots; \item the $\result$ structure described above. \end{itemize} \section{Default group parameters} \label{default-group} These parameters have been generated by the \verb=fips.sage= script (available in Belenios sources), which is itself based on FIPS 186-4. \[ \begin{array}{lcr} p&=&20694785691422546\\ &&401013643657505008064922989295751104097100884787057374219242\\ &&717401922237254497684338129066633138078958404960054389636289\\ &&796393038773905722803605973749427671376777618898589872735865\\ &&049081167099310535867780980030790491654063777173764198678527\\ &&273474476341835600035698305193144284561701911000786737307333\\ &&564123971732897913240474578834468260652327974647951137672658\\ &&693582180046317922073668860052627186363386088796882120769432\\ &&366149491002923444346373222145884100586421050242120365433561\\ &&201320481118852408731077014151666200162313177169372189248078\\ &&507711827842317498073276598828825169183103125680162072880719\\ g&=&2402352677501852\\ &&209227687703532399932712287657378364916510075318787663274146\\ &&353219320285676155269678799694668298749389095083896573425601\\ &&900601068477164491735474137283104610458681314511781646755400\\ &&527402889846139864532661215055797097162016168270312886432456\\ &&663834863635782106154918419982534315189740658186868651151358\\ &&576410138882215396016043228843603930989333662772848406593138\\ &&406010231675095763777982665103606822406635076697764025346253\\ &&773085133173495194248967754052573659049492477631475991575198\\ &&775177711481490920456600205478127054728238140972518639858334\\ &&115700568353695553423781475582491896050296680037745308460627\\ q&=&78571733251071885\\ &&079927659812671450121821421258408794611510081919805623223441 \end{array} \] The additional output of the generation algorithm is: \[ \begin{array}{lcr} \texttt{domain\_parameter\_seed}&=&478953892617249466\\ &&166106476098847626563138168027\\ &&716882488732447198349000396592\\ &&020632875172724552145560167746\\ \texttt{counter}&=&109 \end{array} \] \end{document} belenios-1.4+dfsg/doc/tool.md000066400000000000000000000142441307140314400161430ustar00rootroot00000000000000Belenios Tool ============= Introduction ------------ `belenios-tool` is a command-line tool that can be used to perform administrative tasks related to elections, as well as verifications. If you do not wish to use the provided web server, a whole election can be organized using this tool. As an illustration of that, you can have a look at the `demo/demo.sh` script that simulates an election. This file documents how to use `belenios-tool`, from the point of view of the various roles involved in an election. You can also run it with the `--help` option to get more information. Auditor's guide --------------- Note that anyone can be an auditor. Everyone who plays a specific role in an election should start by auditing the election data. During an election, you should have access to the following files: * `election.json`: election parameters * `public_keys.jsons`: trustees' public keys * `public_creds.txt`: the public keys associated to valid credentials * `ballots.jsons`: accepted ballots Note that the last one is dynamic, and evolve during the election. At the end of the election, it is frozen and a `result.json` file will be published. If you put these files in a directory `/path/to/election`, the following command will perform all possible verifications, depending on existing files: belenios-tool verify --dir /path/to/election For example, during the election, you can check if some candidate ballot is acceptable by putting it alone in `ballots.jsons`, and running the command above. Voter's guide ------------- If you put your secret credential in a file `/path/to/credential` and your choices in a file `/path/to/choices.json` (as an array of arrays of 0/1 in JSON format), the following command will output a raw ballot that can be sent to the administrator of the election: belenios-tool vote --dir /path/to/election --privcred /path/to/credential --ballot /path/to/choices.json In the case where the election is administered with the web interface, a raw ballot prepared with the command-line tool can be uploaded directly via the web interface. Administrator's guide --------------------- ### Setup a new election 1. Generate an UUID with the `uuidgen` command. Let it be `$UUID`. 2. Go to an empty directory. In the following, we denote by `$DIR` the full path to this directory and by `$BELENIOS` the full path to the Belenios source tree. 4. Ask the credential authority to generate credentials. Note that `$UUID` is needed for that. Save the file with public credentials into `$DIR/public_creds.txt`. 5. Ask each trustee to generate a keypair. Concatenate all trustee public keys into a `$DIR/public_keys.jsons` file. 6. Edit `$BELENIOS/demo/templates/questions.json`. 7. Go to `$DIR` and run: `belenios-tool mkelection --uuid $UUID --group $BELENIOS/demo/groups/default.json --template $BELENIOS/demo/templates/questions.json`. It should generate `election.json`. 8. Create an empty `ballots.jsons` file in `$DIR`. ### Running the election The contents of `$DIR` must be public. For each received ballot, append it to `ballots.jsons` and run: belenios-tool verify --dir $DIR If no error is reported, publish the new `ballots.jsons`; otherwise, the new ballot is incorrect and you must revert `ballots.jsons` to its previous state. Note that each ballot must be authenticated in order to prevent the credential authority from stuffing the ballot box. This issue is not addressed by the command-line tool, but the web server provides several authentication mechanisms. ### Tallying the election 1. Go to the election directory, which must contain `election.json`, `public_keys.jsons`, `public_creds.txt` and `ballots.jsons`. 2. Concatenate the `partial_decryption.json` received from each trustee into a `partial_decryptions.jsons`, in the same order as in `public_keys.jsons`. 3. Run `belenios-tool finalize`. It will create `result.json`. Publish this file, along with the files listed in the first step above. The whole set will enable universal verifiability. Note: `partial_decryptions.jsons` is a temporary file whose contents is embedded in `result.json`, so it can be discarded. Credential authority's guide ---------------------------- ### Credential generation If you have a list of identities in a file `F` with `N` lines, one identity per line, run: belenios-tool credgen --uuid XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX --file F where `XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX` is the UUID of the election given by the administrator. It will generate three files with `N` lines: * `T.privcreds`: each line of this file contains an identity and a private credential. Send each voter the associated credential. Keep this file secret, and secure if you want to be able to re-send a credential later (e.g. if a voter lost or did not receive it). * `T.pubcreds`: each line of this file contains a public credential. Send the whole file to the election administrator; it will be the `public_creds.txt` for the election (and you must check that); * `T.hashcreds`: each line of this file contains, for each id in `T.privcreds`, the hash of the corresponding public key. At the moment, this file has no practical purpose (but this might change in the future). Destroy it. You can optionally add a `--dir` option to specify the directory where these files will be written. Trustee's guide --------------- ### Key generation To generate a keypair, run: belenios-tool trustee-keygen It will generate two files, `XXXXXXXX.public` and `XXXXXXXX.private`, containing respectively the public and the private key. Send the public key file to the server administrator, and keep the private key with extreme care. When the election is open, you must check that your public key is present in the published `public_keys.jsons`. ### Partial decryption To compute your decryption share, set `/path/to/election` up as described in the _Voter's guide_ section above, and run: belenios-tool decrypt --dir /path/to/election --privkey /path/to/privkey > partial_decryption.json and send `partial_decryption.json` to the election administrator. Note: be sure to authenticate all your input files when you use your private key! belenios-1.4+dfsg/doc/web.md000066400000000000000000000144351307140314400157450ustar00rootroot00000000000000Belenios Web Server =================== Election administrator's guide ------------------------------ ### Setup a new election Once the server is up and running (see below), anyone who can log into the server as an administrator can create an election. First, the administrator has to choose how credentials will be handled: * in the automatic mode, the server will generate credentials and mail the private parts to each voter. Credential recovery (i.e. one voter loses his/her credential or does not receive it) is not possible in this case; * in the manual mode, a third party will generate credentials using a web interface or the command-line tool, and upload the public credentials to the server. It's up to this third party to send private credentials to each voter, and to implement credential recovery. Moreover, the administrator has to choose the authentication mode for voters: * with the password mode, the server will generate passwords and mail them to the voters, this is the most common mode; * the other one uses a [CAS](https://www.apereo.org/projects/cas) server. Then, the administrator must: * set the name and description of the election; * edit questions; * edit voters, and have the server send them their password if this authentication mode has been chosen; * have the credential authority generate credentials and send e-mails; in the automatic mode, this is done simply by clicking on a button; in the manual mode, a link is generated for the credential authority; * (optionally) edit trustees. For good security there should be at least two trustees; a link is generated for each trustee; * finalize the election. Each "link" above must be sent by the administrator to their intended recipient. Each link leads to an interface that will help its recipient accomplish his or her task. The *election fingerprint*, which is shown on the election page and in the booth, is the compact Base64 encoding of the SHA256 of `election.json`. It can be computed from a POSIX shell by piping it into: sha256sum | xxd -r -p | base64 ### Election life cycle An election starts by being in preparation (or "setup mode"), then becomes finalized. Then, it is immediately opened and can be closed and re-opened at will. When it is closed, the election administrator can initiate the tallying process. The encrypted tally is then computed and published. After each trustee has computed his/her share of the decryption, the administrator triggers the release of the result. At any moment, a finalized election can be archived. This releases some resources on the server and makes the election read-only. In particular, it is no longer possible to vote in or to tally an archived election. Be careful, this operation is not revertible. ### Auditing an election During the election, the following files are published: * `election.json`: election parameters * `public_keys.jsons`: trustees' public keys * `public_creds.txt`: the public keys associated to valid credentials * `ballots.jsons`: accepted ballots They are accessible from the bottom of the election page. Together, they enable anyone to audit the election. At the end of the election, an additional `result.json` file is published with the result and other cryptographic proofs that everything went well. Please refer to the auditor's guide in the documentation of the command-line tool for more information. Server administrator's guide ---------------------------- A sample web server can be run with the `demo/run-server.sh` script, from the compiled source tree. Here is an excerpt of the sample configuration file: `` elements configure authentication for the whole site. Available authentication methods: * ``: just asks for a name. No security is intended. This is useful for debugging or demonstration purposes but obviously not suitable for production * ``: password-based authentication. It takes as parameter a file, in CSV format, where each line consists of: + a user name + a salt + SHA256(salt concatenated with password) Additional fields are ignored. In the sample `password_db.csv` file, a fourth field with the plaintext password is included. The sample file has been generated with the following shell command: `for u in $(seq 1 5); do SALT=$(pwgen); PASS=$(pwgen); echo "user$u,$SALT,$(echo -n "$SALT$PASS" | sha256sum | read a b; echo $a),$PASS"; done` * ``: authenticate with a [CAS](https://www.apereo.org/projects/cas) server. For example: `` If the web server is behind a reverse-proxy, it might be needed to rewrite URLs passed to the CAS server. This can be done with the following directive: `` * ``: authenticate with an [OpenID Connect](http://openid.net/connect/) server. For example: `` In the above, `client-id` and `client-secret` must be replaced by valid credentials issued by the OpenID Connect provider. The `` directive also applies to this authentication scheme. The `` element gives the path to the source tarball. Note that this is a path on the local filesystem and not a URL. If you made local changes, an easy way to comply with the AGPL license is to commit them in a local git checkout, and put in the `source` element the path to the tarball generated by `make archive`. The `` element indicates a file where some security-sensitive events will be logged. It is optional. The `` element indicates a directory with election data. This directory should be empty when the server is launched for the first time, and will be populated with election data. A typical location would be `/var/lib/belenios`. Warning: it may contain sensitive data (e.g. the private key when no external trustees are set). belenios-1.4+dfsg/genversion.sh000077500000000000000000000003441307140314400166110ustar00rootroot00000000000000#!/bin/sh # the following is to be run from _build directory if [ -d ../.git ] && which git >/dev/null 2>&1; then BUILD=${BUILD:-$(git describe)} else BUILD=${BUILD:-$(date -u +%Y%m%d)} fi head -n1 VERSION echo $BUILD belenios-1.4+dfsg/minimal.itarget000066400000000000000000000000161307140314400170760ustar00rootroot00000000000000belenios-tool belenios-1.4+dfsg/myocamlbuild.ml000066400000000000000000000115241307140314400171100ustar00rootroot00000000000000open Ocamlbuild_plugin let debug = try Sys.getenv "BELENIOS_DEBUG" <> "" with Not_found -> false let try_exec cmd = Sys.command (cmd ^ " >/dev/null 2>&1") = 0 let has_ocamlopt = try_exec "which ocamlopt" let native_compilation = try Sys.getenv "OCAMLBEST" = "native" with Not_found -> has_ocamlopt let exe_suffix = if native_compilation then ".native" else ".byte" let atdgen_action opts env build = let x = env "%.atd" in let d = Pathname.dirname x and f = Pathname.basename x in Cmd (S [A"cd"; P d; Sh"&&"; A"atdgen"; S opts; P f]) let js_of_ocaml env build = Cmd (S [A"js_of_ocaml"; P (env "%.byte")]) let ( / ) = Filename.concat let platform_rules kind = let lib = "src" / "lib" in let platform_dir = "src" / "platform" in let platform_mod = platform_dir / kind / "platform" in let platform_lib = platform_dir / "platform-" ^ kind in let ml = platform_mod ^ ".ml" in let mli = platform_mod ^ ".mli" in let mllib = platform_lib ^ ".mllib" in rule mllib ~deps:[ml] ~prods:[mllib] (fun _ _ -> (* technically, there is no dependency, but we need the directory to exist for the following *) Echo ([platform_dir / kind / "Belenios_version"; "\n"; platform_dir / kind / "Platform"; "\n"], mllib) ); dep ["file:" ^ ml] [mli]; copy_rule mli (lib / "platform.mli") mli; ocaml_lib platform_lib let build_rule () = let genversion = "genversion.sh" in let deps = ["VERSION"; genversion] in let prod = "BUILD" in let builder _ _ = Cmd (S [A "sh"; P genversion; Sh ">"; P prod]) in rule "BUILD" ~deps ~prod builder let version_rules kind = let file = "BUILD" in let deps = [file; "src/platform/" ^ kind ^ "/belenios_version.mli"] in let prod = "src/platform/" ^ kind ^ "/belenios_version.ml" in let builder _ _ = let version, build = let ic = open_in file in let version = input_line ic in let build = input_line ic in close_in ic; version, build in let lines = Printf.([ sprintf "let version = \"%s\"" version; sprintf "let build = \"%s\"" build; sprintf "let debug = %b" debug; ]) in Echo (lines, prod) in copy_rule (kind / "belenios_tool.mli") "src/lib/belenios_version.mli" ("src/platform/" ^ kind ^ "/belenios_version.mli"); rule ("BUILD -> " ^ kind ^ "/belenios_version.ml") ~deps ~prod builder let copy_static f = let base = Filename.basename f in copy_rule base f ("src/static" / base) let () = dispatch & function | Before_options -> Options.use_ocamlfind := true; Options.make_links := false; | After_rules -> Pathname.define_context "src/web" ["src/lib"]; Pathname.define_context "src/tool" ["src/lib"]; Pathname.define_context "src/booth" ["src/lib"]; Pathname.define_context "demo" ["src/lib"]; Pathname.define_context "stuff" ["src/lib"]; Pathname.define_context "." ["src/lib"]; (* the following avoids an ocamlfind warning, it should be built-in *) flag ["doc"; "thread"] (A"-thread"); rule "%.atd -> %_t.ml & %_t.mli" ~deps:["%.atd"] ~prods:["%_t.ml"; "%_t.mli"] (atdgen_action [A"-t"]); rule "%.atd -> %_j.ml & %_j.mli" ~deps:["%.atd"] ~prods:["%_j.ml"; "%_j.mli"] (atdgen_action [A"-j"; A"-j-std"]); rule "%.byte -> %.js" ~deps:["%.byte"] ~prods:["%.js"] js_of_ocaml; rule "%.md -> %.html" ~deps:["%.md"] ~prods:["%.html"] (fun env build -> Cmd (S [A"markdown"; P (env "%.md"); Sh">"; P (env "%.html")]) ); build_rule (); version_rules "native"; version_rules "js"; platform_rules "native"; platform_rules "js"; copy_rule "jsbn.js" "ext/booth/js/jsbn/jsbn.js" "src/static/jsbn.js"; copy_rule "jsbn2.js" "ext/booth/js/jsbn/jsbn2.js" "src/static/jsbn2.js"; copy_rule "sjcl.js" "ext/booth/js/sjcl/sjcl.js" "src/static/sjcl.js"; copy_rule "random.js" "src/platform/js/random.js" "src/static/random.js"; copy_rule "belenios-tool" ("src/tool/tool_cmdline" ^ exe_suffix) "belenios-tool"; copy_rule "belenios-tool.js" "src/tool/tool_js.js" "src/static/tool_js.js"; copy_rule "belenios-tool.html" "src/tool/belenios-tool.html" "src/static/belenios-tool.html"; copy_rule "encrypting.gif" "ext/booth/encrypting.gif" "src/static/encrypting.gif"; copy_rule "booth.js" "src/booth/booth.js" "src/static/booth.js"; copy_rule "tool_js_tkeygen.js" "src/tool/tool_js_tkeygen.js" "src/static/tool_js_tkeygen.js"; copy_rule "tool_js_credgen.js" "src/tool/tool_js_credgen.js" "src/static/tool_js_credgen.js"; copy_rule "tool_js_questions.js" "src/tool/tool_js_questions.js" "src/static/tool_js_questions.js"; copy_rule "tool_js_pd.js" "src/tool/tool_js_pd.js" "src/static/tool_js_pd.js"; List.iter copy_static [ "ext/css/reset.css"; "ext/css/styled-elements.css"; "ext/css/style.css"; "ext/css/superfish.css"; ] | _ -> () belenios-1.4+dfsg/opam-bootstrap.sh000077500000000000000000000060341307140314400174030ustar00rootroot00000000000000#!/bin/sh set -e BELENIOS_SRC="${BELENIOS_SRC:-$PWD}" # Check that OCamlDuce is not installed if which ocamlduce >/dev/null; then echo "Please uninstall OCamlDuce first, or remove it from your PATH." exit 1 fi echo echo "=-=-= Download and check tarballs =-=-=" echo # Look for wget or curl if which wget >/dev/null; then echo "wget was found and will be used" elif which curl >/dev/null; then wget () { curl "$1" > "${1##*/}"; } echo "curl was found and will be used" fi export BELENIOS_SYSROOT="${BELENIOS_SYSROOT:-$HOME/.belenios}" export OPAMROOT="$BELENIOS_SYSROOT/opam" if [ -e "$BELENIOS_SYSROOT" ]; then echo "$BELENIOS_SYSROOT already exists." echo "Please remove it or set BELENIOS_SYSROOT to a non-existent directory first." exit 1 fi mkdir -p "$BELENIOS_SYSROOT/bootstrap/src" cd "$BELENIOS_SYSROOT/bootstrap/src" wget http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-4.02.3.tar.gz wget https://github.com/ocaml/opam/releases/download/1.2.2/opam-full-1.2.2.tar.gz if which sha256sum >/dev/null; then sha256sum --check < $BELENIOS_SRC/env.sh <. *) (**************************************************************************) open Platform open Serializable_j open Signatures open Common let document = Dom_html.window##document let withElementById x f = Js.Opt.iter (document##getElementById (Js.string x)) f let getHtmlById x = let r = ref x in withElementById x (fun x -> Js.Opt.iter (x##textContent) (fun x -> r := Js.to_string x) ); !r let alert s : unit = let open Js.Unsafe in fun_call (variable "alert") [| s |> Js.string |> inject |] let prompt s = let open Js.Unsafe in Js.Opt.map (fun_call (variable "prompt") [| s |> Js.string |> inject |]) Js.to_string |> Js.Opt.to_option let runHandler handler () = (try handler () with e -> let msg = "Unexpected error: " ^ Printexc.to_string e in alert msg ); Js._false let installHandler id handler = let f _ = runHandler handler () in withElementById id (fun e -> e##onclick <- Dom_html.handler f) let getTextarea id = let res = ref None in withElementById id (fun e -> Js.Opt.iter (Dom_html.CoerceTo.textarea e) (fun x -> res := Some (Js.to_string (x##value))) ); match !res with | None -> raise Not_found | Some x -> x let setTextarea id z = withElementById id (fun e -> Js.Opt.iter (Dom_html.CoerceTo.textarea e) (fun x -> x##value <- Js.string z) ) let setNodeById id x = withElementById id (fun e -> let t = document##createTextNode (Js.string x) in Dom.appendChild e t ) let setDisplayById id x = withElementById id (fun e -> e##style##display <- Js.string x) let prng = lazy (pseudo_rng (random_string secure_rng 16)) module LwtJsRandom = struct type 'a t = unit -> 'a Lwt.t let return x () = Lwt.return x let bind x f () = Lwt.bind (x ()) (fun y -> f y ()) let fail x () = Lwt.fail x let random q = let size = Z.bit_length q / 8 + 1 in fun () -> lwt () = Lwt_js.yield () in let r = random_string (Lazy.force prng) size in Lwt.return Z.(of_bits r mod q) end let encryptBallot params cred plaintext () = let module P = (val params : ELECTION_DATA) in let module G = P.G in let module E = Election.MakeElection (G) (LwtJsRandom) in let module CD = Credential.MakeDerive (G) in let sk = CD.derive P.election.e_params.e_uuid cred in lwt randomness = E.make_randomness P.election () in lwt b = E.create_ballot P.election ~sk randomness plaintext () in let s = string_of_ballot G.write b in setTextarea "ballot" s; setNodeById "ballot_tracker" (sha256_b64 s); setDisplayById "encrypting_div" "none"; setDisplayById "ballot_div" "block"; Dom_html.window##onbeforeunload <- Dom_html.no_handler; Lwt.return () let progress_step n = let old_ = Printf.sprintf "progress%d" (n-1) in let new_ = Printf.sprintf "progress%d" n in withElementById old_ (fun e -> e##setAttribute (Js.string "style", Js.string "")); withElementById new_ (fun e -> e##setAttribute (Js.string "style", Js.string "font-weight: bold;")) let rec createQuestionNode sk params question_div num_questions i prev (q, answers) next = (* Create div element for the current question. [i] and [(q, answers)] point to the current question. [List.rev prev @ [q, answers] @ next] is the list of all questions. *) let div = document##createElement (Js.string "div") in let () = let c = document##createElement (Js.string "h2") in let t = document##createTextNode (Js.string q.q_question) in Dom.appendChild c t; Dom.appendChild div c in let () = let c = document##createElement (Js.string "div") in let fmt = Scanf.format_from_string (getHtmlById "question_header") "%d%d%d%d" in let s = Printf.sprintf fmt (i + 1) num_questions q.q_min q.q_max in let t = document##createTextNode (Js.string s) in Dom.appendChild c t; Dom.appendChild div c in let q_answers = match q.q_blank with | Some true -> Array.append [|getHtmlById "str_blank_vote"|] q.q_answers | _ -> q.q_answers in let () = let choices = document##createElement (Js.string "div") in let choices_divs = Array.mapi (fun i a -> let div = document##createElement (Js.string "div") in let checkbox = document##createElement (Js.string "input") in let cb = match Js.Opt.to_option (Dom_html.CoerceTo.input checkbox) with | Some x -> x | None -> failwith "error while casting checkbox" in if answers.(i) > 0 then cb##checked <- Js.bool true; checkbox##setAttribute (Js.string "type", Js.string "checkbox"); checkbox##setAttribute (Js.string "style", Js.string "cursor: pointer;"); Dom.appendChild div checkbox; let t = document##createTextNode (Js.string a) in checkbox##onclick <- Dom_html.handler (fun _ -> answers.(i) <- if Js.to_bool cb##checked then 1 else 0; Js._true ); Dom.appendChild div t; div ) q_answers in begin match q.q_blank with | Some true -> for i = 1 to Array.length choices_divs - 1 do Dom.appendChild choices choices_divs.(i) done; (* Put the blank choice at the end of the list *) Dom.appendChild choices (Dom_html.createBr document); Dom.appendChild choices choices_divs.(0) | _ -> for i = 0 to Array.length choices_divs - 1 do Dom.appendChild choices choices_divs.(i) done end; Dom.appendChild div choices in let check_constraints () = let check_min_max total = if total < q.q_min then ( let fmt = Scanf.format_from_string (getHtmlById "at_least") "%d" in Printf.ksprintf alert fmt q.q_min; false ) else if total > q.q_max then ( let fmt = Scanf.format_from_string (getHtmlById "at_most") "%d" in Printf.ksprintf alert fmt q.q_max; false ) else true in match q.q_blank with | Some true -> let answers' = Array.sub answers 1 (Array.length answers - 1) in let total = Array.fold_left (+) 0 answers' in if answers.(0) > 0 then ( if total <> 0 then (alert (getHtmlById "no_other_blank"); false) else true ) else check_min_max total | _ -> let total = Array.fold_left (+) 0 answers in check_min_max total in let () = (* previous button *) let btns = document##createElement (Js.string "div") in btns##setAttribute (Js.string "style", Js.string "text-align: center;"); let () = match prev with | [] -> (* first question, no "Previous" button *) () | r :: prev -> let b = document##createElement (Js.string "button") in let t = document##createTextNode (Js.string @@ getHtmlById "str_previous") in b##onclick <- Dom_html.handler (fun _ -> if check_constraints () then ( let ndiv = createQuestionNode sk params question_div num_questions (i - 1) prev r ((q, answers) :: next) in Dom.replaceChild question_div ndiv div; Js._false ) else Js._false ); Dom.appendChild b t; Dom.appendChild btns b; in let () = (* next button *) match next with | [] -> (* last question, the button leads to encryption page *) let b = document##createElement (Js.string "button") in let t = document##createTextNode (Js.string @@ getHtmlById "str_next") in b##onclick <- Dom_html.handler (fun _ -> if check_constraints () then ( let all = (q, answers) :: prev in let all_answers = List.rev_map snd all |> Array.of_list in let all_questions = List.rev_map fst all |> Array.of_list in setTextarea "choices" (string_of_plaintext all_answers); question_div##style##display <- Js.string "none"; withElementById "pretty_choices" (fun e -> Array.iteri (fun i a -> let q = all_questions.(i) in let h = document##createElement (Js.string "h3") in let t = document##createTextNode (Js.string q.q_question) in Dom.appendChild h t; Dom.appendChild e h; let ul = document##createElement (Js.string "ul") in let checked = ref 0 in Array.iteri (fun i a -> if a > 0 then ( incr checked; let li = document##createElement (Js.string "li") in let text = match q.q_blank with | Some true -> if i = 0 then getHtmlById "str_blank_vote" else q.q_answers.(i-1) | _ -> q.q_answers.(i) in let t = document##createTextNode (Js.string text) in Dom.appendChild li t; Dom.appendChild ul li; ) ) a; if !checked = 0 then ( let t = document##createTextNode (Js.string @@ getHtmlById "str_nothing") in Dom.appendChild ul t ); Dom.appendChild e ul; ) all_answers ); Lwt_js_events.async (encryptBallot params sk all_answers); setDisplayById "plaintext_div" "block"; progress_step 3; Js._false ) else Js._false ); Dom.appendChild b t; Dom.appendChild btns b | r :: next -> let b = document##createElement (Js.string "button") in let t = document##createTextNode (Js.string @@ getHtmlById "str_next") in b##onclick <- Dom_html.handler (fun _ -> if check_constraints () then ( let ndiv = createQuestionNode sk params question_div num_questions (i + 1) ((q, answers) :: prev) r next in Dom.replaceChild question_div ndiv div; Js._false ) else Js._false ); Dom.appendChild b t; Dom.appendChild btns b; in Dom.appendChild div btns in div let addQuestions sk params qs = withElementById "question_div" (fun e -> let n = Array.length qs in let qs = Array.to_list qs |> List.map (fun q -> q, Array.make (Election.question_length q) 0) in match qs with | [] -> failwith "no questions" | q :: next -> let div = createQuestionNode sk params e n 0 [] q next in Dom.appendChild e div ) let createStartButton params intro_div qs = let b = document##createElement (Js.string "button") in b##setAttribute (Js.string "style", Js.string "font-size:20px;"); let t = document##createTextNode (Js.string (getHtmlById "str_here")) in b##onclick <- Dom_html.handler (fun _ -> (match prompt (getHtmlById "enter_cred") with | Some cred when Credential.check cred -> intro_div##style##display <- Js.string "none"; setDisplayById "question_div" "block"; Dom_html.window##onbeforeunload <- Dom_html.handler (fun _ -> Js._false ); progress_step 2; addQuestions cred params qs | Some _ -> alert (getHtmlById "invalid_cred") | None -> () ); Js._false ); Dom.appendChild b t; b let drop_trailing_newline s = let n = String.length s in if n > 0 && s.[n-1] = '\n' then String.sub s 0 (n-1) else s let loadElection () = setDisplayById "election_loader" "none"; setDisplayById "booth_div" "block"; let election_raw = getTextarea "election_params" |> drop_trailing_newline in let election_params = Group.election_params_of_string election_raw in let module P = (val election_params : ELECTION_DATA) in let params = P.election.e_params in setNodeById "election_name" params.e_name; setNodeById "election_description" params.e_description; setNodeById "election_uuid" (Uuidm.to_string params.e_uuid); setNodeById "election_fingerprint" P.election.e_fingerprint; withElementById "intro" (fun e -> let b = createStartButton election_params e params.e_questions in withElementById "input_code" (fun e -> Dom.appendChild e b) ) let get_prefix str = let n = String.length str in if n >= 4 then String.sub str 0 (n-4) else str let () = Dom_html.window##onload <- Dom_html.handler (fun _ -> let s = Js.to_string Dom_html.window##location##pathname in let url = get_prefix s in withElementById "ballot_form" (fun e -> Js.Opt.iter (Dom_html.CoerceTo.form e) (fun e -> e##action <- Js.string (url ^ "cast")) ); let open XmlHttpRequest in Lwt.async (fun () -> lwt raw = get (url ^ "election.json") in let () = setTextarea "election_params" raw.content in Lwt.return (runHandler loadElection ()) ); Js._false ) belenios-1.4+dfsg/src/lib/000077500000000000000000000000001307140314400154275ustar00rootroot00000000000000belenios-1.4+dfsg/src/lib/belenios_version.mli000066400000000000000000000000711307140314400214750ustar00rootroot00000000000000val version : string val build : string val debug : bool belenios-1.4+dfsg/src/lib/common.ml000066400000000000000000000117371307140314400172620ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let ( |> ) x f = f x module Array = struct include Array let exists f a = let n = Array.length a in (let rec check i = if i >= 0 then f a.(i) || check (pred i) else false in check (pred n)) let forall f a = let n = Array.length a in (let rec check i = if i >= 0 then f a.(i) && check (pred i) else true in check (pred n)) let forall2 f a b = let n = Array.length a in n = Array.length b && (let rec check i = if i >= 0 then f a.(i) b.(i) && check (pred i) else true in check (pred n)) let fforall f xs = let rec loop_outer i = if i >= 0 then let x = xs.(i) in let n = Array.length x in let rec loop_inner j = if j >= 0 then f x.(j) && loop_inner (pred j) else loop_outer (pred i) in loop_inner (pred n) else true in let n = Array.length xs in loop_outer (pred n) let fforall2 f xs ys = let rec loop_outer i = if i >= 0 then let x = xs.(i) and y = ys.(i) in let n = Array.length x in n = Array.length y && let rec loop_inner j = if j >= 0 then f x.(j) y.(j) && loop_inner (pred j) else loop_outer (pred i) in loop_inner (pred n) else true in let n = Array.length xs in n = Array.length ys && loop_outer (pred n) let fforall3 f xs ys zs = let rec loop_outer i = if i >= 0 then let x = xs.(i) and y = ys.(i) and z = zs.(i) in let n = Array.length x in n = Array.length y && n = Array.length z && let rec loop_inner j = if j >= 0 then f x.(j) y.(j) z.(j) && loop_inner (pred j) else loop_outer (pred i) in loop_inner (pred n) else true in let n = Array.length xs in n = Array.length ys && n = Array.length zs && loop_outer (pred n) let map2 f a b = Array.mapi (fun i ai -> f ai b.(i)) a let map3 f a b c = Array.mapi (fun i ai -> f ai b.(i) c.(i)) a let mmap f a = Array.map (fun ai -> Array.map f ai ) a let mmap2 f a b = Array.mapi (fun i ai -> let bi = b.(i) in Array.mapi (fun j aj -> f aj bi.(j) ) ai ) a let mmap3 f a b c = Array.mapi (fun i ai -> let bi = b.(i) and ci = c.(i) in Array.mapi (fun j aj -> f aj bi.(j) ci.(j) ) ai ) a let ssplit a = mmap fst a, mmap snd a end module String = struct include String let startswith x s = let xn = String.length x and sn = String.length s in xn >= sn && String.sub x 0 sn = s end let rec list_join sep = function | [] -> [] | [x] -> [x] | x :: xs -> x :: sep :: list_join sep xs let option_map f = function | Some x -> Some (f x) | None -> None let save_to filename writer x = let oc = open_out filename in let ob = Bi_outbuf.create_channel_writer oc in writer ob x; Bi_outbuf.add_char ob '\n'; Bi_outbuf.flush_channel_writer ob; close_out oc;; let b64_order = "+/0123456789aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ" let compare_b64 a b = let na = String.length a and nb = String.length b in let value_of c = try String.index b64_order c with Not_found -> -1 in let rec loop i = match (i < na), (i < nb) with | true, true -> let diff = value_of a.[i] - value_of b.[i] in if diff = 0 then loop (i+1) else diff | true, false -> 1 | false, true -> -1 | false, false -> 0 in loop 0 module SMap = Map.Make(String) belenios-1.4+dfsg/src/lib/common.mli000066400000000000000000000055031307140314400174250ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) val ( |> ) : 'a -> ('a -> 'b) -> 'b module Array : sig include module type of Array val exists : ('a -> bool) -> 'a array -> bool val forall : ('a -> bool) -> 'a array -> bool val forall2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool val fforall : ('a -> bool) -> 'a array array -> bool val fforall2 : ('a -> 'b -> bool) -> 'a array array -> 'b array array -> bool val fforall3 : ('a -> 'b -> 'c -> bool) -> 'a array array -> 'b array array -> 'c array array -> bool val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val map3 : ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array val mmap : ('a -> 'b) -> 'a array array -> 'b array array val mmap2 : ('a -> 'b -> 'c) -> 'a array array -> 'b array array -> 'c array array val mmap3 : ('a -> 'b -> 'c -> 'd) -> 'a array array -> 'b array array -> 'c array array -> 'd array array val ssplit : ('a * 'b) array array -> 'a array array * 'b array array end module String : sig include module type of String val startswith : string -> string -> bool end val list_join : 'a -> 'a list -> 'a list val option_map : ('a -> 'b) -> 'a option -> 'b option val save_to : string -> (Bi_outbuf.t -> 'a -> unit) -> 'a -> unit val compare_b64 : string -> string -> int module SMap : Map.S with type key = string belenios-1.4+dfsg/src/lib/credential.ml000066400000000000000000000062371307140314400201030ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Signatures let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" let token_length = 14 let n58 = Z.of_int 58 let n53 = Z.of_int 53 module MakeGenerate (M : RANDOM) = struct let get_random_digit () = M.bind (M.random n58) (fun x -> M.return (Z.to_int x)) let generate_raw_token () = let res = Bytes.create token_length in let rec loop i accu = if i < token_length then ( M.bind (get_random_digit ()) (fun digit -> Bytes.set res i digits.[digit]; loop (i+1) Z.(n58 * accu + of_int digit) ) ) else M.return (Bytes.to_string res, accu) in loop 0 Z.zero let add_checksum (raw, value) = let checksum = 53 - Z.(to_int (value mod n53)) in M.return (raw ^ String.make 1 digits.[checksum]) let generate () = M.bind (generate_raw_token ()) add_checksum end let check x = String.length x = token_length + 1 && let rec loop i accu = if i < token_length then ( let digit = String.index digits x.[i] in loop (i+1) Z.(n58 * accu + of_int digit) ) else accu in try let n = loop 0 Z.zero in let checksum = String.index digits x.[token_length] in Z.((n + of_int checksum) mod n53 =% zero) with Not_found -> false let remove_dashes x = let n = String.length x in let res = Buffer.create n in for i = 0 to n-1 do let c = x.[i] in if c <> '-' then Buffer.add_char res c; done; Buffer.contents res module MakeDerive (G : GROUP) = struct let derive uuid x = let salt = remove_dashes (Uuidm.to_string uuid) in let derived = pbkdf2_hex ~iterations:1000 ~salt x in Z.(of_string_base 16 derived mod G.q) end belenios-1.4+dfsg/src/lib/credential.mli000066400000000000000000000033411307140314400202450ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Signatures module MakeGenerate (M : RANDOM) : sig val generate : unit -> string M.t end val check : string -> bool module MakeDerive (G : GROUP) : sig val derive : Uuidm.t -> string -> Z.t end belenios-1.4+dfsg/src/lib/election.ml000066400000000000000000000566461307140314400176040ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_t open Signatures open Common (** Helper functions *) let check_modulo p x = Z.(geq x zero && lt x p) let question_length q = Array.length q.q_answers + match q.q_blank with | Some true -> 1 | _ -> 0 (** Simple monad *) module MakeSimpleMonad (G : GROUP) = struct type 'a t = unit -> 'a let ballots = ref [] let return x () = x let bind x f = f (x ()) let fail e = raise e let prng = lazy (pseudo_rng (random_string secure_rng 16)) let random q = let size = Z.bit_length q / 8 + 1 in fun () -> let r = random_string (Lazy.force prng) size in Z.(of_bits r mod q) type elt = G.t ballot let cast x () = ballots := x :: !ballots let fold f x () = List.fold_left (fun accu b -> f () b accu ()) x !ballots let cardinal () = List.length !ballots end (** Distributed key generation *) module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) = struct open G open M let ( >>= ) = bind let ( / ) x y = x *~ invert y (** Fiat-Shamir non-interactive zero-knowledge proofs of knowledge *) let fs_prove gs x oracle = random q >>= fun w -> let commitments = Array.map (fun g -> g **~ w) gs in let challenge = oracle commitments in let response = Z.((w + x * challenge) mod q) in return {challenge; response} let generate_and_prove () = random q >>= fun x -> let trustee_public_key = g **~ x in let zkp = "pok|" ^ G.to_string trustee_public_key ^ "|" in fs_prove [| g |] x (G.hash zkp) >>= fun trustee_pok -> return (x, {trustee_pok; trustee_public_key}) let check {trustee_pok; trustee_public_key = y} = G.check y && let {challenge; response} = trustee_pok in check_modulo q challenge && check_modulo q response && let commitment = g **~ response / (y **~ challenge) in let zkp = "pok|" ^ G.to_string y ^ "|" in Z.(challenge =% G.hash zkp [| commitment |]) let combine pks = Array.fold_left (fun y {trustee_public_key; _} -> y *~ trustee_public_key ) G.one pks end (** Homomorphic elections *) module MakeElection (G : GROUP) (M : RANDOM) = struct open G type 'a m = 'a M.t open M let ( >>= ) = bind type elt = G.t type t = elt election type private_key = Z.t type public_key = elt let ( / ) x y = x *~ invert y type ciphertext = elt Serializable_t.ciphertext array array let dummy_ciphertext = { alpha = G.one; beta = G.one; } (** Multiply two ElGamal ciphertexts. *) let eg_combine c1 c2 = { alpha = c1.alpha *~ c2.alpha; beta = c1.beta *~ c2.beta; } let neutral_ciphertext e = Array.map (fun q -> Array.make (question_length q) dummy_ciphertext ) e.e_params.e_questions let combine_ciphertexts = Array.mmap2 eg_combine type plaintext = int array array type ballot = elt Serializable_t.ballot type randomness = Z.t array array (** ElGamal encryption. *) let eg_encrypt y r x = { alpha = g **~ r; beta = y **~ r *~ g **~ Z.of_int x; } let dummy_proof = { challenge = Z.zero; response = Z.zero; } (** Fiat-Shamir non-interactive zero-knowledge proofs of knowledge *) let fs_prove gs x oracle = random q >>= fun w -> let commitments = Array.map (fun g -> g **~ w) gs in let challenge = oracle commitments in let response = Z.((w + x * challenge) mod q) in return {challenge; response} (** ZKPs for disjunctions *) let eg_disj_prove y d zkp x r {alpha; beta} = (* prove that alpha = g^r and beta = y^r/d_x *) (* the size of d is the number of disjuncts *) let n = Array.length d in assert (0 <= x && x < n); let proofs = Array.make n dummy_proof and commitments = Array.make (2*n) g and total_challenges = ref Z.zero in (* compute fake proofs *) let f i = let challenge = random q and response = random q in challenge >>= fun challenge -> response >>= fun response -> proofs.(i) <- {challenge; response}; commitments.(2*i) <- g **~ response / alpha **~ challenge; commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge; total_challenges := Z.(!total_challenges + challenge); return () in let rec loop i = if i < x then f i >>= fun () -> loop (succ i) else if i = x then loop (succ i) else if i < n then f i >>= fun () -> loop (succ i) else return () in loop 0 >>= fun () -> total_challenges := Z.(q - !total_challenges mod q); (* compute genuine proof *) fs_prove [| g; y |] r (fun commitx -> Array.blit commitx 0 commitments (2*x) 2; let prefix = Printf.sprintf "prove|%s|%s,%s|" zkp (G.to_string alpha) (G.to_string beta) in Z.((G.hash prefix commitments + !total_challenges) mod q) ) >>= fun p -> proofs.(x) <- p; return proofs let eg_disj_verify y d zkp proofs {alpha; beta} = G.check alpha && G.check beta && let n = Array.length d in n = Array.length proofs && let commitments = Array.make (2*n) g and total_challenges = ref Z.zero in try for i = 0 to n-1 do let {challenge; response} = proofs.(i) in if check_modulo q challenge && check_modulo q response then ( commitments.(2*i) <- g **~ response / alpha **~ challenge; commitments.(2*i+1) <- y **~ response / (beta *~ d.(i)) **~ challenge; total_challenges := Z.(!total_challenges + challenge); ) else raise Exit done; total_challenges := Z.(!total_challenges mod q); let prefix = Printf.sprintf "prove|%s|%s,%s|" zkp (G.to_string alpha) (G.to_string beta) in Z.(hash prefix commitments =% !total_challenges) with Exit -> false (** ZKPs for blank ballots *) let make_blank_proof y zkp min max m0 c0 r0 mS cS rS = let zkp = Printf.sprintf "%s|%s,%s,%s,%s,%s,%s" zkp (G.to_string g) (G.to_string y) (G.to_string c0.alpha) (G.to_string c0.beta) (G.to_string cS.alpha) (G.to_string cS.beta) in if m0 = 0 then ( let blank_proof = (* proof of m0 = 0 \/ mS = 0 (first is true) *) random q >>= fun challenge1 -> random q >>= fun response1 -> let commitmentA1 = g **~ response1 *~ cS.alpha **~ challenge1 in let commitmentB1 = y **~ response1 *~ cS.beta **~ challenge1 in random q >>= fun w -> let commitmentA0 = g **~ w and commitmentB0 = y **~ w in let prefix = Printf.sprintf "bproof0|%s|" zkp in let h = G.hash prefix [|commitmentA0; commitmentB0; commitmentA1; commitmentB1|] in let challenge0 = Z.(erem (h - challenge1) q) in let response0 = Z.(erem (w - r0 * challenge0) q) in return [| {challenge=challenge0; response=response0}; {challenge=challenge1; response=response1}; |] in let overall_proof = (* proof of m0 = 1 \/ min <= mS <= max (second is true) *) assert (min <= mS && mS <= max); random q >>= fun challenge0 -> random q >>= fun response0 -> let proof0 = {challenge=challenge0; response=response0} in let overall_proof = Array.make (max-min+2) proof0 in let commitments = Array.make (2*(max-min+2)) g in let total_challenges = ref challenge0 in commitments.(0) <- g **~ response0 *~ c0.alpha **~ challenge0; commitments.(1) <- y **~ response0 *~ (c0.beta / g) **~ challenge0; let index_true = mS-min+1 in let rec loop i = if i < max-min+2 then ( if i <> index_true then ( random q >>= fun challenge -> random q >>= fun response -> let nbeta = cS.beta / (g **~ Z.of_int (min+i-1)) in let j = 2*i in overall_proof.(i) <- {challenge; response}; commitments.(j) <- g **~ response *~ cS.alpha **~ challenge; commitments.(j+1) <- y **~ response *~ nbeta **~ challenge; total_challenges := Z.(!total_challenges + challenge); loop (i+1) ) else loop (i+1) ) else return () in loop 1 >>= fun () -> random q >>= fun w -> let j = 2 * index_true in commitments.(j) <- g **~ w; commitments.(j+1) <- y **~ w; let prefix = Printf.sprintf "bproof1|%s|" zkp in let h = G.hash prefix commitments in let challenge = Z.(erem (h - !total_challenges) q) in let response = Z.(erem (w - rS * challenge) q) in overall_proof.(index_true) <- {challenge; response}; return overall_proof in blank_proof >>= fun blank_proof -> overall_proof >>= fun overall_proof -> return (overall_proof, blank_proof) ) else ( let blank_proof = (* proof of m0 = 0 \/ mS = 0 (second is true) *) assert (mS = 0); random q >>= fun challenge0 -> random q >>= fun response0 -> let commitmentA0 = g **~ response0 *~ c0.alpha **~ challenge0 in let commitmentB0 = y **~ response0 *~ c0.beta **~ challenge0 in random q >>= fun w -> let commitmentA1 = g **~ w and commitmentB1 = y **~ w in let prefix = Printf.sprintf "bproof0|%s|" zkp in let h = G.hash prefix [|commitmentA0; commitmentB0; commitmentA1; commitmentB1|] in let challenge1 = Z.(erem (h - challenge0) q) in let response1 = Z.(erem (w - rS * challenge1) q) in return [| {challenge=challenge0; response=response0}; {challenge=challenge1; response=response1} |] in let overall_proof = (* proof of m0 = 1 \/ min <= mS <= max (first is true) *) assert (m0 = 1); let nil_proof = {challenge=Z.zero; response=Z.zero} in let overall_proof = Array.make (max-min+2) nil_proof in let commitments = Array.make (2*(max-min+2)) g in let total_challenges = ref Z.zero in let rec loop i = if i < max-min+2 then ( random q >>= fun challenge -> random q >>= fun response -> let nbeta = cS.beta / (g **~ Z.of_int (min+i-1)) in let j = 2*i in overall_proof.(i) <- {challenge; response}; commitments.(j) <- g **~ response *~ cS.alpha **~ challenge; commitments.(j+1) <- y **~ response *~ nbeta **~ challenge; total_challenges := Z.(!total_challenges + challenge); loop (i+1) ) else return () in loop 1 >>= fun () -> random q >>= fun w -> commitments.(0) <- g **~ w; commitments.(1) <- y **~ w; let prefix = Printf.sprintf "bproof1|%s|" zkp in let h = G.hash prefix commitments in let challenge = Z.(erem (h - !total_challenges) q) in let response = Z.(erem (w - r0 * challenge) q) in overall_proof.(0) <- {challenge; response}; return overall_proof in blank_proof >>= fun blank_proof -> overall_proof >>= fun overall_proof -> return (overall_proof, blank_proof) ) let verify_blank_proof y zkp min max c0 cS overall_proof blank_proof = G.check c0.alpha && G.check c0.beta && G.check cS.alpha && G.check cS.beta && let zkp = Printf.sprintf "%s|%s,%s,%s,%s,%s,%s" zkp (G.to_string g) (G.to_string y) (G.to_string c0.alpha) (G.to_string c0.beta) (G.to_string cS.alpha) (G.to_string cS.beta) in (* check blank_proof, proof of m0 = 0 \/ mS = 0 *) Array.length blank_proof = 2 && ( try let commitments = Array.make 4 g in let total_challenges = ref Z.zero in let {challenge; response} = blank_proof.(0) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; commitments.(0) <- g **~ response *~ c0.alpha **~ challenge; commitments.(1) <- y **~ response *~ c0.beta **~ challenge; total_challenges := Z.(!total_challenges + challenge); let {challenge; response} = blank_proof.(1) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; commitments.(2) <- g **~ response *~ cS.alpha **~ challenge; commitments.(3) <- y **~ response *~ cS.beta **~ challenge; total_challenges := Z.(!total_challenges + challenge); let prefix = Printf.sprintf "bproof0|%s|" zkp in let h = G.hash prefix commitments in let total_challenges = Z.(!total_challenges mod q) in Z.(h =% total_challenges) with Exit -> false ) && (* check overall_proof, proof of m0 = 1 \/ min <= mS <= max *) Array.length overall_proof = max-min+2 && ( try let commitments = Array.make (2*(max-min+2)) g in let total_challenges = ref Z.zero in let {challenge; response} = overall_proof.(0) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; commitments.(0) <- g **~ response *~ c0.alpha **~ challenge; commitments.(1) <- y **~ response *~ (c0.beta / g) **~ challenge; total_challenges := Z.(!total_challenges + challenge); let rec loop i = if i < max-min+2 then ( let {challenge; response} = overall_proof.(i) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; let nbeta = cS.beta / (g **~ Z.of_int (min+i-1)) in let j = 2*i in commitments.(j) <- g **~ response *~ cS.alpha **~ challenge; commitments.(j+1) <- y **~ response *~ nbeta **~ challenge; total_challenges := Z.(!total_challenges + challenge); loop (i+1) ) else () in loop 1; let prefix = Printf.sprintf "bproof1|%s|" zkp in let h = G.hash prefix commitments in let total_challenges = Z.(!total_challenges mod q) in Z.(h =% total_challenges) with Exit -> false ) (** Ballot creation *) let invg = invert g let d01 = [| G.one; invg |] let make_d min max = let n = max - min + 1 in let d = Array.make n (invert (g **~ Z.of_int min)) in for i = 1 to n-1 do d.(i) <- d.(i-1) *~ invg done; d let swap xs = let rec loop i accu = if i >= 0 then xs.(i) >>= fun x -> loop (pred i) (x::accu) else return (Array.of_list accu) in loop (pred (Array.length xs)) [] let sswap xs = let rec loop_outer i accu = if i >= 0 then ( let x = xs.(i) in let rec loop_inner j accu = if j >= 0 then x.(j) >>= fun r -> loop_inner (pred j) (r::accu) else return (Array.of_list accu) in loop_inner (Array.length x - 1) [] >>= fun ys -> loop_outer (pred i) (ys::accu) ) else return (Array.of_list accu) in loop_outer (Array.length xs - 1) [] let create_answer y zkp q r m = let n = Array.length r in assert (n = Array.length m); let choices = Array.map2 (eg_encrypt y) r m in let individual_proofs = Array.map3 (eg_disj_prove y d01 zkp) m r choices in swap individual_proofs >>= fun individual_proofs -> match q.q_blank with | Some true -> (* index 0 is whether the ballot is blank or not, indexes 1..n-1 are the actual choices *) assert (n = Array.length q.q_answers + 1); let choices' = Array.sub choices 1 (n - 1) in let r' = Array.sub r 1 (n - 1) in let m' = Array.sub m 1 (n - 1) in let sumr = Array.fold_left Z.(+) Z.zero r' in let summ = Array.fold_left (+) 0 m' in let sumc = Array.fold_left eg_combine dummy_ciphertext choices' in let bproofs = make_blank_proof y zkp q.q_min q.q_max m.(0) choices.(0) r.(0) summ sumc sumr in bproofs >>= fun (overall_proof, blank_proof) -> let blank_proof = Some blank_proof in return {choices; individual_proofs; overall_proof; blank_proof} | _ -> (* indexes 0..n-1 are the actual choices *) assert (n = Array.length q.q_answers); let sumr = Array.fold_left Z.(+) Z.zero r in let summ = Array.fold_left (+) 0 m in let sumc = Array.fold_left eg_combine dummy_ciphertext choices in assert (q.q_min <= summ && summ <= q.q_max); let d = make_d q.q_min q.q_max in let overall_proof = eg_disj_prove y d zkp (summ - q.q_min) sumr sumc in overall_proof >>= fun overall_proof -> let blank_proof = None in return {choices; individual_proofs; overall_proof; blank_proof} let make_randomness e = sswap (Array.map (fun q -> Array.init (question_length q) (fun _ -> random G.q) ) e.e_params.e_questions) let make_sig_prefix zkp commitment = "sig|" ^ zkp ^ "|" ^ G.to_string commitment ^ "|" let make_sig_contents answers = List.flatten ( List.map (fun a -> List.flatten ( List.map (fun {alpha; beta} -> [alpha; beta] ) (Array.to_list a.choices) ) ) (Array.to_list answers) ) |> Array.of_list let create_ballot e ?sk r m = let p = e.e_params in let sk, zkp = match sk with | None -> None, "" | Some x -> let y = G.(g **~ x) in Some (x, y), G.to_string y in swap (Array.map3 (create_answer p.e_public_key zkp) p.e_questions r m) >>= fun answers -> ( match sk with | None -> return None | Some (x, y) -> random q >>= fun w -> let commitment = g **~ w in let prefix = make_sig_prefix zkp commitment in let contents = make_sig_contents answers in let s_challenge = G.hash prefix contents in let s_response = Z.(erem (w - x * s_challenge) q) in return (Some {s_public_key = y; s_challenge; s_response}) ) >>= fun signature -> return { answers; election_hash = e.e_fingerprint; election_uuid = p.e_uuid; signature; } (** Ballot verification *) let verify_answer y zkp q a = let n = Array.length a.choices in n = Array.length a.individual_proofs && Array.forall2 (eg_disj_verify y d01 zkp) a.individual_proofs a.choices && match q.q_blank, a.blank_proof with | Some true, Some blank_proof -> n = Array.length q.q_answers + 1 && let c = Array.sub a.choices 1 (n - 1) in let sumc = Array.fold_left eg_combine dummy_ciphertext c in verify_blank_proof y zkp q.q_min q.q_max a.choices.(0) sumc a.overall_proof blank_proof | _, None -> n = Array.length q.q_answers && let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in let d = make_d q.q_min q.q_max in eg_disj_verify y d zkp a.overall_proof sumc | _, _ -> false let check_ballot e b = let p = e.e_params in b.election_uuid = p.e_uuid && b.election_hash = e.e_fingerprint && let ok, zkp = match b.signature with | Some {s_public_key = y; s_challenge; s_response} -> let zkp = G.to_string y in let ok = check_modulo q s_challenge && check_modulo q s_response && let commitment = g **~ s_response *~ y **~ s_challenge in let prefix = make_sig_prefix zkp commitment in let contents = make_sig_contents b.answers in Z.(s_challenge =% G.hash prefix contents) in ok, zkp | None -> true, "" in ok && Array.forall2 (verify_answer p.e_public_key zkp) p.e_questions b.answers let extract_ciphertext b = Array.map (fun x -> x.choices) b.answers type factor = elt partial_decryption let eg_factor x {alpha; _} = let zkp = "decrypt|" ^ G.to_string (g **~ x) ^ "|" in alpha **~ x, fs_prove [| g; alpha |] x (hash zkp) let check_ciphertext c = Array.fforall (fun {alpha; beta} -> G.check alpha && G.check beta) c let compute_factor c x = if check_ciphertext c then ( let res = Array.mmap (eg_factor x) c in let decryption_factors, decryption_proofs = Array.ssplit res in sswap decryption_proofs >>= fun decryption_proofs -> return {decryption_factors; decryption_proofs} ) else ( fail (Invalid_argument "Invalid ciphertext") ) let check_factor c y f = let zkp = "decrypt|" ^ G.to_string y ^ "|" in Array.fforall3 (fun {alpha; _} f {challenge; response} -> check_modulo q challenge && check_modulo q response && let commitments = [| g **~ response / (y **~ challenge); alpha **~ response / (f **~ challenge); |] in Z.(hash zkp commitments =% challenge) ) c f.decryption_factors f.decryption_proofs type result = elt Serializable_t.result let combine_factors num_tallied encrypted_tally partial_decryptions = let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in let factors = Array.fold_left (fun a b -> Array.mmap2 ( *~ ) a b.decryption_factors ) dummy partial_decryptions in let results = Array.mmap2 (fun {beta; _} f -> beta / f ) encrypted_tally factors in let log = let module GMap = Map.Make(G) in let rec loop i cur accu = if i <= num_tallied then loop (succ i) (cur *~ g) (GMap.add cur i accu) else accu in let map = loop 0 G.one GMap.empty in fun x -> try GMap.find x map with Not_found -> invalid_arg "Cannot compute result" in let result = Array.mmap log results in {num_tallied; encrypted_tally; partial_decryptions; result} let check_result pks r = let {encrypted_tally; partial_decryptions; result; _} = r in check_ciphertext encrypted_tally && (* decryption factors may be not in the same order as pks! *) Array.forall (fun pk -> Array.exists (check_factor encrypted_tally pk) partial_decryptions ) pks && let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in let factors = Array.fold_left (fun a b -> Array.mmap2 ( *~ ) a b.decryption_factors ) dummy partial_decryptions in let results = Array.mmap2 (fun {beta; _} f -> beta / f ) encrypted_tally factors in Array.fforall2 (fun r1 r2 -> r1 =~ g **~ Z.of_int r2) results result let extract_tally r = r.result end belenios-1.4+dfsg/src/lib/election.mli000066400000000000000000000063021307140314400177350ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) (** Election primitives *) open Platform open Serializable_t open Signatures val question_length : question -> int module MakeSimpleMonad (G : GROUP) : sig (** {2 Monadic definitions} *) include Signatures.MONAD with type 'a t = unit -> 'a (** {2 Random number generation} *) val random : Z.t -> Z.t t (** [random q] returns a random number modulo [q]. It uses a secure random number generator lazily initialized by a 128-bit seed shared by all instances. *) (** {2 Ballot box management} *) include Signatures.MONADIC_MAP_RO with type 'a m := 'a t and type elt = G.t ballot and type key := unit val cast : elt -> unit t end (** Simple election monad that keeps all ballots in memory. *) module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) : sig (** This module implements a simple distributed key generation. Each share is a number modulo q, and the secret key is their sum. All shares are needed to decrypt, but the decryptions can be done in a distributed fashion. *) val generate_and_prove : unit -> (Z.t * G.t trustee_public_key) M.t (** [generate_and_prove ()] returns a new keypair [(x, y)]. [x] is the secret exponent, [y] contains the public key and a zero-knowledge proof of knowledge of [x]. *) val check : G.t trustee_public_key -> bool (** Check a public key and its proof. *) val combine : G.t trustee_public_key array -> G.t (** Combine all public key shares into an election public key. *) end (** Simple distributed generation of an election public key. *) module MakeElection (G : GROUP) (M : RANDOM) : ELECTION with type elt = G.t and type 'a m = 'a M.t (** Implementation of {!Signatures.ELECTION}. *) belenios-1.4+dfsg/src/lib/group.ml000066400000000000000000000045311307140314400171200ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_j open Signatures (** Generic group parsing *) (* For now, only finite fields are supported... *) let of_string x = let group = ff_params_of_string x in let module G = (val Group_field.make group : Group_field.GROUP) in (module G : GROUP) let read state buf = let group = read_ff_params state buf in let module G = (val Group_field.make group : Group_field.GROUP) in (module G : GROUP) let election_params_of_string x = let params = params_of_string (read_wrapped_pubkey read_ff_params read_number) x in let {wpk_group=group; wpk_y=y} = params.e_public_key in let module X = struct module G = (val Group_field.make group : Group_field.GROUP) let election = { e_params = {params with e_public_key = y}; e_fingerprint = sha256_b64 x; } end in (module X : ELECTION_DATA) belenios-1.4+dfsg/src/lib/group.mli000066400000000000000000000034211307140314400172660ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) (** Generic group parsing *) open Signatures val of_string : string -> (module GROUP) (** Parse a [Serializable_t.group]. *) val read : (module GROUP) reader val election_params_of_string : string -> (module ELECTION_DATA) (** Parse a [Serializable_t.params]. *) belenios-1.4+dfsg/src/lib/group_field.ml000066400000000000000000000065041307140314400202650ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_j open Common (** Helper functions *) let check_modulo p x = Z.(geq x zero && lt x p) let map_and_concat_with_commas f xs = let n = Array.length xs in let res = Buffer.create (n * 1024) in for i = 0 to n-1 do Buffer.add_string res (f xs.(i)); Buffer.add_char res ','; done; let size = Buffer.length res - 1 in if size > 0 then Buffer.sub res 0 size else "" (** Finite field arithmetic *) let check_params {p; q; g} = Z.probab_prime p 20 > 0 && Z.probab_prime q 20 > 0 && check_modulo p g && check_modulo p q && Z.(powm g q p =% one) module type GROUP = Signatures.GROUP with type t = Z.t and type group = ff_params let unsafe_make group = let {p; q; g} = group in let module G = struct open Z type t = Z.t let p = p let q = q let one = Z.one let g = g let ( *~ ) a b = a * b mod p let ( **~ ) a b = powm a b p let invert x = Z.invert x p let ( =~ ) = Z.( =% ) let check x = check_modulo p x && x **~ q =~ one let to_string = Z.to_string let of_string = Z.of_string let read state buf = match Yojson.Safe.from_lexbuf ~stream:true state buf with | `String s -> Z.of_string s | _ -> invalid_arg "Group_field.read: a string was expected" let write buf x = Bi_outbuf.add_char buf '"'; Bi_outbuf.add_string buf (Z.to_string x); Bi_outbuf.add_char buf '"' let hash prefix xs = let x = prefix ^ (map_and_concat_with_commas Z.to_string xs) in let z = Z.of_string_base 16 (sha256_hex x) in Z.(z mod q) let compare = Z.compare type group = ff_params let group = group let write_group = write_ff_params end in (module G : GROUP) let make group = if check_params group then unsafe_make group else invalid_arg "incorrect finite field parameters" belenios-1.4+dfsg/src/lib/group_field.mli000066400000000000000000000040101307140314400204240ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) (** Finite field arithmetic *) open Platform open Serializable_t module type GROUP = Signatures.GROUP with type t = Z.t and type group = ff_params (** Multiplicative subgroup of a finite field. *) val check_params : ff_params -> bool (** Check consistency of finite field parameters. *) val make : ff_params -> (module GROUP) (** [finite_field params] builds the multiplicative subgroup of F[params.p], generated by [params.g], of order [params.q]. It checks the consistency of the parameters. *) belenios-1.4+dfsg/src/lib/lib.mllib000066400000000000000000000002261307140314400172160ustar00rootroot00000000000000src/platform/native/Platform Serializable_builtin_t Serializable_builtin_j Serializable_t Serializable_j Common Group_field Group Election Credential belenios-1.4+dfsg/src/lib/platform.mli000066400000000000000000000045161307140314400177640ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) val sha256_hex : string -> string val sha256_b64 : string -> string val pbkdf2_hex : iterations:int -> salt:string -> string -> string type rng val secure_rng : rng val pseudo_rng : string -> rng val random_string : rng -> int -> string module Z : sig type t val zero : t val one : t val of_int : int -> t val of_string : string -> t val of_string_base : int -> string -> t val ( + ) : t -> t -> t val ( - ) : t -> t -> t val ( * ) : t -> t -> t val ( mod ) : t -> t -> t val erem : t -> t -> t val to_int : t -> int val to_string : t -> string val compare : t -> t -> int val ( =% ) : t -> t -> bool val geq : t -> t -> bool val lt : t -> t -> bool val powm : t -> t -> t -> t val invert : t -> t -> t val probab_prime : t -> int -> int val bit_length : t -> int val of_bits : string -> t end belenios-1.4+dfsg/src/lib/serializable.atd000066400000000000000000000105121307140314400205660ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) (** {2 Predefined types} *) type number = abstract type uuid = abstract (** {2 Basic cryptographic datastructures} *) type 'a ciphertext = { alpha : 'a; beta : 'a; } type proof = { challenge : number; response : number; } type disjunctive_proof = proof list (** {2 Trustees} *) type 'a trustee_public_key = { pok : proof; public_key : 'a; } (** {2 Elections} *) type ff_params = { g : number; p : number; q : number; } type ('a, 'b) wrapped_pubkey = { group : 'a; y : 'b; } type question = { answers : string list ; ?blank : bool option; min : int; max : int; question : string; } type 'a params = { description : string; name : string; public_key : 'a; questions : question list ; uuid : uuid; } type template = { description : string; name : string; questions : question list ; } type 'a answer = { choices : 'a ciphertext list ; individual_proofs : disjunctive_proof list ; overall_proof : disjunctive_proof; ?blank_proof : disjunctive_proof option; } (* FIXME: merge this with trustee_public_key *) type 'a signature = { public_key : 'a; challenge : number; response : number; } type 'a ballot = { answers : 'a answer list ; election_hash : string; election_uuid : uuid; ?signature : 'a signature option; } type 'a partial_decryption = { decryption_factors : 'a list list ; decryption_proofs : proof list list ; } type plaintext = int list list type 'a encrypted_tally = 'a ciphertext list list type 'a result = { num_tallied : int; encrypted_tally : 'a encrypted_tally; partial_decryptions : 'a partial_decryption list ; result : plaintext; } belenios-1.4+dfsg/src/lib/serializable_builtin_j.ml000066400000000000000000000064431307140314400224750ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_builtin_t (** {1 Helpers for interacting with atd-generated stuff} *) let make_write to_string buf x = Bi_outbuf.add_char buf '"'; Bi_outbuf.add_string buf (to_string x); Bi_outbuf.add_char buf '"' let make_read name of_string state buf = match Yojson.Safe.from_lexbuf ~stream:true state buf with | `String s -> of_string s | _ -> invalid_arg (name ^ ": a string was expected") (** {1 Serializers for type number} *) let write_number = make_write Z.to_string let read_number = make_read "read_number" Z.of_string (** {1 Serializers for type uuid} *) let write_uuid = make_write Uuidm.to_string let raw_uuid_of_string x = match Uuidm.of_string x with | Some s -> s | _ -> invalid_arg "uuid_of_string: invalid UUID" let read_uuid = make_read "read_uuid" raw_uuid_of_string (** {1 Serializers for type int_or_null} *) let write_int_or_null buf = function | Some n -> Bi_outbuf.add_string buf (string_of_int n) | None -> Bi_outbuf.add_string buf "null" let int_or_null_of_json = function | `Int i -> Some i | `Null -> None | _ -> invalid_arg "int_or_null_of_json: unexpected input" let read_int_or_null state buf = int_or_null_of_json (Yojson.Safe.from_lexbuf ~stream:true state buf) (** {1 Serializers for type string_set} *) let write_string_set buf set = `List (SSet.elements set |> List.map (fun x -> `String x)) |> Yojson.Safe.to_outbuf buf let string_set_of_json = function | `List xs -> List.fold_left (fun accu x -> match x with | `String y -> SSet.add y accu | _ -> invalid_arg "string_set_of_json: a string was expected" ) SSet.empty xs | _ -> invalid_arg "string_set_of_json: a list was expected" let read_string_set state buf = Yojson.Safe.from_lexbuf ~stream:true state buf |> string_set_of_json belenios-1.4+dfsg/src/lib/serializable_builtin_j.mli000066400000000000000000000043021307140314400226360ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Serializable_builtin_t (** {1 Serializers for type number} *) val write_number : Bi_outbuf.t -> number -> unit val read_number : Yojson.Safe.lexer_state -> Lexing.lexbuf -> number (** {1 Serializers for type uuid} *) val write_uuid : Bi_outbuf.t -> uuid -> unit val read_uuid : Yojson.Safe.lexer_state -> Lexing.lexbuf -> uuid (** {1 Serializers for type int_or_null} *) val write_int_or_null : Bi_outbuf.t -> int_or_null -> unit val read_int_or_null : Yojson.Safe.lexer_state -> Lexing.lexbuf -> int_or_null (** {1 Serializers for type string_set} *) val write_string_set : Bi_outbuf.t -> string_set -> unit val read_string_set : Yojson.Safe.lexer_state -> Lexing.lexbuf -> string_set belenios-1.4+dfsg/src/lib/serializable_builtin_t.ml000066400000000000000000000032231307140314400225000ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform type number = Z.t type uuid = Uuidm.t type int_or_null = int option module SSet = Set.Make(String) type string_set = SSet.t belenios-1.4+dfsg/src/lib/serializable_builtin_t.mli000066400000000000000000000032371307140314400226560ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform type number = Z.t type uuid = Uuidm.t type int_or_null = int option module SSet : Set.S with type elt = string type string_set = SSet.t belenios-1.4+dfsg/src/lib/signatures.mli000066400000000000000000000167531307140314400203320ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) (** Signatures *) open Platform open Serializable_t (** Helpers for interacting with atd stuff *) type 'a reader = Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a type 'a writer = Bi_outbuf.t -> 'a -> unit (** A group suitable for discrete logarithm-based cryptography. *) module type GROUP = sig (** The following interface is redundant: it is assumed, but not checked, that usual mathematical relations hold. *) type t (** The type of elements. Note that it may be larger than the group itself, hence the [check] function below. *) val check : t -> bool (** Check group membership. *) val one : t (** The neutral element of the group. *) val g : t (** A generator of the group. *) val q : Z.t (** The order of [g]. *) val ( *~ ) : t -> t -> t (** Multiplication. *) val ( **~ ) : t -> Z.t -> t (** Exponentiation. *) val ( =~ ) : t -> t -> bool (** Equality test. *) val invert : t -> t (** Inversion. *) val to_string : t -> string (** Conversion to string. *) val of_string : string -> t (** Conversion from string. *) val read : t reader (** Reading from a stream. *) val write : t writer (** Writing to a stream. *) val hash : string -> t array -> Z.t (** Hash an array of elements into an integer mod [q]. The string argument is a string that is prepended before computing the hash. *) val compare : t -> t -> int (** A total ordering over the elements of the group. *) type group (** Serializable description of the group. *) val group : group val write_group : group writer end (** Monad signature. *) module type MONAD = sig type 'a t val return : 'a -> 'a t val bind : 'a t -> ('a -> 'b t) -> 'b t val fail : exn -> 'a t end (** Random number generation. *) module type RANDOM = sig include MONAD val random : Z.t -> Z.t t (** [random q] returns a random number modulo [q]. *) end (** Read operations of a monadic map. *) module type MONADIC_MAP_RO = sig type 'a m (** The type of monadic values. *) type elt (** The type of map values. *) type key (** The type of map keys. *) val fold : (key -> elt -> 'a -> 'a m) -> 'a -> 'a m (** [fold f a] computes [(f kN vN ... (f k2 v2 (f k1 v1 a))...)], where [k1/v1 ... kN/vN] are all key/value pairs. *) val cardinal : int m (** Return the number of bindings. *) end (** Election data needed for cryptographic operations. *) type 'a election = { e_params : 'a params; (** Parameters of the election. *) e_fingerprint : string; (** Fingerprint of the election. *) } (** Election data bundled with a group. *) module type ELECTION_DATA = sig module G : GROUP val election : G.t election end (** Cryptographic primitives for an election with homomorphic tally. *) module type ELECTION = sig type 'a m (** The type of monadic values. *) (** {2 Election parameters} *) (** Ballots are encrypted using public-key cryptography secured by the discrete logarithm problem. Here, we suppose private keys are integers modulo a large prime number. Public keys are members of a suitably chosen group. *) type elt type t = elt election type private_key = Z.t type public_key = elt (** {2 Ciphertexts} *) type ciphertext = elt Serializable_t.ciphertext array array (** A ciphertext that can be homomorphically combined. *) val neutral_ciphertext : t -> ciphertext (** The neutral element for [combine_ciphertext] below. *) val combine_ciphertexts : ciphertext -> ciphertext -> ciphertext (** Combine two ciphertexts. The encrypted tally of an election is the combination of all ciphertexts of valid cast ballots. *) (** {2 Ballots} *) type plaintext = Serializable_t.plaintext (** The plaintext equivalent of [ciphertext], i.e. the contents of a ballot. When [x] is such a value, [x.(i).(j)] is the weight (0 or 1) given to answer [j] in question [i]. *) type ballot = elt Serializable_t.ballot (** A ballot ready to be transmitted, containing the encrypted answers and cryptographic proofs that they satisfy the election constraints. *) type randomness (** Randomness needed to create a ballot. *) val make_randomness : t -> randomness m (** Creates randomness for [create_ballot] below. The result can be kept for Benaloh-style auditing. *) val create_ballot : t -> ?sk:private_key -> randomness -> plaintext -> ballot m (** [create_ballot r answers] creates a ballot, or raises [Invalid_argument] if [answers] doesn't satisfy the election constraints. The private key, if given, will be used to sign the ballot. *) val check_ballot : t -> ballot -> bool (** [check_ballot b] checks all the cryptographic proofs in [b]. All ballots produced by [create_ballot] should pass this check. *) val extract_ciphertext : ballot -> ciphertext (** Extract the ciphertext from a ballot. *) (** {2 Partial decryptions} *) type factor = elt partial_decryption (** A decryption share. It is computed by a trustee from his or her private key share and the encrypted tally, and contains a cryptographic proof that he or she didn't cheat. *) val compute_factor : ciphertext -> private_key -> factor m val check_factor : ciphertext -> public_key -> factor -> bool (** [check_factor c pk f] checks that [f], supposedly submitted by a trustee whose public_key is [pk], is valid with respect to the encrypted tally [c]. *) (** {2 Result} *) type result = elt Serializable_t.result (** The election result. It contains the needed data to validate the result from the encrypted tally. *) val combine_factors : int -> ciphertext -> factor array -> result (** Combine the encrypted tally and the factors from all trustees to produce the election result. The first argument is the number of tallied ballots. May raise [Invalid_argument]. *) val check_result : public_key array -> result -> bool val extract_tally : result -> plaintext (** Extract the plaintext result of the election. *) end belenios-1.4+dfsg/src/platform/000077500000000000000000000000001307140314400165055ustar00rootroot00000000000000belenios-1.4+dfsg/src/platform/js/000077500000000000000000000000001307140314400171215ustar00rootroot00000000000000belenios-1.4+dfsg/src/platform/js/platform.ml000066400000000000000000000106231307140314400213010ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let sjcl = Js.Unsafe.variable "sjcl" let sha256 x = Js.Unsafe.meth_call sjcl "hash.sha256.hash" [| Js.string x |> Js.Unsafe.inject |] let sha256_hex x = Js.Unsafe.meth_call sjcl "codec.hex.fromBits" [| sha256 x |] |> Js.to_string let sha256_b64 x = let raw = Js.Unsafe.meth_call sjcl "codec.base64.fromBits" [| sha256 x |] |> Js.to_string in match (try Some (String.index raw '=') with Not_found -> None) with | Some i -> String.sub raw 0 i | None -> raw let pbkdf2_hex ~iterations ~salt x = let salt = Js.Unsafe.meth_call sjcl "codec.hex.toBits" [| Js.string salt |> Js.Unsafe.inject |] in let derived = Js.Unsafe.meth_call sjcl "misc.pbkdf2" [| Js.string x |> Js.Unsafe.inject; salt; Js.Unsafe.inject iterations; Js.Unsafe.inject 256; |] in Js.Unsafe.meth_call sjcl "codec.hex.fromBits" [| derived |] |> Js.to_string type rng = unit -> unit let sjcl_random = Js.Unsafe.get sjcl "random" (* PRNG is initialized in random.js *) let secure_rng () = () let pseudo_rng _ () = () let string_of_hex hex n = String.init n (fun i -> let c = int_of_string ("0x" ^ String.sub hex (2*i) 2) in char_of_int c ) let random_string rng n = let () = rng () in let words = Js.Unsafe.meth_call sjcl_random "randomWords" [| n/4+1 |> float_of_int |> Js.number_of_float |> Js.Unsafe.inject |] in let hex_words = Js.Unsafe.meth_call sjcl "codec.hex.fromBits" [| words |] |> Js.to_string in string_of_hex hex_words n module Z = struct open Js.Unsafe type t = any let lib = variable "BigInteger" let zero = get lib "ZERO" let one = get lib "ONE" let of_string_base b x = new_obj lib [| x |> Js.string |> inject; b |> float_of_int |> Js.number_of_float |> inject; |] let of_string x = of_string_base 10 x let of_int x = x |> string_of_int |> of_string let ( + ) x y = meth_call x "add" [| y |] let ( - ) x y = meth_call x "subtract" [| y |] let ( * ) x y = meth_call x "multiply" [| y |] let ( mod ) x y = meth_call x "mod" [| y |] let to_int x = meth_call x "intValue" [| |] let to_string x = meth_call x "toString" [| |] |> Js.to_string let compare x y = meth_call x "compareTo" [| y |] let ( =% ) x y = compare x y = 0 let geq x y = compare x y >= 0 let lt x y = compare x y < 0 let powm x y m = meth_call x "modPow" [| y; m |] let invert x m = meth_call x "modInverse" [| m |] let bit_length x = meth_call x "bitLength" [| |] let erem x y = let r = x mod y in if lt r zero then r + y else r let probab_prime x n = meth_call x "isProbablePrime" [| n |> float_of_int |> Js.number_of_float |> inject |] |> Js.float_of_number |> int_of_float let z256 = of_int 256 let of_bits x = let n = String.length x in let rec loop res i = if i >= 0 then loop (res * z256 + of_int (int_of_char x.[i])) (pred i) else res in loop zero (pred n) end belenios-1.4+dfsg/src/platform/js/random.js000066400000000000000000000010601307140314400207340ustar00rootroot00000000000000function init_prng () { // Start SJCL built-in collectors sjcl.random.startCollectors(); // Seed from window.crypto if present var cryptoObj = window.crypto || window.msCrypto; // for IE 11 if (cryptoObj) { var n = 8; var bytes = new Uint32Array(n); cryptoObj.getRandomValues(bytes); for (var i = 0; i < n; i++) { sjcl.random.addEntropy(bytes[i], 32); } if (console) { console.log("PRNG successfully initialized using crypto object"); } } } init_prng(); belenios-1.4+dfsg/src/platform/native/000077500000000000000000000000001307140314400177735ustar00rootroot00000000000000belenios-1.4+dfsg/src/platform/native/platform.ml000066400000000000000000000066171307140314400221630ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let sha256_hex x = Cryptokit.(x |> hash_string (Hash.sha256 ()) |> transform_string (Hexa.encode ()) ) let sha256_b64 x = Cryptokit.(x |> hash_string (Hash.sha256 ()) |> transform_string (Base64.encode_compact ()) ) let int_msb i = let result = Bytes.create 4 in Bytes.set result 0 (char_of_int (i lsr 24)); Bytes.set result 1 (char_of_int ((i lsr 16) land 0xff)); Bytes.set result 2 (char_of_int ((i lsr 8) land 0xff)); Bytes.set result 3 (char_of_int (i land 0xff)); Bytes.to_string result let xor a b = let n = String.length a in assert (n = String.length b); String.init n (fun i -> char_of_int (int_of_char a.[i] lxor int_of_char b.[i]) ) let pbkdf2 ~prf ~salt ~iterations ~size password = let c = iterations - 1 in let hLen = (prf password)#hash_size in let result = Bytes.create (hLen * size) in let one_iteration i = let u = Cryptokit.hash_string (prf password) (salt ^ int_msb i) in let rec loop c u accu = if c > 0 then let u' = Cryptokit.hash_string (prf password) u in loop (c-1) u' (xor accu u') else accu in loop c u u in for i = 1 to size do let offset = (i-1) * hLen in String.blit (one_iteration i) 0 result offset hLen; done; Bytes.to_string result let pbkdf2_hex ~iterations ~salt x = let open Cryptokit in let salt = transform_string (Hexa.decode ()) salt in pbkdf2 ~prf:MAC.hmac_sha256 ~iterations ~size:1 ~salt x |> transform_string (Hexa.encode ()) type rng = Cryptokit.Random.rng let secure_rng = if Belenios_version.debug && (try Sys.getenv "BELENIOS_USE_URANDOM" with Not_found -> "") <> "" then Cryptokit.Random.device_rng "/dev/urandom" else Cryptokit.Random.secure_rng let pseudo_rng = Cryptokit.Random.pseudo_rng let random_string = Cryptokit.Random.string module Z = struct include Z let ( =% ) = equal let bit_length x = Pervasives.(String.length (to_bits x) * 8) end belenios-1.4+dfsg/src/static/000077500000000000000000000000001307140314400161505ustar00rootroot00000000000000belenios-1.4+dfsg/src/static/belenios-tool.html.itarget000066400000000000000000000001011307140314400232370ustar00rootroot00000000000000sjcl.js jsbn.js jsbn2.js random.js tool_js.js belenios-tool.html belenios-1.4+dfsg/src/static/booth.css000066400000000000000000000002521307140314400177740ustar00rootroot00000000000000@import url('style.css'); @import url('superfish.css'); @import url('site.css'); #footer #bottom { line-height: 1.5em; } #ballot_tracker { font-weight: bold; } belenios-1.4+dfsg/src/static/logo.png000066400000000000000000000222551307140314400176240ustar00rootroot00000000000000PNG  IHDRZI pHYs  tIME 0 IDATx]y@T2 þ)h*R`⚹|s)*M-K.+( "((|͜sϙ{o;{+A]ut'}3̗#4MldX3wNÊs}|tN/U7Oc{.GYU@lh}Jг˰@ʃӿ$9^|)# }]))J5͆ 7vMkMQۦ`g(o;[To2rMMU _;arX7.Ѫɴ/.dDwp_2`i!nT~lqh9ȓpn `|@#O 믷X42Bΰ,]lF,o;r*M۝ iφJ'+}Д5tˬ}k۴C8֦"dkl/8dC9nȓ_qRURѧ}. M$hN`_?0&aW̷WOfX~!|-p,fFZR&vPB +6mI;oC@ܿ+okP5&94?O\*ǔm=|-mײ@0z @Mm };}!_vŹV 95y Pz2Ah`U 5#e̻#f~ ýXڈXd >3omjR%n$F,%H 12`At`8\y('I F"Ey AO>t_+`޼y/m{ܻwo9r`nݻw_ܜcЈ i1R@L `ځ!I, 4j_&#~p=1L%K,vZ!6*駟B L˲`Y F;H ,I`’:z6f _^/=싧,C0 rdR4ĉ'֯__&Mƍm{_ ԩRDAT?t @,(@\A0eSB@ f',C">kDEE}cx  6tquu œRWle,0Bl*ɜܲ"d$@kU &Dvzz-Rg WC'uy 5I0L(..HګW?~@fb[~ǏiӦ1OOEjMw'sGD4]~wV%F(,A2@`h.hBK:`EͭsT^nƞlcf6ڹsg7B*H$' hwwFDځ;^s)Pr)!g^&.[$sFΔ(V @6!eD5IX,(++6dff;w 5k֮]k#ދ-[,], 9APmO.\ qmtZ1pn>3e;}|FFW\iʏ# ߕH$E"QSV(++h4?lV&]R=ñ㱼s}z9'1Oq罷2n|OGbk @0 xeE0 0gH PXXxO{޼ym{ppp~˚6m:C p )///>7[7_;Sn8|.IHgPu, ~. s v?cWw<,^c<\`L^^˗/G|ǩ 6j7nC*Cq@vov{gxaÆY39Vn|KU&F(!d)Z3})j-H;K(sz A IJdL^ܿ?c#^=@V#00H$ZYTTsppF+yܯNy 0 ɔd47EGGo`֯_~`LjD\.^%%4cH<+>ؖeYT=ڵk[-[T& #xk׮-Z&K/\?Rnݺ}~b<<šFjVYfوO a7gee-rGxQQQ|}}<L^^w̙sZfΝ;]vd2vhVٳgۈO 0 hSBBkX, izcIN\.ߦP(~;vlR5kDbq#Z-4 =sCFHzyy ;vlZ~ [qqqAsŊ~;;;{團f3fNP'OnԨrX\A%m\^jY@ h #G#,X111ABp{b ԚA@Pk4/_]dk <?Jy<볐W#hV gf]:ggg͛7Ffz}k>6m:kI͛/srrGt!zI,˂~d;v+W,KMM-)...4h;˗/o=q [ɫR˿>|YNi:I74JBhoo?СC{Uڸ$)xH cYYY;m޼boo֬VGGfUO+t:4SdX-ٳgonȐ!7qƬׯOIJJ L+V,J۵k$ɞ *ۖO -תt7(ۙOTsqFUM?Q ,KS vE7 XS\poh4s*K@Z}`0R2:deee7ngggOZ #*OCӧOĻ4"X!IrM]8: Xƾq,St=}Jcsf_v 䯿Vn¥ȜSa>?r#ה6ZF2 '& $J  c22ldUi:ǞZ]7WM`PäS.Ebp.'K/VVvvv={6s2 ֣ ÂUiK,bQ˧Ȗ0gw0@@ħ̯zn`Sل^-DjXЊKWxU&]_InhM4@ƍ?/^*4G+L;~Wf-K-UuҬPkv7sLywY~m' ؟RNX?O/?1RUqIܧ^ݵc.o_.ڹ`#N͔s#QyxRL/#"eh׮|cӎ_Ş7 w :u`k+L~eim巰ҲH!MZk\{/;]"ئa/\7`pD1z4Ribu9i䴇&I~Q/jۄŧwh IV@# @̡cWkұ+Ny( ƨB>^ۙQ,x:4O<ќ1K:6Q)^G܁ `Z|`ȍ3Z4 ܳs;]ڝCzAU]<=̇aA$fxJg#1[¡ˍf"E䒔_@G+;0O'v߳iyH0 <<< 5@i4_Peqtjr+'İ`xgf̓Q3?:RNU70&QswyrɫD~?&߬51Lw,@';<@ ﶩd&ں6%_k25:u*ݱuVa \΃+ ŗԨ키Ht&:FtNY ݺ&+xvbo<9Tŧjf%Xvz?M̥Htr~{7Ull)ooo,^ .7FKE魚Hg8L)鬘, urTMHyd텈#Wt|}𻀦iESRwž"=tquhiVrXx1Lggg0 S݆ջ;iWޘǧ( ~=|cEշS3{X&Ki ZqްU]nM%mG/h)8 8 fş "HEӧ磮f3<<<:xJ}T\ަTowkt_vq^0F%^QXc3b^j0֤f-KdcO̰6 簵oGhd7 rК-4uXӭ%ŁG7 _{akɂ\?ϩQ-OD!y<(ш˗/c2dn:ݻIIIOLz ///D"B@zzz<ğ+>GI5Fݳ]vʀ-o]e-$?KycŹ-zOջ9 xsۇfKD+z׊+]i2{v&u'gՈx$0,H,:QHɰ$! EZ>$hש*B>&$ArGĤ6 + ك"88Æ CHHN<p8Z/>(J4 P;(ܺuvcOSċof/j-TEh 7 u|E[4K,I…aXdko\wϷ:og2QtcQã%]yRwX!*GbXywPWq^z3{)ϲǵL:*>}`С4h>ZgVMP駟c 6 &MBAArrrJRY,>|aaaizѣGQPPPgq1@kngb>0W" aaYC/͉o恝yV1'Xq|b1E  z%\pN {iksqH~֭Bܹs ϳЯ_'n߱,۷ݻ 5cݺuXx18fϞO>;O  -- _}/_ooo̟? .T*E}$l>} Z#4#*^zUVIEEEXp!6m1bf,̜9111H$Xjƌ77:$A޽{zAP(DpppOcK6DUR$@x<RRRpES#irq18q۷DŽ ХKZ 99u$Iڵk`Y[CNN.^X'dAT%z8bUdHMM+u]} a4P(PXXAqs"0Ʊcxa6T4Mh4"..Ӑgډa5KBeffbѢE8s z~@ x-"eY^t򕔔 ** sŭ[0|p\ݻwx?X5Shzjh{ｇ$$$ٳ`YC+B oxEFF[DFF`ĉXz5|||`( 999EbM%,yNnn.͛]o߾4vZ2Vt:C(8@IDATV?3^L&Yӱ6!ryD"sHIHIIAJJ ڵkl_c,[ㄅ:oP{UmbbbvVVVNbyno;w3fݻ_H  SSS'>|&m۶ xEa$&&V|Q0b֬Y UV /nr޽Ǎ7QQQ=KJJzWzb.//_{̙V :b&7o&z\\z'(x;iӦwnݺU:}ݻw748^޽qȑG5-rM^?,w;󿊌<<ȸo7~H5EGGoزeO^^R V?ԩSh4;vx9La:u*yVVV#0d2ڹ( @R]vkK.W_}٬/ ?fsQTTW[lT,6|!ȟ:}t̙3+W.ow(9rthtul{! ((111 'K$)Ց gQ(7ފϬ\WPPWt"h?۹sToN7U?u EQ())*,, 6mo6lIj%߶mۏ~3fv@0 AM>ʕ+^u{MMU_ޕ4MtU'I媒{[zOs̱M<!!!-<==0k4۷-^xߊmlS5j rՇI&llWL BIENDB`belenios-1.4+dfsg/src/static/placeholder.png000066400000000000000000000200251307140314400211370ustar00rootroot00000000000000PNG  IHDRZIbKGD pHYs  tIME6}IDATxwtTe?Ν>J*!EBi"8XV^dWv]\EW|-.HA: T!H$Lc` $0s8->{=*nrBP:G;6c{9d)eb$6#%:oLpv|dvIjdX>#CbI0> n|`'IɄjԁ3M1kj$L#e o?M=yVz{"p%h%vWmAfoL4ޤ^lH<ޯy{W:@$4p5oH1_PtL&C)u{Xp >svdY `Tȶ6.`lFAUmeSp .Yc$yJ X]JCxsxJzY3^,ӥ'oI/4HF-ȸ A1U|v,)ѡjށR##xgW%P:d8Z௏\'sfs J$Ѭ.H`Xݹ.bl ( |tdQDP@WMY|2Ǎ񐗗Ǵi8xЯ uĻYc0 ::EQPP@zPD"ϋ x$kȒ%gD9_Kk-D$,Gcv3أ뗓=;;rʠīϸP}}`2 z=NP‘Pd  KBEB"z=x!N$gX|a~Y DQ񐟟(8pɓ'Ļa2'Onܹlݺo zJFI4{%bcc(֙ATr9Pۭ(Bv"K$ ZPΐȋ@eT*DEEѻwo/_L:5(g,]VKXXfDrQjgƳn5i0iT*Vȥ{/'"< ݊*: n U.>ע((**p />;$O?d Eꐝͫʞ={ۆ$pj#VE6.`HR _?tڍxdYFyZ-8"bd/zK.Z+4JPAegO>lܸ1HkFx˗c00K$館ù3*VC^e\zGl!} ^֟-GI#2ڢ<^ P% BRpҤIA] [oѴiSzeIMqd\\^@%z=-o@1tP=JYfmbI0KglNZFtŠ/d>*pL:8A@ŀ-ۻwo eeekH^^u&*j1Ӈ;!5/͟(-a&B4kw$7%a2WެV+{eԨQtڵ^{׽mѢǏv >QFa6 A˶j"a.%EEk56PRIA- #&ϛ|rq˽ǃfÇں?hbbŊ~1|pF# '!"fݢ=> =fYJs[㯁s}ڷoZ,eggƌ3*;v,:uBbZa FhDNgetg}Fll,JU$E˅<#t@\^pB0ͨTZ]ncZfܸqϚ50L&$a۱<3A]mUeY,Tx̜9ïߧf Wfr{^o민3 +Nt]$޵" ȲvhѢJΝ-܂hD) +@łVR^PYaRRR͛+e'f̘ADDA]C]ǃdٲex@Կ[nDDD I_ii)?>m_~_҃w$^^/Ln>ez$I5|-TqU륰}WioAHH& Z]{픕{,t:9q͛7͟?:] gϞ%##>4oޜZ_fQVVs=$M |>dY&//5kL&/^$IDFF֙',"Bqq1cƌh4b*t\=vl6'N7Ļ7T*T* 32A`ʕ{ａDv툊rFqnOz(G槟~ ?k,4hpM*91Ɠas69O\Z%vȱp_R ШDvd[8~8ʧwzK/~kՈ蟫 'yeN٪p`]5uQ Y۳ +BBBxXn#x߁ f\@k5µj[-E[C(D"ad=ڇV Ƈ<:!4(w՛REf\^χz3\)@NGV)}1kԀ&gsX;[WK R]ʶb}@DDz".. Ǫ+wzeJFN'6^mIYyX]^dEA l^܌G.< ;Zs'Nyv'L:40M΀wS<?^0(]KkunJOxjzV07?/Wa= F^KCVQR_. ~.Z-]Z0%pTGInz!]_aiifb&2(`?vyꩧc>}I:}ryl'ܗv id/ХǩmI Z5&=ޚw|B,!?UrGLR幵 _L]_ [*11S2e+u(0M~4D#`rLIWmQux۽5:'L&cLooO ;\%7aqC5]cE0uT|IeY+ 2t_<=yn,Ԉs.+khW ]&l>R^ |{:^/++ӧ;2}t&LNj)0K||< SNu17Q% ؞$]d9IYZ㩁5DQi9֭G :}v/^Z鈎j"IΝ;R8rH;4V44jij$Ѭt|r.rN* $`#p΢_2)~9"RUOflF!V;ɡ Z)vy,o;/AR(B?+h.P6l`FڷoOII W]UgG(OoNZGѪDb ((<>|BEZ^#(M*#{oԡEDFQO9YνtUo䆟@+~!\>wɱiçsle;^m(.(}UCON>}x衇{ٸq#+WMRn$Id?NNNYYY%|>7ndРAHD޽ټy3999WM],XQ/ d>Eᐥlcs+vbgxx;K`RI4 !+`qz(qoym]փ&k\8vΈ#HII LٷoZvy'cҥ:t[r4i҄|}q1}tZlyv;*s̡^x?O$''I<|$Y~.S>'O^|z6O/)UQ1gNZW_h_<^ϡC?̙3ILLdL2:)iELΟj2 0Foox❯2e | #F^?q'NdŘf|MFMllU$ p)8{~9G}T7ԄnAj?"B^Wزe ۶mcǎ^-x=CQ w0|^x9°ax7ٳ~OǪ}87m(ٳiժGYEQ8qB $]wAwh4;ƻQՌ7ٳgtEJ"++뚨@DÆ _mZnhZ())o8^6mJqq1999={0dȐjdee]Wիjb`6뼆MEDQ$==t:tiݺ5_|_}U=ϊתbwk^[~=}%..F!\ؽ{7{o߾u8堢׻5ksa2Xp!-[$%%嚨^J,ˬ_>zAEйb%6mԿC}UVѢE ~ϟOAAA` ћٖv C=%^1at]I©SO8rHΟ/$5@jj*6mxk:_Zpjvv6ӧO7~+Hh">SΞ=[RGա~z \%KwCd.*`|ҨQ@S},c())aҤI+LcMϞ=ٶm[@ƫdTO:+/{݊m6zP]j(t:eΜ974nHl~mbaѢEϸ\F*‘#G;v,=\cY 9dKh ZAp\c.]͊:tf=z3a&NH-qX#G"IR[Qѕɓ!= j@*Çl6_,(f͚ߔ+p.=1K8T* 駟fx"!! 0zhz}x<߿ٳgWڷjժ%^8 X,lJk+HII |̞=>8pʕ4lAl|gL:͛HoUàA5jDJJJ%iWă" " f`AfIENDB`belenios-1.4+dfsg/src/static/site.css000066400000000000000000000010141307140314400176220ustar00rootroot00000000000000@import url('style.css'); @import url('superfish.css'); #page-title-home { height:223px; } ol { list-style: decimal; } ul { list-style: disc; } #wrapper { min-height: 0px; font-size: 16px; } #header { color: #ffffff; height: auto; } #main { border-radius: 0px 0px 0px 0px; padding: 10px; } #footer #bottom { line-height: 3em; } #header a { color: #ffffff; } button { cursor: pointer; } .current_step { text-align: center; font-size: 28px; padding-bottom: 28px; } belenios-1.4+dfsg/src/static/vote.html.itarget000066400000000000000000000002041307140314400214450ustar00rootroot00000000000000sjcl.js jsbn.js jsbn2.js random.js booth.js encrypting.gif reset.css styled-elements.css style.css superfish.css booth.css site.css belenios-1.4+dfsg/src/tool/000077500000000000000000000000001307140314400156365ustar00rootroot00000000000000belenios-1.4+dfsg/src/tool/belenios-tool.html000066400000000000000000000152311307140314400213010ustar00rootroot00000000000000 Belenios Tool

Belenios Tool

Unit tests

Pre-election setup

UUID:
Group parameters:

Trustee key generation

Generated key identifier

Generated secret key

Generated public key

Credential management

Generate anonymous credentials

Number of credentials to generate:

Generate credentials with identity matching

List of identities:

Generated private credentials

Generated public credentials

Fingerprints of generated public credentials

Check a credential

Credential:

Election creation

Trustee public keys:
Questions:

Output

Election management

Election parameters

Trustee public keys

Public credentials

Ballot creation

Secret credential:
Plaintext choices:

Ballots

Partial decryption

Private key:

Election result

Partial decryptions:
belenios-1.4+dfsg/src/tool/tool_cmdline.ml000066400000000000000000000430661307140314400206510ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Serializable_j open Common open Cmdliner let stream_to_list s = let res = ref [] in Stream.iter (fun x -> res := x :: !res) s; List.rev !res let lines_of_file fname = let ic = open_in fname in Stream.from (fun _ -> try Some (input_line ic) with End_of_file -> close_in ic; None ) let string_of_file f = lines_of_file f |> stream_to_list |> String.concat "\n" let load_from_file of_string filename = if Sys.file_exists filename then ( Printf.eprintf "I: loading %s...\n%!" (Filename.basename filename); Some (lines_of_file filename |> stream_to_list |> List.rev_map of_string) ) else None let ( / ) = Filename.concat let download dir url file = let url = if url.[String.length url - 1] = '/' then url else url ^ "/" in Printf.eprintf "I: downloading %s...\n%!" file; let target = dir / file in let command = Printf.sprintf "curl --silent --fail \"%s%s\" > \"%s\"" url file target in let r = Sys.command command in if r <> 0 then (Sys.remove target; false) else true let rm_rf dir = let files = Sys.readdir dir in Array.iter (fun f -> Unix.unlink (dir / f)) files; Unix.rmdir dir exception Cmdline_error of string let failcmd fmt = Printf.ksprintf (fun x -> raise (Cmdline_error x)) fmt let common_man = [ `S "MORE INFORMATION"; `P "This command is part of the Belenios command-line tool."; `P "To get more help on a specific subcommand, run:"; `P "$(b,belenios-tool) $(i,COMMAND) $(b,--help)"; `P "See $(i,http://www.belenios.org/)."; ] let get_mandatory_opt name = function | Some x -> x | None -> failcmd "%s is mandatory" name let wrap_main f = try let () = f () in `Ok () with | Cmdline_error e -> `Error (true, e) | Failure e -> `Error (false, e) | e -> `Error (false, Printexc.to_string e) module type CMDLINER_MODULE = sig val cmds : (unit Cmdliner.Term.t * Cmdliner.Term.info) list end let group_t = let doc = "Take group parameters from file $(docv)." in Arg.(value & opt (some file) None & info ["group"] ~docv:"GROUP" ~doc) let uuid_t = let doc = "UUID of the election." in Arg.(value & opt (some string) None & info ["uuid"] ~docv:"UUID" ~doc) let dir_t, optdir_t = let doc = "Use directory $(docv) for reading and writing election files." in let the_info = Arg.info ["dir"] ~docv:"DIR" ~doc in Arg.(value & opt dir Filename.current_dir_name the_info), Arg.(value & opt (some dir) None the_info) let url_t = let doc = "Download election files from $(docv)." in let the_info = Arg.info ["url"] ~docv:"URL" ~doc in Arg.(value & opt (some string) None the_info) module Tkeygen : CMDLINER_MODULE = struct open Tool_tkeygen let main group = wrap_main (fun () -> let module P = struct let group = get_mandatory_opt "--group" group |> string_of_file end in let module R = (val make (module P : PARAMS) : S) in let kp = R.trustee_keygen () in Printf.printf "I: keypair %s has been generated\n%!" kp.R.id; let pubkey = "public", kp.R.id ^ ".pubkey", 0o444, kp.R.pub in let privkey = "private", kp.R.id ^ ".privkey", 0o400, kp.R.priv in let save (kind, filename, perm, thing) = let oc = open_out_gen [Open_wronly; Open_creat] perm filename in output_string oc thing; output_char oc '\n'; close_out oc; Printf.printf "I: %s key saved to %s\n%!" kind filename; (* set permissions in the unlikely case where the file already existed *) Unix.chmod filename perm in save pubkey; save privkey ) let tkeygen_cmd = let doc = "generate a trustee key" in let man = [ `S "DESCRIPTION"; `P "This command is run by a trustee to generate a share of an election key. Such a share consists of a private key and a public key with a certificate. Generated files are stored in the current directory with a name that starts with $(i,ID), where $(i,ID) is a short fingerprint of the public key. The private key is stored in $(i,ID.privkey) and must be secured by the trustee. The public key is stored in $(i,ID.pubkey) and must be sent to the election administrator."; ] @ common_man in Term.(ret (pure main $ group_t)), Term.info "trustee-keygen" ~doc ~man let cmds = [tkeygen_cmd] end module Election : CMDLINER_MODULE = struct open Tool_election module MakeGetters (X : sig val dir : string end) = struct let get_public_keys () = load_from_file (fun x -> x) (X.dir/"public_keys.jsons") |> option_map Array.of_list let get_public_creds () = let file = "public_creds.txt" in Printf.eprintf "I: loading %s...\n%!" file; try Some (lines_of_file (X.dir / file)) with _ -> None let get_ballots () = let file = "ballots.jsons" in Printf.eprintf "I: loading %s...\n%!" file; try Some (lines_of_file (X.dir / file)) with _ -> None let get_result () = load_from_file (fun x -> x) (X.dir/"result.json") |> function | None -> None | Some [r] -> Some r | _ -> failwith "invalid result" let print_msg = prerr_endline end let main url dir action = wrap_main (fun () -> let dir, cleanup = match url, dir with | Some _, None -> let tmp = Filename.temp_file "belenios" "" in Unix.unlink tmp; Unix.mkdir tmp 0o700; tmp, true | None, None -> Filename.current_dir_name, false | _, Some d -> d, false in Printf.eprintf "I: using directory %s\n%!" dir; let () = match url with | None -> () | Some u -> if not ( download dir u "election.json" && download dir u "public_keys.jsons" && download dir u "public_creds.txt" && download dir u "ballots.jsons" && download dir u "result.json" ) then Printf.eprintf "W: some errors occurred while downloading\n%!"; in let module P : PARAMS = struct include MakeGetters (struct let dir = dir end) let election = let fname = dir/"election.json" in load_from_file (fun x -> x) fname |> function | Some [e] -> e | None -> failcmd "could not read %s" fname | _ -> Printf.ksprintf failwith "invalid election file: %s" fname end in let module X = (val make (module P : PARAMS) : S) in begin match action with | `Vote (privcred, ballot) -> let ballot = match load_from_file plaintext_of_string ballot with | Some [b] -> b | _ -> failwith "invalid plaintext ballot file" and privcred = match load_from_file (fun x -> x) privcred with | Some [cred] -> cred | _ -> failwith "invalid credential" in print_endline (X.vote (Some privcred) ballot) | `Decrypt privkey -> let privkey = match load_from_file (fun x -> x) privkey with | Some [privkey] -> privkey | _ -> failwith "invalid private key" in print_endline (X.decrypt privkey) | `Verify -> X.verify () | `Finalize -> let factors = let fname = dir/"partial_decryptions.jsons" in match load_from_file (fun x -> x) fname with | Some factors -> Array.of_list factors | None -> failwith "cannot load partial decryptions" in let oc = open_out (dir/"result.json") in output_string oc (X.finalize factors); output_char oc '\n'; close_out oc end; if cleanup then rm_rf dir ) let privcred_t = let doc = "Read private credential from file $(docv)." in let the_info = Arg.info ["privcred"] ~docv:"PRIV_CRED" ~doc in Arg.(value & opt (some file) None the_info) let privkey_t = let doc = "Read private key from file $(docv)." in let the_info = Arg.info ["privkey"] ~docv:"PRIV_KEY" ~doc in Arg.(value & opt (some file) None the_info) let ballot_t = let doc = "Read ballot choices from file $(docv)." in let the_info = Arg.info ["ballot"] ~docv:"BALLOT" ~doc in Arg.(value & opt (some file) None the_info) let vote_cmd = let doc = "create a ballot" in let man = [ `S "DESCRIPTION"; `P "This command creates a ballot and prints it on standard output."; ] @ common_man in let main = Term.pure (fun u d p b -> let p = get_mandatory_opt "--privcred" p in let b = get_mandatory_opt "--ballot" b in main u d (`Vote (p, b)) ) in Term.(ret (main $ url_t $ optdir_t $ privcred_t $ ballot_t)), Term.info "vote" ~doc ~man let verify_cmd = let doc = "verify election data" in let man = [ `S "DESCRIPTION"; `P "This command performs all possible verifications."; ] @ common_man in Term.(ret (pure main $ url_t $ optdir_t $ pure `Verify)), Term.info "verify" ~doc ~man let decrypt_cmd = let doc = "perform partial decryption" in let man = [ `S "DESCRIPTION"; `P "This command is run by each trustee to perform a partial decryption."; ] @ common_man in let main = Term.pure (fun u d p -> let p = get_mandatory_opt "--privkey" p in main u d (`Decrypt p) ) in Term.(ret (main $ url_t $ optdir_t $ privkey_t)), Term.info "decrypt" ~doc ~man let finalize_cmd = let doc = "finalizes an election" in let man = [ `S "DESCRIPTION"; `P "This command reads partial decryptions done by trustees from file $(i,partial_decryptions.jsons), checks them, combines them into the final tally and prints the result to standard output."; `P "The result structure contains partial decryptions itself, so $(i,partial_decryptions.jsons) can be discarded afterwards."; ] @ common_man in Term.(ret (pure main $ url_t $ optdir_t $ pure `Finalize)), Term.info "finalize" ~doc ~man let cmds = [vote_cmd; verify_cmd; decrypt_cmd; finalize_cmd] end module Credgen : CMDLINER_MODULE = struct open Tool_credgen let params_priv = "private credentials with ids", ".privcreds", 0o400 let params_pub = "public credentials", ".pubcreds", 0o444 let params_hash = "hashed public credentials with ids", ".hashcreds", 0o400 let save (info, ext, perm) basename things = let fname = basename ^ ext in let oc = open_out_gen [Open_wronly; Open_creat; Open_excl] perm fname in let count = ref 0 in List.iter (fun x -> incr count; output_string oc x; output_string oc "\n"; ) things; close_out oc; Printf.printf "%d %s saved to %s\n%!" !count info fname let main group dir uuid count file derive = wrap_main (fun () -> let module P = struct let group = get_mandatory_opt "--group" group |> string_of_file let uuid = get_mandatory_opt "--uuid" uuid end in let module R = (val make (module P : PARAMS) : S) in let action = match count, file, derive with | Some n, None, None -> if n < 1 then ( failcmd "the argument of --count must be a positive number" ) else `Generate (generate_ids n) | None, Some f, None -> `Generate (lines_of_file f |> stream_to_list) | None, None, Some c -> `Derive c | _, _, _ -> failcmd "--count, --file and --derive are mutually exclusive" in match action with | `Derive c -> print_endline (R.derive c) | `Generate ids -> let privs, pubs, hashs = List.fold_left (fun (privs, pubs, hashs) id -> let priv, pub, hash = R.generate () in let priv = id ^ " " ^ priv and hash = id ^ " " ^ hash in priv::privs, pub::pubs, hash::hashs ) ([], [], []) ids in let timestamp = Printf.sprintf "%.0f" (Unix.time ()) in let base = dir / timestamp in save params_priv base (List.rev privs); save params_pub base (List.sort compare pubs); save params_hash base (List.rev hashs) ) let count_t = let doc = "Generate $(docv) credentials." in let the_info = Arg.info ["count"] ~docv:"N" ~doc in Arg.(value & opt (some int) None the_info) let file_t = let doc = "Read identities from $(docv) and generate an additional $(i,T.hashcreds) with identities associated with hashed public credentials. These hashed public credentials are used by the hotline to update a public credential on the web server. One credential will be generated for each line of $(docv)." in let the_info = Arg.info ["file"] ~docv:"FILE" ~doc in Arg.(value & opt (some file) None the_info) let derive_t = let doc = "Derive the public key associated to a specific $(docv)." in let the_info = Arg.info ["derive"] ~docv:"PRIVATE_CRED" ~doc in Arg.(value & opt (some string) None the_info) let credgen_cmd = let doc = "generate credentials" in let man = [ `S "DESCRIPTION"; `P "This command is run by a credential authority to generate credentials for a specific election. The generated private credentials are stored in $(i,T.privcreds), where $(i,T) is a timestamp. $(i,T.privcreds) contains one credential per line. Each voter must be sent a credential, and $(i,T.privcreds) must be destroyed after dispatching is done. The associated public keys are stored in $(i,T.pubcreds) and must be sent to the election administrator."; ] @ common_man in Term.(ret (pure main $ group_t $ dir_t $ uuid_t $ count_t $ file_t $ derive_t)), Term.info "credgen" ~doc ~man let cmds = [credgen_cmd] end module Mkelection : CMDLINER_MODULE = struct open Tool_mkelection let main dir group uuid template = wrap_main (fun () -> let module P = struct let group = get_mandatory_opt "--group" group |> string_of_file let uuid = get_mandatory_opt "--uuid" uuid let template = get_mandatory_opt "--template" template |> string_of_file let get_public_keys () = Some (lines_of_file (dir / "public_keys.jsons") |> stream_to_list |> Array.of_list) end in let module R = (val make (module P : PARAMS) : S) in let params = R.mkelection () in let oc = open_out (dir / "election.json") in output_string oc params; output_char oc '\n'; close_out oc ) let template_t = let doc = "Read election template from file $(docv)." in Arg.(value & opt (some file) None & info ["template"] ~docv:"TEMPLATE" ~doc) let mkelection_cmd = let doc = "create an election public parameter file" in let man = [ `S "DESCRIPTION"; `P "This command reads and checks $(i,public_keys.jsons). It then computes the global election public key and generates an $(i,election.json) file."; ] @ common_man in Term.(ret (pure main $ dir_t $ group_t $ uuid_t $ template_t)), Term.info "mkelection" ~doc ~man let cmds = [mkelection_cmd] end module Verifydiff : CMDLINER_MODULE = struct open Tool_verifydiff let main dir1 dir2 = wrap_main (fun () -> match dir1, dir2 with | Some dir1, Some dir2 -> verifydiff dir1 dir2 | _, _ -> failcmd "--dir1 or --dir2 is missing" ) let dir1_t = let doc = "First directory to compare." in Arg.(value & opt (some dir) None & info ["dir1"] ~docv:"DIR1" ~doc) let dir2_t = let doc = "Second directory to compare." in Arg.(value & opt (some dir) None & info ["dir2"] ~docv:"DIR2" ~doc) let verifydiff_cmd = let doc = "verify an election directory update" in let man = [ `S "DESCRIPTION"; `P "This command is run by an auditor on two directories $(i,DIR1) and $(i,DIR2). It checks that $(i,DIR2) is a valid update of $(i,DIR1)."; ] @ common_man in Term.(ret (pure main $ dir1_t $ dir2_t)), Term.info "verify-diff" ~doc ~man let cmds = [verifydiff_cmd] end let cmds = Tkeygen.cmds @ Election.cmds @ Credgen.cmds @ Mkelection.cmds @ Verifydiff.cmds let default_cmd = let open Belenios_version in let version = Printf.sprintf "%s (%s)" version build in let version = if debug then version ^ " [debug]" else version in let doc = "election management tool" in let man = common_man in Term.(ret (pure (`Help (`Pager, None)))), Term.info "belenios-tool" ~version ~doc ~man let () = match Term.eval_choice default_cmd cmds with | `Error _ -> exit 1 | _ -> exit 0 belenios-1.4+dfsg/src/tool/tool_cmdline.mli000066400000000000000000000000261307140314400210070ustar00rootroot00000000000000(* empty interface *) belenios-1.4+dfsg/src/tool/tool_credgen.ml000066400000000000000000000061721307140314400206420ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Signatures open Common module type PARAMS = sig val uuid : string val group : string end module type S = sig val derive : string -> string val generate : unit -> string * string * string end module type PARSED_PARAMS = sig val uuid : Uuidm.t module G : GROUP end let parse_params p = let module P = (val p : PARAMS) in let module R = struct let uuid = match Uuidm.of_string P.uuid with | Some u -> u | None -> Printf.ksprintf failwith "%s is not a valid UUID" P.uuid module G = (val Group.of_string P.group : GROUP) end in (module R : PARSED_PARAMS) module Make (P : PARSED_PARAMS) : S = struct open P module CG = Credential.MakeGenerate (Election.MakeSimpleMonad (G)) module CD = Credential.MakeDerive (G) let derive x = let x = CD.derive uuid x in let y = G.(g **~ x) in G.to_string y let compute_pub_and_hash priv = let pub = derive priv in let hashed = sha256_hex pub in priv, pub, hashed let generate () = CG.generate () () |> compute_pub_and_hash end let make params = let module P = (val parse_params params : PARSED_PARAMS) in let module R = Make (P) in (module R : S) let int_length n = string_of_int n |> String.length let rec find_first n first = if int_length first = int_length (first + n) then first else find_first n (10 * first) let generate_ids n = (* choose the first id so that they all have the same length *) let first = find_first n 1 in let last = first + n - 1 in let rec loop last accu = if last < first then accu else loop (last-1) (string_of_int last :: accu) in loop last [] belenios-1.4+dfsg/src/tool/tool_credgen.mli000066400000000000000000000004021307140314400210010ustar00rootroot00000000000000module type PARAMS = sig val uuid : string val group : string end module type S = sig val derive : string -> string val generate : unit -> string * string * string end val make : (module PARAMS) -> (module S) val generate_ids : int -> string list belenios-1.4+dfsg/src/tool/tool_election.ml000066400000000000000000000143761307140314400210420ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_j open Signatures open Common module type PARAMS = sig val election : string val get_public_keys : unit -> string array option val get_public_creds : unit -> string Stream.t option val get_ballots : unit -> string Stream.t option val get_result : unit -> string option val print_msg : string -> unit end module type S = sig val vote : string option -> int array array -> string val decrypt : string -> string val finalize : string array -> string val verify : unit -> unit end module type PARSED_PARAMS = sig include PARAMS include ELECTION_DATA end let parse_params p = let module P = (val p : PARAMS) in let params = Group.election_params_of_string P.election in let module R = struct include P include (val params : ELECTION_DATA) end in (module R : PARSED_PARAMS) module Make (P : PARSED_PARAMS) : S = struct open P module M = Election.MakeSimpleMonad(G) module E = Election.MakeElection(G)(M);; (* Load and check trustee keys, if present *) module KG = Election.MakeSimpleDistKeyGen(G)(M);; let public_keys_with_pok = get_public_keys () |> option_map @@ Array.map (trustee_public_key_of_string G.read) let () = match public_keys_with_pok with | Some pks -> assert (Array.forall KG.check pks); let y' = KG.combine pks in assert G.(election.e_params.e_public_key =~ y') | None -> () let public_keys = option_map ( Array.map (fun pk -> pk.trustee_public_key) ) public_keys_with_pok (* Finish setting up the election *) let pks = match public_keys with | Some pks -> pks | None -> failwith "missing public keys" (* Load ballots, if present *) module GSet = Map.Make (G) let public_creds = lazy ( get_public_creds () |> option_map (fun creds -> let res = ref GSet.empty in Stream.iter (fun x -> res := GSet.add (G.of_string x) false !res) creds; res ) ) let ballots = lazy ( get_ballots () |> option_map (fun ballots -> let res = ref [] in Stream.iter (fun x -> res := (ballot_of_string G.read x, sha256_b64 x) :: !res ) ballots; List.rev !res ) ) let check_signature_present = lazy ( match Lazy.force public_creds with | Some creds -> (fun b -> match b.signature with | Some s -> (try if GSet.find s.s_public_key !creds then false else (creds := GSet.add s.s_public_key true !creds; true) with Not_found -> false) | None -> false ) | None -> (fun _ -> true) ) let cast (b, hash) = if Lazy.force check_signature_present b && E.check_ballot election b then M.cast b () else Printf.ksprintf failwith "ballot %s failed tests" hash let ballots_check = lazy ( Lazy.force ballots |> option_map (List.iter cast) ) let encrypted_tally = lazy ( match Lazy.force ballots_check with | None -> failwith "ballots.jsons is missing" | Some () -> M.fold (fun () b t -> M.return (E.combine_ciphertexts (E.extract_ciphertext b) t) ) (E.neutral_ciphertext election) () ) let vote privcred ballot = let sk = privcred |> option_map (fun cred -> let module CD = Credential.MakeDerive (G) in CD.derive election.e_params.e_uuid cred ) in let b = E.create_ballot election ?sk (E.make_randomness election ()) ballot () in assert (E.check_ballot election b); string_of_ballot G.write b let decrypt privkey = let sk = number_of_string privkey in let pk = G.(g **~ sk) in if Array.forall (fun x -> not G.(x =~ pk)) pks then ( print_msg "W: your key is not present in public_keys.jsons"; ); let tally = Lazy.force encrypted_tally in let factor = E.compute_factor tally sk () in assert (E.check_factor tally pk factor); string_of_partial_decryption G.write factor let finalize factors = let factors = Array.map (partial_decryption_of_string G.read) factors in let tally = Lazy.force encrypted_tally in assert (Array.forall2 (E.check_factor tally) pks factors); let result = E.combine_factors (M.cardinal ()) tally factors in assert (E.check_result pks result); string_of_result G.write result let verify () = (match Lazy.force ballots_check with | Some () -> () | None -> print_msg "W: no ballots to check" ); (match get_result () with | Some result -> let result = result_of_string G.read result in assert (Lazy.force encrypted_tally = result.encrypted_tally); assert (E.check_result pks result) | None -> print_msg "W: no result to check" ); print_msg "I: all checks passed" end let make params = let module P = (val parse_params params : PARSED_PARAMS) in let module R = Make (P) in (module R : S) belenios-1.4+dfsg/src/tool/tool_election.mli000066400000000000000000000007761307140314400212120ustar00rootroot00000000000000module type PARAMS = sig val election : string val get_public_keys : unit -> string array option val get_public_creds : unit -> string Stream.t option val get_ballots : unit -> string Stream.t option val get_result : unit -> string option val print_msg : string -> unit end module type S = sig val vote : string option -> int array array -> string val decrypt : string -> string val finalize : string array -> string val verify : unit -> unit end val make : (module PARAMS) -> (module S) belenios-1.4+dfsg/src/tool/tool_js.ml000066400000000000000000000227371307140314400176540ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_j open Tool_js_common let install_handler (id, handler) = let f _ = begin try handler () with e -> let msg = "Unexpected error: " ^ Printexc.to_string e in alert msg end; Js._false in Js.Opt.iter (document##getElementById (Js.string id)) (fun e -> e##onclick <- Dom_html.handler f) module Tests = struct let unit_tests () = let a = "13133254971699857128" and b = "31748915560162976106" in let c = Z.of_string a and d = Z.of_string b in let ntests = ref 0 in let check name f = if not (f ()) then Printf.ksprintf failwith "test %s failed" name; incr ntests in check "ZERO" (fun () -> Z.to_string Z.zero = "0"); check "ONE" (fun () -> Z.to_string Z.one = "1"); let string_roundtrip a c () = a = Z.to_string c in check "string_roundtrip_a" (string_roundtrip a c); check "string_roundtrip_b" (string_roundtrip b d); let operator op expected () = expected = Z.to_string (op c d) in check "add" (operator Z.( + ) "44882170531862833234"); check "mul" (operator Z.( * ) "416966603126589360375328894595477783568"); check "sub" (operator Z.( - ) "-18615660588463118978"); let a = 132180439 and b = 41907500 in let c = Z.of_int a and d = Z.of_int b in let int_roundtrip a c () = a = Z.to_int c in check "int_roundtrip_a" (int_roundtrip a c); check "int_roundtrip_b" (int_roundtrip b d); let m = Z.of_int 181944121 in check "mod" (fun () -> Z.to_int Z.((c * d) mod m) = 30881634); check "erem" (fun () -> Z.to_int Z.((zero - c * d) mod m) = 151062487); check "powm" (fun () -> Z.to_int (Z.powm c d m) = 81171525); check "invert" (fun () -> Z.to_int (Z.invert c m) = 54455411); check "prime" (fun () -> Z.probab_prime m 5 > 0); check "eq" (fun () -> Z.(c =% c)); check "neq" (fun () -> Z.(not (c =% d))); check "geq" (fun () -> Z.geq c d); check "lt" (fun () -> Z.lt d c); let i = Z.of_string "272660753928370030481696309961224617984" in check "bit_length" (fun () -> Z.bit_length i = 128); let j = Z.of_bits "\x81\xab\xd3\xed\x0b\x19\x2e\x40\x7a\xca" in let k = Z.of_string "956173156978067279948673" in check "of_bits" (fun () -> Z.(j =% k)); Printf.ksprintf alert "%d tests were successful!" !ntests let cmds = ["do_unit_tests", unit_tests] end module Tkeygen = struct open Tool_tkeygen let tkeygen () = let module P : PARAMS = struct let group = get_textarea "election_group" end in let module X = (val make (module P : PARAMS) : S) in let open X in let {id; priv; pub} = trustee_keygen () in set_textarea "tkeygen_id" id; set_textarea "tkeygen_secret" priv; set_textarea "tkeygen_public" pub let cmds = ["do_tkeygen", tkeygen] end let split_lines str = let str = str ^ "\n" in let n = String.length str in let rec loop accu i = if i < n then ( let j = String.index_from str i '\n' in let line = String.sub str i (j-i) in let accu = if line = "" then accu else line :: accu in loop accu (j+1) ) else List.rev accu in loop [] 0 module Credgen = struct open Tool_credgen let derive () = let module P : PARAMS = struct let uuid = get_textarea "election_uuid" let group = get_textarea "election_group" end in let module X = (val make (module P : PARAMS) : S) in let cred = get_textarea "credgen_derive_input" in set_textarea "credgen_derive_output" (X.derive cred) let generate ids = let module P : PARAMS = struct let uuid = get_textarea "election_uuid" let group = get_textarea "election_group" end in let module X = (val make (module P : PARAMS) : S) in let privs, pubs, hashs = List.fold_left (fun (privs, pubs, hashs) id -> let priv, pub, hash = X.generate () in let priv = id ^ " " ^ priv and hash = id ^ " " ^ hash in priv::privs, pub::pubs, hash::hashs ) ([], [], []) ids in set_textarea "credgen_generated_creds" (privs |> List.rev |> String.concat "\n"); set_textarea "credgen_generated_pks" (pubs |> List.sort compare |> String.concat "\n"); set_textarea "credgen_generated_hashed" (hashs |> List.rev |> String.concat "\n") let generate_n () = get_textarea "credgen_number" |> int_of_string |> generate_ids |> generate let generate_ids () = get_textarea "credgen_ids" ^ "\n" |> split_lines |> generate let cmds = [ "do_credgen_derive", derive; "do_credgen_generate", generate_n; "do_credgen_ids", generate_ids; ] end module Mkelection = struct open Tool_mkelection let mkelection () = let module P : PARAMS = struct let uuid = get_textarea "election_uuid" let group = get_textarea "election_group" let template = get_textarea "mkelection_template" let get_public_keys () = Some (get_textarea "mkelection_pks" |> split_lines |> Array.of_list) end in let module X = (val make (module P : PARAMS) : S) in set_textarea "mkelection_output" (X.mkelection ()) let cmds = [ "do_mkelection", mkelection; ] end module ToolElection = struct open Tool_election module Getters = struct let get_public_keys () = let raw = get_textarea "election_pks" |> split_lines in let pks = Array.of_list raw in if Array.length pks = 0 then None else Some pks let get_public_creds () = let raw = get_textarea "election_pubcreds" |> split_lines in match raw with | [] -> None | _ -> Some (Stream.of_list raw) let get_ballots () = let raw = get_textarea "election_ballots" |> split_lines in match raw with | [] -> None | _ -> Some (Stream.of_list raw) let get_result () = let raw = get_textarea "election_result" |> split_lines in match raw with | [] -> None | [r] -> Some r | _ -> invalid_arg "invalid result" let print_msg x = alert x end let get_election () = let raw = get_textarea "election_params" in match split_lines raw with | [e] -> e | _ -> invalid_arg "invalid election parameters" let create_ballot () = let module P : PARAMS = struct let election = get_election () include Getters end in let choices = get_textarea "election_choices" |> plaintext_of_string in let privcred = get_textarea "election_privcred" in let module X = (val make (module P : PARAMS) : S) in set_textarea "election_ballot" (X.vote (Some privcred) choices) let verify () = let module P : PARAMS = struct let election = get_election () include Getters end in let module X = (val make (module P : PARAMS) : S) in X.verify () let decrypt () = let module P : PARAMS = struct let election = get_election () include Getters end in let module X = (val make (module P : PARAMS) : S) in let privkey = get_textarea "election_privkey" in set_textarea "election_pd" (X.decrypt privkey) let finalize () = let module P : PARAMS = struct let election = get_election () include Getters end in let module X = (val make (module P : PARAMS) : S) in let factors = get_textarea "election_factors" |> split_lines in set_textarea "election_result" (X.finalize (Array.of_list factors)) let cmds = [ "do_encrypt", create_ballot; "do_verify", verify; "do_decrypt", decrypt; "do_finalize", finalize; ] end let int_of_quad str = let ( ! ) x = int_of_char str.[x] in (((((!0 lsl 8) lor !1) lsl 8) lor !2) lsl 8) lor !3 let new_uuid () = let seed = Array.init 16 (fun _ -> random_string secure_rng 4 |> int_of_quad ) in let s = Random.State.make seed in let uuid = Uuidm.v4_gen s () in set_textarea "election_uuid" (Uuidm.to_string uuid) let cmds = ["new_uuid", new_uuid] @ Tests.cmds @ Tkeygen.cmds @ Credgen.cmds @ Mkelection.cmds @ ToolElection.cmds let install_handlers () = List.iter install_handler cmds let () = Dom_html.window##onload <- Dom_html.handler (fun _ -> install_handlers (); Js._false ) belenios-1.4+dfsg/src/tool/tool_js.mli000066400000000000000000000000261307140314400200100ustar00rootroot00000000000000(* empty interface *) belenios-1.4+dfsg/src/tool/tool_js_common.ml000066400000000000000000000047011307140314400212130ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let document = Dom_html.window##document let alert s : unit = let open Js.Unsafe in fun_call (variable "alert") [| s |> Js.string |> inject |] let get_textarea id = let res = ref None in Js.Opt.iter (document##getElementById (Js.string id)) (fun e -> Js.Opt.iter (Dom_html.CoerceTo.textarea e) (fun x -> res := Some (Js.to_string (x##value))) ); match !res with | None -> raise Not_found | Some x -> x let set_textarea id z = Js.Opt.iter (document##getElementById (Js.string id)) (fun e -> Js.Opt.iter (Dom_html.CoerceTo.textarea e) (fun x -> x##value <- Js.string z) ) let get_input id = let res = ref None in Js.Opt.iter (document##getElementById (Js.string id)) (fun e -> Js.Opt.iter (Dom_html.CoerceTo.input e) (fun x -> res := Some (Js.to_string (x##value))) ); match !res with | None -> raise Not_found | Some x -> x belenios-1.4+dfsg/src/tool/tool_js_credgen.ml000066400000000000000000000070211307140314400213300ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Tool_js_common open Tool_credgen let generate _ = let ids = let raw = get_textarea "voters" in let rec loop i accu = if i >= 0 then let j = try String.rindex_from raw i '\n' with Not_found -> -1 in loop (j-1) (String.sub raw (j+1) (i-j) :: accu) else accu in loop (String.length raw - 1) [] in let module P : PARAMS = struct let uuid = get_textarea "uuid" let group = get_textarea "group" end in let module X = (val make (module P : PARAMS) : S) in let privs, pubs, hashs = List.fold_left (fun (privs, pubs, hashs) id -> let priv, pub, hash = X.generate () in let priv = id ^ " " ^ priv and hash = id ^ " " ^ hash in priv::privs, pub::pubs, hash::hashs ) ([], [], []) ids in let text_pks = pubs |> List.sort compare |> String.concat "\n" in set_textarea "pks" text_pks; let text_creds = (privs |> List.rev |> String.concat "\n") ^ "\n" in let data_creds = (Js.string "data:text/plain,")##concat (Js.encodeURI (Js.string text_creds)) in ignore (Dom_html.window##open_ (data_creds, Js.string "creds", Js.null)); let text_hashed = (hashs |> List.rev |> String.concat "\n") ^ "\n" in let data_hashed = (Js.string "data:text/plain,")##concat (Js.encodeURI (Js.string text_hashed)) in ignore (Dom_html.window##open_ (data_hashed, Js.string "hashed", Js.null)); alert "New windows (or tabs) were open with private credentials and credential hashes. Please save them before submitting public credentials!"; Js._false let fill_interactivity _ = Js.Opt.iter (document##getElementById (Js.string "interactivity")) (fun e -> let x = document##createElement (Js.string "div") in Dom.appendChild e x; let b = document##createElement (Js.string "button") in let t = document##createTextNode (Js.string "Generate") in b##onclick <- Dom_html.handler generate; Dom.appendChild b t; Dom.appendChild x b; ); Js._false let () = Dom_html.window##onload <- Dom_html.handler fill_interactivity; belenios-1.4+dfsg/src/tool/tool_js_pd.ml000066400000000000000000000104101307140314400203200ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_j open Tool_js_common let election = ref None let encrypted_tally = ref None let ( >>= ) = Js.Opt.bind let wrap f x = (try Js.Opt.case (f x) (fun () -> failwith "Unexpected error") (fun () -> ()) with | Failure s -> alert s | e -> Printf.ksprintf alert "Unexpected error: %s" (Printexc.to_string e) ); Js._false let basic_check_private_key s = let n = String.length s in let rec leading i = if i < n then match s.[i] with | '"' -> middle (i+1) | _ -> failwith "Must start with a double quote" else failwith "Too short" and middle i = if i < n then match s.[i] with | '0'..'9' -> ending (i+1) | _ -> failwith "Must have at least one digit" else failwith "Too short" and ending i = if i < n then match s.[i] with | '0'..'9' -> ending (i+1) | '"' -> (if i+1 < n then failwith "Must end with a double quote") | c -> Printf.ksprintf failwith "Illegal character: %c" c else failwith "Must end with a double quote" in leading 0 let compute_partial_decryption _ = Js.Opt.option !election >>= fun e -> let election = Group.election_params_of_string e in let module P = (val election) in let module M = Election.MakeSimpleMonad (P.G) in let module E = Election.MakeElection (P.G) (M) in Js.Opt.option !encrypted_tally >>= fun e -> let encrypted_tally = encrypted_tally_of_string P.G.read e in document##getElementById (Js.string "private_key") >>= fun e -> Dom_html.CoerceTo.input e >>= fun e -> let pk_str = Js.to_string e##value in basic_check_private_key pk_str; let private_key = try number_of_string pk_str with e -> Printf.ksprintf failwith "Error in format of private key: %s" (Printexc.to_string e) in let factor = E.compute_factor encrypted_tally private_key () in set_textarea "pd" (string_of_partial_decryption P.G.write factor); Js.some () let compute_hash () = let _ = Js.Opt.option !encrypted_tally >>= fun e -> let hash = sha256_b64 e in document##getElementById (Js.string "hash") >>= fun e -> let t = document##createTextNode (Js.string hash) in Dom.appendChild e t; Js.null in Js._false let main _ = let _ = document##getElementById (Js.string "compute") >>= fun e -> Dom_html.CoerceTo.button e >>= fun e -> e##onclick <- Dom_html.handler (wrap compute_partial_decryption); Js.null in let _ = Lwt.async (fun () -> let open XmlHttpRequest in lwt e = get "../encrypted_tally.json" in encrypted_tally := Some e.content; lwt e = get "../election.json" in election := Some e.content; Lwt.return (compute_hash ())) in Js._false let () = Dom_html.window##onload <- Dom_html.handler main belenios-1.4+dfsg/src/tool/tool_js_questions.ml000066400000000000000000000252341307140314400217610ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Serializable_j open Tool_js_common let (>>=) = Js.Opt.bind let return = Js.Opt.return let handler f = Dom_html.handler (fun e -> ignore (f e); Js._false) (* Getting the OCaml structure out of the DOM *) let extractAnswer a = Dom_html.CoerceTo.input a >>= fun x -> return (Js.to_string (x##value)) let extractQuestion q = Dom_html.CoerceTo.input q >>= fun x -> let q_question = Js.to_string (x##value) in q##parentNode >>= fun p1 -> p1##parentNode >>= fun p2 -> Dom.CoerceTo.element p2 >>= fun p2 -> let p2 = Dom_html.element p2 in let numeric selector error_msg = p2##querySelector (Js.string selector) >>= fun x -> Dom_html.CoerceTo.input x >>= fun x -> let x = Js.to_string x##value in try return (int_of_string x) with _ -> failwith (error_msg ^ ": " ^ x ^ ".") in p2##querySelector (Js.string ".question_blank") >>= fun q_blank -> Dom_html.CoerceTo.input q_blank >>= fun q_blank -> let q_blank = if Js.to_bool q_blank##checked then Some true else None in numeric ".question_min" "Invalid minimum number of choices" >>= fun q_min -> numeric ".question_max" "Invalid maximum number of choices" >>= fun q_max -> if not (q_min <= q_max) then failwith "Minimum number of choices must be less than or equal to maximum number of choices!"; let answers = p2##querySelectorAll (Js.string ".question_answer") in let q_answers = Array.init (answers##length) (fun i -> let a = answers##item (i) >>= extractAnswer in Js.Opt.get a (fun () -> failwith "extractQuestion")) in return {q_question; q_blank; q_min; q_max; q_answers} let extractTemplate () = let t_name = get_input "election_name" in let t_description = get_textarea "election_description" in let questions = document##querySelectorAll (Js.string ".question_question") in let t_questions = Array.init (questions##length) (fun i -> let q = questions##item (i) >>= extractQuestion in Js.Opt.get q (fun () -> failwith "extractTemplate")) in {t_name; t_description; t_questions} (* Injecting the OCaml structure into the DOM *) let rec createAnswer a = let container = Dom_html.createDiv document in let t = document##createTextNode (Js.string "Answer: ") in let u = Dom_html.createInput document in u##className <- Js.string "question_answer"; u##value <- Js.string a; u##size <- 60; Dom.appendChild container t; Dom.appendChild container u; let btn_text = document##createTextNode (Js.string "Remove") in let btn = Dom_html.createButton document in let f _ = container##parentNode >>= fun x -> Dom.removeChild x container; return () in btn##onclick <- handler f; Dom.appendChild btn btn_text; Dom.appendChild container btn; let insert_text = document##createTextNode (Js.string "Insert") in let insert_btn = Dom_html.createButton document in let f _ = let x = createAnswer "" in container##parentNode >>= fun p -> Dom.insertBefore p x (Js.some container); return () in insert_btn##onclick <- handler f; Dom.appendChild insert_btn insert_text; Dom.appendChild container insert_btn; container let rec createQuestion q = let container = Dom_html.createDiv document in (* question text and remove/insert buttons *) let x = Dom_html.createDiv document in let t = document##createTextNode (Js.string "Question: ") in Dom.appendChild x t; let h_question = Dom_html.createInput document in Dom.appendChild x h_question; h_question##className <- Js.string "question_question"; h_question##size <- 60; h_question##value <- Js.string q.q_question; let remove_text = document##createTextNode (Js.string "Remove") in let remove_btn = Dom_html.createButton document in let f _ = container##parentNode >>= fun x -> Dom.removeChild x container; return () in remove_btn##onclick <- handler f; Dom.appendChild remove_btn remove_text; Dom.appendChild x remove_btn; let insert_text = document##createTextNode (Js.string "Insert") in let insert_btn = Dom_html.createButton document in let f _ = let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in container##parentNode >>= fun p -> Dom.insertBefore p x (Js.some container); return () in insert_btn##onclick <- handler f; Dom.appendChild insert_btn insert_text; Dom.appendChild x insert_btn; Dom.appendChild container x; (* properties *) let x = Dom_html.createDiv document in let t = document##createTextNode (Js.string "The voter has to choose between ") in Dom.appendChild x t; let h_min = Dom_html.createInput document in Dom.appendChild x h_min; h_min##className <- Js.string "question_min"; h_min##size <- 5; h_min##value <- Js.string (string_of_int q.q_min); let t = document##createTextNode (Js.string " and ") in Dom.appendChild x t; let h_max = Dom_html.createInput document in Dom.appendChild x h_max; h_max##className <- Js.string "question_max"; h_max##size <- 5; h_max##value <- Js.string (string_of_int q.q_max); let t = document##createTextNode (Js.string " answers.") in Dom.appendChild x t; Dom.appendChild container x; (* is blank allowed? *) let x = Dom_html.createDiv document in let h_blank = Dom_html.createInput ~_type:(Js.string "checkbox") document in h_blank##className <- Js.string "question_blank"; h_blank##checked <- Js.(match q.q_blank with Some true -> _true | _ -> _false); Dom.appendChild x h_blank; let t = document##createTextNode (Js.string "Blank vote is allowed") in Dom.appendChild x t; Dom.appendChild container x; (* answers *) let h_answers = Dom_html.createDiv document in h_answers##className <- Js.string "question_answers"; Dom.appendChild container h_answers; Array.iter (fun a -> let x = createAnswer a in Dom.appendChild h_answers x) q.q_answers; (* button for adding answer *) let x = Dom_html.createDiv document in let b = Dom_html.createButton document in let t = document##createTextNode (Js.string "Add an answer") in let f _ = let x = createAnswer "" in Dom.appendChild h_answers x in b##onclick <- handler f; Dom.appendChild b t; Dom.appendChild x b; Dom.appendChild container x; (* horizontal rule *) let x = Dom_html.createHr document in Dom.appendChild container x; (* return *) container let createTemplate template = let container = Dom_html.createDiv document in (* name *) let x = Dom_html.createDiv document in x##style##display <- Js.string "none"; let t = document##createTextNode (Js.string "Name of the election: ") in Dom.appendChild x t; let h_name = Dom_html.createInput document in h_name##id <- Js.string "election_name"; h_name##value <- Js.string template.t_name; Dom.appendChild x h_name; Dom.appendChild container x; (* description *) let x = Dom_html.createDiv document in x##style##display <- Js.string "none"; let y = Dom_html.createDiv document in let t = document##createTextNode (Js.string "Description:") in Dom.appendChild y t; Dom.appendChild x y; let y = Dom_html.createDiv document in let h_description = Dom_html.createTextarea document in h_description##id <- Js.string "election_description"; h_description##value <- Js.string template.t_description; h_description##cols <- 80; Dom.appendChild y h_description; Dom.appendChild x y; Dom.appendChild container x; (* questions *) let x = Dom_html.createDiv document in let h_questions_div = Dom_html.createDiv document in h_questions_div##id <- Js.string "election_questions"; Dom.appendChild x h_questions_div; Dom.appendChild container x; Array.iter (fun q -> let x = createQuestion q in Dom.appendChild h_questions_div x) template.t_questions; (* button for adding question *) let x = Dom_html.createDiv document in let b = Dom_html.createButton document in let t = document##createTextNode (Js.string "Add a question") in let f _ = let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in Dom.appendChild h_questions_div x in b##onclick <- handler f; Dom.appendChild b t; Dom.appendChild x b; Dom.appendChild container x; (* button for submitting *) let x = Dom_html.createHr document in Dom.appendChild container x; let x = Dom_html.createDiv document in let b = Dom_html.createButton document in let t = document##createTextNode (Js.string "Save changes") in let f _ = try let template = extractTemplate () in set_textarea "questions" (string_of_template template); document##querySelector (Js.string "form") >>= fun x -> Dom_html.CoerceTo.form x >>= fun x -> x##submit (); return () with Failure e -> alert e; return () in b##onclick <- handler f; Dom.appendChild b t; Dom.appendChild x b; Dom.appendChild container x; (* return *) container (* Entry point *) let fill_interactivity _ = document##getElementById (Js.string "interactivity") >>= fun e -> let t = template_of_string (get_textarea "questions") in let div = createTemplate t in Dom.appendChild e div; document##querySelector (Js.string "form") >>= fun x -> x##style##display <- Js.string "none"; return () let () = Dom_html.window##onload <- handler fill_interactivity; belenios-1.4+dfsg/src/tool/tool_js_tkeygen.ml000066400000000000000000000047751307140314400214040ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Tool_js_common open Tool_tkeygen let tkeygen _ = let module P : PARAMS = struct let group = get_textarea "group" end in let module X = (val make (module P : PARAMS) : S) in let open X in let {id; priv; pub} = trustee_keygen () in let data_uri = (Js.string "data:application/json,")##concat (Js.encodeURI (Js.string priv)) in ignore (Dom_html.window##open_ (data_uri, Js.string id, Js.null)); set_textarea "pk" pub; alert "The private key has been open in a new window (or tab). Please save it before submitting the public key!"; Js._false let fill_interactivity _ = Js.Opt.iter (document##getElementById (Js.string "interactivity")) (fun e -> let b = document##createElement (Js.string "button") in let t = document##createTextNode (Js.string "Generate a new keypair") in b##onclick <- Dom_html.handler tkeygen; Dom.appendChild b t; Dom.appendChild e b; ); Js._false let () = Dom_html.window##onload <- Dom_html.handler fill_interactivity; belenios-1.4+dfsg/src/tool/tool_mkelection.ml000066400000000000000000000064511307140314400213650ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Serializable_j open Signatures open Common module type PARAMS = sig val uuid : string val group : string val template : string val get_public_keys : unit -> string array option end module type S = sig val mkelection : unit -> string end module type PARSED_PARAMS = sig val uuid : Uuidm.t val template : template module G : GROUP val get_public_keys : unit -> G.t trustee_public_key array option end let parse_params p = let module P = (val p : PARAMS) in let module R = struct let uuid = match Uuidm.of_string P.uuid with | Some u -> u | None -> Printf.ksprintf failwith "%s is not a valid UUID" P.uuid let template = template_of_string P.template module G = (val Group.of_string P.group : GROUP) let get_public_keys () = match P.get_public_keys () with | None -> None | Some xs -> Some (Array.map (trustee_public_key_of_string G.read) xs) end in (module R : PARSED_PARAMS) module Make (P : PARSED_PARAMS) : S = struct open P (* Setup group *) module M = Election.MakeSimpleMonad(G);; (* Setup trustees *) module KG = Election.MakeSimpleDistKeyGen(G)(M);; let public_keys = match get_public_keys () with | Some keys -> keys | None -> failwith "trustee keys are missing" let y = KG.combine public_keys (* Setup election *) let params = { e_description = template.t_description; e_name = template.t_name; e_public_key = {wpk_group = G.group; wpk_y = y}; e_questions = template.t_questions; e_uuid = uuid; } (* Generate and serialize election.json *) let mkelection () = string_of_params (write_wrapped_pubkey G.write_group G.write) params end let make params = let module P = (val parse_params params : PARSED_PARAMS) in let module R = Make (P) in (module R : S) belenios-1.4+dfsg/src/tool/tool_mkelection.mli000066400000000000000000000003671307140314400215360ustar00rootroot00000000000000module type PARAMS = sig val uuid : string val group : string val template : string val get_public_keys : unit -> string array option end module type S = sig val mkelection : unit -> string end val make : (module PARAMS) -> (module S) belenios-1.4+dfsg/src/tool/tool_tkeygen.ml000066400000000000000000000053371307140314400207030ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Platform open Serializable_j open Signatures open Common module type PARAMS = sig val group : string end module type S = sig type keypair = { id : string; priv : string; pub : string } val trustee_keygen : unit -> keypair end module type PARSED_PARAMS = sig module G : GROUP end let parse_params p = let module P = (val p : PARAMS) in let module R = struct module G = (val Group.of_string P.group : GROUP) end in (module R : PARSED_PARAMS) module Make (P : PARSED_PARAMS) : S = struct open P (* Setup group *) module M = Election.MakeSimpleMonad(G);; (* Generate key *) module KG = Election.MakeSimpleDistKeyGen(G)(M);; type keypair = { id : string; priv : string; pub : string } let trustee_keygen () = let private_key, public_key = KG.generate_and_prove () () in assert (KG.check public_key); let id = String.sub (sha256_hex (G.to_string public_key.trustee_public_key)) 0 8 |> String.uppercase in let priv = string_of_number private_key in let pub = string_of_trustee_public_key G.write public_key in {id; priv; pub} end let make params = let module P = (val parse_params params : PARSED_PARAMS) in let module R = Make (P) in (module R : S) belenios-1.4+dfsg/src/tool/tool_tkeygen.mli000066400000000000000000000003321307140314400210420ustar00rootroot00000000000000module type PARAMS = sig val group : string end module type S = sig type keypair = { id : string; priv : string; pub : string } val trustee_keygen : unit -> keypair end val make : (module PARAMS) -> (module S) belenios-1.4+dfsg/src/tool/tool_verifydiff.ml000066400000000000000000000173241307140314400213710ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Signatures open Serializable_j let stream_to_list s = let res = ref [] in Stream.iter (fun x -> res := x :: !res) s; List.rev !res let lines_of_file fname = let ic = open_in fname in Stream.from (fun _ -> try Some (input_line ic) with End_of_file -> close_in ic; None ) let string_of_file f = lines_of_file f |> stream_to_list |> String.concat "\n" let load_from_file of_string filename = if Sys.file_exists filename then ( Some (lines_of_file filename |> stream_to_list |> List.rev_map of_string) ) else None let ( / ) = Filename.concat type verifydiff_error = | ElectionMismatch | PublicKeysMismatch | MissingPublicKeys | InvalidPublicKeys | PublicKeyMismatch | MissingCredentials | InvalidCredential | CredentialsMismatch | MissingBallots | InvalidBallot | DuplicateBallot | BallotSignedByInvalidKey | DecreasingBallots | BallotSignedByReplacedKey exception VerifydiffError of verifydiff_error let explain_error = function | ElectionMismatch -> "election mismatch" | PublicKeysMismatch -> "public keys mismatch" | MissingPublicKeys -> "missing public keys" | InvalidPublicKeys -> "invalid public keys" | PublicKeyMismatch -> "public key mismatch" | MissingCredentials -> "missing credentials" | InvalidCredential -> "invalid credential" | CredentialsMismatch -> "credentials mismatch" | MissingBallots -> "missing ballots" | InvalidBallot -> "invalid ballot" | DuplicateBallot -> "duplicate ballot" | BallotSignedByInvalidKey -> "ballot signed by invalid key" | DecreasingBallots -> "decreasing ballots" | BallotSignedByReplacedKey -> "ballot signed by replaced key" let () = Printexc.register_printer (function | VerifydiffError e -> Some ("verify-diff error: " ^ explain_error e) | _ -> None) let verifydiff dir1 dir2 = (* the elections must be the same *) let election = string_of_file (dir1 / "election.json") in let () = let election2 = string_of_file (dir2 / "election.json") in if election2 <> election then raise (VerifydiffError ElectionMismatch) in (* the public keys must be the same *) let pks = load_from_file (fun x -> x) (dir1 / "public_keys.jsons") in let () = let pks2 = load_from_file (fun x -> x) (dir2 / "public_keys.jsons") in if pks2 <> pks then raise (VerifydiffError PublicKeysMismatch) in (* the public keys must be valid *) let module ED = (val Group.election_params_of_string election) in let open ED in let module M = Election.MakeSimpleMonad (G) in let module E = Election.MakeElection (G) (M) in let module KG = Election.MakeSimpleDistKeyGen (G) (M) in let pks = match pks with | None -> raise (VerifydiffError MissingPublicKeys) | Some pks -> List.map (trustee_public_key_of_string G.read) pks in let () = if not (List.for_all KG.check pks) then raise (VerifydiffError InvalidPublicKeys) in (* the public keys must correspond to the public key of election *) let y = KG.combine (Array.of_list pks) in let () = if not G.(election.e_params.e_public_key =~ y) then raise (VerifydiffError PublicKeyMismatch) in (* load both public_creds.txt and check that their contents is valid *) let module GSet = Set.Make (G) in let creds dir = match load_from_file G.of_string (dir / "public_creds.txt") with | None -> raise (VerifydiffError MissingCredentials) | Some creds -> if not (List.for_all G.check creds) then raise (VerifydiffError InvalidCredential); List.fold_left (fun accu x -> GSet.add x accu) GSet.empty creds in let creds1 = creds dir1 and creds2 = creds dir2 in (* both public_creds.txt have the same cardinal *) let () = if GSet.cardinal creds1 <> GSet.cardinal creds2 then raise (VerifydiffError CredentialsMismatch) in (* compute credentials that have been replaced *) let creds_replaced = GSet.fold (fun x accu -> if not (GSet.mem x creds2) then GSet.add x accu else accu ) creds1 GSet.empty in (* issue a warning when credentials have changed *) let () = if not (GSet.is_empty creds_replaced) then Printf.eprintf "W: credentials have changed\n%!" in (* load both ballots.jsons and check that their contents is valid *) let module GMap = Map.Make (G) in let ballots dir = match load_from_file (ballot_of_string G.read) (dir / "ballots.jsons") with | None -> raise (VerifydiffError MissingBallots) | Some ballots -> if not (List.for_all (E.check_ballot election) ballots) then raise (VerifydiffError InvalidBallot); (* return the set of ballots indexed by the public keys used to sign *) List.fold_left (fun accu x -> match x.signature with | None -> raise (VerifydiffError InvalidBallot) | Some s -> if GMap.mem s.s_public_key accu then raise (VerifydiffError DuplicateBallot) else GMap.add s.s_public_key x accu ) GMap.empty ballots in let ballots1 = ballots dir1 and ballots2 = ballots dir2 in (* each ballot is signed with a valid key *) let check_keys ballots creds = GMap.for_all (fun pk _ -> GSet.mem pk creds) ballots in let () = if not (check_keys ballots1 creds1 && check_keys ballots2 creds2) then raise (VerifydiffError BallotSignedByInvalidKey) in (* the set of ballots increases *) let () = if not (GMap.for_all (fun pk _ -> GMap.mem pk ballots2) ballots1) then raise (VerifydiffError DecreasingBallots) in let () = let n = GMap.cardinal ballots2 - GMap.cardinal ballots1 in if n > 0 then Printf.eprintf "I: %d new ballot(s)\n%!" n in (* the keys of modified ballots have not been replaced *) let () = if not (GMap.for_all (fun pk ballot1 -> let ballot2 = GMap.find pk ballots2 in ballot1 = ballot2 || not (GSet.mem pk creds_replaced) ) ballots1) then raise (VerifydiffError BallotSignedByReplacedKey) in let () = let n = GMap.fold (fun pk ballot1 accu -> let ballot2 = GMap.find pk ballots2 in if ballot1 <> ballot2 then accu + 1 else accu ) ballots1 0 in if n > 0 then Printf.eprintf "W: %d ballot(s) have been replaced\n%!" n in Printf.eprintf "I: all tests passed!\n%!" belenios-1.4+dfsg/src/tool/tool_verifydiff.mli000066400000000000000000000037441307140314400215430ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) type verifydiff_error = | ElectionMismatch | PublicKeysMismatch | MissingPublicKeys | InvalidPublicKeys | PublicKeyMismatch | MissingCredentials | InvalidCredential | CredentialsMismatch | MissingBallots | InvalidBallot | DuplicateBallot | BallotSignedByInvalidKey | DecreasingBallots | BallotSignedByReplacedKey exception VerifydiffError of verifydiff_error val explain_error : verifydiff_error -> string val verifydiff : string -> string -> unit belenios-1.4+dfsg/src/web/000077500000000000000000000000001307140314400154365ustar00rootroot00000000000000belenios-1.4+dfsg/src/web/server.mllib000066400000000000000000000006401307140314400177650ustar00rootroot00000000000000src/platform/native/Belenios_version src/platform/native/Platform Serializable_builtin_t Serializable_builtin_j Serializable_j Common Group_field Group Election Credential Web_l10n_en Web_l10n_fr Web_l10n_de Web_l10n_ro Web_l10n_it Web_i18n Web_serializable_builtin_t Web_serializable_builtin_j Web_serializable_j Web_common Web_persist Web_services Web_state Web_templates Web_auth Web_election Web_site Web_main belenios-1.4+dfsg/src/web/web_auth.ml000066400000000000000000000321301307140314400175650ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Eliom_service open Platform open Web_serializable_j open Web_common open Web_state open Web_services let next_lf str i = try Some (String.index_from str i '\n') with Not_found -> None let configure x = let auth_config = List.map (fun {auth_system; auth_instance; auth_config} -> auth_instance, (auth_system, List.map snd auth_config) ) x in Web_persist.set_auth_config "" auth_config |> Lwt_main.run; List.iter (fun {auth_system; auth_config; _} -> match auth_system with | "password" -> let table = Ocsipersist.open_table "password_site" in (match auth_config with | [] -> () | ["db", file] -> Ocsigen_messages.console (fun () -> Printf.sprintf "Loading passwords from file %s" file ); let db = Csv.load file in List.iter (function | username :: salt :: password :: _ -> Ocsipersist.add table username (salt, password) |> Lwt_main.run | _ -> failwith ("error while loading " ^ file)) db | _ -> failwith "error in passwords configuration") | _ -> () ) x let scope = Eliom_common.default_session_scope let auth_env = Eliom_reference.eref ~scope None let default_cont uuid () = match%lwt cont_pop () with | Some f -> f () | None -> match uuid with | None -> Eliom_registration.Redirection.send Web_services.admin | Some u -> Eliom_registration.Redirection.send (preapply Web_services.election_home (u, ())) (** Dummy authentication *) let dummy_handler () name = match%lwt Eliom_reference.get auth_env with | None -> failwith "dummy handler was invoked without environment" | Some (uuid, service) -> Eliom_reference.set user (Some {uuid; service; name}) >> Eliom_reference.unset auth_env >> default_cont uuid () let () = Eliom_registration.Any.register ~service:dummy_post dummy_handler (** Password authentication *) let password_handler () (name, password) = let%lwt uuid, service = match%lwt Eliom_reference.get auth_env with | None -> failwith "password handler was invoked without environment" | Some x -> return x in let table = "password_" ^ match uuid with | None -> "site" | Some u -> let u = Uuidm.to_string u in underscorize u in let table = Ocsipersist.open_table table in let%lwt salt, hashed = try%lwt Ocsipersist.find table name with Not_found -> fail_http 401 in if sha256_hex (salt ^ password) = hashed then Eliom_reference.set user (Some {uuid; service; name}) >> Eliom_reference.unset auth_env >> default_cont uuid () else fail_http 401 let () = Eliom_registration.Any.register ~service:password_post password_handler (** CAS authentication *) let cas_server = Eliom_reference.eref ~scope None let login_cas = Eliom_service.Http.service ~path:["auth"; "cas"] ~get_params:Eliom_parameter.(opt (string "ticket")) () let cas_self = (* lazy so rewrite_prefix is called after server initialization *) lazy (Eliom_uri.make_string_uri ~absolute:true ~service:(preapply login_cas None) () |> rewrite_prefix) let parse_cas_validation info = match next_lf info 0 with | Some i -> (match String.sub info 0 i with | "yes" -> `Yes (match next_lf info (i+1) with | Some j -> Some (String.sub info (i+1) (j-i-1)) | None -> None) | "no" -> `No | _ -> `Error `Parsing) | None -> `Error `Parsing let get_cas_validation server ticket = let url = let cas_validate = Http.external_service ~prefix:server ~path:["validate"] ~get_params:Eliom_parameter.(string "service" ** string "ticket") () in let service = preapply cas_validate (Lazy.force cas_self, ticket) in Eliom_uri.make_string_uri ~absolute:true ~service () in let%lwt reply = Ocsigen_http_client.get_url url in match reply.Ocsigen_http_frame.frame_content with | Some stream -> let%lwt info = Ocsigen_stream.(string_of_stream 1000 (get stream)) in Ocsigen_stream.finalize stream `Success >> return (parse_cas_validation info) | None -> return (`Error `Http) let cas_handler ticket () = let%lwt uuid, service = match%lwt Eliom_reference.get auth_env with | None -> failwith "cas handler was invoked without environment" | Some x -> return x in match ticket with | Some x -> let%lwt server = match%lwt Eliom_reference.get cas_server with | None -> failwith "cas handler was invoked without a server" | Some x -> return x in (match%lwt get_cas_validation server x with | `Yes (Some name) -> Eliom_reference.set user (Some {uuid; service; name}) >> default_cont uuid () | `No -> fail_http 401 | `Yes None | `Error _ -> fail_http 502) | None -> Eliom_reference.unset cas_server >> Eliom_reference.unset auth_env >> default_cont uuid () let () = Eliom_registration.Any.register ~service:login_cas cas_handler let cas_login_handler config () = match config with | [server] -> Eliom_reference.set cas_server (Some server) >> let cas_login = Http.external_service ~prefix:server ~path:["login"] ~get_params:Eliom_parameter.(string "service") () in let service = preapply cas_login (Lazy.force cas_self) in Eliom_registration.Redirection.send service | _ -> failwith "cas_login_handler invoked with bad config" (** OpenID Connect (OIDC) authentication *) let oidc_state = Eliom_reference.eref ~scope None let login_oidc = Eliom_service.Http.service ~path:["auth"; "oidc"] ~get_params:Eliom_parameter.any () let oidc_self = lazy (Eliom_uri.make_string_uri ~absolute:true ~service:(preapply login_oidc []) () |> rewrite_prefix) let oidc_get_userinfo ocfg info = let info = oidc_tokens_of_string info in let access_token = info.oidc_access_token in let url = ocfg.userinfo_endpoint in let headers = Http_headers.( add (name "Authorization") ("Bearer " ^ access_token) empty ) in let%lwt reply = Ocsigen_http_client.get_url ~headers url in match reply.Ocsigen_http_frame.frame_content with | Some stream -> let%lwt info = Ocsigen_stream.(string_of_stream 10000 (get stream)) in Ocsigen_stream.finalize stream `Success >> let x = oidc_userinfo_of_string info in return (Some (match x.oidc_email with Some x -> x | None -> x.oidc_sub)) | None -> return None let oidc_get_name ocfg client_id client_secret code = let content = [ "code", code; "client_id", client_id; "client_secret", client_secret; "redirect_uri", Lazy.force oidc_self; "grant_type", "authorization_code"; ] in let%lwt reply = Ocsigen_http_client.post_urlencoded_url ~content ocfg.token_endpoint in match reply.Ocsigen_http_frame.frame_content with | Some stream -> let%lwt info = Ocsigen_stream.(string_of_stream 10000 (get stream)) in Ocsigen_stream.finalize stream `Success >> oidc_get_userinfo ocfg info | None -> return None let oidc_handler params () = let%lwt uuid, service = match%lwt Eliom_reference.get auth_env with | None -> failwith "oidc handler was invoked without environment" | Some x -> return x in let code = try Some (List.assoc "code" params) with Not_found -> None in let state = try Some (List.assoc "state" params) with Not_found -> None in match code, state with | Some code, Some state -> let%lwt ocfg, client_id, client_secret, st = match%lwt Eliom_reference.get oidc_state with | None -> failwith "oidc handler was invoked without a state" | Some x -> return x in Eliom_reference.unset oidc_state >> Eliom_reference.unset auth_env >> if state <> st then fail_http 401 else (match%lwt oidc_get_name ocfg client_id client_secret code with | Some name -> Eliom_reference.set user (Some {uuid; service; name}) >> default_cont uuid () | None -> fail_http 401) | _, _ -> default_cont uuid () let () = Eliom_registration.Any.register ~service:login_oidc oidc_handler let get_oidc_configuration server = let url = server ^ "/.well-known/openid-configuration" in let%lwt reply = Ocsigen_http_client.get_url url in match reply.Ocsigen_http_frame.frame_content with | Some stream -> let%lwt info = Ocsigen_stream.(string_of_stream 10000 (get stream)) in Ocsigen_stream.finalize stream `Success >> return (oidc_configuration_of_string info) | None -> fail_http 404 let split_prefix_path url = let n = String.length url in let i = String.rindex url '/' in String.sub url 0 i, [String.sub url (i+1) (n-i-1)] let oidc_login_handler config () = match config with | [server; client_id; client_secret] -> let%lwt ocfg = get_oidc_configuration server in let%lwt state = generate_token () in Eliom_reference.set oidc_state (Some (ocfg, client_id, client_secret, state)) >> let prefix, path = split_prefix_path ocfg.authorization_endpoint in let auth_endpoint = Http.external_service ~prefix ~path ~get_params:Eliom_parameter.(string "redirect_uri" ** string "response_type" ** string "client_id" ** string "scope" ** string "state" ** string "prompt") () in let service = preapply auth_endpoint (Lazy.force oidc_self, ("code", (client_id, ("openid email", (state, "consent"))))) in Eliom_registration.Redirection.send service | _ -> failwith "oidc_login_handler invoked with bad config" (** Generic authentication *) let get_login_handler service uuid auth_system config = Eliom_reference.set auth_env (Some (uuid, service)) >> match auth_system with | "dummy" -> Web_templates.login_dummy () >>= Eliom_registration.Html5.send | "cas" -> cas_login_handler config () | "password" -> Web_templates.login_password () >>= Eliom_registration.Html5.send | "oidc" -> oidc_login_handler config () | _ -> fail_http 404 let login_handler service uuid = let myself service = match uuid with | None -> preapply site_login service | Some u -> preapply election_login ((u, ()), service) in match%lwt Eliom_reference.get user with | Some _ -> cont_push (fun () -> Eliom_registration.Redirection.send (myself service)) >> Web_templates.already_logged_in () >>= Eliom_registration.Html5.send | None -> let uuid_or_empty = match uuid with | None -> "" | Some u -> Uuidm.to_string u in let%lwt c = Web_persist.get_auth_config uuid_or_empty in match service with | Some s -> let%lwt auth_system, config = try return @@ List.assoc s c with Not_found -> fail_http 404 in get_login_handler s uuid auth_system config | None -> match c with | [s, _] -> Eliom_registration.Redirection.send (myself (Some s)) | _ -> let builder = match uuid with | None -> fun s -> preapply Web_services.site_login (Some s) | Some u -> fun s -> preapply Web_services.election_login ((u, ()), Some s) in Web_templates.login_choose (List.map fst c) builder () >>= Eliom_registration.Html5.send let logout_handler () = Eliom_reference.unset Web_state.user >> match%lwt cont_pop () with | Some f -> f () | None -> Eliom_registration.Redirection.send Web_services.home let () = Eliom_registration.Any.register ~service:site_login (fun service () -> login_handler service None) let () = Eliom_registration.Any.register ~service:logout (fun () () -> logout_handler ()) let () = Eliom_registration.Any.register ~service:election_login (fun ((uuid, ()), service) () -> login_handler service (Some uuid)) belenios-1.4+dfsg/src/web/web_auth.mli000066400000000000000000000001021307140314400177300ustar00rootroot00000000000000open Web_serializable_t val configure : auth_config list -> unit belenios-1.4+dfsg/src/web/web_common.ml000066400000000000000000000157521307140314400201270ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Platform open Common open Web_serializable_builtin_t open Web_serializable_j let spool_dir = ref "." let make_rng = Lwt_preemptive.detach (fun () -> pseudo_rng (random_string secure_rng 16) ) module type LWT_RANDOM = Signatures.RANDOM with type 'a t = 'a Lwt.t module type LWT_RNG = sig val rng : rng Lwt.t end module MakeLwtRandom (X : LWT_RNG) = struct type 'a t = 'a Lwt.t let return = Lwt.return let bind = Lwt.bind let fail = Lwt.fail let random q = let size = Z.bit_length q / 8 + 1 in let%lwt rng = X.rng in let r = random_string rng size in return Z.(of_bits r mod q) end type error = | Serialization of exn | ProofCheck | ElectionClosed | MissingCredential | InvalidCredential | RevoteNotAllowed | ReusedCredential | WrongCredential | UsedCredential | CredentialNotFound | UnauthorizedVoter exception Error of error let fail e = Lwt.fail (Error e) let explain_error = function | Serialization e -> Printf.sprintf "your ballot has a syntax error (%s)" (Printexc.to_string e) | ProofCheck -> "some proofs failed verification" | ElectionClosed -> "the election is closed" | MissingCredential -> "a credential is missing" | InvalidCredential -> "your credential is invalid" | RevoteNotAllowed -> "you are not allowed to revote" | ReusedCredential -> "your credential has already been used" | WrongCredential -> "you are not allowed to vote with this credential" | UsedCredential -> "the credential has already been used" | CredentialNotFound -> "the credential has not been found" | UnauthorizedVoter -> "you are not allowed to vote" let security_logfile = ref None let open_security_log f = let%lwt () = match !security_logfile with | Some ic -> Lwt_io.close ic | None -> return () in let%lwt ic = Lwt_io.( open_file ~flags:Unix.( [O_WRONLY; O_APPEND; O_CREAT] ) ~perm:0o600 ~mode:output f ) in security_logfile := Some ic; return () let security_log s = match !security_logfile with | None -> return () | Some ic -> Lwt_io.atomic (fun ic -> Lwt_io.write ic ( string_of_datetime (now ()) ) >> Lwt_io.write ic ": " >> Lwt_io.write_line ic (s ()) >> Lwt_io.flush ic ) ic let fail_http status = [%lwt raise ( Ocsigen_extensions.Ocsigen_http_error (Ocsigen_cookies.empty_cookieset, status) )] let forbidden () = fail_http 403 let rewrite_fun = ref (fun x -> x) let rewrite_prefix x = !rewrite_fun x let set_rewrite_prefix ~src ~dst = let nsrc = String.length src in let f x = let n = String.length x in if n >= nsrc && String.sub x 0 nsrc = src then dst ^ String.sub x nsrc (n-nsrc) else x in rewrite_fun := f type election_file = | ESRaw | ESKeys | ESCreds | ESBallots | ESVoters | ESRecords | ESETally | ESResult let election_file_of_string = function | "election.json" -> ESRaw | "public_keys.jsons" -> ESKeys | "public_creds.txt" -> ESCreds | "ballots.jsons" -> ESBallots | "records" -> ESRecords | "voters.txt" -> ESVoters | "encrypted_tally.json" -> ESETally | "result.json" -> ESResult | x -> invalid_arg ("election_dir_item: " ^ x) let string_of_election_file = function | ESRaw -> "election.json" | ESKeys -> "public_keys.jsons" | ESCreds -> "public_creds.txt" | ESBallots -> "ballots.jsons" | ESRecords -> "records" | ESVoters -> "voters.txt" | ESETally -> "encrypted_tally.json" | ESResult -> "result.json" let election_file = Eliom_parameter.user_type ~of_string:election_file_of_string ~to_string:string_of_election_file let uuid_of_string x = match Uuidm.of_string x with | Some x -> x | None -> Printf.ksprintf invalid_arg "invalid UUID [%s]" x let uuid = let of_string x = uuid_of_string x and to_string x = Uuidm.to_string x in Eliom_parameter.user_type ~of_string ~to_string let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" let token_length = 14 let prng = lazy (pseudo_rng (random_string secure_rng 16)) let random_char () = let%lwt rng = if Lazy.is_val prng then return (Lazy.force prng) else Lwt_preemptive.detach (fun () -> Lazy.force prng) () in return (int_of_char (random_string rng 1).[0]) let generate_token () = let res = Bytes.create token_length in let rec loop i = if i < token_length then ( let%lwt digit = random_char () in let digit = digit mod 58 in Bytes.set res i b58_digits.[digit]; loop (i+1) ) else return (Bytes.to_string res) in loop 0 let string_of_user {user_domain; user_name} = user_domain ^ ":" ^ user_name let underscorize x = String.map (function '-' -> '_' | c -> c) x let send_email recipient subject body = let contents = Netsendmail.compose ~from_addr:("Belenios public server", "noreply@belenios.org") ~to_addrs:[recipient, recipient] ~in_charset:`Enc_utf8 ~out_charset:`Enc_utf8 ~subject body in let rec loop () = try%lwt Lwt_preemptive.detach Netsendmail.sendmail contents with Unix.Unix_error (Unix.EAGAIN, _, _) -> Lwt_unix.sleep 1. >> loop () in loop () let split_identity x = let n = String.length x in try let i = String.index x ',' in String.sub x 0 i, String.sub x (i+1) (n-i-1) with Not_found -> x, x let available_languages = ["en"; "fr"; "de"; "ro"; "it"] let get_languages xs = match xs with | None -> ["en"] | Some xs -> xs let string_of_languages xs = String.concat " " (get_languages xs) let languages_of_string x = Some (Pcre.split x) belenios-1.4+dfsg/src/web/web_common.mli000066400000000000000000000070641307140314400202750ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Web_serializable_t val spool_dir : string ref val make_rng : unit -> Platform.rng Lwt.t (** Create a pseudo random number generator initialized by a 128-bit secure random seed. *) module type LWT_RANDOM = Signatures.RANDOM with type 'a t = 'a Lwt.t module type LWT_RNG = sig val rng : Platform.rng Lwt.t end module MakeLwtRandom (X : LWT_RNG) : LWT_RANDOM (** Lwt-compatible random number generation. *) type error = | Serialization of exn | ProofCheck | ElectionClosed | MissingCredential | InvalidCredential | RevoteNotAllowed | ReusedCredential | WrongCredential | UsedCredential | CredentialNotFound | UnauthorizedVoter exception Error of error val fail : error -> 'a Lwt.t val explain_error : error -> string val open_security_log : string -> unit Lwt.t (** Set the path to the security logger. *) val security_log : (unit -> string) -> unit Lwt.t (** Add an entry to the security log. *) val fail_http : int -> 'a Lwt.t val forbidden : unit -> 'a Lwt.t val rewrite_prefix : string -> string val set_rewrite_prefix : src:string -> dst:string -> unit type election_file = | ESRaw | ESKeys | ESCreds | ESBallots | ESVoters | ESRecords | ESETally | ESResult val election_file_of_string : string -> election_file val string_of_election_file : election_file -> string val election_file : string -> (election_file, [ `WithoutSuffix ], [ `One of election_file ] Eliom_parameter.param_name) Eliom_parameter.params_type val uuid_of_string : string -> Uuidm.t val uuid : string -> (Uuidm.t, [ `WithoutSuffix ], [ `One of Uuidm.t ] Eliom_parameter.param_name) Eliom_parameter.params_type val generate_token : unit -> string Lwt.t val string_of_user : user -> string val underscorize : string -> string val send_email : string -> string -> string -> unit Lwt.t val split_identity : string -> string * string val available_languages : string list val get_languages : string list option -> string list val string_of_languages : string list option -> string val languages_of_string : string -> string list option belenios-1.4+dfsg/src/web/web_election.ml000066400000000000000000000215071307140314400204340ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Platform open Serializable_j open Signatures open Common open Web_serializable_j open Web_signatures open Web_common let ( / ) = Filename.concat module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION = struct let uuid = Uuidm.to_string D.election.e_params.e_uuid module G = D.G module E = Election.MakeElection (G) (M) module B : WEB_BALLOT_BOX = struct let uuid_u = underscorize uuid let ballots_table = Ocsipersist.open_table ("ballots_" ^ uuid_u) let records_table = Ocsipersist.open_table ("records_" ^ uuid_u) let cred_table = Ocsipersist.open_table ("creds_" ^ uuid_u) let inject_cred cred = try%lwt let%lwt _ = Ocsipersist.find cred_table cred in failwith "trying to add duplicate credential" with Not_found -> Ocsipersist.add cred_table cred None let send_confirmation_email user email hash = let title = D.election.e_params.e_name in let x = (D.election.e_params.e_uuid, ()) in let url1 = Eliom_uri.make_string_uri ~absolute:true ~service:Web_services.election_pretty_ballots x |> rewrite_prefix in let url2 = Eliom_uri.make_string_uri ~absolute:true ~service:Web_services.election_home x |> rewrite_prefix in let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let subject = Printf.sprintf L.mail_confirmation_subject title in let body = Printf.sprintf L.mail_confirmation user title hash url1 url2 in send_email email subject body let do_cast rawballot (user, date) = let voters = Lwt_io.lines_of_file (!spool_dir / uuid / "voters.txt") in let%lwt voters = Lwt_stream.to_list voters in let%lwt email, login = let rec loop = function | x :: xs -> let email, login = split_identity x in if login = user.user_name then return (email, login) else loop xs | [] -> fail UnauthorizedVoter in loop voters in let user = string_of_user user in let%lwt state = Web_persist.get_election_state uuid in let voting_open = state = `Open in if not voting_open then fail ElectionClosed else return () >> if String.contains rawballot '\n' then ( fail (Serialization (Invalid_argument "multiline ballot")) ) else return () >> let%lwt ballot = try Lwt.return (ballot_of_string G.read rawballot) with e -> fail (Serialization e) in let%lwt credential = match ballot.signature with | Some s -> Lwt.return (G.to_string s.s_public_key) | None -> fail MissingCredential in let%lwt old_cred = try%lwt Ocsipersist.find cred_table credential with Not_found -> fail InvalidCredential and old_record = try%lwt let%lwt x = Ocsipersist.find records_table user in Lwt.return (Some x) with Not_found -> Lwt.return None in match old_cred, old_record with | None, None -> (* first vote *) if E.check_ballot D.election ballot then ( let hash = sha256_b64 rawballot in Ocsipersist.add cred_table credential (Some hash) >> Ocsipersist.add ballots_table hash rawballot >> Ocsipersist.add records_table user (date, credential) >> send_confirmation_email login email hash >> return hash ) else ( fail ProofCheck ) | Some h, Some (_, old_credential) -> (* revote *) if credential = old_credential then ( if E.check_ballot D.election ballot then ( Ocsipersist.remove ballots_table h >> let hash = sha256_b64 rawballot in Ocsipersist.add cred_table credential (Some hash) >> Ocsipersist.add ballots_table hash rawballot >> Ocsipersist.add records_table user (date, credential) >> send_confirmation_email login email hash >> return hash ) else ( fail ProofCheck ) ) else ( security_log (fun () -> Printf.sprintf "%s attempted to revote with already used credential %s" user credential ) >> fail WrongCredential ) | None, Some _ -> security_log (fun () -> Printf.sprintf "%s attempted to revote using a new credential %s" user credential ) >> fail RevoteNotAllowed | Some _, None -> security_log (fun () -> Printf.sprintf "%s attempted to vote with already used credential %s" user credential ) >> fail ReusedCredential let do_update_cred ~old ~new_ = match%lwt Ocsipersist.fold_step (fun k v x -> if sha256_hex k = old then ( match v with | Some _ -> fail UsedCredential | None -> return (Some k) ) else return x ) cred_table None with | None -> fail CredentialNotFound | Some x -> Ocsipersist.remove cred_table x >> Ocsipersist.add cred_table new_ None let do_write f = Lwt_io.(with_file ~mode:Output (!spool_dir / uuid / string_of_election_file f)) let do_write_ballots () = do_write ESBallots (fun oc -> Ocsipersist.iter_step (fun _ x -> Lwt_io.write_line oc x ) ballots_table ) let do_write_creds () = do_write ESCreds (fun oc -> Ocsipersist.iter_step (fun x _ -> Lwt_io.write_line oc x ) cred_table ) let do_write_records () = do_write ESRecords (fun oc -> Ocsipersist.iter_step (fun u (d, _) -> Printf.sprintf "%s %S\n" (string_of_datetime d) u |> Lwt_io.write oc ) records_table ) let mutex = Lwt_mutex.create () let cast rawballot (user, date) = Lwt_mutex.with_lock mutex (fun () -> let%lwt r = do_cast rawballot (user, date) in do_write_ballots () >> do_write_records () >> return r ) let update_cred ~old ~new_ = Lwt_mutex.with_lock mutex (fun () -> let%lwt r = do_update_cred ~old ~new_ in do_write_creds () >> return r ) let update_files () = Lwt_mutex.with_lock mutex (fun () -> do_write_ballots () >> do_write_records () >> do_write_creds () ) let compute_encrypted_tally () = let%lwt num_tallied, tally = Ocsipersist.fold_step (fun _ rawballot (n, accu) -> let ballot = ballot_of_string G.read rawballot in let ciphertext = E.extract_ciphertext ballot in return (n + 1, E.combine_ciphertexts accu ciphertext)) ballots_table (0, E.neutral_ciphertext D.election) in let tally = string_of_encrypted_tally G.write tally in Lwt_mutex.with_lock mutex (fun () -> do_write ESETally (fun oc -> Lwt_io.write oc tally ) ) >> return (num_tallied, sha256_b64 tally, tally) end end belenios-1.4+dfsg/src/web/web_election.mli000066400000000000000000000032011307140314400205740ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Signatures open Web_signatures module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION belenios-1.4+dfsg/src/web/web_i18n.ml000066400000000000000000000005321307140314400174040ustar00rootroot00000000000000let get_lang = function | "fr" -> (module Web_l10n_fr : Web_i18n_sig.LocalizedStrings) | "de" -> (module Web_l10n_de : Web_i18n_sig.LocalizedStrings) | "ro" -> (module Web_l10n_ro : Web_i18n_sig.LocalizedStrings) | "it" -> (module Web_l10n_it : Web_i18n_sig.LocalizedStrings) | _ -> (module Web_l10n_en : Web_i18n_sig.LocalizedStrings) belenios-1.4+dfsg/src/web/web_i18n.mli000066400000000000000000000001001307140314400175440ustar00rootroot00000000000000val get_lang : string -> (module Web_i18n_sig.LocalizedStrings) belenios-1.4+dfsg/src/web/web_i18n_sig.mli000066400000000000000000000113661307140314400204260ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) module type LocalizedStrings = sig val lang : string val start : string val advanced_mode : string val see_accepted_ballots : string val belenios_booth : string val here : string val question_header : string val at_least : string val at_most : string val previous : string val next : string val nothing : string val enter_cred : string val invalid_cred : string val input_credential : string val answer_to_questions : string val review_and_encrypt : string val authenticate : string val confirm : string val done_ : string val booth_step1 : string val booth_step2 : string val booth_step3 : string val booth_step5 : string val booth_step6 : string val input_your_credential : string val wait_while_encrypted : string val encrypting : string val restart : string val successfully_encrypted : string val not_cast_yet : string val qmark : string val your_tracker_is : string val we_invite_you_to_save_it : string val continue : string val election_uuid : string val election_fingerprint : string val i_am : string val and_ : string val i_cast_my_vote : string val please_login_to_confirm : string val your_ballot_for : string val has_been_received : string val nobody_can_see : string val go_back_to_election : string val has_been_accepted : string val you_can_check_its_presence : string val ballot_box : string val anytime_during_the_election : string val confirmation_email : string val thank_you_for_voting : string val is_rejected_because : string val fail : string val administer_elections : string val administer_this_election : string val powered_by : string val get_the_source_code : string val audit_data : string val parameters : string val public_credentials : string val trustee_public_keys : string val ballots : string val election_server : string val accepted_ballots : string val ballots_have_been_accepted_so_far : string val ballots_have_been_accepted : string val ballots_have_been_accepted_and : string val have_been_tallied : string val username : string val password : string val login : string val password_login : string val you_must_accept_cookies : string val accept : string val not_yet_open : string val come_back_later : string val cookies_are_blocked : string val please_enable_them : string val election_currently_closed : string val election_closed_being_tallied : string val the : string val encrypted_tally : string val hash_is : string val election_has_been_tallied : string val election_archived : string val number_accepted_ballots : string val you_can_also_download : string val result_with_crypto_proofs : string val blank_vote : string val no_other_blank : string val mail_password_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 val mail_password : (string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 val mail_credential_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 val mail_credential : (string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 val mail_confirmation_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 val mail_confirmation : (string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 end belenios-1.4+dfsg/src/web/web_l10n_de.ml000066400000000000000000000202041307140314400200450ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let lang = "de" let start = "Start" let advanced_mode = "Erweiterter Modus" let see_accepted_ballots = "angenommene Stimmen anzeigen" let belenios_booth = "Belenios Wahlkabine" let here = "hier" let question_header = "Frage #%d von %d — wählen Sie zwischen %d und %d Antworten aus" let at_least = "Sie müssen mindestens %d Antworten auswählen" let at_most = "Sie müssen maximal %d Antworten auswählen" let previous = "Zurück" let next = "Weiter" let nothing = "(nichts)" let enter_cred = "Bitte geben Sie Ihre Wählernummer ein:" let invalid_cred = "Falsche Wählernummer!" let input_credential = "Wählernummer eingeben" let answer_to_questions = "Fragen beantworten" let review_and_encrypt = "Überprüfen und verschlüsseln" let authenticate = "Authentifizieren" let confirm = "Bestätigen" let done_ = "Fertig" let booth_step1 = "Schritt 1/6: Wählernummer eingeben" let booth_step2 = "Schritt 2/6: Fragen beantworten" let booth_step3 = "Schritt 3/6: Überprüfen und verschlüsseln" let booth_step5 = "Schritt 5/6: Bestätigen" let booth_step6 = "Schritt 6/6: " let input_your_credential = "Bitte Wählernummer eingeben " let wait_while_encrypted = "Bitte warten, Ihre Stimme wird verschlüsselt..." let encrypting = "Verschlüssele..." let restart = "Erneut beginnen" let successfully_encrypted = "Ihre Stimme wurde erfolgreich verschlüsselt, " let not_cast_yet = "aber noch nicht abgeschickt" let qmark = "!" let your_tracker_is = "Ihre Stimmennummer ist " let we_invite_you_to_save_it = "Bitte Speichern Sie sie ab um später zu überprüfen, dass Ihre Stimme gezählt wurde." let continue = "Weiter" let election_uuid = "Eindeutige Nummer der Abstimmung: " let election_fingerprint = "Fingerabdruck der Abstimmung: " let i_am = "Ich bin " let and_ = " und " let i_cast_my_vote = "ich schicke meine Stimme ab" let please_login_to_confirm = "Bitte melden Sie sich an um Ihre Stime zu bestätigen." let your_ballot_for = "Ihre Stimme für " let has_been_received = " wurde empfangen, aber noch nicht gespeichert. " let nobody_can_see = "Hinweis: Ihre Stimme ist verschlüsselt und niemand kann ihren Inhalt sehen." let go_back_to_election = "Zurück zur Wahl" let has_been_accepted = " wurde angenommen." let you_can_check_its_presence = "Sie können jederzeit überprüfen, dass Ihre Stimme in der " let ballot_box = "Wahlurne" let anytime_during_the_election = " vorhanden ist." let confirmation_email = " Sie erhalten eine Bestätigung per E-Mail." let thank_you_for_voting = "Vielen Dank für Ihre Stimme!" let is_rejected_because = " wurde abgelehnt, da " let fail = "FEHLER!" let administer_elections = "Abstimmung verwalten" let administer_this_election = "Diese Abstimmung verwalten" let powered_by = "Powered by " let get_the_source_code = "Den Quellcode herunterladen" let audit_data = "Auditdaten: " let parameters = "Parameter" let public_credentials = "Öffentliche Daten" let trustee_public_keys = "Öffentliche Schlüssel der Treuhänder" let ballots = "Stimmen" let election_server = "Wahlserver" let accepted_ballots = "Angenommene Stimmen" let ballots_have_been_accepted_so_far = " Stimmen wurden bis jetzt angenommen." let ballots_have_been_accepted = " Stimmen wurden angenommen." let ballots_have_been_accepted_and = " Stimmen wurden angenommen, und " let have_been_tallied = " wurden gezählt." let username = "Benutzername:" let password = "Passwort:" let login = "Login" let password_login = "Login mit Passwort" let you_must_accept_cookies = "Um diese Seite benutzen zu können, müssen Sie Cookies aktivieren. " let accept = "Bestätigen" let not_yet_open = "Entschuldigung, die Abstimmung ist noch nicht geöffnet." let come_back_later = "Diese Abstimmung gibt es noch nicht. Bitte kommen Sie später wieder." let cookies_are_blocked = "Cookies sind deaktiviert" let please_enable_them = "Ihr Browser nimmt keine Cookies an, bitte aktivieren Sie diese." let election_currently_closed = "Diese Abstimmung ist beendet." let election_closed_being_tallied = "Diese Abstimmung ist beendet und wird ausgezählt." let the = "Der Hash des " let encrypted_tally = "verschlüsselten Ergebnisses" let hash_is = " ist " let election_has_been_tallied = "Diese Abstimmung wurde ausgezählt." let election_archived = "Diese Abstimmung wurde archiviert." let number_accepted_ballots = "Anzahl angenommener Stimmen: " let you_can_also_download = "Sie können außerdem das " let result_with_crypto_proofs = "Ergbnis mit den kryptographischen Beweisen herunterladen" let blank_vote = "ungültige Stimme" let no_other_blank = "Bei einer ungültigen Stimme sind keine anderen Auswahlmöglichkeiten vorhanden." let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Ihr Passwort für die Abstimmung %s" let mail_password : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Sie sind für die folgende Abstimmung als Wähler eingetragen: %s Am Ende der Mail finden Sie Ihren Benutzername und Ihr Passwort. Um abzustimmen benötigen sie außerdem noch Ihre Wählernummer, die Ihnen in einer seperaten Mail zugestellt wird. Obwohl Passwort und Wählernummer ähnlich aussehen, erfüllen sie zwei verschiedene Zwecke: die Wählernummer wird für die Verschlüsselung Ihrer Stimme in der virtuellen Wahlkabine benötigt, mit dem Passwort können Sie anschließend Ihre verschlüsselte Stimme auf den Wahlserver übertragen. Benutzername: %s Passwort: %s Website der Abstimmung: %s Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt." let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Ihre Wählernummer für die Abstimmung %s" let mail_credential : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Sie sind für die folgende Abstimmung als Wähler eingetragen: %s Am Ende der Mail finden Sie Ihren Benutzername und Ihre Wählernummer. Um abzustimmen benötigen sie außerdem noch Ihr Passwort, die Ihnen in einer seperaten Mail zugestellt wird. Obwohl Passwort und Wählernummer ähnlich aussehen, erfüllen sie zwei verschiedene Zwecke: die Wählernummer wird für die Verschlüsselung Ihrer Stimme in der virtuellen Wahlkabine benötigt, mit dem Passwort können Sie anschließend Ihre verschlüsselte Stimme auf den Wahlserver übertragen. Benutzername: %s Wählernummer: %s Website der Abstimmung: %s Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Ihre Stimme zur Abstimmung %s" let mail_confirmation : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%s, Ihre Stimme zur Abstimmung %s wurde angenommen. Ihre Stimmennummer ist: %s Mit dieser Nummer können Sie überprüfen, ob sich Ihre Stimme in der Wahlurne befindet: %s Das Ergebnis wird auf der Website der Abstimmung veröffentlicht: %s -- \nBelenios" belenios-1.4+dfsg/src/web/web_l10n_de.mli000066400000000000000000000000461307140314400202200ustar00rootroot00000000000000include Web_i18n_sig.LocalizedStrings belenios-1.4+dfsg/src/web/web_l10n_en.ml000066400000000000000000000165431307140314400200720ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let lang = "en" let start = "Start" let advanced_mode = "Advanced mode" let see_accepted_ballots = "See accepted ballots" let belenios_booth = "Belenios Booth" let here = "here" let question_header = "Question #%d of %d — select between %d and %d answer(s)" let at_least = "You must select at least %d answer(s)" let at_most = "You must select at most %d answer(s)" let previous = "Previous" let next = "Next" let nothing = "(nothing)" let enter_cred = "Please enter your credential:" let invalid_cred = "Invalid credential!" let input_credential = "Input credential" let answer_to_questions = "Answer to questions" let review_and_encrypt = "Review and encrypt" let authenticate = "Authenticate" let confirm = "Confirm" let done_ = "Done" let booth_step1 = "Step 1/6: Input your credential" let booth_step2 = "Step 2/6: Answer to questions" let booth_step3 = "Step 3/6: Review and encrypt" let booth_step5 = "Step 5/6: Confirm" let booth_step6 = "Step 6/6: " let input_your_credential = "Input your credential " let wait_while_encrypted = "Please wait while your ballot is being encrypted..." let encrypting = "Encrypting..." let restart = "Restart" let successfully_encrypted = "Your ballot has been successfully encrypted, " let not_cast_yet = "but has not been cast yet" let qmark = "!" let your_tracker_is = "Your smart ballot tracker is " let we_invite_you_to_save_it = "We invite you to save it in order to check later that it is taken into account." let continue = "Continue" let election_uuid = "Election UUID: " let election_fingerprint = "Election fingerprint: " let i_am = "I am " let and_ = " and " let i_cast_my_vote = "I cast my vote" let please_login_to_confirm = "Please log in to confirm your vote." let your_ballot_for = "Your ballot for " let has_been_received = " has been received, but not recorded yet. " let nobody_can_see = "Note: your ballot is encrypted and nobody can see its contents." let go_back_to_election = "Go back to election" let has_been_accepted = " has been accepted." let you_can_check_its_presence = "You can check its presence in the " let ballot_box = "ballot box" let anytime_during_the_election = " anytime during the election." let confirmation_email = " A confirmation e-mail has been sent to you." let thank_you_for_voting = "Thank you for voting!" let is_rejected_because = " is rejected, because " let fail = "FAIL!" let administer_elections = "Administer elections" let administer_this_election = "Administer this election" let powered_by = "Powered by " let get_the_source_code = "Get the source code" let audit_data = "Audit data: " let parameters = "parameters" let public_credentials = "public credentials" let trustee_public_keys = "trustee public keys" let ballots = "ballots" let election_server = "Election server" let accepted_ballots = "Accepted ballots" let ballots_have_been_accepted_so_far = " ballot(s) have been accepted so far." let ballots_have_been_accepted = " ballot(s) have been accepted." let ballots_have_been_accepted_and = " ballot(s) have been accepted, and " let have_been_tallied = " have been tallied." let username = "Username:" let password = "Password:" let login = "Login" let password_login = "Password login" let you_must_accept_cookies = "To use this site, you must accept cookies. " let accept = "Accept" let not_yet_open = "Sorry, this election is not yet open" let come_back_later = "This election does not exist yet. Please come back later." let cookies_are_blocked = "Cookies are blocked" let please_enable_them = "Your browser seems to block cookies. Please enable them." let election_currently_closed = "This election is currently closed." let election_closed_being_tallied = "The election is closed and being tallied." let the = " The " let encrypted_tally = "encrypted tally" let hash_is = " hash is " let election_has_been_tallied = "This election has been tallied." let election_archived = "This election is archived." let number_accepted_ballots = "Number of accepted ballots: " let you_can_also_download = "You can also download the " let result_with_crypto_proofs = "result with cryptographic proofs" let blank_vote = "Blank vote" let no_other_blank = "No other choices are allowed when voting blank" let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Your password for election %s" let mail_password : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "You are listed as a voter for the election %s You will find below your login and password. To cast a vote, you will also need a credential, sent in a separate email. Be careful, passwords and credentials look similar but play different roles. You will be asked to enter your credential before entering the voting booth. Login and passwords are required once your ballot is ready to be cast. Username: %s Password: %s Page of the election: %s Note that you are allowed to vote several times. Only the last vote counts." let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Your credential for election %s" let mail_credential : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "You are listed as a voter for the election %s You will find below your login and credential. To cast a vote, you will also need a password, sent in a separate email. Be careful, passwords and credentials look similar but play different roles. You will be asked to enter your credential before entering the voting booth. Login and passwords are required once your ballot is ready to be cast. Username: %s Credential: %s Page of the election: %s Note that you are allowed to vote several times. Only the last vote counts." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Your vote for election %s" let mail_confirmation : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Dear %s, Your vote for election %s has been recorded. Your smart ballot tracker is %s You can check its presence in the ballot box, accessible at %s Results will be published on the election page %s -- \nBelenios" belenios-1.4+dfsg/src/web/web_l10n_en.mli000066400000000000000000000000461307140314400202320ustar00rootroot00000000000000include Web_i18n_sig.LocalizedStrings belenios-1.4+dfsg/src/web/web_l10n_fr.ml000066400000000000000000000205021307140314400200650ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let lang = "fr" let start = "Commencer" let advanced_mode = "Mode avancé" let see_accepted_ballots = "Voir les bulletins acceptés" let belenios_booth = "Isoloir Belenios" let here = "ici" let question_header = "Question %d/%d — sélectionnez entre %d et %d réponse(s)" let at_least = "Vous devez sélectionner au moins %d réponse(s)" let at_most = "Vous devez sélectionner au plus %d réponse(s)" let previous = "Précédent" let next = "Suivant" let nothing = "(rien)" let enter_cred = "Veuillez entrer votre code de vote :" let invalid_cred = "Code de vote invalide !" let input_credential = "Saisie du code de vote" let answer_to_questions = "Réponse aux questions" let review_and_encrypt = "Récapitulatif et chiffrement" let authenticate = "Authentification" let confirm = "Confirmation" let done_ = "Terminé" let booth_step1 = "Étape 1/6 : Saisie du code de vote" let booth_step2 = "Étape 2/6 : Réponse aux questions" let booth_step3 = "Étape 3/6 : Récapitulatif et chiffrement" let booth_step5 = "Étape 5/6 : Confirmation" let booth_step6 = "Étape 6/6 : " let input_your_credential = "Saisissez votre code de vote " let wait_while_encrypted = "Veuillez patienter, le chiffrement de votre bulletin est en cours..." let encrypting = "Chiffrement en cours..." let restart = "Recommencer" let successfully_encrypted = "Votre bulletin a été chiffré avec succès, " let not_cast_yet = "mais n'a pas encore été déposé dans l'urne" let qmark = " !" let your_tracker_is = "Votre numéro de suivi est " let we_invite_you_to_save_it = "Nous vous invitons à le sauvegarder afin de vérifier ultérieurement que votre vote est bien pris en compte" let continue = "Continuer" let election_uuid = "UUID de l'élection : " let election_fingerprint = "Empreinte de l'élection : " let i_am = "Je suis " let and_ = " et " let i_cast_my_vote = "je dépose mon bulletin dans l'urne" let please_login_to_confirm = "Veuillez vous connecter pour confirmer votre vote" let your_ballot_for = "Votre bulletin pour " let has_been_received = " a été reçu, mais pas encore pris en compte. " let nobody_can_see = "Note: votre bulletin est chiffré et personne ne peut voir son contenu." let go_back_to_election = "Retourner à la page d'accueil de l'élection" let has_been_accepted = " a été accepté." let you_can_check_its_presence = "Vous pouvez vérifier sa présence dans l'" let ballot_box = "urne" let anytime_during_the_election = " à tout moment pendant l'élection." let confirmation_email = " Un e-mail de confirmation vous a été envoyé." let thank_you_for_voting = "Merci pour votre participation !" let is_rejected_because = " est refusé, parce que " let fail = "ÉCHEC !" let administer_elections = "Administrer des élections" let administer_this_election = "Administrer cette élection" let powered_by = "Propulsé par " let get_the_source_code = "Obtenir le code source" let audit_data = "Données d'audit : " let parameters = "paramètres" let public_credentials = "clés de vérification" let trustee_public_keys = "clés publiques" let ballots = "bulletins" let election_server = "Serveur d'élections" let accepted_ballots = "Bulletins acceptés" let ballots_have_been_accepted_so_far = " bulletin(s) ont été accepté(s) jusqu'à présent." let ballots_have_been_accepted = " bulletin(s) ont été accepté(s)." let ballots_have_been_accepted_and = " bulletin(s) ont été accepté(s), et " let have_been_tallied = " ont été compté(s)." let username = "Nom d'utilisateur :" let password = "Mot de passe :" let login = "Se connecter" let password_login = "Connexion par mot de passe" let you_must_accept_cookies = "Pour utiliser ce site, vous devez accepter les cookies. " let accept = "Accepter" let not_yet_open = "Désolé, cette élection n'est pas encore ouverte" let come_back_later = "Cette élection n'existe pas encore. Veuillez revenir plus tard." let cookies_are_blocked = "Les cookies sont bloqués" let please_enable_them = "Votre navigateur semble bloquer les cookies. Veuillez les activer." let election_currently_closed = "Cette élection est actuellement fermée." let election_closed_being_tallied = "L'élection est fermée et en cours de dépouillement." let the = " L'empreinte du " let encrypted_tally = "résultat chiffré" let hash_is = " est " let election_has_been_tallied = "Cette élection a été dépouillée." let election_archived = "Cette élection est archivée." let number_accepted_ballots = "Nombre de bulletins acceptés : " let you_can_also_download = "Vous pouvez également télécharger le " let result_with_crypto_proofs = "résultat avec les preuves cryptographiques" let blank_vote = "Vote blanc" let no_other_blank = "Vous ne pouvez pas sélectionner d'autres choix lors d'un vote blanc" let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Votre mot de passe pour l'élection %s" let mail_password : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Vous êtes enregistré(e) en tant qu'électeur(trice) pour l'élection %s Veuillez trouver ci-dessous votre nom d'utilisateur et votre mot de passe. Pour soumettre un bulletin, vous aurez également besoin d'un code de vote, envoyé dans un e-mail séparé. Soyez attentif(ve), le mot de passe et le code de vote se ressemblent mais jouent des rôles différents. Le système vous demandera votre code de vote dès l'entrée dans l'isoloir virtuel. Le nom d'utilisateur et le mot de passe sont nécessaires lorsque votre bulletin est prêt à être soumis. Nom d'utilisateur : %s Mot de passe : %s Page de l'élection : %s Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est pris en compte." let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Votre code de vote pour l'élection %s" let mail_credential : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Vous êtes enregistré(e) en tant qu'électeur(trice) pour l'élection %s Veuillez trouver ci-dessous votre nom d'utilisateur et votre code de vote. Pour soumettre un bulletin, vous aurez également besoin d'un mot de passe, envoyé dans un e-mail séparé. Soyez attentif(ve), le mot de passe et le code de vote se ressemblent mais jouent des rôles différents. Le système vous demandera votre code de vote dès l'entrée dans l'isoloir virtuel. Le nom d'utilisateur et le mot de passe sont nécessaires lorsque votre bulletin est prêt à être soumis. Nom d'utilisateur : %s Code de vote : %s Page de l'élection : %s Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est pris en compte." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Votre vote pour l'élection %s" let mail_confirmation : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%s, Votre vote pour l'élection %s a été enregistré. Votre numéro de suivi est %s Vous pouvez vérifier sa présence dans l'urne, accessible au %s Les résultats seront publiés sur la page de l'élection %s -- \nBelenios" belenios-1.4+dfsg/src/web/web_l10n_fr.mli000066400000000000000000000000461307140314400202370ustar00rootroot00000000000000include Web_i18n_sig.LocalizedStrings belenios-1.4+dfsg/src/web/web_l10n_it.ml000066400000000000000000000203401307140314400200720ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2017 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let lang = "it" let start = "Cominciare" let advanced_mode = "Modo avanzato" let see_accepted_ballots = "Consultare le schede elettorali accettate" let belenios_booth = "Cabina elettorale Belenios" let here = "qui" let question_header = "Domanda %d/%d — selezionare tra %d e %d risposta(e)" let at_least = "Lei deve selezionare almeno %d risposta(e)" let at_most = "Lei deve selezionare al massimo %d risposta(e)" let previous = "Precedente" let next = "Seguente" let nothing = "(niente)" let enter_cred = "Si prega di inserire il codice di voto :" let invalid_cred = "Codice di voto non valido !" let input_credential = "Inserire il codice di voto" let answer_to_questions = "Risposta alle domande" let review_and_encrypt = "Riepilogo e cifratura" let authenticate = "Autenticazione" let confirm = "Conferma" let done_ = "Finito" let booth_step1 = "Fase 1/6 : Inserire il codice di voto" let booth_step2 = "Fase 2/6 : Risposta alle domande" let booth_step3 = "Fase 3/6 : Riepilogo e cifratura" let booth_step5 = "Fase 5/6 : Conferma" let booth_step6 = "Fase 6/6 : " let input_your_credential = "Inserisca il suo codice di voto " let wait_while_encrypted = "Si prega di pazientare, la cifratura della sua scheda elettorale è in corso..." let encrypting = "Cifratura in corso..." let restart = "Ricominciare" let successfully_encrypted = "La sua scheda elettorale è stata cifrata con successo, " let not_cast_yet = "ma non è stata ancora depositata nell'urna" let qmark = " !" let your_tracker_is = "Il suo codice di verifica è " let we_invite_you_to_save_it = "La preghiamo di registrarlo per potere verificare ulteriormente se il suo voto è stato preso in considerazione." let continue = "Proseguire" let election_uuid = "UUID dell'elezione : " let election_fingerprint = "Impronta dell'elezione : " let i_am = "Sono " let and_ = " e " let i_cast_my_vote = "depongo la mia scheda elettorale nell'urna" let please_login_to_confirm = "La preghiamo di connettersi per confermare il suo voto" let your_ballot_for = "La sua scheda elettorale per " let has_been_received = " è stata ricevuta, ma non è ancora presa in considerazione. " let nobody_can_see = "Nota: la sua scheda è cifrata e nessuno può consultarla." let go_back_to_election = "Tornare alla pagina iniziale dell'elezione" let has_been_accepted = " è stata accettata." let you_can_check_its_presence = "È possibile verificare la sua presenza nell'" let ballot_box = "urna" let anytime_during_the_election = " ad ogni momento durante l'elezione." let confirmation_email = " Le è stata spedita una email di conferma." let thank_you_for_voting = "La ringraziamo per la sua partecipazione !" let is_rejected_because = "è rifiutato, perché" let fail = "FALLIMENTO !" let administer_elections = "Amministrare delle elezioni" let administer_this_election = "Amministrare questa elezione" let powered_by = "Utilizza " let get_the_source_code = "Ottenere il codice sorgente" let audit_data = "Dati d'audit : " let parameters = "parametri" let public_credentials = "chiavi di verificazione" let trustee_public_keys = "chiavi pubbliche" let ballots = "schede elettorali" let election_server = "Server delle elezioni" let accepted_ballots = "Schede elettorali accettate" let ballots_have_been_accepted_so_far = " scheda(e) accettata(e) finora." let ballots_have_been_accepted = " scheda(e) accettata(e)." let ballots_have_been_accepted_and = " scheda(e) accettata(e), e" let have_been_tallied = " sono state contate" let username = "Nome utente :" let password = "Password :" let login = "Connettersi" let password_login = "Connessione tramite la password" let you_must_accept_cookies = "Per navigare sul sito, è necessario attivare i cookies. " let accept = "Accettare" let not_yet_open = "Spiacente, quest'elezione non è ancora aperta" let come_back_later = "Quest'elezione ancora non esiste. La preghiamo di consultare ulteriormente." let cookies_are_blocked = "I cookies sono bloccati" let please_enable_them = "Il suo browser non accetta i cookies. Si prega di attivarli." let election_currently_closed = "Questa elezione è chiusa per ora." let election_closed_being_tallied = "L'elezione è chiusa ed il conteggio è in corso." let the = " L'impronta del " let encrypted_tally = "risultato cifrato" let hash_is = " è " let election_has_been_tallied = "Questa elezione è stata conteggiata." let election_archived = "Questa elezione è archiviata." let number_accepted_ballots = "Numero di schede accettate : " let you_can_also_download = "È possibile scaricare il " let result_with_crypto_proofs = "risultato con le prove crittografiche" let blank_vote = "Scheda bianca" let no_other_blank = "Nessun'altra scelta è autorizzata quando la scheda è bianca" let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "La sua password per l'elezione %s" let mail_password : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Lei è registrato(a) in quanto elettore(trice) per l'elezione %s Si prega di trovare qui sotto il suo nome di utente e la sua password. Per presentare una scheda elettorale, avrà bisogno di un codice di voto, spedito in una email separata. Faccia attenzione, la password e il codice di voto sono simili ma hanno un ruolo diverso. Il sistema le domanderà il suo codice di voto non appena entrato(a) nella cabina elettorale virtuale. Il nome di utente e la password sono necessari quando la sua scheda è pronta per essere presentata. Nome utente : %s Password : %s Pagina dell'elezione : %s Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è preso in considerazione." let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Il suo codice di voto per l'elezione %s" let mail_credential : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Lei è registrato(a) in quanto elettore(trice) per l'elezione %s Si prega di trovare qui sotto il suo nome di utente e il suo codice di voto. Per presentare una scheda elettorale, avrà bisogno di una password, spedita in una email separata. Faccia attenzione, la password e il codice di voto sono simili ma hanno un ruolo diverso. Il sistema le domanderà il suo codice di voto non appena entrato(a) nella cabina elettorale virtuale. Il nome di utente e la password sono necessari quando la sua scheda è pronta per essere presentata. Nome utente : %s Codice di voto : %s Pagina dell'elezione : %s Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è preso in considerazione." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "La sua scheda per l'elezione %s" let mail_confirmation : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%s, La sua scheda per l'elezione %s è stata registrata. Il suo codice di verifica è %s Può verificare la sua presenza nell'urna, accessibile su %s I risultati saranno pubblicati sulla pagina dell'elezione %s -- \nBelenios" belenios-1.4+dfsg/src/web/web_l10n_it.mli000066400000000000000000000000461307140314400202440ustar00rootroot00000000000000include Web_i18n_sig.LocalizedStrings belenios-1.4+dfsg/src/web/web_l10n_ro.ml000066400000000000000000000202251307140314400201000ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) let lang = "ro" let start = "Start" let advanced_mode = "Mod avansat" let see_accepted_ballots = "Consultă buletinele de vot acceptate" let belenios_booth = "Cabina de vot Belenios" let here = "aici" let question_header = "Întrebarea #%d din %d — selectați între %d și %d rspuns(uri)" let at_least = "Trebuie să selectați cel puțin %d răspuns(uri)" let at_most = "Trebuie să selectați cel mult %d răspuns(uri)" let previous = "Precedent" let next = "Următor" let nothing = "(nimic)" let enter_cred = "Vă rugăm să introduceți codul de votare:" let invalid_cred = "Cod de votare invalid !" let input_credential = "Introdu codul de votare" let answer_to_questions = "Răspunde la întrebări" let review_and_encrypt = "Rezumat și criptare" let authenticate = "Autentificare" let confirm = "Confirmare" let done_ = "Terminare" let booth_step1 = "Pas 1/6: Introduceți codul de votare" let booth_step2 = "Pas 2/6: Răspunde la întrebări" let booth_step3 = "Pas 3/6: Rezumat și criptare" let booth_step5 = "Pas 5/6: Confirmare" let booth_step6 = "Pas 6/6: " let input_your_credential = "Introduceți codul vostru de votare " let wait_while_encrypted = "Vă rugăm să așteptați criptarea buletinului vostru de vot..." let encrypting = "Criptare în curs..." let restart = "Reîncepe" let successfully_encrypted = "Buletinul vostru de vot a fost criptat cu succes, " let not_cast_yet = "dar încă nu a fost depus în urna de vot" let qmark = "!" let your_tracker_is = "Numărul vostru de identificare este " let we_invite_you_to_save_it = "Vă invităm să-l salvați pentru a verifica ulterior că votul vostru este luat în considerare." let continue = "Continuă" let election_uuid = "Codul UUID al alegerii: " let election_fingerprint = "Amprenta digitală al alegerii: " let i_am = "Eu sunt " let and_ = " și " let i_cast_my_vote = "Am depus votul meu" let please_login_to_confirm = "Vă rugăm să vă logați pentru a confirma votul vostru." let your_ballot_for = "Buletinul de vot pentru " let has_been_received = " a fost primit, dar nu a fost încă înregistrat. " let nobody_can_see = "Notă: buletinul de vot este criptat și nimeni nu-i poate vedea conținutul." let go_back_to_election = "Întoarcete la pagina de start a alegerii" let has_been_accepted = " a fost acceptat." let you_can_check_its_presence = "Puteți verifica prezența în " let ballot_box = "urna de vot" let anytime_during_the_election = " în orice moment al alegerii." let confirmation_email = " Un e-mail de confirmare v-a fost trimis." let thank_you_for_voting = "Vă mulțumim pentru participare!" let is_rejected_because = " este resprins, deoarece " let fail = "EȘEC!" let administer_elections = "Administrează alegerile" let administer_this_election = "Administrează această alegere" let powered_by = "Realizat de " let get_the_source_code = "Obține codul sursă" let audit_data = "Date de audit: " let parameters = "parametrii" let public_credentials = "chei de verificare" let trustee_public_keys = "cheia publică" let ballots = "buletine de vot" let election_server = "Server al alegerii" let accepted_ballots = "Buletinele de vot acceptate" let ballots_have_been_accepted_so_far = " buletin(e) de vot au fost acceptat(e) până în prezent." let ballots_have_been_accepted = " buletin(e) de vot au fost acceptat(e)." let ballots_have_been_accepted_and = " buletin(e) de vot au fost acceptat(e), și " let have_been_tallied = " au fost contorizate." let username = "Nume utilizator:" let password = "Parola:" let login = "Conectare" let password_login = "Conectare folosind parola" let you_must_accept_cookies = "Pentru a utiliza acest site, trebuie să acceptați cookie-uri. " let accept = "Accept" let not_yet_open = "Din păcate, această alegere nu este încă deschisă" let come_back_later = "Acesta alegere nu există încă. Vă rugăm să reveniți mai târziu." let cookies_are_blocked = "Cookie-urile sunt blocate" let please_enable_them = "Browser-ul dumneavoastră pare să blocheze cookie-urile. Vă rugăm să le activați." let election_currently_closed = "Această alegere este în prezent închisă." let election_closed_being_tallied = "Această alegere este închisă și în curs de contorizare." let the = " Amprenta " let encrypted_tally = "rezultatului criptat" let hash_is = " este " let election_has_been_tallied = "Această alegere a fost contorizata." let election_archived = "Această alegere este arhivată." let number_accepted_ballots = "Numărul buletinelor de vot acceptate: " let you_can_also_download = "De asemenea, puteți descărca " let result_with_crypto_proofs = "rezultat cu dovada criptografică" let blank_vote = "Vot alb" let no_other_blank = "Nu puteți selecta o altă opțiune la un vot alb" let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Parola voastră pentru alegere %s" let mail_password : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Sunteți înregistrat(ă) ca votant(ă) pentru alegerea %s Mai jos veți găsi numele de utilizator și parola. Pentru a depune votul vostru, vă trebuie un cod de votare, ce va fi trimis într-un e-mail separat. Aveți grijă, parola și codul de votare arată similare, dar joacă roluri diferite. Sistemul va solicita codul de votare la intrarea în cabina de vot. Numele de utilizator și parola sunt necesare atunci când buletinul de vot este gata pentru depunere. Nume utilizator: %s Parola: %s Pagina alegerii: %s Rețineți că este posibil să votați de mai multe ori. Numai ultimul vot va fi luat în considerare." let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Codul vostru de votare pentru alegere %s" let mail_credential : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Sunteți înregistrat(ă) ca votant(ă) pentru alegerea %s Mai jos veți găsi numele de utilizator și codul de votare. Pentru a depune votul vostru, vă trebuie o parolă, ce va fi trimisă într-un e-mail separat. Aveți grijă, parola și codul de votare arată similare, dar joacă roluri diferite. Sistemul va solicita codul de votare la intrarea în cabina de vot. Numele de utilizator și parola sunt necesare atunci când buletinul de vot este gata pentru depunere. Nume utilizator: %s Cod de votare: %s Pagina alegerii: %s Rețineți că este posibil să votați de mai multe ori. Numai ultimul vot va fi luat în considerare." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Votul vostru pentru alegerea %s" let mail_confirmation : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%s, Votul vostru pentru alegerea %s a fost înregistrat. Numărul vostru de identificare este %s Puteți verifica prezența acestuia în urma de vot, accesibilă la %s Rezultatele vor fi publicate pe pagina de alegere %s -- \nBelenios" belenios-1.4+dfsg/src/web/web_l10n_ro.mli000066400000000000000000000000461307140314400202500ustar00rootroot00000000000000include Web_i18n_sig.LocalizedStrings belenios-1.4+dfsg/src/web/web_main.ml000066400000000000000000000070371307140314400175600ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Common open Web_serializable_j open Web_common (** Global initialization *) (* FIXME: the following should be in configuration file... but doesn't work *) let () = Ocsigen_config.set_maxrequestbodysizeinmemory 128000 let () = CalendarLib.Time_Zone.(change Local) (** Parse configuration from *) let spool_dir = ref None let source_file = ref None let auth_instances = ref [] let () = Eliom_config.get_config () |> let open Simplexmlparser in List.iter @@ function | PCData x -> Ocsigen_extensions.Configuration.ignore_blank_pcdata ~in_tag:"belenios" x | Element ("log", ["file", file], []) -> Lwt_main.run (open_security_log file) | Element ("source", ["file", file], []) -> source_file := Some file | Element ("maxmailsatonce", ["value", limit], []) -> Web_site.maxmailsatonce := int_of_string limit | Element ("spool", ["dir", dir], []) -> spool_dir := Some dir | Element ("rewrite-prefix", ["src", src; "dst", dst], []) -> set_rewrite_prefix ~src ~dst | Element ("auth", ["name", auth_instance], [Element (auth_system, auth_config, [])]) -> let i = {auth_system; auth_instance; auth_config} in auth_instances := i :: !auth_instances | Element (tag, _, _) -> Printf.ksprintf failwith "invalid configuration for tag %s in belenios" tag (** Parse configuration from other sources *) let file_exists x = try%lwt Lwt_unix.(access x [R_OK]) >> return true with _ -> return false let%lwt source_file = match !source_file with | Some f -> let%lwt b = file_exists f in if b then ( return f ) else ( Printf.ksprintf failwith "file %s does not exist" f ) | None -> failwith "missing in configuration" let spool_dir = match !spool_dir with | Some d -> d | None -> failwith "missing in configuration" (** Build up the site *) let () = Web_site.source_file := source_file let () = Web_common.spool_dir := spool_dir let () = Web_auth.configure (List.rev !auth_instances) belenios-1.4+dfsg/src/web/web_main.mli000066400000000000000000000000261307140314400177200ustar00rootroot00000000000000(* empty interface *) belenios-1.4+dfsg/src/web/web_persist.ml000066400000000000000000000145131307140314400203220ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Platform open Serializable_j open Common open Web_serializable_j open Web_common let ( / ) = Filename.concat let get_election_result uuid = try%lwt Lwt_io.chars_of_file (!spool_dir / uuid / "result.json") |> Lwt_stream.to_string >>= fun x -> return @@ Some (result_of_string (Yojson.Safe.from_lexbuf ~stream:true) x) with _ -> return_none type election_state = [ `Open | `Closed | `EncryptedTally of int * int * string | `Tallied of plaintext | `Archived ] let election_states = Ocsipersist.open_table "election_states" let get_election_state x = try%lwt Ocsipersist.find election_states x with Not_found -> return `Archived let set_election_state x s = Ocsipersist.add election_states x s let past = datetime_of_string "\"2015-10-01 00:00:00.000000\"" let set_election_date uuid d = let dates = { e_finalization = d } in Lwt_io.(with_file Output (!spool_dir / uuid / "dates.json") (fun oc -> write_line oc (string_of_election_dates dates) )) let get_election_date uuid = try%lwt Lwt_io.chars_of_file (!spool_dir / uuid / "dates.json") |> Lwt_stream.to_string >>= fun x -> let dates = election_dates_of_string x in return dates.e_finalization with _ -> return past let election_pds = Ocsipersist.open_table "election_pds" let get_partial_decryptions x = try%lwt Ocsipersist.find election_pds x with Not_found -> return [] let set_partial_decryptions x pds = Ocsipersist.add election_pds x pds let auth_configs = Ocsipersist.open_table "auth_configs" let get_auth_config x = try%lwt Ocsipersist.find auth_configs x with Not_found -> return [] let set_auth_config x c = Ocsipersist.add auth_configs x c let get_raw_election uuid = try%lwt let lines = Lwt_io.lines_of_file (!spool_dir / uuid / "election.json") in begin match%lwt Lwt_stream.to_list lines with | x :: _ -> return @@ Some x | [] -> return_none end with _ -> return_none let empty_metadata = { e_owner = None; e_auth_config = None; e_cred_authority = None; e_trustees = None; e_languages = None; } let return_empty_metadata = return empty_metadata let get_election_metadata uuid = try%lwt Lwt_io.chars_of_file (!spool_dir / uuid / "metadata.json") |> Lwt_stream.to_string >>= fun x -> return @@ metadata_of_string x with _ -> return_empty_metadata let get_elections_by_owner user = Lwt_unix.files_of_directory !spool_dir |> Lwt_stream.filter_s (fun x -> if x = "." || x = ".." then return false else let%lwt metadata = get_election_metadata x in match metadata.e_owner with | Some o -> return (o = user) | None -> return false ) |> Lwt_stream.to_list let get_voters uuid = try%lwt let lines = Lwt_io.lines_of_file (!spool_dir / uuid / "voters.txt") in let%lwt lines = Lwt_stream.to_list lines in return @@ Some lines with _ -> return_none let get_passwords uuid = let csv = try Some (Csv.load (!spool_dir / uuid / "passwords.csv")) with _ -> None in match csv with | None -> return_none | Some csv -> let res = List.fold_left (fun accu line -> match line with | [login; salt; hash] -> SMap.add login (salt, hash) accu | _ -> accu ) SMap.empty csv in return @@ Some res let get_public_keys uuid = try%lwt let lines = Lwt_io.lines_of_file (!spool_dir / uuid / "public_keys.jsons") in let%lwt lines = Lwt_stream.to_list lines in return @@ Some lines with _ -> return_none module Ballots = Map.Make (String) module BallotsCacheTypes = struct type key = string type value = string Ballots.t end module BallotsCache = Ocsigen_cache.Make (BallotsCacheTypes) let raw_get_ballots_archived uuid = try%lwt let ballots = Lwt_io.lines_of_file (!spool_dir / uuid / "ballots.jsons") in Lwt_stream.fold (fun b accu -> let hash = sha256_b64 b in Ballots.add hash b accu ) ballots Ballots.empty with _ -> return Ballots.empty let archived_ballots_cache = new BallotsCache.cache raw_get_ballots_archived 10 let get_ballot_hashes ~uuid = match%lwt get_election_state uuid with | `Archived -> let%lwt ballots = archived_ballots_cache#find uuid in Ballots.bindings ballots |> List.map fst |> return | _ -> let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in Ocsipersist.fold_step (fun hash _ accu -> return (hash :: accu) ) table [] >>= (fun x -> return @@ List.rev x) let get_ballot_by_hash ~uuid ~hash = match%lwt get_election_state uuid with | `Archived -> let%lwt ballots = archived_ballots_cache#find uuid in (try Some (Ballots.find hash ballots) with Not_found -> None) |> return | _ -> let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in try%lwt Ocsipersist.find table hash >>= (fun x -> return @@ Some x) with Not_found -> return_none belenios-1.4+dfsg/src/web/web_persist.mli000066400000000000000000000053671307140314400205020ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Serializable_t open Common open Web_serializable_t type election_state = [ `Open | `Closed | `EncryptedTally of int * int * string | `Tallied of plaintext | `Archived ] val get_election_state : string -> election_state Lwt.t val set_election_state : string -> election_state -> unit Lwt.t val get_election_date : string -> datetime Lwt.t val set_election_date : string -> datetime -> unit Lwt.t val get_partial_decryptions : string -> (int * string) list Lwt.t val set_partial_decryptions : string -> (int * string) list -> unit Lwt.t val get_auth_config : string -> (string * (string * string list)) list Lwt.t val set_auth_config : string -> (string * (string * string list)) list -> unit Lwt.t val get_raw_election : string -> string option Lwt.t val get_election_metadata : string -> metadata Lwt.t val get_election_result : string -> Yojson.Safe.json result option Lwt.t val get_elections_by_owner : user -> string list Lwt.t val get_voters : string -> string list option Lwt.t val get_passwords : string -> (string * string) SMap.t option Lwt.t val get_public_keys : string -> string list option Lwt.t val get_ballot_hashes : uuid:string -> string list Lwt.t val get_ballot_by_hash : uuid:string -> hash:string -> string option Lwt.t belenios-1.4+dfsg/src/web/web_serializable.atd000066400000000000000000000067301307140314400214410ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) (** {1 Predefined types} *) type uuid = abstract type string_set = abstract type datetime = abstract type template = abstract (** {1 Web-specific types} *) type randomness = { randomness : string; } type user = { domain : string; name : string; } type auth_config = { auth_system : string; auth_instance : string; auth_config : (string * string) list; } type metadata = { ?owner: user option; ?auth_config: auth_config list option; ?cred_authority : string option; ?trustees : string list option; ?languages : string list option; } type election_dates = { finalization : datetime; } (** {1 Types related to elections being prepared} *) type setup_voter = { id : string; ?password : (string * string) option; } type setup_trustee = { id : string; token : string; public_key : string; } type setup_election = { owner : user; group : string; voters : setup_voter list; questions : template; public_keys : setup_trustee list; metadata : metadata; public_creds : string; public_creds_received : bool; } (** {1 OpenID Connect-related types} *) type oidc_configuration = { authorization_endpoint : string; token_endpoint : string; userinfo_endpoint : string; } type oidc_tokens = { access_token : string; token_type : string; id_token : string; } type oidc_userinfo = { sub : string; ?email : string option; } belenios-1.4+dfsg/src/web/web_serializable_builtin_j.ml000066400000000000000000000037131307140314400233360ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Web_serializable_builtin_t (** {1 Serializers for type datetime} *) let write_datetime buf n = Bi_outbuf.add_char buf '"'; Bi_outbuf.add_string buf (raw_string_of_datetime n); Bi_outbuf.add_char buf '"' let datetime_of_json = function | `String s -> raw_datetime_of_string s | _ -> invalid_arg "datetime_of_json: a string was expected" let read_datetime state buf = datetime_of_json (Yojson.Safe.from_lexbuf ~stream:true state buf) belenios-1.4+dfsg/src/web/web_serializable_builtin_j.mli000066400000000000000000000033171307140314400235070ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Web_serializable_builtin_t (** {1 Serializers for type datetime} *) val write_datetime : Bi_outbuf.t -> datetime -> unit val read_datetime : Yojson.Safe.lexer_state -> Lexing.lexbuf -> datetime belenios-1.4+dfsg/src/web/web_serializable_builtin_t.ml000066400000000000000000000050211307140314400233420ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open CalendarLib let datetime_format = "%Y-%m-%d %H:%M:%S" type datetime = Fcalendar.Precise.t * string option let now () = CalendarLib.Fcalendar.Precise.now (), None let raw_string_of_datetime (n, s) = match s with | Some s -> s | None -> let n = Fcalendar.Precise.to_gmt n in let a = Printer.Precise_Fcalendar.sprint datetime_format n in let ts = Printf.sprintf "%.6f" (Fcalendar.Precise.to_unixfloat n) in let i = String.index ts '.' in let b = String.sub ts i (String.length ts - i) in a ^ b let raw_datetime_of_string s = let i = String.index s '.' in let l = Printer.Precise_Fcalendar.from_fstring datetime_format (String.sub s 0 i) in let l = Fcalendar.Precise.from_gmt l in let r = float_of_string ("0" ^ String.sub s i (String.length s-i)) in (Fcalendar.Precise.add l (Fcalendar.Precise.Period.second r), Some s) let datetime_compare (a, _) (b, _) = CalendarLib.Fcalendar.Precise.compare a b let format_datetime fmt (a, _) = CalendarLib.Printer.Precise_Fcalendar.sprint fmt a belenios-1.4+dfsg/src/web/web_serializable_builtin_t.mli000066400000000000000000000033651307140314400235240ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) type datetime val now : unit -> datetime val raw_string_of_datetime : datetime -> string val raw_datetime_of_string : string -> datetime val datetime_compare : datetime -> datetime -> int val format_datetime : string -> datetime -> string belenios-1.4+dfsg/src/web/web_services.ml000066400000000000000000000200301307140314400204430ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Eliom_service open Eliom_service.Http open Eliom_parameter open Web_common let home = service ~path:[""] ~get_params:unit () let admin = service ~path:["admin"] ~get_params:unit () let site_login = service ~path:["login"] ~get_params:(opt (string "service")) () let logout = service ~path:["logout"] ~get_params:unit () let source_code = service ~path:["belenios.tar.gz"] ~get_params:unit () let get_randomness = service ~path:["get-randomness"] ~get_params:unit () let tool = preapply (static_dir ()) ["static"; "belenios-tool.html"] let election_setup_new = post_coservice ~csrf_safe:true ~fallback:admin ~post_params:(radio string "credmgmt" ** radio string "auth" ** string "cas_server") () let election_setup_pre = service ~path:["setup"; "new"] ~get_params:unit () let election_setup = service ~path:["setup"; "election"] ~get_params:(uuid "uuid") () let election_setup_questions = service ~path:["setup"; "questions"] ~get_params:(uuid "uuid") () let election_setup_questions_post = post_coservice ~fallback:election_setup_questions ~post_params:(string "questions") () let election_setup_description = post_coservice ~fallback:election_setup ~post_params:(string "name" ** string "description") () let election_setup_languages = post_coservice ~fallback:election_setup ~post_params:(string "languages") () let election_setup_voters = service ~path:["setup"; "voters"] ~get_params:(uuid "uuid") () let election_setup_voters_add = post_service ~fallback:election_setup_voters ~post_params:(string "voters") () let election_setup_voters_remove = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") () let election_setup_voters_passwd = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") () let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:(string "id") () let election_setup_trustee_del = post_coservice ~fallback:election_setup ~post_params:(int "index") () let election_setup_credential_authority = service ~path:["setup"; "credential-authority"] ~get_params:(uuid "uuid") () let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") () let election_setup_credentials_download = service ~path:["setup"; "public_creds.txt"] ~get_params:(string "token") () let election_setup_credentials_post = post_coservice ~fallback:election_setup_credentials ~post_params:(string "public_creds") () let election_setup_credentials_post_file = post_coservice ~fallback:election_setup_credentials ~post_params:(file "public_creds") () let election_setup_credentials_server = post_coservice ~fallback:election_setup ~post_params:unit () let election_setup_trustees = service ~path:["setup"; "trustees"] ~get_params:(uuid "uuid") () let election_setup_trustee = service ~path:["setup"; "trustee"] ~get_params:(string "token") () let election_setup_trustee_post = post_coservice ~fallback:election_setup_trustee ~post_params:(string "public_key") () let election_setup_confirm = service ~path:["setup"; "confirm"] ~get_params:(uuid "uuid") () let election_setup_create = post_coservice ~csrf_safe:true ~fallback:election_setup ~post_params:unit () let election_setup_auth_genpwd = post_coservice ~fallback:election_setup ~post_params:unit () let election_setup_import = service ~path:["setup"; "import"] ~get_params:(uuid "uuid") () let election_setup_import_post = post_coservice ~fallback:election_setup_import ~post_params:(uuid "from") () let election_setup_import_trustees = service ~path:["setup"; "import-trustees"] ~get_params:(uuid "uuid") () let election_setup_import_trustees_post = post_coservice ~fallback:election_setup_import_trustees ~post_params:(uuid "from") () let election_home = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "")) () let set_cookie_disclaimer = coservice' ~get_params:unit () let election_admin = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "admin")) () let election_regenpwd = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "regenpwd")) () let election_regenpwd_post = post_coservice ~fallback:election_regenpwd ~post_params:(string "user") () let election_login = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "login") (opt (string "service"))) () let election_open = post_coservice ~fallback:election_admin ~post_params:unit () let election_close = post_coservice ~fallback:election_admin ~post_params:unit () let election_archive = post_coservice ~fallback:election_admin ~post_params:unit () let election_update_credential = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred")) () let election_update_credential_post = post_service ~fallback:election_update_credential ~post_params:(string "old_credential" ** string "new_credential") () let election_vote = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "vote")) () let election_cast = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "cast")) () let election_cast_post = post_service ~fallback:election_cast ~post_params:(opt (string "encrypted_vote") ** opt (file "encrypted_vote_file")) () let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit () let election_pretty_ballots = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "ballots")) () let election_pretty_ballot = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballot") (string "hash")) () let election_pretty_records = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "pretty-records")) () let election_missing_voters = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "missing")) () let election_compute_encrypted_tally = post_coservice ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_tally_trustees = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** int "trustee_id")) () let election_tally_trustees_post = post_service ~fallback:election_tally_trustees ~post_params:(string "partial_decryption") () let election_tally_release = post_service ~fallback:election_admin ~post_params:unit () let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) () let dummy_post = post_coservice' ~post_params:(string "username") () let password_post = post_coservice' ~post_params:(string "username" ** string "password") () let set_language = coservice' ~get_params:(string "lang") () belenios-1.4+dfsg/src/web/web_signatures.mli000066400000000000000000000060351307140314400211660ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Signatures open Web_serializable_t module type AUTH_SERVICES = sig val get_auth_systems : unit -> string list Lwt.t val get_user : unit -> user option Lwt.t end module type AUTH_LINKS = sig val login : string option -> (unit, unit, [< Eliom_service.service_method > `Get ], [< Eliom_service.attached > `Attached ], [< Eliom_service.service_kind > `Service ], [ `WithoutSuffix ], unit, unit, [< Eliom_service.registrable > `Unregistrable ], [> Eliom_service.http_service ]) Eliom_service.service val logout : (unit, unit, [< Eliom_service.service_method > `Get ], [< Eliom_service.attached > `Attached ], [< Eliom_service.service_kind > `Service ], [ `WithoutSuffix ], unit, unit, [< Eliom_service.registrable > `Unregistrable ], [> Eliom_service.http_service ]) Eliom_service.service end type content = Eliom_registration.browser_content Eliom_registration.kind Lwt.t module type WEB_BALLOT_BOX = sig val cast : string -> user * datetime -> string Lwt.t val inject_cred : string -> unit Lwt.t val update_files : unit -> unit Lwt.t val update_cred : old:string -> new_:string -> unit Lwt.t val compute_encrypted_tally : unit -> (int * string * string) Lwt.t (** Computes and writes to disk the encrypted tally. Returns the number of ballots and the hash of the encrypted tally. *) end module type WEB_ELECTION = sig module G : GROUP module E : ELECTION with type elt = G.t and type 'a m = 'a Lwt.t module B : WEB_BALLOT_BOX end belenios-1.4+dfsg/src/web/web_site.ml000066400000000000000000001550561307140314400176050ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Platform open Serializable_j open Signatures open Common open Web_serializable_builtin_t open Web_serializable_j open Web_common open Web_services let source_file = ref "belenios.tar.gz" let maxmailsatonce = ref 1000 let ( / ) = Filename.concat module PString = String open Eliom_service open Eliom_registration module LwtRandom = MakeLwtRandom (struct let rng = make_rng () end) (* Table with elections in setup mode. *) let election_stable = Ocsipersist.open_table "site_setup" (* Table with tokens given to trustees. *) let election_pktokens = Ocsipersist.open_table "site_pktokens" (* Table with tokens given to credential authorities. *) let election_credtokens = Ocsipersist.open_table "site_credtokens" module T = Web_templates let raw_find_election uuid = let%lwt raw_election = Web_persist.get_raw_election uuid in match raw_election with | Some raw_election -> return (Group.election_params_of_string raw_election) | _ -> Lwt.fail Not_found module WCacheTypes = struct type key = string type value = (module ELECTION_DATA) end module WCache = Ocsigen_cache.Make (WCacheTypes) let find_election = let cache = new WCache.cache raw_find_election 100 in fun x -> cache#find x let get_setup_election uuid_s = let%lwt se = Ocsipersist.find election_stable uuid_s in return (setup_election_of_string se) let set_setup_election uuid_s se = Ocsipersist.add election_stable uuid_s (string_of_setup_election se) let dump_passwords dir table = Lwt_io.(with_file Output (dir / "passwords.csv") (fun oc -> Ocsipersist.iter_step (fun voter (salt, hashed) -> write_line oc (voter ^ "," ^ salt ^ "," ^ hashed) ) table )) let finalize_election uuid se = let uuid_s = Uuidm.to_string uuid in (* voters *) let () = if se.se_voters = [] then failwith "no voters" in (* passwords *) let () = match se.se_metadata.e_auth_config with | Some [{auth_system = "password"; _}] -> if not @@ List.for_all (fun v -> v.sv_password <> None) se.se_voters then failwith "some passwords are missing" | _ -> () in (* credentials *) let () = if not se.se_public_creds_received then failwith "public credentials are missing" in (* trustees *) let group = Group.of_string se.se_group in let module G = (val group : GROUP) in let module KG = Election.MakeSimpleDistKeyGen (G) (LwtRandom) in let%lwt trustees, public_keys, private_key = match se.se_public_keys with | [] -> let%lwt private_key, public_key = KG.generate_and_prove () in return (None, [public_key], Some private_key) | _ :: _ -> return ( Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys), (List.map (fun {st_public_key; _} -> if st_public_key = "" then failwith "some public keys are missing"; trustee_public_key_of_string G.read st_public_key ) se.se_public_keys), None) in let y = KG.combine (Array.of_list public_keys) in (* election parameters *) let metadata = { se.se_metadata with e_trustees = trustees } in let template = se.se_questions in let params = { e_description = template.t_description; e_name = template.t_name; e_public_key = {wpk_group = G.group; wpk_y = y}; e_questions = template.t_questions; e_uuid = uuid; } in let raw_election = string_of_params (write_wrapped_pubkey G.write_group G.write) params in (* write election files to disk *) let dir = !spool_dir / uuid_s in let create_file fname what xs = Lwt_io.with_file ~flags:(Unix.([O_WRONLY; O_NONBLOCK; O_CREAT; O_TRUNC])) ~perm:0o600 ~mode:Lwt_io.Output (dir / fname) (fun oc -> Lwt_list.iter_s (fun v -> Lwt_io.write oc (what v) >> Lwt_io.write oc "\n") xs) in Lwt_unix.mkdir dir 0o700 >> create_file "public_keys.jsons" (string_of_trustee_public_key G.write) public_keys >> create_file "voters.txt" (fun x -> x.sv_id) se.se_voters >> create_file "metadata.json" string_of_metadata [metadata] >> create_file "election.json" (fun x -> x) [raw_election] >> (* construct Web_election instance *) let election = Group.election_params_of_string raw_election in let module W = Web_election.Make ((val election)) (LwtRandom) in (* set up authentication *) let%lwt () = match metadata.e_auth_config with | None -> return () | Some xs -> let auth_config = List.map (fun {auth_system; auth_instance; auth_config} -> auth_instance, (auth_system, List.map snd auth_config) ) xs in Web_persist.set_auth_config uuid_s auth_config in (* inject credentials *) let%lwt () = let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in Lwt_io.lines_of_file fname |> Lwt_stream.iter_s W.B.inject_cred >> W.B.update_files () >> Lwt_unix.unlink fname in (* create file with private key, if any *) let%lwt () = match private_key with | None -> return_unit | Some x -> create_file "private_key.json" string_of_number [x] in (* clean up setup database *) Ocsipersist.remove election_credtokens se.se_public_creds >> Lwt_list.iter_s (fun {st_token; _} -> Ocsipersist.remove election_pktokens st_token) se.se_public_keys >> Ocsipersist.remove election_stable uuid_s >> (* inject passwords *) (match metadata.e_auth_config with | Some [{auth_system = "password"; _}] -> let table = "password_" ^ underscorize uuid_s in let table = Ocsipersist.open_table table in Lwt_list.iter_s (fun v -> let _, login = split_identity v.sv_id in match v.sv_password with | Some x -> Ocsipersist.add table login x | None -> return_unit ) se.se_voters >> dump_passwords (!spool_dir / uuid_s) table | _ -> return_unit) >> (* finish *) Web_persist.set_election_state uuid_s `Open >> Web_persist.set_election_date uuid_s (now ()) let cleanup_table ?uuid_s table = let table = Ocsipersist.open_table table in match uuid_s with | None -> let%lwt indexes = Ocsipersist.fold_step (fun k _ accu -> return (k :: accu)) table [] in Lwt_list.iter_s (Ocsipersist.remove table) indexes | Some u -> Ocsipersist.remove table u let cleanup_file f = try%lwt Lwt_unix.unlink f with _ -> return_unit let archive_election uuid_s = let uuid_u = underscorize uuid_s in let%lwt () = cleanup_table ~uuid_s "election_states" in let%lwt () = cleanup_table ~uuid_s "election_pds" in let%lwt () = cleanup_table ~uuid_s "auth_configs" in let%lwt () = cleanup_table ("password_" ^ uuid_u) in let%lwt () = cleanup_table ("records_" ^ uuid_u) in let%lwt () = cleanup_table ("creds_" ^ uuid_u) in let%lwt () = cleanup_table ("ballots_" ^ uuid_u) in let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_key.json") in return_unit let () = Any.register ~service:home (fun () () -> Eliom_reference.unset Web_state.cont >> Redirection.send admin ) let get_finalized_elections_by_owner u = let%lwt elections, tallied, archived = Web_persist.get_elections_by_owner u >>= Lwt_list.fold_left_s (fun accu uuid_s -> let%lwt w = find_election uuid_s in let%lwt state = Web_persist.get_election_state uuid_s in let%lwt date = Web_persist.get_election_date uuid_s in let elections, tallied, archived = accu in match state with | `Tallied _ -> return (elections, (date, w) :: tallied, archived) | `Archived -> return (elections, tallied, (date, w) :: archived) | _ -> return ((date, w) :: elections, tallied, archived) ) ([], [], []) in let sort l = List.sort (fun (x, _) (y, _) -> datetime_compare x y) l |> List.map (fun (_, x) -> x) in return (sort elections, sort tallied, sort archived) let () = Html5.register ~service:admin (fun () () -> let cont () = Redirection.send admin in Eliom_reference.set Web_state.cont [cont] >> let%lwt site_user = Web_state.get_site_user () in let%lwt elections = match site_user with | None -> return None | Some u -> let%lwt elections, tallied, archived = get_finalized_elections_by_owner u in let%lwt setup_elections = Ocsipersist.fold_step (fun k v accu -> let v = setup_election_of_string v in if v.se_owner = u then return ((uuid_of_string k, v.se_questions.t_name) :: accu) else return accu ) election_stable [] in return @@ Some (elections, tallied, archived, setup_elections) in T.admin ~elections () ) let () = File.register ~service:source_code ~content_type:"application/x-gzip" (fun () () -> return !source_file) let do_get_randomness = let prng = Lazy.from_fun (Lwt_preemptive.detach (fun () -> pseudo_rng (random_string secure_rng 16) )) in let mutex = Lwt_mutex.create () in fun () -> Lwt_mutex.with_lock mutex (fun () -> let%lwt prng = Lazy.force prng in return (random_string prng 32) ) let b64_encode_compact x = Cryptokit.(transform_string (Base64.encode_compact ()) x) let () = String.register ~service:get_randomness (fun () () -> let%lwt r = do_get_randomness () in b64_encode_compact r |> (fun x -> string_of_randomness { randomness=x }) |> (fun x -> return (x, "application/json")) ) let generate_uuid = Uuidm.v4_gen (Random.State.make_self_init ()) let create_new_election owner cred auth = let e_cred_authority = match cred with | `Automatic -> Some "server" | `Manual -> None in let e_auth_config = match auth with | `Password -> Some [{auth_system = "password"; auth_instance = "password"; auth_config = []}] | `Dummy -> Some [{auth_system = "dummy"; auth_instance = "dummy"; auth_config = []}] | `CAS server -> Some [{auth_system = "cas"; auth_instance = "cas"; auth_config = ["server", server]}] in let uuid = generate_uuid () in let uuid_s = Uuidm.to_string uuid in let%lwt token = generate_token () in let se_metadata = { e_owner = Some owner; e_auth_config; e_cred_authority; e_trustees = None; e_languages = Some ["en"; "fr"]; } in let question = { q_answers = [| "Answer 1"; "Answer 2"; "Blank" |]; q_blank = None; q_min = 1; q_max = 1; q_question = "Question 1?"; } in let se_questions = { t_description = "Description of the election."; t_name = "Name of the election"; t_questions = [| question |]; } in let se = { se_owner = owner; se_group = "{\"g\":\"2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627\",\"p\":\"20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719\",\"q\":\"78571733251071885079927659812671450121821421258408794611510081919805623223441\"}"; (* generated by fips.sage *) se_voters = []; se_questions; se_public_keys = []; se_metadata; se_public_creds = token; se_public_creds_received = false; } in let%lwt () = set_setup_election uuid_s se in let%lwt () = Ocsipersist.add election_credtokens token uuid_s in return (preapply election_setup uuid) let () = Html5.register ~service:election_setup_pre (fun () () -> T.election_setup_pre ()) let () = Redirection.register ~service:election_setup_new (fun () (credmgmt, (auth, cas_server)) -> match%lwt Web_state.get_site_user () with | Some u -> let%lwt credmgmt = match credmgmt with | Some "auto" -> return `Automatic | Some "manual" -> return `Manual | _ -> fail_http 400 in let%lwt auth = match auth with | Some "password" -> return `Password | Some "dummy" -> return `Dummy | Some "cas" -> return @@ `CAS cas_server | _ -> fail_http 400 in create_new_election u credmgmt auth | None -> forbidden ()) let generic_setup_page f uuid () = match%lwt Web_state.get_site_user () with | Some u -> let uuid_s = Uuidm.to_string uuid in let%lwt se = get_setup_election uuid_s in if se.se_owner = u then f uuid se () else forbidden () | None -> forbidden () let () = Html5.register ~service:election_setup (generic_setup_page T.election_setup) let () = Html5.register ~service:election_setup_trustees (generic_setup_page T.election_setup_trustees) let () = Html5.register ~service:election_setup_credential_authority (generic_setup_page T.election_setup_credential_authority) let election_setup_mutex = Lwt_mutex.create () let handle_setup f uuid x = match%lwt Web_state.get_site_user () with | Some u -> let uuid_s = Uuidm.to_string uuid in Lwt_mutex.with_lock election_setup_mutex (fun () -> let%lwt se = get_setup_election uuid_s in if se.se_owner = u then ( try%lwt let%lwt cont = f se x u uuid in set_setup_election uuid_s se >> cont () with e -> let service = preapply election_setup uuid in T.generic_page ~title:"Error" ~service (Printexc.to_string e) () >>= Html5.send ) else forbidden () ) | None -> forbidden () let redir_preapply s u () = Redirection.send (preapply s u) let () = Any.register ~service:election_setup_languages (handle_setup (fun se languages _ uuid -> let langs = languages_of_string languages in match langs with | None -> assert false | Some [] -> return (fun () -> let service = preapply election_setup uuid in T.generic_page ~title:"Error" ~service "You must select at least one language!" () >>= Html5.send ) | Some ls -> let unavailable = List.filter (fun x -> not (List.mem x available_languages) ) ls in match unavailable with | [] -> se.se_metadata <- { se.se_metadata with e_languages = langs }; return (redir_preapply election_setup uuid) | l :: _ -> return (fun () -> let service = preapply election_setup uuid in T.generic_page ~title:"Error" ~service ("No such language: " ^ l) () >>= Html5.send ) )) let () = Any.register ~service:election_setup_description (handle_setup (fun se (name, description) _ uuid -> se.se_questions <- {se.se_questions with t_name = name; t_description = description; }; return (redir_preapply election_setup uuid))) let generate_password langs title url id = let email, login = split_identity id in let%lwt salt = generate_token () in let%lwt password = generate_token () in let hashed = sha256_hex (salt ^ password) in let bodies = List.map (fun lang -> let module L = (val Web_i18n.get_lang lang) in Printf.sprintf L.mail_password title login password url ) langs in let body = PString.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \nBelenios" in let subject = let lang = List.hd langs in let module L = (val Web_i18n.get_lang lang) in Printf.sprintf L.mail_password_subject title in send_email email subject body >> return (salt, hashed) let handle_password se uuid ~force voters = if List.length voters > !maxmailsatonce then Lwt.fail (Failure (Printf.sprintf "Cannot send passwords, there are too many voters (max is %d)" !maxmailsatonce)) else let title = se.se_questions.t_name in let url = Eliom_uri.make_string_uri ~absolute:true ~service:election_home (uuid, ()) |> rewrite_prefix in let langs = get_languages se.se_metadata.e_languages in Lwt_list.iter_s (fun id -> match id.sv_password with | Some _ when not force -> return_unit | None | Some _ -> let%lwt x = generate_password langs title url id.sv_id in return (id.sv_password <- Some x) ) voters >> return (fun () -> let service = preapply election_setup uuid in T.generic_page ~title:"Success" ~service "Passwords have been generated and mailed!" () >>= Html5.send) let () = Any.register ~service:election_setup_auth_genpwd (handle_setup (fun se () _ uuid -> handle_password se uuid ~force:false se.se_voters)) let () = Any.register ~service:election_regenpwd (fun (uuid, ()) () -> T.regenpwd uuid () >>= Html5.send) let () = Any.register ~service:election_regenpwd_post (fun (uuid, ()) user -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let%lwt site_user = Web_state.get_site_user () in match site_user with | Some u when metadata.e_owner = Some u -> let table = "password_" ^ underscorize uuid_s in let table = Ocsipersist.open_table table in let title = W.election.e_params.e_name in let url = Eliom_uri.make_string_uri ~absolute:true ~service:election_home (uuid, ()) |> rewrite_prefix in let service = preapply election_admin (uuid, ()) in begin try%lwt let%lwt _ = Ocsipersist.find table user in let langs = get_languages metadata.e_languages in let%lwt x = generate_password langs title url user in Ocsipersist.add table user x >> dump_passwords (!spool_dir / uuid_s) table >> T.generic_page ~title:"Success" ~service ("A new password has been mailed to " ^ user ^ ".") () >>= Html5.send with Not_found -> T.generic_page ~title:"Error" ~service (user ^ " is not a registered user for this election.") () >>= Html5.send end | _ -> forbidden () ) let () = Html5.register ~service:election_setup_questions (fun uuid () -> match%lwt Web_state.get_site_user () with | Some u -> let uuid_s = Uuidm.to_string uuid in let%lwt se = get_setup_election uuid_s in if se.se_owner = u then T.election_setup_questions uuid se () else forbidden () | None -> forbidden () ) let () = Any.register ~service:election_setup_questions_post (handle_setup (fun se x _ uuid -> se.se_questions <- template_of_string x; return (redir_preapply election_setup uuid))) let () = Html5.register ~service:election_setup_voters (fun uuid () -> match%lwt Web_state.get_site_user () with | Some u -> let uuid_s = Uuidm.to_string uuid in let%lwt se = get_setup_election uuid_s in if se.se_owner = u then T.election_setup_voters uuid se !maxmailsatonce () else forbidden () | None -> forbidden () ) (* see http://www.regular-expressions.info/email.html *) let identity_rex = Pcre.regexp ~flags:[`CASELESS] "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,7}(,[A-Z0-9._%+-]+)?$" let is_identity x = try ignore (Pcre.pcre_exec ~rex:identity_rex x); true with Not_found -> false let email_rex = Pcre.regexp ~flags:[`CASELESS] "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,7}$" let is_email x = try ignore (Pcre.pcre_exec ~rex:email_rex x); true with Not_found -> false module SSet = Set.Make (PString) let merge_voters a b f = let existing = List.fold_left (fun accu sv -> SSet.add sv.sv_id accu ) SSet.empty a in let _, res = List.fold_left (fun (existing, accu) sv_id -> if SSet.mem sv_id existing then (existing, accu) else (SSet.add sv_id existing, {sv_id; sv_password = f sv_id} :: accu) ) (existing, List.rev a) b in List.rev res let () = Any.register ~service:election_setup_voters_add (handle_setup (fun se x _ uuid -> if se.se_public_creds_received then forbidden () else ( let xs = Pcre.split x in let () = try let bad = List.find (fun x -> not (is_identity x)) xs in Printf.ksprintf failwith "%S is not a valid identity" bad with Not_found -> () in se.se_voters <- merge_voters se.se_voters xs (fun _ -> None); return (redir_preapply election_setup_voters uuid)))) let () = Any.register ~service:election_setup_voters_remove (handle_setup (fun se voter _ uuid -> if se.se_public_creds_received then forbidden () else ( se.se_voters <- List.filter (fun v -> v.sv_id <> voter ) se.se_voters; return (redir_preapply election_setup_voters uuid)))) let () = Any.register ~service:election_setup_voters_passwd (handle_setup (fun se voter _ uuid -> let voter = List.filter (fun v -> v.sv_id = voter) se.se_voters in handle_password se uuid ~force:true voter)) let () = Any.register ~service:election_setup_trustee_add (fun uuid st_id -> if is_email st_id then match%lwt Web_state.get_site_user () with | Some u -> let uuid_s = Uuidm.to_string uuid in Lwt_mutex.with_lock election_setup_mutex (fun () -> let%lwt se = get_setup_election uuid_s in if se.se_owner = u then ( let%lwt st_token = generate_token () in let trustee = {st_id; st_token; st_public_key = ""} in se.se_public_keys <- se.se_public_keys @ [trustee]; set_setup_election uuid_s se >> Ocsipersist.add election_pktokens st_token uuid_s ) else forbidden () ) >> Redirection.send (preapply election_setup_trustees uuid) | None -> forbidden () else let msg = st_id ^ " is not a valid e-mail address!" in let service = preapply election_setup_trustees uuid in T.generic_page ~title:"Error" ~service msg () >>= Html5.send ) let () = Redirection.register ~service:election_setup_trustee_del (fun uuid index -> match%lwt Web_state.get_site_user () with | Some u -> let uuid_s = Uuidm.to_string uuid in Lwt_mutex.with_lock election_setup_mutex (fun () -> let%lwt se = get_setup_election uuid_s in if se.se_owner = u then ( let trustees, old = se.se_public_keys |> List.mapi (fun i x -> i, x) |> List.partition (fun (i, _) -> i <> index) |> (fun (x, y) -> List.map snd x, List.map snd y) in se.se_public_keys <- trustees; set_setup_election uuid_s se >> Lwt_list.iter_s (fun {st_token; _} -> Ocsipersist.remove election_pktokens st_token ) old ) else forbidden () ) >> return (preapply election_setup_trustees uuid) | None -> forbidden () ) let () = Html5.register ~service:election_setup_credentials (fun token () -> let%lwt uuid = Ocsipersist.find election_credtokens token in let%lwt se = get_setup_election uuid in let uuid = match Uuidm.of_string uuid with | None -> failwith "invalid UUID extracted from credtokens" | Some u -> u in T.election_setup_credentials token uuid se () ) let () = File.register ~service:election_setup_credentials_download ~content_type:"text/plain" (fun token () -> let%lwt uuid = Ocsipersist.find election_credtokens token in return (!spool_dir / uuid ^ ".public_creds.txt") ) let wrap_handler f = try%lwt f () with | e -> T.generic_page ~title:"Error" (Printexc.to_string e) () >>= Html5.send let handle_credentials_post token creds = let%lwt uuid = Ocsipersist.find election_credtokens token in let%lwt se = get_setup_election uuid in if se.se_public_creds_received then forbidden () else let module G = (val Group.of_string se.se_group : GROUP) in let fname = !spool_dir / uuid ^ ".public_creds.txt" in Lwt_mutex.with_lock election_setup_mutex (fun () -> Lwt_io.with_file ~flags:(Unix.([O_WRONLY; O_NONBLOCK; O_CREAT; O_TRUNC])) ~perm:0o600 ~mode:Lwt_io.Output fname (fun oc -> Lwt_io.write_chars oc creds) ) >> let%lwt () = let i = ref 1 in Lwt_stream.iter (fun x -> try let x = G.of_string x in if not (G.check x) then raise Exit; incr i with _ -> Printf.ksprintf failwith "invalid credential at line %d" !i) (Lwt_io.lines_of_file fname) in let () = se.se_metadata <- {se.se_metadata with e_cred_authority = None} in let () = se.se_public_creds_received <- true in set_setup_election uuid se >> T.generic_page ~title:"Success" ~service:home "Credentials have been received and checked!" () >>= Html5.send let () = Any.register ~service:election_setup_credentials_post (fun token creds -> let s = Lwt_stream.of_string creds in wrap_handler (fun () -> handle_credentials_post token s)) let () = Any.register ~service:election_setup_credentials_post_file (fun token creds -> let s = Lwt_io.chars_of_file creds.Ocsigen_extensions.tmp_filename in wrap_handler (fun () -> handle_credentials_post token s)) module CG = Credential.MakeGenerate (LwtRandom) let () = Any.register ~service:election_setup_credentials_server (handle_setup (fun se () _ uuid -> let nvoters = List.length se.se_voters in if nvoters > !maxmailsatonce then Lwt.fail (Failure (Printf.sprintf "Cannot send credentials, there are too many voters (max is %d)" !maxmailsatonce)) else if nvoters = 0 then Lwt.fail (Failure "No voters") else if se.se_public_creds_received then forbidden () else let () = se.se_metadata <- {se.se_metadata with e_cred_authority = Some "server" } in let uuid_s = Uuidm.to_string uuid in let title = se.se_questions.t_name in let url = Eliom_uri.make_string_uri ~absolute:true ~service:election_home (uuid, ()) |> rewrite_prefix in let module S = Set.Make (PString) in let module G = (val Group.of_string se.se_group : GROUP) in let module CD = Credential.MakeDerive (G) in let%lwt creds = Lwt_list.fold_left_s (fun accu v -> let email, login = split_identity v.sv_id in let%lwt cred = CG.generate () in let pub_cred = let x = CD.derive uuid cred in let y = G.(g **~ x) in G.to_string y in let langs = get_languages se.se_metadata.e_languages in let bodies = List.map (fun lang -> let module L = (val Web_i18n.get_lang lang) in Printf.sprintf L.mail_credential title login cred url ) langs in let body = PString.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \nBelenios" in let subject = let lang = List.hd langs in let module L = (val Web_i18n.get_lang lang) in Printf.sprintf L.mail_credential_subject title in let%lwt () = send_email email subject body in return @@ S.add pub_cred accu ) S.empty se.se_voters in let creds = S.elements creds in let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in let%lwt () = Lwt_io.with_file ~flags:(Unix.([O_WRONLY; O_NONBLOCK; O_CREAT; O_TRUNC])) ~perm:0o600 ~mode:Lwt_io.Output fname (fun oc -> Lwt_list.iter_s (Lwt_io.write_line oc) creds) in se.se_public_creds_received <- true; return (fun () -> let service = preapply election_setup uuid in T.generic_page ~title:"Success" ~service "Credentials have been generated and mailed!" () >>= Html5.send))) let () = Html5.register ~service:election_setup_trustee (fun token () -> let%lwt uuid = Ocsipersist.find election_pktokens token in let%lwt se = get_setup_election uuid in let uuid = match Uuidm.of_string uuid with | None -> failwith "invalid UUID extracted from pktokens" | Some u -> u in T.election_setup_trustee token uuid se () ) let () = Any.register ~service:election_setup_trustee_post (fun token public_key -> wrap_handler (fun () -> let%lwt uuid = Ocsipersist.find election_pktokens token in Lwt_mutex.with_lock election_setup_mutex (fun () -> let%lwt se = get_setup_election uuid in let t = List.find (fun x -> token = x.st_token) se.se_public_keys in let module G = (val Group.of_string se.se_group : GROUP) in let pk = trustee_public_key_of_string G.read public_key in let module KG = Election.MakeSimpleDistKeyGen (G) (LwtRandom) in if not (KG.check pk) then failwith "invalid public key"; (* we keep pk as a string because of G.t *) t.st_public_key <- public_key; set_setup_election uuid se ) >> T.generic_page ~title:"Success" "Your key has been received and checked!" () >>= Html5.send ) ) let () = Any.register ~service:election_setup_confirm (fun uuid () -> match%lwt Web_state.get_site_user () with | None -> forbidden () | Some u -> let uuid_s = Uuidm.to_string uuid in let%lwt se = get_setup_election uuid_s in if se.se_owner <> u then forbidden () else T.election_setup_confirm uuid se () >>= Html5.send) let () = Any.register ~service:election_setup_create (fun uuid () -> match%lwt Web_state.get_site_user () with | None -> forbidden () | Some u -> begin try%lwt let uuid_s = Uuidm.to_string uuid in Lwt_mutex.with_lock election_setup_mutex (fun () -> let%lwt se = get_setup_election uuid_s in if se.se_owner <> u then forbidden () else finalize_election uuid se >> Redirection.send (preapply election_admin (uuid, ())) ) with e -> T.new_election_failure (`Exception e) () >>= Html5.send end ) let () = Html5.register ~service:election_setup_import (fun uuid () -> let%lwt site_user = Web_state.get_site_user () in match site_user with | None -> forbidden () | Some u -> let%lwt se = get_setup_election (Uuidm.to_string uuid) in let%lwt elections = get_finalized_elections_by_owner u in T.election_setup_import uuid se elections ()) let () = Any.register ~service:election_setup_import_post (handle_setup (fun se from _ uuid -> let from_s = Uuidm.to_string from in let%lwt voters = Web_persist.get_voters from_s in let%lwt passwords = Web_persist.get_passwords from_s in let get_password = match passwords with | None -> fun _ -> None | Some p -> fun sv_id -> let _, login = split_identity sv_id in try Some (SMap.find login p) with Not_found -> None in match voters with | Some voters -> if se.se_public_creds_received then forbidden () else ( se.se_voters <- merge_voters se.se_voters voters get_password; return (redir_preapply election_setup_voters uuid)) | None -> return (fun () -> T.generic_page ~title:"Error" ~service:(preapply election_setup_voters uuid) (Printf.sprintf "Could not retrieve voter list from election %s" from_s) () >>= Html5.send))) let () = Html5.register ~service:election_setup_import_trustees (fun uuid () -> let%lwt site_user = Web_state.get_site_user () in match site_user with | None -> forbidden () | Some u -> let%lwt se = get_setup_election (Uuidm.to_string uuid) in let%lwt elections = get_finalized_elections_by_owner u in T.election_setup_import_trustees uuid se elections ()) exception TrusteeImportError of string let () = Any.register ~service:election_setup_import_trustees_post (handle_setup (fun se from _ uuid -> let uuid_s = Uuidm.to_string uuid in let from_s = Uuidm.to_string from in let%lwt metadata = Web_persist.get_election_metadata from_s in let%lwt public_keys = Web_persist.get_public_keys from_s in try%lwt match metadata.e_trustees, public_keys with | Some ts, Some pks when List.length ts = List.length pks -> let%lwt trustees = List.combine ts pks |> Lwt_list.map_p (fun (st_id, st_public_key) -> let%lwt st_token = generate_token () in return {st_id; st_token; st_public_key}) in let () = (* check that imported keys are valid *) let module G = (val Group.of_string se.se_group : GROUP) in let module KG = Election.MakeSimpleDistKeyGen (G) (LwtRandom) in if not @@ List.for_all (fun t -> let pk = t.st_public_key in let pk = trustee_public_key_of_string G.read pk in KG.check pk) trustees then raise (TrusteeImportError "Imported keys are invalid for this election!") in se.se_public_keys <- se.se_public_keys @ trustees; Lwt_list.iter_s (fun {st_token; _} -> Ocsipersist.add election_pktokens st_token uuid_s ) trustees >> return (redir_preapply election_setup_trustees uuid) | _, _ -> [%lwt raise (TrusteeImportError "Could not retrieve trustees from selected election!")] with | TrusteeImportError msg -> return (fun () -> T.generic_page ~title:"Error" ~service:(preapply election_setup_trustees uuid) msg () >>= Html5.send))) let () = Any.register ~service:election_home (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in try%lwt let%lwt w = find_election uuid_s in let module W = (val w) in Eliom_reference.unset Web_state.ballot >> let cont () = Redirection.send (Eliom_service.preapply election_home (W.election.e_params.e_uuid, ())) in Eliom_reference.set Web_state.cont [cont] >> match%lwt Eliom_reference.get Web_state.cast_confirmed with | Some result -> Eliom_reference.unset Web_state.cast_confirmed >> Eliom_reference.unset Web_state.user >> T.cast_confirmed (module W) ~result () >>= Html5.send | None -> let%lwt state = Web_persist.get_election_state uuid_s in T.election_home (module W) state () >>= Html5.send with Not_found -> let%lwt lang = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang lang) in T.generic_page ~title:L.not_yet_open ~service:(preapply election_home (uuid, ())) L.come_back_later () >>= Html5.send) let () = Any.register ~service:set_cookie_disclaimer (fun () () -> Eliom_reference.set Web_state.show_cookie_disclaimer false >> let%lwt cont = Web_state.cont_pop () in match cont with | Some f -> f () | None -> let%lwt lang = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang lang) in T.generic_page ~title:L.cookies_are_blocked L.please_enable_them () >>= Html5.send) let () = Any.register ~service:election_admin (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let%lwt site_user = Web_state.get_site_user () in let module W = (val w) in match site_user with | Some u when metadata.e_owner = Some u -> let%lwt state = Web_persist.get_election_state uuid_s in T.election_admin w metadata state () >>= Html5.send | _ -> let cont () = Redirection.send (Eliom_service.preapply election_admin (uuid, ())) in Eliom_reference.set Web_state.cont [cont] >> Redirection.send (Eliom_service.preapply site_login None) ) let election_set_state state (uuid, ()) () = let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let%lwt () = match%lwt Web_state.get_site_user () with | Some u when metadata.e_owner = Some u -> return () | _ -> forbidden () in let%lwt () = match%lwt Web_persist.get_election_state uuid_s with | `Open | `Closed -> return () | _ -> forbidden () in let state = if state then `Open else `Closed in Web_persist.set_election_state uuid_s state >> Redirection.send (preapply election_admin (uuid, ())) let () = Any.register ~service:election_open (election_set_state true) let () = Any.register ~service:election_close (election_set_state false) let () = Any.register ~service:election_archive (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let%lwt site_user = Web_state.get_site_user () in let module W = (val w) in match site_user with | Some u when metadata.e_owner = Some u -> archive_election uuid_s >> Redirection.send (Eliom_service.preapply election_admin (uuid, ())) | _ -> forbidden () ) let () = Any.register ~service:election_update_credential (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let%lwt site_user = Web_state.get_site_user () in let module W = (val w) in match site_user with | Some u -> if metadata.e_owner = Some u then ( T.update_credential (module W) () >>= Html5.send ) else ( forbidden () ) | _ -> forbidden ()) let () = Any.register ~service:election_update_credential_post (fun (uuid, ()) (old, new_) -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let%lwt site_user = Web_state.get_site_user () in let module WE = Web_election.Make (W) (LwtRandom) in match site_user with | Some u -> if metadata.e_owner = Some u then ( try%lwt WE.B.update_cred ~old ~new_ >> String.send ("OK", "text/plain") with Error e -> String.send ("Error: " ^ explain_error e, "text/plain") ) >>= (fun x -> return @@ cast_unknown_content_kind x) else ( forbidden () ) | _ -> forbidden ()) let () = Any.register ~service:election_vote (fun (_, ()) () -> Eliom_reference.unset Web_state.ballot >> Web_templates.booth () >>= Html5.send) let () = Any.register ~service:election_cast (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let module W = (val w) in let cont () = Redirection.send (Eliom_service.preapply election_cast (W.election.e_params.e_uuid, ())) in Eliom_reference.set Web_state.cont [cont] >> match%lwt Eliom_reference.get Web_state.ballot with | Some b -> T.cast_confirmation (module W) (sha256_b64 b) () >>= Html5.send | None -> T.cast_raw (module W) () >>= Html5.send) let () = Any.register ~service:election_cast_post (fun (uuid, ()) (ballot_raw, ballot_file) -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let module W = (val w) in let%lwt user = Web_state.get_election_user uuid in let%lwt the_ballot = match ballot_raw, ballot_file with | Some ballot, None -> return ballot | None, Some fi -> let fname = fi.Ocsigen_extensions.tmp_filename in Lwt_stream.to_string (Lwt_io.chars_of_file fname) | _, _ -> fail_http 400 in let the_ballot = PString.trim the_ballot in let cont () = Redirection.send (Eliom_service.preapply Web_services.election_cast (W.election.e_params.e_uuid, ())) in Eliom_reference.set Web_state.cont [cont] >> Eliom_reference.set Web_state.ballot (Some the_ballot) >> match user with | None -> Redirection.send (Eliom_service.preapply Web_services.election_login ((W.election.e_params.e_uuid, ()), None)) | Some _ -> cont ()) let () = Any.register ~service:election_cast_confirm (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let module W = (val w) in let module WE = Web_election.Make (W) (LwtRandom) in match%lwt Eliom_reference.get Web_state.ballot with | Some the_ballot -> begin Eliom_reference.unset Web_state.ballot >> match%lwt Web_state.get_election_user uuid with | Some u -> let record = u, now () in let%lwt result = try%lwt let%lwt hash = WE.B.cast the_ballot record in return (`Valid hash) with Error e -> return (`Error e) in Eliom_reference.set Web_state.cast_confirmed (Some result) >> Redirection.send (Eliom_service.preapply election_home (W.election.e_params.e_uuid, ())) | None -> forbidden () end | None -> fail_http 404) let () = Any.register ~service:election_pretty_ballots (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt ballots = Web_persist.get_ballot_hashes uuid_s in let%lwt result = Web_persist.get_election_result uuid_s in T.pretty_ballots w ballots result () >>= Html5.send) let () = Any.register ~service:election_pretty_ballot (fun ((uuid, ()), hash) () -> let uuid_s = Uuidm.to_string uuid in let%lwt ballot = Web_persist.get_ballot_by_hash ~uuid:uuid_s ~hash in match ballot with | None -> fail_http 404 | Some b -> String.send (b, "application/json") >>= (fun x -> return @@ cast_unknown_content_kind x)) let () = let rex = Pcre.regexp "\".*\" \".*:(.*)\"" in Any.register ~service:election_missing_voters (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let%lwt () = match%lwt Web_state.get_site_user () with | Some u when metadata.e_owner = Some u -> return () | _ -> forbidden () in let voters = Lwt_io.lines_of_file (!spool_dir / uuid_s / string_of_election_file ESVoters) in let module S = Set.Make (PString) in let%lwt voters = Lwt_stream.fold (fun v accu -> let _, login = split_identity v in S.add login accu ) voters S.empty in let records = Lwt_io.lines_of_file (!spool_dir / uuid_s / string_of_election_file ESRecords) in let%lwt voters = Lwt_stream.fold (fun r accu -> let s = Pcre.exec ~rex r in let v = Pcre.get_substring s 1 in S.remove v accu ) records voters in let buf = Buffer.create 128 in S.iter (fun v -> Buffer.add_string buf v; Buffer.add_char buf '\n' ) voters; String.send (Buffer.contents buf, "text/plain")) let () = let rex = Pcre.regexp "\"(.*)\\..*\" \".*:(.*)\"" in Any.register ~service:election_pretty_records (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let%lwt () = match%lwt Web_state.get_site_user () with | Some u when metadata.e_owner = Some u -> return_unit | _ -> forbidden () in let records = Lwt_io.lines_of_file (!spool_dir / uuid_s / string_of_election_file ESRecords) in let%lwt records = Lwt_stream.fold (fun r accu -> let s = Pcre.exec ~rex r in let date = Pcre.get_substring s 1 in let voter = Pcre.get_substring s 2 in (date, voter) :: accu ) records [] in T.pretty_records w (List.rev records) () >>= Html5.send ) let () = Any.register ~service:election_tally_trustees (fun (uuid, ((), trustee_id)) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let module W = (val w) in let%lwt () = match%lwt Web_persist.get_election_state uuid_s with | `EncryptedTally _ -> return () | _ -> fail_http 404 in let%lwt pds = Web_persist.get_partial_decryptions uuid_s in if List.mem_assoc trustee_id pds then ( T.generic_page ~title:"Error" "Your partial decryption has already been received and checked!" () >>= Html5.send ) else ( T.tally_trustees (module W) trustee_id () >>= Html5.send )) let () = Any.register ~service:election_tally_trustees_post (fun (uuid, ((), trustee_id)) partial_decryption -> let uuid_s = Uuidm.to_string uuid in let%lwt () = match%lwt Web_persist.get_election_state uuid_s with | `EncryptedTally _ -> return () | _ -> forbidden () in let%lwt pds = Web_persist.get_partial_decryptions uuid_s in let%lwt () = if List.mem_assoc trustee_id pds then forbidden () else return () in let%lwt () = if trustee_id > 0 then return () else fail_http 404 in let%lwt w = find_election uuid_s in let module W = (val w) in let module E = Election.MakeElection (W.G) (LwtRandom) in let pks = !spool_dir / uuid_s / string_of_election_file ESKeys in let pks = Lwt_io.lines_of_file pks in let%lwt () = Lwt_stream.njunk (trustee_id-1) pks in let%lwt pk = Lwt_stream.peek pks in let%lwt () = Lwt_stream.junk_while (fun _ -> true) pks in let%lwt pk = match pk with | None -> fail_http 404 | Some x -> return x in let pk = trustee_public_key_of_string W.G.read pk in let pk = pk.trustee_public_key in let pd = partial_decryption_of_string W.G.read partial_decryption in let et = !spool_dir / uuid_s / string_of_election_file ESETally in let%lwt et = Lwt_io.chars_of_file et |> Lwt_stream.to_string in let et = encrypted_tally_of_string W.G.read et in if E.check_factor et pk pd then ( let pds = (trustee_id, partial_decryption) :: pds in let%lwt () = Web_persist.set_partial_decryptions uuid_s pds in T.generic_page ~title:"Success" "Your partial decryption has been received and checked!" () >>= Html5.send ) else ( let service = preapply election_tally_trustees (uuid, ((), trustee_id)) in T.generic_page ~title:"Error" ~service "The partial decryption didn't pass validation!" () >>= Html5.send )) let handle_election_tally_release (uuid, ()) () = let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let module E = Election.MakeElection (W.G) (LwtRandom) in let%lwt () = match%lwt Web_state.get_site_user () with | Some u when metadata.e_owner = Some u -> return () | _ -> forbidden () in let%lwt npks, ntallied = match%lwt Web_persist.get_election_state uuid_s with | `EncryptedTally (npks, ntallied, _) -> return (npks, ntallied) | _ -> forbidden () in let%lwt pds = Web_persist.get_partial_decryptions uuid_s in let%lwt pds = try return @@ Array.init npks (fun i -> List.assoc (i+1) pds |> partial_decryption_of_string W.G.read ) with Not_found -> fail_http 404 in let%lwt et = !spool_dir / uuid_s / string_of_election_file ESETally |> Lwt_io.chars_of_file |> Lwt_stream.to_string >>= wrap1 (encrypted_tally_of_string W.G.read) in let result = E.combine_factors ntallied et pds in let%lwt () = let open Lwt_io in with_file ~mode:Output (!spool_dir / uuid_s / string_of_election_file ESResult) (fun oc -> Lwt_io.write_line oc (string_of_result W.G.write result)) in let%lwt () = Web_persist.set_election_state uuid_s (`Tallied result.result) in Eliom_service.preapply election_home (W.election.e_params.e_uuid, ()) |> Redirection.send let () = Any.register ~service:election_tally_release handle_election_tally_release let content_type_of_file = function | ESRaw -> "application/json; charset=utf-8" | ESKeys | ESBallots | ESETally | ESResult -> "application/json" | ESCreds | ESRecords | ESVoters -> "text/plain" let handle_pseudo_file uuid_s w f site_user = let module W = (val w : ELECTION_DATA) in let confidential = match f with | ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false | ESRecords | ESVoters -> true in let%lwt () = if confidential then ( let%lwt metadata = Web_persist.get_election_metadata uuid_s in match site_user with | Some u when metadata.e_owner = Some u -> return () | _ -> forbidden () ) else return () in let content_type = content_type_of_file f in File.send ~content_type (!spool_dir / uuid_s / string_of_election_file f) let () = Any.register ~service:election_dir (fun (uuid, f) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt site_user = Web_state.get_site_user () in let module W = (val w) in handle_pseudo_file uuid_s w f site_user) let () = Any.register ~service:election_compute_encrypted_tally (fun (uuid, ()) () -> let uuid_s = Uuidm.to_string uuid in let%lwt w = find_election uuid_s in let%lwt metadata = Web_persist.get_election_metadata uuid_s in let module W = (val w) in let module WE = Web_election.Make (W) (LwtRandom) in let%lwt () = match%lwt Web_state.get_site_user () with | Some u when metadata.e_owner = Some u -> return () | _ -> forbidden () in let%lwt () = match%lwt Web_persist.get_election_state uuid_s with | `Closed -> return () | _ -> forbidden () in let%lwt nb, hash, tally = WE.B.compute_encrypted_tally () in let pks = !spool_dir / uuid_s / string_of_election_file ESKeys in let pks = Lwt_io.lines_of_file pks in let npks = ref 0 in let%lwt () = Lwt_stream.junk_while (fun _ -> incr npks; true) pks in Web_persist.set_election_state uuid_s (`EncryptedTally (!npks, nb, hash)) >> (* compute partial decryption and release tally if the (single) key is known *) let skfile = !spool_dir / uuid_s / "private_key.json" in if !npks = 1 && Sys.file_exists skfile then ( let%lwt sk = Lwt_io.lines_of_file skfile |> Lwt_stream.to_list in let sk = match sk with | [sk] -> number_of_string sk | _ -> failwith "several private keys are available" in let tally = encrypted_tally_of_string WE.G.read tally in let%lwt pd = WE.E.compute_factor tally sk in let pd = string_of_partial_decryption WE.G.write pd in Web_persist.set_partial_decryptions uuid_s [1, pd] >> handle_election_tally_release (uuid, ()) () ) else Redirection.send (preapply election_admin (uuid, ()))) let () = Any.register ~service:set_language (fun lang () -> Eliom_reference.set Web_state.language lang >> let%lwt cont = Web_state.cont_pop () in match cont with | Some f -> f () | None -> Redirection.send home) belenios-1.4+dfsg/src/web/web_site.mli000066400000000000000000000031001307140314400177340ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) val source_file : string ref val maxmailsatonce : int ref belenios-1.4+dfsg/src/web/web_state.ml000066400000000000000000000062421307140314400177510ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Web_serializable_t type user = { uuid: Uuidm.t option; service : string; name : string; } let scope = Eliom_common.default_session_scope let show_cookie_disclaimer = Eliom_reference.eref ~scope true let user = Eliom_reference.eref ~scope None let get_site_user () = match%lwt Eliom_reference.get user with | None -> return None | Some u -> match u.uuid with | None -> return @@ Some { user_domain = u.service; user_name = u.name; } | Some _ -> return None let get_election_user uuid = match%lwt Eliom_reference.get user with | None -> return None | Some u -> match u.uuid with | None -> return None | Some uuid' -> if Uuidm.equal uuid uuid' then return @@ Some { user_domain = u.service; user_name = u.name } else return None let cont = Eliom_reference.eref ~scope [] let cont_push f = let open Eliom_reference in let%lwt fs = get cont in set cont (f :: fs) let cont_pop () = let open Eliom_reference in let%lwt fs = get cont in match fs with | f :: fs -> set cont fs >> return (Some f) | [] -> return None let ballot = Eliom_reference.eref ~scope None let cast_confirmed = Eliom_reference.eref ~scope None let get_default_language () = let ri = Eliom_request_info.get_ri () in let lazy langs = Ocsigen_request_info.accept_language ri in match langs with | [] -> "en" | (lang, _) :: _ -> let n = try String.index lang '-' with Not_found -> String.length lang in String.sub lang 0 n let language = Eliom_reference.eref_from_fun ~scope get_default_language belenios-1.4+dfsg/src/web/web_state.mli000066400000000000000000000042641307140314400201240ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Web_signatures type user = { uuid: Uuidm.t option; service : string; name : string; } val show_cookie_disclaimer : bool Eliom_reference.eref val user : user option Eliom_reference.eref val get_site_user : unit -> Web_serializable_t.user option Lwt.t val get_election_user : Uuidm.t -> Web_serializable_t.user option Lwt.t val cont : (unit -> content) list Eliom_reference.eref val cont_push : (unit -> content) -> unit Lwt.t val cont_pop : unit -> (unit -> content) option Lwt.t val ballot : string option Eliom_reference.eref val cast_confirmed : [ `Error of Web_common.error | `Valid of string ] option Eliom_reference.eref val language : string Eliom_reference.eref belenios-1.4+dfsg/src/web/web_templates.ml000066400000000000000000001752211307140314400206330ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Lwt open Serializable_j open Signatures open Common open Web_serializable_j open Web_signatures open Web_common open Web_services open Eliom_content.Html5.F (* TODO: these pages should be redesigned *) let site_title = "Election Server" let admin_background = " background: #FF9999;" let format_user ~site u = em [pcdata (if site then string_of_user u else u.user_name)] let make_login_box ~site auth links = let style = if site then admin_background else "" in let style = "float: right; text-align: right;" ^ style in let module S = (val auth : AUTH_SERVICES) in let module L = (val links : AUTH_LINKS) in let%lwt user = S.get_user () in let%lwt auth_systems = S.get_auth_systems () in let body = match user with | Some user -> [ div [ pcdata "Logged in as "; format_user ~site user; pcdata "."; ]; div [ a ~a:[a_id "logout"] ~service:L.logout [pcdata "Log out"] (); pcdata "."; ]; ] | None -> if site then [ div [ pcdata "Not logged in."; ]; let auth_systems = auth_systems |> List.map (fun name -> a ~a:[a_id ("login_" ^ name)] ~service:(L.login (Some name)) [pcdata name] () ) |> list_join (pcdata ", ") in div ( [pcdata "Log in: ["] @ auth_systems @ [pcdata "]"] ); ] else [] in match body with | [] -> return None | _::_ -> return (Some (div ~a:[a_style style] body)) module Site_links = struct let login x = Eliom_service.preapply site_login x let logout = Eliom_service.preapply logout () end module Site_auth = struct let get_user () = Web_state.get_site_user () let get_auth_systems () = let%lwt l = Web_persist.get_auth_config "" in return (List.map fst l) end let site_links = (module Site_links : AUTH_LINKS) let site_auth = (module Site_auth : AUTH_SERVICES) let site_login_box () = make_login_box ~site:true site_auth site_links let belenios_url = Eliom_service.Http.external_service ~prefix:"http://www.belenios.org" ~path:[] ~get_params:Eliom_parameter.unit () let base ~title ?login_box ~content ?(footer = div []) ?uuid () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let administer = match uuid with | None -> a ~service:admin [pcdata L.administer_elections] () | Some uuid -> a ~service:election_admin [pcdata L.administer_this_election] (uuid, ()) in let login_box = match login_box with | None -> div ~a:[a_style "float: right; padding: 10px;"] [ img ~a:[a_height 70] ~alt:"" ~src:(uri_of_string (fun () -> "/static/placeholder.png")) (); ] | Some x -> x in Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang L.lang] (head (Eliom_content.Html5.F.title (pcdata title)) [ script (pcdata "window.onbeforeunload = function () {};"); link ~rel:[`Stylesheet] ~href:(uri_of_string (fun () -> "/static/site.css")) (); ]) (body [ div ~a:[a_id "wrapper"] [ div ~a:[a_id "header"] [ div [ div ~a:[a_style "float: left; padding: 10px;"] [ a ~service:home [ img ~alt:L.election_server ~a:[a_height 70] ~src:(uri_of_string (fun () -> "/static/logo.png")) (); ] (); ]; login_box; h1 ~a:[a_style "text-align: center; padding: 20px;"] [pcdata title]; div ~a:[a_style "clear: both;"] []; ]; ]; div ~a:[a_id "main"] content; div ~a:[a_id "footer"; a_style "text-align: center;" ] [ div ~a:[a_id "bottom"] [ footer; pcdata L.powered_by; a ~service:belenios_url [pcdata "Belenios"] (); pcdata ". "; a ~service:source_code [pcdata L.get_the_source_code] (); pcdata ". "; administer; pcdata "."; ] ]] ])) let format_election election = let module W = (val election : ELECTION_DATA) in let e = W.election.e_params in let service = election_admin in li [ a ~service [pcdata e.e_name] (e.e_uuid, ()); ] let admin ~elections () = let title = site_title ^ " — Administration" in match elections with | None -> let content = [ div [ pcdata "To administer an election, you need to "; a ~service:site_login [pcdata "log in"] None; pcdata ". If you do not have an account, "; pcdata "please send an email to contact@belenios.org."; ] ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () | Some (elections, tallied, archived, setup_elections) -> let elections = match elections with | [] -> p [pcdata "You own no such elections!"] | _ -> ul @@ List.map format_election elections in let tallied = match tallied with | [] -> p [pcdata "You own no such elections!"] | _ -> ul @@ List.map format_election tallied in let archived = match archived with | [] -> p [pcdata "You own no such elections!"] | _ -> ul @@ List.map format_election archived in let setup_elections = match setup_elections with | [] -> p [pcdata "You own no such elections!"] | _ -> ul @@ List.map (fun (k, title) -> li [a ~service:election_setup [pcdata title] k] ) setup_elections in let content = [ div [ div [ a ~service:election_setup_pre [ pcdata "Prepare a new election"; ] (); ]; div [br ()]; h2 [pcdata "Elections being prepared"]; setup_elections; div [br ()]; h2 [pcdata "Elections you can administer"]; elections; div [br ()]; h2 [pcdata "Tallied elections"]; tallied; div [br ()]; h2 [pcdata "Archived elections"]; archived; ]; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let make_button ~service ~disabled contents = let uri = Eliom_uri.make_string_uri ~service () in Printf.ksprintf Unsafe.data (* FIXME: unsafe *) "" uri (if disabled then " disabled" else "") contents let a_mailto ~dest ~subject ~body contents = let uri = Printf.sprintf "mailto:%s?subject=%s&body=%s" dest (Netencoding.Url.encode ~plus:false subject) (Netencoding.Url.encode ~plus:false body) in Printf.ksprintf Unsafe.data "%s" uri contents let new_election_failure reason () = let title = "Create new election" in let reason = match reason with | `Exists -> pcdata "An election with the same UUID already exists." | `Exception e -> pcdata @@ Printexc.to_string e in let content = [ div [ p [pcdata "The creation failed."]; p [reason]; ] ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let generic_page ~title ?service message () = let proceed = match service with | None -> pcdata "" | Some service -> div [ a ~service [pcdata "Proceed"] (); ] in let content = [ p [pcdata message]; proceed; ] in base ~title ~content () let election_setup_pre () = let title = "Prepare a new election" in let cred_info = Eliom_service.Http.external_service ~prefix:"http://www.belenios.org" ~path:["setup.php"] ~get_params:Eliom_parameter.unit () in let form = post_form ~service:election_setup_new (fun (credmgmt, (auth, cas_server)) -> [ fieldset ~legend:(legend [ pcdata "Credential management ("; a ~service:cred_info [pcdata "more info"] (); pcdata ")"; ]) [ div [ string_radio ~checked:true ~name:credmgmt ~value:"auto" (); pcdata " Automatic (degraded mode - credentials will be handled by the server)"; ]; div [ string_radio ~name:credmgmt ~value:"manual" (); pcdata " Manual (safe mode - a third party will handle the credentials)"; ]; ]; fieldset ~legend:(legend [pcdata "Authentication"]) [ div [ string_radio ~checked:true ~name:auth ~value:"password" (); pcdata " Password (passwords will be emailed to voters)"; ]; div [ string_radio ~name:auth ~value:"cas" (); pcdata " CAS (external authentication server), server address: "; string_input ~input_type:`Text ~name:cas_server (); pcdata " (for example: https://cas.inria.fr/cas)"; ]; ]; div [ string_input ~input_type:`Submit ~value:"Proceed" (); ]; ] ) () in let content = [ form ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_setup uuid se () = let title = "Preparation of election " ^ se.se_questions.t_name in let form_languages = post_form ~service:election_setup_languages (fun languages -> [ div [ pcdata "Languages: "; string_input ~name:languages ~input_type:`Text ~value:(string_of_languages se.se_metadata.e_languages) (); pcdata " (Available languages: "; pcdata (string_of_languages (Some available_languages)); pcdata ")"; ]; div [ pcdata "(This is a space-separated list of languages that will be used in emails sent by the server.)"; ]; div [ string_input ~input_type:`Submit ~value:"Save changes" (); ]; ]) uuid in let div_languages = div [ h2 [pcdata "Languages"]; form_languages; ] in let form_description = post_form ~service:election_setup_description (fun (name, description) -> [ div [ pcdata "Name of the election: "; string_input ~name:name ~input_type:`Text ~value:se.se_questions.t_name (); ]; div [ div [pcdata "Description of the election: "]; div [ textarea ~name:description ~a:[a_cols 80] ~value:se.se_questions.t_description (); ]; ]; div [ string_input ~input_type:`Submit ~value:"Save changes" (); ]; ] ) uuid in let div_description = div [ h2 [pcdata "Name and description of the election"]; form_description; ] in let has_credentials = match se.se_metadata.e_cred_authority with | None -> false | Some _ -> true in let auth = match se.se_metadata.e_auth_config with | Some [{auth_system = "password"; _}] -> `Password | Some [{auth_system = "dummy"; _}] -> `Dummy | Some [{auth_system = "cas"; auth_config = ["server", server]; _}] -> `CAS server | _ -> failwith "unknown authentication scheme in election_setup" in let div_auth = div [ h2 [pcdata "Authentication"]; match auth with | `Password -> div [ pcdata "Authentication scheme: password "; post_form ~service:election_setup_auth_genpwd (fun () -> [string_input ~input_type:`Submit ~value:"Generate and mail missing passwords" ()] ) uuid; ] | `Dummy -> div [ pcdata "Authentication scheme: dummy" ] | `CAS server -> div [ pcdata "Authentication scheme: CAS with server "; pcdata server; ] ] in let div_questions = div [ h2 [ a ~a:[a_id "edit_questions"] ~service:election_setup_questions [pcdata "Edit questions"] uuid; ] ] in let div_voters = div [ h2 [ a ~a:[a_id "edit_voters"] ~service:election_setup_voters [pcdata "Edit voters"] uuid ]; div [ pcdata @@ string_of_int @@ List.length se.se_voters; pcdata " voter(s) registered"; ]; ] in let div_trustees = div [ h2 [pcdata "Trustees"]; div [ pcdata "By default, the election server manages the keys of the "; pcdata "election. If you do not wish the server to store any keys, "; pcdata "click "; a ~service:election_setup_trustees [pcdata "here"] uuid; pcdata "."]; ] in let div_credentials = div [ h2 [pcdata "Credentials"]; if se.se_public_creds_received then ( div [ pcdata "Credentials have already been generated!" ] ) else ( div [ pcdata "Warning: this will freeze the voter list!"; if has_credentials then ( post_form ~service:election_setup_credentials_server (fun () -> [string_input ~input_type:`Submit ~value:"Generate on server" ()] ) uuid ) else ( div [ a ~service:election_setup_credential_authority [pcdata "Credential management"] uuid; ] ); ] ) ] in let link_confirm = div [ h2 [pcdata "Finalize creation"]; a ~service:election_setup_confirm [pcdata "Create election"] uuid; ] in let content = [ div_description; hr (); div_languages; hr (); div_questions; hr (); div_voters; hr (); div_credentials; hr (); div_auth; hr (); div_trustees; hr (); link_confirm; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let mail_trustee_generation : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Dear trustee, You will find below the link to generate your private decryption key, used to tally the election. %s Here's the instructions: 1. click on the link 2. click on \"generate a new key pair\" 3. your private key will appear in another window or tab. Make sure you SAVE IT properly otherwise it will not possible to tally and the election will be canceled. 4. in the first window, click on \"submit\" to send the public part of your key, used encrypt the votes. For verification purposes, you should save this part (that starts with {\"pok\":{\"challenge\":\") ), for example sending yourself an email. Regarding your private key, it is crucial you save it (otherwise the election will be canceled) and store it securely (if your private key is known together with the private keys of the other trustees, then vote privacy is no longer guaranteed). We suggest two options: 1. you may store the key on a USB stick and store it in a safe. 2. Or you may simply print it and store it in a safe. Of course, more cryptographic solutions are welcome as well. Thank you for your help, -- \nThe election administrator." let election_setup_trustees uuid se () = let title = "Trustees for election " ^ se.se_questions.t_name in let form_trustees_add = post_form ~service:election_setup_trustee_add (fun name -> [ pcdata "Trustee's e-mail address: "; string_input ~input_type:`Text ~name (); string_input ~input_type:`Submit ~value:"Add" (); ] ) uuid in let mk_form_trustee_del value = post_form ~service:election_setup_trustee_del (fun name -> [ int_input ~input_type:`Hidden ~name ~value (); string_input ~input_type:`Submit ~value:"Remove" (); ]) uuid in let trustees = match se.se_public_keys with | [] -> pcdata "" | ts -> table ( tr [ th [pcdata "Trustee"]; th [pcdata "Mail"]; th [pcdata "Link"]; th [pcdata "Done?"]; th [pcdata "Remove"]; ] :: List.mapi (fun i t -> tr [ td [ pcdata t.st_id; ]; td [ let uri = rewrite_prefix @@ Eliom_uri.make_string_uri ~absolute:true ~service:election_setup_trustee t.st_token in let body = Printf.sprintf mail_trustee_generation uri in let subject = "Link to generate the decryption key" in a_mailto ~dest:t.st_id ~subject ~body "Mail" ]; td [ a ~service:election_setup_trustee [pcdata "Link"] t.st_token; ]; td [ pcdata (if t.st_public_key = "" then "No" else "Yes"); ]; td [mk_form_trustee_del i]; ] ) ts ) in let div_content = div [ div [pcdata "If you do not wish the server to store any keys, you may nominate trustees. In that case, each trustee will create her own secret key. Be careful, once the election is over, you will need the contribution of each trustee to compute the result!"]; br (); trustees; (if se.se_public_keys <> [] then div [ pcdata "There is one link per trustee. Send each trustee her link."; br (); br (); ] else pcdata ""); form_trustees_add; ] in let import_link = div [ a ~service:Web_services.election_setup_import_trustees [pcdata "Import trustees from another election"] uuid ] in let back_link = div [ a ~service:Web_services.election_setup [pcdata "Go back to election setup"] uuid; ] in let content = [ div_content; import_link; back_link; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_setup_credential_authority _ se () = let title = "Credentials for election " ^ se.se_questions.t_name in let content = [ div [ pcdata "Please send the credential authority the following link:"; ]; ul [ li [ a ~service:election_setup_credentials [ pcdata @@ rewrite_prefix @@ Eliom_uri.make_string_uri ~absolute:true ~service:election_setup_credentials se.se_public_creds ] se.se_public_creds; ]; ]; div [ pcdata "Note that this authority will have to send each credential to each voter herself."; ]; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_setup_questions uuid se () = let title = "Questions for election " ^ se.se_questions.t_name in let form = let value = string_of_template se.se_questions in post_form ~service:election_setup_questions_post (fun name -> [ div [pcdata "Questions:"]; div [textarea ~a:[a_id "questions"; a_rows 5; a_cols 80] ~name ~value ()]; div [string_input ~input_type:`Submit ~value:"Save changes" ()]]) uuid in let interactivity = div ~a:[a_id "interactivity"] [ script ~a:[a_src (uri_of_string (fun () -> "../static/sjcl.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn2.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/random.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/tool_js_questions.js"))] (pcdata ""); ] in let content = [ interactivity; form; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_setup_voters uuid se maxvoters () = let title = "Voters for election " ^ se.se_questions.t_name in let form = post_form ~service:election_setup_voters_add (fun name -> [ div [textarea ~a:[a_rows 20; a_cols 50] ~name ()]; div [string_input ~input_type:`Submit ~value:"Add" ()]]) uuid in let mk_remove_button id = post_form ~service:election_setup_voters_remove (fun name -> [ string_input ~input_type:`Hidden ~name ~value:id (); string_input ~input_type:`Submit ~value:"Remove" (); ] ) uuid in let has_passwords = match se.se_metadata.e_auth_config with | Some [{auth_system = "password"; _}] -> true | _ -> false in let mk_regen_passwd value = post_form ~service:election_setup_voters_passwd ~a:[a_style "display: inline;"] (fun name -> [ string_input ~input_type:`Hidden ~name ~value (); string_input ~input_type:`Submit ~value:"Send again" (); ] ) uuid in let format_password_cell x = match x.sv_password with | Some _ -> [pcdata "Yes "; mk_regen_passwd x.sv_id] | None -> [pcdata "No"] in let voters = List.map (fun v -> tr ( [td [pcdata v.sv_id]] @ (if has_passwords then [td (format_password_cell v)] else []) @ (if se.se_public_creds_received then [] else [td [mk_remove_button v.sv_id]]) ) ) se.se_voters in let form_passwords = if has_passwords then post_form ~service:election_setup_auth_genpwd (fun () -> [string_input ~input_type:`Submit ~value:"Generate and mail missing passwords" ()] ) uuid else pcdata "" in let voters = match voters with | [] -> div [pcdata "No voters"] | _ :: _ -> div [ form_passwords; br (); table (tr ( [th [pcdata "Identity"]] @ (if has_passwords then [th [pcdata "Password sent?"]] else []) @ (if se.se_public_creds_received then [] else [th [pcdata "Remove"]]) ) :: voters) ] in let back = div [ a ~service:Web_services.election_setup [pcdata "Return to setup page"] uuid; ] in let div_add = if se.se_public_creds_received then pcdata "" else div [ div [ pcdata "Please enter the identities of voters to add, one per line (max "; pcdata (string_of_int maxvoters); pcdata "):" ]; form; div [ b [pcdata "Note:"]; pcdata " An identity is either an e-mail address, or \"address,login\","; pcdata " where \"address\" is an e-mail address and \"login\" the"; pcdata " associated login for authentication."; ]; ] in let div_import = div [ a ~service:election_setup_import [pcdata "Import voters from another election"] uuid ] in let content = [ back; div_import; br (); voters; div_add; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_setup_credentials token uuid se () = let title = "Credentials for election " ^ se.se_questions.t_name in let div_link = let url = Eliom_uri.make_string_uri ~absolute:true ~service:election_home (uuid, ()) |> rewrite_prefix in div [ pcdata "The link to the election will be:"; ul [li [pcdata url]]; ] in let form_textarea = post_form ~service:election_setup_credentials_post (fun name -> [div [div [pcdata "Public credentials:"]; div [textarea ~a:[a_id "pks"; a_rows 5; a_cols 40] ~name ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()]]]) token in let disclaimer = p [ b [pcdata "Note:"]; pcdata " submitting a large (> 200) number of credentials using the above form may fail; in this case, you have to use the command-line tool and the form below."; ] in let form_file = post_form ~service:election_setup_credentials_post_file (fun name -> [div [h2 [pcdata "Submit by file"]; div [pcdata "Use this form to upload public credentials generated with the command-line tool."]; div [file_input ~name ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()]]]) token in let div_download = p [a ~service:election_setup_credentials_download [pcdata "Download current file"] token] in let group = let name : 'a Eliom_parameter.param_name = Obj.magic "group" in let value = se.se_group in div ~a:[a_style "display:none;"] [ div [pcdata "UUID:"]; div [textarea ~a:[a_id "uuid"; a_rows 1; a_cols 40; a_readonly `ReadOnly] ~name ~value:(Uuidm.to_string uuid) ()]; div [pcdata "Group parameters:"]; div [textarea ~a:[a_id "group"; a_rows 5; a_cols 40; a_readonly `ReadOnly] ~name ~value ()]; ] in let voters = let name : 'a Eliom_parameter.param_name = Obj.magic "voters" in let value = String.concat "\n" (List.map (fun x -> x.sv_id) se.se_voters) in div [ div [pcdata "List of voters:"]; div [textarea ~a:[a_id "voters"; a_rows 5; a_cols 40; a_readonly `ReadOnly] ~name ~value ()]; ] in let interactivity = div ~a:[a_id "interactivity"] [ script ~a:[a_src (uri_of_string (fun () -> "../static/sjcl.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn2.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/random.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/tool_js_credgen.js"))] (pcdata ""); ] in let div_textarea = div [group; voters; interactivity; form_textarea; disclaimer] in let content = if se.se_public_creds_received then ( [ div [pcdata "Credentials have already been generated!"]; ] ) else ( [ div_link; div_download; div_textarea; form_file; ] ) in base ~title ~content () let election_setup_trustee token uuid se () = let title = "Trustee for election " ^ se.se_questions.t_name in let div_link = let url = Eliom_uri.make_string_uri ~absolute:true ~service:election_home (uuid, ()) |> rewrite_prefix in div [ pcdata "The link to the election will be:"; ul [li [pcdata url]]; ] in let form = let trustee = List.find (fun x -> x.st_token = token) se.se_public_keys in let value = trustee.st_public_key in let service = Eliom_service.preapply election_setup_trustee_post token in post_form ~service (fun name -> [ div [ div [pcdata "Public key:"]; div [textarea ~a:[a_rows 5; a_cols 40; a_id "pk"] ~name ~value ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] ] ) () in let group = let name : 'a Eliom_parameter.param_name = Obj.magic "group" in let value = se.se_group in div ~a:[a_style "display:none;"] [ div [pcdata "Group parameters:"]; div [textarea ~a:[a_id "group"; a_rows 5; a_cols 40; a_readonly `ReadOnly] ~name ~value ()]; ] in let interactivity = div ~a:[a_id "interactivity"] [ script ~a:[a_src (uri_of_string (fun () -> "../static/sjcl.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn2.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/random.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../static/tool_js_tkeygen.js"))] (pcdata ""); ] in let content = [ div_link; group; interactivity; form; ] in base ~title ~content () let election_setup_importer ~service ~title uuid (elections, tallied, archived) () = let format_election election = let module W = (val election : ELECTION_DATA) in let name = W.election.e_params.e_name in let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in let form = post_form ~service (fun from -> [ div [pcdata name; pcdata " ("; pcdata uuid_s; pcdata ")"]; div [ user_type_input Uuidm.to_string ~input_type:`Hidden ~name:from ~value:W.election.e_params.e_uuid (); string_input ~input_type:`Submit ~value:"Import from this election" (); ] ] ) uuid in li [form] in let itemize xs = match xs with | [] -> p [pcdata "You own no such elections!"] | _ -> ul @@ List.map format_election xs in let content = [ h2 [pcdata "Elections you can administer"]; itemize elections; h2 [pcdata "Tallied elections"]; itemize tallied; h2 [pcdata "Archived elections"]; itemize archived; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_setup_import uuid se elections = let title = "Election " ^ se.se_questions.t_name ^ " — Import voters from another election" in let service = election_setup_import_post in election_setup_importer ~service ~title uuid elections let election_setup_import_trustees uuid se elections = let title = "Election " ^ se.se_questions.t_name ^ " — Import trustees from another election" in let service = election_setup_import_trustees_post in election_setup_importer ~service ~title uuid elections let election_setup_confirm uuid se () = let title = "Election " ^ se.se_questions.t_name ^ " — Finalize creation" in let voters = Printf.sprintf "%d voter(s)" (List.length se.se_voters) in let ready = not (se.se_voters = []) in let ready, passwords = match se.se_metadata.e_auth_config with | Some [{auth_system = "password"; _}] -> if List.for_all (fun v -> v.sv_password <> None) se.se_voters then ready, "OK" else false, "Missing" | _ -> ready, "Not applicable" in let ready, credentials = if se.se_public_creds_received then ready, if se.se_metadata.e_cred_authority = None then "Received" else "Sent" else false, "Missing" in let ready, trustees = match se.se_public_keys with | [] -> ready, "OK" | _ :: _ -> if List.for_all (fun {st_public_key; _} -> st_public_key <> "" ) se.se_public_keys then ready, "OK" else false, "Missing" in let div_trustee_warning = match se.se_public_keys with | [] -> div [ b [pcdata "Warning:"]; pcdata " No trustees were set. This means that the server will manage the election key by itself."; ] | _ :: _ -> pcdata "" in let table_checklist = table [ tr [ td [pcdata "Voters?"]; td [pcdata voters]; ]; tr [ td [pcdata "Passwords?"]; td [pcdata passwords]; ]; tr [ td [pcdata "Credentials?"]; td [pcdata credentials]; ]; tr [ td [pcdata "Trustees?"]; td [pcdata trustees]; ] ] in let checklist = div [ h2 [pcdata "Checklist"]; table_checklist; div_trustee_warning; ] in let form_create = if ready then post_form ~service:election_setup_create (fun () -> [div [h2 [pcdata "Finalize creation"]; string_input ~input_type:`Submit ~value:"Create election" (); pcdata " (Warning: this action is irreversible.)"; ]] ) uuid else div [] in let back = div [ a ~service:Web_services.election_setup [pcdata "Return to setup page"] uuid; ] in let content = [ back; checklist; form_create; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let election_login_box w = let module W = (val w : ELECTION_DATA) in let module A = struct let get_user () = Web_state.get_election_user W.election.e_params.e_uuid let get_auth_systems () = let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in let%lwt l = Web_persist.get_auth_config uuid_s in return @@ List.map fst l end in let auth = (module A : AUTH_SERVICES) in let module L = struct let login x = Eliom_service.preapply election_login ((W.election.e_params.e_uuid, ()), x) let logout = Eliom_service.preapply logout () end in let links = (module L : AUTH_LINKS) in fun () -> make_login_box ~site:false auth links let file w x = let module W = (val w : ELECTION_DATA) in Eliom_service.preapply election_dir (W.election.e_params.e_uuid, x) let audit_footer w = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let module W = (val w : ELECTION_DATA) in return @@ div ~a:[a_style "line-height:1.5em;"] [ div [ div [ pcdata L.election_fingerprint; code [ pcdata W.election.e_fingerprint ]; ]; div [ pcdata L.audit_data; a ~service:(file w ESRaw) [ pcdata L.parameters ] (); pcdata ", "; a ~service:(file w ESKeys) [ pcdata L.trustee_public_keys ] (); pcdata ", "; a ~service:(file w ESCreds) [ pcdata L.public_credentials ] (); pcdata ", "; a ~service:(file w ESBallots) [ pcdata L.ballots ] (); pcdata "."; ]; ] ] let rec list_concat elt = function | x :: ((_ :: _) as xs) -> x :: elt :: (list_concat elt xs) | ([_] | []) as xs -> xs let election_home w state () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let module W = (val w : ELECTION_DATA) in let params = W.election.e_params in let state_ = match state with | `Closed -> [ pcdata " "; b [pcdata L.election_currently_closed]; ] | `Open -> [] | `EncryptedTally (_, _, hash) -> [ pcdata " "; b [pcdata L.election_closed_being_tallied]; pcdata L.the; a ~service:election_dir [pcdata L.encrypted_tally] (W.election.e_params.e_uuid, ESETally); pcdata L.hash_is; b [pcdata hash]; pcdata "."; ] | `Tallied _ -> [ pcdata " "; b [pcdata L.election_has_been_tallied]; ] | `Archived -> [ pcdata " "; b [pcdata L.election_archived]; ] in let ballots_link = p ~a:[a_style "text-align:center;"] [ a ~a:[a_style "font-size:25px;"] ~service:election_pretty_ballots [ pcdata L.see_accepted_ballots ] (params.e_uuid, ()) ] in let%lwt footer = audit_footer w in let go_to_the_booth = let disabled = match state with | `Open -> false | _ -> true in div ~a:[a_style "text-align:center;"] [ div [ make_button ~service:(Eliom_service.preapply election_vote (params.e_uuid, ())) ~disabled L.start; ]; div [ a ~service:(Eliom_service.preapply election_cast (params.e_uuid, ())) [pcdata L.advanced_mode] (); ]; ] in let%lwt middle = let uuid = Uuidm.to_string params.e_uuid in let%lwt result = Web_persist.get_election_result uuid in match result with | Some r -> let result = r.result in let questions = Array.to_list W.election.e_params.e_questions in return @@ div [ ul (List.mapi (fun i x -> let answers = Array.to_list x.q_answers in let answers = match x.q_blank with | Some true -> L.blank_vote :: answers | _ -> answers in let answers = List.mapi (fun j x -> tr [td [pcdata x]; td [pcdata @@ string_of_int result.(i).(j)]] ) answers in let answers = match answers with | [] -> pcdata "" | y :: ys -> match x.q_blank with | Some true -> table (ys @ [y]) | _ -> table (y :: ys) in li [ pcdata x.q_question; answers; ] ) questions); div [ pcdata L.number_accepted_ballots; pcdata (string_of_int r.num_tallied); ]; div [ pcdata L.you_can_also_download; a ~service:election_dir [pcdata L.result_with_crypto_proofs] (W.election.e_params.e_uuid, ESResult); pcdata "."; ]; ] | None -> return go_to_the_booth in let languages = div ~a:[a_class ["languages"]] (list_concat (pcdata " ") @@ List.map (fun lang -> a ~service:set_language [pcdata lang] lang ) available_languages) in let%lwt scd = Eliom_reference.get Web_state.show_cookie_disclaimer in let cookie_disclaimer = if scd then div ~a:[a_style "border-style: solid; border-width: 1px;"] [ pcdata L.you_must_accept_cookies; a ~service:set_cookie_disclaimer [pcdata L.accept] (); ] else pcdata "" in let content = [ cookie_disclaimer; languages; p state_; br (); middle; br (); ballots_link; ] in let%lwt login_box = election_login_box w () in let uuid = params.e_uuid in base ~title:params.e_name ?login_box ~content ~footer ~uuid () let mail_trustee_tally : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Dear trustee, The election is now closed. Here's the link to proceed to tally: %s Here's the instructions: 1. Follow the link. 2. Enter your private decryption key in the first box and click on \"generate decryption factors\" 3. The second box is now filled with crypto material. Please press the button \"submit\". Thank you again for your help, -- \nThe election administrator." let election_admin w metadata state () = let module W = (val w : ELECTION_DATA) in let title = W.election.e_params.e_name ^ " — Administration" in let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in let state_form checked = let service, value, msg = if checked then election_close, "Close election", "The election is open. Voters can vote. " else election_open, "Open election", "The election is closed. No one can vote. " in post_form ~service (fun () -> [ pcdata msg; string_input ~input_type:`Submit ~value (); ]) (W.election.e_params.e_uuid, ()) in let%lwt state_div = match state with | `Open -> return @@ div [ state_form true; ] | `Closed -> return @@ div [ state_form false; br (); post_form ~service:election_compute_encrypted_tally (fun () -> [string_input ~input_type:`Submit ~value:"Tally election" (); pcdata " Warning: this action is irreversible; the election will be definitively closed."; ]) (W.election.e_params.e_uuid, ()); ] | `EncryptedTally (npks, _, hash) -> let%lwt pds = Web_persist.get_partial_decryptions uuid_s in let trustees = let rec loop i ts = if i <= npks then match ts with | t :: ts -> (Some t, i) :: (loop (i+1) ts) | [] -> (None, i) :: (loop (i+1) ts) else [] in match metadata.e_trustees with | None -> loop 1 [] | Some ts -> loop 1 ts in let trustees = List.map (fun (name, trustee_id) -> let service = election_tally_trustees in let x = (W.election.e_params.e_uuid, ((), trustee_id)) in let uri = rewrite_prefix @@ Eliom_uri.make_string_uri ~absolute:true ~service x in let link_content, dest = match name with | None -> uri, "toto@example.org" | Some name -> name, name in tr [ td [pcdata link_content]; td [ let body = Printf.sprintf mail_trustee_tally uri in let subject = "Link to tally the election" in a_mailto ~dest ~subject ~body "Mail" ]; td [ a ~service [pcdata "Link"] x; ]; td [ pcdata (if List.mem_assoc trustee_id pds then "Yes" else "No") ]; ] ) trustees in let release_form = post_form ~service:election_tally_release (fun () -> [string_input ~input_type:`Submit ~value:"Compute the result" () ]) (W.election.e_params.e_uuid, ()) in return @@ div [ div [ pcdata "The "; a ~service:election_dir [pcdata "encrypted tally"] (W.election.e_params.e_uuid, ESETally); pcdata " has been computed. Its hash is "; b [pcdata hash]; pcdata "."; ]; div [ div [pcdata "We are now waiting for trustees..."]; table (tr [ th [pcdata "Trustee"]; th [pcdata "Mail"]; th [pcdata "Link"]; th [pcdata "Done?"]; ] :: trustees) ]; release_form; ] | `Tallied _ -> return @@ div [ pcdata "This election has been tallied."; ] | `Archived -> return @@ div [ pcdata "This election is archived."; ] in let div_archive = match state with | `Archived -> pcdata "" | _ -> div [ br (); hr (); post_form ~service:election_archive (fun () -> [ string_input ~input_type:`Submit ~value:"Archive election" (); pcdata " Warning: this action is irreversible. Archiving an election makes it read-only; in particular, the election will be definitively closed (no vote submission, no tally)."; ] ) (W.election.e_params.e_uuid, ()); ] in let uuid = W.election.e_params.e_uuid in let update_credential = match metadata.e_cred_authority with | Some "server" -> pcdata "" | _ -> div [ a ~service:election_update_credential [pcdata "Update a credential"] (uuid, ()); ]; in let content = [ div [ a ~service:Web_services.election_home [pcdata "Election home"] (uuid, ()); ]; update_credential; div [ a ~service:election_dir [pcdata "Voter list"] (uuid, ESVoters); ]; div [ a ~service:election_pretty_records [pcdata "Voting records"] (uuid, ()); ]; div [ a ~service:election_missing_voters [pcdata "Missing voters"] (uuid, ()); ]; div [ a ~service:election_regenpwd [pcdata "Regenerate and mail a password"] (uuid, ()); ]; div [state_div]; div_archive; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let update_credential w () = let module W = (val w : ELECTION_DATA) in let params = W.election.e_params in let form = post_form ~service:election_update_credential_post (fun (old, new_) -> [ div [ p [ pcdata "\ This form allows you to change a single credential at \ a time. To get the hash of a credential, run the \ following command:\ "; ]; pre [ pcdata "printf old-credential | sha256sum"; ]; p [ pcdata "In the above command, "; code [pcdata "old-credential"]; pcdata " should look like a big number written in base 10."; ]; ]; p [ pcdata "Hash of the old credential: "; string_input ~name:old ~input_type:`Text ~a:[a_size 64] (); ]; p [ pcdata "New credential: "; string_input ~name:new_ ~input_type:`Text ~a:[a_size 617] (); ]; p [string_input ~input_type:`Submit ~value:"Submit" ()]; ] ) (params.e_uuid, ()) in let content = [ form; ] in let%lwt login_box = site_login_box () in let uuid = W.election.e_params.e_uuid in base ~title:params.e_name ?login_box ~content ~uuid () let regenpwd uuid () = let form = post_form ~service:election_regenpwd_post (fun user -> [ div [ pcdata "Username: "; string_input ~name:user ~input_type:`Text (); ]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] ) (uuid, ()) in let content = [ form ] in let title = "Regenerate and mail password" in let%lwt login_box = site_login_box () in base ~title ?login_box ~content ~uuid () let cast_raw w () = let module W = (val w : ELECTION_DATA) in let params = W.election.e_params in let form_rawballot = post_form ~service:election_cast_post (fun (name, _) -> [ div [pcdata "Please paste your encrypted ballot in JSON format in the following box:"]; div [textarea ~a:[a_rows 10; a_cols 40] ~name ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] ) (params.e_uuid, ()) in let form_upload = post_form ~service:election_cast_post (fun (_, name) -> [ div [pcdata "Alternatively, you can also upload a file containing your ballot:"]; div [ pcdata "File: "; file_input ~name (); ]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] ) (params.e_uuid, ()) in let intro = div [ div [ pcdata "You can create an encrypted ballot by using the command line tool "; pcdata "(available in the "; a ~service:source_code [pcdata "sources"] (); pcdata "), or its "; a ~service:(Eliom_service.static_dir ()) [ pcdata "web interface"; ] ["static"; "belenios-tool.html"]; pcdata ". A specification of encrypted ballots is also available in the "; pcdata "sources."; ]; div [ a ~service:Web_services.election_home [pcdata "Back to election home"] (params.e_uuid, ()); ]; ] in let content = [ intro; h3 [ pcdata "Submit by copy/paste" ]; form_rawballot; h3 [ pcdata "Submit by file" ]; form_upload; ] in let%lwt login_box = election_login_box w () in let uuid = W.election.e_params.e_uuid in let%lwt footer = audit_footer w in base ~title:params.e_name ?login_box ~content ~uuid ~footer () let cast_confirmation w hash () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let module W = (val w : ELECTION_DATA) in let%lwt user = Web_state.get_election_user W.election.e_params.e_uuid in let params = W.election.e_params in let name = params.e_name in let user_div = match user with | Some u -> post_form ~service:election_cast_confirm (fun () -> [ p ~a:[a_style "text-align: center; padding: 10px;"] [ pcdata L.i_am; format_user ~site:false u; pcdata L.and_; string_input ~a:[a_style "font-size: 20px; cursor: pointer;"] ~input_type:`Submit ~value:L.i_cast_my_vote (); pcdata "."; ] ]) (params.e_uuid, ()) | None -> div [ pcdata L.please_login_to_confirm; ] in let progress = div ~a:[a_style "text-align:center;margin-bottom:20px;"] [ pcdata L.input_credential; pcdata " — "; pcdata L.answer_to_questions; pcdata " — "; pcdata L.review_and_encrypt; pcdata " — "; pcdata L.authenticate; pcdata " — "; b [pcdata L.confirm]; pcdata " — "; pcdata L.done_; hr (); ] in let content = [ progress; div ~a:[a_class ["current_step"]] [ pcdata L.booth_step5; ]; p [ pcdata L.your_ballot_for; em [pcdata name]; pcdata L.has_been_received; pcdata L.your_tracker_is; b [pcdata hash]; pcdata "."; br (); ]; br (); p [pcdata L.nobody_can_see]; user_div; p [ (let service = Eliom_service.preapply Web_services.election_home (W.election.e_params.e_uuid, ()) in a ~service [ pcdata L.go_back_to_election ] ()); pcdata "."; ]; ] in let uuid = params.e_uuid in base ~title:name ~content ~uuid () let cast_confirmed w ~result () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let module W = (val w : ELECTION_DATA) in let params = W.election.e_params in let name = params.e_name in let progress = div ~a:[a_style "text-align:center;margin-bottom:20px;"] [ pcdata L.input_credential; pcdata " — "; pcdata L.answer_to_questions; pcdata " — "; pcdata L.review_and_encrypt; pcdata " — "; pcdata L.authenticate; pcdata " — "; pcdata L.confirm; pcdata " — "; b [pcdata L.done_]; hr (); ] in let result, step_title = match result with | `Valid hash -> [pcdata L.has_been_accepted; pcdata " "; pcdata L.your_tracker_is; b [pcdata hash]; pcdata ". "; pcdata L.you_can_check_its_presence; a ~service:election_pretty_ballots [pcdata L.ballot_box] (params.e_uuid, ()); pcdata L.anytime_during_the_election; pcdata L.confirmation_email; ], L.thank_you_for_voting | `Error e -> [pcdata L.is_rejected_because; pcdata (Web_common.explain_error e); pcdata "."; ], L.fail in let content = [ progress; div ~a:[a_class ["current_step"]] [ pcdata L.booth_step6; pcdata step_title; ]; p ([ pcdata L.your_ballot_for; em [pcdata name]; ] @ result); p [a ~service:Web_services.election_home [pcdata L.go_back_to_election] (params.e_uuid, ())]; ] in let uuid = params.e_uuid in base ~title:name ~content ~uuid () let pretty_ballots w hashes result () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let module W = (val w : ELECTION_DATA) in let params = W.election.e_params in let title = params.e_name ^ " — " ^ L.accepted_ballots in let nballots = ref 0 in let hashes = List.sort compare_b64 hashes in let ballots = List.map (fun h -> incr nballots; li [a ~service:election_pretty_ballot [pcdata h] ((params.e_uuid, ()), h)] ) hashes in let links = p [a ~service:Web_services.election_home [pcdata L.go_back_to_election] (params.e_uuid, ())] in let number = match !nballots, result with | n, None -> div [ pcdata (string_of_int n); pcdata L.ballots_have_been_accepted_so_far; ] | n, Some r when n = r.num_tallied -> div [ pcdata (string_of_int n); pcdata L.ballots_have_been_accepted; ] | n, Some r -> (* should not happen *) div [ pcdata (string_of_int n); pcdata L.ballots_have_been_accepted_and; pcdata (string_of_int r.num_tallied); pcdata L.have_been_tallied; ] in let content = [ number; ul ballots; links; ] in let%lwt login_box = election_login_box w () in let uuid = params.e_uuid in base ~title ?login_box ~content ~uuid () let pretty_records w records () = let module W = (val w : ELECTION_DATA) in let uuid = W.election.e_params.e_uuid in let title = W.election.e_params.e_name ^ " — Records" in let records = List.map (fun (date, voter) -> tr [td [pcdata date]; td [pcdata voter]] ) records in let table = match records with | [] -> div [pcdata "Nobody voted!"] | _ -> div [ table (tr [th [pcdata "Date/Time (UTC)"]; th [pcdata "Username"]] :: records); ] in let content = [ div [ pcdata "You can also access the "; a ~service:election_dir [pcdata "raw data"] (uuid, ESRecords); pcdata "."; ]; table; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () let tally_trustees w trustee_id () = let module W = (val w : ELECTION_DATA) in let params = W.election.e_params in let title = params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id in let content = [ p [pcdata "It is now time to compute your partial decryption factors."]; p [ pcdata "The hash of the encrypted tally is "; b [span ~a:[a_id "hash"] []]; pcdata "." ]; div ~a:[a_id "input_private_key"] [ p [pcdata "Please enter your private key:"]; input ~a:[a_id "private_key"; a_size 80] ~input_type:`Text (); button ~a:[a_id "compute"] ~button_type:`Button [pcdata "Compute decryption factors"]; ]; div ~a:[a_id "pd_done"] [ post_form ~service:election_tally_trustees_post (fun pd -> [ div [ textarea ~a:[a_rows 5; a_cols 40; a_id "pd"] ~name:pd (); ]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] ) (params.e_uuid, ((), trustee_id)); ]; div [ script ~a:[a_src (uri_of_string (fun () -> "../../../static/sjcl.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../../../static/jsbn.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../../../static/jsbn2.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../../../static/random.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../../../static/tool_js_pd.js"))] (pcdata ""); ] ] in let uuid = params.e_uuid in base ~title ~content ~uuid () let already_logged_in () = let title = "Already logged in" in let content = [ div [ pcdata "You are already logged in as an administrator or on another election. You have to "; a ~service:logout [pcdata "log out"] (); pcdata " first."]; ] in base ~title ~content () let login_choose auth_systems service () = let auth_systems = auth_systems |> List.map (fun name -> a ~service:(service name) [pcdata name] () ) |> list_join (pcdata ", ") in let content = [ div [p ( [pcdata "Please log in: ["] @ auth_systems @ [pcdata "]"] )] ] in base ~title:"Log in" ~content () let login_dummy () = let title, field_name, input_type = "Dummy login", "Username:", `Text in let form = post_form ~service:dummy_post (fun name -> [ tablex [tbody [ tr [ th [label ~a:[a_for name] [pcdata field_name]]; td [string_input ~a:[a_maxlength 50] ~input_type ~name ()]; ]] ]; div [ string_input ~input_type:`Submit ~value:"Login" (); ] ]) () in let content = [ form; ] in base ~title ~content () let login_password () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let form = post_form ~service:password_post (fun (llogin, lpassword) -> [ tablex [tbody [ tr [ th [label ~a:[a_for llogin] [pcdata L.username]]; td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:llogin ()]; ]; tr [ th [label ~a:[a_for lpassword] [pcdata L.password]]; td [string_input ~a:[a_maxlength 50] ~input_type:`Password ~name:lpassword ()]; ]; ]]; div [ string_input ~input_type:`Submit ~value:L.login (); ] ]) () in let content = [ form; ] in base ~title:L.password_login ~content () let booth () = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) in let head = head (title (pcdata L.belenios_booth)) [ link ~rel:[`Stylesheet] ~href:(uri_of_string (fun () -> "/static/booth.css")) (); script ~a:[a_src (uri_of_string (fun () -> "/static/sjcl.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "/static/jsbn.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "/static/jsbn2.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "/static/random.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "/static/booth.js"))] (pcdata ""); ] in let election_loader = let name : 'a Eliom_parameter.param_name = Obj.magic "election_params" in div ~a:[a_id "election_loader"; a_style "display:none;"] [ h1 [pcdata "Election loader"]; pcdata "Election parameters:"; div [textarea ~name ~a:[a_id "election_params"; a_rows 1; a_cols 80] ()]; div [button ~button_type:`Button ~a:[a_id "load_election"] [pcdata "Load election"]]; ] in let text_choices = let name : 'a Eliom_parameter.param_name = Obj.magic "choices" in textarea ~name ~a:[a_id "choices"; a_rows 1; a_cols 80; a_readonly `ReadOnly] () in let ballot_form = post_form ~a:[a_id "ballot_form"] ~service:election_cast_post (fun (encrypted_vote, _) -> [ div ~a:[a_style "display:none;"] [ pcdata "Encrypted ballot:"; div [ textarea ~a:[a_id "ballot"; a_rows 1; a_cols 80; a_readonly `ReadOnly] ~name:encrypted_vote (); ]; ]; p [ pcdata L.successfully_encrypted; b [pcdata L.not_cast_yet]; pcdata L.qmark; ]; p [ pcdata L.your_tracker_is; span ~a:[a_id "ballot_tracker"] []; ]; p [ pcdata L.we_invite_you_to_save_it; ]; br (); string_input ~input_type:`Submit ~value:L.continue ~a:[a_style "font-size:30px;"] (); br (); br (); ]) (Uuidm.nil, ()) in let main = div ~a:[a_id "main"] [ div ~a:[a_style "text-align:center; margin-bottom:20px;"] [ span ~a:[a_id "progress1"; a_style "font-weight:bold;"] [pcdata L.input_credential]; pcdata " — "; span ~a:[a_id "progress2"] [pcdata L.answer_to_questions]; pcdata " — "; span ~a:[a_id "progress3"] [pcdata L.review_and_encrypt]; pcdata " — "; span ~a:[a_id "progress4"] [pcdata L.authenticate]; pcdata " — "; span ~a:[a_id "progress5"] [pcdata L.confirm]; pcdata " — "; span ~a:[a_id "progress6"] [pcdata L.done_]; hr (); ]; div ~a:[a_id "intro"; a_style "text-align:center;"] [ div ~a:[a_class ["current_step"]] [ pcdata L.booth_step1; ]; br (); br (); p ~a:[a_id "input_code"; a_style "font-size:20px;"] [ pcdata L.input_your_credential; ]; br (); br (); ]; div ~a:[a_id "question_div"; a_style "display:none;"] [ div ~a:[a_class ["current_step"]] [ pcdata L.booth_step2; ]; ]; div ~a:[a_id "plaintext_div"; a_style "display:none;"] [ div ~a:[a_class ["current_step"]] [ pcdata L.booth_step3; ]; div ~a:[a_id "pretty_choices"] []; div ~a:[a_style "display:none;"] [ pcdata "Plaintext raw ballot:"; div [text_choices]; ]; div ~a:[a_style "text-align:center;"] [ div ~a:[a_id "encrypting_div"] [ p [pcdata L.wait_while_encrypted]; img ~src:(uri_of_string (fun () -> "/static/encrypting.gif")) ~alt:L.encrypting (); ]; div ~a:[a_id "ballot_div"; a_style "display:none;"] [ballot_form]; Unsafe.data (""); br (); br (); ]; ]; ] in let booth_div = div ~a:[a_id "booth_div"; a_style "display:none;"] [ div ~a:[a_id "header"] [ div ~a:[a_style "float: left; padding: 15px;"] [ img ~alt:L.election_server ~a:[a_height 70] ~src:(uri_of_string (fun () -> "/static/logo.png")) (); ]; div ~a:[a_style "float: right; padding: 15px;"] [ img ~alt:"" ~a:[a_height 70] ~src:(uri_of_string (fun () -> "/static/placeholder.png")) (); ]; div ~a:[a_style "text-align:center; padding: 20px;"] [ h1 ~a:[a_id "election_name"] []; p ~a:[a_id "election_description"] []; ]; div ~a:[a_style "clear: both;"] []; ]; main; div ~a:[a_id "footer"] [ div ~a:[a_id "bottom"] [ div [ pcdata L.election_uuid; span ~a:[a_id "election_uuid"] []; ]; div [ pcdata L.election_fingerprint; span ~a:[a_id "election_fingerprint"] []; ]; ]; ]; div ~a:[a_style "display:none;"] [ span ~a:[a_id "str_here"] [pcdata L.here]; span ~a:[a_id "question_header"] [pcdata L.question_header]; span ~a:[a_id "at_least"] [pcdata L.at_least]; span ~a:[a_id "at_most"] [pcdata L.at_most]; span ~a:[a_id "str_previous"] [pcdata L.previous]; span ~a:[a_id "str_next"] [pcdata L.next]; span ~a:[a_id "str_nothing"] [pcdata L.nothing]; span ~a:[a_id "enter_cred"] [pcdata L.enter_cred]; span ~a:[a_id "invalid_cred"] [pcdata L.invalid_cred]; span ~a:[a_id "str_blank_vote"] [pcdata L.blank_vote]; span ~a:[a_id "no_other_blank"] [pcdata L.no_other_blank]; ]; ] in let body = body [ div ~a:[a_id "wrapper"] [ election_loader; booth_div; ]; ] in return @@ html ~a:[a_dir `Ltr; a_xml_lang L.lang] head body belenios-1.4+dfsg/src/web/web_templates.mli000066400000000000000000000127501307140314400210010ustar00rootroot00000000000000(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2016 Inria *) (* *) (* 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, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* 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 *) (* . *) (**************************************************************************) open Serializable_t open Web_serializable_t open Signatures val admin : elections:((module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list * (Uuidm.t * string) list) option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val generic_page : title:string -> ?service:(unit, unit, [< Eliom_service.get_service_kind ], [< Eliom_service.attached ], [< Eliom_service.service_kind ], [< Eliom_service.suff ], 'a, unit, [< Eliom_service.registrable ], [< Eliom_service.non_ocaml_service ]) Eliom_service.service -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_pre : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_voters : Uuidm.t -> setup_election -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_questions : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_credential_authority : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_credentials : string -> Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_trustees : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_trustee : string -> Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_import : Uuidm.t -> setup_election -> (module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_import_trustees : Uuidm.t -> setup_election -> (module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_confirm : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_home : (module ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_admin : (module ELECTION_DATA) -> Web_serializable_j.metadata -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val update_credential : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val regenpwd : Uuidm.t -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val cast_raw : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val cast_confirmation : (module ELECTION_DATA) -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val cast_confirmed : (module ELECTION_DATA) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val pretty_ballots : (module ELECTION_DATA) -> string list -> Yojson.Safe.json result option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val pretty_records : (module ELECTION_DATA) -> (string * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val tally_trustees : (module ELECTION_DATA) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val already_logged_in : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val login_choose : string list -> (string -> (unit, unit, [< Eliom_service.get_service_kind ], [< Eliom_service.attached ], [< Eliom_service.service_kind ], [< Eliom_service.suff ], 'a, unit, [< Eliom_service.registrable ], [< Eliom_service.non_ocaml_service ]) Eliom_service.service) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val login_dummy : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val login_password : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val booth : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t