diff -Nru belenios-1.4+dfsg/all.itarget belenios-1.6+dfsg/all.itarget --- belenios-1.4+dfsg/all.itarget 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/all.itarget 2018-06-13 11:46:49.000000000 +0000 @@ -6,6 +6,7 @@ src/static/belenios-tool.html.otarget src/static/vote.html.otarget src/static/tool_js_tkeygen.js +src/static/tool_js_ttkeygen.js src/static/tool_js_credgen.js src/static/tool_js_questions.js src/static/tool_js_pd.js diff -Nru belenios-1.4+dfsg/all-native.itarget belenios-1.6+dfsg/all-native.itarget --- belenios-1.4+dfsg/all-native.itarget 1970-01-01 00:00:00.000000000 +0000 +++ belenios-1.6+dfsg/all-native.itarget 2018-06-13 11:46:49.000000000 +0000 @@ -0,0 +1 @@ +src/web/server.cmxs diff -Nru belenios-1.4+dfsg/CHANGES.md belenios-1.6+dfsg/CHANGES.md --- belenios-1.4+dfsg/CHANGES.md 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/CHANGES.md 2018-06-13 11:46:49.000000000 +0000 @@ -1,3 +1,26 @@ +1.6 (2018-06-13) +================ + + * Add (optional) contact info in emails sent by the server + * Use base 58 tokens as UUIDs for shorter URLs (optional) + * Add (optional) return path to mails sent by server + * Show personal data processing notice to election administrators + * Fix password regeneration when explicit usernames are used + * Make the booth independent of the server and usable offline + * Internationalize error messages + +1.5 (2017-12-13) +================ + + * Add support for threshold decryption (experimental) + * Fix bias in random sampling + * Web server: + + Add possibility to define the server e-mail address in config + + Add possibility to explicitly add the server itself as a trustee + + Add possibility to destroy elections in setup mode + + Avoid new tabs and use download links + + Add config option for "contact us" link on admin login page + 1.4 (2017-04-05) ================ diff -Nru belenios-1.4+dfsg/debian/changelog belenios-1.6+dfsg/debian/changelog --- belenios-1.4+dfsg/debian/changelog 2017-07-27 04:56:00.000000000 +0000 +++ belenios-1.6+dfsg/debian/changelog 2018-06-13 13:36:06.000000000 +0000 @@ -1,3 +1,14 @@ +belenios (1.6+dfsg-1) unstable; urgency=medium + + * New upstream release + - Fix compilation with OCaml 4.05.0 (Closes: #878980) + * Update Vcs-* to point to salsa + * Set pristine-tar filter in debian/gbp.conf + * Bump Standards-Version to 4.1.4 + * Fix Homepage URL + + -- Stéphane Glondu Wed, 13 Jun 2018 15:36:06 +0200 + belenios (1.4+dfsg-2) unstable; urgency=medium * Add ocamlbuild to Build-Depends diff -Nru belenios-1.4+dfsg/debian/control belenios-1.6+dfsg/debian/control --- belenios-1.4+dfsg/debian/control 2017-07-27 04:55:40.000000000 +0000 +++ belenios-1.6+dfsg/debian/control 2018-06-13 13:36:06.000000000 +0000 @@ -22,10 +22,10 @@ texlive-fonts-extra, lmodern, uuid-runtime -Standards-Version: 3.9.8 -Homepage: https://www.belenios.org/ -Vcs-Browser: https://anonscm.debian.org/git/pkg-ocaml-maint/packages/belenios.git -Vcs-Git: https://anonscm.debian.org/git/pkg-ocaml-maint/packages/belenios.git +Standards-Version: 4.1.4 +Homepage: http://www.belenios.org/ +Vcs-Browser: https://salsa.debian.org/ocaml-team/belenios +Vcs-Git: https://salsa.debian.org/ocaml-team/belenios.git Package: belenios-tool Architecture: any diff -Nru belenios-1.4+dfsg/debian/copyright belenios-1.6+dfsg/debian/copyright --- belenios-1.4+dfsg/debian/copyright 2017-07-27 04:53:57.000000000 +0000 +++ belenios-1.6+dfsg/debian/copyright 2018-06-13 13:28:36.000000000 +0000 @@ -1,7 +1,8 @@ -Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Packaged-By: Stéphane Glondu Packaged-Date: Thu, 06 Apr 2017 11:31:20 +0200 Source: http://www.belenios.org/ +Files-Excluded: ext Files: * Copyright: 2012-2017 Inria diff -Nru belenios-1.4+dfsg/debian/gbp.conf belenios-1.6+dfsg/debian/gbp.conf --- belenios-1.4+dfsg/debian/gbp.conf 2017-07-27 04:53:57.000000000 +0000 +++ belenios-1.6+dfsg/debian/gbp.conf 2018-06-13 12:40:43.000000000 +0000 @@ -1,2 +1,4 @@ [DEFAULT] pristine-tar = True +filter-pristine-tar = True +filter = [ "ext" ] diff -Nru belenios-1.4+dfsg/debian/rules belenios-1.6+dfsg/debian/rules --- belenios-1.4+dfsg/debian/rules 2017-07-27 04:56:00.000000000 +0000 +++ belenios-1.6+dfsg/debian/rules 2018-06-13 13:28:36.000000000 +0000 @@ -7,9 +7,13 @@ .PHONY: override_dh_auto_build override_dh_auto_build: $(MAKE) minimal +ifeq (,$(findstring nodoc,$(DEB_BUILD_OPTIONS))) $(MAKE) doc +endif _build/belenios-tool --help=groff > debian/belenios-tool.1 .PHONY: override_dh_auto_test override_dh_auto_test: +ifeq (,$(filter nocheck,$(DEB_BUILD_OPTIONS))) demo/demo.sh +endif diff -Nru belenios-1.4+dfsg/debian/upstream/signing-key.asc belenios-1.6+dfsg/debian/upstream/signing-key.asc --- belenios-1.4+dfsg/debian/upstream/signing-key.asc 1970-01-01 00:00:00.000000000 +0000 +++ belenios-1.6+dfsg/debian/upstream/signing-key.asc 2018-06-13 13:28:36.000000000 +0000 @@ -0,0 +1,268 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- + +mQINBEpaWw8BEAC8yDOX137e5bAH9E7kQhGiERN4atC7h7ZeeSYDaiToOdg7Ome8 +kSoIGlEEDxlU3LffKbQfH2SJtRfAH1bUHuJ1xq769AVpAsAN9elkcKkieAERQeA9 +uzR+prrM2KMT1dZJQTKbOkTu6CLKyzNsnuGa+osfMRxYN8atUqXD7fVBLeuoVnqB +VOSS7dLYsU2mR6CSvBlsppxCub0ArNZ5BBxhmQJK7M8bnRfqF10jn/thDBk70FVV +uKnKKYICh+nbfFwxG9vQwQYQkgQHdMfCUHPnAQMo1dBMVCiP19+dkzpGfHMBp+e/ +2gMd6YngoBhj2oKlaokV8Bil5q4D1UArWm/U3I5AdPu/l762DtF0Bo1XIKQYp1ec +vX0VS6ZzVpC4JVomFcqi+uGjzC1vEENQAb+ghEhv20UDQKMsSvSaqM791CdWNJds +stgHunrBSVWhPRq2JtehOp9avTXbop4NZJfs4QwTW6el+q2M4HFoM6k7jBM8wJWo +aAkKi6d90t5DJwEet4D26KWQi+/fS8MvavWLpR0qkObdTWFUuHq8665U5HPaNEW6 +C1WzTt2TjWl9HjuIeiPlvPnnHtRBCe/g4g0EepTm8GH9E0FjzI9txDYcZD11bj1k +VHu32Pzkrvzdgz/JP0NUbASS1bQwRoSLwtVPflS+dWiEt9DnOVazeWpjEwARAQAB +tCNTdMOpcGhhbmUgR2xvbmR1IDxzdGVwaEBnbG9uZHUubmV0PokCOgQTAQgAJAIb +AwIeAQIXgAIZAQUCSlpdiQULCQgHAwUVCgkICwUWAgMBAAAKCRB4U9pNSYga0/ei +D/9taJ6OVuJ+tLkaRgdA+EttGAkiTVyYBaZLfqIF0oxvqFkAu8b+x2vyXraK0IW8 +A5n9kZQ/RSvW70MztgVAjT8OLjM64fgflMpbsSDXAiYriZ9gmtyokAJ42OMGi3WF +civQjesTSfuPcIA8aX+ZtruEmLgFoc5V/4OXF2a5jXn9SWXk3SjBclkx6fvgvg+O +kYZb/dwEhpNcWYJAvnkTLxok6TvI5AsFMhS2OlDeQDk6/4CdjmQ6z1rpMLTuwB9+ +KD4YOu4ju9laNWt9a1Yl3Ki2W8EtlBKQ49tqCTmY+swAVp6xWMpzCrcafqjFOTjV +tBe6tImt5z002hVu10VViLTmtrvnrWZTgISFAe4PRnzlMjiGCP53JZH7ULOUOrVA +LGNwl04VEve7BnwG+mOaBXXCPX446qhp2qvHfBo8z2wusM+p3741Dq+sIdiZUfhZ +EB53qXfkIQPESv2hF+p4Q6q8rf2+hVSBzxgfLDRodISwdaLfWoLQbyv49FzVlt6y +5xU52+fvzKMu6qywAz/qddwZiGn3svaIEOeZjOM8klmpllwoTiSuPoAlFPCb3aqu +6JUbKVyj0ApdVCJHY/0F1W97Q2rCA7RcZcZSneHRl9chg63SppuLes6ZGggBqGb2 +NY6Ptrnn0v+YWnRqg+A9NncFemQBLls/BzKLbwDvnQdhirQsU3TDqXBoYW5lIEds +b25kdSA8U3RlcGhhbmUuR2xvbmR1QGNyYW5zLm9yZz6JAjcEEwEIACECGwMCHgEC +F4AFAkpaXVgFCwkIBwMFFQoJCAsFFgIDAQAACgkQeFPaTUmIGtNsjxAAoR8U0GjK +F7XGnQMDYUaqhZ2I1fW50z2TXQaTv5ozPs4xm7of2SeqZYcRfXmOK+uZHAXTwXRz +A0efbvaMKuCsy4pKz1lZURGtMXcjTYIFSEYhjulSp24xIWVPoMeY23118nUQHWmh +nfVVNJM5yGdfw/+GrViHZFoUIoIwVWfcNCjs4+jHTTUzNMPMU2SBYIRu5ohM+oc8 +yJSgL98/Klfu6DBJEFeV043ayP1nRCSQJaFrpsNq+8wKjrBPTYnzkptcc+qUNuMF +IWyKv3DzvrZe1maWbhxNqpROGWfPVzKQa6YGTDS4mu+dPEtnHmrZpF99ChTaryEZ +F4N+i5i6O+R2MuZF5ckLDrT+wJ49kDTfUKPRv1DDHerkglEdWJq3oSz1txjPzVNL +oOXX2hC9f+sdAJqHME5QribMhHlLUPKkWb8ZW0R1tix5SDDuDR3GtZ6ZUrnQ/oX1 +7r7FTVLf3rlf46C7SuAtH8nn7Q2XEKDBb3IocqCzFhFzE4JAifcd0hmJIp+ARuoE +aQ/g4WoapN8ZP2D/Bd7uNkh/mTHfVnkMQFYO8Zbj2Z0Fmw58d+7A0Tq9u3lOLWZc +5E/de5FC7uxhej8gCEIwCtxP2HQSF3w9hZyAAqKZBc8aBDKU6Zs+UTZnVgLIsqUx +79557ruoNrG07hGOtHENMRBVr/1ck9UHlBu0MVN0w6lwaGFuZSBHbG9uZHUgPFN0 +ZXBoYW5lLkdsb25kdUBwcHMuanVzc2lldS5mcj6JAh8EMAEKAAkFAlDeFS0CHSAA +CgkQeFPaTUmIGtOS8g/6A5Hy26zLswpstlKicjJb5k6ocJyL68Lpc+NVWpFoiFUP +OBr96mkAXJZIpnhDEdXzxFzpda8RSlfvwQ56Fs/Yta06XaJlhN/qlfzdun8OuoYn +SIKcbdXHUrsDz2JsxMPMTeY9/xKdM00ZmWfFk9lCOJB2ya0p1rYGFbQNcffa+lkW +pyK8B8a567ct/MVyReg2I9WItzwwzgnhnofnPw/O8kfTVpRz7rxvN9dsQ76Yhx73 +bWNo/9c1ju+tDg7NczJOLEt08fAF4l34dzBEyl3kZ+HhxyNiCon0VsgbQ/UsWqe/ +QF3i3/j3hxE0rzexRseYgCbV0/6pIVWS73tJ6ZVb5zWUfFeRYSaFQxrNBBHRQkL9 +gTyM5PgTEZim7RjL5hccNDuwBTyVGnC1a78MLsPvmFbbILrzJ9eFS80AIL0h8IF3 +3zpsyUpT2VRE8nbId5PyDoNiOiw2OUfLIP/qe20VCVAM/0ufY3sKx+YFmG5OXeuR +UqYcSDB5WzrpSXkocGRIW98yZZyO3qFIG1pL8VnxRZ8i90HOZDcKNFyJq9L4NaHL +ihtzsacKiMXS3rZrTwBKum0QRqeEFmbUl3soNbQr8dNgz2P6Xv4Qq6bs+OkRYW6L ++6Zn/um5TVzRiRfPqLZNrMvxVCWH6e8hj5/FJUjNnXNonLUUFzT/SZe3y/CqKv3R +zsvOyQEQAAEBAAAAAAAAAAAAAAAA/9j/4AAQSkZJRgABAQEASABIAAD/2wBDAAgF +BgcGBQgHBgcJCAgJDBMMDAsLDBgREg4THBgdHRsYGxofIywlHyEqIRobJjQnKi4v +MTIxHiU2OjYwOiwwMTD/2wBDAQgJCQwKDBcMDBcwIBsgMDAwMDAwMDAwMDAwMDAw +MDAwMDAwMDAwMDAwMDAwMDAwMDAwMDAwMDAwMDAwMDAwMDD/wAARCADCAJYDASIA +AhEBAxEB/8QAHAAAAQQDAQAAAAAAAAAAAAAAAAIDBAUBBgcI/8QAQBAAAQMCBAMF +BgMFBgcAAAAAAQACAwQRBRIhMQZBUQcTImFxIzKBkaHBFEKxCBUzUtEWJCU0kuFT +YoKissLw/8QAGAEBAAMBAAAAAAAAAAAAAAAAAAECAwT/xAAfEQEBAQEAAwEBAAMA +AAAAAAAAAQIRAxIhMRMiMlH/2gAMAwEAAhEDEQA/AO/oQhAIQhAIQhAIULF8WocG +on1eJ1UVNCwe9I4C56DqfJcr4g7c4onviwLDhNa4E87iGnzDRY/og7CheYcT7UeL +cQe5zsUfTsOzIGhgHy1PxuoDeO+KGC0eN1kYJuQyTKCeuiI69WoXmfCO1ji3Di0P +rxWRj8lSwPv/ANXvfVb3w3240lRK2HiDDzS307+nOdo9WnUD0JQ666hQsHxfDsZp +BU4VWRVcJ/NG69vIjcHyKmokIQhAIQhAIQhAIQhAIQhALnHaF2r0PDzpKDBhHiGI +tu15zeyhPmR7x8h8TyTHbVx47AqT9yYTLlxGqZeWRp1gjPTo4/Qa8wuAWL7uJRCw +4gx/E+IK01eL1clTKdsx8LB0aNgPRViVYrBFtwQoGBusrA3SjqdUCVlAF1nKgnYL +jWIYHWtq8LqpaWdv5mOtcdCNiPIr0N2bdo9HxZC2jrMlLizBrFfwzAbuZ9wvNgaS +L2TtNPNSVDJ6aR8MsZzNew2LT1BQeyELQOybj5vFND+BxF7W4rTN8XLv2/zgdeo+ +Ppv6lIQhCAQhCAQhCAVPxfj8PDXD1Xis4D+5bZjCbZ3nRo+f0urhcg/aPr3soMIw +5jvBLJJM8dcoAb/5OQcbxXEKrGMUnr66Qy1FQ8ve49TyHlyS2Upy6aKNT/xBfkrQ +Gw2WW7xfGeo8VJcEHQp9lI3TS4tY3CUw6qVEC4gcysbqunOIp5aJ0bzYaJIo5CMx +0C2RtKJLB2qlxYbGzxkXPnyUzyq3w/8AGrw4e5zA7LusTUTmu1FwFs8sdhawA8lC +mYBfRR/S9W/jOKZlG+QjQNaFisoe6ZduqtAANkiq1hcFM3eqXxziBw9i1RgONUmJ +0jiJKaQPA/mHNp8iLj4r1ph9XFX0FPWQG8VRG2Vh8nC4/VePXgAkdF6W7GK8V3Z7 +h4uS+mL4H36hxI/7S1dMcrdEIQpSEIQgEIQgFw39o8/4xhAuf8u/TkPEF3JcZ/aR +pD/gtYBp7WIn/SR90RXH6UDMOt1YjZQaRuZ17bKZqTZqw3+ujxfhTd1LhJBBCZhh +c4i6sqamJtcarDVdOS4Cc9zeysnSAxW2TEdKRqQluiktoDb0WfWnEaVwAUCR1zqF +ZOpnu/Kok9MR6qZUWIhsm6g+zKdcxwKw5ocLEK8Z6UM18xuNV3r9niUP4NrI813M +rnm3QFjLfdcKrYnRym+xXa/2dA79xYr/ACfiW29cuv2XZn8cFnK6uhCFYCEIQCEI +QC5b2/vo6nhqGMT/AN6p6gSNjDTq2xDtbW0uF1Jeb+0OKUcY4wx8jnNdO/UnYHl6 +aqurxMz1qmHsBhPW6feXM0jbc8ymqMdzG5hcM+YgC905O8xXGckjoAFlr9aYpF6z +VzXBvkpVDidVE+0wDh1VcJZAwzZXPYHWJvpdWUhkrqZ00NPA1kJDC6MHXz809Oz6 +mb5fjYqLE2PZ7tj5qXJiIDPE0WWoQzvig7zQnNlDb7/7Kxkq3yNia+zWuFi4j3Ss +LiyurO5Z0/iONvaxwijAOwNlSvr8RqnEsaAPRNzNlnlLW30NlIqpq3CoXUxnc1kz +A8ta9wD/AC0WucRhvdNsfVtN5AD8VKiOceIWKri+VhYZWlpeMzc2twrKmzSQXija +X3tc6KLnlJexXY0PFGOoK7X2CCKj4TMM72R1FXUvmja5wDntADdBubFjlxutilc6 +MFrc73WDv5QrrhmGoix3DG0sjmyGZgY7mNVpnUnIz9Lq2vSyEIWzIIQhAIQhALzt +x7Ka7jHF5GG7e+czNy8Nm/ZeifRedeM4ZsH4kxKlqY9DK57C4btcbtPyKy8veNvD +zv1r1NCxlmkA2O6bkgD5HAjS6UZPaFw2KnxPjewXYLlY6ti+c9qr/DFgLRq07jqj +K5gsGgX5DRW4iadcoCYqg1kZsBdVm2vohQtByxloLg7MT9lYyRgxZXDRR8PhNw4j +Uq2kpz3diFXevq/jz/ipHwl0rntZcE6hIfC91gW5mjbMNlMLDHPlcN9ipIAc2xJH +xVvdT+aujpHPdd9zZWNJH3UTri2t0prRGPeOqxM4WVLrq0zz6jztztFtwbhW/Bzi +OKcJzm2Wriv094KnD9z0VrwxJLW43QwUkV5e+aQRve91ed7FJyyvRiEIXa4ghCEA +hCEAuQ9tmGzxYtTYoIy+mmhELn2uGOBOh6XB09CuvJuogiqYXw1ETJonizmPaHNc +OhB3VdT2nE5vL15WnaGSEA35pdNLZuq6J23YFQYW/C6nDKOKlbN3jJGwsDGXGUt0 +A31d8lzNrraeaw1n5xvjX3q1jkzADqk1tmwjrufRR4XnRPSuBFnLDnK6Zew3T1jI +pNb2HNWFXi4khaG2cQLABU4bH3gLGXupbzHHT3ZEA52hVrmIm7CW1AqLNPvk/JT3 +AFvQjdQoHxxEXaASpDpA73DdVq0spLpgG2KZll00WJvHsmQb6KcxTWjrBmIbe2Zb +z2SUZk4tie2P/LRySPcBoLty/wDsqjs6wmmxviinpK6LvafJI57bkbNNjcba2Xb8 +BwHDsBp3w4ZB3TZHZnuLi5zj5krozjt65rvkuVmhCFuxCEIQCEIQCEIQaF23URqe +DBUNbc0lQyQno03afq4LhGhXp7i11B/ZyvZir8lLLC6JxAu7xCwyjmb7Ly9fI8tP +I2We4vipUbrDZInks72jgL8hyWGO0T8TGyNIeBdc9+X66Z9hENRFGRla5xClCuiL +biK56FMBpidpfROisttFtzU/K0k+ESTZ73pz6hNwSe2OUPaPNSO8Exub+gThDGtA +sq2z8LPvwkg3TDhYlPF2iZJzOATLPddN7DcNe+vrsTc32ccfcNJ5ucQTb0A+q64q +DgHCosI4ToII7F0kYnkd/M94ufloPQBX668zkclvaEIQrICEIQCEIQCEKLX4lQ4e +3NW1UMF9g9wBPoNz8EHNe1TGXVFc6jjf7CjGoGzpCNT8Bp81xmckvLhzN10bHpBX +1lfKwkieWR7SRyLjZc9LC0ljhZzSWlZ7vE+OdtNxPuVLadNFBmYWHM1OQVA2doVl +qd+xvnXreVZxC48SdETCfdUeGUb3UptSwNtzWTfrIjAHhCZeDfXklPqvko89U0C5 +KiS2l1JCpXhovskQEucHcgmGXndc+70Uhx7uMnkAtPz4y/2+u29l/EslbTswysfn +cxnsHnewHunrpqPQrfVxHs1L4sSoJLm75mgehNv0K7cuqOSBCEKUhCEIIGJ41huF +j+/VkUTt8l7u/wBI1WqYn2jwtuzCqN8p2Ek3hb8hqfmFz2wBuWknqSsucQf6FQp7 +LzEuL8cxAkOq/wAKwj3KYZB89/qqrD/a1hfI4vcPEXONyVFcLnQlS8MZmM+XfLZF +emw673W5krXOIKDuqg1UY8D/AH7cj1V8DY+aVJG2eIxvAcHCxuos7OLY163rS3xZ +m2UGWDK6y2CuoH0cpFi6InQ9PJV1TFzXN25vK7uTc7EBomaPC66zmqCdinw2xT7R +dt9Fb2V9EJoqHaE2CW2Al3iJJ80/rdPQM1udVF0mYZijyNCVT0r6+qZTsvl3eRyC +VkkmkEcTS556LaMFw5tDCAQC92rj1KePPb2q+XczORc4ADS1VOYQA+Eh7bi4u3UD +6LoOFcZYdVv7msP4KcGxEh8BPk7+tlz/AA3SrZ1JUfEHD95zNda19AuhyS8dqa4O +aHNIIIuCOayuQYVjWIYS4fgqhwZe/dP8TD8OXwstzwjjuhqGtZiTHUku2cDNGfju +PiPip6t1tiEmKSOaNskT2yMcLtc03BHkUKUuBeO10nzJKURysknQW6+ShiUHkttf +yKsOHyPxTxe92318tfsq12gtv5pWH1DqeujeLgXsiVhi9GaWsewDwnVvoVFj0Nit +ixaIVOHRVDNXQ+Fx6tOxVFk1Ft0iCZYmTRlkoBad1reJ4c+le4tBdDfQ9FtLAQdf +X1SnwtlaWPAIcNQdlXWZppjdxWhmO+ywIjvdX9fgWV5dSuAP/DP2UP8AddZoBCDf +fxDRYXOo7J5M1XhikUtPLUPyQNv1J2CtqTAw4gzvzf8AK3ZXNPSshYGxsDQOg3Vs ++O39Z788nzKLheGR0sV3DM927lPOvu7XWSC42tonGRXtZbSc/HLbbe1Iwg5qkBw1 +DSb220VfiQBxGYkg+I6rYDE3D8NL5BaVzcx8ug+/wWqOkc+RxcSS43IUFOl7uTtO +SGSm9nglJ3GugCC7wi2ykWVDildQBzaKsmgYTcsa/S/W219BqhVeYn3ShDpvKG2/ +M4/RINydSU5rfySRbNpYn1UoAF+Z1SXAHncfonHNAF9LpLQCbggDyRDY+Hqtk9Oa +ec3GXI705H4H9VBraZ9LUuheDcHQ9R1VdTVDqapbI11+uitsVxemqKVjWNe6dnuv +2Fuh6olGOVrSXEN8ybKOKwPGWIaDd5+wUaRzprZzt8glsAafLyUoLbdxLiS4Abqu +ZUVVRioYyN7Wh1n3FgAB9SraBvgv1KWWW8bBfrdRZ1aXhiRwYMzXEOHNPUVayY92 +6zJANByd6JmYZgd9fJQ3syvu06g6eSlVfNaBc7qxwWkE1QZZBaGEZnE/oqGkr9Wx +zi19A/8AqtoqqynoMMbHTyskFrlzTfM7/b+iirRWcTVxe7ugfeNyOn/23zVAwZna +aJ+Z5lc6R/iJ26hNi1iT9VBWS64AukusLEaXQ2xd4fjolAAttY/NAhwAtfX6IQbI +RBDv4fxWR9kIUjO7NeqzEhCDLgLDTqmgAhCIDtk9GBYaDZCEEmm1iZfVLAs4WQhS +lHmJzu1TEY95CFAw/R2iBuEIUBX5/inXjwIQgYj/AIhTp95CECHb/BCEIP/ZiQI2 +BBMBCAAgBQJKWmB7AhsDBgsJCAcDAgQVAggDBBYCAwECHgECF4AACgkQeFPaTUmI +GtO2cA//ShSoNa+ZxxI6dJkUa86MbB3ca/pEfWDbJLNFNFzjFWqVcoLuKle8uJfT +vwtYqJZFbtqgXGKwtl1mlU+9iaxx+E/TnYKJuoNG91FlNJvSnvp1xzxIchj/dUMw +LEM0vnEz+T6v3YjETtNTwR4AWg8VfszYDdYfwOWL9biHklZW3bDSv3TTrvJp3W79 +EN9XWFSzd+sEJmQOBuVb5ne2ABPmGio9ygtaKgaUmiE2pdJ67qgBKRILpX4VzQGA +MNxs+oaIFLkDyevofPPJZxl7dqwaJNsVDNhYSqzN5wP0nsx3qqcPoswKjoKX7LOm +0K4ia+QnRAvG5+6v5zMKeYAhqps9ZmVJ57UxeswDxyL41uyjVtj6uAVdOei6b9qp +94Uw6HnXcVhvYYUfhn5mBoyh9MULkgAL7XMoILkIVZBd4NqHwb1GDz8XTXLustZ6 +upOZ9JJc1VmN8IlV1rQHuZtfBQ+q3OYkHgH/h4hWUy1Xrcks1rmO4e8ghynSHl8s +9QvHIZNIhLsdBzMj/95nSedYJlg5y2WSgvB1z+bpn728xMuuq6cyHktjh8kC1LoF +FhFhH4XX8h04WLAVQDVAI2HkDZhaoswA63MZOTFm8edE653K8hBWYjmt5ntbzHe+ +QhmOvoKRzlEIyCbi8s5c3iHSU5NCfxMBwb/JuBj4wu0V4RrrgFy0JFN0w6lwaGFu +ZSBHbG9uZHUgPGdsb25kdUBkZWJpYW4ub3JnPokCNwQTAQoAIQUCSpPLbgIbAwUL +CQgHAwUVCgkICwUWAgMBAAIeAQIXgAAKCRB4U9pNSYga04j9EACMUo6pmDJ0FZTX +yGmuu7txnOwX7DRsIzQOGxGAeiLWAv05tfDzu1amUgdj1M4cob1S6BqcmhOWi/Rz +WhwqXOjfs4WGTxpzlKxLyMznIv1uC/UgXIklfctS3J+5qFrZOrDD3fgT5bfoiTP7 +XQ+luhZ12aeQNMPBCcQNT6zPKUMmQW9tWTn4g02SOQETWfHaB+eGlOE3kdOkl1GU +GljdO5g1ibQ2gYacgYyLRcb5GbWzKpCLmaqaeO6A0067YmRq1q5KVRzX5qkP38Kn +VT9SUJL/27RI3rp3Oj6cHTSjhbA8R4iGTGcup6hGn8FUD7YRV7RH5Ei47JU87BtU +eIg/yjdnF2ETPpXXNbjk+2UrgCfVzZJ1dxsKkeIqJE8/fmH5G2B4i9WW07WvHfJt +uABSz2Cbt+gbEi7+TcSLLFWWCQ+Hj3n8Po46kmBryy0enPzvvpIVy1CkwnmnAQne +3HzQCuUAvFwOW0jxO1LqOCv64ScXATobCwWtLgCwq5lIlOmuNykyBCNZQZZHxsM7 +88yv5HNGELaRzMmyMBzY0IdlLQIYcK0g3tNGDYXoQgmfUBjd9iNMSst1E14/lyto +OFCQ/FnW/J1xLU0bgXMx5bJvREDo2q8YxYKmw9biKVt3vFhIaZrTNxDKcjBljLI7 +YYBTbY3Jlznqe4B2BUr5BjEKG3OvKbQqU3TDqXBoYW5lIEdpbGJlcnQgR2xvbmR1 +IChET0I6IDE5ODQtMDMtMjcptCtTdMOpcGhhbmUgR2xvbmR1IDxTdGVwaGFuZS5H +bG9uZHVAaW5yaWEuZnI+iQI3BBMBCgAhBQJKpDo6AhsDBQsJCAcDBRUKCQgLBRYC +AwEAAh4BAheAAAoJEHhT2k1JiBrTQ0MQAJxMlnHyvD2gN2c+Wj65aojddBBHUuLx +hJnz0ZV42fc1YYJvH6kzTEYFrUlpKhBQ2as6XZ5n2PGOtVdHGt5OeCpZELr722gn +wYQXN5KoOgOPoTk921IXwetUEcRKnWmlvwtYdU/2/rQ46r4VlwPNlSfLaERfOfQE +8nG170x1tPBTqPliJloA6WxAIL+WVCCGleJ590BNY8oNznUWuEmPf7/7l5HcO5ts +p6hMJJkmP9lRKAmTt0jBmqIuerZ2PA1wcNTu/skMXkjOWKA/zwzod2GHJQXohXXv +7OLbPoKdczhkYGy11mame48qqME9AC8GBIKVI9CAZxZvYRu6eWS/YoGxR/ILFAPH +XCk6a7tbGz6D8hVAQpPi4DzhD5oO0dzAbljBdiPYqIESMHd3kJ9GSjPB1M1TX2Ui +l3xifDdoFVFWzhaVAPdzaSuaXwovU6aBZVCO9Cyy6X0JOwmd4bfk1z56Rlgk/d3X +IExI6TOkMmPbApODCyrx9lZxOOmncAmeZI8Vm77qQS0I7rkPf5WaeSgLO5TNp4ci +iqbVpLYQx50qDrd3kuvfXCBoBAGW9SaXCk0MY9AImU952OUoV8QffazcpelK+JcO +v3y/YbzHOYjCre6oQ4DJx2s2Yuq9t9tIIIV0yeji/8DMWus2eUn64UQJVtNFooHU +WW1XaD2brmEduQINBEpaXdEBEADAcmFn7at2YP0TRQMU0JlQm+I3L2GRI0JhGsX6 +736z//5e8hMeUufh3mIa9cWlHEAWZBW/l8eB94E1QRjj4ka6c1G/qabxppl82Y5b +3hjOGJb0wQO3q4Sj/VvpaVXx9fqG4uX5lZ6JXLtH7SbqeEoLspsPfpnB6d9FUASW +/QFN2HkrWi9A1xu0X68ldLJdOi5sKVYzttcoS21gF8DmkLuHrwyBCuD9RY6M6AN7 +XHrXBcHiHEAanTKQZW3NcUOgPozykC8rdMv38LKhzuwDHVFRQCEq1OP6LWs10Q5S +wMIdtbNClnWaMrHpfSAvZAgpN2ewR9GPljHhfcF5ZW3asp3ns24yFGOHqTO2kXEt +54qZ/MMSLNi6IVbBlOJ4IIEm0yyIE1bB1x7FzsA1fK8V9t9QShA5JmmyLoPzMZq8 +UjKhZxGu9RQn23kq8Som7ddfew/IZqv66AtR0m72fOpoAFDUWkWtLS2cUyIfpvR/ +AXKSCv5eZuvmNn7QC/hQY5xfKOWpkV/UmxWW0SmByve0BOcusn4TqO6wMWV7tLRz +hkmhNWK3MSVAKgbXWi4giF2kcJTwnkvnyRfxlnXOWP3GQeJMpVMc30edgna6usaw +IvG12vZwxSexqO0m4T7N8Sua+LQy9Xrv/l8mrvDaOPMl+Ki9iY080/RjAXVV26CC +q3fW4wARAQABiQIfBBgBCAAJBQJKWl3RAhsMAAoJEHhT2k1JiBrTPlAP/1/1+bPp +Q8ePAxcjWNwXPtjx4N5BK/VnjCu+S0D+gExDEKkjWv60yO7WG4e7ZkQjJd8Pojmg +mz2oUURWwOCpj4JQdVRbgvr3KmlDL7QPGLd4Nm0SJ37y+Aiuh6b1CLrtx5jxTdgw +giCChnmE03gfIf1DDOXYfgzcgL2wTisMBQui0MfxLtRSnH8dXnHVFr7L9pR2xZhd +OmGaGSm9IAYHHrut9XA6qG5EgP9IntAkPI8xQX/2871pYzSfty9JgXZ3W/r5yxVi +RDVxEFc2FggGmbPZED4q+y5inoh1/LO6gs6pQSz1NuNGGFLAfz1+0EjTtvCkExNO +YqVGHkuXsRT6MmB24NbRmKrl1LbJ+O46V3BBE3obxaxzaHcBDWGnQpZwOow01i5s +7Qn3MVRDCva6BlpQf4CNugVp2UH9cBeXQHKdJmyhsXavkrcmYils3ppDdEUOlkSH +heRbMf0gTyH8l5iWY3b6a6jDec5RlZoAR6Qz/Xo/dut/hTKOl9obJS5M+peHCPib +y32XP3Tyba8RAHeS7908KOjbhUXXgcSwsgNHOhaaknO5gA8kDgRV9nq3+OguLT5/ +aJfB7/j/xapoDOu5L0hThrms4qxKaT7zXwhCnmJ9db8zdvshdGFrVEzGEAF3/lxa +fGm1jqFZwCNNoaKOKMWsNyLs9k4bGOHAIcrTiQI1BCgBCgAgFiEEWOsJmcZOiX7o +lLgDeFPaTUmIGtMFAlrt6ZUCHQEACgkQeFPaTUmIGtPevA/3ed/YFiyEx9oC3oIm +Aih2hKqebnx2UT+mkeYrdNVTep5LjBgCXfbKcseMOIac/34zNqGvrRgpEMUs5xHo +fTssYTRliUNtI3GeunW2kKXjta9JUDp6nB//YjDzT9rNHfUyeDRW871TnuEhVv9V +6G3s5iFBvF921/KbKXrEbZUcL2eQ7buIzaXU2tu8hVouLJVCslNC+TDeXkZNaxx/ +4MWiLKLw94veu5S7eQnGI1x5o9MxScEM+NKxE0EWr2EhE9oExFP44Rqgq5Hf18n9 +9tFNpcxaw8a7IQzdN6x8jxhvVrHDd3ig2+INfADzw7TCG2QMVVNX2bISe77+KNLI +RJuXu6LAumfh54x8EXq/93UutQuNAZxDHHkxngN/+HUrjvXQCZGR4wRUXD1CYyXF +oVOb/0KAg1gkhgRaZagxKbvz60b8eG8NcVPgDasjFbsuVi7iSZPk6iij3uW1TVFO +stZRO58Rs3t3u0FHSDUiiSTLwfpTvk1XPXsvClp9znoIqxJWObbJcb9aBWVIW/yq +/lRWmlPBPD/vq3tY55/upLL4XPNcg9UELDlhiH+i4FlqBrLrL96enA/lpmPJWxPB +U6ISYY2bzQOPIGpcaauBTMkNghm3Wj/3pFxN1YACSVNG2fF0VV/C09YY0J6T/Yz2 +vklVGiD22/3RFAfr7T9Bb2UW6rkBDQRa6I8hAQgAqTA7ggr56hheybZYS/NtlrSa +n/PBaw3q7eom/7PXEwbsbrRRmGqT7ToYVRY+J+NcH3zqba+FLVNQ+ylPU32fXkw7 +TDFkP3Rhnao5yXtB9j6sxEys/yZDBL6aP/0ILmdver0S5wyuOFLVfLMTFoeWXA3T +SNeA5ICZ4sgboUzExgK7VsEhjRQcaoY5x+QaQic3v1ur4vhcrqCXFkvSCWq+WYGo +yf9zxgkhnlz6e/XoIaQHPq/+XdOnXwWZDDx51whPy8vgGW6kJMHZpCj1MTM81FA4 +DeU28xRv9h5Mq7iiavx/WA81aUoXuY1YveHZtG4DmJtXZiMAEj7qNl8nrPepRQAR +AQABiQI2BBgBCgAgFiEEWOsJmcZOiX7olLgDeFPaTUmIGtMFAlrojyECGyAACgkQ +eFPaTUmIGtOt0Q/9Hi6j+LmAKUqlTI26jZq4BlAzTu68JO8LDlhKPq2uz6DgZ29O +TSmCi2Nc+yEsqLTr7+nfABE0knHZEm6xEmJCuxCeSh69c7Acxjpum0JQasaTFJs5 +Y4M8KWdJ+lZrA2VEgQC3APHnx3SUydTuRBCP9cSYy8l8OmXM9dLLHPFiYQbzp5CZ +Q/8JuclTluKUMOv4HJoFgC5Mm+fCvqzK0LZfmLfy3PVToPHBPZQtsIiN+QM9Ga1z +5KN3QHrRJCER+M3do2fTyldmR6Vd/eI0wpfAqwKmWFv2ZTEBqzjZ3RlzdhIxO/JQ +0vaEkE8wG02MZhAKPW5j9biE3TkmZKl6cPFn9WBMV8tTLdX+3xQ8GLxeU2+uNrcm +AEBMc6H82oGGIjnVBlGKP4B5CH/hbRQVKfiYNpJ0Mn+A0izRgLWKq/B6qCDTZe+S +0SfT8NmAVFKcsn/rbdx7mSVRH06Oow5hhmKx8z1FHY7CMmYGA7Hwy6cybLwqBLRK +54c9wECLP47NZlG2OyGi/pUn97JKCyw4ygclkCcdDBEh9NWy16T+K63KpXJlF3Tx +H7HKjxRrH9k+Wzzq6+Xd3UsxczYAHRTgQFhWAeN0SkyxsMD9bKclHwGJXdCwtA54 +GUOKg9su/pebULidShqFC697sfsPOwTejNiLGCSZiDiDpieJGdYPU+ZIwna5AQ0E +Wu3oFwEIALIMWoIdaGlTta41GQege75xbbo1LotdVHboe3W2qLnCz4DXx3uaEhdk ++17MmqMuLjcyKUM8+D9cxTVLBAVl6cpFPCOMIhRSLNtGkWw6jrnHW6i2NwfeE4Xi +n8nM24N74H7quDAxWn2RDQUrh6ea47xcEMXqPheiKnCucwTUsKDrt2xdjdwjTvUX +thXCG3+8GTHLCC8BnejJLcKh7g6AY0a5wa5gQfaQ7AR6o6hohbWwMf5wRMiErKKg +g2+NgKDkqKDpCEy6oR8nlU7GSzuFl1PjFbaX68f8YTYzk/Pm+TX6KQ6Sez+D5PgF +FaCdEm//KpOcbUZ1zgJp90pJ5Z+seI0AEQEAAYkDbAQYAQoAIBYhBFjrCZnGTol+ +6JS4A3hT2k1JiBrTBQJa7egXAhsCAUAJEHhT2k1JiBrTwHQgBBkBCgAdFiEEbeJO +l+yohsxW5iUOIbju8bGJMIEFAlrt6BcACgkQIbju8bGJMIEZwQf7Bhhy1nfVNneQ +mm2InJtpSGuWDQB950gi/UwG4NIR2m9gO6+p5VUj/iMjO9IpCu7hu4qy6SsfTi+e +ORHsyvbOtXs3CSeon6TXD2AkmyzWURQS0n4BECNNut5ZoIJD9Mkpx6h0FMwkPisG +wcGLc37ayTsTFVQsTI2Qw91kVVWhi2Kgckkks1U/Hz3RbbDKgox7AqcNgxGPzgc2 +udmR0Gcphxve5f0Q7l7CriFD1OBYRKJ5p4CapnzAMHUMe7LV8yRGwkVsIm2FQp6G +ULnDqxD99dJUXoT70XYf+NEKblhK1gdQto09jfQt8cbrX1/k/eJOfoeQqeShY4lo +eODdCkR8eMAxD/0VVHr7OkeiZtVXbidz8OF9tE94lpFM093JMENON95Gjwdos+la +rqcEprN0ze0lQX/2xVrQ8wgGxNi7YYYHCuRQw0Ve34QgSt+0i0FISHhB+fQywGt7 +x6o1ychGvfLgCcGjbBxCJKMSsgVHxAU9dr9Wg4KNR62Uz0Ew5SxT9bkBj1xdTmYX +Pc2/g+QZ9vGqqJLTDRZk6xIL94M/2i1n1M5g02O+RVZI20PIEvE1CVSCKjo3Q1hP +dCqHH32SZ25vb8vDyvi84gluSlxLjbYN64PqEIPaqKOcRYVzHiugs6zi6WYGabUh +BLzpYHoQwxw/PwyMbmkyXb+6s8Id5VJIuR1qiIrJe3ITPl5HYwJP0ckrWtul6buX +CWvxA69Z+tApi1N/i8iScFnTa+kMbzmtGAAQXKojibntr3BbOIOQECU8vIG5jg9j +KY42Nm42FjWnw9pohmmEUV7XOsorE/lSrJtgikhNbYOoN3jhoqGXmfCOmU3Wava2 +ofIrDhdCo2LGbaW295eEcFjyIH8T5dP0QrXSajli0o5aHLFM3iBFXhOAcUe755pk +HkiM98leibhWynjG5XVrzFfGpN7mFs/5Wtlhn6Kqw+rbU4IjGcqt8Hurt59pRU63 +e3LJvj3NMmpDWEcjGxifLNiy6MNIzQclaAZUqvmgq9TLfT3/OzuRqIOHYbkBDQRa +7eiQAQgAxdcBrrtRzq+u/9SA73g5snOXfNxqSwTFRdbhkXp3/X6RO+kP8Ys/T3re ++V6jgH82oeQ5t7VTE85FV/7QTNQpm/AbMfUd6IMAt2rdcge8BmnG/aRoofm7EW2q +u0oNNPnj5E7uJv7VWj5lkmBr2tC9EejDOzBGe8mNAoPRGtKziOqw5QMto//TIKsD +iqycQJtaslt6yNN2rrmUXt7rx0pEJIiZmZzl7N1v1kXJ10cox3aRLeRCP/kBRMw2 +XQ9D00uHUCvTMHGxK+BD/WuoosE4jBKBhqUrxa4/Z53wQXORHZptNMUaqKmMZwef +egVO+nFZdsT3eqDW5OtgKqbCxwnF1wARAQABiQI2BBgBCgAgFiEEWOsJmcZOiX7o +lLgDeFPaTUmIGtMFAlrt6JACGwwACgkQeFPaTUmIGtOo1BAAlU+pMd8vvPfKVmHK +fPLWcLfSbxZYlMLInKGoM2m6zCwHQNlsYtYSDboz5y/t1eh6ALTuN+S7rdXD9Yyq +ED9t5X1jXK1Ux4mKnUYTySderLN2pvpyEENul60FrMdTD62czQDyr70ENNFVyFgJ +jRmIwzq3frUUAcg3fWfRmY33lB1SauuP5dpYhs+FXDMtKgfvtnf9/Vz6HhAiO390 +JEiQ9r+pePzlu5qIEYbxXWcQxYqnwJ00rDZfH6YTL6+XG/C8cBU1K7Jkf1jpVi0E +gjPlflkctXfbTGxGHxhA0NI09EMQThE5J5ue5khPin9+2WJqms+2BC8o40pKq1KC +JovTa3Gq+NsoV391RbgKAtZNuucKrt2YMKPgDyoS7kkfqhrT6c2aMqHLSfUqDeaf +k7LSxCT74lEcEE5gPG3nOB8LbqpMOjU6VafITjpFCAvQdOgwku2AhUtfL6o3wu9Z +i6Iph66llZs9F7Wh8d6r0SQHwMFAJMlbLkXFTL+zLN7VTITghpFExaCJAk7Xu5Wx +Qlv0VwnluZ+JxwicgIOslnEizPwWOAeXCInqEC139PkNkaH28JsrPcQ9KPKPMcPz +RqX1vMrCQgpTIk0gy8l65JGQyS9CBI9DIHi2VDW4aBt+lXHCENvJN8oWYx3gFiJM +BVdjGfB7Abu4FOJi+dEc8KJ3HnQ= +=jJI+ +-----END PGP PUBLIC KEY BLOCK----- diff -Nru belenios-1.4+dfsg/debian/watch belenios-1.6+dfsg/debian/watch --- belenios-1.4+dfsg/debian/watch 2017-07-27 04:53:57.000000000 +0000 +++ belenios-1.6+dfsg/debian/watch 2018-06-13 13:28:36.000000000 +0000 @@ -1,3 +1,3 @@ version=3 -opts="dversionmangle=s/\+dfsg//" \ +opts="dversionmangle=s/\+dfsg//,pgpsigurlmangle=s/$/.asc/" \ https://gforge.inria.fr/frs/?group_id=5428 .*/belenios-(.+)\.tar\.gz diff -Nru belenios-1.4+dfsg/demo/demo-threshold.sh belenios-1.6+dfsg/demo/demo-threshold.sh --- belenios-1.4+dfsg/demo/demo-threshold.sh 1970-01-01 00:00:00.000000000 +0000 +++ belenios-1.6+dfsg/demo/demo-threshold.sh 2018-06-13 11:46:49.000000000 +0000 @@ -0,0 +1,111 @@ +#!/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 +ttkeygen () { + belenios-tool threshold-trustee-keygen $group "$@" +} +ttkeygen --step 1 +ttkeygen --step 1 +ttkeygen --step 1 +cat *.cert > certs.jsons +ttkeygen --certs certs.jsons --step 2 +for u in *.key; do + ttkeygen --certs certs.jsons --key $u --step 3 --threshold 2 +done > polynomials.jsons +ttkeygen --certs certs.jsons --step 4 --polynomials polynomials.jsons +for u in *.key; do + b=${u%.key} + ttkeygen --certs certs.jsons --key $u --step 5 < $b.vinput > $b.voutput +done +cat *.voutput | ttkeygen --certs certs.jsons --step 6 --polynomials polynomials.jsons > threshold.json + +# 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 threshold.json public_creds.txt "$tdir" +head -n3 ballots.jsons > "$tdir/ballots.jsons" +belenios-tool verify-diff --dir1="$tdir" --dir2=. +rm -rf "$tdir" + +header "Perform decryption" + +for u in *.key; do + belenios-tool threshold-decrypt --key $u --decryption-key ${u%.key}.dkey + echo >&2 +done > partial_decryptions.tmp +head -n2 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 diff -Nru belenios-1.4+dfsg/demo/ocsigenserver.conf.in belenios-1.6+dfsg/demo/ocsigenserver.conf.in --- belenios-1.4+dfsg/demo/ocsigenserver.conf.in 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/demo/ocsigenserver.conf.in 2018-06-13 11:46:49.000000000 +0000 @@ -32,16 +32,21 @@ - + + + + + + diff -Nru belenios-1.4+dfsg/demo/run-server.sh belenios-1.6+dfsg/demo/run-server.sh --- belenios-1.4+dfsg/demo/run-server.sh 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/demo/run-server.sh 2018-06-13 11:46:49.000000000 +0000 @@ -24,4 +24,10 @@ -e "s@_SRCDIR_@$PWD@g" \ demo/ocsigenserver.conf.in > $BELENIOS_RUNDIR/etc/ocsigenserver.conf -ocsigenserver -c $BELENIOS_RUNDIR/etc/ocsigenserver.conf "$@" +OCSIGENSERVER=ocsigenserver + +if command -v ocsigenserver.opt > /dev/null; then + OCSIGENSERVER=ocsigenserver.opt +fi + +exec $OCSIGENSERVER -c $BELENIOS_RUNDIR/etc/ocsigenserver.conf "$@" diff -Nru belenios-1.4+dfsg/doc/specification.tex belenios-1.6+dfsg/doc/specification.tex --- belenios-1.4+dfsg/doc/specification.tex 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/doc/specification.tex 2018-06-13 11:46:49.000000000 +0000 @@ -7,7 +7,7 @@ \usepackage{bbm} \usepackage{hyperref} -\newcommand{\version}{0.2} +\newcommand{\version}{1.5} \newcommand{\F}{\mathbbm{F}} \newcommand{\G}{\mathbbm{G}} @@ -30,6 +30,11 @@ \newcommand{\pdecryption}{\texttt{partial\_decryption}} \newcommand{\result}{\texttt{result}} +\newcommand{\cert}{\texttt{cert}} +\newcommand{\poly}{\texttt{polynomial}} +\newcommand{\vinput}{\texttt{vinput}} +\newcommand{\voutput}{\texttt{voutput}} + \title{Belenios specification} \date{Version~\version} \author{Stéphane Glondu} @@ -45,11 +50,6 @@ 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 @@ -62,11 +62,11 @@ \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 +\item $\mathcal{S}$: voting server +\item $\mathcal{A}$: server administrator +\item $\mathcal{C}$: credential authority +\item $\mathcal{T}_1,\dots,\mathcal{T}_m$: trustees +\item $\mathcal{V}_1,\dots,\mathcal{V}_n$: voters \end{itemize} \section{Processes} @@ -76,60 +76,107 @@ \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} +\item $\mathcal{A}$ generates a fresh \hyperref[basic-types]{$\uuid$} $u$ and + sends it to $\mathcal{C}$ +\item $\mathcal{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)$ +\item for $j\in[1\dots n]$, $\mathcal{C}$ sends $c_j$ to $\mathcal{V}_j$ +\item $\mathcal{C}$ forgets $c_1,\dots,c_n$ +\item $\mathcal{C}$ forgets the mapping between $j$ and $\public(c_j)$ if credential recovery is not needed -\item $C$ sends $L$ to $A$ +\item $\mathcal{C}$ sends $L$ to $\mathcal{A}$ +\item $\mathcal{A}$ and $\mathcal{T}_1,\dotsc,\mathcal{T}_m$ run a key establishment protocol + (either \ref{no-threshold} or \ref{threshold}) +\item $\mathcal{A}$ creates the \hyperref[elections]{$\election$} $E$ +\item $\mathcal{A}$ loads $E$ and $L$ into $\mathcal{S}$ and starts it +\end{enumerate} + +\subsubsection{Basic decryption support} +\label{no-threshold} + +To perform tally with this scheme, all trustees will need to compute a +partial decryption. + +\begin{enumerate} \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$ + \item $\mathcal{T}_z$ generates a \hyperref[trustee-keys]{$\tpk$} $k_z$ and + sends it to $\mathcal{A}$ + \item $\mathcal{A}$ checks $k_z$ \end{enumerate} -\item $A$ combines all the trustee public keys into the election +\item $\mathcal{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} + +\subsubsection{Threshold decryption support} +\label{threshold} + +To perform tally with this scheme, $t+1$ trustees will need to compute +a partial decryption. + +\begin{enumerate} +\item for $z\in[1\dots m]$, + \begin{enumerate} + \item $\mathcal{T}_z$ generates a \hyperref[certificates]{$\cert$} $\gamma_z$ + and sends it to $\mathcal{A}$ + \item $\mathcal{A}$ checks $\gamma_z$ + \end{enumerate} +\item $\mathcal{A}$ assembles $\Gamma=\gamma_1,\dotsc,\gamma_n$ +\item for $z\in[1\dots m]$, + \begin{enumerate} + \item $\mathcal{A}$ sends $\Gamma$ to $\mathcal{T}_z$ and $\mathcal{T}_z$ checks it + \item $\mathcal{T}_z$ generates a \hyperref[polynomials]{$\poly$} $P_z$ and + sends it to $\mathcal{A}$ + \item $\mathcal{A}$ checks $P_z$ + \end{enumerate} +\item for $z\in[1\dots m]$, $\mathcal{A}$ computes a + \hyperref[vinputs]{$\vinput$} $\textsf{vi}_z$ +\item for $z\in[1\dots m]$, + \begin{enumerate} + \item $\mathcal{A}$ sends $\Gamma$ to $\mathcal{T}_z$ and $\mathcal{T}_z$ checks it + \item $\mathcal{A}$ sends $\textsf{vi}_z$ to $\mathcal{T}_z$ and $\mathcal{T}_z$ checks it + \item $\mathcal{T}_z$ computes a \hyperref[voutputs]{$\voutput$} $\textsf{vo}_z$ and + sends it to $\mathcal{A}$ + \item $\mathcal{A}$ checks $\textsf{vo}_z$ + \end{enumerate} +\item $\mathcal{A}$ extracts encrypted decryption keys $K_1,\dots,K_m$ and + \hyperref[threshold-params]{threshold parameters} \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 +\item $\mathcal{V}$ gets $E$ +\item $\mathcal{V}$ creates a \hyperref[ballots]{$\ballot$} $b$ and submits it to $\mathcal{S}$ +\item $\mathcal{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 +\item $\mathcal{V}_i$ contacts $\mathcal{C}$ +\item $\mathcal{C}$ looks up $\mathcal{V}_i$'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 +\item $\mathcal{C}$ sends $c'_i$ to $\mathcal{V}_i$ and forgets it +\item $\mathcal{C}$ sends $\public(c_i)$ and $\public(c'_i)$ to $\mathcal{A}$ +\item $\mathcal{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]$, +\item $\mathcal{A}$ stops $\mathcal{S}$ and computes the \hyperref[tally]{$\etally$} $\Pi$ +\item for $z\in[1\dots m]$ (or, if in threshold mode, a subset of it + of size at least $t+1$), \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$ + \item $\mathcal{A}$ sends $\Pi$ (and $K_z$ if in threshold mode) to $\mathcal{T}_z$ + \item $\mathcal{T}_z$ generates a \hyperref[tally]{$\pdecryption$} $\delta_z$ + and sends it to $\mathcal{A}$ + \item $\mathcal{A}$ verifies $\delta_z$ \end{enumerate} -\item $A$ combines all the partial decryptions, computes and publishes +\item $\mathcal{A}$ combines all the partial decryptions, computes and publishes the election \hyperref[election-result]{\result} \end{enumerate} @@ -220,6 +267,295 @@ \item check that $\challenge=\Hash_\pok(\pklabel,A)\mod q$ \end{enumerate} +\subsection{Messages specific to threshold decryption support} + +\subsubsection{Public key infrastructure} +\label{pki} + +Establishing a public key so that threshold decryption is supported +requires private communications between trustees. To achieve this, +Belenios uses a custom public key infrastructure. During the key +establishment protocol, each trustee starts by generating a secret +seed (at random), then derives from it encryption and decryption keys, +as well as signing and verification keys. These four keys are then +used to exchange messages between trustees by using $\mathcal{A}$ as a proxy. + +The secret seed $s$ is a 22-character string, where characters are +taken from the set: +\[\texttt{123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz}\] + +\paragraph{Deriving keys} + +The (private) signing key $\textsf{sk}$ is derived by computing the +SHA256 of $s$ prefixed by the string \verb/sk|/. The corresponding +(public) verification key is $g^{\textsf{sk}}$. The (private) +decryption key $\textsf{dk}$ is derived by computing the SHA256 of $s$ +prefixed by the string \verb/dk|/. The corresponding (public) +encryption key is $g^{\textsf{dk}}$. + +\paragraph{Signing} + +Signing takes a signing key $\textsf{sk}$ and a \textsf{message} $M$ +(as a $\jstring$), computes a \textsf{signature} and produces a +$\texttt{signed\_msg}$. For the signature, we use a (Schnorr-like) +non-interactive zero-knowledge proof. + +\begin{gather*} + \texttt{signed\_msg}=\left\{ + \begin{array}{rcl} + \textsf{message}&:&\jstring\\ + \textsf{signature}&:&\texttt{proof} + \end{array} + \right\} +\end{gather*} +To compute the \textsf{signature}, +\begin{enumerate} +\item pick a random $w\in\Z_q$ +\item compute the commitment $A=g^w$ +\item compute the \textsf{challenge} as + $\textsf{SHA256}(\texttt{sigmsg|}M\texttt{|}A)$, where $A$ is written + in base 10 and the result is interpreted as a 256-bit big-endian + number +\item compute the \textsf{response} as + $w-\textsf{sk}\times\textsf{challenge}\mod q$ +\end{enumerate} +To verify a \textsf{signature} using a verification key \textsf{vk}, +\begin{enumerate} +\item compute the commitment $A=g^{\textsf{response}}\times\textsf{vk}^{\textsf{challenge}}$ +\item check that $\textsf{challenge}=\textsf{SHA256}(\texttt{sigmsg|}M\texttt{|}A)$ +\end{enumerate} + +\paragraph{Encrypting} + +Encrypting takes an encryption key $\textsf{ek}$ and a message $M$ (as +a $\jstring$), computes an \texttt{encrypted\_msg} and serializes it +as a $\jstring$. We use an El Gamal-like system. + +\begin{gather*} + \texttt{encrypted\_msg}=\left\{ + \begin{array}{rcl} + \textsf{alpha}&:&\G\\ + \textsf{beta}&:&\G\\ + \textsf{data}&:&\jstring + \end{array} + \right\} +\end{gather*} +To compute the \texttt{encrypted\_msg}: +\begin{enumerate} +\item pick random $r,s\in\Z_q$ +\item compute $\textsf{alpha}=g^r$ +\item compute $\textsf{beta}=\textsf{ek}^r\times g^s$ +\item compute $\textsf{data}$ as the hexadecimal encoding of the (symmetric) + encryption of $M$ using AES in CCM mode with + $\textsf{SHA256}(\texttt{key|}g^s)$ as the key and $\textsf{SHA256}(\texttt{iv|}g^r)$ as the + initialization vector (where numbers are written in base 10) +\end{enumerate} +To decrypt an \texttt{encrypted\_msg} using a decryption key \textsf{dk}: +\begin{enumerate} +\item compute the symmetric key as $\textsf{SHA256}(\texttt{key|}\textsf{beta}/(\textsf{alpha}^{\textsf{dk}}))$ +\item compute the initialization vector as $\textsf{SHA256}(\texttt{iv|}\textsf{alpha})$ +\item decrypt $\textsf{data}$ +\end{enumerate} + +\subsubsection{Certificates} +\label{certificates} + +A certificate is a \texttt{signed\_msg} encapsulating a serialized +\texttt{cert\_keys} structure, itself filled with the public keys +generated as described in section~\ref{pki}. +\begin{gather*} + \texttt{cert}=\texttt{signed\_msg} + \qquad + \texttt{cert\_keys}=\left\{ + \begin{array}{rcl} + \textsf{verification}&:&\G\\ + \textsf{encryption}&:&\G + \end{array} + \right\} +\end{gather*} +The message is signed with the signing key associated to +\textsf{verification}. + +\subsubsection{Channels} +\label{channels} + +A \textsf{message} is sent securely from \textsf{sk} (a signing key) +to \textsf{recipient} (an encryption key) by encapsulating it in a +\texttt{channel\_msg}, serializing it as a $\jstring$, signing it with +\textsf{sk} and serializing the resulting \texttt{signed\_msg} as a +$\jstring$, and finally encrypting it with \textsf{recipient}. The +resulting $\jstring$ will be denoted by +$\textsf{send}(\textsf{sk},\textsf{recipient},\textsf{message})$, and +can be transmitted using a third-party (such as the election +administrator). +\begin{gather*} + \texttt{channel\_msg}=\left\{ + \begin{array}{rcl} + \textsf{recipient}&:&\G\\ + \textsf{message}&:&\jstring + \end{array} + \right\} +\end{gather*} +When decoding such a message, \textsf{recipient} must be checked. + +\subsubsection{Polynomials} +\label{polynomials} + +Let $\Gamma=\gamma_1,\dotsc,\gamma_m$ be the certificates of all +trustees. We will denote by $\textsf{vk}_z$ (resp. $\textsf{ek}_z$) +the \textsf{verification} key (resp. the \textsf{encryption} key) of +$\gamma_z$. Each trustee must compute a \texttt{polynomial} structure +in step 3 of the key establishment protocol. +\begin{gather*} + \texttt{polynomial}=\left\{ + \begin{array}{rcl} + \textsf{polynomial}&:&\jstring\\ + \textsf{secrets}&:&\jstring^\ast\\ + \textsf{coefexps}&:&\texttt{coefexps} + \end{array} + \right\} +\end{gather*} +Suppose $\mathcal{T}_i$ is the trustee who is computing. Therefore, $\mathcal{T}_i$ knows +the signing key $\textsf{sk}_i$ corresponding to $\textsf{vk}_i$ and the +decryption key $\textsf{dk}_i$ corresponding to $\textsf{ek}_i$. $\mathcal{T}_i$ +first checks that keys indeed match. Then $\mathcal{T}_i$ picks a random +polynomial +\[ + f_i(x)=a_{i0}+a_{i1}x+\dotsb+a_{it}x^t\in\Z_q[x] +\] +and computes $A_{ik}=g^{a_{ik}}$ for $k=0,\dotsc,t$ and +$s_{ij}=f_i(j)\mod q$ for $j=1,\dotsc,m$. $\mathcal{T}_i$ then fills the +\texttt{polynomial} structure as follows: +\begin{itemize} +\item the \textsf{polynomial} field is + $\textsf{send}(\textsf{sk}_i,\textsf{ek}_i,M)$ where $M$ is a + serialized \texttt{raw\_polynomial} structure + \begin{gather*} + \texttt{raw\_polynomial}=\left\{ + \begin{array}{rcl} + \textsf{polynomial}&:&\Z_q^\ast + \end{array} + \right\} + \end{gather*} + filled with $a_{i0},\dotsc,a_{it}$ +\item the \textsf{secrets} field is + $\textsf{send}(\textsf{sk}_i,\textsf{ek}_1,M_{i1}),\dotsc,\textsf{send}(\textsf{sk}_i,\textsf{ek}_m,M_{im})$ + where $M_{ij}$ is a serialized \texttt{secret} structure + \begin{gather*} + \texttt{secret}=\left\{ + \begin{array}{rcl} + \textsf{secret}&:&\Z_q + \end{array} + \right\} + \end{gather*} + filled with $s_{ij}$ +\item the \textsf{coefexps} field is a signed message containing a + serialized \texttt{raw\_coefexps} structure + \begin{gather*} + \texttt{coefexps}=\texttt{signed\_msg} + \qquad + \texttt{raw\_coefexps}=\left\{ + \begin{array}{rcl} + \textsf{coefexps}&:&\G^\ast + \end{array} + \right\} + \end{gather*} + filled with $A_{i0},\dotsc,A_{it}$ +\end{itemize} + +\subsubsection{Vinputs} +\label{vinputs} + +Once we receive all the \texttt{polynomial} structures +$P_1,\dotsc,P_m$, we compute (during step 4) input data (called +\texttt{vinput}) for a verification step performed later by the +trustees. Step 4 can be seen as a routing step. +\begin{gather*} + \texttt{vinput}=\left\{ + \begin{array}{rcl} + \textsf{polynomial}&:&\jstring\\ + \textsf{secrets}&:&\jstring^\ast\\ + \textsf{coefexps}&:&\texttt{coefexps}^\ast + \end{array} + \right\} +\end{gather*} +Suppose we are computing the \texttt{vinput} structure $\textsf{vi}_j$ +for trustee $\mathcal{T}_j$. We fill it as follows: +\begin{itemize} +\item the \textsf{polynomial} field is the same as the one of $P_j$ +\item the \textsf{secret} field is + $\textsf{secret}(P_1)_j,\dotsc,\textsf{secret}(P_m)_j$ +\item the \textsf{coefexps} field is + $\textsf{coefexps}(P_1),\dotsc,\textsf{coefexps}(P_m)$ +\end{itemize} +Note that the \textsf{coefexps} field is the same for all trustees. + +In step~5, $\mathcal{T}_j$ checks consistency of $\textsf{vi}_j$ by unpacking it +and checking that, for $i=1,\dotsc,m$, +\[ +g^{s_{ij}}=\prod_{k=0}^t(A_{ik})^{j^k} +\] + +\subsubsection{Voutputs} +\label{voutputs} + +In step 5 of the key establishment protocol, a trustee $\mathcal{T}_j$ receives +$\Gamma$ and $\textsf{vi}_j$, and produces a \texttt{voutput} +$\textsf{vo}_j$. +\begin{gather*} + \texttt{voutput}=\left\{ + \begin{array}{rcl} + \textsf{private\_key}&:&\jstring\\ + \textsf{public\_key}&:&\texttt{trustee\_public\_key} + \end{array} + \right\} +\end{gather*} +Trustee $\mathcal{T}_j$ fills $\textsf{vo}_j$ as follows: +\begin{itemize} +\item \textsf{private\_key} is set to + $\textsf{send}(\textsf{sk}_j,\textsf{ek}_j,S_j)$, where $S_j$ is $\mathcal{T}_j$'s + (private) decryption key: + \[ + S_j=\sum_{i=1}^m s_{ij}\mod q + \] +\item \textsf{public\_key} is set to a + \hyperref[trustee-keys]{\texttt{trustee\_public\_key}} structure + built using $S_j$ as private key. +\end{itemize} +The administrator checks $\textsf{vo}_j$ as follows: +\begin{itemize} +\item check that: + \[ + \textsf{public\_key}(\textsf{public\_key}(\textsf{vo}_j))=\prod_{i=1}^m \prod_{k=0}^t (A_{ik})^{j^k} + \] +\item check $\textsf{pok}(\textsf{public\_key}(\textsf{vo}_j))$ +\end{itemize} + +\subsubsection{Threshold parameters} +\label{threshold-params} + +The \texttt{threshold\_parameters} structure embeds data that is +published during the election. +\begin{gather*} + \texttt{threshold\_parameters}=\left\{ + \begin{array}{rcl} + \textsf{threshold}&:&\I\\ + \textsf{certs}&:&\texttt{cert}^\ast\\ + \textsf{coefexps}&:&\texttt{coefexps}^\ast\\ + \textsf{verification\_keys}&:&\texttt{trustee\_public\_key}^\ast + \end{array} + \right\} +\end{gather*} +The administrator fills it as follows: +\begin{itemize} +\item \textsf{threshold} is set to $t+1$ +\item \textsf{certs} is set to $\Gamma=\gamma_1,\dotsc,\gamma_m$ +\item \textsf{coefexps} is set to the same value as the + \textsf{coefexps} field of \texttt{vinput}s +\item \textsf{verification\_keys} is set to + $\textsf{public\_key}(\textsf{vo}_1),\dotsc,\textsf{public\_key}(\textsf{vo}_m)$ +\end{itemize} + \subsection{Credentials} \label{credentials} @@ -264,9 +600,8 @@ \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. +document, is computed during the setup phase, and bundled with the +group parameters in a \texttt{wrapped\_pk} structure. \newcommand{\blank}{\textsf{blank}} \newcommand{\minlabel}{\textsf{min}} @@ -312,7 +647,8 @@ 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 +\item all the $\tpk$s, or the + $\texttt{threshold\_parameters}$, that were generated during the \hyperref[election-setup]{setup phase}; \item the set $L$ of public credentials. \end{itemize} @@ -340,8 +676,8 @@ 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: +More concretely, each weight $m\in[0\dots1]$ is encrypted (in an El +Gamal-like fashion) into a $\ciphertext$ as follows: \begin{enumerate} \item pick a random $r\in\Z_q$ \item $\alphalabel=g^r$ @@ -575,7 +911,7 @@ \newcommand{\siglabel}{\textsf{signature}} -Each ballot contains a digital signature to avoid ballot stuffing. The +Each ballot contains a (Schnorr-like) 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 @@ -710,12 +1046,24 @@ \right\} \end{gather*} The decryption factors are combined for each ciphertext to build -synthetic ones: +synthetic ones $F_{i,j}$. With basic decryption support: \[ 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: +where $m$ is the number of trustees. With threshold decryption +support: +\[ +F_{i,j}=\prod_{z\in\mathcal{I}}(\pdlabel_{z,i,j})^{\lambda_z^{\mathcal{I}}} +\] +where $\mathcal{I}=\{z_1,\dotsc,z_{t+1}\}$ is the set of indexes of +supplied partial decryptions, and $\lambda_z^{\mathcal{I}}$ are the +Lagrange coefficients: +\[ + \lambda_z^{\mathcal{I}}=\prod_{k\in\mathcal{I}\backslash\{z\}}\frac{k}{k-z}\mod q +\] + +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) \] @@ -726,8 +1074,8 @@ 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 all the $\tpk$s, or the $\texttt{threshold\_parameters}$, 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. diff -Nru belenios-1.4+dfsg/INSTALL.md belenios-1.6+dfsg/INSTALL.md --- belenios-1.4+dfsg/INSTALL.md 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/INSTALL.md 2018-06-13 11:46:49.000000000 +0000 @@ -29,7 +29,7 @@ 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 + sudo apt install build-essential libgmp-dev libpcre3-dev pkg-config m4 libssl-dev libsqlite3-dev wget ca-certificates unzip aspcud libncurses-dev uuid-runtime zlib1g-dev If you are unfamiliar with OCaml or OPAM, we provide an `opam-bootstrap.sh` shell script that creates a whole, hopefully @@ -75,7 +75,6 @@ * [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) @@ -85,7 +84,7 @@ With OPAM, these dependencies can be installed with the following command: - opam install atdgen zarith cryptokit uuidm calendar cmdliner + opam install atdgen zarith cryptokit uuidm cmdliner Once all the dependencies have been installed, the command-line tool can be compiled with: @@ -101,12 +100,13 @@ The web server has the following additional dependencies: + * [Calendar](http://calendar.forge.ocamlcore.org/) * [Eliom](http://ocsigen.org/eliom/) * [Csv](https://forge.ocamlcore.org/projects/csv/) With OPAM, you can install them with: - opam install eliom csv + opam install calendar eliom csv Once all the dependencies have been installed, the Eliom module can be compiled with: @@ -140,14 +140,14 @@ Compilation using only official Debian packages ----------------------------------------------- -At the time of writing (05 Apr 2016), you need the development version +At the time of writing (07 Dec 2017), you need the stable version (stretch) 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 + sudo apt install libatdgen-ocaml-dev libzarith-ocaml-dev libcryptokit-ocaml-dev libuuidm-ocaml-dev libcalendar-ocaml-dev libcmdliner-ocaml-dev + sudo apt install ocsigenserver eliom libcsv-ocaml-dev Compiling on Windows using Cygwin --------------------------------- diff -Nru belenios-1.4+dfsg/Makefile belenios-1.6+dfsg/Makefile --- belenios-1.4+dfsg/Makefile 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/Makefile 2018-06-13 11:46:49.000000000 +0000 @@ -1,14 +1,21 @@ +ALL_TARGETS := all.otarget +ALL_TARGETS += $(if $(shell sh -c "command -v ocamlopt"),all-native.otarget) + minimal: + rm -f _build/BUILD ocamlbuild minimal.otarget all: - ocamlbuild all.otarget + rm -f _build/BUILD + ocamlbuild $(ALL_TARGETS) -check: all +check: minimal demo/demo.sh + demo/demo-threshold.sh clean: - ocamlbuild -clean + -ocamlbuild -clean + rm -rf _build rm -f *~ tree: _build/tree.html diff -Nru belenios-1.4+dfsg/myocamlbuild.ml belenios-1.6+dfsg/myocamlbuild.ml --- belenios-1.4+dfsg/myocamlbuild.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/myocamlbuild.ml 2018-06-13 11:46:49.000000000 +0000 @@ -132,6 +132,7 @@ 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_ttkeygen.js" "src/tool/tool_js_ttkeygen.js" "src/static/tool_js_ttkeygen.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"; diff -Nru belenios-1.4+dfsg/opam-bootstrap.sh belenios-1.6+dfsg/opam-bootstrap.sh --- belenios-1.4+dfsg/opam-bootstrap.sh 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/opam-bootstrap.sh 2018-06-13 11:46:49.000000000 +0000 @@ -92,7 +92,7 @@ echo echo "=-=-= Installation of Belenios build-dependencies =-=-=" echo -opam install --yes atdgen zarith cryptokit uuidm calendar cmdliner sqlite3 eliom=4.2.0 csv +opam install --yes atdgen=1.12.0 zarith cryptokit uuidm calendar cmdliner sqlite3 eliom=4.2.0 csv echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" diff -Nru belenios-1.4+dfsg/README.md belenios-1.6+dfsg/README.md --- belenios-1.4+dfsg/README.md 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/README.md 2018-06-13 11:46:49.000000000 +0000 @@ -76,7 +76,7 @@ By "internal code", we mean everything that is not in the `ext/` directory. -Copyright © 2012-2016 Inria +Copyright © 2012-2018 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 diff -Nru belenios-1.4+dfsg/src/booth/booth.ml belenios-1.6+dfsg/src/booth/booth.ml --- belenios-1.4+dfsg/src/booth/booth.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/booth/booth.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -20,6 +20,7 @@ (**************************************************************************) open Platform +open Serializable_builtin_t open Serializable_j open Signatures open Common @@ -102,11 +103,11 @@ 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 E = Election.Make (P) (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 + lwt randomness = E.make_randomness () () in + lwt b = E.create_ballot ~sk randomness plaintext () in let s = string_of_ballot G.write b in setTextarea "ballot" s; setNodeById "ballot_tracker" (sha256_b64 s); @@ -348,14 +349,15 @@ let loadElection () = setDisplayById "election_loader" "none"; + setDisplayById "wait_div" "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 election_params = Election.(get_group (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_uuid" (raw_string_of_uuid params.e_uuid); setNodeById "election_fingerprint" P.election.e_fingerprint; withElementById "intro" (fun e -> let b = createStartButton election_params e params.e_questions in @@ -366,20 +368,57 @@ 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 -> +let get_url x = + let n = String.length x in + if n <= 1 || String.sub x 0 1 <> "#" then + None + else + let args = Url.decode_arguments (String.sub x 1 (n-1)) in + try Some (List.assoc "url" args) + with Not_found -> None + +let load_url url = + 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 () -> + 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 ()) + ) + +let load_url_handler _ = + let url = getTextarea "url" in + let encoded = Url.encode_arguments ["url", url] in + Dom_html.window##location##hash <- Js.string encoded; + load_url url; + Js._false + +let load_params_handler _ = + setDisplayById "div_ballot" "block"; + setDisplayById "div_submit" "none"; + setDisplayById "div_submit_manually" "block"; + Lwt.async (fun () -> + Lwt.return (runHandler loadElection ()) ); - Js._false - ) + Js._false + +let onload_handler _ = + let () = + withElementById "load_url" + (fun e -> e##onclick <- Dom_html.handler load_url_handler); + withElementById "load_params" + (fun e -> e##onclick <- Dom_html.handler load_params_handler); + in + let () = + match get_url (Js.to_string Dom_html.window##location##hash) with + | None -> + setDisplayById "wait_div" "none"; + setDisplayById "election_loader" "block"; + | Some url -> load_url url + in Js._false + +let () = Dom_html.window##onload <- Dom_html.handler onload_handler diff -Nru belenios-1.4+dfsg/src/lib/common.ml belenios-1.6+dfsg/src/lib/common.ml --- belenios-1.4+dfsg/src/lib/common.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/common.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,7 +19,7 @@ (* . *) (**************************************************************************) -let ( |> ) x f = f x +open Platform module Array = struct include Array @@ -123,6 +123,17 @@ let ssplit a = mmap fst a, mmap snd a + + let findi f a = + let n = Array.length a in + let rec loop i = + if i < n then + match f i a.(i) with + | None -> loop (i+1) + | Some _ as x -> x + else None + in loop 0 + end module String = struct @@ -166,3 +177,25 @@ in loop 0 module SMap = Map.Make(String) + +(** Direct random monad *) + +let bytes_to_sample q = + (* we take 128 additional bits of random before the mod q, so that + the statistical distance with a uniform distribution in [0,q[ is + negligible *) + Z.bit_length q / 8 + 17 + +module DirectRandom = struct + type 'a t = 'a + 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 = bytes_to_sample q in + let r = random_string (Lazy.force prng) size in + Z.(of_bits r mod q) +end diff -Nru belenios-1.4+dfsg/src/lib/common.mli belenios-1.6+dfsg/src/lib/common.mli --- belenios-1.4+dfsg/src/lib/common.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/common.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,7 +19,7 @@ (* . *) (**************************************************************************) -val ( |> ) : 'a -> ('a -> 'b) -> 'b +open Signatures module Array : sig include module type of Array @@ -40,6 +40,7 @@ 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 + val findi : (int -> 'a -> 'b option) -> 'a array -> 'b option end module String : sig @@ -56,3 +57,7 @@ val compare_b64 : string -> string -> int module SMap : Map.S with type key = string + +val bytes_to_sample : Platform.Z.t -> int + +module DirectRandom : RANDOM with type 'a t = 'a diff -Nru belenios-1.4+dfsg/src/lib/credential.ml belenios-1.6+dfsg/src/lib/credential.ml --- belenios-1.4+dfsg/src/lib/credential.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/credential.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,6 +19,7 @@ (* . *) (**************************************************************************) +open Serializable_builtin_t open Platform open Signatures @@ -78,8 +79,15 @@ 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 + let uuid = raw_string_of_uuid uuid in + let derived = + match Uuidm.of_string uuid with + | Some _ -> (* old-style UUIDs *) + let salt = remove_dashes uuid in + pbkdf2_hex ~iterations:1000 ~salt x + | None -> + pbkdf2_utf8 ~iterations:1000 ~salt:uuid x + in Z.(of_string_base 16 derived mod G.q) end diff -Nru belenios-1.4+dfsg/src/lib/credential.mli belenios-1.6+dfsg/src/lib/credential.mli --- belenios-1.4+dfsg/src/lib/credential.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/credential.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,6 +19,7 @@ (* . *) (**************************************************************************) +open Serializable_builtin_t open Platform open Signatures @@ -29,5 +30,5 @@ val check : string -> bool module MakeDerive (G : GROUP) : sig - val derive : Uuidm.t -> string -> Z.t + val derive : uuid -> string -> Z.t end diff -Nru belenios-1.4+dfsg/src/lib/election.ml belenios-1.6+dfsg/src/lib/election.ml --- belenios-1.4+dfsg/src/lib/election.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/election.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -20,10 +20,29 @@ (**************************************************************************) open Platform -open Serializable_t +open Serializable_j open Signatures open Common +(** Parsing helpers *) + +let of_string x = + let params = params_of_string Yojson.Safe.read_json x in + { + e_params = params; + e_fingerprint = sha256_b64 x; + } + +let get_group x = + let w = Yojson.Safe.to_string x.e_params.e_public_key in + let module W = (val Group.wrapped_pubkey_of_string w) in + let module X = + struct + module G = W.G + let election = {x with e_params = {x.e_params with e_public_key = W.y}} + end + in (module X : ELECTION_DATA) + (** Helper functions *) let check_modulo p x = Z.(geq x zero && lt x p) @@ -33,83 +52,19 @@ | 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 - +module Make (W : ELECTION_DATA) (M : RANDOM) = struct type 'a m = 'a M.t open M let ( >>= ) = bind - type elt = G.t + type elt = W.G.t + + module G = W.G + open G + let election = W.election - type t = elt election type private_key = Z.t type public_key = elt @@ -130,9 +85,9 @@ beta = c1.beta *~ c2.beta; } - let neutral_ciphertext e = Array.map (fun q -> + let neutral_ciphertext () = Array.map (fun q -> Array.make (question_length q) dummy_ciphertext - ) e.e_params.e_questions + ) election.e_params.e_questions let combine_ciphertexts = Array.mmap2 eg_combine @@ -142,9 +97,11 @@ (** ElGamal encryption. *) let eg_encrypt y r x = + (* FIXME: side channel *) + let g' = if x = 0 then G.one else g **~ Z.of_int x in { alpha = g **~ r; - beta = y **~ r *~ g **~ Z.of_int x; + beta = y **~ r *~ g'; } let dummy_proof = @@ -268,7 +225,8 @@ 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 g' = if min+i-1 = 0 then G.one else g **~ Z.of_int (min+i-1) in + let nbeta = cS.beta / g' in let j = 2*i in overall_proof.(i) <- {challenge; response}; commitments.(j) <- g **~ response *~ cS.alpha **~ challenge; @@ -323,7 +281,8 @@ 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 g' = if min+i-1 = 0 then G.one else g **~ Z.of_int (min+i-1) in + let nbeta = cS.beta / g' in let j = 2*i in overall_proof.(i) <- {challenge; response}; commitments.(j) <- g **~ response *~ cS.alpha **~ challenge; @@ -397,7 +356,8 @@ 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 g' = if min+i-1 = 0 then G.one else g **~ Z.of_int (min+i-1) in + let nbeta = cS.beta / g' in let j = 2*i in commitments.(j) <- g **~ response *~ cS.alpha **~ challenge; commitments.(j+1) <- y **~ response *~ nbeta **~ challenge; @@ -420,7 +380,8 @@ let make_d min max = let n = max - min + 1 in - let d = Array.make n (invert (g **~ Z.of_int min)) in + let g' = if min = 0 then G.one else g **~ Z.of_int min in + let d = Array.make n (invert g') in for i = 1 to n-1 do d.(i) <- d.(i-1) *~ invg done; @@ -484,10 +445,10 @@ let blank_proof = None in return {choices; individual_proofs; overall_proof; blank_proof} - let make_randomness e = + let make_randomness () = sswap (Array.map (fun q -> Array.init (question_length q) (fun _ -> random G.q) - ) e.e_params.e_questions) + ) election.e_params.e_questions) let make_sig_prefix zkp commitment = "sig|" ^ zkp ^ "|" ^ G.to_string commitment ^ "|" @@ -503,8 +464,8 @@ ) (Array.to_list answers) ) |> Array.of_list - let create_ballot e ?sk r m = - let p = e.e_params in + let create_ballot ?sk r m = + let p = election.e_params in let sk, zkp = match sk with | None -> None, "" @@ -525,7 +486,7 @@ ) >>= fun signature -> return { answers; - election_hash = e.e_fingerprint; + election_hash = election.e_fingerprint; election_uuid = p.e_uuid; signature; } @@ -549,10 +510,10 @@ eg_disj_verify y d zkp a.overall_proof sumc | _, _ -> false - let check_ballot e b = - let p = e.e_params in + let check_ballot b = + let p = election.e_params in b.election_uuid = p.e_uuid && - b.election_hash = e.e_fingerprint && + b.election_hash = election.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 @@ -605,11 +566,10 @@ 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 + type combinator = factor list -> elt array array + + let compute_result num_tallied encrypted_tally partial_decryptions combinator = + let factors = combinator partial_decryptions in let results = Array.mmap2 (fun {beta; _} f -> beta / f ) encrypted_tally factors in @@ -630,21 +590,17 @@ let result = Array.mmap log results in {num_tallied; encrypted_tally; partial_decryptions; result} - let check_result pks r = + let check_result combinator 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 factors = combinator 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 + Array.fforall2 (fun r1 r2 -> + let g' = if r2 = 0 then G.one else g **~ Z.of_int r2 in + r1 =~ g' + ) results result let extract_tally r = r.result end diff -Nru belenios-1.4+dfsg/src/lib/election.mli belenios-1.6+dfsg/src/lib/election.mli --- belenios-1.4+dfsg/src/lib/election.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/election.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,58 +21,14 @@ (** 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 of_string : string -> Yojson.Safe.json election +val get_group : Yojson.Safe.json election -> (module ELECTION_DATA) - 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. *) +val question_length : question -> int -module MakeElection (G : GROUP) (M : RANDOM) : - ELECTION with type elt = G.t and type 'a m = 'a M.t +module Make (W : ELECTION_DATA) (M : RANDOM) : + ELECTION with type elt = W.G.t and type 'a m = 'a M.t (** Implementation of {!Signatures.ELECTION}. *) diff -Nru belenios-1.4+dfsg/src/lib/group_field.ml belenios-1.6+dfsg/src/lib/group_field.ml --- belenios-1.4+dfsg/src/lib/group_field.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/group_field.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/lib/group_field.mli belenios-1.6+dfsg/src/lib/group_field.mli --- belenios-1.4+dfsg/src/lib/group_field.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/group_field.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/lib/group.ml belenios-1.6+dfsg/src/lib/group.ml --- belenios-1.4+dfsg/src/lib/group.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/group.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,7 +19,6 @@ (* . *) (**************************************************************************) -open Platform open Serializable_j open Signatures @@ -37,14 +36,13 @@ 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) +let wrapped_pubkey_of_string x = + let x = wrapped_pubkey_of_string read Yojson.Safe.read_json x in + let {wpk_group=group; wpk_y=y} = x in + let module X = + struct + module G = (val group) + let y = G.of_string (Yojson.Safe.Util.to_string y) + end + in + (module X : WRAPPED_PUBKEY) diff -Nru belenios-1.4+dfsg/src/lib/group.mli belenios-1.6+dfsg/src/lib/group.mli --- belenios-1.4+dfsg/src/lib/group.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/group.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -28,5 +28,4 @@ val read : (module GROUP) reader -val election_params_of_string : string -> (module ELECTION_DATA) -(** Parse a [Serializable_t.params]. *) +val wrapped_pubkey_of_string : string -> (module WRAPPED_PUBKEY) diff -Nru belenios-1.4+dfsg/src/lib/lib.mllib belenios-1.6+dfsg/src/lib/lib.mllib --- belenios-1.4+dfsg/src/lib/lib.mllib 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/lib.mllib 2018-06-13 11:46:49.000000000 +0000 @@ -6,5 +6,6 @@ Common Group_field Group +Trustees Election Credential diff -Nru belenios-1.4+dfsg/src/lib/platform.mli belenios-1.6+dfsg/src/lib/platform.mli --- belenios-1.4+dfsg/src/lib/platform.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/platform.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -22,6 +22,13 @@ val sha256_hex : string -> string val sha256_b64 : string -> string val pbkdf2_hex : iterations:int -> salt:string -> string -> string +val pbkdf2_utf8 : iterations:int -> salt:string -> string -> string + +val aes_hex : key:string -> data:string -> string + +(** [key] and [iv] in hex, [plaintext] UTF8 string, [ciphertext] in hex *) +val encrypt : key:string -> iv:string -> plaintext:string -> string +val decrypt : key:string -> iv:string -> ciphertext:string -> string type rng val secure_rng : rng diff -Nru belenios-1.4+dfsg/src/lib/serializable.atd belenios-1.6+dfsg/src/lib/serializable.atd --- belenios-1.4+dfsg/src/lib/serializable.atd 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/serializable.atd 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -125,6 +125,79 @@ type 'a result = { num_tallied : int; encrypted_tally : 'a encrypted_tally; - partial_decryptions : 'a partial_decryption list ; + partial_decryptions : 'a partial_decryption list; result : plaintext; } + +(** {2 PKI support} *) + +type signed_msg = { + message : string; + signature : proof; +} + +type 'a channel_msg = { + recipient : 'a; + message : string; +} + +type 'a encrypted_msg = { + alpha : 'a; + beta : 'a; + data : string; +} + +(** {2 Threshold decryption support} *) + +type 'a cert_keys = { + verification : 'a; + encryption : 'a; +} + +type cert = signed_msg (* cert_keys *) + +type certs = { + certs : cert list ; +} + +type raw_polynomial = { + polynomial : number list +} + +type 'a raw_coefexps = { + coefexps : 'a list +} + +type coefexps = signed_msg (* raw_coefexps *) + +type secret = { + secret : number; +} + +type polynomial = { + polynomial : string; (* sent raw_polynomial *) + secrets : string list ; (* sent secrets *) + coefexps : coefexps; +} + +type vinput = { + polynomial : string; (* sent raw_polynomial *) + secrets : string list ; (* sent secrets *) + coefexps : coefexps list ; +} + +type partial_decryption_key = { + decryption_key : number; +} + +type 'a voutput = { + private_key : string; (* sent partial_decryption_key *) + public_key : 'a trustee_public_key; +} + +type 'a threshold_parameters = { + threshold : int; + certs : cert list ; + coefexps : coefexps list ; + verification_keys : 'a trustee_public_key list ; +} diff -Nru belenios-1.4+dfsg/src/lib/serializable_builtin_j.ml belenios-1.6+dfsg/src/lib/serializable_builtin_j.ml --- belenios-1.4+dfsg/src/lib/serializable_builtin_j.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/serializable_builtin_j.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -42,14 +42,9 @@ (** {1 Serializers for type uuid} *) -let write_uuid = make_write Uuidm.to_string +let write_uuid = make_write raw_string_of_uuid -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 +let read_uuid = make_read "read_uuid" uuid_of_raw_string (** {1 Serializers for type int_or_null} *) diff -Nru belenios-1.4+dfsg/src/lib/serializable_builtin_j.mli belenios-1.6+dfsg/src/lib/serializable_builtin_j.mli --- belenios-1.4+dfsg/src/lib/serializable_builtin_j.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/serializable_builtin_j.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/lib/serializable_builtin_t.ml belenios-1.6+dfsg/src/lib/serializable_builtin_t.ml --- belenios-1.4+dfsg/src/lib/serializable_builtin_t.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/serializable_builtin_t.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -22,9 +22,31 @@ open Platform type number = Z.t -type uuid = Uuidm.t +type uuid = string type int_or_null = int option +let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" +let min_uuid_length = 14 (* at least 82 bits of entropy *) + +let check token = + let n = String.length token in + n >= min_uuid_length && + let rec loop i = + if i >= 0 then + let digit = try String.index digits token.[i] with Not_found -> -1 in + if digit >= 0 then loop (i-1) else false + else true + in loop (n-1) + +let uuid_of_raw_string x = + match Uuidm.of_string x with + | Some s -> Uuidm.to_string s + | None -> + if check x then x + else Printf.ksprintf invalid_arg "%S is not a valid UUID" x + +let raw_string_of_uuid x = x + module SSet = Set.Make(String) type string_set = SSet.t diff -Nru belenios-1.4+dfsg/src/lib/serializable_builtin_t.mli belenios-1.6+dfsg/src/lib/serializable_builtin_t.mli --- belenios-1.4+dfsg/src/lib/serializable_builtin_t.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/serializable_builtin_t.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -22,9 +22,14 @@ open Platform type number = Z.t -type uuid = Uuidm.t +type uuid type int_or_null = int option +val min_uuid_length : int + +val uuid_of_raw_string : string -> uuid +val raw_string_of_uuid : uuid -> string + module SSet : Set.S with type elt = string type string_set = SSet.t diff -Nru belenios-1.4+dfsg/src/lib/signatures.mli belenios-1.6+dfsg/src/lib/signatures.mli --- belenios-1.4+dfsg/src/lib/signatures.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/signatures.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -89,6 +89,12 @@ end +(** A public key with its group *) +module type WRAPPED_PUBKEY = sig + module G : GROUP + val y : G.t +end + (** Monad signature. *) module type MONAD = sig type 'a t @@ -105,25 +111,6 @@ (** [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; @@ -154,7 +141,9 @@ type elt - type t = elt election + module G : GROUP with type t = elt + val election : elt election + type private_key = Z.t type public_key = elt @@ -163,7 +152,7 @@ type ciphertext = elt Serializable_t.ciphertext array array (** A ciphertext that can be homomorphically combined. *) - val neutral_ciphertext : t -> ciphertext + val neutral_ciphertext : unit -> ciphertext (** The neutral element for [combine_ciphertext] below. *) val combine_ciphertexts : ciphertext -> ciphertext -> ciphertext @@ -185,18 +174,17 @@ type randomness (** Randomness needed to create a ballot. *) - val make_randomness : t -> randomness m + val make_randomness : unit -> 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 + val create_ballot : ?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 + val check_ballot : ballot -> bool (** [check_ballot b] checks all the cryptographic proofs in [b]. All ballots produced by [create_ballot] should pass this check. *) @@ -223,13 +211,59 @@ (** The election result. It contains the needed data to validate the result from the encrypted tally. *) - val combine_factors : int -> ciphertext -> factor array -> result + type combinator = factor list -> elt array array + + val compute_result : int -> ciphertext -> factor list -> combinator -> 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 check_result : combinator -> result -> bool val extract_tally : result -> plaintext (** Extract the plaintext result of the election. *) end + +module type PKI = sig + type 'a m + type private_key + type public_key + val genkey : unit -> string m + val derive_sk : string -> private_key + val derive_dk : string -> private_key + val sign : private_key -> string -> signed_msg m + val verify : public_key -> signed_msg -> bool + val encrypt : public_key -> string -> string m + val decrypt : private_key -> string -> string + val make_cert : sk:private_key -> dk:private_key -> cert m + val verify_cert : cert -> bool +end + +module type CHANNELS = sig + type 'a m + type private_key + type public_key + val send : private_key -> public_key -> string -> string m + val recv : private_key -> public_key -> string -> string +end + +module type PEDERSEN = sig + type 'a m + type elt + + val step1 : unit -> (string * cert) m + val step1_check : cert -> bool + val step2 : certs -> unit + val step3 : certs -> string -> int -> polynomial m + val step3_check : certs -> int -> polynomial -> bool + val step4 : certs -> polynomial array -> vinput array + val step5 : certs -> string -> vinput -> elt voutput m + val step5_check : certs -> int -> polynomial array -> elt voutput -> bool + val step6 : certs -> polynomial array -> elt voutput array -> elt threshold_parameters + + val check : elt threshold_parameters -> bool + val combine : elt threshold_parameters -> elt + + type checker = elt -> elt partial_decryption -> bool + val combine_factors : checker -> elt threshold_parameters -> elt partial_decryption list -> elt array array +end diff -Nru belenios-1.4+dfsg/src/lib/trustees.ml belenios-1.6+dfsg/src/lib/trustees.ml --- belenios-1.4+dfsg/src/lib/trustees.ml 1970-01-01 00:00:00.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/trustees.ml 2018-06-13 11:46:49.000000000 +0000 @@ -0,0 +1,481 @@ +(**************************************************************************) +(* BELENIOS *) +(* *) +(* Copyright © 2012-2018 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 + +(** Helper functions *) + +let check_modulo p x = Z.(geq x zero && lt x p) + +(** Distributed key generation *) + +module MakeSimple (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 () = random q + + let prove 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 {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 + + type checker = G.t -> G.t partial_decryption -> bool + + let combine_factors checker pks pds = + let dummy = + match pds with + | x :: _ -> Array.mmap (fun _ -> G.one) x.decryption_factors + | [] -> failwith "no partial decryptions" + in + assert (Array.forall (fun pk -> List.exists (checker pk) pds) pks); + List.fold_left (fun a b -> + Array.mmap2 ( *~ ) a b.decryption_factors + ) dummy pds + +end + +module MakePKI (G : GROUP) (M : RANDOM) = struct + + type 'a m = 'a M.t + type private_key = Z.t + type public_key = G.t + + let genkey () = + let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" in + let n = 22 and z58 = Z.of_int 58 in + let res = Bytes.create n in + let rec loop i = + if i < n then + M.bind (M.random z58) (fun x -> + Bytes.set res i b58_digits.[Z.to_int x]; + loop (i+1) + ) + else M.return (Bytes.to_string res) + in loop 0 + + let derive_sk p = + Z.of_string_base 16 (sha256_hex ("sk|" ^ p)) + + let derive_dk p = + Z.of_string_base 16 (sha256_hex ("dk|" ^ p)) + + let sign sk s_message = + M.bind (M.random G.q) (fun w -> + let commitment = G.(g **~ w) in + let prefix = "sigmsg|" ^ s_message ^ "|" in + let challenge = G.hash prefix [|commitment|] in + let response = Z.(erem (w - sk * challenge) G.q) in + let s_signature = { challenge; response } in + M.return { s_message; s_signature } + ) + + let verify vk {s_message; s_signature = { challenge; response }} = + check_modulo G.q challenge && + check_modulo G.q response && + let commitment = G.(g **~ response *~ vk **~ challenge) in + let prefix = "sigmsg|" ^ s_message ^ "|" in + Z.(challenge =% G.hash prefix [|commitment|]) + + let encrypt y plaintext = + M.bind (M.random G.q) (fun r -> + M.bind (M.random G.q) (fun key -> + let key = G.(g **~ key) in + let y_alpha = G.(g **~ r) in + let y_beta = G.((y **~ r) *~ key) in + let key = sha256_hex ("key|" ^ G.to_string key) in + let iv = sha256_hex ("iv|" ^ G.to_string y_alpha) in + let y_data = Platform.encrypt ~key ~iv ~plaintext in + let msg = {y_alpha; y_beta; y_data} in + M.return (string_of_encrypted_msg G.write msg) + ) + ) + + let decrypt x msg = + let {y_alpha; y_beta; y_data} = encrypted_msg_of_string G.read msg in + let key = sha256_hex G.("key|" ^ to_string (y_beta *~ invert (y_alpha **~ x))) in + let iv = sha256_hex ("iv|" ^ G.to_string y_alpha) in + Platform.decrypt ~key ~iv ~ciphertext:y_data + + let make_cert ~sk ~dk = + let cert_keys = { + cert_verification = G.(g **~ sk); + cert_encryption = G.(g **~ dk); + } in + let cert = string_of_cert_keys G.write cert_keys in + sign sk cert + + let verify_cert x = + let keys = cert_keys_of_string G.read x.s_message in + verify keys.cert_verification x + +end + +module MakeChannels (G : GROUP) (M : RANDOM) + (P : PKI with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t) = struct + + type 'a m = 'a P.m + type private_key = P.private_key + type public_key = P.public_key + + let send sk c_recipient c_message = + let msg = { c_recipient; c_message } in + let msg = string_of_channel_msg G.write msg in + M.bind (P.sign sk msg) (fun msg -> + P.encrypt c_recipient (string_of_signed_msg msg) + ) + + let recv dk vk msg = + let msg = P.decrypt dk msg |> signed_msg_of_string in + if not (P.verify vk msg) then + failwith "invalid signature on received message"; + let msg = channel_msg_of_string G.read msg.s_message in + let { c_recipient; c_message } = msg in + if not G.(c_recipient =~ g **~ dk) then + failwith "invalid recipient on received message"; + c_message + +end + +exception PedersenFailure of string + +module MakePedersen (G : GROUP) (M : RANDOM) + (P : PKI with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t) + (C : CHANNELS with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t) = struct + + type 'a m = 'a M.t + type elt = G.t + open G + let (>>=) = M.bind + + module K = MakeSimple (G) (M) + + let compute_verification_keys coefexps = + let n = Array.length coefexps in + assert (n > 0); + let threshold = Array.length coefexps.(0) in + assert (threshold > 0); + Array.init n (fun j -> + let jj = Z.of_int (j+1) in + let rec loop_compute_vk i vk = + if i < n then + let c = coefexps.(i) in + assert (threshold = Array.length c); + let rec loop k jk accu = + if k < threshold then + loop (k+1) Z.(jk * jj) (accu *~ (c.(k) **~ jk)) + else accu + in + let computed_gsij = loop 0 Z.one one in + loop_compute_vk (i+1) (vk *~ computed_gsij) + else vk + in + loop_compute_vk 0 one + ) + + let check t = + Array.forall P.verify_cert t.t_certs && + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) t.t_certs in + Array.forall2 (fun cert x -> + P.verify cert.cert_verification x + ) certs t.t_coefexps && + let coefexps = Array.map (fun x -> (raw_coefexps_of_string G.read x.s_message).coefexps) t.t_coefexps in + Array.forall K.check t.t_verification_keys && + let computed_vks = compute_verification_keys coefexps in + t.t_threshold = Array.length coefexps.(0) && + Array.forall2 (fun vk computed_vk -> + vk.trustee_public_key =~ computed_vk + ) t.t_verification_keys computed_vks + + type checker = elt -> elt partial_decryption -> bool + + let lagrange indexes j = + List.fold_left (fun accu k -> + let kj = k - j in + if kj = 0 then accu + else Z.(accu * (of_int k) * invert (of_int kj) q mod q) + ) Z.one indexes + + let combine_factors checker t pds = + let dummy = + match pds with + | x :: _ -> Array.mmap (fun _ -> G.one) x.decryption_factors + | [] -> failwith "no partial decryptions" + in + let pds_with_ids = + List.map (fun pd -> + match Array.findi (fun i vk -> + if checker vk.trustee_public_key pd then Some i else None + ) t.t_verification_keys + with + | Some i -> i+1, pd + | None -> raise (PedersenFailure "a partial decryption does not correspond to any verification key") + ) pds + in + let pds_with_ids = + let compare (a, _) (b, _) = Pervasives.compare a b in + List.sort_uniq compare pds_with_ids + in + let rec take n accu xs = + if n > 0 then + match xs with + | [] -> raise (PedersenFailure "not enough partial decryptions") + | x :: xs -> take (n-1) (x :: accu) xs + else accu + in + let pds_with_ids = take t.t_threshold [] pds_with_ids in + let indexes = List.map fst pds_with_ids in + List.fold_left (fun a (j, b) -> + let l = lagrange indexes j in + Array.mmap2 (fun x y -> x *~ y **~ l) a b.decryption_factors + ) dummy pds_with_ids + + let combine t = + t.t_coefexps + |> Array.map (fun x -> (raw_coefexps_of_string G.read x.s_message).coefexps) + |> Array.fold_left (fun accu x -> G.(accu *~ x.(0))) G.one + + let step1 () = + P.genkey () >>= fun seed -> + let sk = P.derive_sk seed in + let dk = P.derive_dk seed in + P.make_cert ~sk ~dk >>= fun cert -> + M.return (seed, cert) + + let step1_check cert = P.verify_cert cert + + let step2 {certs} = + Array.iteri (fun i cert -> + if P.verify_cert cert then () + else + let msg = Printf.sprintf "certificate %d does not validate" (i+1) in + raise (PedersenFailure msg) + ) certs + + let eval_poly polynomial x = + let cur = ref Z.one and res = ref Z.zero in + for i = 0 to Array.length polynomial - 1 do + res := Z.(!res + !cur * polynomial.(i) mod q); + cur := Z.(!cur * x mod q); + done; + !res + + let step3 certs seed threshold = + let n = Array.length certs.certs in + let () = step2 certs in + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) certs.certs in + let sk = P.derive_sk seed and dk = P.derive_dk seed in + let vk = g **~ sk and ek = g **~ dk in + let i = + Array.findi (fun i cert -> + if cert.cert_verification =~ vk && cert.cert_encryption =~ ek + then Some (i+1) else None + ) certs + in + let () = match i with + | None -> raise (PedersenFailure "could not find my certificate") + | Some _ -> () + in + let polynomial = Array.make threshold Z.zero in + let rec fill_polynomial i = + if i < threshold then + M.random q >>= fun a -> + polynomial.(i) <- a; + fill_polynomial (i+1) + else M.return () + in fill_polynomial 0 >>= fun () -> + C.send sk ek (string_of_raw_polynomial {polynomial}) >>= fun p_polynomial -> + let coefexps = Array.map (fun x -> g **~ x) polynomial in + let coefexps = string_of_raw_coefexps G.write {coefexps} in + P.sign sk coefexps >>= fun p_coefexps -> + let p_secrets = Array.make n "" in + let rec fill_secrets j = + if j < n then + let secret = eval_poly polynomial (Z.of_int (j+1)) in + let secret = string_of_secret {secret} in + C.send sk certs.(j).cert_encryption secret >>= fun x -> + p_secrets.(j) <- x; + fill_secrets (j+1) + else M.return () + in fill_secrets 0 >>= fun () -> + M.return {p_polynomial; p_secrets; p_coefexps} + + let step3_check certs i polynomial = + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) certs.certs in + P.verify certs.(i).cert_verification polynomial.p_coefexps + + let step4 certs polynomials = + let n = Array.length certs.certs in + let () = step2 certs in + assert (n = Array.length polynomials); + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) certs.certs in + let vi_coefexps = Array.map (fun x -> x.p_coefexps) polynomials in + Array.iteri (fun i x -> + if P.verify certs.(i).cert_verification x then () + else + let msg = Printf.sprintf "coefexps %d does not validate" (i+1) in + raise (PedersenFailure msg) + ) vi_coefexps; + Array.init n (fun j -> + let vi_polynomial = polynomials.(j).p_polynomial in + let vi_secrets = Array.init n (fun i -> polynomials.(i).p_secrets.(j)) in + {vi_polynomial; vi_secrets; vi_coefexps} + ) + + let step5 certs seed vinput = + let n = Array.length certs.certs in + let () = step2 certs in + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) certs.certs in + let sk = P.derive_sk seed and dk = P.derive_dk seed in + let vk = g **~ sk and ek = g **~ dk in + let j = + Array.findi (fun i cert -> + if cert.cert_verification =~ vk && cert.cert_encryption =~ ek + then Some (i+1) else None + ) certs + in + let j = match j with + | None -> raise (PedersenFailure "could not find my certificate") + | Some i -> Z.of_int i + in + let {polynomial} = C.recv dk vk vinput.vi_polynomial |> raw_polynomial_of_string in + let threshold = Array.length polynomial in + assert (n = Array.length vinput.vi_secrets); + let secrets = + Array.init n (fun i -> + let x = C.recv dk certs.(i).cert_verification vinput.vi_secrets.(i) in + (secret_of_string x).secret + ) + in + assert (n = Array.length vinput.vi_coefexps); + let coefexps = + Array.init n (fun i -> + let x = vinput.vi_coefexps.(i) in + if not (P.verify certs.(i).cert_verification x) then + raise (PedersenFailure (Printf.sprintf "coefexps %d does not validate" (i+1))); + let res = (raw_coefexps_of_string G.read x.s_message).coefexps in + assert (Array.length res = threshold); + res + ) + in + for i = 0 to n-1 do + let c = coefexps.(i) in + let rec loop k jk accu = + if k < threshold then + loop (k+1) Z.(jk * j) (accu *~ (c.(k) **~ jk)) + else accu + in + let computed_gsij = loop 0 Z.one one in + if not (g **~ secrets.(i) =~ computed_gsij) then + raise (PedersenFailure (Printf.sprintf "secret %d does not validate" (i+1))); + done; + let pdk_decryption_key = Array.fold_left Z.(+) Z.zero secrets in + let pdk = string_of_partial_decryption_key {pdk_decryption_key} in + M.bind (K.prove pdk_decryption_key) (fun vo_public_key -> + M.bind (C.send sk ek pdk) (fun vo_private_key -> + M.return { vo_public_key; vo_private_key } + ) + ) + + let step5_check certs i polynomials voutput = + let n = Array.length certs.certs in + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) certs.certs in + assert (n = Array.length polynomials); + let coefexps = + Array.init n (fun i -> + let x = polynomials.(i).p_coefexps in + if not (P.verify certs.(i).cert_verification x) then + raise (PedersenFailure (Printf.sprintf "coefexps %d does not validate" (i+1))); + (raw_coefexps_of_string G.read x.s_message).coefexps + ) + in + let computed_vk = (compute_verification_keys coefexps).(i) in + K.check voutput.vo_public_key && + voutput.vo_public_key.trustee_public_key =~ computed_vk + + let step6 certs polynomials voutputs = + let n = Array.length certs.certs in + let () = step2 certs in + let t_certs = certs.certs in + let certs = Array.map (fun x -> cert_keys_of_string G.read x.s_message) t_certs in + assert (n = Array.length polynomials); + assert (n = Array.length voutputs); + let coefexps = + Array.init n (fun i -> + let x = polynomials.(i).p_coefexps in + if not (P.verify certs.(i).cert_verification x) then + raise (PedersenFailure (Printf.sprintf "coefexps %d does not validate" (i+1))); + (raw_coefexps_of_string G.read x.s_message).coefexps + ) + in + let computed_vks = compute_verification_keys coefexps in + for j = 0 to n - 1 do + let voutput = voutputs.(j) in + if not (K.check voutput.vo_public_key) then + raise (PedersenFailure (Printf.sprintf "pok %d does not validate" (j+1))); + if not (voutput.vo_public_key.trustee_public_key =~ computed_vks.(j)) then + raise (PedersenFailure (Printf.sprintf "verification key %d is incorrect" (j+1))); + done; + { + t_threshold = Array.length coefexps.(0); + t_certs; + t_coefexps = Array.map (fun x -> x.p_coefexps) polynomials; + t_verification_keys = Array.map (fun x -> x.vo_public_key) voutputs; + } + +end diff -Nru belenios-1.4+dfsg/src/lib/trustees.mli belenios-1.6+dfsg/src/lib/trustees.mli --- belenios-1.4+dfsg/src/lib/trustees.mli 1970-01-01 00:00:00.000000000 +0000 +++ belenios-1.6+dfsg/src/lib/trustees.mli 2018-06-13 11:46:49.000000000 +0000 @@ -0,0 +1,75 @@ +(**************************************************************************) +(* BELENIOS *) +(* *) +(* Copyright © 2012-2018 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 + +module MakeSimple (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 : unit -> Z.t M.t + (** [generate ()] generates a new private key. *) + + val prove : Z.t -> G.t trustee_public_key M.t + (** [prove x] returns the public key associated to [x] and a zero- + knowledge proof of its knowledge. *) + + 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. *) + + type checker = G.t -> G.t partial_decryption -> bool + val combine_factors : checker -> G.t array -> G.t partial_decryption list -> G.t array array + +end +(** Simple distributed generation of an election public key. *) + +module MakePKI (G : GROUP) (M : RANDOM) : + PKI with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t + +module MakeChannels (G : GROUP) (M : RANDOM) + (P : PKI with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t) : + CHANNELS with type 'a m = 'a P.m + and type private_key = P.private_key + and type public_key = P.public_key + +exception PedersenFailure of string + +module MakePedersen (G : GROUP) (M : RANDOM) + (P : PKI with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t) + (C : CHANNELS with type 'a m = 'a M.t + and type private_key = Z.t + and type public_key = G.t) : + PEDERSEN with type 'a m = 'a M.t + and type elt = G.t diff -Nru belenios-1.4+dfsg/src/platform/js/platform.ml belenios-1.6+dfsg/src/platform/js/platform.ml --- belenios-1.4+dfsg/src/platform/js/platform.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/platform/js/platform.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,13 +21,27 @@ let sjcl = Js.Unsafe.variable "sjcl" +let hex_fromBits x = + Js.Unsafe.meth_call sjcl "codec.hex.fromBits" + [| x |] |> Js.to_string + +let hex_toBits x = + Js.Unsafe.meth_call sjcl "codec.hex.toBits" + [| Js.string x |> Js.Unsafe.inject |] + +let utf8String_fromBits x = + Js.Unsafe.meth_call sjcl "codec.utf8String.fromBits" + [| x |] |> Js.to_string + +let utf8String_toBits x = + Js.Unsafe.meth_call sjcl "codec.utf8String.toBits" + [| Js.string x |> Js.Unsafe.inject |] + 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_hex x = hex_fromBits (sha256 x) let sha256_b64 x = let raw = @@ -38,10 +52,8 @@ | 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 pbkdf2_generic toBits ~iterations ~salt x = + let salt = toBits salt in let derived = Js.Unsafe.meth_call sjcl "misc.pbkdf2" [| Js.string x |> Js.Unsafe.inject; @@ -50,8 +62,33 @@ Js.Unsafe.inject 256; |] in - Js.Unsafe.meth_call sjcl "codec.hex.fromBits" - [| derived |] |> Js.to_string + hex_fromBits derived + +let pbkdf2_hex = pbkdf2_generic hex_toBits +let pbkdf2_utf8 = pbkdf2_generic utf8String_toBits + +let aes_hex ~key ~data = + let key = hex_toBits key in + let data = hex_toBits data in + let cipher = Js.Unsafe.(new_obj (get sjcl "cipher.aes") [| key |]) in + let output = Js.Unsafe.meth_call cipher "encrypt" [| data |] in + hex_fromBits output + +let encrypt ~key ~iv ~plaintext = + let key = hex_toBits key in + let iv = hex_toBits iv in + let plaintext = utf8String_toBits plaintext in + let prf = Js.Unsafe.(new_obj (get sjcl "cipher.aes") [| key |]) in + let ciphertext = Js.Unsafe.meth_call sjcl "mode.ccm.encrypt" [| prf; plaintext; iv |] in + hex_fromBits ciphertext + +let decrypt ~key ~iv ~ciphertext = + let key = hex_toBits key in + let iv = hex_toBits iv in + let ciphertext = hex_toBits ciphertext in + let prf = Js.Unsafe.(new_obj (get sjcl "cipher.aes") [| key |]) in + let plaintext = Js.Unsafe.meth_call sjcl "mode.ccm.decrypt" [| prf; ciphertext; iv |] in + utf8String_fromBits plaintext type rng = unit -> unit diff -Nru belenios-1.4+dfsg/src/platform/native/platform.ml belenios-1.6+dfsg/src/platform/native/platform.ml --- belenios-1.4+dfsg/src/platform/native/platform.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/platform/native/platform.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -63,12 +63,134 @@ done; Bytes.to_string result -let pbkdf2_hex ~iterations ~salt x = +let pbkdf2_generic toBits ~iterations ~salt x = let open Cryptokit in - let salt = transform_string (Hexa.decode ()) salt in + let salt = toBits salt in pbkdf2 ~prf:MAC.hmac_sha256 ~iterations ~size:1 ~salt x |> transform_string (Hexa.encode ()) +let pbkdf2_hex = pbkdf2_generic Cryptokit.(transform_string (Hexa.decode ())) +let pbkdf2_utf8 = pbkdf2_generic (fun x -> x) + +let aes_hex ~key ~data = + let open Cryptokit in + let key = transform_string (Hexa.decode ()) key in + let data = transform_string (Hexa.decode ()) data in + let output = transform_string (Cipher.(aes ~mode:ECB key Encrypt)) data in + transform_string (Hexa.encode ()) output + +let read_i32 str i = + let open Int32 in + let (!) x = of_int (int_of_char str.[i+x]) in + logor (shift_left !0 24) (logor (shift_left !1 16) (logor (shift_left !2 8) !3)) + +let export_i32 x = + let open Int32 in + let (!) i = String.make 1 (char_of_int (to_int (logand 0xffl (shift_right_logical x i)))) in + !24 ^ !16 ^ !8 ^ !0 + +let xor128 x y = + let r = Bytes.create 16 in + for i = 0 to 15 do + Bytes.set r i (char_of_int (int_of_char x.[i] lxor int_of_char y.[i])) + done; + Bytes.to_string r + +(********** Functions directly translated from SJCL **********) + +let ccm_computeTag prf plaintext iv adata tlen ll = + let l = String.length plaintext in + let plaintext = plaintext ^ "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" in + let tlen = tlen / 8 in + if tlen mod 2 <> 0 || tlen < 4 || tlen > 16 then invalid_arg "ccm: invalid tag length"; + let flags = + (if String.length adata <> 0 then 1 lsl 6 else 0) + lor ((tlen - 2) lsl 2) lor (ll - 1) + in + let mac = String.make 1 (char_of_int flags) ^ iv ^ "\000\000\000\000\000\000\000\000\000\000\000\000" in + (* works only for "small enough" plaintext (length < 31 bits) *) + let a = read_i32 mac 12 in + let a = Int32.(logor a (of_int l)) in + let mac = String.sub mac 0 12 ^ export_i32 a in + let mac = ref (prf mac) in + if String.length adata <> 0 then invalid_arg "ccm: adata not supported"; + let i = ref 0 in + while !i < l do + mac := prf (xor128 !mac (String.sub plaintext !i 16)); + i := !i + 16; + done; + String.sub !mac 0 tlen + +let ccm_ctrMode prf data iv tag tlen ll = + let l = String.length data in + let data = data ^ "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" in + let ctr = String.make 1 (char_of_int (ll - 1)) ^ iv ^ "\000\000\000\000\000\000\000\000\000\000\000\000" in + let ctr = ref (String.sub ctr 0 16) in + let tag = tag ^ "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" in + let tag = String.sub (xor128 (prf !ctr) tag) 0 (tlen / 8) in + let i = ref 0 in + let res = ref "" in + while !i < l do + (* works only for "small enough" plaintexts (length < 31 bits) *) + let c = Int32.succ (read_i32 !ctr 12) in + ctr := String.sub !ctr 0 12 ^ export_i32 c; + res := !res ^ (xor128 (prf !ctr) (String.sub data !i 16)); + i := !i + 16; + done; + String.sub !res 0 l, tag + +let ccm_encrypt prf plaintext iv adata tlen = + let ivl = String.length iv in + let ol = String.length plaintext in + if ivl < 7 then invalid_arg "ccm: iv must be at least 7 bytes"; + let l = + let l = ref 2 in + while !l < 4 && (ol asr (8 * !l) <> 0) do incr l done; + if !l < 15 - ivl then l := 15 - ivl; + !l + in + let iv = String.sub iv 0 (15 - l) in + let tag = ccm_computeTag prf plaintext iv adata tlen l in + let out, tag = ccm_ctrMode prf plaintext iv tag tlen l in + out ^ tag + +let ccm_decrypt prf ciphertext iv adata tlen = + let ivl = String.length iv in + let ol = String.length ciphertext - tlen / 8 in + let out = String.sub ciphertext 0 ol in + let tag = String.sub ciphertext ol (String.length ciphertext - ol) in + if ivl < 7 then invalid_arg "ccm: iv must be at least 7 bytes"; + let l = + let l = ref 2 in + while !l < 4 && (ol asr (8 * !l) <> 0) do incr l done; + if !l < 15 - ivl then l := 15 - ivl; + !l + in + let iv = String.sub iv 0 (15 - l) in + let out, tag = ccm_ctrMode prf out iv tag tlen l in + let tag2 = ccm_computeTag prf out iv adata tlen l in + if tag <> tag2 then invalid_arg "ccm: tag doesn't match"; + out + +(********** End of SJCL functions **********) + +let encrypt ~key ~iv ~plaintext = + let open Cryptokit in + let key = transform_string (Hexa.decode ()) key in + let iv = transform_string (Hexa.decode ()) iv in + let prf x = transform_string (Cipher.(aes ~mode:ECB key Encrypt)) x in + let ciphertext = ccm_encrypt prf plaintext iv "" 64 in + transform_string (Hexa.encode ()) ciphertext + +let decrypt ~key ~iv ~ciphertext = + let open Cryptokit in + let key = transform_string (Hexa.decode ()) key in + let iv = transform_string (Hexa.decode ()) iv in + let ciphertext = transform_string (Hexa.decode ()) ciphertext in + let prf x = transform_string (Cipher.(aes ~mode:ECB key Encrypt)) x in + let plaintext = ccm_decrypt prf ciphertext iv "" 64 in + plaintext + type rng = Cryptokit.Random.rng let secure_rng = @@ -84,4 +206,7 @@ include Z let ( =% ) = equal let bit_length x = Pervasives.(String.length (to_bits x) * 8) + + let powm = powm_sec (* Warning: no efforts have been made to be + constant time in the rest of the code. *) end diff -Nru belenios-1.4+dfsg/src/tool/tool_cmdline.ml belenios-1.6+dfsg/src/tool/tool_cmdline.ml --- belenios-1.4+dfsg/src/tool/tool_cmdline.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_cmdline.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,7 +19,9 @@ (* . *) (**************************************************************************) +open Signatures open Serializable_j +open Platform open Common open Cmdliner @@ -35,6 +37,12 @@ with End_of_file -> close_in ic; None ) +let lines_of_stdin () = + Stream.from (fun _ -> + try Some (input_line stdin) + with End_of_file -> None + ) + let string_of_file f = lines_of_file f |> stream_to_list |> String.concat "\n" @@ -108,6 +116,11 @@ let the_info = Arg.info ["url"] ~docv:"URL" ~doc in Arg.(value & opt (some string) None the_info) +let key_t = + let doc = "Read private key from file $(docv)." in + let the_info = Arg.info ["key"] ~docv:"KEY" ~doc in + Arg.(value & opt (some file) None the_info) + module Tkeygen : CMDLINER_MODULE = struct open Tool_tkeygen @@ -147,11 +160,146 @@ end +module Ttkeygen : CMDLINER_MODULE = struct + + let main group step certs threshold key polynomials = + wrap_main (fun () -> + let get_certs () = + let certs = get_mandatory_opt "--certs" certs in + match load_from_file cert_of_string certs with + | None -> Printf.ksprintf failwith "%s does not exist" certs + | Some l -> { certs = Array.of_list (List.rev l) } + in + let get_polynomials () = + let polynomials = get_mandatory_opt "--polynomials" polynomials in + match load_from_file polynomial_of_string polynomials with + | None -> Printf.ksprintf failwith "%s does not exist" polynomials + | Some l -> Array.of_list (List.rev l) + in + let group = get_mandatory_opt "--group" group |> string_of_file in + let module G = (val Group.of_string group : GROUP) in + let module P = Trustees.MakePKI (G) (DirectRandom) in + let module C = Trustees.MakeChannels (G) (DirectRandom) (P) in + let module T = Trustees.MakePedersen (G) (DirectRandom) (P) (C) in + match step with + | 1 -> + let key, cert = T.step1 () in + let id = sha256_hex cert.s_message in + Printf.eprintf "I: certificate %s has been generated\n%!" id; + let pub = "certificate", id ^ ".cert", 0o444, string_of_cert cert in + let prv = "private key", id ^ ".key", 0o400, key in + let save (descr, 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.eprintf "I: %s saved to %s\n%!" descr filename; + (* set permissions in the unlikely case where the file already existed *) + Unix.chmod filename perm + in + save pub; + save prv + | 2 -> + let certs = get_certs () in + let () = T.step2 certs in + Printf.eprintf "I: certificates are valid\n%!" + | 3 -> + let certs = get_certs () in + let threshold = get_mandatory_opt "--threshold" threshold in + let key = get_mandatory_opt "--key" key |> string_of_file in + let polynomial = T.step3 certs key threshold in + Printf.printf "%s\n%!" (string_of_polynomial polynomial) + | 4 -> + let certs = get_certs () in + let n = Array.length certs.certs in + let polynomials = get_polynomials () in + assert (n = Array.length polynomials); + let vinputs = T.step4 certs polynomials in + assert (n = Array.length vinputs); + for i = 0 to n - 1 do + let id = sha256_hex certs.certs.(i).s_message in + let fn = id ^ ".vinput" in + let oc = open_out_gen [Open_wronly; Open_creat] 0o444 fn in + output_string oc (string_of_vinput vinputs.(i)); + output_char oc '\n'; + close_out oc; + Printf.eprintf "I: wrote %s\n%!" fn + done + | 5 -> + let certs = get_certs () in + let key = get_mandatory_opt "--key" key |> string_of_file in + let vinput = read_line () |> vinput_of_string in + let voutput = T.step5 certs key vinput in + Printf.printf "%s\n%!" (string_of_voutput G.write voutput) + | 6 -> + let certs = get_certs () in + let n = Array.length certs.certs in + let polynomials = get_polynomials () in + assert (n = Array.length polynomials); + let voutputs = lines_of_stdin () + |> stream_to_list + |> List.map (voutput_of_string G.read) + |> Array.of_list + in + assert (n = Array.length voutputs); + let tparams = T.step6 certs polynomials voutputs in + for i = 0 to n - 1 do + let id = sha256_hex certs.certs.(i).s_message in + let fn = id ^ ".dkey" in + let oc = open_out_gen [Open_wronly; Open_creat] 0o400 fn in + output_string oc voutputs.(i).vo_private_key; + output_char oc '\n'; + close_out oc; + Printf.eprintf "I: wrote %s\n%!" fn + done; + Printf.printf "%s\n%!" (string_of_threshold_parameters G.write tparams) + | _ -> failwith "invalid step" + ) + + let step_t = + let doc = "Step to execute." in + let the_info = Arg.info ["step"] ~docv:"STEP" ~doc in + Arg.(value & opt int 0 the_info) + + let cert_t = + let doc = "Read certificates from file $(docv)." in + let the_info = Arg.info ["certs"] ~docv:"CERTS" ~doc in + Arg.(value & opt (some file) None the_info) + + let threshold_t = + let doc = "Threshold of trustees needed to decrypt." in + let the_info = Arg.info ["threshold"] ~docv:"THRESHOLD" ~doc in + Arg.(value & opt (some int) None the_info) + + let polynomials_t = + let doc = "Read polynomials (output of step 3) from file $(docv)." in + let the_info = Arg.info ["polynomials"] ~docv:"POLYNOMIALS" ~doc in + Arg.(value & opt (some file) None the_info) + + let ttkeygen_cmd = + let doc = "generate a trustee key usable with threshold decryption" in + let man = [ + `S "DESCRIPTION"; + `P "This command is run by trustees and the administrator to generate an election key with threshold decryption."; + ] @ common_man in + Term.(ret (pure main $ group_t $ step_t $ cert_t $ threshold_t $ key_t $ polynomials_t)), + Term.info "threshold-trustee-keygen" ~doc ~man + + let cmds = [ttkeygen_cmd] + +end + module Election : CMDLINER_MODULE = struct open Tool_election module MakeGetters (X : sig val dir : string end) = struct + let get_threshold () = + let file = "threshold.json" in + Printf.eprintf "I: loading %s...\n%!" file; + try Some (string_of_file (X.dir / file)) + with _ -> None + let get_public_keys () = load_from_file (fun x -> x) (X.dir/"public_keys.jsons") |> option_map Array.of_list @@ -233,12 +381,16 @@ | _ -> failwith "invalid private key" in print_endline (X.decrypt privkey) + | `TDecrypt (key, pdk) -> + let key = string_of_file key in + let pdk = string_of_file pdk in + print_endline (X.tdecrypt key pdk) | `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 + | Some factors -> factors | None -> failwith "cannot load partial decryptions" in let oc = open_out (dir/"result.json") in @@ -264,6 +416,11 @@ let the_info = Arg.info ["ballot"] ~docv:"BALLOT" ~doc in Arg.(value & opt (some file) None the_info) + let pdk_t = + let doc = "Read (encrypted) decryption key from file $(docv)." in + let the_info = Arg.info ["decryption-key"] ~docv:"KEY" ~doc in + Arg.(value & opt (some file) None the_info) + let vote_cmd = let doc = "create a ballot" in let man = [ @@ -287,18 +444,30 @@ 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 = [ + let decrypt_man = [ `S "DESCRIPTION"; `P "This command is run by each trustee to perform a partial decryption."; - ] @ common_man in + ] @ common_man + + let decrypt_cmd = + let doc = "perform partial decryption" 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 + Term.info "decrypt" ~doc ~man:decrypt_man + + let tdecrypt_cmd = + let doc = "perform partial decryption (threshold version)" in + let main = Term.pure (fun u d k pdk -> + let k = get_mandatory_opt "--key" k in + let pdk = get_mandatory_opt "--decryption-key" pdk in + main u d (`TDecrypt (k, pdk)) + ) + in + Term.(ret (main $ url_t $ optdir_t $ key_t $ pdk_t)), + Term.info "threshold-decrypt" ~doc ~man:decrypt_man let finalize_cmd = let doc = "finalizes an election" in @@ -310,7 +479,7 @@ 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] + let cmds = [vote_cmd; verify_cmd; decrypt_cmd; tdecrypt_cmd; finalize_cmd] end @@ -408,6 +577,9 @@ 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) + let get_threshold () = + let fn = dir / "threshold.json" in + if Sys.file_exists fn then Some (string_of_file fn) else None end in let module R = (val make (module P : PARAMS) : S) in let params = R.mkelection () in @@ -425,7 +597,7 @@ 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."; + `P "This command reads and checks $(i,public_keys.jsons) (or $(i,threshold.json) if it exists). 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 @@ -465,7 +637,7 @@ end -let cmds = Tkeygen.cmds @ Election.cmds @ Credgen.cmds @ Mkelection.cmds @ Verifydiff.cmds +let cmds = Tkeygen.cmds @ Ttkeygen.cmds @ Election.cmds @ Credgen.cmds @ Mkelection.cmds @ Verifydiff.cmds let default_cmd = let open Belenios_version in diff -Nru belenios-1.4+dfsg/src/tool/tool_credgen.ml belenios-1.6+dfsg/src/tool/tool_credgen.ml --- belenios-1.4+dfsg/src/tool/tool_credgen.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_credgen.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,6 +19,7 @@ (* . *) (**************************************************************************) +open Serializable_builtin_t open Platform open Signatures open Common @@ -34,17 +35,14 @@ end module type PARSED_PARAMS = sig - val uuid : Uuidm.t + val uuid : uuid 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 + let uuid = uuid_of_raw_string P.uuid module G = (val Group.of_string P.group : GROUP) end in (module R : PARSED_PARAMS) @@ -52,7 +50,7 @@ module Make (P : PARSED_PARAMS) : S = struct open P - module CG = Credential.MakeGenerate (Election.MakeSimpleMonad (G)) + module CG = Credential.MakeGenerate (DirectRandom) module CD = Credential.MakeDerive (G) let derive x = @@ -66,7 +64,7 @@ priv, pub, hashed let generate () = - CG.generate () () |> compute_pub_and_hash + CG.generate () |> compute_pub_and_hash end diff -Nru belenios-1.4+dfsg/src/tool/tool_election.ml belenios-1.6+dfsg/src/tool/tool_election.ml --- belenios-1.4+dfsg/src/tool/tool_election.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_election.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -27,6 +27,7 @@ module type PARAMS = sig val election : string val get_public_keys : unit -> string array option + val get_threshold : unit -> string option val get_public_creds : unit -> string Stream.t option val get_ballots : unit -> string Stream.t option val get_result : unit -> string option @@ -36,7 +37,8 @@ module type S = sig val vote : string option -> int array array -> string val decrypt : string -> string - val finalize : string array -> string + val tdecrypt : string -> string -> string + val finalize : string list -> string val verify : unit -> unit end @@ -47,7 +49,7 @@ let parse_params p = let module P = (val p : PARAMS) in - let params = Group.election_params_of_string P.election in + let params = Election.(get_group (of_string P.election)) in let module R = struct include P include (val params : ELECTION_DATA) @@ -57,35 +59,44 @@ module Make (P : PARSED_PARAMS) : S = struct open P - module M = Election.MakeSimpleMonad(G) - module E = Election.MakeElection(G)(M);; + module E = Election.Make (P) (DirectRandom) + + module KG = Trustees.MakeSimple (G) (DirectRandom) + + module P = Trustees.MakePKI (G) (DirectRandom) + module C = Trustees.MakeChannels (G) (DirectRandom) (P) + module KP = Trustees.MakePedersen (G) (DirectRandom) (P) (C) (* Load and check trustee keys, if present *) - module KG = Election.MakeSimpleDistKeyGen(G)(M);; + let threshold = + match get_threshold () with + | None -> None + | Some x -> Some (threshold_parameters_of_string G.read x) let public_keys_with_pok = - get_public_keys () |> option_map @@ - Array.map (trustee_public_key_of_string G.read) + match threshold with + | None -> + get_public_keys () |> option_map @@ + Array.map (trustee_public_key_of_string G.read) + | Some t -> Some t.t_verification_keys let () = - match public_keys_with_pok with - | Some pks -> + match public_keys_with_pok, threshold with + | Some pks, None -> 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" + let pks = lazy (match public_keys with + | Some pks -> pks + | None -> failwith "missing public keys") (* Load ballots, if present *) @@ -124,22 +135,24 @@ ) let cast (b, hash) = - if Lazy.force check_signature_present b && E.check_ballot election b - then M.cast b () + if Lazy.force check_signature_present b && E.check_ballot b + then () 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 encrypted_tally = + lazy ( + match Lazy.force ballots with + | None -> failwith "ballots.jsons is missing" + | Some ballots -> + List.fold_left (fun accu (b, _) -> + E.combine_ciphertexts (E.extract_ciphertext b) accu + ) (E.neutral_ciphertext ()) ballots, + List.length ballots + ) let vote privcred ballot = let sk = @@ -148,39 +161,75 @@ 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); + let b = E.create_ballot ?sk (E.make_randomness ()) ballot in + assert (E.check_ballot 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 ( + if Array.forall (fun x -> not G.(x =~ pk)) (Lazy.force 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 + 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 tdecrypt key pdk = + let sk = P.derive_sk key and dk = P.derive_dk key in + let vk = G.(g **~ sk) in + let pdk = C.recv dk vk pdk in + let pdk = (partial_decryption_key_of_string pdk).pdk_decryption_key in + let pvk = G.(g **~ pdk) in + (match threshold with + | None -> print_msg "W: threshold parameters are missing" + | Some t -> + if Array.forall (fun x -> + not G.(x.trustee_public_key =~ pvk) + ) t.t_verification_keys then + print_msg "W: your key is not present in threshold parameters" + ); + let tally, _ = Lazy.force encrypted_tally in + let factor = E.compute_factor tally pdk in + assert (E.check_factor tally pvk 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); + let factors = List.map (partial_decryption_of_string G.read) factors in + let tally, nballots = Lazy.force encrypted_tally in + let checker = E.check_factor tally in + let combinator = + match threshold with + | None -> + KG.combine_factors checker (Lazy.force pks) + | Some t -> KP.combine_factors checker t + in + let result = E.compute_result nballots tally factors combinator in + assert (E.check_result combinator result); string_of_result G.write result let verify () = + (match threshold with + | Some t -> + assert (KP.check t); + assert G.(election.e_params.e_public_key =~ KP.combine t) + | None -> ignore (Lazy.force pks) + ); (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) + let result = result_of_string G.read result in + assert (fst (Lazy.force encrypted_tally) = result.encrypted_tally); + let checker = E.check_factor result.encrypted_tally in + let combinator = match threshold with + | None -> KG.combine_factors checker (Lazy.force pks) + | Some t -> KP.combine_factors checker t + in + assert (E.check_result combinator result) | None -> print_msg "W: no result to check" ); print_msg "I: all checks passed" diff -Nru belenios-1.4+dfsg/src/tool/tool_election.mli belenios-1.6+dfsg/src/tool/tool_election.mli --- belenios-1.4+dfsg/src/tool/tool_election.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_election.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,6 +1,7 @@ module type PARAMS = sig val election : string val get_public_keys : unit -> string array option + val get_threshold : unit -> string option val get_public_creds : unit -> string Stream.t option val get_ballots : unit -> string Stream.t option val get_result : unit -> string option @@ -10,7 +11,8 @@ module type S = sig val vote : string option -> int array array -> string val decrypt : string -> string - val finalize : string array -> string + val tdecrypt : string -> string -> string + val finalize : string list -> string val verify : unit -> unit end diff -Nru belenios-1.4+dfsg/src/tool/tool_js_common.ml belenios-1.6+dfsg/src/tool/tool_js_common.ml --- belenios-1.4+dfsg/src/tool/tool_js_common.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js_common.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -59,3 +59,19 @@ match !res with | None -> raise Not_found | Some x -> x + +let set_element_display id x = + Js.Opt.iter + (document##getElementById (Js.string id)) + (fun e -> e##style##display <- Js.string x) + +let hide_element_by_id id = set_element_display id "none" + +let set_download id mime fn x = + let x = (Js.string ("data:" ^ mime ^ ","))##concat (Js.encodeURI (Js.string x)) in + Js.Opt.iter + (document##getElementById (Js.string id)) + (fun e -> + e##setAttribute (Js.string "download", Js.string fn); + Js.Opt.iter (Dom_html.CoerceTo.a e) (fun e -> e##href <- x) + ) diff -Nru belenios-1.4+dfsg/src/tool/tool_js_credgen.ml belenios-1.6+dfsg/src/tool/tool_js_credgen.ml --- belenios-1.4+dfsg/src/tool/tool_js_credgen.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js_credgen.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -48,13 +48,12 @@ in let text_pks = pubs |> List.sort compare |> String.concat "\n" in set_textarea "pks" text_pks; + set_download "public_creds" "text/plain" "public_creds.txt" 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)); + set_download "creds" "text/plain" "creds.txt" text_creds; 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!"; + set_download "hashed" "text/plain" "hashed.txt" text_hashed; + set_element_display "submit_form" "inline"; Js._false let fill_interactivity _ = diff -Nru belenios-1.4+dfsg/src/tool/tool_js.ml belenios-1.6+dfsg/src/tool/tool_js.ml --- belenios-1.4+dfsg/src/tool/tool_js.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -74,6 +74,13 @@ 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)); + let key = "0000000000000000000000000000000000000000000000000000000000000000" in + let iv = "00000000000000000000000000000000" in + check "AES" (fun () -> aes_hex ~key ~data:iv = "dc95c078a2408989ad48a21492842087"); + let plaintext = "Lorem ipsum dolor sit amet, consectetur adipiscing elit." in + let ciphertext = "91f136cd65db6fa83b4943395e388089d4a8d0531b43a24a6498a1433559039ce5a18734752e13418718be1c2da5cca3d89e6e62fb729a81ec1cb3d1174e770c" in + check "AES-CCM-encrypt" (fun () -> encrypt ~key ~iv ~plaintext = ciphertext); + check "AES-CCM-decrypt" (fun () -> decrypt ~key ~iv ~ciphertext = plaintext); Printf.ksprintf alert "%d tests were successful!" !ntests let cmds = ["do_unit_tests", unit_tests] @@ -166,6 +173,7 @@ let template = get_textarea "mkelection_template" let get_public_keys () = Some (get_textarea "mkelection_pks" |> split_lines |> Array.of_list) + let get_threshold () = None end in let module X = (val make (module P : PARAMS) : S) in set_textarea "mkelection_output" (X.mkelection ()) @@ -185,6 +193,8 @@ let pks = Array.of_list raw in if Array.length pks = 0 then None else Some pks + let get_threshold () = None + let get_public_creds () = let raw = get_textarea "election_pubcreds" |> split_lines in match raw with @@ -248,7 +258,7 @@ 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)) + set_textarea "election_result" (X.finalize factors) let cmds = [ "do_encrypt", create_ballot; diff -Nru belenios-1.4+dfsg/src/tool/tool_js_pd.ml belenios-1.6+dfsg/src/tool/tool_js_pd.ml --- belenios-1.4+dfsg/src/tool/tool_js_pd.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js_pd.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,6 +21,7 @@ open Platform open Serializable_j +open Common open Tool_js_common let election = ref None @@ -65,23 +66,31 @@ let compute_partial_decryption _ = Js.Opt.option !election >>= fun e -> - let election = Group.election_params_of_string e in + let election = Election.(get_group (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 + let module E = Election.Make (P) (DirectRandom) 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) + try + let epk = get_textarea "encrypted_private_key" in + let module PKI = Trustees.MakePKI (P.G) (DirectRandom) in + let module C = Trustees.MakeChannels (P.G) (DirectRandom) (PKI) in + let sk = PKI.derive_sk pk_str and dk = PKI.derive_dk pk_str in + let vk = P.G.(g **~ sk) in + let epk = C.recv dk vk epk in + (partial_decryption_key_of_string epk).pdk_decryption_key + with Not_found -> + basic_check_private_key pk_str; + 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 + let factor = E.compute_factor encrypted_tally private_key in set_textarea "pd" (string_of_partial_decryption P.G.write factor); Js.some () diff -Nru belenios-1.4+dfsg/src/tool/tool_js_questions.ml belenios-1.6+dfsg/src/tool/tool_js_questions.ml --- belenios-1.4+dfsg/src/tool/tool_js_questions.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js_questions.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/tool/tool_js_tkeygen.ml belenios-1.6+dfsg/src/tool/tool_js_tkeygen.ml --- belenios-1.4+dfsg/src/tool/tool_js_tkeygen.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js_tkeygen.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -28,11 +28,11 @@ 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)); + let {id=_; priv; pub} = trustee_keygen () in 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!"; + set_download "public_key" "application/json" "public_key.json" pub; + set_download "private_key" "application/json" "private_key.json" priv; + set_element_display "submit_form" "inline"; Js._false let fill_interactivity _ = diff -Nru belenios-1.4+dfsg/src/tool/tool_js_ttkeygen.ml belenios-1.6+dfsg/src/tool/tool_js_ttkeygen.ml --- belenios-1.4+dfsg/src/tool/tool_js_ttkeygen.ml 1970-01-01 00:00:00.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_js_ttkeygen.ml 2018-06-13 11:46:49.000000000 +0000 @@ -0,0 +1,119 @@ +(**************************************************************************) +(* BELENIOS *) +(* *) +(* Copyright © 2012-2018 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 +open Tool_js_common + +let gen_cert e _ = + let group = get_textarea "group" in + let module G = (val Group.of_string group : GROUP) in + let module P = Trustees.MakePKI (G) (DirectRandom) in + let module C = Trustees.MakeChannels (G) (DirectRandom) (P) in + let module T = Trustees.MakePedersen (G) (DirectRandom) (P) (C) in + let key, cert = T.step1 () in + let id = sha256_hex cert.s_message in + e##innerHTML <- Js.string ""; + let t = document##createTextNode (Js.string (Printf.sprintf "Certificate %s has been generated!" id)) in + Dom.appendChild e t; + set_download "private_key" "text/plain" "private_key.txt" key; + set_element_display "key_helper" "block"; + let cert = string_of_cert cert in + set_textarea "data" cert; + Js._false + +let proceed step e textarea _ = + let group = get_textarea "group" in + let key = + let r = ref "" in + Js.Opt.iter (Dom_html.CoerceTo.textarea textarea) (fun x -> r := Js.to_string x##value); + !r + in + let certs = certs_of_string (get_textarea "certs") in + let threshold = int_of_string (get_textarea "threshold") in + let module G = (val Group.of_string group : GROUP) in + let module P = Trustees.MakePKI (G) (DirectRandom) in + let module C = Trustees.MakeChannels (G) (DirectRandom) (P) in + let module T = Trustees.MakePedersen (G) (DirectRandom) (P) (C) in + match step with + | 3 -> + let polynomial = T.step3 certs key threshold in + e##innerHTML <- Js.string ""; + set_textarea "data" (string_of_polynomial polynomial); + Js._false + | 5 -> + let vinput = get_textarea "vinput" in + let vinput = vinput_of_string vinput in + let voutput = T.step5 certs key vinput in + e##innerHTML <- Js.string ""; + set_textarea "data" (string_of_voutput G.write voutput); + Js._false + | _ -> + alert "Unexpected state!"; + Js._false + +let fill_interactivity _ = + Js.Opt.iter + (document##getElementById (Js.string "interactivity")) + (fun e -> + let step = int_of_string (get_textarea "step") in + match step with + | 0 -> + hide_element_by_id "data_form"; + let t = document##createTextNode (Js.string "Waiting for the election administrator to set the threshold... Reload the page to check progress.") in + Dom.appendChild e t + | 2 | 4 | 6 -> + hide_element_by_id "data_form"; + let t = document##createTextNode (Js.string "Waiting for the other trustees... Reload the page to check progress.") in + Dom.appendChild e t + | 7 -> + hide_element_by_id "data_form"; + let t = document##createTextNode (Js.string "The key establishment protocol is finished!") in + Dom.appendChild e t + | 1 -> + let b = document##createElement (Js.string "button") in + let t = document##createTextNode (Js.string "Generate private key") in + b##onclick <- Dom_html.handler (gen_cert e); + Dom.appendChild b t; + Dom.appendChild e b; + | 3 | 5 -> + let div = document##createElement (Js.string "div") in + let t = document##createTextNode (Js.string "Private key: ") in + Dom.appendChild div t; + let textarea = Dom_html.createTextarea document in + textarea##rows <- 1; + textarea##cols <- 25; + Dom.appendChild div textarea; + Dom.appendChild e div; + let b = document##createElement (Js.string "button") in + let t = document##createTextNode (Js.string "Proceed") in + b##onclick <- Dom_html.handler (proceed step e textarea); + Dom.appendChild b t; + Dom.appendChild e b; + | _ -> + alert "Unexpected state!" + ); + Js._false + +let () = + Dom_html.window##onload <- Dom_html.handler fill_interactivity; diff -Nru belenios-1.4+dfsg/src/tool/tool_mkelection.ml belenios-1.6+dfsg/src/tool/tool_mkelection.ml --- belenios-1.4+dfsg/src/tool/tool_mkelection.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_mkelection.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,6 +19,7 @@ (* . *) (**************************************************************************) +open Serializable_builtin_t open Serializable_j open Signatures open Common @@ -28,6 +29,7 @@ val group : string val template : string val get_public_keys : unit -> string array option + val get_threshold : unit -> string option end module type S = sig @@ -35,45 +37,50 @@ end module type PARSED_PARAMS = sig - val uuid : Uuidm.t + val uuid : uuid val template : template module G : GROUP val get_public_keys : unit -> G.t trustee_public_key array option + val get_threshold : unit -> G.t threshold_parameters 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 uuid = uuid_of_raw_string 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) + let get_threshold () = + match P.get_threshold () with + | None -> None + | Some t -> Some (threshold_parameters_of_string G.read t) 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 + let y = + match get_threshold () with + | None -> + let public_keys = + match get_public_keys () with + | Some keys -> keys + | None -> failwith "trustee keys are missing" + in + let module K = Trustees.MakeSimple (G) (DirectRandom) in + K.combine public_keys + | Some t -> + let module P = Trustees.MakePKI (G) (DirectRandom) in + let module C = Trustees.MakeChannels (G) (DirectRandom) (P) in + let module K = Trustees.MakePedersen (G) (DirectRandom) (P) (C) in + K.combine t (* Setup election *) diff -Nru belenios-1.4+dfsg/src/tool/tool_mkelection.mli belenios-1.6+dfsg/src/tool/tool_mkelection.mli --- belenios-1.4+dfsg/src/tool/tool_mkelection.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_mkelection.mli 2018-06-13 11:46:49.000000000 +0000 @@ -3,6 +3,7 @@ val group : string val template : string val get_public_keys : unit -> string array option + val get_threshold : unit -> string option end module type S = sig diff -Nru belenios-1.4+dfsg/src/tool/tool_tkeygen.ml belenios-1.6+dfsg/src/tool/tool_tkeygen.ml --- belenios-1.4+dfsg/src/tool/tool_tkeygen.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_tkeygen.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -47,18 +47,15 @@ module Make (P : PARSED_PARAMS) : S = struct open P - (* Setup group *) - - module M = Election.MakeSimpleMonad(G);; - (* Generate key *) - module KG = Election.MakeSimpleDistKeyGen(G)(M);; + module KG = Trustees.MakeSimple (G) (DirectRandom) type keypair = { id : string; priv : string; pub : string } let trustee_keygen () = - let private_key, public_key = KG.generate_and_prove () () in + let private_key = KG.generate () in + let public_key = KG.prove private_key in assert (KG.check public_key); let id = String.sub (sha256_hex (G.to_string public_key.trustee_public_key)) diff -Nru belenios-1.4+dfsg/src/tool/tool_verifydiff.ml belenios-1.6+dfsg/src/tool/tool_verifydiff.ml --- belenios-1.4+dfsg/src/tool/tool_verifydiff.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_verifydiff.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,6 +21,7 @@ open Signatures open Serializable_j +open Common let stream_to_list s = let res = ref [] in @@ -37,6 +38,9 @@ let string_of_file f = lines_of_file f |> stream_to_list |> String.concat "\n" +let string_of_file_opt filename = + if Sys.file_exists filename then Some (string_of_file filename) else None + 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) @@ -49,7 +53,9 @@ | PublicKeysMismatch | MissingPublicKeys | InvalidPublicKeys + | InvalidThreshold | PublicKeyMismatch + | ThresholdMismatch | MissingCredentials | InvalidCredential | CredentialsMismatch @@ -67,7 +73,9 @@ | PublicKeysMismatch -> "public keys mismatch" | MissingPublicKeys -> "missing public keys" | InvalidPublicKeys -> "invalid public keys" + | InvalidThreshold -> "invalid threshold parameters" | PublicKeyMismatch -> "public key mismatch" + | ThresholdMismatch -> "threshold parameters mismatch" | MissingCredentials -> "missing credentials" | InvalidCredential -> "invalid credential" | CredentialsMismatch -> "credentials mismatch" @@ -96,22 +104,37 @@ 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 + (* the threshold parameters must be the same *) + let threshold = string_of_file_opt (dir1 / "threshold.json") in let () = - if not (List.for_all KG.check pks) then - raise (VerifydiffError InvalidPublicKeys) + let t2 = string_of_file_opt (dir2 / "threshold.json") in + if t2 <> threshold then raise (VerifydiffError ThresholdMismatch) + in + (* the public keys / threshold parameters must be valid *) + let module ED = (val Election.(get_group (of_string election))) in + let open ED in + let module E = Election.Make (ED) (DirectRandom) in + let y = + match threshold with + | None -> + let module K = Trustees.MakeSimple (G) (DirectRandom) in + let pks = match pks with + | None -> raise (VerifydiffError MissingPublicKeys) + | Some pks -> List.map (trustee_public_key_of_string G.read) pks + in + if not (List.for_all K.check pks) then + raise (VerifydiffError InvalidPublicKeys); + K.combine (Array.of_list pks) + | Some t -> + let t = threshold_parameters_of_string G.read t in + let module P = Trustees.MakePKI (G) (DirectRandom) in + let module C = Trustees.MakeChannels (G) (DirectRandom) (P) in + let module K = Trustees.MakePedersen (G) (DirectRandom) (P) (C) in + if not (K.check t) then + raise (VerifydiffError InvalidThreshold); + K.combine t 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) @@ -149,7 +172,7 @@ 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 + if not (List.for_all E.check_ballot ballots) then raise (VerifydiffError InvalidBallot); (* return the set of ballots indexed by the public keys used to sign *) List.fold_left (fun accu x -> diff -Nru belenios-1.4+dfsg/src/tool/tool_verifydiff.mli belenios-1.6+dfsg/src/tool/tool_verifydiff.mli --- belenios-1.4+dfsg/src/tool/tool_verifydiff.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/tool/tool_verifydiff.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -24,7 +24,9 @@ | PublicKeysMismatch | MissingPublicKeys | InvalidPublicKeys + | InvalidThreshold | PublicKeyMismatch + | ThresholdMismatch | MissingCredentials | InvalidCredential | CredentialsMismatch diff -Nru belenios-1.4+dfsg/src/web/server.mllib belenios-1.6+dfsg/src/web/server.mllib --- belenios-1.4+dfsg/src/web/server.mllib 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/server.mllib 2018-06-13 11:46:49.000000000 +0000 @@ -6,6 +6,7 @@ Common Group_field Group +Trustees Election Credential diff -Nru belenios-1.4+dfsg/src/web/web_auth.ml belenios-1.6+dfsg/src/web/web_auth.ml --- belenios-1.4+dfsg/src/web/web_auth.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_auth.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -37,25 +37,7 @@ 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 + Web_persist.set_auth_config None auth_config |> Lwt_main.run let scope = Eliom_common.default_session_scope @@ -76,7 +58,7 @@ let dummy_handler () name = match%lwt Eliom_reference.get auth_env with | None -> failwith "dummy handler was invoked without environment" - | Some (uuid, service) -> + | Some (uuid, service, _) -> Eliom_reference.set user (Some {uuid; service; name}) >> Eliom_reference.unset auth_env >> default_cont uuid () @@ -85,26 +67,45 @@ (** Password authentication *) +let check_password_with_file db name password = + let%lwt db = Lwt_preemptive.detach Csv.load db in + try + begin + match + List.find (function + | username :: _ :: _ :: _ -> username = name + | _ -> false + ) db + with + | _ :: salt :: hashed :: _ -> + return (sha256_hex (salt ^ password) = hashed) + | _ -> return false + end + with Not_found -> return false + let password_handler () (name, password) = - let%lwt uuid, service = + let%lwt uuid, service, config = match%lwt Eliom_reference.get auth_env with | None -> failwith "password handler was invoked without environment" | Some x -> return x in - let table = - "password_" ^ + let%lwt ok = 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 + | None -> + begin + match config with + | [db] -> check_password_with_file db name password + | _ -> failwith "invalid configuration for admin site" + end + | Some uuid -> + let table = "password_" ^ underscorize uuid in + let table = Ocsipersist.open_table table in + try%lwt + let%lwt salt, hashed = Ocsipersist.find table name in + return (sha256_hex (salt ^ password) = hashed) + with Not_found -> return false in - if sha256_hex (salt ^ password) = hashed then + if ok then Eliom_reference.set user (Some {uuid; service; name}) >> Eliom_reference.unset auth_env >> default_cont uuid () @@ -161,7 +162,7 @@ | None -> return (`Error `Http) let cas_handler ticket () = - let%lwt uuid, service = + let%lwt uuid, service, _ = match%lwt Eliom_reference.get auth_env with | None -> failwith "cas handler was invoked without environment" | Some x -> return x @@ -248,7 +249,7 @@ | None -> return None let oidc_handler params () = - let%lwt uuid, service = + let%lwt uuid, service, _ = match%lwt Eliom_reference.get auth_env with | None -> failwith "oidc handler was invoked without environment" | Some x -> return x @@ -311,7 +312,7 @@ (** Generic authentication *) let get_login_handler service uuid auth_system config = - Eliom_reference.set auth_env (Some (uuid, service)) >> + Eliom_reference.set auth_env (Some (uuid, service, config)) >> match auth_system with | "dummy" -> Web_templates.login_dummy () >>= Eliom_registration.Html5.send | "cas" -> cas_login_handler config () @@ -330,11 +331,7 @@ 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 + let%lwt c = Web_persist.get_auth_config uuid in match service with | Some s -> let%lwt auth_system, config = diff -Nru belenios-1.4+dfsg/src/web/web_common.ml belenios-1.6+dfsg/src/web/web_common.ml --- belenios-1.4+dfsg/src/web/web_common.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_common.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -22,31 +22,28 @@ open Lwt open Platform open Common +open Serializable_builtin_t open Web_serializable_builtin_t open Web_serializable_j let spool_dir = ref "." +let server_mail = ref "noreply@example.org" +let return_path = ref None +let contact_uri = ref None +let gdpr_uri = 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 +module LwtRandom = struct type 'a t = 'a Lwt.t let return = Lwt.return let bind = Lwt.bind let fail = Lwt.fail + let prng = lazy (pseudo_rng (random_string secure_rng 16)) + let random q = - let size = Z.bit_length q / 8 + 1 in - let%lwt rng = X.rng in + let size = bytes_to_sample q in + let%lwt rng = Lwt_preemptive.detach Lazy.force prng in let r = random_string rng size in return Z.(of_bits r mod q) @@ -69,19 +66,20 @@ 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 explain_error l e = + let module L = (val l : Web_i18n_sig.LocalizedStrings) in + match e with + | Serialization e -> Printf.sprintf L.error_Serialization (Printexc.to_string e) + | ProofCheck -> L.error_ProofCheck + | ElectionClosed -> L.error_ElectionClosed + | MissingCredential -> L.error_MissingCredential + | InvalidCredential -> L.error_InvalidCredential + | RevoteNotAllowed -> L.error_RevoteNotAllowed + | ReusedCredential -> L.error_ReusedCredential + | WrongCredential -> L.error_WrongCredential + | UsedCredential -> L.error_UsedCredential + | CredentialNotFound -> L.error_CredentialNotFound + | UnauthorizedVoter -> L.error_UnauthorizedVoter let security_logfile = ref None @@ -135,6 +133,7 @@ type election_file = | ESRaw | ESKeys + | ESTParams | ESCreds | ESBallots | ESVoters @@ -145,6 +144,7 @@ let election_file_of_string = function | "election.json" -> ESRaw | "public_keys.jsons" -> ESKeys + | "threshold.json" -> ESTParams | "public_creds.txt" -> ESCreds | "ballots.jsons" -> ESBallots | "records" -> ESRecords @@ -156,6 +156,7 @@ let string_of_election_file = function | ESRaw -> "election.json" | ESKeys -> "public_keys.jsons" + | ESTParams -> "threshold.json" | ESCreds -> "public_creds.txt" | ESBallots -> "ballots.jsons" | ESRecords -> "records" @@ -167,18 +168,10 @@ ~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 + Eliom_parameter.user_type ~of_string:uuid_of_raw_string ~to_string:raw_string_of_uuid let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" -let token_length = 14 let prng = lazy (pseudo_rng (random_string secure_rng 16)) let random_char () = @@ -188,10 +181,10 @@ in return (int_of_char (random_string rng 1).[0]) -let generate_token () = - let res = Bytes.create token_length in +let generate_token ?(length=14) () = + let res = Bytes.create length in let rec loop i = - if i < token_length then ( + if i < length then ( let%lwt digit = random_char () in let digit = digit mod 58 in Bytes.set res i b58_digits.[digit]; @@ -203,19 +196,28 @@ user_domain ^ ":" ^ user_name let underscorize x = - String.map (function '-' -> '_' | c -> c) x + String.map (function '-' -> '_' | c -> c) (raw_string_of_uuid x) + +let sendmail ?return_path message = + let mailer = + match return_path with + | None -> None + | Some x -> Some (Printf.sprintf "/usr/lib/sendmail -f %s" x) in + Netsendmail.sendmail ?mailer message let send_email recipient subject body = let contents = Netsendmail.compose - ~from_addr:("Belenios public server", "noreply@belenios.org") + ~from_addr:("Belenios public server", !server_mail) ~to_addrs:[recipient, recipient] ~in_charset:`Enc_utf8 ~out_charset:`Enc_utf8 ~subject body in + let return_path = !return_path in + let sendmail = sendmail ?return_path in let rec loop () = try%lwt - Lwt_preemptive.detach Netsendmail.sendmail contents + Lwt_preemptive.detach sendmail contents with Unix.Unix_error (Unix.EAGAIN, _, _) -> Lwt_unix.sleep 1. >> loop () in loop () @@ -239,4 +241,34 @@ String.concat " " (get_languages xs) let languages_of_string x = - Some (Pcre.split x) + Pcre.split x + +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 + +let get_fname uuid x = + match uuid with + | None -> x + | Some uuid -> + let ( / ) = Filename.concat in + !spool_dir / raw_string_of_uuid uuid / x + +let read_file ?uuid x = + try%lwt + let%lwt lines = Lwt_io.lines_of_file (get_fname uuid x) |> Lwt_stream.to_list in + return (Some lines) + with _ -> return_none + +let write_file ?uuid x lines = + Lwt_io.( + with_file Output (get_fname uuid x) (fun oc -> + Lwt_list.iter_s (write_line oc) lines + ) + ) + +let default_contact = "Name " diff -Nru belenios-1.4+dfsg/src/web/web_common.mli belenios-1.6+dfsg/src/web/web_common.mli --- belenios-1.4+dfsg/src/web/web_common.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_common.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,21 +19,16 @@ (* . *) (**************************************************************************) +open Signatures open Web_serializable_t val spool_dir : string ref +val server_mail : string ref +val return_path : string option ref +val contact_uri : string option ref +val gdpr_uri : 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 +module LwtRandom : RANDOM with type 'a t = 'a Lwt.t (** Lwt-compatible random number generation. *) type error = @@ -53,7 +48,7 @@ val fail : error -> 'a Lwt.t -val explain_error : error -> string +val explain_error : (module Web_i18n_sig.LocalizedStrings) -> error -> string val open_security_log : string -> unit Lwt.t (** Set the path to the security logger. *) @@ -70,6 +65,7 @@ type election_file = | ESRaw | ESKeys + | ESTParams | ESCreds | ESBallots | ESVoters @@ -86,19 +82,17 @@ [ `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) + (uuid, [ `WithoutSuffix ], + [ `One of uuid ] Eliom_parameter.param_name) Eliom_parameter.params_type -val generate_token : unit -> string Lwt.t +val generate_token : ?length:int -> unit -> string Lwt.t val string_of_user : user -> string -val underscorize : string -> string +val underscorize : uuid -> string val send_email : string -> string -> string -> unit Lwt.t @@ -107,4 +101,11 @@ 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 +val languages_of_string : string -> string list + +val is_email : string -> bool + +val read_file : ?uuid:uuid -> string -> string list option Lwt.t +val write_file : ?uuid:uuid -> string -> string list -> unit Lwt.t + +val default_contact : string diff -Nru belenios-1.4+dfsg/src/web/web_election.ml belenios-1.6+dfsg/src/web/web_election.ml --- belenios-1.4+dfsg/src/web/web_election.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_election.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,6 +21,7 @@ open Lwt open Platform +open Serializable_builtin_t open Serializable_j open Signatures open Common @@ -30,14 +31,11 @@ let ( / ) = Filename.concat -module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION = struct +module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct - let uuid = Uuidm.to_string D.election.e_params.e_uuid + let uuid = E.election.e_params.e_uuid - module G = D.G - module E = Election.MakeElection (G) (M) - - module B : WEB_BALLOT_BOX = struct + module G = E.G let uuid_u = underscorize uuid let ballots_table = Ocsipersist.open_table ("ballots_" ^ uuid_u) @@ -51,9 +49,11 @@ 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 send_confirmation_email revote user email hash = + let title = E.election.e_params.e_name in + let uuid = E.election.e_params.e_uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + let x = (uuid, ()) in let url1 = Eliom_uri.make_string_uri ~absolute:true ~service:Web_services.election_pretty_ballots x |> rewrite_prefix in @@ -63,19 +63,20 @@ 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 + let contact = Web_templates.contact_footer metadata L.please_contact in + let revote = if revote then L.this_vote_replaces else "" in + let body = Printf.sprintf L.mail_confirmation user title hash revote url1 url2 contact 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 voters = read_file ~uuid "voters.txt" 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 loop (match voters with Some xs -> xs | None -> []) in let user = string_of_user user in let%lwt state = Web_persist.get_election_state uuid in @@ -105,12 +106,13 @@ match old_cred, old_record with | None, None -> (* first vote *) - if E.check_ballot D.election ballot then ( + let%lwt b = Lwt_preemptive.detach E.check_ballot ballot in + if b 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 >> + send_confirmation_email false login email hash >> return hash ) else ( fail ProofCheck @@ -118,13 +120,14 @@ | Some h, Some (_, old_credential) -> (* revote *) if credential = old_credential then ( - if E.check_ballot D.election ballot then ( + let%lwt b = Lwt_preemptive.detach E.check_ballot ballot in + if b 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 >> + send_confirmation_email true login email hash >> return hash ) else ( fail ProofCheck @@ -157,7 +160,7 @@ Ocsipersist.add cred_table new_ None let do_write f = - Lwt_io.(with_file ~mode:Output (!spool_dir / uuid / string_of_election_file f)) + Lwt_io.(with_file ~mode:Output (!spool_dir / raw_string_of_uuid uuid / string_of_election_file f)) let do_write_ballots () = do_write ESBallots (fun oc -> @@ -211,7 +214,7 @@ 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) + ballots_table (0, E.neutral_ciphertext ()) in let tally = string_of_encrypted_tally G.write tally in Lwt_mutex.with_lock mutex (fun () -> @@ -221,6 +224,4 @@ ) >> return (num_tallied, sha256_b64 tally, tally) - end - end diff -Nru belenios-1.4+dfsg/src/web/web_election.mli belenios-1.6+dfsg/src/web/web_election.mli --- belenios-1.4+dfsg/src/web/web_election.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_election.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -22,4 +22,4 @@ open Signatures open Web_signatures -module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION +module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX diff -Nru belenios-1.4+dfsg/src/web/web_i18n_sig.mli belenios-1.6+dfsg/src/web/web_i18n_sig.mli --- belenios-1.4+dfsg/src/web/web_i18n_sig.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_i18n_sig.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -64,6 +64,7 @@ val your_ballot_for : string val has_been_received : string val nobody_can_see : string + val you_have_already_voted : string val go_back_to_election : string val has_been_accepted : string val you_can_check_its_presence : string @@ -92,7 +93,8 @@ val password : string val login : string val password_login : string - val you_must_accept_cookies : string + val by_using_you_accept : string + val privacy_policy : string val accept : string val not_yet_open : string val come_back_later : string @@ -111,9 +113,24 @@ 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_password : (string -> 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_credential : (string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 + val mail_credential_password : string + val mail_credential_cas : string 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 + val mail_confirmation : (string -> string -> string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 + val this_vote_replaces : string + val please_contact : string + val error_Serialization : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 + val error_ProofCheck : string + val error_ElectionClosed : string + val error_MissingCredential : string + val error_InvalidCredential : string + val error_RevoteNotAllowed : string + val error_ReusedCredential : string + val error_WrongCredential : string + val error_UsedCredential : string + val error_CredentialNotFound : string + val error_UnauthorizedVoter : string end diff -Nru belenios-1.4+dfsg/src/web/web_l10n_de.ml belenios-1.6+dfsg/src/web/web_l10n_de.ml --- belenios-1.4+dfsg/src/web/web_l10n_de.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_l10n_de.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -63,6 +63,7 @@ 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 you_have_already_voted = "Note: you have already voted. Your vote will be replaced." 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 " @@ -91,7 +92,8 @@ 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 by_using_you_accept = "By using this site, you accept our " +let privacy_policy = "personal data policy" 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." @@ -131,7 +133,7 @@ Passwort: %s Website der Abstimmung: %s -Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt." +Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt.%s" let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = @@ -142,20 +144,24 @@ %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. +%s -Benutzername: %s Wählernummer: %s Website der Abstimmung: %s -Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt." +Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt.%s" + +let mail_credential_password = +"Am Ende der Mail finden Sie 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." +let mail_credential_cas = +"Am Ende der Mail finden Sie Ihre Wählernummer." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Ihre Stimme zur Abstimmung %s" @@ -169,15 +175,29 @@ wurde angenommen. Ihre Stimmennummer ist: - %s + %s%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 + %s%s -- \nBelenios" + +let this_vote_replaces = "\n\nThis vote replaces any previous vote." +let please_contact = "To get more information, please contact:" + +let error_Serialization : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "your ballot has a syntax error (%s)" +let error_ProofCheck = "some proofs failed verification" +let error_ElectionClosed = "the election is closed" +let error_MissingCredential = "a credential is missing" +let error_InvalidCredential = "your credential is invalid" +let error_RevoteNotAllowed = "you are not allowed to revote" +let error_ReusedCredential = "your credential has already been used" +let error_WrongCredential = "you are not allowed to vote with this credential" +let error_UsedCredential = "the credential has already been used" +let error_CredentialNotFound = "the credential has not been found" +let error_UnauthorizedVoter = "you are not allowed to vote" diff -Nru belenios-1.4+dfsg/src/web/web_l10n_en.ml belenios-1.6+dfsg/src/web/web_l10n_en.ml --- belenios-1.4+dfsg/src/web/web_l10n_en.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_l10n_en.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -63,6 +63,7 @@ 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 you_have_already_voted = "Note: you have already voted. Your vote will be replaced." 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 " @@ -91,7 +92,8 @@ 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 by_using_you_accept = "By using this site, you accept our " +let privacy_policy = "personal data policy" 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." @@ -131,7 +133,7 @@ Page of the election: %s Note that you are allowed to vote several times. Only the last vote -counts." +counts.%s" let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = @@ -142,20 +144,23 @@ %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. +%s -Username: %s Credential: %s Page of the election: %s Note that you are allowed to vote several times. Only the last vote -counts." +counts.%s" + +let mail_credential_password = +"You will find below your 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." +let mail_credential_cas = +"You will find below your credential." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Your vote for election %s" @@ -169,14 +174,28 @@ has been recorded. Your smart ballot tracker is - %s + %s%s -You can check its presence in the ballot box, accessible at +You can check its presence in the ballot box, accessible at %s Results will be published on the election page - - %s + %s%s -- \nBelenios" + +let this_vote_replaces = "\n\nThis vote replaces any previous vote." +let please_contact = "To get more information, please contact:" + +let error_Serialization : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "your ballot has a syntax error (%s)" +let error_ProofCheck = "some proofs failed verification" +let error_ElectionClosed = "the election is closed" +let error_MissingCredential = "a credential is missing" +let error_InvalidCredential = "your credential is invalid" +let error_RevoteNotAllowed = "you are not allowed to revote" +let error_ReusedCredential = "your credential has already been used" +let error_WrongCredential = "you are not allowed to vote with this credential" +let error_UsedCredential = "the credential has already been used" +let error_CredentialNotFound = "the credential has not been found" +let error_UnauthorizedVoter = "you are not allowed to vote" diff -Nru belenios-1.4+dfsg/src/web/web_l10n_fr.ml belenios-1.6+dfsg/src/web/web_l10n_fr.ml --- belenios-1.4+dfsg/src/web/web_l10n_fr.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_l10n_fr.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -63,6 +63,7 @@ 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 you_have_already_voted = "Note: vous avez déjà voté. Votre vote va être remplacé." 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'" @@ -91,7 +92,8 @@ 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 by_using_you_accept = "En utilisant ce site, vous acceptez notre " +let privacy_policy = "politique concernant les données personnelles" 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." @@ -132,7 +134,7 @@ Page de l'élection : %s Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est -pris en compte." +pris en compte.%s" let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = @@ -143,21 +145,25 @@ %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. +%s -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." +pris en compte.%s" + +let mail_credential_password = +"Veuillez trouver ci-dessous 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." +let mail_credential_cas = +"Veuillez trouver ci-dessous votre code de vote." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Votre vote pour l'élection %s" @@ -171,14 +177,28 @@ a été enregistré. Votre numéro de suivi est - %s + %s%s -Vous pouvez vérifier sa présence dans l'urne, accessible au +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 + %s%s -- \nBelenios" + +let this_vote_replaces = "\n\nCe vote remplace le vote précédent." +let please_contact = "Pour obtenir plus d'informations, veuillez contacter :" + +let error_Serialization : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "votre bulletin a une erreur de syntaxe (%s)" +let error_ProofCheck = "certaines preuves sont invalides" +let error_ElectionClosed = "l'élection est fermée" +let error_MissingCredential = "un code de vote manque" +let error_InvalidCredential = "votre code de vote est invalide" +let error_RevoteNotAllowed = "vous n'êtes pas autorisé(e) à revoter" +let error_ReusedCredential = "votre code de vote a déjà été utilisé" +let error_WrongCredential = "vous n'êtes pas autorisé(e) à voter avec ce code de vote" +let error_UsedCredential = "le code de vote a déjà été utilisé" +let error_CredentialNotFound = "le code de vote n'a pas été trouvé" +let error_UnauthorizedVoter = "vous n'êtes pas autorisé(e) a voter" diff -Nru belenios-1.4+dfsg/src/web/web_l10n_it.ml belenios-1.6+dfsg/src/web/web_l10n_it.ml --- belenios-1.4+dfsg/src/web/web_l10n_it.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_l10n_it.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2017 Inria *) +(* Copyright © 2012-2018 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 *) @@ -63,6 +63,7 @@ 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 you_have_already_voted = "Note: you have already voted. Your vote will be replaced." 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'" @@ -91,7 +92,8 @@ 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 by_using_you_accept = "By using this site, you accept our " +let privacy_policy = "personal data policy" 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." @@ -134,7 +136,7 @@ Pagina dell'elezione : %s Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è -preso in considerazione." +preso in considerazione.%s" let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = @@ -145,23 +147,25 @@ %s +%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." +preso in considerazione.%s" +let mail_credential_password = +"Si prega di trovare qui sotto 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." + +let mail_credential_cas = +"Si prega di trovare qui sotto il suo codice di voto." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "La sua scheda per l'elezione %s" @@ -175,14 +179,28 @@ è stata registrata. Il suo codice di verifica è - %s + %s%s -Può verificare la sua presenza nell'urna, accessibile su +Può verificare la sua presenza nell'urna, accessibile su %s I risultati saranno pubblicati sulla pagina dell'elezione - - %s + %s%s -- \nBelenios" + +let this_vote_replaces = "\n\nThis vote replaces any previous vote." +let please_contact = "To get more information, please contact:" + +let error_Serialization : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "your ballot has a syntax error (%s)" +let error_ProofCheck = "some proofs failed verification" +let error_ElectionClosed = "the election is closed" +let error_MissingCredential = "a credential is missing" +let error_InvalidCredential = "your credential is invalid" +let error_RevoteNotAllowed = "you are not allowed to revote" +let error_ReusedCredential = "your credential has already been used" +let error_WrongCredential = "you are not allowed to vote with this credential" +let error_UsedCredential = "the credential has already been used" +let error_CredentialNotFound = "the credential has not been found" +let error_UnauthorizedVoter = "you are not allowed to vote" diff -Nru belenios-1.4+dfsg/src/web/web_l10n_ro.ml belenios-1.6+dfsg/src/web/web_l10n_ro.ml --- belenios-1.4+dfsg/src/web/web_l10n_ro.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_l10n_ro.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -63,6 +63,7 @@ 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 you_have_already_voted = "Note: you have already voted. Your vote will be replaced." 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 " @@ -91,7 +92,8 @@ 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 by_using_you_accept = "By using this site, you accept our " +let privacy_policy = "personal data policy" 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." @@ -132,7 +134,7 @@ Pagina alegerii: %s Rețineți că este posibil să votați de mai multe ori. -Numai ultimul vot va fi luat în considerare." +Numai ultimul vot va fi luat în considerare.%s" let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = @@ -143,21 +145,24 @@ %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. +%s -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." +Numai ultimul vot va fi luat în considerare.%s" + +let mail_credential_password = +"Veți găsi mai jos codul de vot. 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." +let mail_credential_cas = +"Veți găsi mai jos codul de vot." let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "Votul vostru pentru alegerea %s" @@ -171,14 +176,28 @@ a fost înregistrat. Numărul vostru de identificare este - %s + %s%s -Puteți verifica prezența acestuia în urma de vot, accesibilă la +Puteți verifica prezența acestuia în urma de vot, accesibilă la %s Rezultatele vor fi publicate pe pagina de alegere - - %s + %s%s -- \nBelenios" + +let this_vote_replaces = "\n\nThis vote replaces any previous vote." +let please_contact = "To get more information, please contact:" + +let error_Serialization : ('a, 'b, 'c, 'd, 'e, 'f) format6 = "your ballot has a syntax error (%s)" +let error_ProofCheck = "some proofs failed verification" +let error_ElectionClosed = "the election is closed" +let error_MissingCredential = "a credential is missing" +let error_InvalidCredential = "your credential is invalid" +let error_RevoteNotAllowed = "you are not allowed to revote" +let error_ReusedCredential = "your credential has already been used" +let error_WrongCredential = "you are not allowed to vote with this credential" +let error_UsedCredential = "the credential has already been used" +let error_CredentialNotFound = "the credential has not been found" +let error_UnauthorizedVoter = "you are not allowed to vote" diff -Nru belenios-1.4+dfsg/src/web/web_main.ml belenios-1.6+dfsg/src/web/web_main.ml --- belenios-1.4+dfsg/src/web/web_main.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_main.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -20,7 +20,7 @@ (**************************************************************************) open Lwt -open Common +open Serializable_builtin_t open Web_serializable_j open Web_common @@ -37,6 +37,8 @@ let spool_dir = ref None let source_file = ref None let auth_instances = ref [] +let gdpr_uri = ref None +let default_group_file = ref None let () = Eliom_config.get_config () |> @@ -48,8 +50,32 @@ Lwt_main.run (open_security_log file) | Element ("source", ["file", file], []) -> source_file := Some file + | Element ("default-group", ["file", file], []) -> + default_group_file := Some file | Element ("maxmailsatonce", ["value", limit], []) -> Web_site.maxmailsatonce := int_of_string limit + | Element ("uuid", ["length", length], []) -> + let length = int_of_string length in + if length >= min_uuid_length then + Web_site.uuid_length := Some length + else + failwith "UUID length is too small" + | Element ("contact", ["uri", uri], []) -> + Web_common.contact_uri := Some uri + | Element ("gdpr", ["uri", uri], []) -> + gdpr_uri := Some uri + | Element ("server", attrs, []) -> + let set attr setter = + try + let mail = List.assoc attr attrs in + if is_email mail then + setter mail + else + Printf.ksprintf failwith "%s is not a valid e-mail address" mail + with Not_found -> () + in + set "mail" (fun x -> server_mail := x); + set "return-path" (fun x -> return_path := Some x); | Element ("spool", ["dir", dir], []) -> spool_dir := Some dir | Element ("rewrite-prefix", ["src", src; "dst", dst], []) -> @@ -63,6 +89,11 @@ "invalid configuration for tag %s in belenios" tag +let () = + match !gdpr_uri with + | None -> failwith "You must provide a GDPR URI" + | Some x -> Web_common.gdpr_uri := x + (** Parse configuration from other sources *) let file_exists x = @@ -88,8 +119,18 @@ | Some d -> d | None -> failwith "missing in configuration" +let%lwt default_group = + match !default_group_file with + | None -> failwith "missing in configuration" + | Some x -> + let%lwt x = Lwt_io.lines_of_file x |> Lwt_stream.to_list in + match x with + | [x] -> return x + | _ -> failwith "invalid default group file" + (** Build up the site *) let () = Web_site.source_file := source_file let () = Web_common.spool_dir := spool_dir +let () = Web_site.default_group := default_group let () = Web_auth.configure (List.rev !auth_instances) diff -Nru belenios-1.4+dfsg/src/web/web_persist.ml belenios-1.6+dfsg/src/web/web_persist.ml --- belenios-1.4+dfsg/src/web/web_persist.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_persist.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,6 +21,7 @@ open Lwt open Platform +open Serializable_builtin_t open Serializable_j open Common open Web_serializable_j @@ -29,11 +30,9 @@ 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 + match%lwt read_file ~uuid "result.json" with + | Some [x] -> return (Some (result_of_string Yojson.Safe.read_json x)) + | _ -> return_none type election_state = [ `Open @@ -46,55 +45,51 @@ let election_states = Ocsipersist.open_table "election_states" let get_election_state x = - try%lwt Ocsipersist.find election_states x + try%lwt Ocsipersist.find election_states (raw_string_of_uuid x) with Not_found -> return `Archived let set_election_state x s = - Ocsipersist.add election_states x s + Ocsipersist.add election_states (raw_string_of_uuid 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 dates = string_of_election_dates { e_finalization = d } in + write_file ~uuid "dates.json" [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 + match%lwt read_file ~uuid "dates.json" with + | Some [x] -> + let dates = election_dates_of_string x in + return dates.e_finalization + | _ -> return past let election_pds = Ocsipersist.open_table "election_pds" let get_partial_decryptions x = - try%lwt Ocsipersist.find election_pds x + try%lwt Ocsipersist.find election_pds (raw_string_of_uuid x) with Not_found -> return [] let set_partial_decryptions x pds = - Ocsipersist.add election_pds x pds + Ocsipersist.add election_pds (raw_string_of_uuid x) pds let auth_configs = Ocsipersist.open_table "auth_configs" +let key_of_uuid_option = function + | None -> "" + | Some x -> raw_string_of_uuid x + let get_auth_config x = - try%lwt Ocsipersist.find auth_configs x + try%lwt Ocsipersist.find auth_configs (key_of_uuid_option x) with Not_found -> return [] let set_auth_config x c = - Ocsipersist.add auth_configs x c + Ocsipersist.add auth_configs (key_of_uuid_option 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 + match%lwt read_file ~uuid "election.json" with + | Some [x] -> return (Some x) + | _ -> return_none let empty_metadata = { e_owner = None; @@ -102,37 +97,41 @@ e_cred_authority = None; e_trustees = None; e_languages = None; + e_contact = None; + e_server_is_trustee = 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 + match%lwt read_file ~uuid "metadata.json" with + | Some [x] -> return (metadata_of_string x) + | _ -> 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 + Lwt_stream.filter_map_s + (fun x -> + if x = "." || x = ".." then + return None + else ( + try + let uuid = uuid_of_raw_string x in + let%lwt metadata = get_election_metadata uuid in + match metadata.e_owner with + | Some o when o = user -> return (Some uuid) + | _ -> return None + with _ -> return None + ) + ) |> + 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 + read_file ~uuid "voters.txt" let get_passwords uuid = let csv = - try Some (Csv.load (!spool_dir / uuid / "passwords.csv")) + try Some (Csv.load (!spool_dir / raw_string_of_uuid uuid / "passwords.csv")) with _ -> None in match csv with @@ -147,34 +146,45 @@ 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 + read_file ~uuid "public_keys.jsons" + +let get_private_key uuid = + match%lwt read_file ~uuid "private_key.json" with + | Some [x] -> return (Some (number_of_string x)) + | _ -> return_none + +let get_private_keys uuid = + read_file ~uuid "private_keys.jsons" + +let get_threshold uuid = + match%lwt read_file ~uuid "threshold.json" with + | Some [x] -> return (Some x) + | _ -> return_none module Ballots = Map.Make (String) module BallotsCacheTypes = struct - type key = string + type key = uuid 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 + match%lwt read_file ~uuid "ballots.jsons" with + | Some bs -> + return ( + List.fold_left (fun accu b -> + let hash = sha256_b64 b in + Ballots.add hash b accu + ) Ballots.empty bs + ) + | None -> return Ballots.empty let archived_ballots_cache = new BallotsCache.cache raw_get_ballots_archived 10 -let get_ballot_hashes ~uuid = +let get_ballot_hashes uuid = match%lwt get_election_state uuid with | `Archived -> let%lwt ballots = archived_ballots_cache#find uuid in @@ -185,7 +195,7 @@ return (hash :: accu) ) table [] >>= (fun x -> return @@ List.rev x) -let get_ballot_by_hash ~uuid ~hash = +let get_ballot_by_hash uuid hash = match%lwt get_election_state uuid with | `Archived -> let%lwt ballots = archived_ballots_cache#find uuid in @@ -194,3 +204,12 @@ 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 + +let has_voted uuid user = + let uuid_u = underscorize uuid in + let records_table = Ocsipersist.open_table ("records_" ^ uuid_u) in + try%lwt + let%lwt _ = Ocsipersist.find records_table (string_of_user user) in + return true + with Not_found -> + return false diff -Nru belenios-1.4+dfsg/src/web/web_persist.mli belenios-1.6+dfsg/src/web/web_persist.mli --- belenios-1.4+dfsg/src/web/web_persist.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_persist.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -30,27 +30,32 @@ | `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_state : uuid -> election_state Lwt.t +val set_election_state : uuid -> election_state -> unit Lwt.t -val get_election_date : string -> datetime Lwt.t -val set_election_date : string -> datetime -> unit Lwt.t +val get_election_date : uuid -> datetime Lwt.t +val set_election_date : uuid -> 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_partial_decryptions : uuid -> (int * string) list Lwt.t +val set_partial_decryptions : uuid -> (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_auth_config : uuid option -> (string * (string * string list)) list Lwt.t +val set_auth_config : uuid option -> (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_raw_election : uuid -> string option Lwt.t +val get_election_metadata : uuid -> metadata Lwt.t +val get_election_result : uuid -> Yojson.Safe.json result option Lwt.t -val get_elections_by_owner : user -> string list Lwt.t +val get_elections_by_owner : user -> uuid 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_voters : uuid -> string list option Lwt.t +val get_passwords : uuid -> (string * string) SMap.t option Lwt.t +val get_public_keys : uuid -> string list option Lwt.t +val get_private_key : uuid -> number option Lwt.t +val get_private_keys : uuid -> string list option Lwt.t +val get_threshold : uuid -> string 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 +val get_ballot_hashes : uuid -> string list Lwt.t +val get_ballot_by_hash : uuid -> string -> string option Lwt.t + +val has_voted : uuid -> user -> bool Lwt.t diff -Nru belenios-1.4+dfsg/src/web/web_serializable.atd belenios-1.6+dfsg/src/web/web_serializable.atd --- belenios-1.4+dfsg/src/web/web_serializable.atd 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_serializable.atd 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -23,18 +23,17 @@ (** {1 Predefined types} *) +type number = abstract type uuid = abstract type string_set = abstract type datetime = abstract type template = abstract +type cert = abstract +type polynomial = abstract +type vinput = abstract (** {1 Web-specific types} *) -type randomness = { - randomness : string; -} - - type user = { domain : string; name : string; @@ -52,6 +51,8 @@ ?cred_authority : string option; ?trustees : string list option; ?languages : string list option; + ?contact : string option; + ?server_is_trustee : bool option; } type election_dates = { @@ -69,8 +70,19 @@ id : string; token : string; public_key : string; + ?private_key : number option; } +type setup_threshold_trustee = { + id : string; + token : string; + ?step : int option; + ?cert : cert option; + ?polynomial : polynomial option; + ?vinput : vinput option; + ?voutput : string option; +} + type setup_election = { owner : user; group : string; @@ -80,6 +92,10 @@ metadata : metadata; public_creds : string; public_creds_received : bool; + ?threshold : int option; + ?threshold_trustees : setup_threshold_trustee list option; + ?threshold_parameters : string option; + ?threshold_error : string option; } (** {1 OpenID Connect-related types} *) diff -Nru belenios-1.4+dfsg/src/web/web_serializable_builtin_j.ml belenios-1.6+dfsg/src/web/web_serializable_builtin_j.ml --- belenios-1.4+dfsg/src/web/web_serializable_builtin_j.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_serializable_builtin_j.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/web/web_serializable_builtin_j.mli belenios-1.6+dfsg/src/web/web_serializable_builtin_j.mli --- belenios-1.4+dfsg/src/web/web_serializable_builtin_j.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_serializable_builtin_j.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/web/web_serializable_builtin_t.ml belenios-1.6+dfsg/src/web/web_serializable_builtin_t.ml --- belenios-1.4+dfsg/src/web/web_serializable_builtin_t.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_serializable_builtin_t.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/web/web_serializable_builtin_t.mli belenios-1.6+dfsg/src/web/web_serializable_builtin_t.mli --- belenios-1.4+dfsg/src/web/web_serializable_builtin_t.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_serializable_builtin_t.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) diff -Nru belenios-1.4+dfsg/src/web/web_services.ml belenios-1.6+dfsg/src/web/web_services.ml --- belenios-1.4+dfsg/src/web/web_services.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_services.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -26,11 +26,11 @@ let home = service ~path:[""] ~get_params:unit () let admin = service ~path:["admin"] ~get_params:unit () +let admin_gdpr_accept = post_coservice ~csrf_safe:true ~fallback:admin ~post_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"] @@ -41,24 +41,34 @@ 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_contact = post_coservice ~fallback:election_setup ~post_params:(string "contact") () 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_add_server = post_coservice ~fallback:election_setup ~post_params:unit () 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_post = post_service ~fallback:election_setup_credentials ~post_params:(string "public_creds") () +let election_setup_credentials_post_file = post_service ~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_threshold_trustees = service ~path:["setup"; "threshold-trustees"] ~get_params:(uuid "uuid") () +let election_setup_threshold_trustee = service ~path:["setup"; "threshold-trustee"] ~get_params:(string "token") () +let election_setup_threshold_trustee_post = post_coservice ~fallback:election_setup_threshold_trustee ~post_params:(string "data") () +let election_setup_threshold_set = post_coservice ~fallback:election_setup_threshold_trustees ~post_params:(int "threshold") () +let election_setup_threshold_trustee_add = post_coservice ~fallback:election_setup_threshold_trustees ~post_params:(string "id") () +let election_setup_threshold_trustee_del = post_coservice ~fallback:election_setup_threshold_trustees ~post_params:(int "index") () + 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_destroy = 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") () @@ -77,7 +87,7 @@ 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_vote = service ~path:["vote.html"] ~get_params:unit () 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 () @@ -88,7 +98,7 @@ 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 = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** string "token")) () 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 () diff -Nru belenios-1.4+dfsg/src/web/web_signatures.mli belenios-1.6+dfsg/src/web/web_signatures.mli --- belenios-1.4+dfsg/src/web/web_signatures.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_signatures.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,7 +19,6 @@ (* . *) (**************************************************************************) -open Signatures open Web_serializable_t module type AUTH_SERVICES = sig @@ -67,9 +66,3 @@ (** 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 diff -Nru belenios-1.4+dfsg/src/web/web_site.ml belenios-1.6+dfsg/src/web/web_site.ml --- belenios-1.4+dfsg/src/web/web_site.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_site.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,6 +21,7 @@ open Lwt open Platform +open Serializable_builtin_t open Serializable_j open Signatures open Common @@ -31,6 +32,8 @@ let source_file = ref "belenios.tar.gz" let maxmailsatonce = ref 1000 +let uuid_length = ref None +let default_group = ref "" let ( / ) = Filename.concat @@ -39,14 +42,18 @@ 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 trustees (in threshold mode). *) +let election_tpktokens = Ocsipersist.open_table "site_tpktokens" + +(* Table with tokens given to trustees (in threshold mode) to decrypt *) +let election_tokens_decrypt = Ocsipersist.open_table "site_tokens_decrypt" + (* Table with tokens given to credential authorities. *) let election_credtokens = Ocsipersist.open_table "site_credtokens" @@ -56,12 +63,12 @@ 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) + return (Election.of_string raw_election) | _ -> Lwt.fail Not_found module WCacheTypes = struct - type key = string - type value = (module ELECTION_DATA) + type key = uuid + type value = Yojson.Safe.json election end module WCache = Ocsigen_cache.Make (WCacheTypes) @@ -70,12 +77,12 @@ 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 +let get_setup_election uuid = + let%lwt se = Ocsipersist.find election_stable (raw_string_of_uuid uuid) 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 set_setup_election uuid se = + Ocsipersist.add election_stable (raw_string_of_uuid uuid) (string_of_setup_election se) let dump_passwords dir table = Lwt_io.(with_file Output (dir / "passwords.csv") (fun oc -> @@ -85,7 +92,7 @@ )) let finalize_election uuid se = - let uuid_s = Uuidm.to_string uuid in + let uuid_s = raw_string_of_uuid uuid in (* voters *) let () = if se.se_voters = [] then failwith "no voters" @@ -106,25 +113,71 @@ (* 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) + let%lwt y, trustees, pk_or_tp, private_keys = + match se.se_threshold_trustees with + | None -> + let module KG = Trustees.MakeSimple (G) (LwtRandom) in + let%lwt trustees, public_keys, private_key = + match se.se_public_keys with + | [] -> + let%lwt private_key = KG.generate () in + let%lwt public_key = KG.prove private_key in + return (None, [public_key], `KEY private_key) + | _ :: _ -> + let private_key = + List.fold_left (fun accu {st_private_key; _} -> + match st_private_key with + | Some x -> x :: accu + | None -> accu + ) [] se.se_public_keys + in + let private_key = match private_key with + | [] -> `None + | [x] -> `KEY x + | _ -> failwith "multiple private keys" + in + 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), + private_key) + in + let y = KG.combine (Array.of_list public_keys) in + return (y, trustees, `PK public_keys, private_key) + | Some ts -> + match se.se_threshold_parameters with + | None -> failwith "key establishment not finished" + | Some tp -> + let tp = threshold_parameters_of_string G.read tp in + let module P = Trustees.MakePKI (G) (LwtRandom) in + let module C = Trustees.MakeChannels (G) (LwtRandom) (P) in + let module K = Trustees.MakePedersen (G) (LwtRandom) (P) (C) in + let trustees = List.map (fun {stt_id; _} -> stt_id) ts in + let private_keys = + List.map (fun {stt_voutput; _} -> + match stt_voutput with + | Some v -> + let voutput = voutput_of_string G.read v in + voutput.vo_private_key + | None -> failwith "inconsistent state" + ) ts + in + let y = K.combine tp in + return (y, Some trustees, `TP tp, `KEYS private_keys) in - let y = KG.combine (Array.of_list public_keys) in (* election parameters *) - let metadata = { se.se_metadata with e_trustees = trustees } in + let e_server_is_trustee = match private_keys with + | `KEY _ -> Some true + | `None | `KEYS _ -> None + in + let metadata = { + se.se_metadata with + e_trustees = trustees; + e_server_is_trustee; + } in let template = se.se_questions in let params = { e_description = template.t_description; @@ -147,13 +200,18 @@ 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 >> + (match pk_or_tp with + | `PK pk -> create_file "public_keys.jsons" (string_of_trustee_public_key G.write) pk + | `TP tp -> create_file "threshold.json" (string_of_threshold_parameters G.write) [tp] + ) >> 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 + let election = Election.of_string raw_election in + let module W = (val Election.get_group election) in + let module E = Election.Make (W) (LwtRandom) in + let module B = Web_election.Make (E) in (* set up authentication *) let%lwt () = match metadata.e_auth_config with @@ -164,33 +222,46 @@ auth_instance, (auth_system, List.map snd auth_config) ) xs in - Web_persist.set_auth_config uuid_s auth_config + Web_persist.set_auth_config (Some uuid) 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 + match%lwt read_file fname with + | Some xs -> + Lwt_list.iter_s B.inject_cred xs + >> B.update_files () + >> Lwt_unix.unlink fname + | None -> return_unit in - (* create file with private key, if any *) + (* create file with private keys, if any *) let%lwt () = - match private_key with - | None -> return_unit - | Some x -> create_file "private_key.json" string_of_number [x] + match private_keys with + | `None -> return_unit + | `KEY x -> create_file "private_key.json" string_of_number [x] + | `KEYS x -> create_file "private_keys.jsons" (fun x -> x) 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) + if st_token <> "" then ( + Ocsipersist.remove election_pktokens st_token + ) else return_unit + ) se.se_public_keys >> + (match se.se_threshold_trustees with + | None -> return_unit + | Some ts -> + Lwt_list.iter_s + (fun x -> Ocsipersist.remove election_tpktokens x.stt_token) + ts + ) >> 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 = "password_" ^ underscorize uuid in let table = Ocsipersist.open_table table in Lwt_list.iter_s (fun v -> @@ -202,8 +273,8 @@ 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 ()) + Web_persist.set_election_state uuid `Open >> + Web_persist.set_election_date uuid (now ()) let cleanup_table ?uuid_s table = let table = Ocsipersist.open_table table in @@ -219,9 +290,11 @@ try%lwt Lwt_unix.unlink f with _ -> return_unit -let archive_election uuid_s = - let uuid_u = underscorize uuid_s in +let archive_election uuid = + let uuid_s = raw_string_of_uuid uuid in + let uuid_u = underscorize uuid in let%lwt () = cleanup_table ~uuid_s "election_states" in + let%lwt () = cleanup_table ~uuid_s "site_tokens_decrypt" 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 @@ -229,6 +302,7 @@ 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 + let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_keys.jsons") in return_unit let () = Any.register ~service:home @@ -240,10 +314,10 @@ 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 + Lwt_list.fold_left_s (fun accu uuid -> + let%lwt w = find_election uuid in + let%lwt state = Web_persist.get_election_state uuid in + let%lwt date = Web_persist.get_election_date uuid in let elections, tallied, archived = accu in match state with | `Tallied _ -> return (elections, (date, w) :: tallied, archived) @@ -257,8 +331,22 @@ in return (sort elections, sort tallied, sort archived) +let with_site_user f = + match%lwt Web_state.get_site_user () with + | Some u -> f u + | None -> forbidden () + +let () = + Redirection.register ~service:admin_gdpr_accept + (fun () () -> + Eliom_reference.set Web_state.show_cookie_disclaimer false >> + return admin + ) + let () = Html5.register ~service:admin (fun () () -> + let%lwt gdpr = Eliom_reference.get Web_state.show_cookie_disclaimer in + if gdpr then T.admin_gdpr () else let cont () = Redirection.send admin in Eliom_reference.set Web_state.cont [cont] >> let%lwt site_user = Web_state.get_site_user () in @@ -270,8 +358,8 @@ 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) + if v.se_owner = u then + return ((uuid_of_raw_string k, v.se_questions.t_name) :: accu) else return accu ) election_stable [] in @@ -280,35 +368,20 @@ T.admin ~elections () ) -let () = File.register - ~service:source_code +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 +let generate_uuid = + let gen = Uuidm.v4_gen (Random.State.make_self_init ()) 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) + match !uuid_length with + | Some length -> + let%lwt token = generate_token ~length () in + return @@ uuid_of_raw_string token + | None -> return @@ uuid_of_raw_string @@ Uuidm.to_string @@ gen () -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 redir_preapply s u () = Redirection.send (preapply s u) let create_new_election owner cred auth = let e_cred_authority = match cred with @@ -320,8 +393,8 @@ | `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 uuid = generate_uuid () in + let uuid_s = raw_string_of_uuid uuid in let%lwt token = generate_token () in let se_metadata = { e_owner = Some owner; @@ -329,12 +402,14 @@ e_cred_authority; e_trustees = None; e_languages = Some ["en"; "fr"]; + e_contact = None; + e_server_is_trustee = None; } in let question = { - q_answers = [| "Answer 1"; "Answer 2"; "Blank" |]; + q_answers = [| "Answer 1"; "Answer 2"; "Answer 3" |]; q_blank = None; q_min = 1; - q_max = 1; + q_max = 2; q_question = "Question 1?"; } in let se_questions = { @@ -344,134 +419,171 @@ } in let se = { se_owner = owner; - se_group = "{\"g\":\"2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627\",\"p\":\"20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719\",\"q\":\"78571733251071885079927659812671450121821421258408794611510081919805623223441\"}"; (* generated by fips.sage *) + se_group = !default_group; se_voters = []; se_questions; se_public_keys = []; se_metadata; se_public_creds = token; se_public_creds_received = false; + se_threshold = None; + se_threshold_trustees = None; + se_threshold_parameters = None; + se_threshold_error = None; } in - let%lwt () = set_setup_election uuid_s se in + let%lwt () = set_setup_election uuid se in let%lwt () = Ocsipersist.add election_credtokens token uuid_s in - return (preapply election_setup uuid) + redir_preapply election_setup uuid () let () = Html5.register ~service:election_setup_pre (fun () () -> T.election_setup_pre ()) -let () = Redirection.register ~service:election_setup_new +let () = Any.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 ()) + with_site_user (fun 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 + ) + ) -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 with_setup_election_ro uuid f = + with_site_user (fun u -> + let%lwt se = get_setup_election uuid in + if se.se_owner = u then + f se + else forbidden () + ) + +let () = + Html5.register ~service:election_setup + (fun uuid () -> + with_setup_election_ro uuid (fun se -> + T.election_setup uuid se () + ) + ) -let () = Html5.register ~service:election_setup - (generic_setup_page T.election_setup) +let () = + Any.register ~service:election_setup_trustees + (fun uuid () -> + with_setup_election_ro uuid (fun se -> + match se.se_threshold_trustees with + | None -> T.election_setup_trustees uuid se () >>= Html5.send + | Some _ -> redir_preapply election_setup_threshold_trustees uuid () + ) + ) -let () = Html5.register ~service:election_setup_trustees - (generic_setup_page T.election_setup_trustees) +let () = + Html5.register ~service:election_setup_threshold_trustees + (fun uuid () -> + with_setup_election_ro uuid (fun se -> + T.election_setup_threshold_trustees uuid se () + ) + ) -let () = Html5.register ~service:election_setup_credential_authority - (generic_setup_page T.election_setup_credential_authority) +let () = + Html5.register ~service:election_setup_credential_authority + (fun uuid () -> + with_setup_election_ro uuid (fun se -> + T.election_setup_credential_authority uuid se () + ) + ) 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 with_setup_election ?(save = true) uuid f = + with_site_user (fun u -> + Lwt_mutex.with_lock election_setup_mutex (fun () -> + let%lwt se = get_setup_election uuid in + if se.se_owner = u then ( + try%lwt + let%lwt r = f se in + let%lwt () = if save then set_setup_election uuid se else return_unit in + return r + with e -> + let service = preapply election_setup uuid in + T.generic_page ~title:"Error" ~service (Printexc.to_string e) () >>= Html5.send + ) else forbidden () + ) + ) 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 () -> + Any.register ~service:election_setup_languages + (fun uuid languages -> + with_setup_election uuid (fun se -> + let langs = languages_of_string languages in + match langs with + | [] -> + let service = preapply election_setup uuid in + T.generic_page ~title:"Error" ~service + "You must select at least one language!" () >>= Html5.send + | _ :: _ -> + let unavailable = + List.filter (fun x -> + not (List.mem x available_languages) + ) langs + in + match unavailable with + | [] -> + se.se_metadata <- { + se.se_metadata with + e_languages = Some langs + }; + redir_preapply election_setup uuid () + | l :: _ -> 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))) + ("No such language: " ^ l) () >>= Html5.send + ) + ) + +let () = + Any.register ~service:election_setup_contact + (fun uuid contact -> + with_setup_election uuid (fun se -> + let contact = + if contact = "" || contact = default_contact then + None + else Some contact + in + se.se_metadata <- { + se.se_metadata with + e_contact = contact + }; + redir_preapply election_setup uuid () + ) + ) -let generate_password langs title url id = +let () = + Any.register ~service:election_setup_description + (fun uuid (name, description) -> + with_setup_election uuid (fun se -> + se.se_questions <- {se.se_questions with + t_name = name; + t_description = description; + }; + redir_preapply election_setup uuid () + ) + ) + +let generate_password metadata 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 + let contact = T.contact_footer metadata L.please_contact in + Printf.sprintf L.mail_password title login password url contact ) langs in let body = PString.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \nBelenios" in @@ -492,101 +604,99 @@ (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%lwt () = + Lwt_list.iter_s (fun id -> + match id.sv_password with + | Some _ when not force -> return_unit + | None | Some _ -> + let%lwt x = generate_password se.se_metadata langs title url id.sv_id in + return (id.sv_password <- Some x) + ) voters + in + 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_regenpwd + Any.register ~service:election_setup_auth_genpwd + (fun uuid () -> + with_setup_election uuid (fun se -> + handle_password se uuid ~force:false se.se_voters + ) + ) + +let () = + Any.register ~service:election_regenpwd (fun (uuid, ()) () -> T.regenpwd uuid () >>= Html5.send) +let find_user_id uuid user = + let uuid_s = raw_string_of_uuid uuid in + let db = Lwt_io.lines_of_file (!spool_dir / uuid_s / "voters.txt") in + let%lwt db = Lwt_stream.to_list db in + let rec loop = function + | [] -> Lwt.fail Not_found + | id :: xs -> + let _, login = split_identity id in + if login = user then return id else loop xs + in loop db + let () = - Any.register - ~service:election_regenpwd_post + 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 () + with_site_user (fun u -> + let%lwt election = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + if metadata.e_owner = Some u then ( + let table = "password_" ^ underscorize uuid in + let table = Ocsipersist.open_table table in + let title = 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 + (try%lwt + let%lwt id = find_user_id uuid user in + let langs = get_languages metadata.e_languages in + let%lwt x = generate_password metadata langs title url id in + Ocsipersist.add table user x >> + dump_passwords (!spool_dir / raw_string_of_uuid uuid) table >> + T.generic_page ~title:"Success" ~service + ("A new password has been mailed to " ^ id ^ ".") () + >>= Html5.send + with Not_found -> + T.generic_page ~title:"Error" ~service + (user ^ " is not a registered user for this election.") () + >>= Html5.send + ) + ) else forbidden () + ) ) let () = - Html5.register - ~service:election_setup_questions + 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 () + with_setup_election_ro uuid (fun se -> + T.election_setup_questions uuid se () + ) ) 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))) + Any.register ~service:election_setup_questions_post + (fun uuid template -> + with_setup_election uuid (fun se -> + se.se_questions <- template_of_string template; + redir_preapply election_setup uuid () + ) + ) let () = - Html5.register - ~service:election_setup_voters + 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 () + with_setup_election_ro uuid (fun se -> + T.election_setup_voters uuid se !maxmailsatonce () + ) ) (* see http://www.regular-expressions.info/email.html *) @@ -598,16 +708,6 @@ 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 @@ -621,116 +721,113 @@ 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)))) + Any.register ~service:election_setup_voters_add + (fun uuid voters -> + with_setup_election uuid (fun se -> + if se.se_public_creds_received then + forbidden () + else ( + let voters = Pcre.split voters in + let () = + try + let bad = List.find (fun x -> not (is_identity x)) voters in + Printf.ksprintf failwith "%S is not a valid identity" bad + with Not_found -> () + in + se.se_voters <- merge_voters se.se_voters voters (fun _ -> None); + 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)))) + Any.register ~service:election_setup_voters_remove + (fun uuid voter -> + with_setup_election uuid (fun se -> + if se.se_public_creds_received then + forbidden () + else ( + se.se_voters <- List.filter (fun v -> v.sv_id <> voter) se.se_voters; + 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)) + (fun uuid voter -> + with_setup_election uuid (fun se -> + 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 + 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 ( + with_setup_election uuid (fun se -> + if is_email st_id then ( let%lwt st_token = generate_token () in - let trustee = {st_id; st_token; st_public_key = ""} in + let trustee = {st_id; st_token; st_public_key = ""; st_private_key = None} 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%lwt () = Ocsipersist.add election_pktokens st_token (raw_string_of_uuid uuid) in + redir_preapply election_setup_trustees uuid () + ) 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 + Any.register ~service:election_setup_trustee_add_server + (fun uuid () -> + with_setup_election uuid (fun se -> + let st_id = "server" and st_token = "" in + let module G = (val Group.of_string se.se_group) in + let module K = Trustees.MakeSimple (G) (LwtRandom) in + let%lwt private_key = K.generate () in + let%lwt public_key = K.prove private_key in + let st_public_key = string_of_trustee_public_key G.write public_key in + let st_private_key = Some private_key in + let trustee = {st_id; st_token; st_public_key; st_private_key} in + se.se_public_keys <- se.se_public_keys @ [trustee]; + redir_preapply election_setup_trustees uuid () + ) + ) + +let () = + Any.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 |> + with_setup_election uuid (fun se -> + 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 >> + in + se.se_public_keys <- trustees; + let%lwt () = Lwt_list.iter_s (fun {st_token; _} -> - Ocsipersist.remove election_pktokens st_token - ) old - ) else forbidden () - ) >> - return (preapply election_setup_trustees uuid) - | None -> forbidden () + if st_token <> "" then ( + Ocsipersist.remove election_pktokens st_token + ) else return_unit + ) old + in + redir_preapply election_setup_trustees uuid () + ) ) let () = - Html5.register - ~service:election_setup_credentials + Html5.register ~service:election_setup_credentials (fun token () -> let%lwt uuid = Ocsipersist.find election_credtokens token in + let uuid = uuid_of_raw_string uuid 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 @@ -738,10 +835,11 @@ let handle_credentials_post token creds = let%lwt uuid = Ocsipersist.find election_credtokens token in + let uuid = uuid_of_raw_string uuid 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 + let fname = !spool_dir / raw_string_of_uuid uuid ^ ".public_creds.txt" in Lwt_mutex.with_lock election_setup_mutex (fun () -> @@ -752,32 +850,34 @@ ) >> 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) + match%lwt read_file fname with + | Some xs -> + return ( + List.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 + ) xs + ) + | None -> return_unit 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 + T.generic_page ~title:"Success" "Credentials have been received and checked!" () >>= Html5.send let () = - Any.register - ~service:election_setup_credentials_post + 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 + 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)) @@ -785,88 +885,92 @@ 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))) + Any.register ~service:election_setup_credentials_server + (fun uuid () -> + with_setup_election uuid (fun se -> + 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 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 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, _ = split_identity v.sv_id in + let cas = + match se.se_metadata.e_auth_config with + | Some [{auth_system = "cas"; _}] -> true + | _ -> false + 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 + let intro = if cas then L.mail_credential_cas else L.mail_credential_password in + let contact = T.contact_footer se.se_metadata L.please_contact in + Printf.sprintf L.mail_credential title intro cred url contact + ) 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 @@ SSet.add pub_cred accu + ) SSet.empty se.se_voters + in + let creds = SSet.elements creds in + let fname = !spool_dir / raw_string_of_uuid uuid ^ ".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; + 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 + Html5.register ~service:election_setup_trustee (fun token () -> let%lwt uuid = Ocsipersist.find election_pktokens token in + let uuid = uuid_of_raw_string uuid 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 + Any.register ~service:election_setup_trustee_post (fun token public_key -> wrap_handler (fun () -> let%lwt uuid = Ocsipersist.find election_pktokens token in + let uuid = uuid_of_raw_string uuid in Lwt_mutex.with_lock election_setup_mutex (fun () -> @@ -874,7 +978,7 @@ 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 + let module KG = Trustees.MakeSimple (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; @@ -886,113 +990,180 @@ ) let () = - Any.register - ~service:election_setup_confirm + 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) + with_setup_election_ro uuid (fun se -> + T.election_setup_confirm uuid se () >>= Html5.send + ) + ) let () = - Any.register - ~service:election_setup_create + 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 + with_setup_election ~save:false uuid (fun se -> + try%lwt + let%lwt () = finalize_election uuid se in + redir_preapply election_admin (uuid, ()) () + with e -> + T.new_election_failure (`Exception e) () >>= Html5.send + ) ) let () = - Html5.register - ~service:election_setup_import + Any.register ~service:election_setup_destroy (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))) + with_setup_election ~save:false uuid (fun se -> + let uuid_s = raw_string_of_uuid uuid in + (* clean up credentials *) + let%lwt () = + let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in + try%lwt Lwt_unix.unlink fname + with _ -> return_unit + in + (* clean up setup database *) + let%lwt () = Ocsipersist.remove election_credtokens se.se_public_creds in + let%lwt () = + Lwt_list.iter_s (fun {st_token; _} -> + if st_token <> "" then + Ocsipersist.remove election_pktokens st_token + else return_unit + ) se.se_public_keys + in + let%lwt () = match se.se_threshold_trustees with + | None -> return_unit + | Some ts -> + Lwt_list.iter_s (fun {stt_token; _} -> + Ocsipersist.remove election_tpktokens stt_token + ) ts + in + let%lwt () = Ocsipersist.remove election_stable uuid_s in + Redirection.send admin + ) + ) + +let () = + Html5.register ~service:election_setup_import + (fun uuid () -> + with_setup_election_ro uuid (fun se -> + let%lwt elections = get_finalized_elections_by_owner se.se_owner in + T.election_setup_import uuid se elections () + ) + ) + +let () = + Any.register ~service:election_setup_import_post + (fun uuid from -> + with_setup_election uuid (fun se -> + let from_s = raw_string_of_uuid from in + let%lwt voters = Web_persist.get_voters from in + let%lwt passwords = Web_persist.get_passwords from 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; + redir_preapply election_setup_voters uuid () + ) + | None -> + 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 ()) + with_setup_election_ro uuid (fun se -> + let%lwt elections = get_finalized_elections_by_owner se.se_owner 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 -> + (fun uuid from -> + with_setup_election uuid (fun se -> + let uuid_s = raw_string_of_uuid uuid in + let%lwt metadata = Web_persist.get_election_metadata from in + let%lwt threshold = Web_persist.get_threshold from in + let%lwt public_keys = Web_persist.get_public_keys from in + try%lwt + match metadata.e_trustees, threshold, public_keys with + | Some ts, Some raw_tp, None -> + if se.se_threshold_trustees <> None then + raise (TrusteeImportError "Importing threshold trustees after having already added ones is not supported"); + let module G = (val Group.of_string se.se_group : GROUP) in + let module P = Trustees.MakePKI (G) (LwtRandom) in + let module C = Trustees.MakeChannels (G) (LwtRandom) (P) in + let module K = Trustees.MakePedersen (G) (LwtRandom) (P) (C) in + let tp = threshold_parameters_of_string G.read raw_tp in + if not (K.check tp) then + raise (TrusteeImportError "Imported threshold trustees are invalid for this election!"); + let%lwt privs = Web_persist.get_private_keys from in + let%lwt se_threshold_trustees = + match privs with + | Some privs -> + let rec loop ts pubs privs accu = + match ts, pubs, privs with + | stt_id :: ts, vo_public_key :: pubs, vo_private_key :: privs -> + let%lwt stt_token = generate_token () in + let stt_voutput = {vo_public_key; vo_private_key} in + let stt_voutput = Some (string_of_voutput G.write stt_voutput) in + let stt = { + stt_id; stt_token; stt_voutput; + stt_step = Some 7; stt_cert = None; + stt_polynomial = None; stt_vinput = None; + } in + loop ts pubs privs (stt :: accu) + | [], [], [] -> return (List.rev accu) + | _, _, _ -> raise (TrusteeImportError "Inconsistency in imported election!") + in loop ts (Array.to_list tp.t_verification_keys) privs [] + | None -> raise (TrusteeImportError "Encrypted decryption keys are missing!") + in + se.se_threshold <- Some tp.t_threshold; + se.se_threshold_trustees <- Some se_threshold_trustees; + se.se_threshold_parameters <- Some raw_tp; + Lwt_list.iter_s (fun {stt_token; _} -> + Ocsipersist.add election_tpktokens stt_token uuid_s + ) se_threshold_trustees >> + redir_preapply election_setup_threshold_trustees uuid () + | Some ts, None, Some pks when List.length ts = List.length pks -> + let module G = (val Group.of_string se.se_group) in + let module KG = Trustees.MakeSimple (G) (LwtRandom) in 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}) + let%lwt st_token, st_private_key, st_public_key = + if st_id = "server" then ( + let%lwt private_key = KG.generate () in + let%lwt public_key = KG.prove private_key in + let public_key = string_of_trustee_public_key G.write public_key in + return ("", Some private_key, public_key) + ) else ( + let%lwt st_token = generate_token () in + return (st_token, None, st_public_key) + ) + in + return {st_id; st_token; st_public_key; st_private_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 @@ -1001,41 +1172,37 @@ 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 + if st_token <> "" then ( + Ocsipersist.add election_pktokens st_token uuid_s + ) else return_unit ) trustees >> - return (redir_preapply election_setup_trustees uuid) - | _, _ -> + 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))) + with + | TrusteeImportError msg -> + T.generic_page ~title:"Error" + ~service:(preapply election_setup_trustees uuid) + msg () >>= Html5.send + ) + ) let () = - Any.register - ~service:election_home + 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 + let%lwt w = find_election uuid in Eliom_reference.unset Web_state.ballot >> - let cont () = - Redirection.send - (Eliom_service.preapply - election_home (W.election.e_params.e_uuid, ())) - in + let cont = redir_preapply election_home (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 + T.cast_confirmed w ~result () >>= Html5.send | None -> - let%lwt state = Web_persist.get_election_state uuid_s in - T.election_home (module W) state () >>= Html5.send + let%lwt state = Web_persist.get_election_state uuid in + T.election_home 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 @@ -1059,134 +1226,115 @@ >>= Html5.send) let () = - Any.register - ~service:election_admin + 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 uuid_s = raw_string_of_uuid uuid in + let%lwt w = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid 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, ())) + let%lwt state = Web_persist.get_election_state uuid in + let get_tokens_decrypt () = + try%lwt + Ocsipersist.find election_tokens_decrypt uuid_s + with Not_found -> + match metadata.e_trustees with + | None -> failwith "missing trustees in get_tokens_decrypt" + | Some ts -> + let%lwt ts = Lwt_list.map_s (fun _ -> generate_token ()) ts in + Ocsipersist.add election_tokens_decrypt uuid_s ts >> + return ts in + T.election_admin w metadata state get_tokens_decrypt () >>= Html5.send + | _ -> + let cont = redir_preapply election_admin (uuid, ()) in Eliom_reference.set Web_state.cont [cont] >> - Redirection.send (Eliom_service.preapply site_login None) + redir_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, ())) + with_site_user (fun u -> + let%lwt metadata = Web_persist.get_election_metadata uuid in + if metadata.e_owner = Some u then ( + let%lwt () = + match%lwt Web_persist.get_election_state uuid with + | `Open | `Closed -> return () + | _ -> forbidden () + in + let state = if state then `Open else `Closed in + Web_persist.set_election_state uuid state >> + redir_preapply election_admin (uuid, ()) () + ) else forbidden () + ) 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_archive + (fun (uuid, ()) () -> + with_site_user (fun u -> + let%lwt metadata = Web_persist.get_election_metadata uuid in + if metadata.e_owner = Some u then ( + archive_election uuid >> + redir_preapply election_admin (uuid, ()) () + ) else forbidden () + ) + ) let () = - Any.register - ~service:election_update_credential + 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 () + with_site_user (fun u -> + let%lwt w = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + if metadata.e_owner = Some u then ( + T.update_credential w () >>= Html5.send + ) else forbidden () ) - | _ -> forbidden ()) + ) let () = - Any.register - ~service:election_update_credential_post + 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 ()) + with_site_user (fun u -> + let%lwt election = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + let module W = (val Election.get_group election) in + let module E = Election.Make (W) (LwtRandom) in + let module B = Web_election.Make (E) in + if metadata.e_owner = Some u then ( + try%lwt + B.update_cred ~old ~new_ >> + String.send ("OK", "text/plain") + with Error e -> + let%lwt lang = Eliom_reference.get Web_state.language in + let l = Web_i18n.get_lang lang in + String.send ("Error: " ^ explain_error l e, "text/plain") + ) else forbidden () + ) + ) let () = - Any.register - ~service:election_vote - (fun (_, ()) () -> + Any.register ~service:election_vote + (fun () () -> Eliom_reference.unset Web_state.ballot >> Web_templates.booth () >>= Html5.send) let () = - Any.register - ~service:election_cast + 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 + let%lwt w = find_election uuid in + let cont = redir_preapply election_cast (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) + | Some b -> T.cast_confirmation w (sha256_b64 b) () >>= Html5.send + | None -> T.cast_raw w () >>= Html5.send) let () = - Any.register - ~service:election_cast_post + 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 @@ -1196,29 +1344,20 @@ | _, _ -> 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 + let cont = redir_preapply election_cast (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)) + | None -> redir_preapply election_login ((uuid, ()), None) () | Some _ -> cont ()) let () = - Any.register - ~service:election_cast_confirm + 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 + let%lwt election = find_election uuid in + let module W = (val Election.get_group election) in + let module E = Election.Make (W) (LwtRandom) in + let module B = Web_election.Make (E) in match%lwt Eliom_reference.get Web_state.ballot with | Some the_ballot -> begin @@ -1228,34 +1367,28 @@ let record = u, now () in let%lwt result = try%lwt - let%lwt hash = WE.B.cast the_ballot record in + let%lwt hash = 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, ())) + redir_preapply election_home (uuid, ()) () | None -> forbidden () end | None -> fail_http 404) let () = - Any.register - ~service:election_pretty_ballots + 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 + let%lwt w = find_election uuid in + let%lwt ballots = Web_persist.get_ballot_hashes uuid in + let%lwt result = Web_persist.get_election_result uuid in T.pretty_ballots w ballots result () >>= Html5.send) let () = - Any.register - ~service:election_pretty_ballot + 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 + let%lwt ballot = Web_persist.get_ballot_by_hash uuid hash in match ballot with | None -> fail_http 404 | Some b -> @@ -1264,255 +1397,305 @@ let () = let rex = Pcre.regexp "\".*\" \".*:(.*)\"" in - Any.register - ~service:election_missing_voters + 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")) + with_site_user (fun u -> + let%lwt metadata = Web_persist.get_election_metadata uuid in + if metadata.e_owner = Some u then ( + let%lwt voters = + match%lwt read_file ~uuid (string_of_election_file ESVoters) with + | Some vs -> + return ( + List.fold_left (fun accu v -> + let _, login = split_identity v in + SSet.add login accu + ) SSet.empty vs + ) + | None -> return SSet.empty + in + let%lwt voters = + match%lwt read_file ~uuid (string_of_election_file ESRecords) with + | Some rs -> + return ( + List.fold_left (fun accu r -> + let s = Pcre.exec ~rex r in + let v = Pcre.get_substring s 1 in + SSet.remove v accu + ) voters rs + ) + | None -> return voters + in + let buf = Buffer.create 128 in + SSet.iter (fun v -> + Buffer.add_string buf v; + Buffer.add_char buf '\n' + ) voters; + String.send (Buffer.contents buf, "text/plain") + ) else forbidden () + ) + ) 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 + with_site_user (fun u -> + let%lwt w = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + if metadata.e_owner = Some u then ( + let%lwt records = + match%lwt read_file ~uuid (string_of_election_file ESRecords) with + | Some rs -> + return ( + List.rev_map (fun r -> + 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) + ) rs + ) + | None -> return [] + in + T.pretty_records w (List.rev records) () >>= Html5.send + ) else forbidden () + ) ) +let find_trustee_id uuid token = + try%lwt + let%lwt tokens = Ocsipersist.find election_tokens_decrypt (raw_string_of_uuid uuid) in + let rec find i = function + | [] -> raise Not_found + | t :: ts -> if t = token then i else find (i+1) ts + in + return (find 1 tokens) + with Not_found -> return (try int_of_string token with _ -> 0) + 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 + Any.register ~service:election_tally_trustees + (fun (uuid, ((), token)) () -> + let%lwt w = find_election uuid in let%lwt () = - match%lwt Web_persist.get_election_state uuid_s with + match%lwt Web_persist.get_election_state uuid with | `EncryptedTally _ -> return () | _ -> fail_http 404 in - let%lwt pds = Web_persist.get_partial_decryptions uuid_s in + let%lwt trustee_id = find_trustee_id uuid token in + let%lwt pds = Web_persist.get_partial_decryptions uuid 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 + T.tally_trustees w trustee_id token () >>= Html5.send )) let () = - Any.register - ~service:election_tally_trustees_post - (fun (uuid, ((), trustee_id)) partial_decryption -> - let uuid_s = Uuidm.to_string uuid in + Any.register ~service:election_tally_trustees_post + (fun (uuid, ((), token)) partial_decryption -> let%lwt () = - match%lwt Web_persist.get_election_state uuid_s with + match%lwt Web_persist.get_election_state uuid with | `EncryptedTally _ -> return () | _ -> forbidden () in - let%lwt pds = Web_persist.get_partial_decryptions uuid_s in + let%lwt trustee_id = find_trustee_id uuid token in + let%lwt pds = Web_persist.get_partial_decryptions uuid 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 + let%lwt election = find_election uuid in + let module W = (val Election.get_group election) in + let module E = Election.Make (W) (LwtRandom) in + let%lwt pks = + match%lwt Web_persist.get_threshold uuid with + | Some tp -> + let tp = threshold_parameters_of_string W.G.read tp in + return tp.t_verification_keys + | None -> + match%lwt Web_persist.get_public_keys uuid with + | None -> failwith "no public keys in election_tally_trustees_post" + | Some pks -> + let pks = Array.of_list pks in + let pks = Array.map (trustee_public_key_of_string W.G.read) pks in + return pks in - let pk = trustee_public_key_of_string W.G.read pk in - let pk = pk.trustee_public_key in + let pk = pks.(trustee_id-1).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 et = !spool_dir / raw_string_of_uuid uuid / 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 + let%lwt () = Web_persist.set_partial_decryptions uuid 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 + let service = preapply election_tally_trustees (uuid, ((), token)) 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 + with_site_user (fun u -> + let uuid_s = raw_string_of_uuid uuid in + let%lwt election = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + let module W = (val Election.get_group election) in + let module E = Election.Make (W) (LwtRandom) in + if metadata.e_owner = Some u then ( + let%lwt npks, ntallied = + match%lwt Web_persist.get_election_state uuid with + | `EncryptedTally (npks, ntallied, _) -> return (npks, ntallied) + | _ -> forbidden () + 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%lwt tp = Web_persist.get_threshold uuid in + let tp = + match tp with + | None -> None + | Some tp -> Some (threshold_parameters_of_string W.G.read tp) + in + let threshold = + match tp with + | None -> npks + | Some tp -> tp.t_threshold + in + let%lwt pds = Web_persist.get_partial_decryptions uuid in + let pds = List.map snd pds in + let pds = List.map (partial_decryption_of_string W.G.read) pds in + let%lwt () = + if List.length pds < threshold then fail_http 404 else return_unit + in + let checker = E.check_factor et in + let%lwt combinator = + match tp with + | None -> + let module K = Trustees.MakeSimple (W.G) (LwtRandom) in + let%lwt pks = + match%lwt Web_persist.get_public_keys uuid with + | Some l -> return (Array.of_list l) + | _ -> fail_http 404 + in + let pks = + Array.map (fun pk -> + (trustee_public_key_of_string W.G.read pk).trustee_public_key + ) pks + in + return (K.combine_factors checker pks) + | Some tp -> + let module P = Trustees.MakePKI (W.G) (LwtRandom) in + let module C = Trustees.MakeChannels (W.G) (LwtRandom) (P) in + let module K = Trustees.MakePedersen (W.G) (LwtRandom) (P) (C) in + return (K.combine_factors checker tp) + in + let result = E.compute_result ntallied et pds combinator in + let%lwt () = + let result = string_of_result W.G.write result in + write_file ~uuid (string_of_election_file ESResult) [result] + in + let%lwt () = Web_persist.set_election_state uuid (`Tallied result.result) in + let%lwt () = Ocsipersist.remove election_tokens_decrypt uuid_s in + redir_preapply election_home (uuid, ()) () + ) else forbidden () + ) let () = - Any.register - ~service:election_tally_release + 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" + | ESTParams | ESETally | ESResult -> "application/json" + | ESKeys | ESBallots -> "text/plain" (* should be "application/json-seq", but we don't use RS *) | ESCreds | ESRecords | ESVoters -> "text/plain" -let handle_pseudo_file uuid_s w f site_user = - let module W = (val w : ELECTION_DATA) in +let handle_pseudo_file uuid f site_user = let confidential = match f with - | ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false + | ESRaw | ESKeys | ESTParams | 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 + let%lwt metadata = Web_persist.get_election_metadata uuid 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) + File.send ~content_type (!spool_dir / raw_string_of_uuid uuid / string_of_election_file f) let () = - Any.register - ~service:election_dir + 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) + handle_pseudo_file uuid f site_user) let () = - Any.register - ~service:election_compute_encrypted_tally + 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, ()))) + with_site_user (fun u -> + let%lwt election = find_election uuid in + let%lwt metadata = Web_persist.get_election_metadata uuid in + let module W = (val Election.get_group election) in + let module E = Election.Make (W) (LwtRandom) in + let module B = Web_election.Make (E) in + if metadata.e_owner = Some u then ( + let%lwt () = + match%lwt Web_persist.get_election_state uuid with + | `Closed -> return () + | _ -> forbidden () + in + let%lwt nb, hash, tally = B.compute_encrypted_tally () in + let%lwt npks = + match%lwt Web_persist.get_threshold uuid with + | Some tp -> + let tp = threshold_parameters_of_string W.G.read tp in + return (Array.length tp.t_verification_keys) + | None -> + match%lwt Web_persist.get_public_keys uuid with + | Some pks -> return (List.length pks) + | None -> failwith "missing public keys and threshold parameters" + in + Web_persist.set_election_state uuid (`EncryptedTally (npks, nb, hash)) >> + let tally = encrypted_tally_of_string W.G.read tally in + let%lwt sk = Web_persist.get_private_key uuid in + match metadata.e_trustees with + | None -> + (* no trustees: compute decryption and release tally *) + let sk = match sk with + | Some x -> x + | None -> failwith "missing private key" + in + let%lwt pd = E.compute_factor tally sk in + let pd = string_of_partial_decryption W.G.write pd in + Web_persist.set_partial_decryptions uuid [1, pd] + >> handle_election_tally_release (uuid, ()) () + | Some ts -> + Lwt_list.iteri_s (fun i t -> + if t = "server" then ( + match%lwt Web_persist.get_private_key uuid with + | Some k -> + let%lwt pd = E.compute_factor tally k in + let pd = string_of_partial_decryption W.G.write pd in + Web_persist.set_partial_decryptions uuid [i+1, pd] + | None -> return_unit (* dead end *) + ) else return_unit + ) ts + >> redir_preapply election_admin (uuid, ()) () + ) else forbidden () + ) + ) let () = Any.register ~service:set_language @@ -1522,3 +1705,210 @@ match cont with | Some f -> f () | None -> Redirection.send home) + +let () = + Any.register ~service:election_setup_threshold_set + (fun uuid threshold -> + with_setup_election uuid (fun se -> + match se.se_threshold_trustees with + | None -> + let msg = "Please add some trustees first!" in + let service = preapply election_setup_threshold_trustees uuid in + T.generic_page ~title:"Error" ~service msg () >>= Html5.send + | Some xs -> + let maybe_threshold, step = + if threshold = 0 then None, None + else Some threshold, Some 1 + in + if threshold >= 0 && threshold < List.length xs then ( + List.iter (fun x -> x.stt_step <- step) xs; + se.se_threshold <- maybe_threshold; + redir_preapply election_setup_threshold_trustees uuid () + ) else ( + let msg = "The threshold must be positive and lesser than the number of trustees!" in + let service = preapply election_setup_threshold_trustees uuid in + T.generic_page ~title:"Error" ~service msg () >>= Html5.send + ) + ) + ) + +let () = + Any.register ~service:election_setup_threshold_trustee_add + (fun uuid stt_id -> + with_setup_election uuid (fun se -> + if is_email stt_id then ( + let%lwt stt_token = generate_token () in + let trustee = { + stt_id; stt_token; stt_step = None; + stt_cert = None; stt_polynomial = None; + stt_vinput = None; stt_voutput = None; + } in + let trustees = + match se.se_threshold_trustees with + | None -> Some [trustee] + | Some t -> Some (t @ [trustee]) + in + se.se_threshold_trustees <- trustees; + let%lwt () = Ocsipersist.add election_tpktokens stt_token (raw_string_of_uuid uuid) in + redir_preapply election_setup_threshold_trustees uuid () + ) else ( + let msg = stt_id ^ " is not a valid e-mail address!" in + let service = preapply election_setup_threshold_trustees uuid in + T.generic_page ~title:"Error" ~service msg () >>= Html5.send + ) + ) + ) + +let () = + Any.register ~service:election_setup_threshold_trustee_del + (fun uuid index -> + with_setup_election uuid (fun se -> + let trustees, old = + let trustees = + match se.se_threshold_trustees with + | None -> [] + | Some x -> x + in + trustees |> + 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 + let trustees = match trustees with [] -> None | x -> Some x in + se.se_threshold_trustees <- trustees; + let%lwt () = + Lwt_list.iter_s (fun {stt_token; _} -> + Ocsipersist.remove election_tpktokens stt_token + ) old + in + redir_preapply election_setup_threshold_trustees uuid () + ) + ) + +let () = + Html5.register ~service:election_setup_threshold_trustee + (fun token () -> + let%lwt uuid = Ocsipersist.find election_tpktokens token in + let uuid = uuid_of_raw_string uuid in + let%lwt se = get_setup_election uuid in + T.election_setup_threshold_trustee token uuid se () + ) + +let () = + Any.register ~service:election_setup_threshold_trustee_post + (fun token data -> + wrap_handler + (fun () -> + let%lwt uuid = Ocsipersist.find election_tpktokens token in + let uuid = uuid_of_raw_string uuid in + Lwt_mutex.with_lock election_setup_mutex + (fun () -> + let%lwt se = get_setup_election uuid in + let ts = + match se.se_threshold_trustees with + | None -> failwith "No threshold trustees" + | Some xs -> Array.of_list xs + in + let i, t = + match Array.findi (fun i x -> + if token = x.stt_token then Some (i, x) else None + ) ts with + | Some (i, t) -> i, t + | None -> failwith "Trustee not found" + in + let get_certs () = + let certs = Array.map (fun x -> + match x.stt_cert with + | None -> failwith "Missing certificate" + | Some y -> y + ) ts in + {certs} + in + let get_polynomials () = + Array.map (fun x -> + match x.stt_polynomial with + | None -> failwith "Missing polynomial" + | Some y -> y + ) ts + in + let module G = (val Group.of_string se.se_group : GROUP) in + let module P = Trustees.MakePKI (G) (LwtRandom) in + let module C = Trustees.MakeChannels (G) (LwtRandom) (P) in + let module K = Trustees.MakePedersen (G) (LwtRandom) (P) (C) in + (match t.stt_step with + | Some 1 -> + let cert = cert_of_string data in + if K.step1_check cert then ( + t.stt_cert <- Some cert; + t.stt_step <- Some 2; + return_unit + ) else ( + failwith "Invalid certificate" + ) + | Some 3 -> + let certs = get_certs () in + let polynomial = polynomial_of_string data in + if K.step3_check certs i polynomial then ( + t.stt_polynomial <- Some polynomial; + t.stt_step <- Some 4; + return_unit + ) else ( + failwith "Invalid polynomial" + ) + | Some 5 -> + let certs = get_certs () in + let polynomials = get_polynomials () in + let voutput = voutput_of_string G.read data in + if K.step5_check certs i polynomials voutput then ( + t.stt_voutput <- Some data; + t.stt_step <- Some 6; + return_unit + ) else ( + failwith "Invalid voutput" + ) + | _ -> failwith "Unknown step" + ) >> ( + if Array.forall (fun x -> x.stt_step = Some 2) ts then ( + (try + K.step2 (get_certs ()); + Array.iter (fun x -> x.stt_step <- Some 3) ts; + with e -> + se.se_threshold_error <- Some (Printexc.to_string e) + ); return_unit + ) else return_unit + ) >> ( + if Array.forall (fun x -> x.stt_step = Some 4) ts then ( + (try + let certs = get_certs () in + let polynomials = get_polynomials () in + let vinputs = K.step4 certs polynomials in + for j = 0 to Array.length ts - 1 do + ts.(j).stt_vinput <- Some vinputs.(j) + done; + Array.iter (fun x -> x.stt_step <- Some 5) ts + with e -> + se.se_threshold_error <- Some (Printexc.to_string e) + ); return_unit + ) else return_unit + ) >> ( + if Array.forall (fun x -> x.stt_step = Some 6) ts then ( + (try + let certs = get_certs () in + let polynomials = get_polynomials () in + let voutputs = Array.map (fun x -> + match x.stt_voutput with + | None -> failwith "Missing voutput" + | Some y -> voutput_of_string G.read y + ) ts in + let p = K.step6 certs polynomials voutputs in + se.se_threshold_parameters <- Some (string_of_threshold_parameters G.write p); + Array.iter (fun x -> x.stt_step <- Some 7) ts + with e -> + se.se_threshold_error <- Some (Printexc.to_string e) + ); return_unit + ) else return_unit + ) >> set_setup_election uuid se + ) >> + redir_preapply election_setup_threshold_trustee token () + ) + ) diff -Nru belenios-1.4+dfsg/src/web/web_site.mli belenios-1.6+dfsg/src/web/web_site.mli --- belenios-1.4+dfsg/src/web/web_site.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_site.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -21,3 +21,5 @@ val source_file : string ref val maxmailsatonce : int ref +val uuid_length : int option ref +val default_group : string ref diff -Nru belenios-1.4+dfsg/src/web/web_state.ml belenios-1.6+dfsg/src/web/web_state.ml --- belenios-1.4+dfsg/src/web/web_state.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_state.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -23,7 +23,7 @@ open Web_serializable_t type user = { - uuid: Uuidm.t option; + uuid: uuid option; service : string; name : string; } @@ -53,7 +53,7 @@ match u.uuid with | None -> return None | Some uuid' -> - if Uuidm.equal uuid uuid' then + if uuid = uuid' then return @@ Some { user_domain = u.service; user_name = u.name diff -Nru belenios-1.4+dfsg/src/web/web_state.mli belenios-1.6+dfsg/src/web/web_state.mli --- belenios-1.4+dfsg/src/web/web_state.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_state.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -19,10 +19,11 @@ (* . *) (**************************************************************************) +open Serializable_builtin_t open Web_signatures type user = { - uuid: Uuidm.t option; + uuid: uuid option; service : string; name : string; } @@ -31,7 +32,7 @@ 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 get_election_user : uuid -> Web_serializable_t.user option Lwt.t val cont : (unit -> content) list Eliom_reference.eref val cont_push : (unit -> content) -> unit Lwt.t diff -Nru belenios-1.4+dfsg/src/web/web_templates.ml belenios-1.6+dfsg/src/web/web_templates.ml --- belenios-1.4+dfsg/src/web/web_templates.ml 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_templates.ml 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -20,6 +20,7 @@ (**************************************************************************) open Lwt +open Serializable_builtin_t open Serializable_j open Signatures open Common @@ -34,6 +35,13 @@ let site_title = "Election Server" let admin_background = " background: #FF9999;" +let unsafe_a uri text = + Printf.ksprintf Unsafe.data "%s" uri text + +let static x = + let service = Eliom_service.static_dir () in + make_uri ~service ["static"; x] + let format_user ~site u = em [pcdata (if site then string_of_user u else u.user_name)] @@ -89,7 +97,7 @@ 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 + let%lwt l = Web_persist.get_auth_config None in return (List.map fst l) end @@ -119,14 +127,14 @@ | None -> div ~a:[a_style "float: right; padding: 10px;"] [ img ~a:[a_height 70] ~alt:"" - ~src:(uri_of_string (fun () -> "/static/placeholder.png")) (); + ~src:(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")) (); + link ~rel:[`Stylesheet] ~href:(static "site.css") (); ]) (body [ div ~a:[a_id "wrapper"] [ @@ -135,7 +143,7 @@ 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")) (); + ~src:(static "logo.png") (); ] (); ]; login_box; @@ -149,9 +157,13 @@ footer; pcdata L.powered_by; a ~service:belenios_url [pcdata "Belenios"] (); - pcdata ". "; + Belenios_version.( + Printf.ksprintf pcdata " %s (%s)." version build + ); a ~service:source_code [pcdata L.get_the_source_code] (); pcdata ". "; + unsafe_a !gdpr_uri "Privacy policy"; + pcdata ". "; administer; pcdata "."; ] @@ -159,23 +171,52 @@ ])) let format_election election = - let module W = (val election : ELECTION_DATA) in - let e = W.election.e_params in + let e = election.e_params in let service = election_admin in li [ a ~service [pcdata e.e_name] (e.e_uuid, ()); ] +let admin_gdpr () = + let title = site_title ^ " — Personal data processing notice" in + let content = + [ + div [ + pcdata "To use this site, you must accept our "; + unsafe_a !gdpr_uri "personal data policy"; + pcdata "."; + ]; + post_form ~service:admin_gdpr_accept + (fun () -> + [ + div [ + string_input ~input_type:`Submit ~value:"Accept" (); + ]; + ] + ) (); + ] + in + base ~title ~content () + let admin ~elections () = let title = site_title ^ " — Administration" in match elections with | None -> + let contact = match !contact_uri with + | None -> pcdata "" + | Some uri -> + div [ + pcdata "If you do not have any account, you may "; + unsafe_a uri "contact us"; + pcdata "."; + ] + in 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."; + pcdata "To administer an election, you need to log in using one"; + pcdata " of the authentication methods available in the upper"; + pcdata " right corner of this page."; + contact; ] ] in let%lwt login_box = site_login_box () in @@ -228,8 +269,12 @@ let%lwt login_box = site_login_box () in base ~title ?login_box ~content () -let make_button ~service ~disabled contents = +let make_button ~service ?hash ~disabled contents = let uri = Eliom_uri.make_string_uri ~service () in + let uri = match hash with + | None -> uri + | Some x -> uri ^ "#" ^ x + in Printf.ksprintf Unsafe.data (* FIXME: unsafe *) "" uri (if disabled then " disabled" else "") @@ -342,7 +387,7 @@ pcdata ")"; ]; div [ - pcdata "(This is a space-separated list of languages that will be used in emails sent by the server.)"; + 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" (); @@ -383,6 +428,33 @@ form_description; ] in + let form_contact = + post_form ~service:election_setup_contact + (fun contact -> + [ + div [ + pcdata "Contact: "; + let value = + match se.se_metadata.e_contact with + | Some x -> x + | None -> default_contact + in + string_input ~name:contact ~input_type:`Text ~value (); + ]; + div [ + pcdata "This contact will be added to emails sent to the voters."; + ]; + div [ + string_input ~input_type:`Submit ~value:"Save changes" (); + ]; + ]) uuid + in + let div_contact = + div [ + h2 [pcdata "Contact"]; + form_contact; + ] + in let has_credentials = match se.se_metadata.e_cred_authority with | None -> false | Some _ -> true @@ -442,11 +514,11 @@ 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 "."]; + pcdata "By default, the election server manages the keys of the election (degraded privacy mode). "; + pcdata "For real elections, the key must be shared among independent trustees. Click "; + a ~service:election_setup_trustees [pcdata "here"] uuid; + pcdata " to set up the election key."; + ]; ] in let div_credentials = @@ -477,11 +549,25 @@ h2 [pcdata "Finalize creation"]; a ~service:election_setup_confirm [pcdata "Create election"] uuid; ] in + let form_destroy = + post_form + ~service:election_setup_destroy + (fun () -> + [ + div [ + h2 [pcdata "Destroy election"]; + string_input ~input_type:`Submit ~value:"Destroy election" (); + ] + ] + ) uuid + in let content = [ div_description; hr (); div_languages; hr (); + div_contact; + hr (); div_questions; hr (); div_voters; @@ -493,6 +579,8 @@ div_trustees; hr (); link_confirm; + hr (); + form_destroy; ] in let%lwt login_box = site_login_box () in base ~title ?login_box ~content () @@ -540,6 +628,18 @@ ] ) uuid in + let form_trustees_add_server = + match List.filter (fun {st_id; _} -> st_id = "server") se.se_public_keys with + | [] -> + post_form + ~service:election_setup_trustee_add_server + (fun () -> + [ + string_input ~input_type:`Submit ~value:"Add the server" () + ] + ) uuid + | _ -> pcdata "" + in let mk_form_trustee_del value = post_form ~service:election_setup_trustee_del @@ -566,15 +666,23 @@ pcdata t.st_id; ]; td [ + if t.st_token <> "" then ( 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" + ) else ( + pcdata "(server)" + ) ]; td [ + if t.st_token <> "" then ( a ~service:election_setup_trustee [pcdata "Link"] t.st_token; + ) else ( + pcdata "(server)" + ) ]; td [ pcdata (if t.st_public_key = "" then "No" else "Yes"); @@ -584,33 +692,180 @@ ) ts ) in + let import_link = div [ + a ~service:Web_services.election_setup_import_trustees + [pcdata "Import trustees from another election"] uuid + ] + in + let div_trustees = + if se.se_threshold_trustees = None then + div [ + 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; + form_trustees_add_server; + ] + else pcdata "" + 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!"]; + div [ + pcdata "To set up the election key, you need to nominate trustees. Each trustee will create her own secret key."; + ]; + br (); + div_trustees; + ] + 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_threshold_trustees uuid se () = + let title = "Trustees for election " ^ se.se_questions.t_name in + let show_add_remove = se.se_threshold = None in + let form_trustees_add = + if show_add_remove then + post_form + ~service:election_setup_threshold_trustee_add + (fun name -> + [ + pcdata "Trustee's e-mail address: "; + string_input ~input_type:`Text ~name (); + string_input ~input_type:`Submit ~value:"Add" (); + ] + ) uuid + else pcdata "" + in + let mk_form_trustee_del value = + post_form + ~service:election_setup_threshold_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_threshold_trustees with + | None -> pcdata "" + | Some ts -> + div [ + table ( + tr ( + [ + th [pcdata "Trustee"]; + th [pcdata "Mail"]; + th [pcdata "Link"]; + th [pcdata "Step"]; + ] @ (if show_add_remove then [th [pcdata "Remove"]] else []) + ) :: + List.mapi (fun i t -> + tr ( + [ + td [ + pcdata t.stt_id; + ]; + td [ + let uri = rewrite_prefix @@ + Eliom_uri.make_string_uri + ~absolute:true ~service:election_setup_threshold_trustee t.stt_token + in + let body = Printf.sprintf mail_trustee_generation uri in + let subject = "Link to generate the decryption key" in + a_mailto ~dest:t.stt_id ~subject ~body "Mail" + ]; + td [ + a ~service:election_setup_threshold_trustee [pcdata "Link"] t.stt_token; + ]; + td [ + pcdata (string_of_int (match t.stt_step with None -> 0 | Some x -> x)); + ]; + ] @ (if show_add_remove then [td [mk_form_trustee_del i]] else []) + ) + ) ts + ); + div [ + pcdata "Meaning of steps:"; + ul [ + li [pcdata "0: administrator needs to set threshold"]; + li [pcdata "1: action needed from trustee: generate private key"]; + li [pcdata "2, 4, 6: waiting for other trustees"]; + li [pcdata "3, 5: action needed from trustee: enter private key"]; + li [pcdata "7: the key establishment protocol is finished"]; + ]; + ]; + br (); + ] + in + let form_threshold = + div [ + let value = + match se.se_threshold with + | None -> 0 + | Some i -> i + in + post_form + ~service:election_setup_threshold_set + (fun name -> + [ + pcdata "Threshold: "; + int_input ~input_type:`Text ~name ~value (); + string_input ~input_type:`Submit ~value:"Set" (); + ] + ) uuid + ] + in + let threshold_warning = + if show_add_remove then pcdata "" else + div [ + b [pcdata "Warning:"]; + pcdata " any change will re-initialize the whole process."; + pcdata " To edit trustees and restart the process, set to 0."; + ] + in + let maybe_error = + match se.se_threshold_error with + | None -> pcdata "" + | Some e -> div [b [pcdata "ERROR: "]; pcdata e; br (); br ()] + in + let div_content = + div [ + div [pcdata "On this page, you can configure a group of trustees such that only a threshold of them is needed to perform the decryption."]; + br (); + form_threshold; + threshold_warning; br (); trustees; - (if se.se_public_keys <> [] then + (if se.se_threshold_trustees <> None then div [ pcdata "There is one link per trustee. Send each trustee her link."; br (); br (); + maybe_error; ] 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 @@ -659,11 +914,11 @@ 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 ""); + script ~a:[a_src (static "sjcl.js")] (pcdata ""); + script ~a:[a_src (static "jsbn.js")] (pcdata ""); + script ~a:[a_src (static "jsbn2.js")] (pcdata ""); + script ~a:[a_src (static "random.js")] (pcdata ""); + script ~a:[a_src (static "tool_js_questions.js")] (pcdata ""); ] in let content = [ @@ -781,6 +1036,19 @@ let%lwt login_box = site_login_box () in base ~title ?login_box ~content () +let unsafe_textarea ?rows ?cols id contents = + let rows = match rows with + | None -> "" + | Some i -> Printf.sprintf " rows=\"%d\"" i + in + let cols = match cols with + | None -> "" + | Some i -> Printf.sprintf " cols=\"%d\"" i + in + Printf.ksprintf Unsafe.data + "" + id rows cols contents + let election_setup_credentials token uuid se () = let title = "Credentials for election " ^ se.se_questions.t_name in let div_link = @@ -793,13 +1061,35 @@ ] in let form_textarea = - post_form + post_form ~a:[a_id "submit_form"; a_style "display:none;"] ~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" ()]]]) + div ~a:[a_style "display:none;"] [a ~service:home ~a:[a_id "hashed"] [pcdata "Hashed public credentials"] ()]; + div [ + b [pcdata "Instructions:"]; + ol [ + li [ + pcdata "Download "; + a ~service:home ~a:[a_id "creds"] [pcdata "private credentials"] (); + pcdata " and save the file to a secure location."; + br (); + pcdata "You will use it to send credentials to voters."; + ]; + li [ + pcdata "Download "; + a ~service:home ~a:[a_id "public_creds"] [pcdata "public credentials"] (); + pcdata " and save the file."; + br (); + pcdata "Once the election is open, you must check that"; + pcdata " the file published by the server matches."; + ]; + li [pcdata "Submit public credentials using the button below."]; + ]; + ]; + div [string_input ~input_type:`Submit ~value:"Submit public credentials" ()]]]) token in let disclaimer = @@ -820,40 +1110,32 @@ 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 [unsafe_textarea "uuid" (raw_string_of_uuid uuid)]; div [pcdata "Group parameters:"]; - div [textarea ~a:[a_id "group"; a_rows 5; a_cols 40; a_readonly `ReadOnly] ~name ~value ()]; + div [unsafe_textarea "group" se.se_group]; ] 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 ()]; + div [unsafe_textarea ~rows:5 ~cols:40 "voters" 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 ""); + script ~a:[a_src (static "sjcl.js")] (pcdata ""); + script ~a:[a_src (static "jsbn.js")] (pcdata ""); + script ~a:[a_src (static "jsbn2.js")] (pcdata ""); + script ~a:[a_src (static "random.js")] (pcdata ""); + script ~a:[a_src (static "tool_js_credgen.js")] (pcdata ""); ] in let div_textarea = div [group; voters; interactivity; form_textarea; disclaimer] in @@ -865,7 +1147,6 @@ ) else ( [ div_link; - div_download; div_textarea; form_file; ] @@ -891,33 +1172,53 @@ ~service (fun name -> [ - div [ + div ~a:[a_id "submit_form"; a_style "display:none;"] [ 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" ()]; + div [ + b [pcdata "Instructions:"]; + ol [ + li [ + pcdata "Download your "; + a ~service:home ~a:[a_id "private_key"] [pcdata "private key"] (); + pcdata " and save it to a secure location."; + br (); + pcdata "You will use it to decrypt the final result."; + ]; + li [ + pcdata "Download your "; + a ~service:home ~a:[a_id "public_key"] [pcdata "public key"] (); + pcdata " and save it."; + br (); + pcdata "Once the election is open, you must check that"; + pcdata " it is present in the set of public keys"; + pcdata " published by the server."; + ]; + li [pcdata "Submit your public key using the button below."]; + ]; + ]; + div [string_input ~input_type:`Submit ~value:"Submit public key" ()]; ] ] ) () 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 ()]; + div [unsafe_textarea "group" se.se_group]; ] 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 ""); + script ~a:[a_src (static "sjcl.js")] (pcdata ""); + script ~a:[a_src (static "jsbn.js")] (pcdata ""); + script ~a:[a_src (static "jsbn2.js")] (pcdata ""); + script ~a:[a_src (static "random.js")] (pcdata ""); + script ~a:[a_src (static "tool_js_tkeygen.js")] (pcdata ""); ] in let content = [ @@ -928,20 +1229,122 @@ ] in base ~title ~content () +let election_setup_threshold_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%lwt trustee = + match se.se_threshold_trustees with + | None -> fail_http 404 + | Some ts -> + try return (List.find (fun x -> x.stt_token = token) ts) + with Not_found -> fail_http 404 + in + let%lwt certs = + match se.se_threshold_trustees with + | None -> fail_http 404 + | Some ts -> + let certs = List.fold_left (fun accu x -> + match x.stt_cert with + | None -> accu + | Some c -> c :: accu + ) [] ts |> List.rev |> Array.of_list + in return {certs} + in + let threshold = + match se.se_threshold with + | None -> 0 + | Some t -> t + in + let inputs = + div ~a:[a_style "display:none;"] [ + div [ + pcdata "Step: "; + unsafe_textarea "step" (match trustee.stt_step with None -> "0" | Some x -> string_of_int x); + ]; + div [ + pcdata "Group parameters: "; + unsafe_textarea "group" se.se_group; + ]; + div [ + pcdata "Certificates: "; + unsafe_textarea "certs" (string_of_certs certs); + ]; + div [ + pcdata "Threshold: "; + unsafe_textarea "threshold" (string_of_int threshold); + ]; + div [ + pcdata "Vinput: "; + unsafe_textarea "vinput" (match trustee.stt_vinput with None -> "" | Some x -> string_of_vinput x); + ]; + ] + in + let form = + post_form + ~service:election_setup_threshold_trustee_post + ~a:[a_id "data_form"] + (fun data -> + [ + div ~a:[a_id "key_helper"; a_style "display:none;"] [ + div [a ~service:home ~a:[a_id "private_key"] [pcdata "Private key"] ()]; + b [pcdata "Instructions:"]; + ol [ + li [pcdata "download your private key using the link above;"]; + li [pcdata "submit public data using the button below."]; + ]; + ]; + div [ + div [ + pcdata "Data: "; + textarea ~a:[a_id "data"] ~name:data (); + ]; + div [string_input ~input_type:`Submit ~value:"Submit" ()]; + ]; + ] + ) token + in + let interactivity = + div + ~a:[a_id "interactivity"] + [ + script ~a:[a_src (static "sjcl.js")] (pcdata ""); + script ~a:[a_src (static "jsbn.js")] (pcdata ""); + script ~a:[a_src (static "jsbn2.js")] (pcdata ""); + script ~a:[a_src (static "random.js")] (pcdata ""); + script ~a:[a_src (static "tool_js_ttkeygen.js")] (pcdata ""); + ] + in + let content = [ + div_link; + inputs; + interactivity; + br (); + 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 name = election.e_params.e_name in + let uuid_s = raw_string_of_uuid 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 + user_type_input raw_string_of_uuid ~input_type:`Hidden ~name:from - ~value:W.election.e_params.e_uuid (); + ~value:election.e_params.e_uuid (); string_input ~input_type:`Submit ~value:"Import from this election" (); ] ] @@ -994,18 +1397,37 @@ 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" + match se.se_threshold_trustees with + | None -> if List.for_all (fun {st_public_key; _} -> + st_public_key <> "" + ) se.se_public_keys then ready, "OK" else false, "Missing" + | Some _ -> + if se.se_threshold_parameters <> None && + match se.se_threshold_trustees with + | None -> false + | Some ts -> + List.for_all (fun {stt_step; _} -> stt_step = Some 7) ts + then ready, "OK" + else false, "Missing" in let div_trustee_warning = - match se.se_public_keys with - | [] -> + match se.se_threshold_trustees, se.se_public_keys with + | None, [] -> div [ b [pcdata "Warning:"]; pcdata " No trustees were set. This means that the server will manage the election key by itself."; ] - | _ :: _ -> pcdata "" + | _, _ -> pcdata "" + in + let contact, div_contact_warning = + match se.se_metadata.e_contact with + | None -> + "No", + div [ + b [pcdata "Warning:"]; + pcdata " No contact was set!"; + ] + | Some _ -> "Yes", pcdata "" in let table_checklist = table [ tr [ @@ -1023,12 +1445,17 @@ tr [ td [pcdata "Trustees?"]; td [pcdata trustees]; - ] + ]; + tr [ + td [pcdata "Contact?"]; + td [pcdata contact]; + ]; ] in let checklist = div [ h2 [pcdata "Checklist"]; table_checklist; div_trustee_warning; + div_contact_warning; ] in let form_create = if ready then @@ -1054,59 +1481,60 @@ 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 election_login_box uuid = let module A = struct let get_user () = - Web_state.get_election_user W.election.e_params.e_uuid + Web_state.get_election_user 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 + let%lwt l = Web_persist.get_auth_config (Some uuid) 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) + Eliom_service.preapply election_login ((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 file uuid x = Eliom_service.preapply election_dir (uuid, x) -let audit_footer w = +let audit_footer election = + let uuid = election.e_params.e_uuid in 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 pk_or_tp = + match%lwt Web_persist.get_threshold election.e_params.e_uuid with + | None -> + return (a ~service:(file uuid ESKeys) [ + pcdata L.trustee_public_keys + ] ()) + | Some _ -> + return (a ~service:(file uuid ESTParams) [ + pcdata "threshold parameters" + ] ()) + in return @@ div ~a:[a_style "line-height:1.5em;"] [ div [ div [ pcdata L.election_fingerprint; - code [ pcdata W.election.e_fingerprint ]; + code [ pcdata election.e_fingerprint ]; ]; div [ pcdata L.audit_data; - a ~service:(file w ESRaw) [ + a ~service:(file uuid ESRaw) [ pcdata L.parameters ] (); pcdata ", "; - a ~service:(file w ESKeys) [ - pcdata L.trustee_public_keys - ] (); + pk_or_tp; pcdata ", "; - a ~service:(file w ESCreds) [ + a ~service:(file uuid ESCreds) [ pcdata L.public_credentials ] (); pcdata ", "; - a ~service:(file w ESBallots) [ + a ~service:(file uuid ESBallots) [ pcdata L.ballots ] (); pcdata "."; @@ -1118,11 +1546,11 @@ | x :: ((_ :: _) as xs) -> x :: elt :: (list_concat elt xs) | ([_] | []) as xs -> xs -let election_home w state () = +let election_home election 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 params = election.e_params in + let uuid = params.e_uuid in let state_ = match state with | `Closed -> @@ -1139,7 +1567,7 @@ a ~service:election_dir [pcdata L.encrypted_tally] - (W.election.e_params.e_uuid, ESETally); + (uuid, ESETally); pcdata L.hash_is; b [pcdata hash]; pcdata "."; @@ -1161,10 +1589,10 @@ ~a:[a_style "font-size:25px;"] ~service:election_pretty_ballots [ pcdata L.see_accepted_ballots - ] (params.e_uuid, ()) + ] (uuid, ()) ] in - let%lwt footer = audit_footer w in + let%lwt footer = audit_footer election in let go_to_the_booth = let disabled = match state with | `Open -> false @@ -1172,24 +1600,27 @@ in div ~a:[a_style "text-align:center;"] [ div [ - make_button - ~service:(Eliom_service.preapply election_vote (params.e_uuid, ())) - ~disabled L.start; + let url = + Eliom_uri.make_string_uri + ~service:election_home ~absolute:true (uuid, ()) |> + rewrite_prefix + in + let hash = Netencoding.Url.mk_url_encoded_parameters ["url", url] in + make_button ~service:election_vote ~hash ~disabled L.start; ]; div [ a - ~service:(Eliom_service.preapply election_cast (params.e_uuid, ())) + ~service:(Eliom_service.preapply election_cast (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 + let questions = Array.to_list election.e_params.e_questions in return @@ div [ ul (List.mapi (fun i x -> let answers = Array.to_list x.q_answers in @@ -1221,7 +1652,7 @@ pcdata L.you_can_also_download; a ~service:election_dir [pcdata L.result_with_crypto_proofs] - (W.election.e_params.e_uuid, ESResult); + (uuid, ESResult); pcdata "."; ]; ] @@ -1239,7 +1670,9 @@ div ~a:[a_style "border-style: solid; border-width: 1px;"] [ - pcdata L.you_must_accept_cookies; + pcdata L.by_using_you_accept; + unsafe_a !gdpr_uri L.privacy_policy; + pcdata ". "; a ~service:set_cookie_disclaimer [pcdata L.accept] (); ] else pcdata "" @@ -1253,8 +1686,7 @@ br (); ballots_link; ] in - let%lwt login_box = election_login_box w () in - let uuid = params.e_uuid in + let%lwt login_box = election_login_box uuid () in base ~title:params.e_name ?login_box ~content ~footer ~uuid () let mail_trustee_tally : ('a, 'b, 'c, 'd, 'e, 'f) format6 = @@ -1275,18 +1707,19 @@ -- \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 election_admin election metadata state get_tokens_decrypt () = + let uuid = election.e_params.e_uuid in + let title = election.e_params.e_name ^ " — Administration" in let state_form checked = - let service, value, msg = + let service, value, msg, msg2 = if checked then election_close, "Close election", - "The election is open. Voters can vote. " + "The election is open. Voters can vote. ", + " You may re-open the election when it is closed." else election_open, "Open election", - "The election is closed. No one can vote. " + "The election is closed. No one can vote. ", + "" in post_form ~service @@ -1294,7 +1727,8 @@ [ pcdata msg; string_input ~input_type:`Submit ~value (); - ]) (W.election.e_params.e_uuid, ()) + pcdata msg2; + ]) (uuid, ()) in let%lwt state_div = match state with @@ -1311,13 +1745,24 @@ (fun () -> [string_input ~input_type:`Submit - ~value:"Tally election" + ~value:"Proceed to vote counting" (); pcdata " Warning: this action is irreversible; the election will be definitively closed."; - ]) (W.election.e_params.e_uuid, ()); + ]) (uuid, ()); ] | `EncryptedTally (npks, _, hash) -> - let%lwt pds = Web_persist.get_partial_decryptions uuid_s in + let%lwt pds = Web_persist.get_partial_decryptions uuid in + let%lwt tp = Web_persist.get_threshold uuid in + let tp = + match tp with + | None -> None + | Some tp -> Some (threshold_parameters_of_string Yojson.Safe.read_json tp) + in + let threshold_or_not = + match tp with + | None -> pcdata "" + | Some tp -> pcdata (Printf.sprintf " At least %d trustee(s) must act." tp.t_threshold) + in let trustees = let rec loop i ts = if i <= npks then @@ -1330,28 +1775,40 @@ | None -> loop 1 [] | Some ts -> loop 1 ts in + let rec seq i j = if i >= j then [] else i :: (seq (i+1) j) in + let%lwt trustee_tokens = + match tp with + | None -> return (List.map string_of_int (seq 1 (npks+1))) + | Some _ -> get_tokens_decrypt () + in + let trustees = List.combine trustees trustee_tokens in let trustees = List.map - (fun (name, trustee_id) -> + (fun ((name, trustee_id), token) -> let service = election_tally_trustees in - let x = (W.election.e_params.e_uuid, ((), trustee_id)) in + let x = (uuid, ((), token)) 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" + | None -> uri, !server_mail | Some name -> name, name in - tr [ - td [pcdata link_content]; - td [ + let mail, link = + if link_content = "server" then ( + pcdata "(server)", + pcdata "(server)" + ) else ( 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; - ]; + a_mailto ~dest ~subject ~body "Mail", + a ~service [pcdata "Link"] x + ) + in + tr [ + td [pcdata link_content]; + td [mail]; + td [link]; td [ pcdata (if List.mem_assoc trustee_id pds then "Yes" else "No") ]; @@ -1366,7 +1823,7 @@ ~input_type:`Submit ~value:"Compute the result" () - ]) (W.election.e_params.e_uuid, ()) + ]) (uuid, ()) in return @@ div [ div [ @@ -1374,13 +1831,13 @@ a ~service:election_dir [pcdata "encrypted tally"] - (W.election.e_params.e_uuid, ESETally); + (uuid, ESETally); pcdata " has been computed. Its hash is "; b [pcdata hash]; pcdata "."; ]; div [ - div [pcdata "We are now waiting for trustees..."]; + div [pcdata "We are now waiting for trustees..."; threshold_or_not]; table (tr [ th [pcdata "Trustee"]; @@ -1408,12 +1865,11 @@ 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)."; + 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 vote counting)."; ] - ) (W.election.e_params.e_uuid, ()); + ) (uuid, ()); ] in - let uuid = W.election.e_params.e_uuid in let update_credential = match metadata.e_cred_authority with | Some "server" -> @@ -1423,6 +1879,18 @@ a ~service:election_update_credential [pcdata "Update a credential"] (uuid, ()); ]; in + let cas = match metadata.e_auth_config with + | Some [{auth_system = "cas"; _}] -> true + | _ -> false + in + let div_regenpwd = + if cas then + pcdata "" + else + div [ + a ~service:election_regenpwd [pcdata "Regenerate and mail a password"] (uuid, ()); + ] + in let content = [ div [ a ~service:Web_services.election_home [pcdata "Election home"] (uuid, ()); @@ -1437,18 +1905,16 @@ div [ a ~service:election_missing_voters [pcdata "Missing voters"] (uuid, ()); ]; - div [ - a ~service:election_regenpwd [pcdata "Regenerate and mail a password"] (uuid, ()); - ]; + div_regenpwd; 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 update_credential election () = + let params = election.e_params in + let uuid = params.e_uuid in let form = post_form ~service:election_update_credential_post (fun (old, new_) -> [ @@ -1479,13 +1945,12 @@ ]; p [string_input ~input_type:`Submit ~value:"Submit" ()]; ] - ) (params.e_uuid, ()) + ) (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 () = @@ -1505,9 +1970,9 @@ 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 cast_raw election () = + let params = election.e_params in + let uuid = params.e_uuid in let form_rawballot = post_form ~service:election_cast_post (fun (name, _) -> [ @@ -1515,7 +1980,7 @@ div [textarea ~a:[a_rows 10; a_cols 40] ~name ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] - ) (params.e_uuid, ()) + ) (uuid, ()) in let form_upload = post_form ~service:election_cast_post (fun (_, name) -> @@ -1527,7 +1992,7 @@ ]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] - ) (params.e_uuid, ()) + ) (uuid, ()) in let intro = div [ div [ @@ -1543,7 +2008,7 @@ ]; div [ a ~service:Web_services.election_home - [pcdata "Back to election home"] (params.e_uuid, ()); + [pcdata "Back to election home"] (uuid, ()); ]; ] in let content = [ @@ -1553,17 +2018,16 @@ 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 + let%lwt login_box = election_login_box uuid () in + let%lwt footer = audit_footer election in base ~title:params.e_name ?login_box ~content ~uuid ~footer () -let cast_confirmation w hash () = +let cast_confirmation election 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 params = election.e_params in + let uuid = params.e_uuid in + let%lwt user = Web_state.get_election_user uuid in let name = params.e_name in let user_div = match user with | Some u -> @@ -1577,12 +2041,22 @@ ~input_type:`Submit ~value:L.i_cast_my_vote (); pcdata "."; ] - ]) (params.e_uuid, ()) + ]) (uuid, ()) | None -> div [ pcdata L.please_login_to_confirm; ] in + let%lwt div_revote = + match user with + | None -> return @@ pcdata "" + | Some u -> + let%lwt revote = Web_persist.has_voted uuid u in + if revote then + return @@ p [b [pcdata L.you_have_already_voted]] + else + return @@ pcdata "" + in let progress = div ~a:[a_style "text-align:center;margin-bottom:20px;"] [ pcdata L.input_credential; pcdata " — "; @@ -1613,11 +2087,12 @@ ]; br (); p [pcdata L.nobody_can_see]; + div_revote; user_div; p [ (let service = Eliom_service.preapply - Web_services.election_home (W.election.e_params.e_uuid, ()) + Web_services.election_home (uuid, ()) in a ~service [ pcdata L.go_back_to_election @@ -1625,14 +2100,14 @@ pcdata "."; ]; ] in - let uuid = params.e_uuid in base ~title:name ~content ~uuid () -let cast_confirmed w ~result () = +let cast_confirmed election ~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 l = Web_i18n.get_lang language in + let module L = (val l) in + let params = election.e_params in + let uuid = params.e_uuid in let name = params.e_name in let progress = div ~a:[a_style "text-align:center;margin-bottom:20px;"] [ pcdata L.input_credential; @@ -1657,13 +2132,13 @@ b [pcdata hash]; pcdata ". "; pcdata L.you_can_check_its_presence; - a ~service:election_pretty_ballots [pcdata L.ballot_box] (params.e_uuid, ()); + a ~service:election_pretty_ballots [pcdata L.ballot_box] (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 (Web_common.explain_error l e); pcdata "."; ], L.fail in @@ -1681,16 +2156,15 @@ [a ~service:Web_services.election_home [pcdata L.go_back_to_election] - (params.e_uuid, ())]; + (uuid, ())]; ] in - let uuid = params.e_uuid in base ~title:name ~content ~uuid () -let pretty_ballots w hashes result () = +let pretty_ballots election 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 params = election.e_params in + let uuid = params.e_uuid in let title = params.e_name ^ " — " ^ L.accepted_ballots in let nballots = ref 0 in let hashes = List.sort compare_b64 hashes in @@ -1702,7 +2176,7 @@ [a ~service:election_pretty_ballot [pcdata h] - ((params.e_uuid, ()), h)] + ((uuid, ()), h)] ) hashes in let links = @@ -1710,7 +2184,7 @@ [a ~service:Web_services.election_home [pcdata L.go_back_to_election] - (params.e_uuid, ())] + (uuid, ())] in let number = match !nballots, result with | n, None -> @@ -1736,14 +2210,12 @@ ul ballots; links; ] in - let%lwt login_box = election_login_box w () in - let uuid = params.e_uuid in + let%lwt login_box = election_login_box 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 pretty_records election records () = + let uuid = election.e_params.e_uuid in + let title = election.e_params.e_name ^ " — Records" in let records = List.map (fun (date, voter) -> tr [td [pcdata date]; td [pcdata voter]] ) records in @@ -1767,12 +2239,17 @@ 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 tally_trustees election trustee_id token () = + let params = election.e_params in + let uuid = params.e_uuid in let title = params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id in + let%lwt encrypted_private_key = + match%lwt Web_persist.get_private_keys uuid with + | None -> return_none + | Some keys -> return (Some (List.nth keys (trustee_id-1))) + in let content = [ p [pcdata "It is now time to compute your partial decryption factors."]; p [ @@ -1780,6 +2257,14 @@ b [span ~a:[a_id "hash"] []]; pcdata "." ]; + ( + match encrypted_private_key with + | None -> pcdata "" + | Some epk -> + div ~a:[a_style "display:none;"] [ + unsafe_textarea "encrypted_private_key" epk + ]; + ); div ~a:[a_id "input_private_key"] [ p [pcdata "Please enter your private key:"]; input @@ -1804,17 +2289,16 @@ ]; div [string_input ~input_type:`Submit ~value:"Submit" ()]; ] - ) (params.e_uuid, ((), trustee_id)); + ) (uuid, ((), token)); ]; 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 ""); + script ~a:[a_src (static "sjcl.js")] (pcdata ""); + script ~a:[a_src (static "jsbn.js")] (pcdata ""); + script ~a:[a_src (static "jsbn2.js")] (pcdata ""); + script ~a:[a_src (static "random.js")] (pcdata ""); + script ~a:[a_src (static "tool_js_pd.js")] (pcdata ""); ] ] in - let uuid = params.e_uuid in base ~title ~content ~uuid () let already_logged_in () = @@ -1890,34 +2374,43 @@ ] in base ~title:L.password_login ~content () +let dummy_uuid = uuid_of_raw_string "00000000-0000-0000-0000-000000000000" + 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 + link ~rel:[`Stylesheet] ~href:(static "booth.css") (); + script ~a:[a_src (static "sjcl.js")] (pcdata ""); + script ~a:[a_src (static "jsbn.js")] (pcdata ""); + script ~a:[a_src (static "jsbn2.js")] (pcdata ""); + script ~a:[a_src (static "random.js")] (pcdata ""); + script ~a:[a_src (static "booth.js")] (pcdata ""); + ] in + let wait_div = + div ~a:[a_id "wait_div"] [ + pcdata "Please wait... "; + img ~src:(static "encrypting.gif") ~alt:"Loading..." (); + ] + 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"]]; + h1 [pcdata L.belenios_booth]; + br (); + pcdata "Load an election by giving its URL:"; + div [unsafe_textarea "url" ""]; + div [button ~button_type:`Button ~a:[a_id "load_url"] [pcdata "Load URL"]]; + br (); + pcdata "Load an election by giving its parameters:"; + div [unsafe_textarea "election_params" ""]; + div [button ~button_type:`Button ~a:[a_id "load_params"] [pcdata "Load parameters"]]; ] 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 text_choices = unsafe_textarea "choices" "" in let ballot_form = post_form ~a:[a_id "ballot_form"] ~service:election_cast_post (fun (encrypted_vote, _) -> [ - div ~a:[a_style "display:none;"] [ + div ~a:[a_id "div_ballot"; a_style "display:none;"] [ pcdata "Encrypted ballot:"; div [ textarea @@ -1938,10 +2431,15 @@ pcdata L.we_invite_you_to_save_it; ]; br (); - string_input ~input_type:`Submit ~value:L.continue ~a:[a_style "font-size:30px;"] (); + div ~a:[a_id "div_submit"] [ + string_input ~input_type:`Submit ~value:L.continue ~a:[a_style "font-size:30px;"] (); + ]; + div ~a:[a_id "div_submit_manually"; a_style "display:none;"] [ + pcdata "You must submit your ballot manually."; + ]; br (); br (); ]) - (Uuidm.nil, ()) + (dummy_uuid, ()) in let main = div ~a:[a_id "main"] [ @@ -1986,7 +2484,7 @@ 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 (); + img ~src:(static "encrypting.gif") ~alt:L.encrypting (); ]; div ~a:[a_id "ballot_div"; a_style "display:none;"] [ballot_form]; Unsafe.data (""); @@ -2000,11 +2498,11 @@ 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")) (); + ~src:(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")) (); + ~src:(static "placeholder.png") (); ]; div ~a:[a_style "text-align:center; padding: 20px;"] [ h1 ~a:[a_id "election_name"] []; @@ -2041,9 +2539,15 @@ ] in let body = body [ + wait_div; + election_loader; div ~a:[a_id "wrapper"] [ - election_loader; booth_div; ]; ] in return @@ html ~a:[a_dir `Ltr; a_xml_lang L.lang] head body + +let contact_footer metadata please_contact = + match metadata.e_contact with + | None -> "" + | Some x -> Printf.sprintf "\n\n%s\n %s" please_contact x diff -Nru belenios-1.4+dfsg/src/web/web_templates.mli belenios-1.6+dfsg/src/web/web_templates.mli --- belenios-1.4+dfsg/src/web/web_templates.mli 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/src/web/web_templates.mli 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ (**************************************************************************) (* BELENIOS *) (* *) -(* Copyright © 2012-2016 Inria *) +(* Copyright © 2012-2018 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 *) @@ -23,7 +23,8 @@ 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 admin_gdpr : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val admin : elections:('a election list * 'a election list * 'a election list * (uuid * 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 @@ -37,28 +38,30 @@ 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 election_setup : uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_voters : uuid -> setup_election -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_questions : uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_credential_authority : uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_credentials : string -> uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_trustees : uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_threshold_trustees : uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_trustee : string -> uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_threshold_trustee : string -> uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_import : uuid -> setup_election -> 'a election list * 'a election list * 'a election list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_import_trustees : uuid -> setup_election -> 'a election list * 'a election list * 'a election list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_setup_confirm : uuid -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t + +val election_home : 'a election -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val election_admin : 'a election -> Web_serializable_j.metadata -> Web_persist.election_state -> (unit -> string list Lwt.t) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val update_credential : 'a election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val regenpwd : uuid -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val cast_raw : 'a election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val cast_confirmation : 'a election -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val cast_confirmed : 'a election -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val pretty_ballots : 'a election -> string list -> Yojson.Safe.json result option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t +val pretty_records : 'a election -> (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 tally_trustees : 'a election -> int -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val already_logged_in : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t @@ -77,3 +80,5 @@ val login_password : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val booth : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t + +val contact_footer : metadata -> string -> string diff -Nru belenios-1.4+dfsg/_tags belenios-1.6+dfsg/_tags --- belenios-1.4+dfsg/_tags 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/_tags 2018-06-13 11:46:49.000000000 +0000 @@ -1,7 +1,7 @@ <**/*.{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 +: package(zarith), package(cryptokit) +: thread, package(eliom.server), package(lwt.ppx), package(calendar), package(csv) +: package(zarith), 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) diff -Nru belenios-1.4+dfsg/VERSION belenios-1.6+dfsg/VERSION --- belenios-1.4+dfsg/VERSION 2017-04-06 09:12:04.000000000 +0000 +++ belenios-1.6+dfsg/VERSION 2018-06-13 11:46:49.000000000 +0000 @@ -1 +1 @@ -1.4 +1.6