belenios-2.2-10-gbb6b7ea8/0002755000175000017500000000000014476041226014100 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/0002755000175000017500000000000014476041226015242 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/debian-votes/0002755000175000017500000000000014476041226017622 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/debian-votes/download.sh0000755000175000017500000000104114476041226021762 0ustar stephsteph#!/bin/bash set -e buffer=$(mktemp) year=$(date +%Y) while true; do vote=1 while true; do filename=$(printf "vote_%03d_tally.txt" $vote) url="https://www.debian.org/vote/$year/$filename" echo "Downloading $url ..." if curl --silent --fail "$url" > $buffer; then mkdir -p $year cp $buffer $year/$filename ((vote++)) else break fi done if [[ $vote -eq 1 ]]; then break else ((year--)) fi done rm -f $buffer belenios-2.2-10-gbb6b7ea8/tests/debian-votes/dune0000644000175000017500000000012114476041226020470 0ustar stephsteph(executable (name convert) (libraries belenios-platform-native belenios pcre)) belenios-2.2-10-gbb6b7ea8/tests/debian-votes/convert.ml0000644000175000017500000000534614476041226021642 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 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 Belenios_core open Serializable_j let rec input_lines ic lines = match input_line ic with | line -> input_lines ic (line :: lines) | exception End_of_file -> lines let tally_txt = input_lines stdin [] let nchoices = let rex = Pcre.regexp "^V: ([-1-9]+)\\s" in match tally_txt with | [] -> failwith "No lines in input" | line :: _ -> ( match Pcre.exec ~rex line with | s -> String.length (Pcre.get_substring s 1) | exception Not_found -> failwith "Could not parse last line as a ballot") let rex = let buf = Buffer.create 32 in Buffer.add_string buf "^V: "; for _ = 1 to nchoices do Buffer.add_string buf "(.)" done; Buffer.add_string buf "\\s"; Pcre.regexp (Buffer.contents buf) let rec convert accu = function | [] -> accu | line :: lines -> let accu = match Pcre.exec ~rex line with | s -> let get i = let x = Pcre.get_substring s (i + 1) in if x = "-" then 0 else int_of_string x in Array.init nchoices get :: accu | exception Not_found -> accu in convert accu lines let tally = convert [] tally_txt |> Array.of_list let () = print_endline (string_of_condorcet_ballots tally) belenios-2.2-10-gbb6b7ea8/tests/debian-votes/README.md0000644000175000017500000000077714476041226021112 0ustar stephstephUsing Debian vote data to test counting methods =============================================== This directory provides tools to test Belenios counting functions with [Debian vote data](https://www.debian.org/vote/). The `download.sh` script downloads tally sheets of all Debian votes. The `convert.ml` script (compiled as `../../_build/tests/debian-votes/convert.byte`) reads on its standard input a tally sheet and writes on its standard output the list of ballots in the JSON format expected by Belenios. belenios-2.2-10-gbb6b7ea8/tests/dune0000644000175000017500000000002414476041226016112 0ustar stephsteph(dirs debian-votes) belenios-2.2-10-gbb6b7ea8/tests/selenium/0002755000175000017500000000000014476041226017063 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/selenium/tools/0002755000175000017500000000000014476041226020223 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/selenium/tools/sendmail_fake_to_static.sh0000755000175000017500000000007614476041226025416 0ustar stephsteph#!/bin/sh exec cat >> _run/usr/share/belenios-server/mail.txt belenios-2.2-10-gbb6b7ea8/tests/selenium/tools/sendmail_fake.sh0000755000175000017500000000005114476041226023336 0ustar stephsteph#!/bin/sh exec cat >> /tmp/sendmail_fake belenios-2.2-10-gbb6b7ea8/tests/selenium/load_testing_set_up.py0000644000175000017500000003757314476041226023505 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys import csv from util.fake_sent_emails_manager import FakeSentEmailsManager from util.selenium_tools import wait_for_element_exists, wait_for_element_exists_and_has_non_empty_content, wait_for_element_exists_and_contains_expected_text, wait_for_element_exists_and_has_non_empty_attribute from util.election_testing import strtobool, console_log, remove_database_folder, wait_a_bit, initialize_server, verify_election_consistency, populate_credential_and_password_for_voters_from_sent_emails, populate_random_votes_for_voters, admin_election_draft_page_url_to_election_id, belenios_tool_generate_credentials, remove_credentials_files, belenios_tool_generate_ballots from test_scenario_2 import BeleniosTestElectionScenario2Base, initialize_browser_for_scenario_2 import settings class BeleniosLoadTestingSetUp(BeleniosTestElectionScenario2Base): """ Properties: - credential_file_id: Path and base filename (without extension) of the credential files generated by `belenios-tool setup generate-credentials` command - distant_fake_sent_emails_manager: An instance of FakeSentEmailsManager, that corresponds to a text file that contains all fake emails sent by a distant Belenios server - fake_sent_emails_initial_lines_count: The number of lines that the fake sent emails file initially has on the server """ def __init__(self, *args, **kw): super().__init__(*args, **kw) self.credential_file_id = None self.distant_fake_sent_emails_manager = None self.fake_sent_emails_initial_lines_count = None def setUp(self): self.fake_sent_emails_manager = FakeSentEmailsManager(settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) self.fake_sent_emails_manager.install_fake_sendmail_log_file() if settings.START_SERVER: remove_database_folder() self.server = initialize_server() self.browser = initialize_browser_for_scenario_2() def tearDown(self): self.browser.quit() if settings.START_SERVER: self.server.kill() remove_database_folder() remove_credentials_files(self.credential_file_id) # delete_election_data_snapshot(snapshot_folder) self.fake_sent_emails_manager.uninstall_fake_sendmail_log_file() if self.distant_fake_sent_emails_manager is not None: self.distant_fake_sent_emails_manager.uninstall_fake_sendmail_log_file() def credential_authority_sends_locally_generated_credentials_to_server(self): # Cecily, the Credential Authority, receives the email sent by Alice, and opens the link in it self.browser = initialize_browser_for_scenario_2() browser = self.browser browser.get(self.credential_authority_link) wait_a_bit() # She remembers what the link to the election will be, so that she will be able to send it to voters by email with their private credential # TODO: use a better selector: edit Belenios page to use an ID in this DOM element future_election_link_css_selector = "#main ul li" future_election_link_element = wait_for_element_exists_and_has_non_empty_content(browser, future_election_link_css_selector) self.election_page_url = future_election_link_element.get_attribute('innerText').strip() # She gets the voter list voters = wait_for_element_exists_and_has_non_empty_attribute(browser, "#voters", "value").get_attribute("value") # She executes local (not server's) CLI belenios-tool to generate a number of credentials corresponding to the number of voters. This creates some local files. console_log("#### Starting step: belenios_tool_generate_credentials") self.credential_file_id = belenios_tool_generate_credentials(self.election_id, voters, nh_question=settings.NH_QUESTION) console_log("#### Step complete: belenios_tool_generate_credentials") console_log("#### Credential file id:", self.credential_file_id) # She uploads the file that corresponds to the public part of the genereated credentials. For this, she clicks on the 'Browse' button and selects the file with `.pubcreds` extension browse_button_css_selector = "form input[name=public_creds][type=file]" browse_button_element = wait_for_element_exists(browser, browse_button_css_selector) path_of_file_to_upload = self.credential_file_id + ".pubcreds" browse_button_element.clear() browse_button_element.send_keys(path_of_file_to_upload) # She clicks on 'Submit' button submit_button_css_selector = "form input[type=submit][value=Submit]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # She checks that page contains text "Credentials have been received and checked!" page_content_css_selector = "#main div div" page_content_expected_content = "Credentials have been received and checked!" wait_for_element_exists_and_contains_expected_text(browser, page_content_css_selector, page_content_expected_content, settings.EXPLICIT_WAIT_TIMEOUT) # We act like if credential authority had also sent each private credential to a different voter. For ease of parsing, we write these emails into the same text file as Belenios server's. self.credential_authority_sends_credentials_to_voters_from_credentials_file(self.credential_file_id + ".privcreds", self.voters_email_addresses) # She closes the browser window browser.quit() def generate_vote_ballots(self): invited_voters_who_will_vote = random.sample(self.voters_email_addresses, settings.NUMBER_OF_VOTING_VOTERS) invited_voters_who_will_vote_data = populate_credential_and_password_for_voters_from_sent_emails(self.distant_fake_sent_emails_manager, invited_voters_who_will_vote, settings.ELECTION_TITLE) invited_voters_who_will_vote_data = populate_random_votes_for_voters(invited_voters_who_will_vote_data) self.update_voters_data(invited_voters_who_will_vote_data) belenios_tool_generate_ballots(self.voters_data, self.credential_file_id, self.election_page_url) def export_all_votes_csv(self): generated_files_destination_folder = settings.GENERATED_FILES_DESTINATION_FOLDER csv_file_path = os.path.join(generated_files_destination_folder, 'all_votes.csv') with open(csv_file_path, 'w', newline='') as csvfile: csvwriter = csv.writer(csvfile, delimiter=',', quotechar='|', quoting=csv.QUOTE_MINIMAL) csvwriter.writerow(['voter_email_address', 'voter_password', 'voter_credential', 'voter_encrypted_ballot_file_name', 'election_page_url']) i = 0 for k, v in self.voters_data.items(): i += 1 voter_email_address = k voter_password = v['password'] voter_credential = v['credential'] voter_crypted_ballot_file = "voter_row_" + str(i) + "_crypted_ballot.json" voter_encrypted_ballot_file_path = voter_crypted_ballot_file # or for absolute path: os.path.join(generated_files_destination_folder, voter_crypted_ballot_file) election_page_url = v['election_page_url'] csvwriter.writerow([voter_email_address, voter_password, voter_credential, voter_encrypted_ballot_file_path, election_page_url]) def download_all_sent_emails(self, target_fake_sent_emails_manager=None): from urllib.parse import urljoin import urllib.request if not target_fake_sent_emails_manager: target_fake_sent_emails_manager = FakeSentEmailsManager() distant_fake_emails_file_url = urljoin(settings.SERVER_URL, settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL) # TODO: maybe we should build this URL by picking link value in alert banner on distant server home page urllib.request.urlretrieve(distant_fake_emails_file_url, target_fake_sent_emails_manager.log_file_path) console_log("#### Distant fake sent emails have been saved in:", target_fake_sent_emails_manager.log_file_path) return target_fake_sent_emails_manager def test_load_testing_set_up(self): # Create (if it does not exist) folder that will contain all files created by this script os.makedirs(settings.GENERATED_FILES_DESTINATION_FOLDER, exist_ok=True) # Download server's sent emails text file, so that we know up to which line number we have to ignore its contents (this is its last line) temporary_fake_sent_emails_manager = None try: temporary_fake_sent_emails_manager = self.download_all_sent_emails() self.fake_sent_emails_initial_lines_count = temporary_fake_sent_emails_manager.count_lines() console_log("### Initial lines count of server's fake sent emails file:", self.fake_sent_emails_initial_lines_count) finally: if temporary_fake_sent_emails_manager: temporary_fake_sent_emails_manager.uninstall_fake_sendmail_log_file() console_log("### Running test method BeleniosLoadTestingSetUp::test_load_testing_set_up()") console_log("### Starting step: administrator_starts_creation_of_manual_election") self.administrator_starts_creation_of_manual_election(nh_question=settings.NH_QUESTION) console_log("### Step complete: administrator_starts_creation_of_manual_election") self.election_id = admin_election_draft_page_url_to_election_id(self.draft_election_administration_page_url) console_log("### Starting step: credential_authority_sends_locally_generated_credentials_to_server") self.credential_authority_sends_locally_generated_credentials_to_server() console_log("### Step complete: credential_authority_sends_locally_generated_credentials_to_server") console_log("### Starting step: administrator_invites_trustees") self.administrator_invites_trustees() console_log("### Step complete: administrator_invites_trustees") console_log("### Starting step: trustees_generate_election_private_keys") self.trustees_generate_election_private_keys() console_log("### Step complete: trustees_generate_election_private_keys") console_log("### Starting step: administrator_completes_creation_of_election") self.administrator_completes_creation_of_election() console_log("### Step complete: administrator_completes_creation_of_election") if settings.SERVER_URL == "http://localhost:8001": console_log("### Starting step: verify_election_consistency using `belenios_tool verify`") verify_election_consistency(self.election_id) console_log("### Step complete: verify_election_consistency using `belenios_tool verify`") console_log("### Starting step: download_all_sent_emails") self.distant_fake_sent_emails_manager = self.download_all_sent_emails() console_log("### Step complete: download_all_sent_emails") # Concatenate (distant) Belenios server's sent emails file (starting after line `fake_sent_emails_initial_lines_count`) and local credential authority's sent emails file into file `self.distant_fake_sent_emails_manager.log_file_path`, so that `self.generate_vote_ballots()` can parse it and find all information it needs. import subprocess import tempfile (file_handle, log_file_path) = tempfile.mkstemp(text=True) with open(log_file_path, 'w') as f: subprocess.run(["tail", "-n", "+" + str(self.fake_sent_emails_initial_lines_count + 1), self.distant_fake_sent_emails_manager.log_file_path], stdout=f) subprocess.run(["cat", self.fake_sent_emails_manager.log_file_path], stdout=f) subprocess.run(["cp", log_file_path, self.distant_fake_sent_emails_manager.log_file_path]) subprocess.run(["rm", "-f", log_file_path]) # Generate ballot for each voter console_log("### Starting step: generate_vote_ballots") self.generate_vote_ballots() console_log("### Step complete: generate_vote_ballots") # Export a CSV file to be imported by the jmeter load testing script. It contains fields 'voter_email_address', 'voter_password', 'voter_credential', 'voter_encrypted_ballot_file_name', 'election_page_url' console_log("### Starting step: export_all_votes_csv") self.export_all_votes_csv() console_log("### Step complete: export_all_votes_csv") if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) settings.SERVER_URL = os.getenv('SERVER_URL', settings.SERVER_URL) if os.getenv('START_SERVER', None): settings.START_SERVER = bool(strtobool(os.getenv('START_SERVER'))) settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL = os.getenv('FAKE_SENT_EMAILS_FILE_RELATIVE_URL', settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.NH_QUESTION = False if os.getenv('NH_QUESTION', None): settings.NH_QUESTION = bool(strtobool(os.getenv('NH_QUESTION'))) settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.LOGIN_MODE = os.getenv('LOGIN_MODE', settings.LOGIN_MODE) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) settings.GENERATED_FILES_DESTINATION_FOLDER = os.getenv('GENERATED_FILES_DESTINATION_FOLDER', settings.GENERATED_FILES_DESTINATION_FOLDER) console_log("SERVER_URL:", settings.SERVER_URL) console_log("START_SERVER:", settings.START_SERVER) console_log("FAKE_SENT_EMAILS_FILE_RELATIVE_URL:", settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("LOGIN_MODE:", settings.LOGIN_MODE) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) console_log("GENERATED_FILES_DESTINATION_FOLDER:", settings.GENERATED_FILES_DESTINATION_FOLDER) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/settings.py0000644000175000017500000000726614476041226021306 0ustar stephsteph#!/usr/bin/python # coding: utf-8 from os.path import abspath, dirname, join from enum import Enum, unique SERVER_EXECUTABLE_FILE_PATH_RELATIVE_TO_GIT_REPOSITORY = "demo/run-server.sh" SERVER_URL = "http://127.0.0.1:8001" START_SERVER = False ELECTION_ID = None DATABASE_FOLDER_PATH_RELATIVE_TO_GIT_REPOSITORY = "_run/spool" FAKE_SENDMAIL_EXECUTABLE_FILE_PATH_RELATIVE_TO_GIT_REPOSITORY = "tests/selenium/tools/sendmail_fake.sh" SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = "/tmp/sendmail_fake" FAKE_SENT_EMAILS_FILE_RELATIVE_URL = "mail/mails.txt" USE_HEADLESS_BROWSER = True # Set this to True if you run this test in Continuous Integration (it has no graphical display) WAIT_TIME_BETWEEN_EACH_STEP = 0 # In seconds (float). Time we wait between each action that we tell Selenium driver to do in the browser. Set to 0 if you don't need to have the time to visually follow progress of actions in the browser EXPLICIT_WAIT_TIMEOUT = 30 # In seconds. Maximum duration Selenium driver will wait for appearance of a specific DOM element expected in the page (for example when transitioning from a page to another). This referes to Selenium's "Explicit Wait" concept NUMBER_OF_INVITED_VOTERS = 20 # This is N in description of Scenario 1. N is between 6 (quick test) and 1000 (load testing) NUMBER_OF_VOTING_VOTERS = 10 # This is K in description of Scenario 1. K is between 6 (quick test) and 1000 (load testing). K <= N. (Some invited voters don't vote, this is abstention, and its value is N - K) NUMBER_OF_MONKEY_VOTING_VOTERS = 4 # In test `test_scenario_2_with_monkeys.py`, this is the number of voters who will act as smart monkeys (who complete their vote). This set of users are part of the bigger set NUMBER_OF_VOTING_VOTERS, so NUMBER_OF_MONKEY_VOTING_VOTERS <= NUMBER_OF_VOTING_VOTERS. If NUMBER_OF_MONKEY_VOTING_VOTERS > 0, then its value must make result the of `(NUMBER_OF_VOTING_VOTERS - NUMBER_OF_MONKEY_VOTING_VOTERS) / 2` be an integer. NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART = 3 # In test `test_scenario_2_with_monkeys.py`, this is the number of non-monkey voters who will vote at first. Then NUMBER_OF_MONKEY_VOTING_VOTERS monkeys vote. Then (NUMBER_OF_VOTING_VOTERS - NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART - NUMBER_OF_MONKEY_VOTING_VOTERS) vote. NUMBER_OF_REVOTING_VOTERS = 5 # This is L in description of Scenario 1. L <= K NUMBER_OF_REGENERATED_PASSWORD_VOTERS = 4 # This is M in description of Scenario 1. M <= K ELECTION_TITLE = "My test election for Scenario 1" ELECTION_DESCRIPTION = "This is the description of my test election for Scenario 1" LOGIN_MODE = "local" ADMINISTRATOR_USERNAME = "user1" # This value comes from file `demo/password_db.csv`, first row, first column ADMINISTRATOR_PASSWORD = "RP91JMQkL6Lz" # This value comes from file `demo/password_db.csv`, first row, 5th column INITIATOR_CONTACT = "Election initiator " GIT_REPOSITORY_ABSOLUTE_PATH = dirname(dirname(dirname(abspath(__file__)))) GENERATED_FILES_DESTINATION_FOLDER = join(GIT_REPOSITORY_ABSOLUTE_PATH, "_testdata") @unique class CLEAN_UP_POLICIES(Enum): REMOVE_DATABASE = "REMOVE_DATABASE" REMOVE_ELECTION = "REMOVE_ELECTION" DO_NOTHING = "DO_NOTHING" CLEAN_UP_POLICY = CLEAN_UP_POLICIES.REMOVE_DATABASE # These variables are used by Scenario 2 only BROWSER_DOWNLOAD_FOLDER = "/tmp" ADMINISTRATOR_EMAIL_ADDRESS = "alice_aka_election_administrator@example.org" CREDENTIAL_AUTHORITY_EMAIL_ADDRESS = "cecily_aka_election_credential_authority@example.org" NUMBER_OF_TRUSTEES = 5 TRUSTEES_EMAIL_ADDRESSES = ["tom_aka_trustee_1@example.org", "taylor_aka_trustee_2@example.org", "tania_aka_trustee_3@example.org", "tiffany_aka_trustee_4@example.org", "theresa_aka_trustee_5@example.org"] TRUSTEES_THRESHOLD_VALUE = 3 belenios-2.2-10-gbb6b7ea8/tests/selenium/test_smart_monkey.py0000644000175000017500000001556014476041226023211 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys import time from util.election_testing import strtobool, election_id_to_election_home_page_url from util.page_objects import BallotBoxPage from util.state_machine import ElectionHomePageState, NormalVoteStep6PageState from util.monkeys import SmartMonkeyWithMemoryAndKnownStateMachine from util.execution import console_log from test_fuzz_vote import BeleniosTestElectionWithCreationBase import settings def smart_monkey_votes(browser, timeout, election_url, voter_username, voter_password, voter_credential, voter_decided_vote=None): console_log("## Going to election page:", election_url) browser.get(election_url) election_home_page_state = ElectionHomePageState(browser, timeout) election_home_page_state.page.click_on_language_link("en") in_memory = { "voter_username": voter_username, "voter_password": voter_password, "voter_credential": voter_credential, } if voter_decided_vote: in_memory["voter_decided_vote"] = voter_decided_vote smart_monkey = SmartMonkeyWithMemoryAndKnownStateMachine(election_home_page_state, in_memory=in_memory) console_log(f"smart_monkey.current_state: {smart_monkey.current_state}") current_iteration = 1 while not isinstance(smart_monkey.current_state, NormalVoteStep6PageState): smart_monkey.verify_page() current_iteration += 1 console_log(f"executing action number {current_iteration}") try: executed_action = smart_monkey.execute_a_random_action() console_log(f"executed action was: {executed_action}") except Exception as e: console_log(f"Exception while executing `smart_monkey.execute_a_random_action()`. Page state was {smart_monkey.current_state} and exception was: {repr(e)}") time.sleep(10) raise Exception("Exception while executing `smart_monkey.execute_a_random_action()`") from e console_log(f"smart_monkey.current_state: {smart_monkey.current_state}") if isinstance(smart_monkey.current_state, NormalVoteStep6PageState): console_log("Ending monkey behaviour here because we have completed the vote") smart_monkey.verify_page() console_log("Clicking on the ballot box link and verifying presence of voter's smart ballot tracker") smart_monkey.current_state.page.click_on_ballot_box_link() ballot_box_page = BallotBoxPage(browser, timeout) voter_validated_smart_ballot_tracker = smart_monkey.get_memory_element("voter_validated_smart_ballot_tracker") ballot_box_page.verify_page(voter_validated_smart_ballot_tracker) return voter_validated_smart_ballot_tracker class BeleniosMonkeyTestClicker(BeleniosTestElectionWithCreationBase): def test_very_smart_monkey_votes(self): console_log("# test_very_smart_monkey_votes()") browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT election_url = election_id_to_election_home_page_url(self.election_id) smart_monkey_votes(browser, timeout, election_url, settings.VOTER_USERNAME, settings.VOTER_PASSWORD, settings.VOTER_CREDENTIAL) if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) settings.SERVER_URL = os.getenv('SERVER_URL', settings.SERVER_URL) if os.getenv('START_SERVER', None): settings.START_SERVER = bool(strtobool(os.getenv('START_SERVER'))) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.ELECTION_ID = os.getenv('ELECTION_ID', None) or None settings.VOTER_USERNAME = os.getenv('VOTER_USERNAME', None) or None settings.VOTER_PASSWORD = os.getenv('VOTER_PASSWORD', None) or None settings.VOTER_CREDENTIAL = os.getenv('VOTER_CREDENTIAL', None) or None settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL = os.getenv('FAKE_SENT_EMAILS_FILE_RELATIVE_URL', "static/mail.txt") settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) # Do not set a value below 0.02 seconds, otherwise hypothesis test becomes flaky. settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.LOGIN_MODE = os.getenv('LOGIN_MODE', settings.LOGIN_MODE) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) console_log("SERVER_URL:", settings.SERVER_URL) console_log("START_SERVER:", settings.START_SERVER) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("LOGIN_MODE:", settings.LOGIN_MODE) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/vote_with_prepared_ballots.py0000644000175000017500000001757214476041226025061 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import os import csv from selenium.webdriver.support.select import Select from util.selenium_tools import wait_for_element_exists, wait_for_element_exists_and_contains_expected_text, wait_for_an_element_with_link_text_exists, wait_for_element_exists_and_has_non_empty_content, verify_all_elements_have_attribute_value from util.election_testing import strtobool, console_log, wait_a_bit from util.execution import ConsoleLogDuration, try_several_times from test_scenario_2 import BeleniosTestElectionScenario2Base, initialize_browser_for_scenario_2 import settings class BeleniosVoteWithPreparedBallots(BeleniosTestElectionScenario2Base): def __init__(self, *args, **kw): super().__init__(*args, **kw) def setUp(self): self.browser = initialize_browser_for_scenario_2() self.browser.set_page_load_timeout(60 * 2) # If we don't set a page load timeout, sometimes some WebDriverWait stay stuck because page has not finished loading def tearDown(self): self.browser.quit() def cast_all_votes_from_csv(self): browser = self.browser generated_files_destination_folder = settings.GENERATED_FILES_DESTINATION_FOLDER csv_file_path = os.path.join(generated_files_destination_folder, 'all_votes.csv') with open(csv_file_path, 'r', newline='') as csvfile: csvreader = csv.DictReader(csvfile, delimiter=',', quotechar='|') current_row = 0 for row in csvreader: current_row += 1 if current_row <= settings.SKIP_ROWS_IN_CSV_FILE: continue voter_email_address = row['voter_email_address'] voter_password = row['voter_password'] voter_encrypted_ballot_file_name = row['voter_encrypted_ballot_file_name'] election_page_url = row['election_page_url'] with ConsoleLogDuration(f"Row {current_row} (voter {voter_email_address})"): # Go to election home browser.get(election_page_url) wait_a_bit() # She clicks on "en" language select = Select(wait_for_element_exists(browser, ".lang_box select", settings.EXPLICIT_WAIT_TIMEOUT)) select.select_by_value("en") wait_a_bit() # Click on advanced mode advanced_mode_link_expected_label = "Advanced mode" advanced_mode_link_element = wait_for_an_element_with_link_text_exists(browser, advanced_mode_link_expected_label, settings.EXPLICIT_WAIT_TIMEOUT) advanced_mode_link_element.click() wait_a_bit() # Browse file and submit it browse_button_css_selector = "form input[name=encrypted_vote][type=file]" browse_button_element = wait_for_element_exists(browser, browse_button_css_selector) path_of_file_to_upload = os.path.join(generated_files_destination_folder, voter_encrypted_ballot_file_name) browse_button_element.clear() browse_button_element.send_keys(path_of_file_to_upload) browse_button_element.submit() wait_a_bit() # Submit login form username_field_css_selector = "form input[name=username]" username_field_element = wait_for_element_exists(browser, username_field_css_selector) username_field_element.clear() username_field_element.send_keys(voter_email_address) password_field_css_selector = "form input[name=password]" password_field_element = wait_for_element_exists(browser, password_field_css_selector) password_field_element.clear() password_field_element.send_keys(voter_password) password_field_element.submit() wait_a_bit() @try_several_times(max_attempts=3) def verify_step_5_and_6(browser, timeout): # Verify that page contains a ballot tracker smart_ballot_tracker_css_selector = "#ballot_tracker" smart_ballot_tracker_element = wait_for_element_exists_and_has_non_empty_content(browser, smart_ballot_tracker_css_selector, timeout) my_smart_ballot_tracker_value = smart_ballot_tracker_element.get_attribute('innerText') assert len(my_smart_ballot_tracker_value) > 5 # Click "I cast my vote" button submit_button_css_selector = "form input[type=submit]" submit_button_expected_content = "I cast my vote" verify_all_elements_have_attribute_value(browser, submit_button_css_selector, "value", submit_button_expected_content, timeout) submit_button_element = wait_for_element_exists(browser, submit_button_css_selector, timeout) submit_button_element.click() wait_a_bit() # Verify that vote has been accepted by the server @try_several_times(max_attempts=3) def verify_that_we_are_on_step_6(browser, timeout): all_ballots_link_expected_label = "ballot box" all_ballots_element = wait_for_an_element_with_link_text_exists(browser, all_ballots_link_expected_label, timeout) current_step_css_selector = ".current_step" current_step_expected_content = "Thank you for voting!" wait_for_element_exists_and_contains_expected_text(browser, current_step_css_selector, current_step_expected_content, timeout) return all_ballots_element all_ballots_element = verify_that_we_are_on_step_6(browser, timeout) # Go to all ballots page all_ballots_element.click() wait_a_bit() # Verify presence of my ballot my_smart_ballot_tracker_link_element = wait_for_an_element_with_link_text_exists(browser, my_smart_ballot_tracker_value, settings.EXPLICIT_WAIT_TIMEOUT) my_smart_ballot_tracker_link_element.click() timeout = settings.EXPLICIT_WAIT_TIMEOUT verify_step_5_and_6(browser, timeout) def test_vote_with_prepared_ballots(self): # Generate ballot for each voter console_log("### Starting step: cast_all_votes_from_csv") self.cast_all_votes_from_csv() console_log("### Step complete: cast_all_votes_from_csv") if __name__ == "__main__": if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) settings.GENERATED_FILES_DESTINATION_FOLDER = os.getenv('GENERATED_FILES_DESTINATION_FOLDER', settings.GENERATED_FILES_DESTINATION_FOLDER) settings.SKIP_ROWS_IN_CSV_FILE = int(os.getenv('SKIP_ROWS_IN_CSV_FILE', 0)) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("GENERATED_FILES_DESTINATION_FOLDER:", settings.GENERATED_FILES_DESTINATION_FOLDER) console_log("SKIP_ROWS_IN_CSV_FILE:", settings.SKIP_ROWS_IN_CSV_FILE) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/test_scenario_3.py0000644000175000017500000002320714476041226022523 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys from util.fake_sent_emails_manager import FakeSentEmailsManager from util.selenium_tools import wait_for_element_exists, wait_for_an_element_with_partial_link_text_exists from util.election_testing import strtobool, remove_database_folder, wait_a_bit, build_css_selector_to_find_buttons_in_page_content_by_value, initialize_server, initialize_browser, verify_election_consistency, create_election_data_snapshot, delete_election_data_snapshot, log_in_as_administrator, remove_election_from_database from util.election_test_base import BeleniosElectionTestBase from util.execution import console_log import settings class BeleniosTestElectionScenario1(BeleniosElectionTestBase): def setUp(self): self.fake_sent_emails_manager = FakeSentEmailsManager(settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) self.fake_sent_emails_manager.install_fake_sendmail_log_file() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: pass self.server = initialize_server() self.browser = initialize_browser() def tearDown(self): self.browser.quit() self.server.kill() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: if self.election_id: remove_election_from_database(self.election_id) self.fake_sent_emails_manager.uninstall_fake_sendmail_log_file() def administrator_does_tallying_of_election(self): browser = self.browser # Alice goes to the election page election_url = self.election_page_url # Could also be obtained with self.voters_data[self.voters_email_addresses[0]]["election_page_url"] browser.get(election_url) wait_a_bit() # She clicks on the "Administer this election" link administration_link_label = "Administer this election" administration_link_element = wait_for_an_element_with_partial_link_text_exists(browser, administration_link_label, settings.EXPLICIT_WAIT_TIMEOUT) administration_link_element.click() # She logs in as administrator log_in_as_administrator(browser, from_a_login_page=True) wait_a_bit() # She clicks on the "Close election" button close_election_button_label = "Close election" close_election_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(close_election_button_label) close_election_button_element = wait_for_element_exists(browser, close_election_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) close_election_button_element.click() wait_a_bit() # She clicks on the "Proceed to vote counting" button proceed_button_label = "Proceed to vote counting" proceed_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(proceed_button_label) proceed_button_element = wait_for_element_exists(browser, proceed_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_button_element.click() wait_a_bit() # She clicks on the "Proceed to decryption" button decrypt_button_label = "Proceed to decryption" decrypt_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(decrypt_button_label) decrypt_button_element = wait_for_element_exists(browser, decrypt_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) decrypt_button_element.click() wait_a_bit() def test_scenario_1_simple_vote(self): console_log("### Starting step: administrator_creates_election") self.administrator_creates_election(nh_question=True) console_log("### Step complete: administrator_creates_election") console_log("### Starting step: administrator_regenerates_passwords_for_some_voters") self.administrator_regenerates_passwords_for_some_voters() console_log("### Step complete: administrator_regenerates_passwords_for_some_voters") console_log("### Starting step: verify_election_consistency using `belenios_tool verify` (0)") verify_election_consistency(self.election_id) console_log("### Step complete: verify_election_consistency using `belenios_tool verify` (0)") console_log("### Starting step: all_voters_vote_in_sequences") self.all_voters_vote_in_sequences() console_log("### Step complete: all_voters_vote_in_sequences") console_log("### Starting step: verify_election_consistency using `belenios_tool verify` (1)") verify_election_consistency(self.election_id) console_log("### Step complete: verify_election_consistency using `belenios_tool verify` (1)") console_log("### Starting step: create_election_data_snapshot (0)") snapshot_folder = create_election_data_snapshot(self.election_id) console_log("### Step complete: create_election_data_snapshot (0)") try: console_log("### Starting step: some_voters_revote") self.some_voters_revote() console_log("### Step complete: some_voters_revote") console_log("### Starting step: verify_election_consistency using `belenios_tool verify-diff` (0)") verify_election_consistency(self.election_id, snapshot_folder) finally: delete_election_data_snapshot(snapshot_folder) console_log("### Step complete: verify_election_consistency using `belenios_tool verify-diff` (0)") console_log("### Starting step: verify_election_consistency using `belenios_tool verify` (2)") verify_election_consistency(self.election_id) console_log("### Step complete: verify_election_consistency using `belenios_tool verify` (2)") console_log("### Starting step: administrator_does_tallying_of_election") self.administrator_does_tallying_of_election() console_log("### Step complete: administrator_does_tallying_of_election") console_log("### Starting step: verify_election_consistency using `belenios_tool verify` (3)") verify_election_consistency(self.election_id) console_log("### Step complete: verify_election_consistency using `belenios_tool verify` (3)") console_log("### Starting step: voter votes after the election is closed") self.one_voter_revotes_after_the_election_is_closed() console_log("### Step complete: voter votes after the election is closed") if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("CLEAN_UP_POLICY:", settings.CLEAN_UP_POLICY) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/test_fuzz_vote.py0000644000175000017500000004771014476041226022536 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys import json from hypothesis import given, HealthCheck, strategies as st, settings as hypothesis_settings from util.fake_sent_emails_manager import FakeSentEmailsManager from util.selenium_tools import wait_for_element_exists, wait_for_element_exists_and_does_not_contain_expected_text from util.election_testing import strtobool, console_log, remove_database_folder, initialize_server, wait_a_bit, populate_credential_and_password_for_voters_from_sent_emails, populate_random_votes_for_voters, election_id_to_election_home_page_url, remove_election_from_database from util.execution import try_several_times from util.page_objects import ElectionHomePage, VoterLoginPage from test_scenario_2 import BeleniosTestElectionScenario2Base, initialize_browser import settings # We use a lower min_size than the real one because otherwise example data elements are way too long to generate choiceNumberAsStringDataFormat = st.text(alphabet="0123456789", min_size=10, max_size=617) # a number written in a text string. Number has between 616 and 617 digits (should probably not start with a 0) proofNumberAsStringDataFormat = st.text(alphabet="0123456789", min_size=10, max_size=78) # a number written in a text string. Number has between 77 and 78 digits (should probably not start with a 0) letters_and_digits = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" electionHashDataFormat = st.text(alphabet=letters_and_digits, min_size=43, max_size=43) electionIdDataFormat = st.text(alphabet=letters_and_digits, min_size=14, max_size=14) choiceDataFormat = st.fixed_dictionaries( { "alpha": choiceNumberAsStringDataFormat, "beta": choiceNumberAsStringDataFormat, } ) proofDataFormat = st.fixed_dictionaries( { "challenge": proofNumberAsStringDataFormat, "response": proofNumberAsStringDataFormat, } ) individualProofDataFormat = st.lists(proofDataFormat, min_size=2, max_size=2) # an array answerDataFormat = st.fixed_dictionaries( { "choices": st.lists(choiceDataFormat, min_size=2, max_size=2), # an array "individual_proofs": st.lists(individualProofDataFormat, min_size=2, max_size=2), # an array "overall_proof": st.lists(proofDataFormat, min_size=2, max_size=2), # an array } ) # a JSON object ballotDataFormat = st.fixed_dictionaries( { "answers": st.lists(answerDataFormat, min_size=1, max_size=1), # an array "election_hash": electionHashDataFormat, "election_uuid": electionIdDataFormat, "signature": st.fixed_dictionaries( { "public_key": choiceNumberAsStringDataFormat, # string representation of an integer "challenge": proofNumberAsStringDataFormat, # string representation of an integer "response": proofNumberAsStringDataFormat, # string representation of an integer } ), # a JSON object } ) # a JSON object class BeleniosTestElectionWithCreationBase(BeleniosTestElectionScenario2Base): def __init__(self, *args, **kw): super().__init__(*args, **kw) self.distant_fake_sent_emails_manager = None self.fake_sent_emails_initial_lines_count = None def setUp(self): self.fake_sent_emails_manager = FakeSentEmailsManager(settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) self.fake_sent_emails_manager.install_fake_sendmail_log_file() if settings.START_SERVER: if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION or settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.DO_NOTHING: pass self.server = initialize_server() self.browser = initialize_browser() if settings.ELECTION_ID: self.election_id = settings.ELECTION_ID else: # Download server's sent emails text file, so that we know up to which line number we have to ignore its contents (this is its last line) temporary_fake_sent_emails_manager = None try: temporary_fake_sent_emails_manager = self.download_all_sent_emails() self.fake_sent_emails_initial_lines_count = temporary_fake_sent_emails_manager.count_lines() console_log("### Initial lines count of server's fake sent emails file:", self.fake_sent_emails_initial_lines_count) finally: if temporary_fake_sent_emails_manager: temporary_fake_sent_emails_manager.uninstall_fake_sendmail_log_file() self.administrator_creates_election() console_log("### Starting step: download_all_sent_emails") self.distant_fake_sent_emails_manager = self.download_all_sent_emails() console_log("### Step complete: download_all_sent_emails") # Concatenate (distant) Belenios server's sent emails file (starting after line `fake_sent_emails_initial_lines_count`) and local credential authority's sent emails file into file `self.distant_fake_sent_emails_manager.log_file_path`, so that `self.generate_vote_ballots()` can parse it and find all information it needs. import subprocess import tempfile (file_handle, log_file_path) = tempfile.mkstemp(text=True) with open(log_file_path, 'w') as f: subprocess.run(["tail", "-n", "+" + str(self.fake_sent_emails_initial_lines_count + 1), self.distant_fake_sent_emails_manager.log_file_path], stdout=f) subprocess.run(["cat", self.fake_sent_emails_manager.log_file_path], stdout=f) subprocess.run(["cp", log_file_path, self.distant_fake_sent_emails_manager.log_file_path]) subprocess.run(["rm", "-f", log_file_path]) invited_voters_who_will_vote = random.sample(self.voters_email_addresses, settings.NUMBER_OF_VOTING_VOTERS) invited_voters_who_will_vote_data = populate_credential_and_password_for_voters_from_sent_emails(self.distant_fake_sent_emails_manager, invited_voters_who_will_vote, settings.ELECTION_TITLE) invited_voters_who_will_vote_data = populate_random_votes_for_voters(invited_voters_who_will_vote_data) self.update_voters_data(invited_voters_who_will_vote_data) selected_voter = invited_voters_who_will_vote_data[0] settings.VOTER_USERNAME = selected_voter["username"] settings.VOTER_PASSWORD = selected_voter["password"] settings.VOTER_CREDENTIAL = selected_voter["credential"] console_log("Going to vote using VOTER_USERNAME:", settings.VOTER_USERNAME) console_log("Going to vote using VOTER_PASSWORD:", settings.VOTER_PASSWORD) console_log("Going to vote using VOTER_CREDENTIAL:", settings.VOTER_CREDENTIAL) def tearDown(self): self.browser.quit() if settings.START_SERVER: self.server.kill() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: if self.election_id: remove_election_from_database(self.election_id) elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.DO_NOTHING: pass self.fake_sent_emails_manager.uninstall_fake_sendmail_log_file() if self.distant_fake_sent_emails_manager is not None: self.distant_fake_sent_emails_manager.uninstall_fake_sendmail_log_file() def download_all_sent_emails(self, target_fake_sent_emails_manager=None): from urllib.parse import urljoin import urllib.request if not target_fake_sent_emails_manager: import tempfile (file_handle, log_file_path) = tempfile.mkstemp(text=True) target_fake_sent_emails_manager = FakeSentEmailsManager(log_file_path) distant_fake_emails_file_url = urljoin(settings.SERVER_URL, settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL) # TODO: maybe we should build this URL by picking link value in alert banner on distant server home page console_log("distant_fake_emails_file_url:", distant_fake_emails_file_url) urllib.request.urlretrieve(distant_fake_emails_file_url, target_fake_sent_emails_manager.log_file_path) console_log("#### Distant fake sent emails have been saved in:", target_fake_sent_emails_manager.log_file_path) return target_fake_sent_emails_manager class BeleniosMonkeyTestFuzzVoteAdvancedMode(BeleniosTestElectionWithCreationBase): @given(st.text()) @hypothesis_settings(deadline=None) def test_submit_prepared_ballot_by_dumb_monkey(self, ballot): self.submit_prepared_ballot(ballot) @given(ballotDataFormat) @hypothesis_settings(deadline=None, suppress_health_check=[HealthCheck.large_base_example, HealthCheck.data_too_large]) def test_submit_prepared_ballot_by_smart_monkey_v2(self, ballot): try: browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT ballot['election_uuid'] = self.election_id printable_ballot = json.dumps(ballot) console_log("### Starting a new Monkey navigation that will try to submit ballot:", printable_ballot) result = self.submit_prepared_ballot(printable_ballot) if result: console_log("#### Page title was 'Password login', so we log in") # Our ballot is not detected as ill-formed, so we arrive on the log in screen console_log("#### Verify that we are on login page") login_page = VoterLoginPage(browser, timeout) login_page.verify_page() console_log("#### Filling log in form and submitting it") login_page.log_in(settings.VOTER_USERNAME, settings.VOTER_PASSWORD) console_log("#### Analyzing page title, expecting it not to be 'Unauthorized'") # If user provided a wrong username/password combination, the resulting page is a browser error page like `

Unauthorized

Error 401

` page_title_css_selector = "h1" expected_text_1 = "Authenticate with password" expected_text_2 = "Unauthorized" page_title_element = wait_for_element_exists_and_does_not_contain_expected_text(browser, page_title_css_selector, expected_text_1, timeout) page_title_element = wait_for_element_exists_and_does_not_contain_expected_text(browser, page_title_css_selector, expected_text_2, timeout) page_title_label = page_title_element.get_attribute('innerText') assert page_title_label != expected_text_1 assert page_title_label != expected_text_2 console_log("#### Page title was not 'Unauthorized', so we click on confirm ballot submission button") # We arrive on the next screen, which asks us to confirm ballot submission submit_button_css_selector = "input[type=submit]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector, timeout) submit_button_element.click() # We check wether the ballot has been received and parsed without errors @try_several_times(5) def verify_step_label(browser, current_attempt=0): console_log("#### Analyzing (attempt", current_attempt, ") whether result page (after click on confirm ballot submission button) has as step title 'Step 6/6: FAIL!' because ballot content is invalid") current_step_css_selector = "#main .current_step" current_step_element = wait_for_element_exists(browser, current_step_css_selector, timeout) current_step_label = current_step_element.get_attribute('innerText') console_log("#### Step title is:", current_step_label) if current_step_label == "Step 6/6: FAIL!": console_log("#### Page step title was 'Step 6/6: FAIL!', which is what we expected. So the full test is correct.") return current_step_label else: # Possibility of improvement: Handle very improbable case where Belenios server accepts the ballot because by chance this ballot generated by Hypothesis would be correct. For now we consider that if Belenios accepts the generated ballot (correct or incorrect), it is a test failure. Maybe also it could be necessary to better detect any case that falls outside these 2 situations. console_log("#### Step title is unexpected. So the full test is incorrect.") raise Exception("Step title is unexpected:", current_step_label) final_label = verify_step_label(browser) assert final_label == "Step 6/6: FAIL!" except Exception as e: console_log("Step title is unexpected. Exception received:", e) browser.quit() self.browser = initialize_browser() raise e def submit_prepared_ballot(self, ballot): browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT console_log("#### Going to election page") election_page_url = election_id_to_election_home_page_url(self.election_id) browser.get(election_page_url) console_log("#### Clicking on 'en' language link") election_home_page = ElectionHomePage(browser, timeout) election_home_page.click_on_language_link("en") console_log("#### Clicking on 'Advanced mode' link") election_home_page.click_on_advanced_mode_link() console_log("#### Filling ballot field with text representation of ballot and clicking on Submit button") field_css_selector = "form[action=submit-ballot] textarea[name=encrypted_vote]" field_element = wait_for_element_exists(browser, field_css_selector, timeout) field_element.clear() field_element.send_keys(ballot) field_element.submit() wait_a_bit() @try_several_times(5) def verify_page_title(browser): console_log("#### Analyzing contents of page returned after having clicked on Submit button, expecting title to be either 'Ill-formed ballot' or 'Password login'") page_title_css_selector = "#header h1" page_title_element = wait_for_element_exists(browser, page_title_css_selector) page_title_label = page_title_element.get_attribute('innerText') # Here we sometimes get a stale element. This is why we run this inside a loop with several attempts page_content_css_selector = "#main" page_content_element = wait_for_element_exists(browser, page_content_css_selector) page_content_label = page_content_element.get_attribute('innerText') console_log("#### Page title was", page_title_label, "and page content was", page_content_label) if page_title_label == "Error": assert page_content_label == "Ill-formed ballot" return page_title_label elif page_title_label == "Authenticate with password": return page_title_label else: # This case happens sometimes, because Selenium has not yet replaced its DOM with the new DOM of the page (maybe because server has not responded yet or page loading is not yet complete). # In this situation, data is still: ('Unexpected page content', 'USERNAME:\t\nPASSWORD:\t') # Or: ('Unexpected page content', 'My test election for Scenario 1', 'Username:Password:') raise Exception("Unexpected page content", page_title_label, page_content_label) try: page_title = verify_page_title(browser) assert page_title in ["Error", "Authenticate with password"] return page_title except Exception as e: console_log("Could not locate expected element. Exception received:", e) # browser.quit() # self.browser = initialize_browser() raise e if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) settings.SERVER_URL = os.getenv('SERVER_URL', settings.SERVER_URL) if os.getenv('START_SERVER', None): settings.START_SERVER = bool(strtobool(os.getenv('START_SERVER'))) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.ELECTION_ID = os.getenv('ELECTION_ID', None) or None settings.VOTER_USERNAME = os.getenv('VOTER_USERNAME', None) or None settings.VOTER_PASSWORD = os.getenv('VOTER_PASSWORD', None) or None settings.VOTER_CREDENTIAL = os.getenv('VOTER_CREDENTIAL', None) or None settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL = os.getenv('FAKE_SENT_EMAILS_FILE_RELATIVE_URL', "static/mail.txt") settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) # Do not set a value below 0.02 seconds, otherwise hypothesis test becomes flaky. settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.LOGIN_MODE = os.getenv('LOGIN_MODE', settings.LOGIN_MODE) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) console_log("SERVER_URL:", settings.SERVER_URL) console_log("START_SERVER:", settings.START_SERVER) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("FAKE_SENT_EMAILS_FILE_RELATIVE_URL:", settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("LOGIN_MODE:", settings.LOGIN_MODE) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) unittest.main(failfast=True) belenios-2.2-10-gbb6b7ea8/tests/selenium/test_fuzz_login.py0000644000175000017500000001003514476041226022657 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys from hypothesis import given import hypothesis.strategies as st from hypothesis import settings as hypothesis_settings from util.election_testing import strtobool, console_log, wait_a_bit, initialize_server from util.page_objects import ServerHomePage, VoterLoginPage, LoginFailedPage, AdministrationHomeLoggedInPage from test_scenario_2 import BeleniosTestElectionScenario2Base, initialize_browser_for_scenario_2 import settings def go_to_log_in_page(browser): # Alice has been given administrator rights on an online voting app called Belenios. She goes # to check out its homepage timeout = settings.EXPLICIT_WAIT_TIMEOUT browser.get(settings.SERVER_URL) wait_a_bit() # She verifies she is on the server home page server_home_page = ServerHomePage(browser, timeout) server_home_page.verify_page() # If a personal data policy modal appears (it does not appear after it has been accepted), she clicks on the "Accept" button server_home_page.click_on_accept_button_in_personal_data_policy_modal_if_available() # She clicks on "local" to go to the login page server_home_page.click_on_login_link(settings.LOGIN_MODE) wait_a_bit() class BeleniosMonkeyTestFuzzLogin(BeleniosTestElectionScenario2Base): def __init__(self, *args, **kw): super().__init__(*args, **kw) def setUp(self): if settings.START_SERVER: self.server = initialize_server() self.browser = initialize_browser_for_scenario_2() def tearDown(self): self.browser.quit() if settings.START_SERVER: self.server.kill() @given(st.text(), st.text()) @hypothesis_settings(deadline=None) def test_log_in(self, username, password): browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT go_to_log_in_page(browser) login_page = VoterLoginPage(browser, timeout) login_page.verify_page() login_page.log_in(username, password) try: unauthorized_page = LoginFailedPage(browser, timeout) unauthorized_page.verify_page() except Exception: administration_page = AdministrationHomeLoggedInPage(browser, timeout) administration_page.verify_page() console_log(f"### Warning: Submitting random input (\"{username}\", \"{password}\") to log in form directs to administration logged in page.") # Or should we rather re-raise an exception because it is very unlikely? if __name__ == "__main__": if not hasattr(settings, "LOGIN_MODE"): settings.LOGIN_MODE = "local" if not hasattr(settings, "START_SERVER"): settings.START_SERVER = True random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) settings.SERVER_URL = os.getenv('SERVER_URL', settings.SERVER_URL) if os.getenv('START_SERVER', None): settings.START_SERVER = bool(strtobool(os.getenv('START_SERVER'))) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) # Do not set a value below 0.02 seconds, otherwise hypothesis test becomes flaky. settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) settings.LOGIN_MODE = os.getenv('LOGIN_MODE', settings.LOGIN_MODE) console_log("SERVER_URL:", settings.SERVER_URL) console_log("START_SERVER:", settings.START_SERVER) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("LOGIN_MODE:", settings.LOGIN_MODE) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/vote_with_prepared_ballots_direct.py0000644000175000017500000000567314476041226026412 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import os import csv import json import re import urllib.request import base64 from util.election_testing import strtobool, console_log from util.execution import ConsoleLogDuration, try_several_times import settings class BeleniosVoteWithPreparedBallots(unittest.TestCase): def __init__(self, *args, **kw): super().__init__(*args, **kw) def cast_all_votes_from_csv(self): generated_files_destination_folder = settings.GENERATED_FILES_DESTINATION_FOLDER csv_file_path = os.path.join(generated_files_destination_folder, 'all_votes.csv') pat = re.compile(r'^(.+)/elections/([^/]+)/$') with open(csv_file_path, 'r', newline='') as csvfile: csvreader = csv.DictReader(csvfile, delimiter=',', quotechar='|') current_row = 0 for row in csvreader: current_row += 1 if current_row <= settings.SKIP_ROWS_IN_CSV_FILE: continue voter_email_address = row['voter_email_address'] auth_dict = { "username": voter_email_address, "password": row['voter_password'] } auth_json = json.dumps(auth_dict) auth_token = base64.b64encode(auth_json.encode()) headers = { "Content-Type": b"application/json", "Authorization": b"Bearer " + auth_token } voter_encrypted_ballot_file_name = row['voter_encrypted_ballot_file_name'] with open(os.path.join(generated_files_destination_folder, voter_encrypted_ballot_file_name), "r") as f: data = f.read().strip().encode() election_page_url = row['election_page_url'] mat = pat.match(election_page_url) prefix = mat.group(1) uuid = mat.group(2) with ConsoleLogDuration(f"Row {current_row} (voter {voter_email_address})"): req = urllib.request.urlopen(urllib.request.Request(prefix + "/api/elections/" + uuid + "/ballots", data=data, headers=headers)) if req.status != 200: console_log("failure") def test_vote_with_prepared_ballots(self): # Generate ballot for each voter console_log("### Starting step: cast_all_votes_from_csv") self.cast_all_votes_from_csv() console_log("### Step complete: cast_all_votes_from_csv") if __name__ == "__main__": settings.GENERATED_FILES_DESTINATION_FOLDER = os.getenv('GENERATED_FILES_DESTINATION_FOLDER', settings.GENERATED_FILES_DESTINATION_FOLDER) settings.SKIP_ROWS_IN_CSV_FILE = int(os.getenv('SKIP_ROWS_IN_CSV_FILE', 0)) console_log("GENERATED_FILES_DESTINATION_FOLDER:", settings.GENERATED_FILES_DESTINATION_FOLDER) console_log("SKIP_ROWS_IN_CSV_FILE:", settings.SKIP_ROWS_IN_CSV_FILE) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/test_clicker_monkey.py0000644000175000017500000003020214476041226023465 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys from urllib.parse import urljoin, urlsplit from util.election_testing import strtobool, wait_a_bit from util.page_objects import ElectionHomePage, ResponsiveBoothStep1Page, ResponsiveBoothStep2Page, ResponsiveBoothStep3Page, VoterLoginPage, NormalVoteStep6Page, BallotBoxPage from util.monkeys import SeleniumClickerMonkey, SeleniumFormFillerMonkey from util.execution import console_log from test_fuzz_vote import BeleniosTestElectionWithCreationBase import settings def verify_page_is_not_an_error_page(browser): # Belenios web server returns a "Unauthorized" "Error 401" page in several situations, for example when we pick the "local" login method and submit an empty login form. For now, we consider this behaviour as normal. # But what we consider an unexpected error is other types of errors returned by the server, for example "Internal Server Error", "Error 500". error_content = ["Internal Server Error", "Error 500", "Not Found", "Error 404"] page_source = browser.page_source if not page_source or not len(page_source): raise Exception(f"Server returned an unexpected blank page. Page source was: {page_source}") for content in error_content: if content in page_source: page_source = str(browser.page_source.encode("utf-8")) raise Exception(f"Server returned an unexpected error page. Page source was: {page_source}") def belenios_fence_filter(initial_page_url, href_value): """ A kind of geofencing: We filter out URLs which are out of the scope of the test """ target_url = urljoin(initial_page_url, href_value) # If this link points to a different host (domain name), we abort if urlsplit(target_url).hostname != urlsplit(initial_page_url).hostname: return False # We abort if this link: # - points to a downloadable element which works correctly for sure or which we don't want to test (for example because it would be tested too often or would take too much resources to download) # - is the election creation page (if monkey accesses the administration panel by logging in using the "demo" mode) # - is the election edition page (if monkey accesses the administration panel by logging in using the "demo" mode) forbidden_urls = ["belenios.tar.gz", ".bel", "/draft/new", "/draft/election?uuid="] for url in forbidden_urls: if url in target_url: return False return True def get_election_url(election_id): return "/".join([settings.SERVER_URL, "elections", election_id, ""]) class BeleniosMonkeyTestClicker(BeleniosTestElectionWithCreationBase): def test_clicker_monkey_on_election_home(self): console_log("# test_clicker_monkey_on_election_home()") browser = self.browser election_url = get_election_url(self.election_id) console_log("## Going to election page:", election_url) monkey = SeleniumClickerMonkey(browser, election_url, 0.25, belenios_fence_filter, verify_page_is_not_an_error_page) monkey.start(200) def test_sometimes_smart_monkey_votes(self): console_log("# test_sometimes_smart_monkey_votes()") browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT election_url = get_election_url(self.election_id) console_log("## Going to election page:", election_url) browser.get(election_url) wait_a_bit() console_log("## Starting clicker monkey behaviour") monkey = SeleniumClickerMonkey(browser, election_url, 0.25, belenios_fence_filter, verify_page_is_not_an_error_page) maximum_monkey_clicks = 50 monkey.start(maximum_monkey_clicks) console_log("## End of clicker monkey behaviour") console_log("## Going to election page again", election_url) browser.get(election_url) wait_a_bit() console_log("## Clicking on 'en' language link") election_home_page = ElectionHomePage(browser, timeout) election_home_page.click_on_language_link("en") wait_a_bit() console_log("## Clicking on 'Start' button") election_home_page.click_on_start_button() wait_a_bit() console_log("## Verifying that we are on step 1 page") step_1_page = ResponsiveBoothStep1Page(browser, timeout) step_1_page.verify_page() step_1_page.type_voter_credential(settings.VOTER_CREDENTIAL) step_1_page.click_next_button() wait_a_bit() step_2_page = ResponsiveBoothStep2Page(browser, timeout) step_2_page.verify_page() # Here: # We can check any checkbox for the question (check 0 to n checkboxes) # We can click on the "Next" button # We can go back. This would go back to the election home page (not to the "Step 1" page, which would probably have been the intuitive behaviour) console_log("## Answering vote question by checking randomly some checkboxes") step_2_parent_css_selector = '.question-with-votable-answers' form_filler_monkey = SeleniumFormFillerMonkey(browser, step_2_parent_css_selector) # Warning: In the DOM of the vote page, step 2, checkboxes are not in a `
`. form_filler_monkey.fill_form() console_log("## Click on the 'Next' button") step_2_page.click_next_button() wait_a_bit() console_log("## Verify that we are on step 3 and that page content is correct (ballot tracker is not empty)") step_3_page = ResponsiveBoothStep3Page(browser, timeout) step_3_page.verify_page() step_3_smart_ballot_tracker_value = step_3_page.get_smart_ballot_tracker_value() # Here: # We can click on the "Continue" button (``) # We can click on the "Restart" button (``). This goes back to step 1. console_log("## Click on the 'Continue' button") step_3_page.click_next_button() wait_a_bit() # We arrive on the login form (if we have not already logged in during this visit, which could happen if we do a complex navigation after a first login. If we have already logged in, we arrive directly on the step 5 page) console_log("## Verify that we are on login page") login_page = VoterLoginPage(browser, timeout) login_page.verify_page() # Here: # We can click on the "Login" button without filling the username nor password field # We can click on the "Login" button after having filled the username and password fields with wrong data # We can click on the "Login" button after having filled the username and password fields with correct data # We can go back. This goes back to step 3. # If we don't fill the form, or fill the form with wrong username/password, and click on the "Login" button, we arrive on an "Unauthorized" "Error 401" page. # If we fill the form with correct data and click on the "Login" button, we arrive on step 5 page. console_log("## Filling log in form and submitting it") login_page.log_in(settings.VOTER_USERNAME, settings.VOTER_PASSWORD) console_log("## Verify that we are on step 6 and that page content is correct (page contains 'has been accepted'; page contains a ballot tracker which is the same as the one we noted)") step_6_page = NormalVoteStep6Page(browser, timeout) step_6_page.verify_page(step_3_smart_ballot_tracker_value) # Here: # We can click on the Belenios logo on the top-left of the screen # We can click on a link in the footer # We can click on the "ballot box" link # We can click on the "Go back to election" link # We can go back. This goes to another page which looks like the "Advanced mode" page. This looks like a small bug. console_log("## Click on the 'ballot box' link") step_6_page.click_on_ballot_box_link() wait_a_bit() console_log("## Verify that ballot box page contains a link labelled as voter's smart ballot tracker, and click on it") ballot_box_page = BallotBoxPage(browser, timeout) ballot_box_page.verify_page(step_3_smart_ballot_tracker_value) ballot_box_page.click_on_ballot_link(step_3_smart_ballot_tracker_value) console_log("## Verify that my ballot page is not an error page") verify_page_is_not_an_error_page(browser) if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) settings.SERVER_URL = os.getenv('SERVER_URL', settings.SERVER_URL) if os.getenv('START_SERVER', None): settings.START_SERVER = bool(strtobool(os.getenv('START_SERVER'))) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.ELECTION_ID = os.getenv('ELECTION_ID', None) or None settings.VOTER_USERNAME = os.getenv('VOTER_USERNAME', None) or None settings.VOTER_PASSWORD = os.getenv('VOTER_PASSWORD', None) or None settings.VOTER_CREDENTIAL = os.getenv('VOTER_CREDENTIAL', None) or None settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL = os.getenv('FAKE_SENT_EMAILS_FILE_RELATIVE_URL', "static/mail.txt") settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) # Do not set a value below 0.02 seconds, otherwise hypothesis test becomes flaky. settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.LOGIN_MODE = os.getenv('LOGIN_MODE', settings.LOGIN_MODE) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) console_log("SERVER_URL:", settings.SERVER_URL) console_log("START_SERVER:", settings.START_SERVER) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("LOGIN_MODE:", settings.LOGIN_MODE) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) unittest.main(failfast=True) belenios-2.2-10-gbb6b7ea8/tests/selenium/util/0002755000175000017500000000000014476041226020040 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/selenium/util/state_machine.py0000644000175000017500000002712114476041226023217 0ustar stephsteph#!/usr/bin/python # coding: utf-8 from util.monkeys import SeleniumFormFillerMonkey, StateForSmartMonkey from util.page_objects import ElectionHomePage, NormalVoteStep1Page, NormalVoteStep2Page, NormalVoteStep3Page, VoterLoginPage, NormalVoteStep6Page, BallotBoxPage, UnauthorizedPage, ServerHomePage, AdvancedModeVotePage, LoginFailedPage from util.execution import console_log class ElectionHomePageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = ElectionHomePage(self.browser, self.timeout) def click_on_start_button_generator(self): def click_on_start_button(in_memory=None): self.page.click_on_language_link("en") # For the rest of the test, we need language to be English, because DOM selectors for links and buttons use English language self.page.click_on_start_button() return NormalVoteStep1PageState(self.browser, self.timeout, ElectionHomePageState) return click_on_start_button def get_all_possible_actions(self): def click_on_start_button(in_memory=None): self.page.click_on_language_link("en") # For the rest of the test, we need language to be English, because DOM selectors for links and buttons use English language self.page.click_on_start_button() return NormalVoteStep1PageState(self.browser, self.timeout, ElectionHomePageState) def click_on_en_language_link(in_memory=None): self.page.click_on_language_link("en") return self def click_on_fr_language_link(in_memory=None): self.page.click_on_language_link("fr") return self def click_on_accept_personal_data_policy_link(in_memory=None): try: if self.browser.find_element_by_link_text("Accept"): self.page.click_on_accept_personal_data_policy_link() finally: return self def click_on_advanced_mode_link(in_memory=None): self.page.click_on_advanced_mode_link() return AdvancedModeVotePageState(self.browser, self.timeout, ElectionHomePageState) def click_on_see_accepted_ballots_link(in_memory=None): self.page.click_on_see_accepted_ballots_link() return BallotBoxPageState(self.browser, self.timeout, ElectionHomePageState) return [ click_on_start_button, click_on_en_language_link, click_on_fr_language_link, click_on_accept_personal_data_policy_link, click_on_advanced_mode_link, click_on_see_accepted_ballots_link, ] class NormalVoteStep1PageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = NormalVoteStep1Page(self.browser, self.timeout) def get_all_possible_actions(self): def click_on_here_button_and_type_correct_voter_credential(in_memory=None): self.page.click_on_here_button_and_type_voter_credential(in_memory["voter_credential"]) return NormalVoteStep2PageState(self.browser, self.timeout, ElectionHomePageState) # Why previous state of step2 is not step1 ? def click_on_here_button_and_type_wrong_voter_credential(in_memory=None): self.page.click_on_here_button_and_type_wrong_voter_credential("aaa") # TODO: randomize input (fuzz). Also sometimes the second alert message is not caught, so maybe we should create a wait_* function for alerts return self def click_on_here_button_and_cancel(in_memory=None): self.page.click_on_here_button_and_cancel() return self return [ click_on_here_button_and_type_correct_voter_credential, # click_on_here_button_and_type_wrong_voter_credential, # TODO: fix flaky detection of Alert click_on_here_button_and_cancel, ] class NormalVoteStep2PageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = NormalVoteStep2Page(self.browser, self.timeout) self.form_has_been_filled = False def get_all_possible_actions(self): def click_on_next_button(in_memory=None): if self.form_has_been_filled: self.page.click_on_next_button() return NormalVoteStep3PageState(self.browser, self.timeout, ElectionHomePageState) # Why previous state of step2 is not step1 ? else: self.page.click_on_next_button_but_form_is_not_filled() return self def fill_form(in_memory=None): decided_vote = in_memory.get("voter_decided_vote", None) if decided_vote: self.page.fill_vote_form(decided_vote) else: step_2_parent_css_selector = "#question_div" form_filler_monkey = SeleniumFormFillerMonkey(self.browser, step_2_parent_css_selector) # Warning: In the DOM of the vote page, step 2, checkboxes are not in a ``. form_filler_monkey.fill_form() self.form_has_been_filled = True return self return [ click_on_next_button, fill_form ] class NormalVoteStep3PageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = NormalVoteStep3Page(self.browser, self.timeout) self.smart_ballot_tracker = None def save_smart_ballot_tracker_value(self, in_memory): self.smart_ballot_tracker = self.page.get_smart_ballot_tracker_value() in_memory["voter_temporary_smart_ballot_tracker"] = self.smart_ballot_tracker def get_all_possible_actions(self): def click_on_restart_button(in_memory): self.page.click_on_restart_button() return NormalVoteStep1PageState(self.browser, self.timeout, ElectionHomePageState) def click_on_continue_button(in_memory): self.save_smart_ballot_tracker_value(in_memory) self.page.click_on_continue_button() return NormalVoteLoginPageState(self.browser, self.timeout, NormalVoteStep1PageState) # Why previous state of login step (which is the fourth step) is not step3? return [ click_on_restart_button, click_on_continue_button, ] class NormalVoteLoginPageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = VoterLoginPage(self.browser, self.timeout) self.form_is_filled_with_correct_data = False def get_all_possible_actions(self): def fill_form_with_wrong_data(in_memory=None): self.page.fill_form("aaa", "aaa") # TODO: randomize input (fuzz) self.form_is_filled_with_correct_data = False return self def fill_form_with_correct_data(in_memory): self.page.fill_form(in_memory["voter_username"], in_memory["voter_password"]) self.form_is_filled_with_correct_data = True return self def click_on_login_button(in_memory=None): self.page.click_on_login_button() if self.form_is_filled_with_correct_data: in_memory["voter_has_logged_in"] = True return NormalVoteStep6PageState(self.browser, self.timeout, NormalVoteLoginPageState) else: return LoginFailedPageState(self.browser, self.timeout, NormalVoteLoginPageState) def click_on_logo_image(in_memory=None): self.page.click_on_logo_image() return ServerHomePageState(self.browser, self.timeout, NormalVoteLoginPageState) return [ fill_form_with_wrong_data, fill_form_with_correct_data, click_on_login_button, click_on_logo_image, ] class UnauthorizedPageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = UnauthorizedPage(self.browser, self.timeout) def get_all_possible_actions(self): return [] class LoginFailedPageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = LoginFailedPage(self.browser, self.timeout) def get_all_possible_actions(self): def click_on_logo_image(in_memory=None): self.page.click_on_logo_image() return ServerHomePageState(self.browser, self.timeout, LoginFailedPageState) def click_on_try_to_log_in_again_link(in_memory=None): self.page.click_on_try_to_log_in_again_link() return NormalVoteLoginPageState(self.browser, self.timeout, NormalVoteLoginPageState) return [ click_on_logo_image, click_on_try_to_log_in_again_link, ] class ServerHomePageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = ServerHomePage(self.browser, self.timeout) def get_all_possible_actions(self): return [] class NormalVoteStep6PageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = NormalVoteStep6Page(self.browser, self.timeout) self.previous_state_class = AdvancedModeVotePageState # Why is it so? (Is it because as our vote has been confirmed, step5 has no meaning anymore? Then we should probably find a better replacement) def verify_page(self, in_memory): console_log("NormalVoteStep6PageState::verify_page()") return self.page.verify_page(in_memory["voter_temporary_smart_ballot_tracker"]) def get_all_possible_actions(self): def click_on_ballot_box_link(in_memory=None): self.click_on_ballot_box_link() return BallotBoxPageState(self.browser, self.timeout, NormalVoteStep6PageState) def click_on_go_back_to_election_link(in_memory=None): self.page.click_on_go_back_to_election_link() return ElectionHomePageState(self.browser, self.timeout, AdvancedModeVotePageState) # Why is it so? It seems to be because all cookies are deleted, so server does not know anything anymore about user session state return [ click_on_ballot_box_link, click_on_go_back_to_election_link, ] class BallotBoxPageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = BallotBoxPage(self.browser, self.timeout) def verify_page(self, in_memory): console_log("BallotBoxPageState::verify_page()") smart_ballot_tracker = in_memory.get("voter_validated_smart_ballot_tracker", None) return self.page.verify_page(smart_ballot_tracker) def get_all_possible_actions(self): def click_on_go_back_to_election_link(in_memory=None): self.page.click_on_go_back_to_election_link() return ElectionHomePageState(self.browser, self.timeout) return [ click_on_go_back_to_election_link ] class AdvancedModeVotePageState(StateForSmartMonkey): def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self.page = AdvancedModeVotePage(self.browser, self.timeout) def get_all_possible_actions(self): def click_on_back_to_election_home_link(in_memory=None): self.page.click_on_back_to_election_home_link() return ElectionHomePageState(self.browser, self.timeout) return [ click_on_back_to_election_home_link, ] # TODO: other available actions belenios-2.2-10-gbb6b7ea8/tests/selenium/util/execution.py0000644000175000017500000000444514476041226022422 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import time from functools import partial, wraps def console_log(*args, **kwargs): print(*args, **kwargs, flush=True) class PrintDuration: """ Prints time elapsed during an operation. Prints title of the operation, when its execution starts and ends. When it ends, it also prints the total time elapsed between start and end. This class is meant to be used as a With Statement Context Manager. Here is an example: ``` with PrintDuration("My task"): calling_a_function(parameters) ``` """ def __init__(self, title=None, print_function=None): self.title = title or "Operation" if print_function is None: self.print_function = print else: self.print_function = print_function def __enter__(self): self.timing1 = time.perf_counter() self.print_function(self.title + ": Starting execution") def __exit__(self, exc_type, exc_val, exc_tb): timing2 = time.perf_counter() self.print_function(self.title + ": Execution complete. Duration: " + str(timing2 - self.timing1) + " seconds") """ A particular case of PrintDuration, which uses `console_log()` as its `print_function`. This class is meant to be used as a With Statement Context Manager. Here is an example: ``` with ConsoleLogDuration("My task"): calling_a_function(parameters) ``` """ ConsoleLogDuration = partial(PrintDuration, print_function=console_log) def try_several_times(max_attempts, sleep_duration=1): """ This is a Python decorator. `sleep_duration` is in seconds """ def decorator_try_several_times(func): @wraps(func) def wrapper_try_several_times(*args, **kwargs): current_attempt = 1 while(current_attempt <= max_attempts): try: return func(*args, **kwargs) except Exception as e: console_log(f"Attempt {current_attempt} of {max_attempts} failed. Error was: {e}") current_attempt += 1 time.sleep(sleep_duration) if current_attempt > max_attempts: raise Exception(f"Error. Failed after {current_attempt-1} attempts.") return wrapper_try_several_times return decorator_try_several_times belenios-2.2-10-gbb6b7ea8/tests/selenium/util/monkeys.py0000644000175000017500000003006314476041226022077 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import random from urllib.parse import urljoin, urlsplit from selenium.common.exceptions import NoAlertPresentException from time import sleep from util.election_testing import wait_a_bit from util.execution import console_log from util.selenium_tools import representation_of_element, element_is_visible_filter def get_link_element_url(link_element): return link_element.get_attribute('href') def fence_filter_for_links_generator(fence_filter_function, initial_page_url): def inner(link_element): link_url = get_link_element_url(link_element) return fence_filter_function(initial_page_url, link_url) return inner def get_all_visible_links(browser): all_links = browser.find_elements_by_css_selector("a[href]") displayed_links = list(filter(element_is_visible_filter, all_links)) return displayed_links def get_all_clickable_elements_in_page(browser, fence_filter_function, initial_page_url): return get_all_clickable_links_in_page(browser, fence_filter_function, initial_page_url) + get_all_buttons_in_page(browser) def get_all_clickable_links_in_page(browser, fence_filter_function, initial_page_url): all_visible_links = get_all_visible_links(browser) fence_filter_for_links = fence_filter_for_links_generator(fence_filter_function, initial_page_url) accepted_links = list(filter(fence_filter_for_links, all_visible_links)) return accepted_links def get_all_buttons_in_page(browser): all_input_type_submit_buttons = browser.find_elements_by_css_selector("button, input[type=submit]") # Possible improvement: Are there other possible types of buttons we should detect? Not in Belenios. Maybe file browse buttons, but these are special. displayed_elements = list(filter(element_is_visible_filter, all_input_type_submit_buttons)) return displayed_elements def get_all_input_type_checkbox_elements(browser_or_parent_element): all_input_type_checkbox = browser_or_parent_element.find_elements_by_css_selector("label") displayed_elements = list(filter(element_is_visible_filter, all_input_type_checkbox)) return displayed_elements def verify_page_is_not_an_error_page(browser): error_content = ["Internal Server Error", "Unauthorized", "Error 500", "Error 401"] page_source = browser.page_source for content in error_content: if content in page_source: page_source = str(browser.page_source.encode("utf-8")) raise Exception(f"Server returned an unexpected error page. Page source was: {page_source}") def default_fence_filter(initial_page_url, href_value): target_url = urljoin(initial_page_url, href_value) # If this link points to a different host (domain name), we abort if urlsplit(target_url).hostname != urlsplit(initial_page_url).hostname: return False class SeleniumClickerMonkey(): def __init__(self, browser, initial_page_url, probability_to_go_back=0.25, fence_filter_function=None, verify_page_is_not_an_error_page_function=None): self.browser = browser self.initial_page_url = initial_page_url self.probability_to_go_back = probability_to_go_back if fence_filter_function is None: self.fence_filter_function = default_fence_filter else: self.fence_filter_function = fence_filter_function if verify_page_is_not_an_error_page_function is None: self.verify_page_is_not_an_error_page_function = verify_page_is_not_an_error_page else: self.verify_page_is_not_an_error_page_function = verify_page_is_not_an_error_page_function def go_back(self): self.browser.back() wait_a_bit() self.handle_alerts() wait_a_bit() def handle_alerts(self): looking_for_alert = True while looking_for_alert: try: alert = self.browser.switch_to.alert console_log("* We encounter an Alert") random_result3 = random.random() if random_result3 < 0.5: console_log("* We decide to accept the Alert") alert.accept() else: console_log("* We decide to dismiss the Alert") alert.dismiss() sleep(1) except NoAlertPresentException: looking_for_alert = False def start(self, maximum_actions_in_visit=100): """ Warning: Do not set a very high value to `maximum_actions_in_visit`. This is because some links clicked by the monkey trigger a download confirmation modal. There seems to be no way in Selenium to click cancel in this modal. As we don't tell the monkey to accept the download (we don't want to), the monkey continues its navigation with the modal still open. Modals stack. You can avoid some or all downloads by customizing your fence function. """ # Possibility of improvement: Detect also when a button (not only a link) redirects to a page which is outside of the fence filter probability_to_go_back_when_dead_end = 1 # 0.25 console_log("## First action in visit goes to page:", self.initial_page_url) self.browser.get(self.initial_page_url) current_actions_in_visit = 1 while current_actions_in_visit < maximum_actions_in_visit: current_actions_in_visit += 1 console_log("## current_actions_in_visit:", current_actions_in_visit) if self.verify_page_is_not_an_error_page_function: self.verify_page_is_not_an_error_page_function(self.browser) random_result = random.random() if random_result < self.probability_to_go_back: if current_actions_in_visit > 2: console_log("### Deciding to go back") self.go_back() else: clickable_elements = get_all_clickable_elements_in_page(self.browser, self.fence_filter_function, self.initial_page_url) if not len(clickable_elements): console_log("### No more clickable element to click on.") random_result2 = random.random() if random_result2 < probability_to_go_back_when_dead_end: console_log("### Deciding to go back") self.go_back() continue else: console_log("### Deciding to end visit here.") break else: selected_element = random.choice(clickable_elements) console_log("### We choose randomly this element:", representation_of_element(selected_element)) selected_element.click() wait_a_bit() self.handle_alerts() console_log("### SeleniumClickerMonkey visit is now complete.") class SeleniumFormFillerMonkey(): def __init__(self, browser, form_css_selector="form"): self.browser = browser self.form_css_selector = form_css_selector def fill_form(self): form_element = self.browser.find_element_by_css_selector(self.form_css_selector) all_input_type_checkbox_elements = get_all_input_type_checkbox_elements(form_element) # v1: This does not work when monkey checks zero checkbox, because in this case Belenios displays an Alert saying that voter is forced to check at least one checkbox # probability_to_click_a_checkbox = 0.5 # for element in all_input_type_checkbox_elements: # random_result = random.random() # console_log("fill_form random_result:", random_result) # if random_result < probability_to_click_a_checkbox: # console_log("clicking element", representation_of_element(element)) # element.click() # v2: Define a random number of checkboxes to check, X, between 1 and the number of checkboxes. Pick X checkboxes at random and check them. if len(all_input_type_checkbox_elements) > 0: number_of_checkboxes_to_check = random.randint(1, len(all_input_type_checkbox_elements)) checkboxes_to_check = random.sample(all_input_type_checkbox_elements, number_of_checkboxes_to_check) for element in checkboxes_to_check: console_log("clicking element", representation_of_element(element)) if not element.is_selected(): element.click() # TODO: handle other types of form fields (examples: input[type=text], input[type=password], textarea, input[type=file], input[type=radio]) # def click_on_submit_button(self): # form_element = self.browser.find_element_by_css_selector(self.form_css_selector) # submit_button = form_element.find_element_by_css_selector("input[type=submit]") # submit_button.click() class StateForSmartMonkey(): def __init__(self, browser, timeout, previous_state_class=None): # console_log("StateForSmartMonkey::__init__() with previous_state_class:", previous_state_class) self.browser = browser self.timeout = timeout self.previous_state_class = previous_state_class self.page = None def go_back(self): if not self.previous_state_class: raise NotImplementedError() self.browser.back() return self.previous_state_class(self.browser, self.timeout) def get_all_possible_actions(self): raise NotImplementedError() # or return [] def verify_page(self, in_memory): """ Child classes can override this method and make use of `in_memory` parameter to pass necessary data to `self.page.verify_page()`. """ if self.page: return self.page.verify_page() class SmartMonkeyWithMemoryAndKnownStateMachine(): def __init__(self, initial_state, in_memory=None, probability_to_go_back=0.15, verbose=False): self.current_state = initial_state self.probability_to_go_back = probability_to_go_back if in_memory: self.in_memory = in_memory else: self.in_memory = dict() self.verbose = verbose def get_memory(self): return self.in_memory def get_memory_element(self, key, default_value=None): return self.in_memory.get(key, default_value) def set_memory_element(self, key, value): self.in_memory[key] = value def go_back(self): if self.verbose: console_log("Trying to go back") try: self.current_state = self.current_state.go_back() return "go_back" except Exception as e: raise Exception("Failed going back.") from e def execute_a_random_action(self): """ Returns the name of the action which has been randomly chosen and executed. """ if random.random() < self.probability_to_go_back: try: return self.go_back() except Exception as e: console_log("Failed going back. Trying something else. Exception was:", e) possible_actions = self.current_state.get_all_possible_actions() if self.verbose: console_log("possible_actions:", [action.__name__ for action in possible_actions]) if len(possible_actions): random_action = random.choice(possible_actions) if self.verbose: console_log("action picked at random:", random_action.__name__) self.current_state = random_action(in_memory=self.in_memory) return random_action.__name__ else: if self.verbose: console_log("List of possible actions is empty. Trying to go back") try: return self.go_back() except Exception as e: raise Exception("Cannot execute a random action, because list of posible actions is empty, and cannot go back.") from e def has_possible_actions(self): possible_actions = self.current_state.get_all_possible_actions() return len(possible_actions) > 0 def verify_page(self): return self.current_state.verify_page(in_memory=self.in_memory) belenios-2.2-10-gbb6b7ea8/tests/selenium/util/election_testing.py0000644000175000017500000012213114476041226023747 0ustar stephsteph#!/usr/bin/python # -*- coding: utf-8 -* import time import string import random import os import shutil import subprocess import re import json from selenium import webdriver from selenium.webdriver.common.keys import Keys from selenium.common.exceptions import NoSuchElementException from util.selenium_tools import wait_for_element_exists, wait_for_element_exists_and_contains_expected_text, wait_for_an_element_with_partial_link_text_exists, verify_element_label, wait_for_element_exists_and_attribute_contains_expected_text, wait_until_page_url_changes from util.execution import console_log import settings def strtobool(s): if s in ("y", "yes", "t", "true", "on", "1"): return True if s in ("n", "no", "f", "false", "off", "0"): return False raise ValueError("cannot interpret {} as a boolean".format(s)) def random_email_addresses_generator(size=20): res = [] for x in range(size): res.append(random_email_address_generator()) return res def random_email_address_generator(): return random_generator() + "@example.org" def random_generator(size=20, chars=string.ascii_lowercase + string.digits): return ''.join(random.choice(chars) for x in range(size)) # Yield successive n-sized # chunks from l. def divide_chunks(l, n): # looping till length l for i in range(0, len(l), n): yield l[i:i + n] def populate_credential_and_password_for_voters_from_sent_emails(fake_sent_emails_manager, voters_email_addresses, election_title): """ Reads the file that gathers all sent emails to find, for each voter provided in array voters_email_addresses, their credential and their latest sent password. Returns an array, where each element is a dictionary with fields "email_address", "credential", "election_page_url", "username", and "password". :return: array """ result = [] sent_emails = fake_sent_emails_manager.separate_sent_emails() for voter_email_address in voters_email_addresses: # Step 1: Gather all emails that have been sent to this voter's email address emails_to_selected_voter = [x for x in sent_emails if x["to"] == voter_email_address] if len(emails_to_selected_voter) == 0: raise Exception("No sent email found to voter " + voter_email_address) # Step 2: Find email sent to this voter that contains credentials, and extract useful information (credential, election page URL) credential_email_subject_to_look_for = "Your credential for election " + election_title emails_with_credential = [x for x in emails_to_selected_voter if x["subject"] == credential_email_subject_to_look_for] if len(emails_with_credential) == 0: raise Exception("No credential email found for voter " + voter_email_address) email_with_credential = emails_with_credential[0] voter_credential = "" match = re.search(r'^Credential: (.*)$', email_with_credential["full_content"], re.MULTILINE) if match: voter_credential = match.group(1) else: raise Exception("Credential not found in credential email for voter " + voter_email_address) election_page_url = "" # In this scenario, it looks like all voters receive the same election page URL. Maybe in different scenarios, voters will not all receive the same vote URL (for the same election). match = re.search(r'^Page of the election: (.*)$', email_with_credential["full_content"], re.MULTILINE) if match: election_page_url = match.group(1) else: raise Exception("Election page URL not found in credential email for voter " + voter_email_address) # Step 3: Find email sent to this voter that contains their password for this election, and extract useful information (username, password) password_email_subject_to_look_for = "Your password for election " + election_title emails_with_password = [x for x in emails_to_selected_voter if x["subject"] == password_email_subject_to_look_for] if len(emails_with_password) == 0: raise Exception("Password email not found for voter " + voter_email_address) email_with_password = emails_with_password[-1] # We select the last password email received, because user's password may have been regenerated and sent several times voter_password = "" match = re.search(r'^Password: (.*)$', email_with_password["full_content"], re.MULTILINE) if match: voter_password = match.group(1) else: raise Exception("Password not found in password email for voter " + voter_email_address) voter_username = "" match = re.search(r'^Username: (.*)$', email_with_password["full_content"], re.MULTILINE) if match: voter_username = match.group(1) else: raise Exception("Username not found in password email for voter " + voter_email_address) # Step 4: Insert all extracted information into returned array element = {} element["email_address"] = voter_email_address element["credential"] = voter_credential element["election_page_url"] = election_page_url element["username"] = voter_username.replace("=40", "@") # Hack for encoding, until we manage encoding better element["password"] = voter_password result.append(element) return result def populate_random_votes_for_voters(voters): for voter in voters: # Voter can't cast their vote when all choices are unselected (an alert shows, saying "You must select at least 1 answer(s)"). So there must be at least one checked answer. answer1 = random.choice([True, False]) answer2 = random.choice([True, False]) if not answer1 and not answer2: select_answer1 = random.choice([True, False]) if select_answer1: answer1 = True else: answer2 = True voter.update({ "votes": { "question1": { "answer1": answer1, "answer2": answer2 } } }) return voters def repopulate_vote_confirmations_for_voters_from_sent_emails(fake_sent_emails_manager, voters_with_credentials, election_title): sent_emails = fake_sent_emails_manager.separate_sent_emails() for voter in voters_with_credentials: voter_email_address = voter["email_address"] # Step 1: Gather all emails that have been sent to this voter's email address emails_to_selected_voter = [x for x in sent_emails if x["to"] == voter_email_address] if len(emails_to_selected_voter) == 0: raise Exception("No sent email found to voter " + voter_email_address) # Step 2: Find email sent to this voter that contains vote confirmation, and extract useful information (smart ballot tracker) """ The received email looks like this: Content-type: text/plain; charset="UTF-8" Content-transfer-encoding: quoted-printable From: Belenios public server To: "A6QKLFSL0TTJ05XE2LHD@example.org" Subject: Your vote for election My test election for Scenario 1 MIME-Version: 1.0 X-Mailer: OcamlNet (ocamlnet.sourceforge.net) Date: Fri, 09 Nov 2018 21:40:39 +0100 Dear A6QKLFSL0TTJ05XE2LHD=40example.org, Your vote for election My test election for Scenario 1 has been recorded. Your smart ballot tracker is jaSjEsICnqaVYcFIkfcdajCZbpwaR0QmHZouYUwabuc {This vote replaces any previous vote.} You can check its presence in the ballot box, accessible at http://localhost:8001/elections/imkV1i7hUR4dV3/ballots Results will be published on the election page http://localhost:8001/elections/imkV1i7hUR4dV3/ --=20 (Where {...} means this string appears only in some cases, namely only if this notification corresponds to a re-vote) """ vote_confirmation_email_subject_to_look_for = "Your vote for election " + election_title emails_with_vote_confirmation = [x for x in emails_to_selected_voter if x["subject"] == vote_confirmation_email_subject_to_look_for] if len(emails_with_vote_confirmation) == 0: raise Exception("No vote confirmation email found for voter " + voter_email_address) email_with_vote_confirmation = emails_with_vote_confirmation[-1] # If voter received several vote confirmation emails (which happens when they revote), select the last one voter_smart_ballot_confirmation = "" match = re.search(r'Your smart ballot tracker is\s*(\S+)\s', email_with_vote_confirmation["full_content"], re.MULTILINE | re.DOTALL) if match: voter_smart_ballot_confirmation = match.group(1) voter_smart_ballot_confirmation = voter_smart_ballot_confirmation.strip() else: raise Exception("Smart ballot tracker not found in vote confirmation email for voter " + voter_email_address) voter["smart_ballot_tracker_in_vote_confirmation_email"] = voter_smart_ballot_confirmation return voters_with_credentials def remove_database_folder(): shutil.rmtree(os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, settings.DATABASE_FOLDER_PATH_RELATIVE_TO_GIT_REPOSITORY), ignore_errors=True) def remove_election_from_database(election_id): shutil.rmtree(os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, settings.DATABASE_FOLDER_PATH_RELATIVE_TO_GIT_REPOSITORY, election_id), ignore_errors=True) def remove_credentials_files(credential_file_id): if credential_file_id: for extension in [".privcreds", ".pubcreds"]: os.remove(credential_file_id + extension) def wait_a_bit(): if settings.WAIT_TIME_BETWEEN_EACH_STEP > 0: time.sleep(settings.WAIT_TIME_BETWEEN_EACH_STEP) def build_css_selector_to_find_buttons_in_page_content_by_value(expected_value): return "#main input[value='" + expected_value + "']" # A more precise use case would be "#main form input[type=submit][value='...']" def find_button_in_page_content_by_value(browser, expected_value): css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(expected_value) return browser.find_element_by_css_selector(css_selector) def find_buttons_in_page_content_by_value(browser, expected_value): css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(expected_value) return browser.find_elements_by_css_selector(css_selector) def initialize_server(): server_path = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, settings.SERVER_EXECUTABLE_FILE_PATH_RELATIVE_TO_GIT_REPOSITORY) fake_sendmail_absolute_path = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, settings.FAKE_SENDMAIL_EXECUTABLE_FILE_PATH_RELATIVE_TO_GIT_REPOSITORY) custom_environment_variables = dict(os.environ, BELENIOS_SENDMAIL=fake_sendmail_absolute_path) server = subprocess.Popen([server_path], stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True, env=custom_environment_variables) try: out, err = server.communicate(timeout=1) raise Exception("Error while trying to run the Belenios server: " + err) except subprocess.TimeoutExpired: # Server process has not exited yet, so we suppose it is working correctly. For example: When port is already in use, server process exits quickly, with error details in its stderr console_log("Server process has not exited yet, so we suppose it is working correctly") return server def initialize_browser(for_scenario_2=False): browser = None profile = webdriver.FirefoxProfile() profile.set_preference("intl.accept_languages", "en-us") if for_scenario_2: # Test Scenario 2 requires users to download things from their browser. # Define a custom profile for Firefox, to automatically download files that a page asks user to download, without asking. This is because Selenium can't control downloads. profile.set_preference('browser.download.folderList', 2) # Can be set to either 0, 1, or 2. When set to 0, Firefox will save all files downloaded via the browser on the user's desktop. When set to 1, these downloads are stored in the Downloads folder. When set to 2, the location specified for the most recent download is utilized again. profile.set_preference('browser.download.manager.showWhenStarting', False) profile.set_preference('browser.download.dir', settings.BROWSER_DOWNLOAD_FOLDER) mime_types_that_should_be_downloaded = ['text/plain', 'application/json'] profile.set_preference('browser.helperApps.neverAsk.saveToDisk', ';'.join(mime_types_that_should_be_downloaded)) if settings.USE_HEADLESS_BROWSER: from selenium.webdriver.firefox.options import Options options = Options() options.add_argument("--headless") options.log.level = "trace" browser = webdriver.Firefox(profile, options=options) else: browser = webdriver.Firefox(profile) # browser.maximize_window() # make the browser window use all available screen space. FIXME: When enabled, some clicks are not triggered anymore browser.implicitly_wait(settings.WAIT_TIME_BETWEEN_EACH_STEP) # In seconds return browser def election_page_url_to_election_id(election_page_url): """ From an election page URL like `http://localhost:8001/elections/JwCoBvR7thYcBG/`, we extract its UUID like `JwCoBvR7thYcBG`. """ election_uuid = None match = re.search(r'/elections/(.+)/$', election_page_url) if match: election_uuid = match.group(1) else: raise Exception("Could not extract UUID from this election page URL: ", election_page_url) return election_uuid def election_id_to_election_home_page_url(election_id): return "/".join([settings.SERVER_URL, "elections", election_id, ""]) def admin_election_draft_page_url_to_election_id(election_page_url): """ From an election page URL like `http://localhost:8001/draft/credentials?token=k3GDN78v16etPW&uuid=3YbExvoPyAyujZ`, we extract its UUID like `3YbExvoPyAyujZ`. """ election_uuid = None match = re.search(r'uuid=(.+)$', election_page_url) if match: election_uuid = match.group(1) else: raise Exception("Could not extract UUID from this election page URL: ", election_page_url) return election_uuid def verify_election_consistency(election_id, snapshot_folder=None): """ :param snapshot_folder: Optional parameter. If provided, it will verify consistency of differences (evolution) between this snapshot folder and current election database folder """ election_folder = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, settings.DATABASE_FOLDER_PATH_RELATIVE_TO_GIT_REPOSITORY, election_id) verification_tool_path = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, "_run/tool-debug/bin/belenios-tool") command = [verification_tool_path, "election", "verify"] if snapshot_folder: command = [verification_tool_path, "election", "verify-diff", "--dir1=" + snapshot_folder, "--dir2=" + election_folder] running_process = subprocess.Popen(command, cwd=election_folder, stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True) process_timeout = 15 # seconds try: outs, errs = running_process.communicate(timeout=process_timeout) # It looks like all output of this program is in stderr match = re.search(r'^I: all (checks|tests) passed!?$', errs, re.MULTILINE) if match: console_log("Verification of election consistency has been correctly processed") assert match else: raise Exception("Error: Verification of election consistency is wrong. STDOUT was: " + outs + " STDERR was:" + errs) except subprocess.TimeoutExpired: running_process.kill() outs, errs = running_process.communicate() raise Exception("Error: Verification took longer than " + process_timeout + " seconds. STDOUT was: " + outs + " STDERR was:" + errs) def belenios_tool_generate_credentials(election_id, voters, nh_question=False): """ Use local CLI belenios-tool to generate a number of credentials corresponding to the number of voters. Example: ``` ./_run/tool-debug/bin/belenios-tool setup generate-credentials --uuid dmGuNVL1meanZt --group Ed25519 --count 5 5 private credentials with ids saved to ./1579802689.privcreds 5 public credentials saved to ./1579802689.pubcreds 5 hashed public credentials with ids saved to ./1579802689.hashcreds ``` """ generated_files_destination_folder = settings.GENERATED_FILES_DESTINATION_FOLDER voters_file = os.path.join(generated_files_destination_folder, "voters.txt") number_of_voters = len(voters.split()) with open(voters_file, "w") as f: f.write(voters) belenios_tool_path = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, "_run/tool-debug/bin/belenios-tool") crypto_group = "Ed25519" command = [belenios_tool_path, "setup", "generate-credentials", "--uuid", election_id, "--group", crypto_group, "--file", "voters.txt"] running_process = subprocess.Popen(command, cwd=generated_files_destination_folder, stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True) process_timeout = 15 * number_of_voters # seconds credential_file_id = None try: outs, errs = running_process.communicate(timeout=process_timeout) # It looks like all output of this program is in stderr match = re.search(r'private credentials with ids saved to \./(.+)\.privcreds', outs, re.MULTILINE) if match: assert match console_log("Credentials have been generated successfully") credential_file_id = match.group(1) else: raise Exception("Error: Credentials generation went wrong. STDOUT was: " + outs + " STDERR was:" + errs) except subprocess.TimeoutExpired: running_process.kill() outs, errs = running_process.communicate() raise Exception("Error: Credentials generation took longer than " + process_timeout + " seconds. STDOUT was: " + outs + " STDERR was:" + errs) return os.path.join(generated_files_destination_folder, credential_file_id) def belenios_tool_generate_ballots(voters_data, global_credential_file_id, vote_page_url): generated_files_destination_folder = settings.GENERATED_FILES_DESTINATION_FOLDER belenios_tool_path = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, "_run/tool-debug/bin/belenios-tool") i = 0 for k, v in voters_data.items(): i += 1 # Write voter private credential to its own file voter_credential_file = os.path.join(generated_files_destination_folder, "voter_row_" + str(i) + "_privcred.txt") with open(voter_credential_file, "w") as f: f.write(v["credential"]) # Write array of voter's answers to questions in a file: This is his non-encrypted ballot, written as a JSON array where each element is the answer to the `i`th question. This answer is itself an array of zeros or ones depending on whether voter checked or not the checkbox corresponding to this answer. voter_uncrypted_ballot_file = os.path.join(generated_files_destination_folder, "voter_row_" + str(i) + "_uncrypted_ballot.json") voter_uncrypted_ballot_content = json.dumps(convert_voter_votes_to_json_uncrypted_ballot(v)) console_log("voter_uncrypted_ballot_file:", voter_uncrypted_ballot_file) try: with open(voter_uncrypted_ballot_file, 'w') as myfile: myfile.write(voter_uncrypted_ballot_content) except Exception as e: raise Exception("Error: Could not write voter's answers (his uncrypted ballot) to a file.") from e # Execute belenios-tool to generate a vote ballot for voter voter_crypted_ballot_file = "voter_row_" + str(i) + "_crypted_ballot.json" command = [belenios_tool_path, "election", "generate-ballot", "--url", vote_page_url, "--privcred", voter_credential_file, "--ballot", voter_uncrypted_ballot_file, ">", voter_crypted_ballot_file] running_process = subprocess.Popen(" ".join(command), cwd=generated_files_destination_folder, stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True, shell=True) process_timeout = 120 # seconds try: outs, errs = running_process.communicate(timeout=process_timeout) except subprocess.TimeoutExpired: running_process.kill() outs, errs = running_process.communicate() raise Exception("Error: Generation of voter's encrypted ballot file took longer than " + str(process_timeout) + " seconds. STDOUT was: " + outs + " STDERR was:" + errs) def convert_voter_votes_to_json_uncrypted_ballot(voter): answer1 = 1 if voter["votes"]["question1"]["answer1"] is True else 0 answer2 = 1 if voter["votes"]["question1"]["answer2"] is True else 0 return [[answer1, answer2]] def create_election_data_snapshot(election_id): election_folder = os.path.join(settings.GIT_REPOSITORY_ABSOLUTE_PATH, settings.DATABASE_FOLDER_PATH_RELATIVE_TO_GIT_REPOSITORY, election_id) process = subprocess.Popen(["mktemp", "-d"], stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True) out, err = process.communicate(timeout=2) temporary_folder_absolute_path = None match = re.search(r'^\s*(\S+)\s*$', out) if match: temporary_folder_absolute_path = match.group(1) else: raise Exception("Could not extract absolute path from output of mktemp:", out) subprocess.run(["cp", election_id + ".bel", temporary_folder_absolute_path], cwd=election_folder) # TODO: Execute a command that works on other OS, like `shutil.copy()` return temporary_folder_absolute_path def delete_election_data_snapshot(snapshot_folder): subprocess.run(["rm", "-rf", snapshot_folder]) # TODO: Execute a command that works on other OS, like `shutil.rmtree()` def accept_data_policy_if_present(browser): # If a personal data policy modal appears (it does not appear after it has been accepted), she clicks on the "Accept" button accept_button_label = "Accept" try: button_elements = find_buttons_in_page_content_by_value(browser, accept_button_label) if len(button_elements) == 1: button_elements[0].click() return True except NoSuchElementException: pass return False def log_in_as_administrator(browser, from_a_login_page=False): if from_a_login_page: local_login_link_label = settings.LOGIN_MODE local_login_link_element = wait_for_an_element_with_partial_link_text_exists(browser, local_login_link_label, settings.EXPLICIT_WAIT_TIMEOUT) local_login_link_element.click() else: # Alice has been given administrator rights on an online voting app called Belenios. She goes # to check out its homepage browser.get(settings.SERVER_URL) wait_a_bit() # She notices the page title mentions an election # TODO: Should we wait for the page to load here? It looks like we don't need to. assert 'Belenios' in browser.title, "Browser title was: " + browser.title # She clicks on "local" to go to the login page login_link_css_selector = "#login_" + settings.LOGIN_MODE login_element = wait_for_element_exists(browser, login_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) login_element.click() wait_a_bit() # She enters her identifier and password and submits the form to log in login_form_username_value = settings.ADMINISTRATOR_USERNAME login_form_password_value = settings.ADMINISTRATOR_PASSWORD login_form_username_css_selector = '#main form input[name=username]' login_form_password_css_selector = '#main form input[name=password]' login_form_username_element = wait_for_element_exists(browser, login_form_username_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) login_form_password_element = wait_for_element_exists(browser, login_form_password_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) login_form_username_element.send_keys(login_form_username_value) login_form_password_element.send_keys(login_form_password_value) wait_a_bit() old_url = browser.current_url login_form_password_element.submit() # She verifies that she arrived on the administration page (instead of any login error page) # Here we use Selenium's Explicit Wait to wait for the h1 element of the page to contain expected text, meaning browser will have changed from login page to administration page. If we had used an Implicit Wait (with a defined duration) instead of an Explicit one, we risk to have some errors sometimes (we experienced them before doing this refactoring): # - Sometimes we get an error like `selenium.common.exceptions.StaleElementReferenceException: Message: The element reference of

is stale; either the element is no longer attached to the DOM, it is not in the current frame context, or the document has been refreshed` or `selenium.common.exceptions.NoSuchElementException: Message: Unable to locate element: #header h1`. This is because page content changed in between two of our instructions. # - Value read from the page is still the value contained in previous page, because page content has not changed yet. wait_until_page_url_changes(browser, old_url, settings.EXPLICIT_WAIT_TIMEOUT) accept_data_policy_if_present(browser) page_title_css_selector = "#header h1" page_title_expected_content = "Administration" wait_for_element_exists_and_contains_expected_text(browser, page_title_css_selector, page_title_expected_content, settings.EXPLICIT_WAIT_TIMEOUT) def election_home_find_start_button(browser): return wait_for_element_exists(browser, "#start", settings.EXPLICIT_WAIT_TIMEOUT) def log_out(browser, election_id=None): # In the header of the page, she clicks on the "Log out" link logout_link_css_selector = "#logout" logout_element = wait_for_element_exists(browser, logout_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) logout_element.click() # She arrives on the election home page. She checks that the "Start" button is present # v1: # if election_id: # verify_all_elements_have_attribute_value(browser, "#main button", "onclick", "location.href='../../vote.html#uuid=" + election_id + "';") # else: # wait_for_element_exists_and_contains_expected_text(browser, "#main button", "Start", settings.EXPLICIT_WAIT_TIMEOUT) # This solution is less robust to variations in browser language settings # v2: election_home_find_start_button(browser) def administrator_starts_creation_of_election(browser, manual_credential_management=False, election_title=None, election_description=None, initiator_contact=None): """ Initial browser (required) state: administrator has just logged in Final browser state: on the "Preparation of election" page Alice, as an administrator, starts creation of the election: - She clicks on the "Prepare a new election" link - She picks the Credential management method she wants (function paramenter `manual_credential_management`) (- She keeps default value for Authentication method: it is Password, not CAS) - She clicks on the "Proceed" button (this redirects to the "Preparation of election" page) - In the "Name and description of the election" section, she changes values of fields name and description of the election - She clicks on the "Save changes button" (the one that is next to the election description field) - In "Contact" section, she changes the value of "contact" field - She clicks on the "Save changes" button (the one that is in the "Contact" section) """ if election_title is None: election_title = settings.ELECTION_TITLE if election_description is None: election_description = settings.ELECTION_DESCRIPTION if initiator_contact is None: initiator_contact = settings.INITIATOR_CONTACT # She clicks on the "Prepare a new election" link create_election_link_expected_content = "Prepare a new election" links_css_selector = "#prepare_new_election" create_election_link_element = wait_for_element_exists_and_contains_expected_text(browser, links_css_selector, create_election_link_expected_content, settings.EXPLICIT_WAIT_TIMEOUT) create_election_link_element.click() wait_a_bit() if manual_credential_management: # She selects the "Manual" radio button, under section "Credential management" manual_mode_radio_button_css_selector = "#main input[type=radio][value=manual]" manual_mode_radio_button_element = wait_for_element_exists(browser, manual_mode_radio_button_css_selector) manual_mode_radio_button_element.click() wait_a_bit() # She clicks on the "Proceed" button (this redirects to the "Preparation of election" page) proceed_button_css_selector = "#main form input[type=submit]" proceed_button_element = wait_for_element_exists(browser, proceed_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_button_element.click() wait_a_bit() # In the "Name and description of the election" section, she changes values of fields name and description of the election election_name_field_css_selector = "#name_and_description_form input[name=__co_eliom_name]" election_name_field_element = wait_for_element_exists(browser, election_name_field_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) election_name_field_value = election_title election_name_field_element.clear() election_name_field_element.send_keys(election_name_field_value) wait_a_bit() election_description_field_css_selector = "#name_and_description_form textarea[name=__co_eliom_description]" election_description_field_element = browser.find_element_by_css_selector(election_description_field_css_selector) election_description_field_value = election_description election_description_field_element.clear() election_description_field_element.send_keys(election_description_field_value) wait_a_bit() # She clicks on the "Save changes" button (the one that is next to the election description field) save_changes_button_css_selector = "#name_and_description_form input[type=submit]" save_changes_button_element = browser.find_element_by_css_selector(save_changes_button_css_selector) save_changes_button_element.click() wait_a_bit() # In "Contact" section, she changes the value of "contact" field election_contact_field_css_selector = "#form_contact input[name=__co_eliom_contact]" election_contact_field_element = browser.find_element_by_css_selector(election_contact_field_css_selector) election_contact_field_value = initiator_contact election_contact_field_element.clear() election_contact_field_element.send_keys(election_contact_field_value) wait_a_bit() # She clicks on the "Save changes" button (the one that is in the "Contact" section) contact_section_save_changes_button_css_selector = "#form_contact input[type=submit]" contact_section_save_changes_button_element = browser.find_element_by_css_selector(contact_section_save_changes_button_css_selector) contact_section_save_changes_button_element.click() wait_a_bit() # In "Public name of the administrator" section, she changes the value of "name" field admin_name_field_css_selector = "#form_admin_name input[name=__co_eliom_name]" admin_name_field_element = browser.find_element_by_css_selector(admin_name_field_css_selector) admin_name_field_value = "Election initiator" admin_name_field_element.clear() admin_name_field_element.send_keys(admin_name_field_value) wait_a_bit() # She clicks on the "Save changes" button (the one that is in the "Contact" section) admin_name_save_changes_button_css_selector = "#form_admin_name input[type=submit]" admin_name_save_changes_button_element = browser.find_element_by_css_selector(admin_name_save_changes_button_css_selector) admin_name_save_changes_button_element.click() wait_a_bit() def administrator_edits_election_questions(browser, nh_question=False): """ Initial browser (required) state: on the "Preparation of election" page, with questions not edited yet Final browser state: on the "Preparation of election" page (with questions edited) Alice, as an administrator who has recently started creating an election (election status is draft), configures its questions: - She clicks on the "Edit questions" link, to write her own questions - She arrives on the Questions page. She checks that the page title is correct - She removes answer 3 - She clicks on the "Save changes" button (this redirects to the "Preparation of election" page) """ # She clicks on the "Edit questions" link, to write her own questions edit_questions_link_css_selector = "#edit_questions" edit_questions_link_element = wait_for_element_exists(browser, edit_questions_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) edit_questions_link_element.click() wait_a_bit() # She arrives on the Questions page. She checks that the page title is correct page_title_css_selector = "#header h1" page_title_expected_content = "Questions for" wait_for_element_exists_and_contains_expected_text(browser, page_title_css_selector, page_title_expected_content, settings.EXPLICIT_WAIT_TIMEOUT) if nh_question: # She ticks "Tick the box to activate this mode." browser.find_element_by_css_selector("#hybrid_mode").click() # She ticks "Alternative" nhtally_css_selector = ".nonhomomorphic_tally" nhtally_checkbox_element = browser.find_element_by_css_selector(nhtally_css_selector) nhtally_checkbox_element.click() else: # She sets max to 2 max_input = browser.find_element_by_css_selector(".question_max") max_input.send_keys(Keys.BACKSPACE) max_input.send_keys("2") # She removes answer 3 candidate_to_remove = 3 remove_button_css_selector = ".question_answer_item:nth-child(" + str(candidate_to_remove) + ") .btn_remove" remove_button_element = browser.find_element_by_css_selector(remove_button_css_selector) remove_button_element.click() wait_a_bit() # She clicks on the "Save changes" button (this redirects to the "Preparation of election" page) save_changes_button_expected_label = "Save changes" button_elements = browser.find_elements_by_css_selector("button") assert len(button_elements) save_changes_button_element = button_elements[-1] verify_element_label(save_changes_button_element, save_changes_button_expected_label) save_changes_button_element.click() wait_a_bit() def administrator_sets_election_voters(browser, voters_email_addresses): """ Initial browser (required) state: on the "Preparation of election" page, with voters not set yet Final browser state: on the "Preparation of election" page (with voters set) :param voters_email_addresses: an array of voters' email addresses, for example generated using `random_email_addresses_generator()` Alice, as an administrator who has recently started creating an election (election status is draft), sets its voters: - She clicks on the "Edit voters" link, to then type the list of voters - She types N e-mail addresses (the list of invited voters) - She clicks on the "Add" button to submit changes - She clicks on "Go back to election draft" link """ # She clicks on the "Edit voters" link, to then type the list of voters edit_voters_link_css_selector = "#edit_voters" edit_voters_link_element = wait_for_element_exists(browser, edit_voters_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) edit_voters_link_element.click() wait_a_bit() # Split voters_email_addresses into batches of maximum 1000 elements (this is a limit imposed by Belenios UI) splitted_voters_email_addresses = list(divide_chunks(voters_email_addresses, 1000)) for batch_of_email_addresses in splitted_voters_email_addresses: # She types N e-mail addresses (the list of invited voters) voters_list_field_css_selector = "#main form textarea" voters_list_field_element = wait_for_element_exists(browser, voters_list_field_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) voters_list_field_element.clear() last_email_address_typed = None is_first = True for email_address in batch_of_email_addresses: if is_first: is_first = False else: voters_list_field_element.send_keys(Keys.ENTER) voters_list_field_element.send_keys(email_address) last_email_address_typed = email_address wait_a_bit() # She clicks on the "Add" button to submit changes voters_list_field_element.submit() wait_a_bit() # She waits until the returned page displays the last email address typed if last_email_address_typed: expected_email_address_css_selector = "tr:last-child td:first-child" wait_for_element_exists_and_contains_expected_text(browser, expected_email_address_css_selector, last_email_address_typed) # She clicks on "Go back to election draft" link return_link_label = "Go back to election draft" return_link_element = wait_for_an_element_with_partial_link_text_exists(browser, return_link_label, settings.EXPLICIT_WAIT_TIMEOUT) return_link_element.click() wait_a_bit() def administrator_validates_creation_of_election(browser): """ :return: election page URL Initial browser (required) state: on the "Preparation of election" page, with election not yet completely created Final browser state: on the "Preparation of election" page (with election completely created) Alice, as an administrator who has recently started creating an election (election status is draft), finalizes the creation of the election: - In "Validate creation" section, she clicks on the "Create election" link - (She arrives on the "Checklist" page, that lists all main parameters of the election for review, and that flags incoherent or misconfigured parameters. For example, in this test scenario, it displays 2 warnings: "Warning: No trustees were set. This means that the server will manage the election key by itself.", and "Warning: No contact was set!") - In the "Validate creation" section, she clicks on the "Create election" button - (She arrives back on the "My test election for Scenario 1 — Administration" page. Its contents have changed. There is now a text saying "The election is open. Voters can vote.", and there are now buttons "Close election", "Archive election", "Delete election") - She remembers the URL of the voting page, that is where the "Election home" link points to - She checks that a "Close election" button is present (but she does not click on it) """ # In "Validate creation" section, she clicks on the "Create election" link create_election_link_label = "Create election" create_election_link_element = wait_for_an_element_with_partial_link_text_exists(browser, create_election_link_label, settings.EXPLICIT_WAIT_TIMEOUT) create_election_link_element.click() wait_a_bit() # She arrives on the "Checklist" page, that lists all main parameters of the election for review, and that flags incoherent or misconfigured parameters. For example, in this test scenario, it displays 2 warnings: "Warning: No trustees were set. This means that the server will manage the election key by itself.", and "Warning: No contact was set!" # She checks the presence of text "election ready" expected_confirmation_label = "election ready" expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) # In the "Validate creation" section, she clicks on the "Create election" button create_election_button_label = "Create election" create_election_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(create_election_button_label) create_election_button_element = wait_for_element_exists(browser, create_election_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) create_election_button_element.click() wait_a_bit() # She arrives back on the "My test election for Scenario 1 — Administration" page. Its contents have changed. There is now a text saying "The election is open. Voters can vote.", and there are now buttons "Close election", "Archive election", "Delete election" # She remembers the URL of the voting page, that is where the "Election home" link points to election_page_link_label = "Election home" election_page_link_element = wait_for_an_element_with_partial_link_text_exists(browser, election_page_link_label, settings.EXPLICIT_WAIT_TIMEOUT) election_page_url = election_page_link_element.get_attribute('href') # She checks that a "Close election" button is present (but she does not click on it) close_election_button_label = "Close election" close_election_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(close_election_button_label) wait_for_element_exists(browser, close_election_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) return election_page_url belenios-2.2-10-gbb6b7ea8/tests/selenium/util/page_objects.py0000644000175000017500000005227214476041226023045 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import time from selenium.webdriver.common.alert import Alert from selenium.webdriver.support.select import Select from util.selenium_tools import wait_for_an_element_exists_and_is_visible_and_contains_expected_text, wait_for_an_element_exists_and_is_visible_and_attribute_contains_expected_text, wait_for_element_exists, wait_for_elements_exist, wait_for_elements_exist_and_are_visible, wait_for_an_element_with_link_text_exists, wait_for_element_exists_and_contains_expected_text, wait_for_element_exists_and_has_non_empty_content, wait_for_an_alert from util.election_testing import wait_a_bit, election_home_find_start_button, find_buttons_in_page_content_by_value class SeleniumPageObjectModel(): """ Classes which inherit from SeleniumPageObjectModel are meant to follow the "Page Object" design pattern of Selenium, as described here: https://www.selenium.dev/documentation/en/guidelines_and_recommendations/page_object_models/ """ def __init__(self, browser, timeout): self.browser = browser self.timeout = timeout def click_on_link_with_expected_label(self, expected_label): link_element = wait_for_an_element_with_link_text_exists(self.browser, expected_label, self.timeout) link_element.click() class VerifiablePage(SeleniumPageObjectModel): def verify_page(self): raise NotImplementedError() class ClickableLogoPage(SeleniumPageObjectModel): def click_on_logo_image(self): logo_image_element = wait_for_element_exists(self.browser, "#header a", self.timeout) # maybe we should edit the DOM of the page to allow for a more specific CSS selector? logo_image_element.click() class ElectionHomePage(VerifiablePage): def verify_page(self): election_home_find_start_button(self.browser) def click_on_language_link(self, language_link_label): select = Select(wait_for_element_exists(self.browser, ".lang_box select", self.timeout)) select.select_by_value(language_link_label) def click_on_start_button(self): start_button_label = "Start" start_button_css_selector = "#main button" start_button_element = wait_for_element_exists_and_contains_expected_text(self.browser, start_button_css_selector, start_button_label, self.timeout) start_button_element.click() def click_on_advanced_mode_link(self): self.click_on_language_link("en") # in order to see the following label in the correct language self.click_on_link_with_expected_label("Advanced mode") def click_on_see_accepted_ballots_link(self): self.click_on_language_link("en") # in order to see the following label in the correct language self.click_on_link_with_expected_label("See accepted ballots") def click_on_accept_personal_data_policy_link(self): self.click_on_link_with_expected_label("Accept") class NormalVoteGenericStepPage(VerifiablePage): current_step_css_selector = ".current_step" expected_step_content = "Step" def verify_step_title(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, self.current_step_css_selector, self.expected_step_content, self.timeout) def verify_page(self): self.verify_step_title() class ResponsiveFrontendSelectors: current_step_css_selector = ".breadcrumb__step--current" current_step_title_css_selector = ".breadcrumb__step--current .breadcrumb__step__title" class ResponsiveBoothGenericStepPage(VerifiablePage): current_step_title_css_selector = ResponsiveFrontendSelectors.current_step_title_css_selector expected_breadcrumb_title = "" # will be customized by children def verify_breadcrumb(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, self.current_step_title_css_selector, self.expected_breadcrumb_title, self.timeout) def verify_page(self): self.verify_breadcrumb() class ResponsiveBoothStep1Page(ResponsiveBoothGenericStepPage): expected_breadcrumb_title = "Input credential" credential_input_css_selector = "#credential" next_button_css_selector = ".input-credential-section__button" def type_voter_credential(self, voter_credential): credential_input_element = wait_for_element_exists(self.browser, self.credential_input_css_selector, self.timeout) credential_input_element.clear() credential_input_element.send_keys(voter_credential) def click_next_button(self): next_button_element = wait_for_element_exists(self.browser, self.next_button_css_selector, self.timeout) next_button_element.click() class NormalVoteStep1Page(NormalVoteGenericStepPage): expected_step_content = "Step 1/6: Input credential" def click_on_here_button(self): here_button_label = "here" here_button_css_selector = "#main button" here_button_element = wait_for_element_exists_and_contains_expected_text(self.browser, here_button_css_selector, here_button_label, self.timeout) here_button_element.click() # A modal opens (it is an HTML modal created using Window.prompt()), with an input field. def click_on_here_button_and_type_voter_credential(self, voter_credential): self.click_on_here_button() wait_a_bit() # A modal opens (it is an HTML modal created using Window.prompt()), with an input field. He types his credential and clicks on "OK" button of the modal. # credential_prompt = Alert(self.browser) credential_prompt = wait_for_an_alert(self.browser) credential_prompt.send_keys(voter_credential) credential_prompt.accept() def click_on_here_button_and_type_wrong_voter_credential(self, voter_credential): self.click_on_here_button_and_type_voter_credential(voter_credential) # Another modal opens (it is an HTML modal created using Window.alert()), saying that this is a wrong credential. He clicks on the "OK" button of the second modal. time.sleep(1) # failure_alert = Alert(self.browser) failure_alert = wait_for_an_alert(self.browser) failure_alert.accept() def click_on_here_button_and_cancel(self): self.click_on_here_button() wait_a_bit() # A modal opens (it is an HTML modal created using Window.prompt()), with an input field. He clicks on the "Cancel" button of the modal. # credential_prompt = Alert(self.browser) credential_prompt = wait_for_an_alert(self.browser) credential_prompt.dismiss() class ResponsiveBoothStep2Page(ResponsiveBoothGenericStepPage): expected_breadcrumb_title = "Answer to questions" answers_css_selector = ".classic-vote-candidates-list label" # includes blank vote next_button_css_selector = ".vote-navigation__next-button-container .nice-button" def verify_page_body(self): answers_elements = wait_for_elements_exist(self.browser, self.answers_css_selector, self.timeout) assert len(answers_elements) == 2 def verify_page(self): super().verify_page() self.verify_page_body() def fill_vote_form(self, vote_data): page = NormalVoteStep2Page(self.browser, self.timeout) page.answers_css_selector = self.answers_css_selector page.fill_vote_form(vote_data) def click_next_button(self): next_button_element = wait_for_element_exists(self.browser, self.next_button_css_selector, self.timeout) next_button_element.click() class NormalVoteStep2Page(NormalVoteGenericStepPage): expected_step_content = "Step 2/6: Answer to questions" answers_css_selector = ".answer_div input" def verify_page_body(self): answers_elements = wait_for_elements_exist(self.browser, self.answers_css_selector, self.timeout) assert len(answers_elements) == 2 def verify_page(self): NormalVoteGenericStepPage.verify_page(self) self.verify_page_body() def click_on_next_button(self): step_2_parent_css_selector = "#question_div" next_button = wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, step_2_parent_css_selector + " button", "Next", self.timeout) next_button.click() def click_on_next_button_but_form_is_not_filled(self): self.click_on_next_button() # A modal opens (it is an HTML modal created using Window.alert()). failure_alert = Alert(self.browser) failure_alert.accept() def fill_vote_form(self, vote_data): """ Parameter `vote_data` is a dict with the following structure: ``` { "question1": { "answer1": False, "answer2": True, } } ``` For now, only one question is supported, with only 2 possible answers. """ answers_elements = wait_for_elements_exist_and_are_visible(self.browser, self.answers_css_selector, self.timeout) # or we could use find_element_by_xpath("//div[@id='question_div']/input[@type='checkbox'][2]") assert len(answers_elements) == 2 anwser1_element_is_proxy = answers_elements[0].tag_name == "label" anwser2_element_is_proxy = answers_elements[1].tag_name == "label" question1_answer1_element = wait_for_element_exists(self.browser, "#" + answers_elements[0].get_attribute("for"), self.timeout) if anwser1_element_is_proxy else answers_elements[0] question1_answer2_element = wait_for_element_exists(self.browser, "#" + answers_elements[1].get_attribute("for"), self.timeout) if anwser2_element_is_proxy else answers_elements[1] voter_vote_to_question_1_answer_1 = vote_data["question1"]["answer1"] voter_vote_to_question_1_answer_2 = vote_data["question1"]["answer2"] if question1_answer1_element.get_attribute('type') == 'checkbox': voter_vote_to_question_1_answer_1_is_checked = question1_answer1_element.is_selected() voter_vote_to_question_1_answer_2_is_checked = question1_answer2_element.is_selected() if voter_vote_to_question_1_answer_1 and not voter_vote_to_question_1_answer_1_is_checked: answers_elements[0].click() if not voter_vote_to_question_1_answer_1 and voter_vote_to_question_1_answer_1_is_checked: answers_elements[0].click() if voter_vote_to_question_1_answer_2 and not voter_vote_to_question_1_answer_2_is_checked: answers_elements[1].click() if not voter_vote_to_question_1_answer_2 and voter_vote_to_question_1_answer_2_is_checked: answers_elements[1].click() elif question1_answer1_element.get_attribute('type') == 'radio': voter_vote_to_question_1_answer_1_is_checked = question1_answer1_element.is_selected() voter_vote_to_question_1_answer_2_is_checked = question1_answer2_element.is_selected() if voter_vote_to_question_1_answer_1 and not voter_vote_to_question_1_answer_1_is_checked: answers_elements[0].click() if voter_vote_to_question_1_answer_2 and not voter_vote_to_question_1_answer_2_is_checked: answers_elements[1].click() else: # this handles the case of non homomorphic questions if voter_vote_to_question_1_answer_1: question1_answer1_element.send_keys("1") if voter_vote_to_question_1_answer_2: question1_answer2_element.send_keys("1") class BallotTrackerPage(SeleniumPageObjectModel): smart_ballot_tracker_css_selector = "#ballot_tracker" def get_smart_ballot_tracker_value(self): smart_ballot_tracker_element = wait_for_element_exists_and_has_non_empty_content(self.browser, self.smart_ballot_tracker_css_selector, self.timeout) smart_ballot_tracker_value = smart_ballot_tracker_element.get_attribute('innerText') return smart_ballot_tracker_value def verify_smart_ballot_tracker_value(self): smart_ballot_tracker_value = self.get_smart_ballot_tracker_value() assert len(smart_ballot_tracker_value) > 5 class ResponsiveBoothStep3Page(ResponsiveBoothGenericStepPage): expected_breadcrumb_title = "Review and encrypt" def __init__(self, browser, timeout): super().__init__(browser, timeout) self.ballot_tracker_page = BallotTrackerPage(browser, timeout) self.ballot_tracker_page.smart_ballot_tracker_css_selector = "#smart_ballot_tracker" def verify_page_body(self): # We could also verify that the recap content corresponds to what has been voted in previous page step_3_parent_css_selector = "#ballot_div" step_3_expected_success_content = "Your ballot has been encrypted" wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, step_3_parent_css_selector, step_3_expected_success_content, self.timeout) self.ballot_tracker_page.verify_smart_ballot_tracker_value() def verify_page(self): super().verify_page() self.verify_page_body() def click_next_button(self): next_button_element = wait_for_an_element_exists_and_is_visible_and_attribute_contains_expected_text(self.browser, ".nice-button.nice-button--blue", "innerText", "Next", self.timeout) next_button_element.click() def click_previous_button(self): previous_button_element = wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, ".nice-button.nice-button--default", "Previous", self.timeout) previous_button_element.click() def get_smart_ballot_tracker_value(self): return self.ballot_tracker_page.get_smart_ballot_tracker_value() def verify_smart_ballot_tracker_value(self): return self.ballot_tracker_page.verify_smart_ballot_tracker_value() class NormalVoteGenericStepWithBallotTrackerPage(NormalVoteGenericStepPage): def __init__(self, browser, timeout): super().__init__(browser, timeout) self.ballot_tracker_page = BallotTrackerPage(browser, timeout) self.ballot_tracker_page.smart_ballot_tracker_css_selector = "#ballot_tracker" def get_smart_ballot_tracker_value(self): return self.ballot_tracker_page.get_smart_ballot_tracker_value() def verify_smart_ballot_tracker_value(self): return self.ballot_tracker_page.verify_smart_ballot_tracker_value() class NormalVoteStep3Page(NormalVoteGenericStepWithBallotTrackerPage): expected_step_content = "Step 3/6: Review and encrypt" def verify_page_body(self): # We could also verify that the recap content corresponds to what has been voted in previous page step_3_parent_css_selector = "#ballot_div" step_3_expected_success_content = "Your ballot has been encrypted" wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, step_3_parent_css_selector, step_3_expected_success_content, self.timeout) self.verify_smart_ballot_tracker_value() def verify_page(self): NormalVoteGenericStepWithBallotTrackerPage.verify_page(self) self.verify_page_body() def click_on_continue_button(self): continue_button_element = wait_for_an_element_exists_and_is_visible_and_attribute_contains_expected_text(self.browser, "input[type=submit]", "value", "Continue", self.timeout) continue_button_element.click() def click_on_restart_button(self): restart_button_element = wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "button", "Restart", self.timeout) restart_button_element.click() class VoterLoginPage(VerifiablePage, ClickableLogoPage): login_form_username_css_selector = '#main form input[name=username]' login_form_password_css_selector = '#main form input[name=password]' login_form_submit_css_selector = '#main form input[type=submit]' def verify_page(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "h1", "with", self.timeout) def fill_form(self, username, password): login_form_username_value = username # correct value: settings.ADMINISTRATOR_USERNAME login_form_password_value = password # correct value: settings.ADMINISTRATOR_PASSWORD login_form_username_element = wait_for_element_exists(self.browser, self.login_form_username_css_selector, self.timeout) login_form_password_element = wait_for_element_exists(self.browser, self.login_form_password_css_selector, self.timeout) login_form_username_element.clear() login_form_username_element.send_keys(login_form_username_value) login_form_password_element.clear() login_form_password_element.send_keys(login_form_password_value) def click_on_login_button(self): login_button_element = wait_for_element_exists(self.browser, self.login_form_submit_css_selector, self.timeout) login_button_element.submit() def log_in(self, username, password): self.fill_form(username, password) wait_a_bit() self.click_on_login_button() class UnauthorizedPage(VerifiablePage): def verify_page(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "h1", "Unauthorized", self.timeout) class LoginFailedPage(VerifiablePage, ClickableLogoPage): def verify_page(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "h1", "Authentication failed", self.timeout) def click_on_try_to_log_in_again_link(self): self.click_on_link_with_expected_label("try to log in again") class ServerHomePage(VerifiablePage): def verify_page(self): assert self.browser.current_url.endswith("/admin") is True # There seems to be no content-based way to test that we are on the server home page. Another test we could use is this one: `assert 'Election server' in browser.title, "Browser title was: " + browser.title` def click_on_login_link(self, login_type): public_link_element = wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "#header a", login_type, self.timeout) public_link_element.click() def click_on_accept_button_in_personal_data_policy_modal_if_available(self): # If a personal data policy modal appears (it does not appear after it has been accepted), she clicks on the "Accept" button accept_button_label = "Accept" button_elements = find_buttons_in_page_content_by_value(self.browser, accept_button_label) if len(button_elements) > 0: assert len(button_elements) == 1 button_elements[0].click() class NormalVoteStep6Page(NormalVoteGenericStepWithBallotTrackerPage): expected_step_content = "Thank you for voting!" def verify_page_body(self, expected_ballot_tracker): step_6_parent_css_selector = "#main" expected_step_6_body_content = "has been accepted" wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, step_6_parent_css_selector, expected_step_6_body_content, self.timeout) self.verify_smart_ballot_tracker_value() ballot_tracker_value = self.get_smart_ballot_tracker_value() assert ballot_tracker_value == expected_ballot_tracker def verify_page(self, expected_ballot_tracker): NormalVoteGenericStepWithBallotTrackerPage.verify_page(self) self.verify_page_body(expected_ballot_tracker) def click_on_ballot_box_link(self): self.click_on_link_with_expected_label("ballot box") def click_on_go_back_to_election_link(self): self.click_on_link_with_expected_label("Go back to election") class BallotBoxPage(VerifiablePage): def verify_header(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "#header h1", "Accepted ballots", self.timeout) def verify_presence_of_expected_ballot_tracker(self, expected_ballot_tracker): all_smart_ballot_trackers_css_selector = "#main ul li a" all_smart_ballot_trackers_elements = wait_for_elements_exist(self.browser, all_smart_ballot_trackers_css_selector, self.timeout) assert len(all_smart_ballot_trackers_elements) matches = [element for element in all_smart_ballot_trackers_elements if element.get_attribute('innerText') == expected_ballot_tracker] assert len(matches) == 1 def verify_page(self, expected_ballot_tracker=None): self.verify_header() if expected_ballot_tracker: self.verify_presence_of_expected_ballot_tracker(expected_ballot_tracker) def click_on_ballot_link(self, ballot_tracker): self.click_on_link_with_expected_label(ballot_tracker) def click_on_go_back_to_election_link(self): self.click_on_link_with_expected_label("Go back to election") class AdvancedModeVotePage(VerifiablePage): def verify_page(self): wait_for_element_exists(self.browser, "input[type=file][name=encrypted_vote]") def click_on_back_to_election_home_link(self): self.click_on_link_with_expected_label("Back to election home") # TODO: other links in the page, fill both forms, submit them class AdministrationHomeLoggedInPage(VerifiablePage): def verify_page(self): wait_for_an_element_exists_and_is_visible_and_contains_expected_text(self.browser, "h1", "Administration", self.timeout) wait_for_an_element_with_link_text_exists(self.browser, "Log out", self.timeout) belenios-2.2-10-gbb6b7ea8/tests/selenium/util/election_test_base.py0000644000175000017500000010601614476041226024247 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import time import unittest import random import re import warnings from urllib.parse import urlencode from util.selenium_tools import wait_for_element_exists, wait_for_elements_exist, wait_for_element_exists_and_contains_expected_text, wait_for_an_element_with_partial_link_text_exists, verify_element_label, printable_page_source from util.election_testing import random_email_addresses_generator, populate_credential_and_password_for_voters_from_sent_emails, populate_random_votes_for_voters, repopulate_vote_confirmations_for_voters_from_sent_emails, wait_a_bit, build_css_selector_to_find_buttons_in_page_content_by_value, find_button_in_page_content_by_value, initialize_browser, election_page_url_to_election_id, verify_election_consistency, create_election_data_snapshot, delete_election_data_snapshot, log_in_as_administrator, log_out, administrator_starts_creation_of_election, administrator_edits_election_questions, administrator_sets_election_voters, administrator_validates_creation_of_election from util.execution import console_log from util.page_objects import ElectionHomePage, NormalVoteStep1Page, NormalVoteStep2Page, NormalVoteStep3Page, VoterLoginPage, NormalVoteStep6Page, BallotBoxPage, ResponsiveBoothStep1Page, ResponsiveBoothStep2Page, ResponsiveBoothStep3Page import settings class BeleniosElectionTestBase(unittest.TestCase): """ A base class that is meant to be derived, to implement a real test of an election. Properties: - server - browser - fake_sent_emails_manager: An instance of util.fake_sent_emails_manager.FakeSentEmailsManager - voters_email_addresses: A list of email addresses (strings). This is all users who are invited to vote - voters_email_addresses_who_have_lost_their_password: A list of email addresses (strings). This is all users who have asked for a new password. - voters_email_addresses_who_have_voted: A dictionary, indexed by email address (string), where each element value is True - voters_data: A dictionary, indexed by email address (string), where each element is a dictionary of fields for the voter who is identified by this email address. This is data about all users who have voted. - election_page_url: The election page URL (string). Example: "http://localhost:8001/elections/H5ecRG3wHZ21cp/" - election_id: The election ID (string). Example: "H5ecRG3wHZ21cp" """ def __init__(self, *args, **kw): super().__init__(*args, **kw) self.server = None self.browser = None self.fake_sent_emails_manager = None self.voters_email_addresses = [] self.voters_email_addresses_who_have_lost_their_password = [] self.voters_email_addresses_who_have_voted = dict() self.voters_data = dict() self.election_page_url = None self.election_id = None @classmethod def setUpClass(cls): """ Do not display in terminal output noisy warnings which seem related to Python, until we know what should be done for them not to appear. Example of warning: /usr/lib/python3.6/enum.py:859: ResourceWarning: unclosed """ warnings.simplefilter("ignore", ResourceWarning) def update_voters_data(self, some_voters_data): """ :param some_voters: a list of voter data """ for voter in some_voters_data: self.voters_data[voter["email_address"]] = voter def compute_number_of_votes_per_answer(self, voters_data=None): if not voters_data: voters_data = self.voters_data votes_for_answers = {'answer1': 0, 'answer2': 0} for k, v in voters_data.items(): answer1 = v['votes']['question1']['answer1'] answer2 = v['votes']['question1']['answer2'] if answer1: votes_for_answers['answer1'] += 1 if answer2: votes_for_answers['answer2'] += 1 return votes_for_answers def administrator_creates_election(self, nh_question=False): # # Setting up a new election (action of the administrator) browser = self.browser # Alice has been given administrator rights on an online voting app called Belenios. She goes # to check out its homepage and logs in log_in_as_administrator(browser) # She starts creation of the election: # - She clicks on the "Prepare a new election" link # (- She keeps default values on the form: Credential management is automatic (not manual), and Authentication method is Password, not CAS) # - She clicks on the "Proceed" button (this redirects to the "Preparation of election" page) # - She changes values of fields name and description of the election # - She clicks on the "Save changes button" (the one that is next to the election description field) administrator_starts_creation_of_election(browser) # She edits election's questions: # - She clicks on the "Edit questions" link, to write her own questions # - She arrives on the Questions page. She checks that the page title is correct # - She removes answer 3 # - She clicks on the "Save changes" button (this redirects to the "Preparation of election" page) administrator_edits_election_questions(browser, nh_question) # She sets election's voters: # - She clicks on the "Edit voters" link, to then type the list of voters # - She types N e-mail addresses (the list of invited voters) # - She clicks on the "Add" button to submit changes # - She clicks on "Go back to election draft" link self.voters_email_addresses = random_email_addresses_generator(settings.NUMBER_OF_INVITED_VOTERS) administrator_sets_election_voters(browser, self.voters_email_addresses) # She clicks on button "Generate on server" generate_on_server_button_label = "Generate on server" generate_on_server_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(generate_on_server_button_label) generate_on_server_button_element = wait_for_element_exists(browser, generate_on_server_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) generate_on_server_button_element.click() # Wait for emails to be delivered time.sleep(10) # (Server sends emails to voters.) She checks that server does not show any error that would happen when trying to send these emails (this can happen if sendmail is not configured) confirmation_sentence_expected_text = "Credentials have been generated and mailed!" confirmation_sentence_css_selector = "#main p" wait_for_element_exists_and_contains_expected_text(browser, confirmation_sentence_css_selector, confirmation_sentence_expected_text, settings.EXPLICIT_WAIT_TIMEOUT) # Now we do a sanity check that server has really tried to send emails. For this, we look for email addresses in the temporary file where our fake sendmail executable redirects its inputs to. """ An email sent by Belenios (using sendmail or using the fake sendmail) to a voter looks like this: Content-type: text/plain; charset="UTF-8" Content-transfer-encoding: quoted-printable From: Belenios public server To: "820E7G83JBY0F4Z3DY2Y@example.org" <820E7G83JBY0F4Z3DY2Y@example.org> Subject: Your credential for election My test election for Scenario 1 MIME-Version: 1.0 X-Mailer: OcamlNet (ocamlnet.sourceforge.net) Date: Wed, 31 Oct 2018 15:22:27 +0100 You are listed as a voter for the election My test election for Scenario 1 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. Credential: yQVDQaKSAQVjdZq Page of the election: http://localhost:8001/elections/AFFNDEPnpy21bw/ Note that you are allowed to vote several times. Only the last vote counts. ---------- Vous =C3=AAtes enregistr=C3=A9(e) en tant qu=27=C3=A9lecteur(trice) pour=20= l=27=C3=A9lection My test election for Scenario 1 Veuillez trouver ci-dessous votre code de vote. Pour soumettre un bulletin, vous aurez =C3=A9galement besoin d=27un mot de passe, envoy=C3=A9= dans un e-mail s=C3=A9par=C3=A9. Soyez attentif(ve), le mot de passe et le cod= e de vote se ressemblent mais jouent des r=C3=B4les diff=C3=A9rents. Le syst=C3= =A8me vous demandera votre code de vote d=C3=A8s l=27entr=C3=A9e dans l=27isoloir=20= virtuel. Le nom d=27utilisateur et le mot de passe sont n=C3=A9cessaires lorsque votr= e bulletin est pr=C3=AAt =C3=A0 =C3=AAtre soumis. Code de vote=C2=A0: yQVDQaKSAQVjdZq Page de l=27=C3=A9lection=C2=A0: http://localhost:8001/elections/AFFNDEPn= py21bw/ Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est pris en compte. --=20 """ email_address_to_look_for = self.voters_email_addresses[0] text_to_look_for = 'To: "' + email_address_to_look_for + '"' email_address_found = self.fake_sent_emails_manager.find_in_sent_emails(text_to_look_for) assert email_address_found, "Text '" + email_address_to_look_for + "' not found in fake sendmail log file " + self.fake_sent_emails_manager.log_file_path # She clicks on the "Proceed" link proceed_link_css_selector = "#generic_proceed_link" proceed_link_element = wait_for_element_exists(browser, proceed_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_link_element.click() wait_a_bit() # In "Authentication" section, she clicks on the "Generate and mail missing passwords" button generate_and_mail_missing_passwords_button_label = "Generate and mail missing passwords" generate_and_mail_missing_passwords_button_element = wait_for_element_exists(browser, build_css_selector_to_find_buttons_in_page_content_by_value(generate_and_mail_missing_passwords_button_label), settings.EXPLICIT_WAIT_TIMEOUT) generate_and_mail_missing_passwords_button_element.click() # Wait for emails to be delivered time.sleep(10) # She checks that the page contains expected confirmation text, instead of an error (TODO: explain in which case an error can happen, and check that it does not show) confirmation_sentence_expected_text = "Passwords have been generated and mailed!" confirmation_sentence_css_selector = "#main p" wait_for_element_exists_and_contains_expected_text(browser, confirmation_sentence_css_selector, confirmation_sentence_expected_text, settings.EXPLICIT_WAIT_TIMEOUT) # She clicks on the "Proceed" link (this redirects to the "Preparation of election" page) proceed_link_css_selector = "#generic_proceed_link" proceed_link_element = wait_for_element_exists(browser, proceed_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_link_element.click() wait_a_bit() self.election_page_url = administrator_validates_creation_of_election(browser) console_log("election_page_url:", self.election_page_url) self.election_id = election_page_url_to_election_id(self.election_page_url) console_log("election_id:", self.election_id) log_out(browser, self.election_id) def administrator_regenerates_passwords_for_some_voters(self): # Alice has been contacted by some voters who say they lost their password. She wants to re-generate their passwords and have the platform send them by email. For this, she logs in as administrator. browser = self.browser log_in_as_administrator(browser) # She remembers the list of voters who contacted her and said they lost their password. For this, we pick randomly NUMBER_OF_REGENERATED_PASSWORD_VOTERS voters from all the voters. self.voters_email_addresses_who_have_lost_their_password = random.sample(self.voters_email_addresses, settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) # She selects the election that she wants to edit browser = self.browser election_to_edit_css_selector = "#election_admin_" + str(self.election_id) election_to_edit_elements = wait_for_elements_exist(browser, election_to_edit_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) assert len(election_to_edit_elements) > 0 election_to_edit_elements[0].click() wait_a_bit() # She arrives to the election administration page. For each voter of the NUMBER_OF_REGENERATED_PASSWORD_VOTERS selected voters: for email_address in self.voters_email_addresses_who_have_lost_their_password: # She clicks on the "Regenerate and mail a password" link regenerate_and_mail_a_password_link_css_selector = "#election_regenpwd" regenerate_and_mail_a_password_link_element = wait_for_element_exists(browser, regenerate_and_mail_a_password_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) regenerate_and_mail_a_password_link_element.click() wait_a_bit() # She types the e-mail address of the voter in the "Username" field username_field_css_selector = "#main input[type=text]" username_field_element = wait_for_element_exists(browser, username_field_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) username_field_element.send_keys(email_address) wait_a_bit() # She clicks on the "Submit" button submit_button_label = "Submit" submit_button_element = find_button_in_page_content_by_value(browser, submit_button_label) submit_button_element.click() wait_a_bit() # She checks that the page shows a confirmation message similar to "A new password has been mailed to RMR4MY4XV5GUDNOR6XNH@example.org" confirmation_sentence_expected_text = "A new password has been mailed to" confirmation_sentence_css_selector = "#main p" wait_for_element_exists_and_contains_expected_text(browser, confirmation_sentence_css_selector, confirmation_sentence_expected_text, settings.EXPLICIT_WAIT_TIMEOUT) # She clicks on the "Proceed" link proceed_link_css_selector = "#generic_proceed_link" proceed_link_element = wait_for_element_exists(browser, proceed_link_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_link_element.click() wait_a_bit() # She arrives back to the election administration page """ Now we do a sanity check that server has really tried to send these emails. For this, we look for email addresses in the temporary file where our fake sendmail executable redirects its inputs to. There should be 3 occurences of "To : xxx@xxx" for users who have lost their password, with respective subjects: - "Your credential for election My test election for Scenario 1" - "Your password for election My test election for Scenario 1" - "Your password for election My test election for Scenario 1" And there should be only 2 occurences for other users, with respective subjects: - "Your credential for election My test election for Scenario 1" - "Your password for election My test election for Scenario 1" """ for email_address in self.voters_email_addresses_who_have_lost_their_password: text_to_look_for = 'To: "' + email_address + '"' assert self.fake_sent_emails_manager.count_occurences_in_sent_emails(text_to_look_for) == 3 voters_email_addresses_who_have_not_lost_their_password = set(self.voters_email_addresses) - set(self.voters_email_addresses_who_have_lost_their_password) for email_address in voters_email_addresses_who_have_not_lost_their_password: text_to_look_for = 'To: "' + email_address + '"' assert self.fake_sent_emails_manager.count_occurences_in_sent_emails(text_to_look_for) == 2 log_out(browser, self.election_id) def one_voter_votes(self, voter, direct=False): browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT if direct: booth_url = settings.SERVER_URL + "/static/frontend/booth/vote.html#" + urlencode({"uuid": self.election_id, "lang": "en"}) browser.get(booth_url) else: # Bob has received 2 emails containing an invitation to vote and all necessary credentials (election page URL, username, password). He goes to the election page URL. browser.get(voter["election_page_url"]) wait_a_bit() # He clicks on "en" language election_home_page = ElectionHomePage(browser, timeout) election_home_page.click_on_language_link("en") # He clicks on the "Start" button election_home_page.click_on_start_button() wait_a_bit() if True: # new booth # A loading screen appears, then another screen appears. It contains an input for credential and a "Next" button. He types his credential in the input field, and clicks on the "Next" button. step_1_page = ResponsiveBoothStep1Page(browser, timeout) step_1_page.verify_page() step_1_page.type_voter_credential(voter["credential"]) step_1_page.click_next_button() wait_a_bit() # A new screen appears, which has a title "Answer to questions", and a content: # "Question 1?" # "Question #1 of 1 — select between 1 and 2 answer(s)" # [ ] "Answer 1" # [ ] "Answer 2" # [Next] # (where "[ ]" is a checkbox, and [Next] is a button) step_2_page = ResponsiveBoothStep2Page(browser, timeout) step_2_page.verify_page() # He fills his votes to each answer of the question vote_data = voter["votes"] step_2_page.fill_vote_form(vote_data) wait_a_bit() # He clicks on the "Next" button step_2_page.click_next_button() wait_a_bit() """ A new screen appears, showing: Review and encrypt Your ballot is not yet in the ballot box, and has the following content: Question 1? - Answer 1 Your ballot has been encrypted, but has not been cast yet! Your smart ballot tracker is sLRilXoAYcodIrjWrOqPrVXLNlRyCJAqFeeHZ4WCajU We invite you to save it in order to check later that it is taken into account. [Copy] [Previous] [Next] """ step_3_page = ResponsiveBoothStep3Page(browser, timeout) step_3_page.verify_page() # He remembers the smart ballot tracker that is displayed. smart_ballot_tracker_value = step_3_page.get_smart_ballot_tracker_value() step_3_page.verify_smart_ballot_tracker_value() voter["smart_ballot_tracker"] = smart_ballot_tracker_value # He clicks on the "Next" button step_3_page.click_next_button() wait_a_bit() # import time # time.sleep(1000) # He arrives on the login page, with a login form (as he has not already logged in during this visit, he does not arrive directly on the step 5 page) login_page = VoterLoginPage(browser, timeout) login_page.verify_page() # He types his voter username and password, and submits the form login_page.log_in(voter["username"], voter["password"]) wait_a_bit() def some_voters_cast_their_vote(self, voters): """ :param voters: list of dict. Each element contains information about a voter (their e-mail address, the planned answers to each question they will cast) """ browser = self.browser timeout = settings.EXPLICIT_WAIT_TIMEOUT voters_count = len(voters) for index, voter in enumerate(voters): console_log("#### Current voter casting their vote in current batch: " + str(index + 1) + "/" + str(voters_count)) self.one_voter_votes(voter) wait_a_bit() """ Next screen looks like this: Your ballot for My test election for Scenario 1 has been accepted. Your smart ballot tracker is ISXe/rCNCVa9XcVeFgKglbpgo5SoZs4svT6dPbR5b6M. You can check its presence in the {ballot box} anytime during the election. A confirmation e-mail has been sent to you. {Go back to election} Where {xxx} is a link """ # He verifies that he is on step 6 and that page content is correct (page contains 'has been accepted'; page contains a ballot tracker which is the same as the one he noted) step_6_page = NormalVoteStep6Page(browser, timeout) step_6_page.verify_page(voter["smart_ballot_tracker"]) # He clicks on the 'ballot box' link step_6_page.click_on_ballot_box_link() wait_a_bit() # He checks that his smart ballot tracker appears in the list ballot_box_page = BallotBoxPage(browser, timeout) ballot_box_page.verify_page(voter["smart_ballot_tracker"]) ballot_box_page.click_on_ballot_link(voter["smart_ballot_tracker"]) self.voters_email_addresses_who_have_voted[voter["email_address"]] = True # In a following pass, he checks his mailbox to find a new email with confirmation of his vote, and verifies the value of the smart ballot tracker written in this email is the same as the one he noted. This verification is done in a separated pass because of an optimization, so that we only re-read and re-populate the sendmail_fake text file once for all users. # He closes the window (there is no log-out link, because user is not logged in: credentials are not remembered) # It is not really mandatory for the test to close the window. Re-opening a browser takes much more time, compared to just navigating to another URL. So actually to save execution time, we choose to close the window only sometimes, randomly. if random.randint(0, 10) <= 3: browser.quit() self.browser = initialize_browser() browser = self.browser # Start another pass, where we re-read and re-populate the sendmail_fake text file once for all users. voters = repopulate_vote_confirmations_for_voters_from_sent_emails(self.fake_sent_emails_manager, voters, settings.ELECTION_TITLE) for voter in voters: # He checks his mailbox to find a new email with confirmation of his vote, and verifies the value of the smart ballot tracker written in this email is the same as the one he noted. assert voter["smart_ballot_tracker"] == voter["smart_ballot_tracker_in_vote_confirmation_email"], "Ballot tracker read in vote confirmation email (" + voter["smart_ballot_tracker"] + ") is not the same as the one read on the vote confirmation page (" + voter["smart_ballot_tracker_in_vote_confirmation_email"] + ")" def one_voter_casts_after_the_election_is_closed(self, voter): browser = self.browser console_log("#### Current voter casting their vote after the election is closed") self.one_voter_votes(voter, direct=True) wait_a_bit() """ Next screen looks like this: Your ballot for Test vote after close is rejected, because the election is closed. {Go back to election} Where {xxx} is a link """ # He checks that "the election is closed" is present wait_for_element_exists_and_contains_expected_text(browser, "#main p", "the election is closed", settings.EXPLICIT_WAIT_TIMEOUT) def all_voters_vote(self): """ This function selects a random set of `NUMBER_OF_VOTING_VOTERS` voters, and casts their vote. Note: If you rather want to cast votes and check consistency for every batch of votes, see function `all_voters_vote_in_sequences()`. """ voters_who_will_vote_now = random.sample(self.voters_email_addresses, settings.NUMBER_OF_VOTING_VOTERS) voters_who_will_vote_now_data = populate_credential_and_password_for_voters_from_sent_emails(self.fake_sent_emails_manager, voters_who_will_vote_now, settings.ELECTION_TITLE) voters_who_will_vote_now_data = populate_random_votes_for_voters(voters_who_will_vote_now_data) self.update_voters_data(voters_who_will_vote_now_data) self.some_voters_cast_their_vote(voters_who_will_vote_now_data) def all_voters_vote_in_sequences(self, verify_every_x_votes=5): """ This function is a wrapper of some_voters_vote_in_sequences(), for readability. It selects a random set of `NUMBER_OF_VOTING_VOTERS` voters, and casts their vote, in batches of `verify_every_x_votes`, and checks vote data consistency after every batch of votes (using `belenios_tool verify-diff` and a snapshot of election data copied in previous batch). Note: If you rather want to cast votes without checking consistency, see function `all_voters_vote()`. """ voters_who_will_vote_now = random.sample(self.voters_email_addresses, settings.NUMBER_OF_VOTING_VOTERS) self.some_voters_vote_in_sequences(voters_who_will_vote_now, start_index=0, end_index=settings.NUMBER_OF_VOTING_VOTERS, verify_every_x_votes=verify_every_x_votes) def some_voters_vote_in_sequences(self, voters=None, start_index=0, end_index=None, verify_every_x_votes=5): """ Iterates over `voters` from index `start_index` (included) to `end_index` (not included), cast their vote, and checks vote data consistency for every batch of `verify_every_x_votes` votes (using `belenios_tool verify-diff` and a snapshot of election data copied in previous batch). """ if start_index < 0: raise Exception("start_index cannot be below 0") current_start_index = start_index if end_index is None: end_index = settings.NUMBER_OF_VOTING_VOTERS elif end_index > settings.NUMBER_OF_VOTING_VOTERS: raise Exception("end_index cannot exceeed NUMBER_OF_VOTING_VOTERS") if voters is None: voters = self.voters_email_addresses voters_who_will_vote_now = voters[start_index:end_index] voters_who_will_vote_now_data = populate_credential_and_password_for_voters_from_sent_emails(self.fake_sent_emails_manager, voters_who_will_vote_now, settings.ELECTION_TITLE) voters_who_will_vote_now_data = populate_random_votes_for_voters(voters_who_will_vote_now_data) self.update_voters_data(voters_who_will_vote_now_data) snapshot_folder = None while current_start_index < end_index: increment = verify_every_x_votes # could be randomized current_end_index = current_start_index + increment if current_end_index > end_index: current_end_index = end_index if current_start_index > 0: console_log("#### Starting substep: create_election_data_snapshot") snapshot_folder = create_election_data_snapshot(self.election_id) console_log("#### Substep complete: create_election_data_snapshot") try: console_log("#### A batch of " + str(current_end_index - current_start_index) + " voters, indexed " + str(current_start_index) + " to " + str(current_end_index - 1) + " included are now going to vote") sublist_start_index = current_start_index - start_index sublist_end_index = current_end_index - start_index self.some_voters_cast_their_vote(voters_who_will_vote_now_data[sublist_start_index:sublist_end_index]) console_log("#### A batch of " + str(current_end_index - current_start_index) + " voters, indexed " + str(current_start_index) + " to " + str(current_end_index - 1) + " included have now voted") if current_start_index > 0: console_log("#### Starting substep: verify_election_consistency using `belenios_tool verify-diff` (for a batch of votes)") verify_election_consistency(self.election_id, snapshot_folder) console_log("#### Substep complete: verify_election_consistency using `belenios_tool verify-diff` (for a batch of votes)") finally: if current_start_index > 0: console_log("#### Starting substep: delete_election_data_snapshot") delete_election_data_snapshot(snapshot_folder) console_log("#### Substep complete: delete_election_data_snapshot") current_start_index += increment def some_voters_revote(self): voters_list_we_pick_from = list(self.voters_email_addresses_who_have_voted.keys()) voters_who_will_vote_now = random.sample(voters_list_we_pick_from, settings.NUMBER_OF_REVOTING_VOTERS) voters_who_will_vote_now_data = populate_credential_and_password_for_voters_from_sent_emails(self.fake_sent_emails_manager, voters_who_will_vote_now, settings.ELECTION_TITLE) voters_who_will_vote_now_data = populate_random_votes_for_voters(voters_who_will_vote_now_data) self.update_voters_data(voters_who_will_vote_now_data) self.some_voters_cast_their_vote(voters_who_will_vote_now_data) def one_voter_revotes_after_the_election_is_closed(self): voters_list_we_pick_from = list(self.voters_email_addresses_who_have_voted.keys()) voters_who_will_vote_now = random.sample(voters_list_we_pick_from, 1) voters_who_will_vote_now_data = populate_credential_and_password_for_voters_from_sent_emails(self.fake_sent_emails_manager, voters_who_will_vote_now, settings.ELECTION_TITLE) voters_who_will_vote_now_data = populate_random_votes_for_voters(voters_who_will_vote_now_data) self.update_voters_data(voters_who_will_vote_now_data) self.one_voter_casts_after_the_election_is_closed(voters_who_will_vote_now_data[0]) def administrator_verifies_vote_results(self): """ Initial browser (required) state: on the vote results page Final browser state: on the accepted ballots page She checks consistency of the vote result: - 1) She checks that the number of accepted ballots is the same as the number of voters who voted - 2) For each available answer in the question, she checks that the total number of votes in favor of Answer X displayed in result page is the same as the sum of votes for Answer X in all votes of voters who voted that have been randomly generated in advance - 3) She checks that each ballot content corresponds to content that of this vote that has been randomly generated in advance This screen looks like this: This is the development version! By using this site, you accept our . This election has been tallied. Question 1? Answer 1 6 Answer 2 8 Number of accepted ballots: 10 You can also download the . Where <...> is a link """ browser = self.browser # - 1) She checks that the number of accepted ballots is the same as the number of voters who voted main_css_selector = "#main" main_expected_content = "Number of accepted ballots:" main_element = wait_for_element_exists_and_contains_expected_text(browser, main_css_selector, main_expected_content, settings.EXPLICIT_WAIT_TIMEOUT) main_text_content = main_element.get_attribute('innerText') number_of_accepted_ballots = None match = re.search(r'Number of accepted ballots:\s*(\d+)\s', main_text_content, re.MULTILINE | re.DOTALL) if match: number_of_accepted_ballots = match.group(1) number_of_accepted_ballots = number_of_accepted_ballots.strip() else: raise Exception("Number of accepted ballots not found in election tally page: " + main_text_content) assert str(number_of_accepted_ballots) == str(settings.NUMBER_OF_VOTING_VOTERS), "Number of accepted ballots (" + str(number_of_accepted_ballots) + ") is not the same as number of voters (" + str(settings.NUMBER_OF_VOTING_VOTERS) + ")" + printable_page_source(browser) # - 2) For each available answer in the question, she checks that the total number of votes in favor of Answer X displayed in result page is the same as the sum of votes for Answer X in all votes of voters who voted that have been randomly generated in advance number_of_votes_per_answer = self.compute_number_of_votes_per_answer() question_id = 1 for answer_id in range(1, 3): base_selector = "#main li:nth-child(" + str(question_id) + ") tr:nth-child(" + str(answer_id) + ")" answer_label_css_selector = base_selector + " td:nth-child(1)" answer_total_css_selector = base_selector + " td:nth-child(2)" answer_expected_label = "Answer " + str(answer_id) answer_element = browser.find_element_by_css_selector(answer_label_css_selector) verify_element_label(answer_element, answer_expected_label) answer_total_real_value_element = browser.find_element_by_css_selector(answer_total_css_selector) answer_total_real_value = answer_total_real_value_element.get_attribute('innerText').strip() answer_total_expected_value = str(number_of_votes_per_answer['answer' + str(answer_id)]) assert answer_total_real_value == answer_total_expected_value, "Number of votes for Answer " + str(answer_id) + " displayed on vote result page (" + answer_total_real_value + ") does not match expected value (" + answer_total_expected_value + "). " + printable_page_source(browser) # - 3) She checks that each smart ballot tracker in the ballot box page corresponds to the smart ballot tracker of one of our voters, and that there is only one of these, and that the number of smart ballot trackers in this page is the same as the number of voters who voted all_ballots_link_label = "See accepted ballots" all_ballots_link_element = wait_for_an_element_with_partial_link_text_exists(browser, all_ballots_link_label, settings.EXPLICIT_WAIT_TIMEOUT) all_ballots_link_element.click() all_smart_ballot_trackers_css_selector = "#main ul li a" all_smart_ballot_trackers_elements = wait_for_elements_exist(browser, all_smart_ballot_trackers_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) assert len(self.voters_email_addresses_who_have_voted) == settings.NUMBER_OF_VOTING_VOTERS assert len(all_smart_ballot_trackers_elements) == settings.NUMBER_OF_VOTING_VOTERS for voter_email_address in self.voters_email_addresses_who_have_voted: voter = self.voters_data[voter_email_address] matches = [element for element in all_smart_ballot_trackers_elements if element.get_attribute('innerText') == voter["smart_ballot_tracker"]] assert len(matches) == 1 belenios-2.2-10-gbb6b7ea8/tests/selenium/util/selenium_tools.py0000644000175000017500000005361514476041226023463 0ustar stephsteph#!/usr/bin/python # coding: utf-8 from selenium.webdriver.support.ui import WebDriverWait from selenium.webdriver.common.by import By from selenium.webdriver.support import expected_conditions as EC from selenium.common.exceptions import NoSuchElementException, StaleElementReferenceException, NoAlertPresentException DEFAULT_WAIT_DURATION = 10 # In seconds def printable_page_source(browser): return "Page source was: " + str(browser.page_source.encode("utf-8")) def element_is_visible_filter(el): return el.is_displayed() def representation_of_element(element): return element.get_attribute("outerHTML") class an_alert_is_present(object): """ An expectation for checking that an Alert is present. """ def __init__(self): pass def __call__(self, driver): alert = driver.switch_to.alert return alert def wait_for_an_alert(browser, wait_duration=DEFAULT_WAIT_DURATION): """ Waits for the presence of an Alert. :param browser: Selenium browser :param wait_duration: Maximum duration in seconds that we wait for the presence of this element before raising an exception :return: The Alert """ try: ignored_exceptions = (NoAlertPresentException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) alert = custom_wait.until(an_alert_is_present()) return alert except Exception as e: raise Exception(f"Could not find expected Alert until timeout of {str(wait_duration)} seconds. " + printable_page_source(browser)) from e class elements_exist_and_are_visible(object): def __init__(self, locator): self.locator = locator def __call__(self, driver): elements = driver.find_elements(*self.locator) if not elements: return False visible_elements = list(filter(element_is_visible_filter, elements)) if not visible_elements: return False return visible_elements def wait_for_elements_exist_and_are_visible(browser, css_selector, wait_duration=DEFAULT_WAIT_DURATION): """ Waits for the presence of elements that match CSS selector `css_selector` and which are currently visible in the page. :param browser: Selenium browser :param css_selector: CSS selector of the expected element :param wait_duration: Maximum duration in seconds that we wait for the presence of this element before raising an exception :return: The list of WebElement once they match expected conditions """ try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) elements = custom_wait.until(elements_exist_and_are_visible((By.CSS_SELECTOR, css_selector))) return elements except Exception as e: raise Exception(f"Could not find expected visible DOM elements matching '{css_selector}' until timeout of {str(wait_duration)} seconds. " + printable_page_source(browser)) from e class an_element_exists_and_is_visible_and_attribute_contains_expected_text(object): def __init__(self, locator, attribute_name, expected_content): self.locator = locator self.attribute_name = attribute_name self.expected_content = expected_content def __call__(self, driver): elements = driver.find_elements(*self.locator) if not elements: return False visible_elements = filter(element_is_visible_filter, elements) if not visible_elements: return False for element in visible_elements: if self.expected_content in element.get_attribute(self.attribute_name): return element return False def wait_for_an_element_exists_and_is_visible_and_attribute_contains_expected_text(browser, css_selector, attribute_name, expected_text, wait_duration=DEFAULT_WAIT_DURATION): """ Waits for the presence of an element that matches CSS selector `css_selector` and which is currently visible in the page, and which has an attribute `attribute_name` which contains string `expected_text`. :param browser: Selenium browser :param css_selector: CSS selector of the expected element :param attribute_name: Name of the HTML attribute of the DOM element which should contain `expected_text` :param expected_text: String of the expected text that element must contain :param wait_duration: Maximum duration in seconds that we wait for the presence of this element before raising an exception :return: The WebElement once it matches expected conditions """ try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(an_element_exists_and_is_visible_and_attribute_contains_expected_text((By.CSS_SELECTOR, css_selector), attribute_name, expected_text)) return element except Exception as e: raise Exception(f"Could not find expected DOM element '{css_selector}' with attribute '{attribute_name}' which contains text content '{expected_text}' until timeout of {str(wait_duration)} seconds. " + printable_page_source(browser)) from e def wait_for_an_element_exists_and_is_visible_and_contains_expected_text(browser, css_selector, expected_text, wait_duration=DEFAULT_WAIT_DURATION): return wait_for_an_element_exists_and_is_visible_and_attribute_contains_expected_text(browser, css_selector, "innerText", expected_text, wait_duration) class element_has_non_empty_attribute(object): """ An expectation for checking that an element has a non-empty value for given attribute. This class is meant to be used in combination with Selenium's `WebDriverWait::until()`. For example: ``` custom_wait = WebDriverWait(browser, 10) smart_ballot_tracker_element = custom_wait.until(element_has_non_empty_attribute((By.ID, "my_id"), 'value')) ``` :param locator: Selenium locator used to find the element. For example: `(By.ID, "my_id")` :param attribute: HTML attribute. For example 'innerText' (see `element_has_non_empty_content()` for this), or 'value' :return: The WebElement once it has a non-empty innerText attribute """ def __init__(self, locator, attribute): self.locator = locator self.attribute = attribute def __call__(self, driver): element = driver.find_element(*self.locator) # Finding the referenced element if not element: return False element_content = element.get_attribute(self.attribute).strip() if len(element_content) > 0: return element else: return False class element_has_non_empty_content(element_has_non_empty_attribute): """ An expectation for checking that an element has a non-empty innerText attribute. This class is meant to be used in combination with Selenium's `WebDriverWait::until()`. For example: ``` custom_wait = WebDriverWait(browser, 10) smart_ballot_tracker_element = custom_wait.until(element_has_non_empty_content((By.ID, "my_id"))) ``` :param locator: Selenium locator used to find the element. For example: `(By.ID, "my_id")` :return: The WebElement once it has a non-empty innerText attribute """ def __init__(self, locator): super().__init__(locator, 'innerText') class an_element_with_partial_link_text_exists(object): def __init__(self, partial_link_text): self.partial_link_text = partial_link_text def __call__(self, driver): element = driver.find_element_by_partial_link_text(self.partial_link_text) if not element: return False return element class an_element_with_link_text_exists(object): def __init__(self, link_text): self.link_text = link_text def __call__(self, driver): element = driver.find_element_by_link_text(self.link_text) if not element: return False return element class element_exists_and_attribute_contains_expected_text(object): """ An expectation for checking that an element exists and its given attribute contains expected text. This class is meant to be used in combination with Selenium's `WebDriverWait::until()`. For example: ``` custom_wait = WebDriverWait(browser, 10) smart_ballot_tracker_element = custom_wait.until(element_exists_and_attribute_contains_expected_text((By.ID, "my_id"), "class", "hello")) ``` :param locator: Selenium locator used to find the element. For example: `(By.ID, "my_id")` :param attribute: Attribute of the element that should contain expected text (parameter type: string) :param expected_text: Text expected in element's given attribute (parameter type: string) :return: The WebElement once its innerText attribute contains expected_text """ def __init__(self, locator, attribute, expected_text): self.locator = locator self.attribute = attribute self.expected_text = expected_text def transform_attribute_content(self, content): return content def __call__(self, driver): element = driver.find_element(*self.locator) # Finding the referenced element if not element: return False element_content = self.transform_attribute_content(element.get_attribute(self.attribute)) if element_content and self.expected_text in element_content: return element else: return False class element_exists_and_contains_expected_text(element_exists_and_attribute_contains_expected_text): """ An expectation for checking that an element exists and its innerText attribute contains expected text. This class is meant to be used in combination with Selenium's `WebDriverWait::until()`. For example: ``` custom_wait = WebDriverWait(browser, 10) smart_ballot_tracker_element = custom_wait.until(element_exists_and_contains_expected_text((By.ID, "my_id"), "my expected text")) ``` :param locator: Selenium locator used to find the element. For example: `(By.ID, "my_id")` :param expected_text: Text expected in element's innerText attribute (parameter type: string) :return: The WebElement once its innerText attribute contains expected_text """ def __init__(self, locator, expected_text): super().__init__(locator, 'innerText', expected_text) def transform_attribute_content(self, content): if content: return content.strip() else: return content class element_exists_and_does_not_contain_expected_text(object): """ An expectation for checking that an element exists and its innerText attribute does not contain expected text. This class is meant to be used in combination with Selenium's `WebDriverWait::until()`. For example: ``` custom_wait = WebDriverWait(browser, 10) smart_ballot_tracker_element = custom_wait.until(element_exists_and_does_not_contain_expected_text((By.ID, "my_id"), "my expected text")) ``` :param locator: Selenium locator used to find the element. For example: `(By.ID, "my_id")` :param expected_text: Text expected to not be present in element's innerText attribute (parameter type: string) :return: The WebElement once its innerText attribute contains expected_text """ def __init__(self, locator, expected_text): self.locator = locator self.expected_text = expected_text def __call__(self, driver): element = driver.find_element(*self.locator) # Finding the referenced element if not element: return False element_content = element.get_attribute('innerText').strip() if self.expected_text not in element_content: return element else: return False def wait_for_element_exists_and_contains_expected_text(browser, css_selector, expected_text, wait_duration=DEFAULT_WAIT_DURATION): """ Waits for the presence of an element that matches CSS selector `css_selector` and that has an innerText attribute that contains string `expected_text`. :param browser: Selenium browser :param css_selector: CSS selector of the expected element :param expected_text: String of the expected text that element must contain :param wait_duration: Maximum duration in seconds that we wait for the presence of this element before raising an exception :return: The WebElement once it matches expected conditions """ try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(element_exists_and_contains_expected_text((By.CSS_SELECTOR, css_selector), expected_text)) return element except Exception as e: raise Exception("Could not find expected DOM element '" + css_selector + "' with text content '" + expected_text + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_for_element_exists_and_attribute_contains_expected_text(browser, css_selector, attribute, expected_text, wait_duration=DEFAULT_WAIT_DURATION): """ Waits for the presence of an element that matches CSS selector `css_selector` and that has an innerText attribute that contains string `expected_text`. :param browser: Selenium browser :param css_selector: CSS selector of the expected element :param attribute: String. Name of the element's attribute that will be inspected :param expected_text: String of the expected text that element must contain :param wait_duration: Maximum duration in seconds that we wait for the presence of this element before raising an exception :return: The WebElement once it matches expected conditions """ try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(element_exists_and_attribute_contains_expected_text((By.CSS_SELECTOR, css_selector), attribute, expected_text)) return element except Exception as e: raise Exception("Could not find expected DOM element '" + css_selector + "' with text content '" + expected_text + "' until timeout of " + str(wait_duration) + " seconds. Page source was: " + str(browser.page_source.encode("utf-8"))) from e def wait_for_element_exists_and_does_not_contain_expected_text(browser, css_selector, expected_text, wait_duration=DEFAULT_WAIT_DURATION): """ Waits for the presence of an element that matches CSS selector `css_selector` and that has an innerText attribute that does not contain string `expected_text`. :param browser: Selenium browser :param css_selector: CSS selector of the expected element :param expected_text: String of the expected text that element must not contain :param wait_duration: Maximum duration in seconds that we wait for the presence of this element before raising an exception :return: The WebElement once it matches expected conditions """ try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(element_exists_and_does_not_contain_expected_text((By.CSS_SELECTOR, css_selector), expected_text)) return element except Exception as e: raise Exception("Could not find expected DOM element '" + css_selector + "' that does not contain string '" + expected_text + "' until timeout of " + str(wait_duration) + " seconds. Page source was: " + str(browser.page_source.encode("utf-8"))) from e def wait_for_element_exists_and_has_non_empty_attribute(browser, css_selector, attribute, wait_duration=DEFAULT_WAIT_DURATION): try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(element_has_non_empty_attribute((By.CSS_SELECTOR, css_selector), attribute)) return element except Exception as e: raise Exception("Could not find expected DOM element '" + css_selector + "' with non-empty attribute '" + attribute + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_for_element_exists_and_has_non_empty_content(browser, css_selector, wait_duration=DEFAULT_WAIT_DURATION): return wait_for_element_exists_and_has_non_empty_attribute(browser, css_selector, 'innerText', wait_duration) def wait_for_an_element_with_partial_link_text_exists(browser, partial_link_text, wait_duration=DEFAULT_WAIT_DURATION): try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(an_element_with_partial_link_text_exists(partial_link_text)) return element except Exception as e: raise Exception("Could not find a DOM element that contains expected partial link text '" + partial_link_text + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_for_an_element_with_link_text_exists(browser, link_text, wait_duration=DEFAULT_WAIT_DURATION): try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until(an_element_with_link_text_exists(link_text)) return element except Exception as e: raise Exception("Could not find a DOM element that has expected link text '" + link_text + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_for_element_exists(browser, css_selector, wait_duration=DEFAULT_WAIT_DURATION): try: ignored_exceptions = (NoSuchElementException, StaleElementReferenceException,) custom_wait = WebDriverWait(browser, wait_duration, ignored_exceptions=ignored_exceptions) element = custom_wait.until( EC.presence_of_element_located((By.CSS_SELECTOR, css_selector)) ) return element except Exception as e: raise Exception("Could not find expected DOM element '" + css_selector + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_for_element_visible(browser, css_selector, wait_duration=DEFAULT_WAIT_DURATION): try: return WebDriverWait(browser, wait_duration).until( EC.visibility_of_element_located((By.CSS_SELECTOR, css_selector)) ) except Exception as e: raise Exception("Could not find expected visible DOM element '" + css_selector + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_for_elements_exist(browser, css_selector, wait_duration=DEFAULT_WAIT_DURATION): try: return WebDriverWait(browser, wait_duration).until( EC.presence_of_all_elements_located((By.CSS_SELECTOR, css_selector)) ) except Exception as e: raise Exception("Could not find expected DOM elements '" + css_selector + "' until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def wait_until_page_url_changes(browser, old_url, wait_duration=DEFAULT_WAIT_DURATION): try: return WebDriverWait(browser, wait_duration).until( lambda driver: old_url != driver.current_url ) except Exception as e: raise Exception("Could not detect a change in page URL until timeout of " + str(wait_duration) + " seconds." + printable_page_source(browser)) from e def set_element_attribute(browser, element_dom_id, attribute_key, attribute_value): browser.execute_script("let el = document.getElementById('" + element_dom_id + "'); el.setAttribute('" + attribute_key + "','" + attribute_value + "');") def verify_element_label(element, expected_label): element_real_label = element.get_attribute('innerText') assert expected_label in element_real_label, 'Expected label "' + expected_label + '" not found in element label "' + element_real_label + "'" def verify_all_elements_have_attribute_value(browser, elements_css_selector, attribute_name, attribute_value, wait_duration=DEFAULT_WAIT_DURATION, extractor=(lambda x: x)): elements = wait_for_elements_exist(browser, elements_css_selector, wait_duration) assert len(elements) > 0, "Error: could not find any element in page matching this CSS selector" + printable_page_source(browser) for element in extractor(elements): assert element.get_attribute(attribute_name) == attribute_value, "Error: One of the elements corresponding to this CSS selector has a value of '" + element.get_attribute(attribute_name) + "' instead of expected '" + attribute_value + "'" + printable_page_source(browser) def verify_some_elements_have_attribute_value(browser, elements_css_selector, attribute_name, attribute_value, necessary_elements): elements = wait_for_elements_exist(browser, elements_css_selector) assert len(elements) > 0, "Error: could not find any element in page matching this CSS selector." + printable_page_source(browser) elements_matching_condition = 0 for element in elements: if element.get_attribute(attribute_name) == attribute_value: elements_matching_condition += 1 if elements_matching_condition >= necessary_elements: break assert elements_matching_condition >= necessary_elements, "Error: Not enough elements corresponding to this CSS selector have a value of '" + attribute_value + "' (" + str(elements_matching_condition) + " instead of expected minimum of " + str(necessary_elements) + ")." + printable_page_source(browser) belenios-2.2-10-gbb6b7ea8/tests/selenium/util/fake_sent_emails_manager.py0000644000175000017500000000762614476041226025406 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import re import subprocess import tempfile class FakeSentEmailsManager: def __init__(self, log_file_path=None): if log_file_path is None: (file_handle, log_file_path) = tempfile.mkstemp(text=True) self.log_file_path = log_file_path # self.install_fake_sendmail_log_file() def find_in_sent_emails(self, text): with open(self.log_file_path) as fl: return text in fl.read() def count_occurences_in_sent_emails(self, text): with open(self.log_file_path) as file: count = file.read().count(text) return count def count_lines(self): i = 0 with open(self.log_file_path) as f: for i, l in enumerate(f): pass return i + 1 def separate_sent_emails(self): """ Converts the file that gathers all sent emails to an array with one element per sent email. Each element is a dictionary with fields "to", "subject", and "full_content". :return: array """ # Email content is encoded using "quoted-printable" encoding. Please refer to https://en.wikipedia.org/wiki/Quoted-printable for more information. For example, this enconding transforms "@" into "=40". TODO: We could improve this function by having it directly decode the part of the email that is encoded, using `quopri` library for example. marker_for_end_of_email = "--=20" result = [] with open(self.log_file_path) as file: contents = file.read() separated_emails = contents.split(marker_for_end_of_email) if len(separated_emails[-1]) < 5: # The last sent email ends with marker_for_end_of_email, so we can ignore what comes after separated_emails.pop() for email_full_content in separated_emails: email_to = "" match = re.search(r'^To: "(.*)"', email_full_content, re.MULTILINE) if match: email_to = match.group(1) email_subject = "" match = re.search(r'^Subject: (.*)$', email_full_content, re.MULTILINE) if match: email_subject = match.group(1) element = { "to": email_to, "subject": email_subject, "full_content": email_full_content } result.append(element) return result def install_fake_sendmail_log_file(self): subprocess.run(["rm", "-f", self.log_file_path]) # TODO: Execute a command that works on other OS, like `os.remove()` subprocess.run(["touch", self.log_file_path]) # TODO: Execute a command that works on other OS, like `pathlib.Path.touch()` def uninstall_fake_sendmail_log_file(self): subprocess.run(["rm", "-f", self.log_file_path]) # TODO: Execute a command that works on other OS, like `os.remove()` def send_email(self, from_email_address, to_email_address, subject, content): from datetime import datetime username_and_email_format = "\"{username}\" <{email_address}>" from_label = username_and_email_format.format(username=from_email_address, email_address=from_email_address) to_label = username_and_email_format.format(username=to_email_address, email_address=to_email_address) date_label = datetime.now().strftime("%a, %d %b %Y %H:%M:%S %z") full_content_format = """\ Content-type: text/plain; charset="UTF-8" Content-transfer-encoding: quoted-printable From: {from_label} To: {to_label} Subject: {subject} MIME-Version: 1.0 X-Mailer: Belenios Automated Tests Date: {date_label} {content} --=20\ """ full_content = full_content_format.format(from_label=from_label, to_label=to_label, subject=subject, date_label=date_label, content=content) with open(self.log_file_path, "a") as myfile: myfile.write(full_content) belenios-2.2-10-gbb6b7ea8/tests/selenium/test_scenario_2.py0000644000175000017500000012322314476041226022521 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import subprocess import re import sys import json from collections import OrderedDict from uuid import uuid4 from selenium.common.exceptions import UnexpectedAlertPresentException from selenium.webdriver.support.select import Select from util.fake_sent_emails_manager import FakeSentEmailsManager from util.selenium_tools import wait_for_element_exists, wait_for_element_exists_and_contains_expected_text, wait_for_element_exists_and_has_non_empty_content, wait_for_an_element_with_partial_link_text_exists, set_element_attribute, wait_for_element_exists_and_has_non_empty_attribute, verify_all_elements_have_attribute_value, verify_some_elements_have_attribute_value, wait_for_elements_exist_and_are_visible, wait_for_an_element_with_link_text_exists from util.election_testing import strtobool, random_email_addresses_generator, remove_database_folder, remove_election_from_database, wait_a_bit, build_css_selector_to_find_buttons_in_page_content_by_value, initialize_server, initialize_browser, election_page_url_to_election_id, verify_election_consistency, create_election_data_snapshot, delete_election_data_snapshot, log_in_as_administrator, log_out, administrator_starts_creation_of_election, administrator_edits_election_questions, administrator_sets_election_voters, administrator_validates_creation_of_election from util.election_test_base import BeleniosElectionTestBase from util.execution import console_log, ConsoleLogDuration import settings def initialize_browser_for_scenario_2(): return initialize_browser(for_scenario_2=True) class BeleniosTestElectionScenario2Base(BeleniosElectionTestBase): """ Properties: - server - browser - fake_sent_emails_manager: An instance of FakeSentEmailsManager - voters_email_addresses: A list of email addresses (strings). This is all users who are invited to vote - voters_email_addresses_who_have_lost_their_password: A list of email addresses (strings). This is all users who have asked for a new password. - voters_email_addresses_who_have_voted: A dictionary, indexed by email address (string), where each element value is True - voters_data: A dictionary, indexed by email address (string), where each element is a dictionary of fields for the voter who is identified by this email address. This is data about all users who have voted. - election_page_url: The election page URL (string). Example: "http://localhost:8001/elections/H5ecRG3wHZ21cp/" - election_id: The election ID (string). Example: "H5ecRG3wHZ21cp" - draft_election_administration_page_url: URL of the draft election administration page - credential_authority_link - credential_authority_file_paths - links_for_trustees - downloaded_files_paths_per_trustee - temporary_files_to_remove_after_test - closed_election_tally_links_for_trustees """ def __init__(self, *args, **kw): super().__init__(*args, **kw) self.draft_election_administration_page_url = None self.credential_authority_link = None self.credential_authority_file_paths = dict() # A dict where key is a label describing the file and value is the absolute path to file self.links_for_trustees = [] self.downloaded_files_paths_per_trustee = dict() # A dict where key is trustee email address, and value is a dict where key is file label (for example "private key" or "public key"), and value is the absolute path to the file self.temporary_files_to_remove_after_test = [] self.closed_election_tally_links_for_trustees = [] def setUp(self): self.fake_sent_emails_manager = FakeSentEmailsManager(settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) self.fake_sent_emails_manager.install_fake_sendmail_log_file() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: pass self.server = initialize_server() self.browser = initialize_browser_for_scenario_2() def tearDown(self): self.browser.quit() self.server.kill() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: if self.election_id: remove_election_from_database(self.election_id) self.fake_sent_emails_manager.uninstall_fake_sendmail_log_file() self.remove_temporary_files() def remember_temporary_file_to_remove_after_test(self, file_path): self.temporary_files_to_remove_after_test.append(file_path) def remove_temporary_files(self): for el in self.temporary_files_to_remove_after_test: subprocess.run(["rm", "-f", el]) # TODO: Execute a command that works on other OS, like `os.remove()` def administrator_starts_creation_of_manual_election(self, nh_question=False): # # Setting up a new election (action of the administrator) browser = self.browser # Alice has been given administrator rights on an online voting app called Belenios. She goes # to check out its homepage and logs in log_in_as_administrator(browser) # She starts creation of the election: # - She clicks on the "Prepare a new election" link # - She picks the Credential management method: manual # (- She keeps default value for Authentication method: it is Password, not CAS) # - She clicks on the "Proceed" button (this redirects to the "Preparation of election" page) # - In the "Name and description of the election" section, she changes values of fields name and description of the election # - She clicks on the "Save changes button" (the one that is next to the election description field) # - In "Contact" section, she changes the value of "contact" field # - She clicks on the "Save changes" button (the one that is in the "Contact" section) administrator_starts_creation_of_election(browser, True) # She remembers the URL of the draft election administration page self.draft_election_administration_page_url = browser.current_url # She edits election's questions: # - She clicks on the "Edit questions" link, to write her own questions # - She arrives on the Questions page. She checks that the page title is correct # - She removes answer 3 # - She clicks on the "Save changes" button (this redirects to the "Preparation of election" page) administrator_edits_election_questions(browser, nh_question) # She sets election's voters: # - She clicks on the "Edit voters" link, to then type the list of voters # - She types N e-mail addresses (the list of invited voters) # - She clicks on the "Add" button to submit changes # - She clicks on "Go back to election draft" link self.voters_email_addresses = random_email_addresses_generator(settings.NUMBER_OF_INVITED_VOTERS) administrator_sets_election_voters(browser, self.voters_email_addresses) # In "Authentication" section, she clicks on the "Generate and mail missing passwords" button generate_and_mail_missing_passwords_button_label = "Generate and mail missing passwords" generate_and_mail_missing_passwords_button_css_selector = "#main input[type=submit][value='" + generate_and_mail_missing_passwords_button_label + "']" generate_and_mail_missing_passwords_button_element = wait_for_element_exists(browser, generate_and_mail_missing_passwords_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) generate_and_mail_missing_passwords_button_element.click() # FIXME: This click does not get triggered when we have maximized the browser window wait_a_bit() # She checks that the page contains expected confirmation text, instead of an error (TODO: explain in which case an error can happen, and check that it does not show) confirmation_sentence_expected_text = "Passwords have been generated and mailed!" confirmation_sentence_css_selector = "#main p" wait_for_element_exists_and_contains_expected_text(browser, confirmation_sentence_css_selector, confirmation_sentence_expected_text, settings.EXPLICIT_WAIT_TIMEOUT) # She clicks on the "Proceed" link (this redirects to the "Preparation of election" page) proceed_link_expected_label = "Proceed" proceed_link_css_selector = "#main a" proceed_link_element = wait_for_element_exists_and_contains_expected_text(browser, proceed_link_css_selector, proceed_link_expected_label, settings.EXPLICIT_WAIT_TIMEOUT) proceed_link_element.click() wait_a_bit() # In "Credentials" section, she clicks on "Credential management" link credential_management_expected_label = "Credential management" credential_management_link_element = wait_for_an_element_with_partial_link_text_exists(browser, credential_management_expected_label) credential_management_link_element.click() wait_a_bit() # She fills in her public name, then clicks on "Set" credential_authority_css_selector = "#main form input[name=__co_eliom_name]" credential_authority_element = wait_for_element_exists(browser, credential_authority_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) credential_authority_element.clear() credential_authority_element.send_keys("Cecily") credential_authority_set_css_selector = "#main form input[type=submit]" credential_authority_set_element = browser.find_element_by_css_selector(credential_authority_set_css_selector) credential_authority_set_element.click() wait_a_bit() # She clicks on the "Proceed" link proceed_link_expected_label = "Proceed" proceed_link_css_selector = "#main a" proceed_link_element = wait_for_element_exists_and_contains_expected_text(browser, proceed_link_css_selector, proceed_link_expected_label, settings.EXPLICIT_WAIT_TIMEOUT) proceed_link_element.click() wait_a_bit() # She remembers the link displayed link_for_credential_authority_css_selector = "#credential_authority_link" link_for_credential_authority_element = wait_for_element_exists_and_has_non_empty_content(browser, link_for_credential_authority_css_selector) link_label = link_for_credential_authority_element.get_attribute('innerText').strip() self.credential_authority_link = link_label # She sends the remembered link to the credential authority by email (actually we don't need to send anything because we will act as the credential authority) # Optionnaly, she logs out # log_out(browser) # She closes the browser window browser.quit() def credential_authority_sends_credentials_to_voters(self): # Cecily, the Credential Authority, receives the email sent by Alice, and opens the link in it self.browser = initialize_browser_for_scenario_2() browser = self.browser browser.get(self.credential_authority_link) wait_a_bit() # She remembers what the link to the election will be, so that she will be able to send it to voters by email with their private credential # TODO: use a better selector: edit Belenios page to use an ID in this DOM element future_election_link_css_selector = "#main ul li" future_election_link_element = wait_for_element_exists_and_has_non_empty_content(browser, future_election_link_css_selector) self.election_page_url = future_election_link_element.get_attribute('innerText').strip() # She clicks on the "Generate" button generate_button_css_selector = "#interactivity button" generate_button_element = wait_for_element_exists(browser, generate_button_css_selector) generate_button_element.click() wait_for_elements_exist_and_are_visible(browser, "#creds") # She clicks on the "private credentials" link and downloads this file. File is by default downloaded to /tmp using filename `creds.txt`, but we choose to name it using an unique identifier instead. link_css_ids = ["creds"] file_labels = ["private credentials"] link_css_selectors = ["#" + el for el in link_css_ids] for idx, link_css_id in enumerate(link_css_ids): link_element = wait_for_element_exists(browser, link_css_selectors[idx]) target_filename = str(uuid4()) + ".txt" set_element_attribute(browser, link_css_id, 'download', target_filename) link_element.click() file_absolute_path = os.path.join(settings.BROWSER_DOWNLOAD_FOLDER, target_filename) self.credential_authority_file_paths[file_labels[idx]] = file_absolute_path # we save the filename in a class instance property, so that we can read the file afterwards (to extract trustee credentials and send them by email to trustees) self.remember_temporary_file_to_remove_after_test(file_absolute_path) wait_a_bit() # She clicks on the "Submit public credentials" button submit_button_css_selector = "#submit_form input[type=submit]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # She checks that redirected page shows correct confirmation sentence expected_content_text = "Credentials have been received and checked!" expected_content_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_content_css_selector, expected_content_text) wait_a_bit() # She closes the window browser.quit() # She reads the private credentials file (creds.txt) and sends credential emails to voters # TODO: Should we check that creds.txt contains the exact same voters email addresses as the ones that admin has added? private_credentials_file_path = self.credential_authority_file_paths["private credentials"] self.credential_authority_sends_credentials_to_voters_from_credentials_file(private_credentials_file_path) def credential_authority_sends_credentials_to_voters_from_credentials_file(self, private_credentials_file_path, voters_email_addresses=None): from_email_address = settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS subject = "Your credential for election " + settings.ELECTION_TITLE content = """You are listed as a voter for the election {election_title} 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. Credential: {credential} Page of the election: {election_url} Note that you are allowed to vote several times. Only the last vote counts.""" with open(private_credentials_file_path) as myfile: data = json.load(myfile, object_pairs_hook=OrderedDict) i = 0 for voter_email_address, voter_private_credential in data.items(): custom_content = content.format(election_title=settings.ELECTION_TITLE, credential=voter_private_credential, election_url=self.election_page_url) self.fake_sent_emails_manager.send_email(from_email_address, voter_email_address, subject, custom_content) i += 1 def administrator_invites_trustees(self): self.browser = initialize_browser_for_scenario_2() browser = self.browser log_in_as_administrator(browser) browser.get(self.draft_election_administration_page_url) wait_a_bit() # In the trustees section, she clicks on the "here" link # TODO: use a better selector: edit Belenios page to use an ID in this DOM element setup_election_key_link_label = "here" setup_election_key_link_element = wait_for_an_element_with_partial_link_text_exists(browser, setup_election_key_link_label) setup_election_key_link_element.click() wait_a_bit() # She adds two trustees (their email address), and remembers the link she will send to each trustee self.links_for_trustees = [] email_address_field_css_selector = "#main form input[type=text]" submit_button_css_selector = "#main form input[type=submit][value=Add]" for idx, email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): email_address_field_element = wait_for_element_exists(browser, email_address_field_css_selector) email_address_field_element.clear() email_address_field_element.send_keys(email_address) submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() trustee_link_css_selector = "#main table tr:nth-of-type(" + str(idx + 3) + ") td:nth-of-type(4) a" # First row of table corresponds to column titles. Second row correpond to server trustee. trustee_link_element = wait_for_element_exists_and_has_non_empty_content(browser, trustee_link_css_selector) self.links_for_trustees.append(trustee_link_element.get_attribute('href')) wait_a_bit() # She sends to each trustee an email containing their own link subject = "Link to generate the decryption key" content_format = """\ Dear trustee, You will find below the link to generate your private decryption key, used to tally the election. {link_for_trustee} Here's the instructions: 1. click on the link 2. click on "generate a new key pair" 3. your private key will appear in another window or tab. Make sure you SAVE IT properly otherwise it will not possible to tally and the election will be canceled. 4. in the first window, click on "submit" to send the public part of your key, used encrypt the votes. For verification purposes, you should save this part (that starts with "pok" "challenge"), for example sending yourself an email. Regarding your private key, it is crucial you save it (otherwise the election will be canceled) and store it securely (if your private key is known together with the private keys of the other trustees, then vote privacy is no longer guaranteed). We suggest two options: 1. you may store the key on a USB stick and store it in a safe. 2. Or you may simply print it and store it in a safe. Of course, more cryptographic solutions are welcome as well. Thank you for your help, -- The election administrator.\ """ for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): custom_content = content_format.format(link_for_trustee=self.links_for_trustees[idx]) self.fake_sent_emails_manager.send_email(settings.ADMINISTRATOR_EMAIL_ADDRESS, trustee_email_address, subject, custom_content) # Optionnaly, she logs out # log_out(browser) # She closes the window browser.quit() def trustees_generate_election_private_keys(self): # Each trustee (Tom and Taylor) will do the following process for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): # Trustee opens link that has been sent to him by election administrator link_for_this_trustee = self.links_for_trustees[idx] # TODO: Decide either not send trustee email at all or read trustee link from email content self.browser = initialize_browser_for_scenario_2() browser = self.browser browser.get(link_for_this_trustee) # He waits for the "Generate a key" button generate_button_css_selector = "#interactivity button" generate_button_expected_label = "Generate a key" generate_button_element = wait_for_element_exists_and_contains_expected_text(browser, generate_button_css_selector, generate_button_expected_label) # He checks that the page content shows the same election URL as the one the administrator saw election_url_css_selector = "#main ul li" election_url_element = wait_for_element_exists_and_has_non_empty_content(browser, election_url_css_selector) election_url_content = election_url_element.get_attribute('innerText').strip() assert election_url_content == self.election_page_url # He clicks on the "Generate a key" button generate_button_element.click() # He clicks on the "private key" and "public key" links, to download the private key and the public key (files are respectively saved by default as `private_key.json` and `public_key.json`, but we decide to save them as a unique file name) link_css_ids = ["private_key"] link_expected_labels = ["private key"] self.downloaded_files_paths_per_trustee[trustee_email_address] = dict() for idx2, link_css_id in enumerate(link_css_ids): link_target_filename = str(uuid4()) + ".json" set_element_attribute(browser, link_css_id, 'download', link_target_filename) link_expected_label = link_expected_labels[idx2] link_element = wait_for_an_element_with_partial_link_text_exists(browser, link_expected_label) assert link_element.get_attribute('id') == link_css_id link_element.click() file_absolute_path = os.path.join(settings.BROWSER_DOWNLOAD_FOLDER, link_target_filename) # We save the filename in a class instance property, so that we can import the file afterwards (during partial decryption step) self.downloaded_files_paths_per_trustee[trustee_email_address][link_expected_labels[idx2]] = file_absolute_path self.remember_temporary_file_to_remove_after_test(file_absolute_path) # He clicks on the "Submit public key" button submit_button_expected_label = "Submit public key" submit_button_css_selector = "#main input[type=submit][value='" + submit_button_expected_label + "']" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() # He checks that the next page shows the expected confirmation sentence expected_confirmation_label = "Your key has been received and checked!" expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) # He closes the window browser.quit() def administrator_completes_creation_of_election(self): # Alice, as an administrator of an election, wants to finalize her draft election creation, to start the vote. # She opens a browser self.browser = initialize_browser_for_scenario_2() browser = self.browser # She logs in as administrator log_in_as_administrator(browser) # She goes to the draft election administration page browser.get(self.draft_election_administration_page_url) # - In "Validate creation" section, she clicks on the "Create election" link # - (She arrives on the "Checklist" page, that lists all main parameters of the election for review, and that flags incoherent or misconfigured parameters. For example, in this test scenario, it displays 2 warnings: "Warning: No trustees were set. This means that the server will manage the election key by itself.", and "Warning: No contact was set!") # - In the "Validate creation" section, she clicks on the "Create election" button # - (She arrives back on the "My test election for Scenario 1 — Administration" page. Its contents have changed. There is now a text saying "The election is open. Voters can vote.", and there are now buttons "Close election", "Archive election", "Delete election") # - She remembers the URL of the voting page, that is where the "Election home" link points to # - She checks that a "Close election" button is present (but she does not click on it) self.election_page_url = administrator_validates_creation_of_election(browser) console_log("election_page_url:", self.election_page_url) self.election_id = election_page_url_to_election_id(self.election_page_url) console_log("election_id:", self.election_id) # She logs out log_out(browser, self.election_id) # She closes the window, and re-opens it (for next emulated user) browser.quit() self.browser = initialize_browser_for_scenario_2() def administrator_starts_tallying_of_election(self, with_threshold=None): browser = self.browser # Alice goes to the election page election_url = self.election_page_url # Could also be obtained with self.voters_data[self.voters_email_addresses[0]]["election_page_url"] browser.get(election_url) wait_a_bit() # She clicks on "en" language select = Select(wait_for_element_exists(browser, ".lang_box select", settings.EXPLICIT_WAIT_TIMEOUT)) select.select_by_value("en") wait_a_bit() # She clicks on the "Administer this election" link administration_link_label = "Administer this election" administration_link_element = wait_for_an_element_with_partial_link_text_exists(browser, administration_link_label, settings.EXPLICIT_WAIT_TIMEOUT) administration_link_element.click() # She logs in as administrator log_in_as_administrator(browser, from_a_login_page=True) wait_a_bit() # She clicks on the "Close election" button close_election_button_label = "Close election" close_election_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(close_election_button_label) close_election_button_element = wait_for_element_exists(browser, close_election_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) close_election_button_element.click() wait_a_bit() # She clicks on the "Proceed to vote counting" button proceed_button_label = "Proceed to vote counting" proceed_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(proceed_button_label) proceed_button_element = wait_for_element_exists(browser, proceed_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_button_element.click() wait_a_bit() if with_threshold is not None: # She checks the presence of text "Awaiting trustees… At least ${U} trustee(s) must act." expected_confirmation_label = "Awaiting trustees… At least " + str(with_threshold) + " trustee(s) must act." expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) # She checks that in the table on every content row, the "DONE?" column is "No" elements_css_selector = "#main table tr td:nth-of-type(4)" attribute_name = "innerText" attribute_value = "No" verify_all_elements_have_attribute_value(browser, elements_css_selector, attribute_name, attribute_value, extractor=(lambda x: x[1:])) # She remembers the link to send to each trustee, so they can tally the election row_padding = 3 self.closed_election_tally_links_for_trustees = [] for idx, email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): trustee_link_css_selector = "#main table tr:nth-of-type(" + str(idx + row_padding) + ") td:nth-of-type(3) a" # First row consists in column titles. Second row is for server. trustee_link_element = wait_for_element_exists_and_has_non_empty_content(browser, trustee_link_css_selector) self.closed_election_tally_links_for_trustees.append(trustee_link_element.get_attribute('href')) # She sends to each trustee an email containing their own link subject = "Link to tally the election" content_format = """\ Dear trustee, The election is now closed. Here's the link to proceed to tally: {link_for_trustee} Here's the instructions: 1. Follow the link. 2. Enter your private decryption key in the first box and click on "generate decryption factors" 3. The second box is now filled with crypto material. Please press the button "submit". Thank you again for your help, -- The election administrator.\ """ for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): custom_content = content_format.format(link_for_trustee=self.closed_election_tally_links_for_trustees[idx]) self.fake_sent_emails_manager.send_email(settings.ADMINISTRATOR_EMAIL_ADDRESS, trustee_email_address, subject, custom_content) # She logs out log_out(browser) # She closes the window browser.quit() def trustees_do_partial_decryption(self, max_trustees=None): # Each of the `T` trustees (limited to `max_trustees`) will do the following process: for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): if max_trustees is not None and idx >= max_trustees: # TODO: Maybe we should pick trustees randomly in the list of trustees instead of always the first few ones? break # He opens the link that Alice (the election administrator) has sent to him self.browser = initialize_browser_for_scenario_2() browser = self.browser link_for_trustee = self.closed_election_tally_links_for_trustees[idx] browser.get(link_for_trustee) wait_a_bit() wait_for_element_exists_and_has_non_empty_content(browser, "#hash") # He verifies that the "private key" input field is empty (at the beginning) private_key_field_css_selector = "#private_key" private_key_field_element = wait_for_element_exists(browser, private_key_field_css_selector) assert private_key_field_element.get_attribute('value') == "" # One trustee uploads his private key file, the other copy-pastes its contents into the form field private_key_file = self.downloaded_files_paths_per_trustee[trustee_email_address]["private key"] if idx % 2 == 0: # He clicks on the "Browse..." button and selects his private key file (initially downloaded as `private_key.json` by default) browse_button_css_selector = "input[id=private_key_file][type=file]" browse_button_element = wait_for_element_exists(browser, browse_button_css_selector) path_of_file_to_upload = private_key_file browse_button_element.clear() browse_button_element.send_keys(path_of_file_to_upload) # He waits until the "private key" input field (that has id "#private_key") becomes not empty anymore. This is because once the user has selected the file to upload, the Javascript code in the page detects that a file has been selected, reads it, and fills "private key" input field with file's contents. The computation triggered by click on the "Compute decryption factors" button will use the value of this field, not directly the uploaded file contents. private_key_field_expected_non_empty_attribute = "value" wait_for_element_exists_and_has_non_empty_attribute(browser, private_key_field_css_selector, private_key_field_expected_non_empty_attribute) else: with open(private_key_file) as myfile: private_key_field_element.send_keys(myfile.read()) wait_a_bit() # He clicks on the "Compute decryption factors" button compute_button_css_selector = "button[id=compute]" compute_button_element = wait_for_element_exists(browser, compute_button_css_selector) compute_button_element.click() # He checks that the text field below (used as visual feedback) now contains text visual_feedback_css_selector = "#pd" visual_feedback_expected_non_empty_attribute = "value" try: wait_for_element_exists_and_has_non_empty_attribute(browser, visual_feedback_css_selector, visual_feedback_expected_non_empty_attribute, 60 * 2) except UnexpectedAlertPresentException as e: raise Exception("An alert was displayed at a moment when no alert should be displayed. Alert displayed probably contains error information about uploaded file contents.") from e # He clicks on the "Submit" button submit_button_css_selector = "#pd_done input[type=submit]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # He checks that next screen contains a confirmation sentence confirmation_sentence_expected_text = "Your partial decryption has been received and checked!" confirmation_sentence_css_selector = "#main p" wait_for_element_exists_and_contains_expected_text(browser, confirmation_sentence_css_selector, confirmation_sentence_expected_text, settings.EXPLICIT_WAIT_TIMEOUT) # He closes the window browser.quit() def administrator_finishes_tallying_of_election(self, max_trustees=None): self.browser = initialize_browser_for_scenario_2() browser = self.browser # Alice goes to the election page election_url = self.election_page_url browser.get(election_url) wait_a_bit() # She clicks on "en" language select = Select(wait_for_element_exists(browser, ".lang_box select", settings.EXPLICIT_WAIT_TIMEOUT)) select.select_by_value("en") wait_a_bit() # She clicks on the "Administer this election" link administration_link_label = "Administer this election" administration_link_element = wait_for_an_element_with_partial_link_text_exists(browser, administration_link_label, settings.EXPLICIT_WAIT_TIMEOUT) administration_link_element.click() # She logs in as administrator log_in_as_administrator(browser, from_a_login_page=True) wait_a_bit() if max_trustees is None: # She clicks on "Election home" election_home_element = wait_for_an_element_with_link_text_exists(browser, "Election home", settings.EXPLICIT_WAIT_TIMEOUT) election_home_element.click() else: # She clicks on the "Compute the result" button compute_result_button_expected_label = "Compute the result" compute_result_button_css_selector = "#main input[type=submit][value='" + compute_result_button_expected_label + "']" compute_result_button_element = wait_for_element_exists(browser, compute_result_button_css_selector) compute_result_button_element.click() wait_a_bit() self.administrator_verifies_vote_results() class BeleniosTestElectionScenario2(BeleniosTestElectionScenario2Base): def test_scenario_2_manual_vote(self): console_log("### Running test method BeleniosTestElectionScenario2::test_scenario_2_manual_vote()") with ConsoleLogDuration("### administrator_starts_creation_of_manual_election"): self.administrator_starts_creation_of_manual_election() with ConsoleLogDuration("### credential_authority_sends_credentials_to_voters"): self.credential_authority_sends_credentials_to_voters() with ConsoleLogDuration("### administrator_invites_trustees"): self.administrator_invites_trustees() with ConsoleLogDuration("### trustees_generate_election_private_keys"): self.trustees_generate_election_private_keys() with ConsoleLogDuration("### administrator_completes_creation_of_election"): self.administrator_completes_creation_of_election() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#0)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### all_voters_vote_in_sequences"): self.all_voters_vote_in_sequences() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#1)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### Starting step: create_election_data_snapshot (#0)"): snapshot_folder = create_election_data_snapshot(self.election_id) console_log("snapshot_folder: ", snapshot_folder) try: with ConsoleLogDuration("### some_voters_revote"): self.some_voters_revote() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify-diff` (#2)"): verify_election_consistency(self.election_id, snapshot_folder) finally: with ConsoleLogDuration("### delete_election_data_snapshot"): delete_election_data_snapshot(snapshot_folder) with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#3)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### administrator_starts_tallying_of_election"): self.administrator_starts_tallying_of_election() with ConsoleLogDuration("### trustees_do_partial_decryption"): self.trustees_do_partial_decryption() with ConsoleLogDuration("### administrator_finishes_tallying_of_election"): self.administrator_finishes_tallying_of_election() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#4)"): verify_election_consistency(self.election_id) if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) settings.INITIATOR_CONTACT = os.getenv('INITIATOR_CONTACT', settings.INITIATOR_CONTACT) settings.BROWSER_DOWNLOAD_FOLDER = os.getenv('BROWSER_DOWNLOAD_FOLDER', settings.BROWSER_DOWNLOAD_FOLDER) settings.ADMINISTRATOR_EMAIL_ADDRESS = os.getenv('ADMINISTRATOR_EMAIL_ADDRESS', settings.ADMINISTRATOR_EMAIL_ADDRESS) settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS = os.getenv('CREDENTIAL_AUTHORITY_EMAIL_ADDRESS', settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS) # TODO: settings.TRUSTEES_EMAIL_ADDRESSES (it cannot be manipulated the same way because it is an array) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("CLEAN_UP_POLICY:", settings.CLEAN_UP_POLICY) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) console_log("INITIATOR_CONTACT:", settings.INITIATOR_CONTACT) console_log("BROWSER_DOWNLOAD_FOLDER:", settings.BROWSER_DOWNLOAD_FOLDER) console_log("ADMINISTRATOR_EMAIL_ADDRESS:", settings.ADMINISTRATOR_EMAIL_ADDRESS) console_log("CREDENTIAL_AUTHORITY_EMAIL_ADDRESS:", settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS) console_log("TRUSTEES_EMAIL_ADDRESSES:", settings.TRUSTEES_EMAIL_ADDRESSES) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/test_scenario_1.py0000644000175000017500000002151314476041226022517 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys from selenium.webdriver.support.select import Select from util.fake_sent_emails_manager import FakeSentEmailsManager from util.selenium_tools import wait_for_element_exists, wait_for_an_element_with_partial_link_text_exists, wait_for_an_element_with_link_text_exists from util.election_testing import strtobool, remove_database_folder, remove_election_from_database, wait_a_bit, build_css_selector_to_find_buttons_in_page_content_by_value, initialize_server, initialize_browser, verify_election_consistency, create_election_data_snapshot, delete_election_data_snapshot, log_in_as_administrator from util.election_test_base import BeleniosElectionTestBase from util.execution import console_log, ConsoleLogDuration import settings class BeleniosTestElectionScenario1(BeleniosElectionTestBase): def setUp(self): self.fake_sent_emails_manager = FakeSentEmailsManager(settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) self.fake_sent_emails_manager.install_fake_sendmail_log_file() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: pass self.server = initialize_server() self.browser = initialize_browser() def tearDown(self): self.browser.quit() self.server.kill() if settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_DATABASE: remove_database_folder() elif settings.CLEAN_UP_POLICY == settings.CLEAN_UP_POLICIES.REMOVE_ELECTION: if self.election_id: remove_election_from_database(self.election_id) self.fake_sent_emails_manager.uninstall_fake_sendmail_log_file() def administrator_does_tallying_of_election(self): browser = self.browser # Alice goes to the election page election_url = self.election_page_url # Could also be obtained with self.voters_data[self.voters_email_addresses[0]]["election_page_url"] browser.get(election_url) wait_a_bit() # She clicks on "en" language select = Select(wait_for_element_exists(browser, ".lang_box select", settings.EXPLICIT_WAIT_TIMEOUT)) select.select_by_value("en") wait_a_bit() # She clicks on the "Administer this election" link administration_link_label = "Administer this election" administration_link_element = wait_for_an_element_with_partial_link_text_exists(browser, administration_link_label, settings.EXPLICIT_WAIT_TIMEOUT) administration_link_element.click() # She logs in as administrator log_in_as_administrator(browser, from_a_login_page=True) wait_a_bit() # She clicks on the "Close election" button close_election_button_label = "Close election" close_election_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(close_election_button_label) close_election_button_element = wait_for_element_exists(browser, close_election_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) close_election_button_element.click() wait_a_bit() # She clicks on the "Proceed to vote counting" button proceed_button_label = "Proceed to vote counting" proceed_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(proceed_button_label) proceed_button_element = wait_for_element_exists(browser, proceed_button_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) proceed_button_element.click() wait_a_bit() # She clicks on "Election home" election_home_element = wait_for_an_element_with_link_text_exists(browser, "Election home", settings.EXPLICIT_WAIT_TIMEOUT) election_home_element.click() wait_a_bit() self.administrator_verifies_vote_results() def test_scenario_1_simple_vote(self): with ConsoleLogDuration("### administrator_creates_election"): self.administrator_creates_election() with ConsoleLogDuration("### administrator_regenerates_passwords_for_some_voters"): self.administrator_regenerates_passwords_for_some_voters() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#0)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### all_voters_vote_in_sequences"): self.all_voters_vote_in_sequences() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#1)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### create_election_data_snapshot (#0)"): snapshot_folder = create_election_data_snapshot(self.election_id) console_log("snapshot_folder: ", snapshot_folder) try: with ConsoleLogDuration("### some_voters_revote"): self.some_voters_revote() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify-diff` (#2)"): verify_election_consistency(self.election_id, snapshot_folder) finally: with ConsoleLogDuration("### delete_election_data_snapshot"): delete_election_data_snapshot(snapshot_folder) with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#3)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### administrator_does_tallying_of_election"): self.administrator_does_tallying_of_election() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#4)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### one_voter_revotes_after_the_election_is_closed"): self.one_voter_revotes_after_the_election_is_closed() if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("CLEAN_UP_POLICY:", settings.CLEAN_UP_POLICY) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/test_scenario_4.py0000644000175000017500000010503114476041226022520 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys from uuid import uuid4 from util.selenium_tools import wait_for_element_exists, wait_for_element_exists_and_contains_expected_text, wait_for_element_exists_and_has_non_empty_content, wait_for_an_element_with_partial_link_text_exists, set_element_attribute, wait_for_element_exists_and_has_non_empty_attribute, verify_all_elements_have_attribute_value from util.election_testing import strtobool, wait_a_bit, election_page_url_to_election_id, verify_election_consistency, create_election_data_snapshot, delete_election_data_snapshot, log_in_as_administrator, log_out, administrator_validates_creation_of_election from util.execution import console_log, ConsoleLogDuration from test_scenario_2 import BeleniosTestElectionScenario2Base, initialize_browser_for_scenario_2 import settings def verify_all_trustee_states_in_table(browser, expected_value): state_column_css_selector = "#main table tr td:last-of-type" attribute_name = "innerText" verify_all_elements_have_attribute_value(browser, state_column_css_selector, attribute_name, expected_value) def verify_trustee_state_in_table(browser, current_trustee_id, expected_value): table_row_padding = 2 state_column_css_selector = "#main table tr:nth-of-type(" + str(current_trustee_id + table_row_padding) + ") td:last-of-type" wait_for_element_exists_and_contains_expected_text(browser, state_column_css_selector, expected_value) class BeleniosTestElectionScenario4(BeleniosTestElectionScenario2Base): """ As this class inherits from `BeleniosTestElectionScenario2Base`, it uses its `setUp()` and `tearDown()` methods, which includes clean up of election or whole database depending on the value of environment variable `CLEAN_UP_POLICY`. Properties: - server - browser - fake_sent_emails_manager: An instance of FakeSentEmailsManager - voters_email_addresses: A list of email addresses (strings). This is all users who are invited to vote - voters_email_addresses_who_have_lost_their_password: A list of email addresses (strings). This is all users who have asked for a new password. - voters_email_addresses_who_have_voted: A dictionary, indexed by email address (string), where each element value is True - voters_data: A dictionary, indexed by email address (string), where each element is a dictionary of fields for the voter who is identified by this email address. This is data about all users who have voted. - election_page_url: The election page URL (string). Example: "http://localhost:8001/elections/H5ecRG3wHZ21cp/" - election_id: The election ID (string). Example: "H5ecRG3wHZ21cp" - draft_election_administration_page_url: URL of the draft election administration page - credential_authority_link - credential_authority_file_paths - links_for_trustees - downloaded_files_paths_per_trustee - temporary_files_to_remove_after_test - closed_election_tally_links_for_trustees """ __test__ = True def __init__(self, *args, **kw): super().__init__(*args, **kw) self.draft_election_administration_page_url = None self.credential_authority_link = None self.credential_authority_file_paths = dict() # A dict where key is a label describing the file and value is the absolute path to file self.links_for_trustees = [] self.downloaded_files_paths_per_trustee = dict() # A dict where key is trustee email address, and value is a dict where key is file label (for example "private key" or "public key"), and value is the absolute path to the file self.temporary_files_to_remove_after_test = [] self.closed_election_tally_links_for_trustees = [] def administrator_invites_trustees_and_sets_threshold(self): self.browser = initialize_browser_for_scenario_2() browser = self.browser log_in_as_administrator(browser) browser.get(self.draft_election_administration_page_url) wait_a_bit() # In the trustees section, she clicks on the "here" link setup_election_key_link_label = "here" setup_election_key_link_element = wait_for_an_element_with_partial_link_text_exists(browser, setup_election_key_link_label) setup_election_key_link_element.click() wait_a_bit() # She clicks on the "threshold mode" link threshold_mode_link_label = "threshold mode" threshold_mode_link_element = wait_for_an_element_with_partial_link_text_exists(browser, threshold_mode_link_label) threshold_mode_link_element.click() wait_a_bit() # She adds `NUMBER_OF_TRUSTEES` trustees (their email address), and remembers the link she will send to each trustee # (The threshold field appears only after user has added the first trustee) self.links_for_trustees = [] email_address_field_css_selector = "#main form input[name=__co_eliom_id]" # TODO: Maybe we should edit Belenios' HTML template to rename `__co_eliom_id` to something more explicit, like `__co_eliom_new_trustee_email_address` submit_button_css_selector = "#main form input[type=submit][value=Add]" for idx, email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): email_address_field_element = wait_for_element_exists(browser, email_address_field_css_selector) email_address_field_element.clear() email_address_field_element.send_keys(email_address) submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() trustee_link_css_selector = "#main table tbody tr:nth-of-type(" + str(idx + 2) + ") td:nth-of-type(4) a" trustee_link_element = wait_for_element_exists_and_has_non_empty_content(browser, trustee_link_css_selector) self.links_for_trustees.append(trustee_link_element.get_attribute('href')) wait_a_bit() # In the field next to "Threshold:", she types the value of `U` (aka `TRUSTEES_THRESHOLD_VALUE`) threshold_value_field_css_selector = "#main form input[name=__co_eliom_threshold]" threshold_value_field_element = wait_for_element_exists(browser, threshold_value_field_css_selector, settings.EXPLICIT_WAIT_TIMEOUT) threshold_value_field_value = settings.TRUSTEES_THRESHOLD_VALUE threshold_value_field_element.clear() threshold_value_field_element.send_keys(threshold_value_field_value) wait_a_bit() # She clicks on the "Set" button submit_button_css_selector = "#main form input[type=submit][value=Set]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # She checks that in the table, the "STATE" column is "1a" on every row expected_value = "1a" verify_all_trustee_states_in_table(browser, expected_value) # She sends to each trustee an email containing their own link subject = "Link to generate the decryption key" content_format = """\ Dear trustee, You will find below the link to generate your private decryption key, used to tally the election. {link_for_trustee} Here's the instructions: 1. click on the link 2. click on "generate a new key pair" 3. your private key will appear in another window or tab. Make sure you SAVE IT properly otherwise it will not possible to tally and the election will be canceled. 4. in the first window, click on "submit" to send the public part of your key, used encrypt the votes. For verification purposes, you should save this part (that starts with "pok" "challenge"), for example sending yourself an email. Regarding your private key, it is crucial you save it (otherwise the election will be canceled) and store it securely (if your private key is known together with the private keys of the other trustees, then vote privacy is no longer guaranteed). We suggest two options: 1. you may store the key on a USB stick and store it in a safe. 2. Or you may simply print it and store it in a safe. Of course, more cryptographic solutions are welcome as well. Thank you for your help, -- The election administrator.\ """ for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): custom_content = content_format.format(link_for_trustee=self.links_for_trustees[idx]) self.fake_sent_emails_manager.send_email(settings.ADMINISTRATOR_EMAIL_ADDRESS, trustee_email_address, subject, custom_content) # Optionnaly, she logs out # log_out(browser) # She closes the window browser.quit() def trustees_do_initialization_step_1_of_3(self): # Trustees initialization step 1/3: Trustees generate election private keys. Each of the `T` (aka `NUMBER_OF_TRUSTEES`) trustees will do the following process: for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): # Trustee opens link that has been sent to him by election administrator link_for_this_trustee = self.links_for_trustees[idx] # TODO: Decide either not send trustee email at all or read trustee link from email content self.browser = initialize_browser_for_scenario_2() browser = self.browser browser.get(link_for_this_trustee) wait_a_bit() # He checks that the page content shows the same election URL as the one the administrator saw election_url_css_selector = "#main ul li" election_url_element = wait_for_element_exists_and_has_non_empty_content(browser, election_url_css_selector) election_url_content = election_url_element.get_attribute('innerText').strip() assert election_url_content == self.election_page_url # He clicks on the "Generate private key" button generate_button_css_selector = "#interactivity button" generate_button_expected_label = "Generate private key" generate_button_element = wait_for_element_exists_and_contains_expected_text(browser, generate_button_css_selector, generate_button_expected_label) generate_button_element.click() wait_a_bit() # He clicks on the "private key" link, to download the private key (file is saved by default as `private_key.txt`) link_css_ids = ["private_key"] link_expected_labels = ["private key"] if trustee_email_address not in self.downloaded_files_paths_per_trustee: self.downloaded_files_paths_per_trustee[trustee_email_address] = dict() for idx2, link_css_id in enumerate(link_css_ids): link_target_filename = str(uuid4()) + ".txt" set_element_attribute(browser, link_css_id, 'download', link_target_filename) link_expected_label = link_expected_labels[idx2] link_element = wait_for_an_element_with_partial_link_text_exists(browser, link_expected_label) assert link_element.get_attribute('id') == link_css_id link_element.click() file_absolute_path = os.path.join(settings.BROWSER_DOWNLOAD_FOLDER, link_target_filename) # We save the filename in a class instance property, so that we can import the file afterwards (during partial decryption step) self.downloaded_files_paths_per_trustee[trustee_email_address][link_expected_labels[idx2]] = file_absolute_path self.remember_temporary_file_to_remove_after_test(file_absolute_path) wait_a_bit() # He clicks on the "Submit" button submit_button_expected_label = "Submit" submit_button_css_selector = "#main input[type=submit][value='" + submit_button_expected_label + "']" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # He checks that the next page shows the expected confirmation sentence (If trustee was the last one in the list, he checks that page contains text "Now, all the certificates of the trustees have been generated. Proceed to generate your share of the decryption key.", else he checks for sentence "Waiting for the other trustees... Reload the page to check progress.") if idx == settings.NUMBER_OF_TRUSTEES - 1: expected_confirmation_label = "Now, all the certificates of the trustees have been generated. Proceed to generate your share of the decryption key." else: expected_confirmation_label = "Waiting for the other trustees... Reload the page to check progress." expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) wait_a_bit() # He closes the window browser.quit() # Administrator logs in, and selects the election by clicking on its link self.browser = initialize_browser_for_scenario_2() browser = self.browser log_in_as_administrator(browser) browser.get(self.draft_election_administration_page_url) wait_a_bit() # In the trustees section, she clicks on the "here" link setup_election_key_link_label = "here" setup_election_key_link_element = wait_for_an_element_with_partial_link_text_exists(browser, setup_election_key_link_label) setup_election_key_link_element.click() wait_a_bit() # If current trustee is the last one, she checks that in the table, the "STATE" column is now "2a" on every row. Else, she checks that in the table on the current trustee row, the "STATE" column is now "1b" (instead of "1a") if idx == settings.NUMBER_OF_TRUSTEES - 1: expected_value = "2a" verify_all_trustee_states_in_table(browser, expected_value) else: expected_value = "1b" verify_trustee_state_in_table(browser, idx, expected_value) wait_a_bit() # She closes the window browser.quit() def trustees_do_initialization_step_2_of_3(self): # Trustees initialization step 2/3: Trustees generate their share of the decryption key. Each of the `T` (aka `NUMBER_OF_TRUSTEES`) trustees will do the following process: for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): # Trustee opens link that has been sent to him by election administrator link_for_this_trustee = self.links_for_trustees[idx] # TODO: Decide either not send trustee email at all or read trustee link from email content self.browser = initialize_browser_for_scenario_2() browser = self.browser browser.get(link_for_this_trustee) wait_a_bit() # He checks that the page content shows the same election URL as the one the administrator saw election_url_css_selector = "#main ul li" election_url_element = wait_for_element_exists_and_has_non_empty_content(browser, election_url_css_selector) election_url_content = election_url_element.get_attribute('innerText').strip() assert election_url_content == self.election_page_url # He checks the presence of text "Now, all the certificates of the trustees have been generated. Proceed to generate your share of the decryption key." expected_confirmation_label = "Now, all the certificates of the trustees have been generated. Proceed to generate your share of the decryption key." expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) # In field next to "Enter your private key:", he types the content of the `private_key.txt` file he downloaded private_key_storage_label = "private key" private_key_file = self.downloaded_files_paths_per_trustee[trustee_email_address][private_key_storage_label] private_key_css_selector = "#compute_private_key" private_key_element = wait_for_element_exists(browser, private_key_css_selector) private_key_element.clear() with open(private_key_file) as myfile: private_key_element.send_keys(myfile.read()) wait_a_bit() # He clicks on the "Proceed" button proceed_button_css_selector = "#compute_button" proceed_button_element = wait_for_element_exists(browser, proceed_button_css_selector) proceed_button_element.click() # He waits until the text field next to "Data:" contains text, and clicks on the "Submit" button data_field_css_selector = "#compute_data" data_field_expected_non_empty_attribute = "value" wait_for_element_exists_and_has_non_empty_attribute(browser, data_field_css_selector, data_field_expected_non_empty_attribute) submit_button_expected_label = "Submit" submit_button_css_selector = "#compute_form input[type=submit][value=" + submit_button_expected_label + "]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # If he is not the last trustee in the list, he checks that the next page contains text "Waiting for the other trustees... Reload the page to check progress.". Else, he checks that the next page contains text "Now, all the trustees have generated their secret shares. Proceed to the final checks so that the election can be validated." if idx == settings.NUMBER_OF_TRUSTEES - 1: expected_confirmation_label = "Now, all the trustees have generated their secret shares. Proceed to the final checks so that the election can be validated." else: expected_confirmation_label = "Waiting for the other trustees... Reload the page to check progress." expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) wait_a_bit() # He closes the window browser.quit() # Administrator logs in, and selects the election by clicking on its link self.browser = initialize_browser_for_scenario_2() browser = self.browser log_in_as_administrator(browser) browser.get(self.draft_election_administration_page_url) wait_a_bit() # In the trustees section, she clicks on the "here" link setup_election_key_link_label = "here" setup_election_key_link_element = wait_for_an_element_with_partial_link_text_exists(browser, setup_election_key_link_label) setup_election_key_link_element.click() wait_a_bit() # If current trustee is the last one, she checks that in the table, the "STATE" column is now "3a" on every row. Else, she checks that in the table on the current trustee row, the "STATE" column is now "2b" (instead of "2a") if idx == settings.NUMBER_OF_TRUSTEES - 1: expected_value = "3a" verify_all_trustee_states_in_table(browser, expected_value) else: expected_value = "2b" verify_trustee_state_in_table(browser, idx, expected_value) wait_a_bit() # She closes the window browser.quit() def trustees_do_initialization_step_3_of_3(self): # Trustees initialization step 3/3: Trustees do the final checks so that the election can be validated. Each of the `T` (aka `NUMBER_OF_TRUSTEES`) trustees will do the following process: for idx, trustee_email_address in enumerate(settings.TRUSTEES_EMAIL_ADDRESSES): # Trustee opens link that has been sent to him by election administrator link_for_this_trustee = self.links_for_trustees[idx] # TODO: Decide either not send trustee email at all or read trustee link from email content self.browser = initialize_browser_for_scenario_2() browser = self.browser browser.get(link_for_this_trustee) wait_a_bit() # He checks that the page content shows the same election URL as the one the administrator saw election_url_css_selector = "#main ul li" election_url_element = wait_for_element_exists_and_has_non_empty_content(browser, election_url_css_selector) election_url_content = election_url_element.get_attribute('innerText').strip() assert election_url_content == self.election_page_url # He checks the presence of text "Step 3/3" expected_confirmation_label = "Step 3/3" expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) # In field next to "Enter your private key:", he types the content of the `private_key.txt` file he downloaded private_key_storage_label = "private key" private_key_file = self.downloaded_files_paths_per_trustee[trustee_email_address][private_key_storage_label] private_key_css_selector = "#compute_private_key" private_key_element = wait_for_element_exists(browser, private_key_css_selector) private_key_element.clear() with open(private_key_file) as myfile: private_key_element.send_keys(myfile.read()) wait_a_bit() # He clicks on the "Proceed" button proceed_button_css_selector = "#compute_button" proceed_button_element = wait_for_element_exists(browser, proceed_button_css_selector) proceed_button_element.click() # He waits until the text field next to "Data:" contains text, and clicks on the "Submit" button data_field_css_selector = "#compute_data" data_field_expected_non_empty_attribute = "value" wait_for_element_exists_and_has_non_empty_attribute(browser, data_field_css_selector, data_field_expected_non_empty_attribute) submit_button_expected_label = "Submit" submit_button_css_selector = "#compute_form input[type=submit][value=" + submit_button_expected_label + "]" submit_button_element = wait_for_element_exists(browser, submit_button_css_selector) submit_button_element.click() wait_a_bit() # He checks that the next page contains text "Your job in the key establishment protocol is done!" expected_confirmation_label = "Your job in the key establishment protocol is done!" expected_confirmation_css_selector = "#main" wait_for_element_exists_and_contains_expected_text(browser, expected_confirmation_css_selector, expected_confirmation_label) wait_a_bit() # He closes the window browser.quit() # Administrator logs in, and selects the election by clicking on its link self.browser = initialize_browser_for_scenario_2() browser = self.browser log_in_as_administrator(browser) browser.get(self.draft_election_administration_page_url) wait_a_bit() # In the trustees section, she clicks on the "here" link setup_election_key_link_label = "here" setup_election_key_link_element = wait_for_an_element_with_partial_link_text_exists(browser, setup_election_key_link_label) setup_election_key_link_element.click() wait_a_bit() # If current trustee is the last one, she checks that in the table, the "STATE" column is now "done" on every row. Else, she checks that in the table on the current trustee row, the "STATE" column is now "3b" (instead of "3a") if idx == settings.NUMBER_OF_TRUSTEES - 1: expected_value = "done" verify_all_trustee_states_in_table(browser, expected_value) else: expected_value = "3b" verify_trustee_state_in_table(browser, idx, expected_value) wait_a_bit() # She closes the window browser.quit() def administrator_completes_creation_of_election(self): # Alice, as an administrator of an election, wants to finalize her draft election creation, to start the vote. # She opens a browser self.browser = initialize_browser_for_scenario_2() browser = self.browser # She logs in as administrator log_in_as_administrator(browser) # She goes to the draft election administration page browser.get(self.draft_election_administration_page_url) # In the "Trustees" section, she clicks on "here" # TODO: use a better selector: edit Belenios page to use an ID in this DOM element setup_election_key_link_label = "here" setup_election_key_link_element = wait_for_an_element_with_partial_link_text_exists(browser, setup_election_key_link_label) setup_election_key_link_element.click() # She checks that in the table on all rows, the "STATE" column is now "done" state_column_css_selector = "#main table tr td:last-of-type" attribute_name = "innerText" attribute_value = "done" verify_all_elements_have_attribute_value(browser, state_column_css_selector, attribute_name, attribute_value) wait_a_bit() # She clicks on the "Go back to election draft" link go_back_link_label = "Go back to election draft" go_back_link_element = wait_for_an_element_with_partial_link_text_exists(browser, go_back_link_label, settings.EXPLICIT_WAIT_TIMEOUT) go_back_link_element.click() # - In "Validate creation" section, she clicks on the "Create election" link # - (She arrives on the "Checklist" page, that lists all main parameters of the election for review, and that flags incoherent or misconfigured parameters.) # - She checks the presence of text "election ready" # - In the "Validate creation" section, she clicks on the "Create election" button # - (She arrives back on the "My test election for Scenario 1 — Administration" page. Its contents have changed. There is now a text saying "The election is open. Voters can vote.", and there are now buttons "Close election", "Archive election", "Delete election") # - She remembers the URL of the voting page, that is where the "Election home" link points to # - She checks that a "Close election" button is present (but she does not click on it) self.election_page_url = administrator_validates_creation_of_election(browser) console_log("election_page_url:", self.election_page_url) self.election_id = election_page_url_to_election_id(self.election_page_url) console_log("election_id:", self.election_id) wait_a_bit() # She logs out log_out(browser, self.election_id) # She closes the window, and re-opens it (for next emulated user) browser.quit() self.browser = initialize_browser_for_scenario_2() def test_scenario_4_manual_vote_with_threshold(self): console_log("### Running test method BeleniosTestElectionScenario4::test_scenario_4_manual_vote_with_threshold()") with ConsoleLogDuration("### administrator_starts_creation_of_manual_election"): self.administrator_starts_creation_of_manual_election() with ConsoleLogDuration("### credential_authority_sends_credentials_to_voters"): self.credential_authority_sends_credentials_to_voters() with ConsoleLogDuration("### administrator_invites_trustees_and_sets_threshold"): self.administrator_invites_trustees_and_sets_threshold() with ConsoleLogDuration("### trustees_do_initialization_step_1_of_3"): self.trustees_do_initialization_step_1_of_3() with ConsoleLogDuration("### trustees_do_initialization_step_2_of_3"): self.trustees_do_initialization_step_2_of_3() with ConsoleLogDuration("### trustees_do_initialization_step_3_of_3"): self.trustees_do_initialization_step_3_of_3() with ConsoleLogDuration("### administrator_completes_creation_of_election"): self.administrator_completes_creation_of_election() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#0)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### all_voters_vote_in_sequences"): self.all_voters_vote_in_sequences() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#1)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### create_election_data_snapshot (#0)"): snapshot_folder = create_election_data_snapshot(self.election_id) try: with ConsoleLogDuration("### some_voters_revote"): self.some_voters_revote() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify-diff` (#2)"): verify_election_consistency(self.election_id, snapshot_folder) finally: with ConsoleLogDuration("### delete_election_data_snapshot"): delete_election_data_snapshot(snapshot_folder) with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#3)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### administrator_starts_tallying_of_election"): self.administrator_starts_tallying_of_election(settings.TRUSTEES_THRESHOLD_VALUE) with ConsoleLogDuration("### trustees_do_partial_decryption"): self.trustees_do_partial_decryption(settings.TRUSTEES_THRESHOLD_VALUE) with ConsoleLogDuration("### administrator_finishes_tallying_of_election"): self.administrator_finishes_tallying_of_election(settings.TRUSTEES_THRESHOLD_VALUE) with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#4)"): verify_election_consistency(self.election_id) if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) settings.INITIATOR_CONTACT = os.getenv('INITIATOR_CONTACT', settings.INITIATOR_CONTACT) settings.BROWSER_DOWNLOAD_FOLDER = os.getenv('BROWSER_DOWNLOAD_FOLDER', settings.BROWSER_DOWNLOAD_FOLDER) settings.ADMINISTRATOR_EMAIL_ADDRESS = os.getenv('ADMINISTRATOR_EMAIL_ADDRESS', settings.ADMINISTRATOR_EMAIL_ADDRESS) settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS = os.getenv('CREDENTIAL_AUTHORITY_EMAIL_ADDRESS', settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS) settings.NUMBER_OF_TRUSTEES = int(os.getenv('NUMBER_OF_TRUSTEES', settings.NUMBER_OF_TRUSTEES)) # TODO: settings.TRUSTEES_EMAIL_ADDRESSES (it cannot be manipulated the same way because it is an array) settings.TRUSTEES_THRESHOLD_VALUE = os.getenv('TRUSTEES_THRESHOLD_VALUE', settings.TRUSTEES_THRESHOLD_VALUE) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("CLEAN_UP_POLICY:", settings.CLEAN_UP_POLICY) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) console_log("INITIATOR_CONTACT:", settings.INITIATOR_CONTACT) console_log("BROWSER_DOWNLOAD_FOLDER:", settings.BROWSER_DOWNLOAD_FOLDER) console_log("ADMINISTRATOR_EMAIL_ADDRESS:", settings.ADMINISTRATOR_EMAIL_ADDRESS) console_log("CREDENTIAL_AUTHORITY_EMAIL_ADDRESS:", settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS) console_log("TRUSTEES_EMAIL_ADDRESSES:", settings.TRUSTEES_EMAIL_ADDRESSES) console_log("NUMBER_OF_TRUSTEES:", settings.NUMBER_OF_TRUSTEES) console_log("TRUSTEES_THRESHOLD_VALUE:", settings.TRUSTEES_THRESHOLD_VALUE) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/selenium/test_scenario_2_with_monkeys.py0000644000175000017500000003033214476041226025317 0ustar stephsteph#!/usr/bin/python # coding: utf-8 import unittest import random import os import sys from util.election_testing import strtobool, verify_election_consistency, create_election_data_snapshot, delete_election_data_snapshot, populate_credential_and_password_for_voters_from_sent_emails, populate_random_votes_for_voters from util.execution import console_log, ConsoleLogDuration from test_scenario_2 import initialize_browser_for_scenario_2 from test_fuzz_vote import BeleniosTestElectionWithCreationBase from test_smart_monkey import smart_monkey_votes import settings class BeleniosTestElectionScenario2WithMonkeys(BeleniosTestElectionWithCreationBase): def test_scenario_2_manual_vote_with_monkeys(self): console_log("### Running test method BeleniosTestElectionScenario2WithMonkeys::test_scenario_2_manual_vote_with_monkeys()") with ConsoleLogDuration("### administrator_starts_creation_of_manual_election"): self.administrator_starts_creation_of_manual_election() with ConsoleLogDuration("### credential_authority_sends_credentials_to_voters"): self.credential_authority_sends_credentials_to_voters() with ConsoleLogDuration("### administrator_invites_trustees"): self.administrator_invites_trustees() with ConsoleLogDuration("### trustees_generate_election_private_keys"): self.trustees_generate_election_private_keys() with ConsoleLogDuration("### administrator_completes_creation_of_election"): self.administrator_completes_creation_of_election() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#0)"): verify_election_consistency(self.election_id) self.voters_data = {} # We reset this (set by `BeleniosTestElectionWithCreationBase`) because we generate voters data in several parts voters_who_will_vote = random.sample(self.voters_email_addresses, settings.NUMBER_OF_VOTING_VOTERS) console_log("voters who will vote:", voters_who_will_vote) start_index_of_voters_who_vote_in_first_part = 0 end_index_of_voters_who_vote_in_first_part = settings.NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART console_log(f"number of (normal) voters who will vote in first part: {end_index_of_voters_who_vote_in_first_part} (indexes {start_index_of_voters_who_vote_in_first_part} included to {end_index_of_voters_who_vote_in_first_part} excluded)") start_index_of_voters_who_vote_in_second_part = end_index_of_voters_who_vote_in_first_part end_index_of_voters_who_vote_in_second_part = end_index_of_voters_who_vote_in_first_part + settings.NUMBER_OF_MONKEY_VOTING_VOTERS console_log(f"number of (smart monkey) voters who will vote in second part: {end_index_of_voters_who_vote_in_second_part - start_index_of_voters_who_vote_in_second_part} (indexes {start_index_of_voters_who_vote_in_second_part} included to {end_index_of_voters_who_vote_in_second_part} excluded)") start_index_of_voters_who_vote_in_third_part = end_index_of_voters_who_vote_in_second_part end_index_of_voters_who_vote_in_third_part = settings.NUMBER_OF_VOTING_VOTERS console_log(f"number of (normal) voters who will vote in third part: {end_index_of_voters_who_vote_in_third_part - start_index_of_voters_who_vote_in_third_part} (indexes {start_index_of_voters_who_vote_in_third_part} included to {end_index_of_voters_who_vote_in_third_part} excluded)") verify_every_x_votes = 5 with ConsoleLogDuration("### some_voters_vote_in_sequences (first part)"): self.some_voters_vote_in_sequences(voters_who_will_vote, start_index=start_index_of_voters_who_vote_in_first_part, end_index=end_index_of_voters_who_vote_in_first_part, verify_every_x_votes=verify_every_x_votes) with ConsoleLogDuration("### smart monkeys vote (second part)"): smart_monkey_voters_who_will_vote_now = voters_who_will_vote[start_index_of_voters_who_vote_in_second_part:end_index_of_voters_who_vote_in_second_part] timeout = settings.EXPLICIT_WAIT_TIMEOUT voters_who_will_vote_now_data = populate_credential_and_password_for_voters_from_sent_emails(self.fake_sent_emails_manager, smart_monkey_voters_who_will_vote_now, settings.ELECTION_TITLE) voters_who_will_vote_now_data = populate_random_votes_for_voters(voters_who_will_vote_now_data) self.update_voters_data(voters_who_will_vote_now_data) for idx, voter in enumerate(voters_who_will_vote_now_data): console_log(f"#### Voting as smart monkey {idx+1} of {settings.NUMBER_OF_MONKEY_VOTING_VOTERS}") voter_email_address = voter["email_address"] voter_username = voter["username"] voter_password = voter["password"] voter_credential = voter["credential"] voter_decided_vote = voter["votes"] election_url = voter["election_page_url"] # this is the same as `election_id_to_election_home_page_url(self.election_id)` smart_ballot_tracker = smart_monkey_votes(self.browser, timeout, election_url, voter_username, voter_password, voter_credential, voter_decided_vote) if smart_ballot_tracker: voter["smart_ballot_tracker"] = smart_ballot_tracker else: raise Exception("Monkey voter did not complete its vote properly") self.voters_email_addresses_who_have_voted[voter_email_address] = True self.browser.quit() self.browser = initialize_browser_for_scenario_2() with ConsoleLogDuration("### some_voters_vote_in_sequences (third part)"): self.some_voters_vote_in_sequences(voters_who_will_vote, start_index=start_index_of_voters_who_vote_in_third_part, end_index=end_index_of_voters_who_vote_in_third_part, verify_every_x_votes=verify_every_x_votes) with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#1)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### Starting step: create_election_data_snapshot (#0)"): snapshot_folder = create_election_data_snapshot(self.election_id) console_log("snapshot_folder: ", snapshot_folder) try: with ConsoleLogDuration("### some_voters_revote"): self.some_voters_revote() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify-diff` (#2)"): verify_election_consistency(self.election_id, snapshot_folder) finally: with ConsoleLogDuration("### delete_election_data_snapshot"): delete_election_data_snapshot(snapshot_folder) with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#3)"): verify_election_consistency(self.election_id) with ConsoleLogDuration("### administrator_starts_tallying_of_election"): self.administrator_starts_tallying_of_election() with ConsoleLogDuration("### trustees_do_partial_decryption"): self.trustees_do_partial_decryption() with ConsoleLogDuration("### administrator_finishes_tallying_of_election"): self.administrator_finishes_tallying_of_election() with ConsoleLogDuration("### verify_election_consistency using `belenios_tool verify` (#4)"): verify_election_consistency(self.election_id) if __name__ == "__main__": random_seed = os.getenv('RANDOM_SEED', None) if not random_seed: random_seed = random.randrange(sys.maxsize) console_log("Python random seed being used:", random_seed) random.seed(random_seed) settings.SERVER_URL = os.getenv('SERVER_URL', settings.SERVER_URL) if os.getenv('START_SERVER', None): settings.START_SERVER = bool(strtobool(os.getenv('START_SERVER'))) if os.getenv('USE_HEADLESS_BROWSER', None): settings.USE_HEADLESS_BROWSER = bool(strtobool(os.getenv('USE_HEADLESS_BROWSER'))) settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL = os.getenv('FAKE_SENT_EMAILS_FILE_RELATIVE_URL', "static/mail.txt") settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH = os.getenv('SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH', settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) settings.WAIT_TIME_BETWEEN_EACH_STEP = float(os.getenv('WAIT_TIME_BETWEEN_EACH_STEP', settings.WAIT_TIME_BETWEEN_EACH_STEP)) settings.EXPLICIT_WAIT_TIMEOUT = int(os.getenv('EXPLICIT_WAIT_TIMEOUT', settings.EXPLICIT_WAIT_TIMEOUT)) if os.getenv('CLEAN_UP_POLICY', None): input_clean_up_policy = os.getenv('CLEAN_UP_POLICY') if hasattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy): settings.CLEAN_UP_POLICY = getattr(settings.CLEAN_UP_POLICIES, input_clean_up_policy) else: raise Exception("Error: Unknown value for CLEAN_UP_POLICY:", input_clean_up_policy) settings.NUMBER_OF_INVITED_VOTERS = int(os.getenv('NUMBER_OF_INVITED_VOTERS', settings.NUMBER_OF_INVITED_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS = int(os.getenv('NUMBER_OF_VOTING_VOTERS', settings.NUMBER_OF_VOTING_VOTERS)) settings.NUMBER_OF_MONKEY_VOTING_VOTERS = int(os.getenv('NUMBER_OF_MONKEY_VOTING_VOTERS', settings.NUMBER_OF_MONKEY_VOTING_VOTERS)) settings.NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART = int(os.getenv('NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART', settings.NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART)) settings.NUMBER_OF_REVOTING_VOTERS = int(os.getenv('NUMBER_OF_REVOTING_VOTERS', settings.NUMBER_OF_REVOTING_VOTERS)) settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS = int(os.getenv('NUMBER_OF_REGENERATED_PASSWORD_VOTERS', settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS)) settings.ADMINISTRATOR_USERNAME = os.getenv('ADMINISTRATOR_USERNAME', settings.ADMINISTRATOR_USERNAME) settings.ADMINISTRATOR_PASSWORD = os.getenv('ADMINISTRATOR_PASSWORD', settings.ADMINISTRATOR_PASSWORD) settings.ELECTION_TITLE = os.getenv('ELECTION_TITLE', settings.ELECTION_TITLE) settings.ELECTION_DESCRIPTION = os.getenv('ELECTION_DESCRIPTION', settings.ELECTION_DESCRIPTION) settings.INITIATOR_CONTACT = os.getenv('INITIATOR_CONTACT', settings.INITIATOR_CONTACT) settings.BROWSER_DOWNLOAD_FOLDER = os.getenv('BROWSER_DOWNLOAD_FOLDER', settings.BROWSER_DOWNLOAD_FOLDER) settings.ADMINISTRATOR_EMAIL_ADDRESS = os.getenv('ADMINISTRATOR_EMAIL_ADDRESS', settings.ADMINISTRATOR_EMAIL_ADDRESS) settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS = os.getenv('CREDENTIAL_AUTHORITY_EMAIL_ADDRESS', settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS) # TODO: settings.TRUSTEES_EMAIL_ADDRESSES (it cannot be manipulated the same way because it is an array) console_log("SERVER_URL:", settings.SERVER_URL) console_log("START_SERVER:", settings.START_SERVER) console_log("USE_HEADLESS_BROWSER:", settings.USE_HEADLESS_BROWSER) console_log("FAKE_SENT_EMAILS_FILE_RELATIVE_URL:", settings.FAKE_SENT_EMAILS_FILE_RELATIVE_URL) console_log("SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH:", settings.SENT_EMAILS_TEXT_FILE_ABSOLUTE_PATH) console_log("WAIT_TIME_BETWEEN_EACH_STEP:", settings.WAIT_TIME_BETWEEN_EACH_STEP) console_log("EXPLICIT_WAIT_TIMEOUT:", settings.EXPLICIT_WAIT_TIMEOUT) console_log("CLEAN_UP_POLICY:", settings.CLEAN_UP_POLICY) console_log("NUMBER_OF_INVITED_VOTERS:", settings.NUMBER_OF_INVITED_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS:", settings.NUMBER_OF_VOTING_VOTERS) console_log("NUMBER_OF_MONKEY_VOTING_VOTERS:", settings.NUMBER_OF_MONKEY_VOTING_VOTERS) console_log("NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART:", settings.NUMBER_OF_VOTING_VOTERS_IN_FIRST_PART) console_log("NUMBER_OF_REVOTING_VOTERS:", settings.NUMBER_OF_REVOTING_VOTERS) console_log("NUMBER_OF_REGENERATED_PASSWORD_VOTERS:", settings.NUMBER_OF_REGENERATED_PASSWORD_VOTERS) console_log("ELECTION_TITLE:", settings.ELECTION_TITLE) console_log("ELECTION_DESCRIPTION:", settings.ELECTION_DESCRIPTION) console_log("INITIATOR_CONTACT:", settings.INITIATOR_CONTACT) console_log("BROWSER_DOWNLOAD_FOLDER:", settings.BROWSER_DOWNLOAD_FOLDER) console_log("ADMINISTRATOR_EMAIL_ADDRESS:", settings.ADMINISTRATOR_EMAIL_ADDRESS) console_log("CREDENTIAL_AUTHORITY_EMAIL_ADDRESS:", settings.CREDENTIAL_AUTHORITY_EMAIL_ADDRESS) console_log("TRUSTEES_EMAIL_ADDRESSES:", settings.TRUSTEES_EMAIL_ADDRESSES) unittest.main() belenios-2.2-10-gbb6b7ea8/tests/tool/0002755000175000017500000000000014476041226016217 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/tool/demo-threshold.sh0000755000175000017500000001040614476041226021473 0ustar stephsteph#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$(dirname $(dirname $PWD))} belenios-tool () { $BELENIOS/_run/tool-debug/bin/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } header "Setup election" UUID=`belenios-tool setup generate-token` echo "UUID of the election is $UUID" DIR=$BELENIOS/tests/tool/data/$UUID mkdir $DIR cd $DIR # Common options uuid="--uuid $UUID" group="--group Ed25519" # Generate credentials belenios-tool setup generate-credentials $uuid $group --count 5 | tee generate-credentials.out mv *.pubcreds public_creds.json mv *.privcreds private_creds.json paste <(jq --raw-output 'keys_unsorted[]' < private_creds.json) <(jq --raw-output '.[]' < private_creds.json) > private_creds.txt # Generate trustee keys ttkeygen () { belenios-tool setup generate-trustee-key-threshold $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 mandatory (server) key belenios-tool setup generate-trustee-key $group cat *.pubkey > public_keys.jsons # Generate trustee parameters belenios-tool setup make-trustees rm threshold.json # Generate election parameters belenios-tool setup make-election $uuid $group --template $BELENIOS/tests/tool/templates/questions.json # Initialize events belenios-tool archive init rm -f election.json trustees.json public_creds.json # Check public credential fingerprint EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT="$(tail -n1 generate-credentials.out| awk '{print $(NF)}')" ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT="$(tar -xOf $UUID.bel $(tar -tf $UUID.bel | head -n4 | tail -n1) | belenios-tool sha256-b64)" if [ "$EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT" != "$ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT" ]; then echo "Discrepancy in public credential fingerprint" exit 2 fi rm -f generate-credentials.out header "Simulate votes" cat > votes.txt <&2 echo >&2 done header "Perform verification" belenios-tool election verify header "Simulate revotes and verify diff" tdir="$(mktemp -d)" cp $UUID.bel "$tdir" paste <(head -n 3 private_creds.txt) <(head -n 3 votes.txt) | while read id cred vote; do belenios-tool election generate-ballot --privcred <(echo "$cred") --choice <(echo "$vote") | belenios-tool archive add-event --type=Ballot echo "Voter $id voted" >&2 echo >&2 done belenios-tool election verify-diff --dir1="$tdir" --dir2=. rm -rf "$tdir" header "End voting phase" belenios-tool archive add-event --type=EndBallots < /dev/null belenios-tool election compute-encrypted-tally | belenios-tool archive add-event --type=EncryptedTally belenios-tool election verify header "Perform decryption (threshold)" trustee_id=2 for u in *.key; do belenios-tool election decrypt-threshold --key $u --decryption-key ${u%.key}.dkey --trustee-id $trustee_id | belenios-tool archive add-event --type=PartialDecryption echo >&2 : $((trustee_id++)) done header "Perform decryption (mandatory)" for u in *.privkey; do belenios-tool election decrypt --privkey $u --trustee-id 1 | belenios-tool archive add-event --type=PartialDecryption echo >&2 done header "Finalize tally" belenios-tool election compute-result | belenios-tool archive add-event --type=Result header "Perform final verification" belenios-tool election verify echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-2.2-10-gbb6b7ea8/tests/tool/templates/0002755000175000017500000000000014476041226020215 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/tests/tool/templates/questions-mj.json0000644000175000017500000000031614476041226023544 0ustar stephsteph{"description":"Description of the election.","name":"Name of the election","questions":[{"type":"NonHomomorphic","value":{"answers":["Answer 1","Answer 2","Answer 3","Answer 4"],"question":"Question?"}}]} belenios-2.2-10-gbb6b7ea8/tests/tool/templates/questions.json0000644000175000017500000000040214476041226023134 0ustar stephsteph{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"},{"answers":["Answer 1","Answer 2"],"blank":true,"min":1,"max":1,"question":"Question 2?"}]} belenios-2.2-10-gbb6b7ea8/tests/tool/templates/questions-nh.json0000644000175000017500000000055414476041226023547 0ustar stephsteph{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"},{"answers":["Answer 1","Answer 2"],"blank":true,"min":1,"max":1,"question":"Question 2?"},{"type":"NonHomomorphic","value":{"answers":["Answer 1","Answer 2","Answer 3"],"question":"Question 3?"}}]} belenios-2.2-10-gbb6b7ea8/tests/tool/templates/questions-stv.json0000644000175000017500000000033114476041226023747 0ustar stephsteph{"description":"Description of the election.","name":"Name of the election","questions":[{"type":"NonHomomorphic","value":{"answers":["Answer 1","Answer 2","Answer 3","Answer 4","Answer 5"],"question":"Question?"}}]} belenios-2.2-10-gbb6b7ea8/tests/tool/demo-n-voters.sh0000755000175000017500000000731114476041226021255 0ustar stephsteph#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$(dirname $(dirname $PWD))} belenios-tool () { $BELENIOS/_run/tool-debug/bin/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } : ${num_voters:="10"} # modify the number of voters here header "Setup election" UUID=`belenios-tool setup generate-token` echo "UUID of the election is $UUID" DIR=$BELENIOS/tests/tool/data/$UUID mkdir -p $DIR cd $DIR uuid="--uuid $UUID" group="--group Ed25519" belenios-tool setup generate-credentials $uuid $group --count $num_voters | tee generate-credentials.out mv *.pubcreds public_creds.json mv *.privcreds private_creds.json paste <(jq --raw-output 'keys_unsorted[]' < private_creds.json) <(jq --raw-output '.[]' < private_creds.json) > private_creds.txt # Generate trustee keys belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group cat *.pubkey > public_keys.jsons # Generate trustee parameters belenios-tool setup make-trustees rm public_keys.jsons # Generate election parameters belenios-tool setup make-election $uuid $group --template $BELENIOS/tests/tool/templates/questions.json # Initialize events belenios-tool archive init rm -f election.json trustees.json public_creds.json # Check public credential fingerprint EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT="$(tail -n1 generate-credentials.out| awk '{print $(NF)}')" ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT="$(tar -xOf $UUID.bel $(tar -tf $UUID.bel | head -n4 | tail -n1) | belenios-tool sha256-b64)" if [ "$EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT" != "$ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT" ]; then echo "Discrepancy in public credential fingerprint" exit 2 fi rm -f generate-credentials.out header "Simulate votes" yes "[[1,0],[0,1,0]]" | head -n $num_voters > votes.txt paste private_creds.txt votes.txt | while read id cred vote; do BALLOT="$(belenios-tool election generate-ballot --privcred <(echo "$cred") --choice <(echo "$vote"))" belenios-tool election verify-ballot --ballot <(echo "$BALLOT") HASH="$(printf "%s" "$BALLOT" | belenios-tool sha256-b64)" echo "$BALLOT" | belenios-tool archive add-event --type=Ballot echo "Voter $id voted with $HASH" >&2 belenios-tool election verify --skip-ballot-check echo >&2 done header "Perform verification" belenios-tool election verify header "End voting phase" belenios-tool archive add-event --type=EndBallots < /dev/null belenios-tool election compute-encrypted-tally | belenios-tool archive add-event --type=EncryptedTally belenios-tool election verify header "Perform decryption" trustee_id=1 for u in *.privkey; do belenios-tool election decrypt --privkey $u --trustee-id $trustee_id | belenios-tool archive add-event --type=PartialDecryption echo >&2 : $((trustee_id++)) done header "Finalize tally" belenios-tool election compute-result | belenios-tool archive add-event --type=Result header "Perform final verification" belenios-tool election verify header "Check result" cat > result.reference < /dev/null; then if diff -u result.reference <(tar -xOf $UUID.bel $RESULT | jq --compact-output '.result'); then echo "Result is correct!" else echo "Result is incorrect!" exit 1 fi else echo "Could not find jq command, test skipped!" fi echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-2.2-10-gbb6b7ea8/tests/tool/demo-mj.sh0000755000175000017500000001220514476041226020104 0ustar stephsteph#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$(dirname $(dirname $PWD))} belenios-tool () { $BELENIOS/_run/tool-debug/bin/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } header "Setup election" UUID=`belenios-tool setup generate-token` echo "UUID of the election is $UUID" DIR=$BELENIOS/tests/tool/data/$UUID mkdir $DIR cd $DIR # Common options uuid="--uuid $UUID" group="--group Ed25519" # Generate credentials belenios-tool setup generate-credentials $uuid $group --count 102 | tee generate-credentials.out mv *.pubcreds public_creds.json mv *.privcreds private_creds.json paste <(jq --raw-output 'keys_unsorted[]' < private_creds.json) <(jq --raw-output '.[]' < private_creds.json) > private_creds.txt # Generate trustee keys belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group cat *.pubkey > public_keys.jsons # Generate trustee parameters belenios-tool setup make-trustees rm public_keys.jsons # Generate election parameters belenios-tool setup make-election $uuid $group --template $BELENIOS/tests/tool/templates/questions-mj.json # Initialize events belenios-tool archive init rm -f election.json trustees.json public_creds.json # Check public credential fingerprint EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT="$(tail -n1 generate-credentials.out| awk '{print $(NF)}')" ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT="$(tar -xOf $UUID.bel $(tar -tf $UUID.bel | head -n4 | tail -n1) | belenios-tool sha256-b64)" if [ "$EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT" != "$ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT" ]; then echo "Discrepancy in public credential fingerprint" exit 2 fi rm -f generate-credentials.out header "Simulate votes" cat > votes.txt <&2 echo >&2 done header "Perform verification" belenios-tool election verify header "End voting phase" belenios-tool archive add-event --type=EndBallots < /dev/null belenios-tool election compute-encrypted-tally | belenios-tool archive add-event --type=EncryptedTally belenios-tool election verify header "Shuffle ciphertexts" belenios-tool election shuffle --trustee-id=1 | belenios-tool archive add-event --type=Shuffle echo >&2 belenios-tool election shuffle --trustee-id=2 | belenios-tool archive add-event --type=Shuffle belenios-tool archive add-event --type=EndShuffles < /dev/null header "Perform decryption" trustee_id=1 for u in *.privkey; do belenios-tool election decrypt --privkey $u --trustee-id $trustee_id | belenios-tool archive add-event --type=PartialDecryption echo >&2 : $((trustee_id++)) done header "Finalize tally" belenios-tool election compute-result | belenios-tool archive add-event --type=Result header "Perform final verification" belenios-tool election verify header "Apply Majority Judgment method" cat > mj.reference < /dev/null; then if diff -u mj.reference <(tar -xOf $UUID.bel $RESULT | jq --compact-output '.result[0]' | belenios-tool method majority-judgment --ngrades 5 --blank-allowed true); then echo "Majority Judgment output is identical!" else echo "Differences in Majority Judgment output!" exit 1 fi else echo "Could not find jq command, test skipped!" fi echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-2.2-10-gbb6b7ea8/tests/tool/.gitignore0000644000175000017500000000000514476041226020200 0ustar stephstephdata belenios-2.2-10-gbb6b7ea8/tests/tool/demo.sh0000755000175000017500000001146714476041226017511 0ustar stephsteph#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$(dirname $(dirname $PWD))} belenios-tool () { $BELENIOS/_run/tool-debug/bin/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } header "Setup election" UUID=`belenios-tool setup generate-token` echo "UUID of the election is $UUID" DIR=$BELENIOS/tests/tool/data/$UUID mkdir -p $DIR cd $DIR # Common options uuid="--uuid $UUID" group="--group Ed25519" # Generate credentials cat > voters.txt < private_creds.txt # Generate trustee keys belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group cat *.pubkey > public_keys.jsons # Generate trustee parameters belenios-tool setup make-trustees rm public_keys.jsons # Generate election parameters belenios-tool setup make-election $uuid $group --template $BELENIOS/tests/tool/templates/questions.json # Initialize events belenios-tool archive init rm -f election.json trustees.json public_creds.json # Check public credential fingerprint EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT="$(tail -n1 generate-credentials.out| awk '{print $(NF)}')" ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT="$(tar -xOf $UUID.bel $(tar -tf $UUID.bel | head -n4 | tail -n1) | belenios-tool sha256-b64)" if [ "$EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT" != "$ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT" ]; then echo "Discrepancy in public credential fingerprint" exit 2 fi rm -f generate-credentials.out header "Simulate votes" cat > votes.txt <&2 echo >&2 done header "Perform verification (skip-ballot-check)" belenios-tool election verify --skip-ballot-check header "Perform verification" belenios-tool election verify header "Simulate revotes and verify diff" tdir="$(mktemp -d)" cp $UUID.bel "$tdir" paste <(head -n 3 private_creds.txt) <(head -n 3 votes.txt) | while read id cred vote; do BALLOT="$(belenios-tool election generate-ballot --privcred <(echo "$cred") --choice <(echo "$vote"))" HASH="$(printf "%s" "$BALLOT" | belenios-tool sha256-b64)" echo "$BALLOT" | belenios-tool archive add-event --type=Ballot echo "Voter $id voted with $HASH" >&2 echo >&2 done belenios-tool election verify-diff --dir1="$tdir" --dir2=. rm -rf "$tdir" header "End voting phase" belenios-tool archive add-event --type=EndBallots < /dev/null belenios-tool election compute-encrypted-tally | belenios-tool archive add-event --type=EncryptedTally belenios-tool election verify header "Check voters" NUMBER_OF_VOTERS="$(belenios-tool election compute-voters --privcreds private_creds.json | wc -l)" if [ "$NUMBER_OF_VOTERS" -eq "5" ]; then echo "Number of voters is correct" else echo "Number of voters does not match!" exit 1 fi header "Perform decryption" trustee_id=1 for u in *.privkey; do belenios-tool election decrypt --privkey $u --trustee-id $trustee_id | belenios-tool archive add-event --type=PartialDecryption echo >&2 : $((trustee_id++)) done header "Finalize tally" belenios-tool election compute-result | belenios-tool archive add-event --type=Result header "Perform final verification" belenios-tool election verify header "Check result" cat > result.reference < /dev/null; then if diff -u result.reference <(tar -xOf $UUID.bel $RESULT | jq --compact-output '.result'); then echo "Result is correct!" else echo "Result is incorrect!" exit 1 fi else echo "Could not find jq command, test skipped!" fi echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-2.2-10-gbb6b7ea8/tests/tool/demo-stv.sh0000755000175000017500000001213314476041226020312 0ustar stephsteph#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$(dirname $(dirname $PWD))} belenios-tool () { $BELENIOS/_run/tool-debug/bin/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } header "Setup election" UUID=`belenios-tool setup generate-token` echo "UUID of the election is $UUID" DIR=$BELENIOS/tests/tool/data/$UUID mkdir $DIR cd $DIR # Common options uuid="--uuid $UUID" group="--group Ed25519" # Generate credentials belenios-tool setup generate-credentials $uuid $group --count 50 | tee generate-credentials.out mv *.pubcreds public_creds.json mv *.privcreds private_creds.json paste <(jq --raw-output 'keys_unsorted[]' < private_creds.json) <(jq --raw-output '.[]' < private_creds.json) > private_creds.txt # Generate trustee keys belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group cat *.pubkey > public_keys.jsons # Generate trustee parameters belenios-tool setup make-trustees rm public_keys.jsons # Generate election parameters belenios-tool setup make-election $uuid $group --template $BELENIOS/tests/tool/templates/questions-stv.json # Initialize events belenios-tool archive init rm -f election.json trustees.json public_creds.json # Check public credential fingerprint EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT="$(tail -n1 generate-credentials.out| awk '{print $(NF)}')" ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT="$(tar -xOf $UUID.bel $(tar -tf $UUID.bel | head -n4 | tail -n1) | belenios-tool sha256-b64)" if [ "$EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT" != "$ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT" ]; then echo "Discrepancy in public credential fingerprint" exit 2 fi rm -f generate-credentials.out header "Simulate votes" cat > votes.txt <&2 echo >&2 done header "Perform verification" belenios-tool election verify header "End voting phase" belenios-tool archive add-event --type=EndBallots < /dev/null belenios-tool election compute-encrypted-tally | belenios-tool archive add-event --type=EncryptedTally belenios-tool election verify header "Shuffle ciphertexts" belenios-tool election shuffle --trustee-id=1 | belenios-tool archive add-event --type=Shuffle echo >&2 belenios-tool election shuffle --trustee-id=2 | belenios-tool archive add-event --type=Shuffle belenios-tool archive add-event --type=EndShuffles < /dev/null header "Perform decryption" trustee_id=1 for u in *.privkey; do belenios-tool election decrypt --privkey $u --trustee-id $trustee_id | belenios-tool archive add-event --type=PartialDecryption echo >&2 : $((trustee_id++)) done header "Finalize tally" belenios-tool election compute-result | belenios-tool archive add-event --type=Result header "Perform final verification" belenios-tool election verify header "Apply STV method" cat > result.reference < /dev/null; then if diff -u result.reference <(tar -xOf $UUID.bel $RESULT | jq --compact-output '.result[0]' | belenios-tool method stv --nseats 2); then echo "STV output is identical!" else echo "Differences in STV output!" exit 1 fi else echo "Could not find jq command, test skipped!" fi echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-2.2-10-gbb6b7ea8/tests/tool/demo-nh.sh0000755000175000017500000001251714476041226020111 0ustar stephsteph#!/bin/bash set -e export BELENIOS_USE_URANDOM=1 BELENIOS=${BELENIOS:-$(dirname $(dirname $PWD))} belenios-tool () { $BELENIOS/_run/tool-debug/bin/belenios-tool "$@" } header () { echo echo "=-=-= $1 =-=-=" echo } header "Setup election" UUID=`belenios-tool setup generate-token` echo "UUID of the election is $UUID" DIR=$BELENIOS/tests/tool/data/$UUID mkdir $DIR cd $DIR # Common options uuid="--uuid $UUID" group="--group Ed25519" # Generate credentials belenios-tool setup generate-credentials $uuid $group --count 60 | tee generate-credentials.out mv *.pubcreds public_creds.json mv *.privcreds private_creds.json paste <(jq --raw-output 'keys_unsorted[]' < private_creds.json) <(jq --raw-output '.[]' < private_creds.json) > private_creds.txt # Generate trustee keys belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group belenios-tool setup generate-trustee-key $group cat *.pubkey > public_keys.jsons # Generate trustee parameters belenios-tool setup make-trustees rm public_keys.jsons # Generate election parameters belenios-tool setup make-election $uuid $group --template $BELENIOS/tests/tool/templates/questions-nh.json # Initialize events belenios-tool archive init rm -f election.json trustees.json public_creds.json # Check public credential fingerprint EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT="$(tail -n1 generate-credentials.out| awk '{print $(NF)}')" ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT="$(tar -xOf $UUID.bel $(tar -tf $UUID.bel | head -n4 | tail -n1) | belenios-tool sha256-b64)" if [ "$EXPECTED_PUBLIC_CREDENTIAL_FINGERPRINT" != "$ACTUAL_PUBLIC_CREDENTIAL_FINGERPRINT" ]; then echo "Discrepancy in public credential fingerprint" exit 2 fi rm -f generate-credentials.out header "Simulate votes" cat > votes.txt <&2 echo >&2 done header "Perform verification" belenios-tool election verify header "End voting phase" belenios-tool archive add-event --type=EndBallots < /dev/null belenios-tool election compute-encrypted-tally | belenios-tool archive add-event --type=EncryptedTally belenios-tool election verify header "Shuffle ciphertexts" belenios-tool election shuffle --trustee-id=1 | belenios-tool archive add-event --type=Shuffle echo >&2 belenios-tool election shuffle --trustee-id=2 | belenios-tool archive add-event --type=Shuffle belenios-tool archive add-event --type=EndShuffles < /dev/null header "Perform decryption" trustee_id=1 for u in *.privkey; do belenios-tool election decrypt --privkey $u --trustee-id $trustee_id | belenios-tool archive add-event --type=PartialDecryption echo >&2 : $((trustee_id++)) done header "Finalize tally" belenios-tool election compute-result | belenios-tool archive add-event --type=Result header "Perform final verification" belenios-tool election verify header "Apply Schulze method" cat > schulze.reference < /dev/null; then if diff -u schulze.reference <(tar -xOf $UUID.bel $RESULT | jq --compact-output '.result[2]' | belenios-tool method schulze --blank-allowed true); then echo "Schulze output is identical!" else echo "Differences in Schulze output!" exit 1 fi else echo "Could not find jq command, test skipped!" fi echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo echo "The simulated election was successful! Its result can be seen in" echo " $DIR" echo echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" echo belenios-2.2-10-gbb6b7ea8/tests/tool/Makefile0000644000175000017500000000022014476041226017647 0ustar stephstephall: check: mkdir -p data ./demo.sh ./demo-threshold.sh ./demo-nh.sh ./demo-mj.sh ./demo-stv.sh ./demo-n-voters.sh clean: rm -rf data belenios-2.2-10-gbb6b7ea8/VERSION0000644000175000017500000000000414476041226015140 0ustar stephsteph2.2 belenios-2.2-10-gbb6b7ea8/frontend/0002755000175000017500000000000014476041226015717 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/frontend/.prettierrc.json0000644000175000017500000000000314476041226021042 0ustar stephsteph{} belenios-2.2-10-gbb6b7ea8/frontend/bundle-css.js0000644000175000017500000000134214476041226020312 0ustar stephstephvar CleanCSS = require('clean-css'); var input = '@import("' + process.argv[2] + '");'; var options = { /* options */ }; var output = new CleanCSS(options).minify(input); if (output.errors.length) { process.stderr.write("There were errors:\n"); output.errors.forEach((x) => process.stderr.write(" " + x + "\n")); process.stderr.write("\n"); process.exit(2); } if (output.warnings.length) { process.stderr.write("There were warnings:\n"); output.warnings.forEach((x) => process.stderr.write(" " + x + "\n")); process.stderr.write("\n"); } process.stderr.write("Inlined stylesheets:\n"); output.inlinedStylesheets.forEach((x) => process.stderr.write(" " + x + "\n")); process.stdout.write(output.styles); belenios-2.2-10-gbb6b7ea8/frontend/booth/0002755000175000017500000000000014476041226017032 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/frontend/booth/majority_judgment_colors.js0000644000175000017500000000232014476041226024477 0ustar stephstephimport { lerpInArray, hslToCssColor } from "./color_utils.js"; const gradeIndexToCssColor = ( gradesHslColorScale, availableGradesLength, gradeIndex, ) => { if (availableGradesLength < 2) { return undefined; } const ratio = gradeIndex / (availableGradesLength - 1); const hsl = lerpInArray(gradesHslColorScale, ratio); return hslToCssColor(hsl[0], hsl[1], hsl[2]); }; /* #b02800: Reject / À rejeter / hsl(14, 100%, 35%) #ff6503: Poor / Insuffisant / hsl(23, 100%, 51%) #ff9f00: Acceptable / Passable / hsl(37, 100%, 50%) #f5c823: Fair / Assez bien / hsl(47, 91%, 55%) #7dd162: Good / Bien / hsl(105, 55%, 60%) #2eb430: Very good / Très bien / hsl(121, 59%, 44%) #0f7c10: Excellent / Excellent / hsl(121, 78%, 27%) */ const majorityJudgmentGradesHslColorScale = [ [121, 78, 27], [121, 59, 44], [105, 55, 60], [47, 91, 55], [37, 100, 50], [23, 100, 51], [14, 100, 35], ]; // from green to yellow to red const majorityJudgmentGradeIndexToCssColor = gradeIndexToCssColor.bind( null, majorityJudgmentGradesHslColorScale, ); export { gradeIndexToCssColor, majorityJudgmentGradesHslColorScale, majorityJudgmentGradeIndexToCssColor, }; export default majorityJudgmentGradeIndexToCssColor; belenios-2.2-10-gbb6b7ea8/frontend/booth/app.js0000644000175000017500000002210114476041226020142 0ustar stephstephimport ReactDOM from "react-dom/client"; import React, { createElement as e } from "react"; import i18next from "i18next"; import { withTranslation } from "react-i18next"; import i18n_init from "./i18n_init.js"; import PageHeader from "./components/PageHeader.js"; import { VoteBreadcrumb } from "./components/Breadcrumb.js"; import { AllQuestionsWithPagination } from "./components/AllQuestionsWithPagination.js"; import NoUuidSection from "./components/NoUuidSection.js"; import InputCredentialSection from "./components/InputCredentialSection.js"; import ReviewEncryptSection from "./components/ReviewEncryptSection.js"; import { PageFooter, EmptyPageFooter } from "./components/PageFooter.js"; import { Election } from "./election_utils.js"; const relativeServerRootFolder = "../../.."; function getHashParametersFromURL() { const url_hash_parameters = window.location.hash.substr(1); return url_hash_parameters.split("&").reduce(function (result, item) { const parts = item.split("="); result[parts[0]] = parts[1]; return result; }, {}); } function VotePage({ electionObject, electionFingerprint, currentStep, children, }) { return e( "div", { className: "page", }, e(PageHeader, { title: electionObject.title, subTitle: electionObject.description, }), e( "div", { className: "page-body", id: "main", // used to ease targetting of DOM elements in automated tests }, e(VoteBreadcrumb, { currentStep: currentStep, }), children, ), e(PageFooter, { electionUuid: electionObject.uuid, electionFingerprint: electionFingerprint, }), ); } function GenericPage({ title = null, subTitle = null, children }) { return e( "div", { className: "page", }, e(PageHeader, { title: title, subTitle: subTitle, }), e( "div", { className: "page-body", }, children, ), e(EmptyPageFooter), ); } function TranslatableVoteApp({ uuid = null, votingCredential = null, draft, t, }) { const [currentStep, setCurrentStep] = React.useState( votingCredential ? 2 : 1, ); // Current step of the workflow displayed in the Breadcrumb. 1: input credential. 2: answer questions. 3: review and encrypt. const [electionData, setElectionData] = React.useState({}); const [electionObject, setElectionObject] = React.useState(undefined); const [electionFingerprint, setElectionFingerprint] = React.useState(""); const [credential, setCredential] = React.useState(votingCredential); const [electionLoadingStatus, setElectionLoadingStatus] = React.useState(0); // 0: not yet loaded. 1: loaded with success. 2: loaded with error. const [electionLoadingErrorMessage, setElectionLoadingErrorMessage] = React.useState(null); const [uncryptedBallotBeforeReview, setUncryptedBallotBeforeReview] = React.useState(null); const [cryptedBallotBeforeReview, setCryptedBallotBeforeReview] = React.useState(null); const [smartBallotTracker, setSmartBallotTracker] = React.useState(null); const processElectionData = (inputElectionData) => { setElectionData(inputElectionData); try { let election = new Election(inputElectionData); setElectionObject(election); } catch (error) { setElectionLoadingErrorMessage(error); setElectionLoadingStatus(2); return; } setElectionFingerprint(belenios.computeFingerprint(inputElectionData)); setElectionLoadingStatus(1); }; const loadElectionDataFromUuid = (uuid, draft) => { const url = draft ? `${relativeServerRootFolder}/draft/preview/${uuid}/election.json` : `${relativeServerRootFolder}/elections/${uuid}/election.json`; fetch(url).then((response) => { if (!response.ok) { setElectionLoadingErrorMessage( "Error: Could not load this election. Maybe no election exists with this identifier.", ); // TODO: should we localize this? setElectionLoadingStatus(2); } else { response.json().then(processElectionData); } }); }; React.useMemo(() => { if (uuid) { loadElectionDataFromUuid(uuid, draft); } }, [uuid]); if (!uuid && electionLoadingStatus == 0) { const onClickLoadFromParameters = (election_params) => { let inputElectionData = null; try { inputElectionData = JSON.parse(election_params); } catch (e) { alert(`Election parameters seem to be invalid. Parsing error: ${e}`); } processElectionData(inputElectionData); }; const onClickLoadFromUuid = (uuid) => { // v1: // document.location.href = `#uuid=${uuid}`; // document.location.reload(); // v2: loadElectionDataFromUuid(uuid, draft); }; const titleMessage = t("page_title"); return e( GenericPage, { title: titleMessage, subTitle: null, }, e(NoUuidSection, { onClickLoadFromUuid: onClickLoadFromUuid, onClickLoadFromParameters: onClickLoadFromParameters, }), ); } else if (electionLoadingStatus === 0 || electionLoadingStatus === 2) { const titleMessage = electionLoadingStatus === 0 ? "Loading..." : "Error"; // TODO: should we localize this? const loadingMessage = electionLoadingStatus === 0 ? titleMessage : electionLoadingErrorMessage; return e( GenericPage, { title: titleMessage, subTitle: null, }, e( "div", { style: { textAlign: "center", padding: "30px 0", }, }, loadingMessage, ), ); } else { if (currentStep === 1) { return e( VotePage, { electionObject, electionFingerprint, currentStep, }, e(InputCredentialSection, { onSubmit: function (credential) { if (belenios.checkCredential(credential) === true) { setCredential(credential); setCurrentStep(2); } else { alert(t("alert_invalid_credential")); } return false; }, }), ); } else if (currentStep === 2) { return e( VotePage, { electionObject, electionFingerprint, currentStep, }, e(AllQuestionsWithPagination, { electionObject, onVoteSubmit: async function ( event, voterSelectedAnswersAsUncryptedBallot, ) { setUncryptedBallotBeforeReview( voterSelectedAnswersAsUncryptedBallot, ); setCryptedBallotBeforeReview(null); setSmartBallotTracker(null); setCurrentStep(3); const encryptBallotSuccessCallback = (ballot, tracker) => { setCryptedBallotBeforeReview(ballot); setSmartBallotTracker(tracker); }; const encryptBallotErrorCallback = (error) => { alert("Error: " + error); }; setTimeout(function () { belenios.encryptBallot( electionData, credential, voterSelectedAnswersAsUncryptedBallot, encryptBallotSuccessCallback, encryptBallotErrorCallback, ); }, 50); }, }), ); } else if (currentStep === 3) { const urlToPostEncryptedBallot = `${relativeServerRootFolder}/election/submit-ballot`; const onClickPrevious = () => { setCurrentStep(2); setUncryptedBallotBeforeReview(null); setCryptedBallotBeforeReview(null); setSmartBallotTracker(null); }; return e( VotePage, { electionObject, electionFingerprint, currentStep, }, e(ReviewEncryptSection, { electionObject, uncryptedBallot: uncryptedBallotBeforeReview, cryptedBallot: cryptedBallotBeforeReview, smartBallotTracker, onClickPrevious, urlToPostEncryptedBallot, draft, }), ); } } } const VoteApp = withTranslation()(TranslatableVoteApp); const afterI18nInitialized = (uuid, lang, credential, draft) => { return function () { document.title = i18next.t("page_title"); document .querySelector("html") .setAttribute("lang", i18next.languages[0] || "en"); const container = document.querySelector("#vote-app"); const root = ReactDOM.createRoot(container); root.render( e(VoteApp, { votingCredential: credential, uuid: uuid, draft, }), ); }; }; function main() { const hash_parameters = getHashParametersFromURL(); const lang = hash_parameters["lang"]; const uuid = hash_parameters["uuid"]; const draft = hash_parameters["draft"]; const credential = draft ? "123-456-789-abc-deN" : hash_parameters["credential"]; const container = document.querySelector("#vote-app"); container.innerHTML = "Loading..."; i18n_init(lang, afterI18nInitialized(uuid, lang, credential, draft)); } main(); belenios-2.2-10-gbb6b7ea8/frontend/booth/select-css.css0000644000175000017500000001044514476041226021613 0ustar stephsteph/* Adapted from https://github.com/filamentgroup/select-css by Filament Group, under the MIT license. The MIT License (MIT) Copyright (c) 2014 Filament Group Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ /* class applies to select element itself, not a wrapper element */ .select-css { display: block; font-size: 16px; font-family: sans-serif; font-weight: 700; color: #444; line-height: 1.3; padding: 0.6em 1.4em 0.5em 0.8em; width: 100%; max-width: 100%; /* useful when width is set to anything other than 100% */ box-sizing: border-box; margin: 0; border: 1px solid #aaa; box-shadow: 0 1px 0 1px rgba(0, 0, 0, 0.04); border-radius: 0.5em; -moz-appearance: none; -webkit-appearance: none; appearance: none; background-color: #fff; /* note: bg image below uses 2 urls. The first is an svg data uri for the arrow icon, and the second is the gradient. for the icon, if you want to change the color, be sure to use `%23` instead of `#`, since it's a url. You can also swap in a different svg icon or an external image reference */ background-image: url("data:image/svg+xml;charset=US-ASCII,%3Csvg%20xmlns%3D%22http%3A%2F%2Fwww.w3.org%2F2000%2Fsvg%22%20width%3D%22292.4%22%20height%3D%22292.4%22%3E%3Cpath%20fill%3D%22%23007CB2%22%20d%3D%22M287%2069.4a17.6%2017.6%200%200%200-13-5.4H18.4c-5%200-9.3%201.8-12.9%205.4A17.6%2017.6%200%200%200%200%2082.2c0%205%201.8%209.3%205.4%2012.9l128%20127.9c3.6%203.6%207.8%205.4%2012.8%205.4s9.2-1.8%2012.8-5.4L287%2095c3.5-3.5%205.4-7.8%205.4-12.8%200-5-1.9-9.2-5.5-12.8z%22%2F%3E%3C%2Fsvg%3E"), linear-gradient(to bottom, #ffffff 0%, #e5e5e5 100%); background-repeat: no-repeat, repeat; /* arrow icon position (1em from the right, 50% vertical) , then gradient position*/ background-position: right 0.7em top 50%, 0 0; /* icon size, then gradient */ background-size: 0.65em auto, 100%; } /* Hide arrow icon in IE browsers */ .select-css::-ms-expand { display: none; } /* Hover style */ .select-css:hover { border-color: #888; } /* Focus style */ .select-css:focus { border-color: #aaa; /* It'd be nice to use -webkit-focus-ring-color here but it doesn't work on box-shadow */ box-shadow: 0 0 1px 3px rgba(59, 153, 252, 0.7); box-shadow: 0 0 0 3px -moz-mac-focusring; color: #222; outline: none; } /* Set options to normal weight */ .select-css option { font-weight: normal; } /* Support for rtl text, explicit support for Arabic and Hebrew */ *[dir="rtl"] .select-css, :root:lang(ar) .select-css, :root:lang(iw) .select-css { background-position: left 0.7em top 50%, 0 0; padding: 0.6em 0.8em 0.5em 1.4em; } /* Disabled styles */ .select-css:disabled, .select-css[aria-disabled="true"] { color: graytext; background-image: url("data:image/svg+xml;charset=US-ASCII,%3Csvg%20xmlns%3D%22http%3A%2F%2Fwww.w3.org%2F2000%2Fsvg%22%20width%3D%22292.4%22%20height%3D%22292.4%22%3E%3Cpath%20fill%3D%22graytext%22%20d%3D%22M287%2069.4a17.6%2017.6%200%200%200-13-5.4H18.4c-5%200-9.3%201.8-12.9%205.4A17.6%2017.6%200%200%200%200%2082.2c0%205%201.8%209.3%205.4%2012.9l128%20127.9c3.6%203.6%207.8%205.4%2012.8%205.4s9.2-1.8%2012.8-5.4L287%2095c3.5-3.5%205.4-7.8%205.4-12.8%200-5-1.9-9.2-5.5-12.8z%22%2F%3E%3C%2Fsvg%3E"), linear-gradient(to bottom, #ffffff 0%, #e5e5e5 100%); } .select-css:disabled:hover, .select-css[aria-disabled="true"] { border-color: #aaa; } belenios-2.2-10-gbb6b7ea8/frontend/booth/election_utils.js0000644000175000017500000001154014476041226022411 0ustar stephstephconst QuestionTypeEnum = Object.freeze({ GENERIC: "GENERIC", CLASSIC: "CLASSIC", // In this question type, voter can select between `questions[i].min` and `questions[i].max` answers, or optionally vote blank (if `questions[i].blank` is true). Question's title is available as `questions[i].question`. Available answers or candidates are each element of array `questions[i].answers`. MAJORITY_JUDGMENT: "MAJORITY_JUDGMENT", // In this question type, voter must associate a grade (represented by a number) to each answer or candidate. Question's title is available as `questions[i].value.question`. Available answers or candidates are each element of array `questions[i].value.answers`. PREFERENTIAL_VOTING_WITH_EQUALITY: "PREFERENTIAL_VOTING_WITH_EQUALITY", // In this question type, voter must associate a rank (represented by a number, 1 being the most preferred, and a bigger number being less preferred ; blank vote cand be accepted, and equality is accepted) to each answer or candidate. Question's title is available as `questions[i].value.question`. Available answers or candidates are each element of array `questions[i].value.answers` PREFERENTIAL_VOTING_WITHOUT_EQUALITY: "PREFERENTIAL_VOTING_WITHOUT_EQUALITY", // In this question type, voter must associate a rank (represented by a number, 1 being the most preferred, and a bigger number being less preferred ; blank vote can be accepted, and equality is not accepted) to each answer or candidate. Question's title is available as `questions[i].value.question`. Available answers or candidates are each element of array `questions[i].value.answers` }); const detectQuestionType = (question) => { const nonHomomorphic = question.hasOwnProperty("type") && question["type"] == "NonHomomorphic"; if (!nonHomomorphic) { return QuestionTypeEnum.CLASSIC; } else { if ( question.hasOwnProperty("extra") && question.extra.hasOwnProperty("type") ) { const questionSubType = question.extra.type; let preciseErrorText = `This booth does not know how to render questions of type "${questionSubType}".`; if (questionSubType == "ScoreVoting") { return QuestionTypeEnum.MAJORITY_JUDGMENT; } else if (questionSubType == "PreferentialVoting") { if (!question.extra.hasOwnProperty("method")) { preciseErrorText = `This booth does not know how to render questions of type "${questionSubType}" and which have no "method" attribute.`; throw preciseErrorText; } const questionMethod = question.extra.method; if (questionMethod == "Schulze") { return QuestionTypeEnum.PREFERENTIAL_VOTING_WITH_EQUALITY; } else if (questionMethod == "STV") { return QuestionTypeEnum.PREFERENTIAL_VOTING_WITHOUT_EQUALITY; } else { preciseErrorText = `This booth does not know how to render questions of type "${questionSubType}" and which "method" attribute is "${questionMethod}".`; throw preciseErrorText; } } else { throw preciseErrorText; } } else { return QuestionTypeEnum.GENERIC; } } }; class ElectionQuestion { constructor(questionData) { this.questionData = questionData; this.type = detectQuestionType(this.questionData); if ( this.type === QuestionTypeEnum.MAJORITY_JUDGMENT || this.type === QuestionTypeEnum.PREFERENTIAL_VOTING_WITH_EQUALITY || this.type === QuestionTypeEnum.PREFERENTIAL_VOTING_WITHOUT_EQUALITY ) { this.title = this.questionData.value.question; this.answers = this.questionData.value.answers; this.candidates = this.questionData.value.answers; this.blankVoteIsAllowed = "extra" in this.questionData && "blank" in this.questionData.extra && this.questionData.extra.blank === true; if (this.type === QuestionTypeEnum.MAJORITY_JUDGMENT) { this.availableGrades = this.questionData.extra.grades; } } else if (this.type === QuestionTypeEnum.CLASSIC) { this.title = this.questionData.question; this.answers = this.questionData.answers; this.blankVoteIsAllowed = "blank" in this.questionData && this.questionData["blank"] === true; this.min = this.questionData.min; this.max = this.questionData.max; } else if (this.type === QuestionTypeEnum.GENERIC) { this.title = this.questionData.value.question; this.answers = this.questionData.value.answers; } else { // TODO } } } class Election { constructor(electionData) { this.electionData = electionData; this.title = electionData.name; this.description = electionData.description; this.uuid = electionData.uuid; this.questions = electionData.questions.map((questionData) => { return new ElectionQuestion(questionData); }); } } export { QuestionTypeEnum, detectQuestionType, ElectionQuestion, Election }; export default Election; belenios-2.2-10-gbb6b7ea8/frontend/booth/webpack.config.js0000644000175000017500000000024114476041226022243 0ustar stephstephconst path = require("path"); module.exports = { entry: "./app.js", output: { path: path.resolve(__dirname, "dist"), filename: "bundle.js", }, }; belenios-2.2-10-gbb6b7ea8/frontend/booth/color_utils.js0000644000175000017500000000254514476041226021732 0ustar stephstephconst lerp = (value1, value2, amount) => { amount = amount < 0 ? 0 : amount; amount = amount > 1 ? 1 : amount; return value1 + (value2 - value1) * amount; }; // @param dataPoints: An array of numbers, or an array where each element is an array of numbers of the same length // @return: If dataPoints is an array of numbers: a number. Else: an array of numbers. const lerpInArray = (dataPoints, ratio) => { const referenceMaxIndex = dataPoints.length - 1; if (referenceMaxIndex < 1) { return undefined; } if (ratio <= 0) { return dataPoints[0]; } if (ratio >= 1) { return dataPoints[referenceMaxIndex]; } const nearestLowIndex = Math.floor(ratio * referenceMaxIndex); const nearestHighIndex = nearestLowIndex + 1; const insideRatio = ratio * referenceMaxIndex - nearestLowIndex; // insideRatio should be inside [0.0;1.0[ if (Array.isArray(dataPoints[nearestLowIndex])) { return dataPoints[nearestLowIndex].map((value, index) => { return lerp(value, dataPoints[nearestHighIndex][index], insideRatio); }); } else { return lerp( dataPoints[nearestLowIndex], dataPoints[nearestHighIndex], insideRatio, ); } }; const hslToCssColor = (hue, saturation, lightness) => { return `hsl(${hue}, ${saturation}%, ${lightness}%)`; }; export { lerp, lerpInArray, hslToCssColor }; export default hslToCssColor; belenios-2.2-10-gbb6b7ea8/frontend/booth/shortcuts.js0000644000175000017500000000076414476041226021433 0ustar stephsteph"use strict"; import { createElement as e } from "react"; const markupFunctions = { text: (key, x) => e("span", { key }, x), br: (key) => e("br", { key }), bold: (key, xs) => e("span", { key, className: "markup-b" }, ...xs), italic: (key, xs) => e("span", { key, className: "markup-i" }, ...xs), error: (x) => e("span", { className: "markup-error" }, x), result: (xs) => e("span", {}, ...xs), }; function markup(x) { return belenios.markup(markupFunctions, x); } export { markup }; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/0002755000175000017500000000000014476041226021217 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/frontend/booth/components/ClassicVoteRecap.js0000644000175000017500000000324614476041226024752 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { markup } from "../shortcuts.js"; function TranslatableClassicVoteRecap({ question, question_index, uncryptedBallot, t, }) { const questionText = question.title; const questionPossibleAnswers = question.answers; const renderedAnswers = uncryptedBallot[question_index].map( function (answer, answer_index) { if (answer === 0) { return null; } else if (answer === 1) { if (answer_index === 0 && question.blankVoteIsAllowed === true) { return e("li", null, t("blank_vote")); } else { const index = question.blankVoteIsAllowed === true ? answer_index - 1 : answer_index; return e("li", null, markup(questionPossibleAnswers[index])); } } else { console.error( `uncryptedBallot for question ${question_index} contains an answer which is something else than 0 or 1.`, ); return e("li", null, "ERROR"); } }, ); const renderedVoteToQuestion = e( React.Fragment, null, e( "h3", { className: "whole-vote-recap__question-title", }, markup(questionText), ), e( "ul", { className: "classic-vote-recap__answers-to-question", }, ...renderedAnswers, ), ); return e( "div", { className: "classic-vote-recap", }, renderedVoteToQuestion, ); } const ClassicVoteRecap = withTranslation()(TranslatableClassicVoteRecap); export { ClassicVoteRecap, TranslatableClassicVoteRecap }; export default ClassicVoteRecap; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/LoadingSpinner.js0000644000175000017500000000062314476041226024470 0ustar stephstephimport React, { createElement as e } from "react"; function LoadingSpinner(props) { return e( "div", { className: "lds-spinner", ...props, }, e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), e("div"), ); } export { LoadingSpinner }; export default LoadingSpinner; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/PreferentialVotingCandidatesList.css0000644000175000017500000000475714476041226030367 0ustar stephsteph.preferential-voting-ui-container { display: flex; align-items: center; flex-direction: column; } .preferential-voting-ui { max-width: 500px; --draggable-handle-color: #777; } .preferential-voting-candidates-list--blank-vote-is-selected .preferential-voting-ui { filter: blur(3px) grayscale(1) opacity(0.7); } .preferential-voting-ui__level-creator { display: flex; align-items: center; flex-direction: column; } .preferential-voting-ui__level-creator__add-icon { border-radius: 30px; display: flex; font-size: 11px; padding: 6px 10px; } .preferential-voting__column-container { margin: 6px; border: 1px solid lightgrey; border-radius: 6px; max-width: 500px; } .preferential-voting__column-header { display: flex; padding: 6px 8px 2px 8px; min-height: 23px; } .preferential-voting__column-title { padding: 0 1px; flex-grow: 1; margin: 0; font-size: 14px; } .preferential-voting__column-actions__action { display: flex; flex-direction: column; border-radius: 30px; width: 22px; height: 22px; line-height: 22px; font-size: 18px; text-align: center; position: relative; top: -2px; padding: 0; } .preferential-voting__column-candidate-list { padding: 0 6px 2px 6px; transition: all 350ms; min-height: 44px; /* for when there are no elements, and smoother transition */ } .preferential-voting__candidate { display: flex; border: 1px solid lightgrey; border-radius: 8px; margin-bottom: 6px; background-color: white; min-height: 32px; box-sizing: border-box; } .preferential-voting__candidate-handle { font-weight: bolder; display: flex; align-items: center; flex-direction: row; } .preferential-voting__candidate-handle__icon { width: 0px; font-size: 22px; padding-left: 14px; padding-right: 17px; position: relative; top: -1px; color: var(--draggable-handle-color); } .preferential-voting__candidate-handle__icon::before { content: "."; text-shadow: -5px 0 var(--draggable-handle-color), -5px -5px var(--draggable-handle-color), 0 -5px var(--draggable-handle-color), -5px -10px var(--draggable-handle-color), 0 -10px var(--draggable-handle-color); font-size: 16px; color: var(--draggable-handle-color); } .preferential-voting__candidate-label { flex-grow: 1; display: flex; flex-direction: row; align-items: center; padding: 1px 8px 1px 0; font-size: 12px; } .preferential-voting__candidate-select-destination { font-size: 11px; vertical-align: middle; margin: auto 2px; } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/NiceInput.css0000644000175000017500000000016314476041226023625 0ustar stephsteph.nice-password-input, .nice-text-input { border-radius: 8px; border: 1px solid #c4c4c4; padding: 5px 10px; } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/InputCredentialSection.css0000644000175000017500000000012614476041226026345 0ustar stephsteph.input-credential-section__instruction { display: flex; flex-direction: column; } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/MajorityJudgmentVoteRecap.js0000644000175000017500000001176114476041226026666 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { markup } from "../shortcuts.js"; import DisplayDependingOnWindowWidth from "./DisplayDependingOnWindowWidth.js"; import { majorityJudgmentGradeIndexToCssColor } from "../majority_judgment_colors.js"; function MajorityJudgmentVoteRecapForCandidateBig({ candidateName, selectedGradeName, selectedGradeNumber, availableGradesCssColors, }) { const bemBlockName = "majority-judgment-vote-recap-for-candidate-big"; return e( "div", { className: bemBlockName, style: { "--majority-judgment-selected-grade-color": availableGradesCssColors[selectedGradeNumber], }, }, e( "div", { className: `${bemBlockName}__candidate-name`, }, markup(candidateName), ), e( "div", { className: `${bemBlockName}__selected-grade`, }, selectedGradeName, ), ); } function MajorityJudgmentVoteRecapForCandidateSmall({ candidateName, selectedGradeName, selectedGradeNumber, availableGradesCssColors, }) { const bemBlockName = "majority-judgment-vote-recap-for-candidate-small"; return e( "div", { className: bemBlockName, style: { "--selected-grade-color": availableGradesCssColors[selectedGradeNumber], }, }, e( "div", { className: `${bemBlockName}__candidate-name`, }, markup(candidateName), ), e( "div", { className: `${bemBlockName}__selected-grade`, }, selectedGradeName, ), ); } function MajorityJudgmentVoteRecapForCandidate({ candidateName, selectedGradeName, selectedGradeNumber, availableGradesCssColors, }) { return e(DisplayDependingOnWindowWidth, { widthLimit: 800, smallComponent: MajorityJudgmentVoteRecapForCandidateSmall, bigComponent: MajorityJudgmentVoteRecapForCandidateBig, candidateName, selectedGradeName, selectedGradeNumber, availableGradesCssColors, }); } function TranslatableMajorityJudgmentVoteRecap({ question, question_index, uncryptedBallot, t, }) { const questionText = question.title; const questionCandidates = question.candidates; const questionPossibleGrades = question.availableGrades; let renderedGradedCandidates = []; if ( question.blankVoteIsAllowed === true && uncryptedBallot[question_index].reduce((accumulator, value) => { if (value !== 0) { accumulator += 1; } return accumulator; }, 0) === 0 ) { renderedGradedCandidates = [e("div", null, t("blank_vote"))]; } else { const availableGradesCssColors = React.useMemo(() => { return questionPossibleGrades.map((grade, index) => { return majorityJudgmentGradeIndexToCssColor( questionPossibleGrades.length, index, ); }); }, questionPossibleGrades); renderedGradedCandidates = uncryptedBallot[question_index].map( function (answer, answer_index) { const selectedGradeIndex = answer - 1; // We substract 1 in order to obtain the index of the selected grade in the array of available grades labels (indexes in arrays start at 0, and by convention index 0 must contain the label of the highest grade, index 2 must contain the label of the second highest grade, etc), whereas the value of answer in the uncrypted ballot represent the selected grade encoded as Belenios backend expects it, which is: grades are expected to start at 1, 1 being the highest grade, 2 being the second highest grade, etc (and 0 being interpreted as invalid vote, whereas 0 to all candidates of a question being interpreted as blank vote). if ( selectedGradeIndex < 0 || selectedGradeIndex >= questionPossibleGrades.length ) { console.error( `uncryptedBallot for question ${question_index} contains an answer for candidate ${answer_index} which is out of the available grades interval.`, ); return e("li", null, "ERROR"); } return e(MajorityJudgmentVoteRecapForCandidate, { candidateName: questionCandidates[answer_index], selectedGradeName: questionPossibleGrades[selectedGradeIndex], selectedGradeNumber: selectedGradeIndex, availableGradesCssColors, }); }, ); } const renderedVoteToQuestion = e( React.Fragment, null, e( "h3", { className: "whole-vote-recap__question-title", }, markup(questionText), ), e( "div", { className: "majority-judgment-vote-recap__answers-to-question", }, ...renderedGradedCandidates, ), ); return e( "div", { className: "majority-judgment-vote-recap", }, renderedVoteToQuestion, ); } const MajorityJudgmentVoteRecap = withTranslation()( TranslatableMajorityJudgmentVoteRecap, ); export { TranslatableMajorityJudgmentVoteRecap, MajorityJudgmentVoteRecap }; export default MajorityJudgmentVoteRecap; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/PreferentialVotingWithoutEqualityColumn.js0000644000175000017500000002032314476041226031642 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { Draggable, Droppable } from "react-beautiful-dnd"; const TranslatableMoveCandidateHandle = ({ t, tReady, ...props }) => { // the icon visual is made using CSS return e( "div", { className: "preferential-voting__candidate-handle draggable", title: t("preferential_voting_drag_candidate"), ...props, }, e("div", { className: "preferential-voting__candidate-handle__icon", }), ); }; const MoveCandidateHandle = withTranslation()(TranslatableMoveCandidateHandle); const SelectOption = ({ value, label }) => { return e( "option", { value: value, }, label, ); }; const TranslatableCandidateWithoutEquality = ({ candidate, index, column, otherColumns, columns, candidates, allCandidates, onSelectDestinationColumn, disabled, showRank, t, }) => { let otherPreferencesSelectOptions = []; /* Build the list of possible places where the user can move this candidate to. This list will be displayed on the right of current candidate's name, in a "select". A candidate which is currently in the "Not ranked" section can be moved to: - The "Ranked" section (generic naming) if no candidate currently is in the "Ranked" section - Above any ranked candidate - Below last ranked candidate A candidate which is currently displayed in the "Ranked" section can be moved to: - The "Not ranked" section - Above any ranked candidate (except himself) - Below last ranked candidate (except if the last ranked candidate is himself) */ // Detect whether there are already candidates in the "Ranked" section (as opposed to the "Not ranked" section) const rankedSectionIsNotEmpty = columns && columns.hasOwnProperty("ranked") && columns["ranked"].hasOwnProperty("candidatesIds") && columns["ranked"]["candidatesIds"] && columns["ranked"]["candidatesIds"].length > 0; if (column && column.id === "not-ranked") { // Current candidate currently appears in the "not-ranked" section if (!rankedSectionIsNotEmpty) { otherPreferencesSelectOptions.push( SelectOption({ value: "ranked", label: t("preferential_voting_ranked"), }), ); } } else { // Current candidate currently appears in the "ranked" section otherPreferencesSelectOptions.push( SelectOption({ value: "not-ranked", label: t("preferential_voting_not_ranked"), }), ); } if (rankedSectionIsNotEmpty) { const otherRankedCandidates = columns["ranked"]["candidatesIds"] .map((candidateId, idx) => { return { candidateId: candidateId, index: idx }; }) .filter((cand) => { return cand.candidateId != candidate.id && index + 1 != cand.index; }); let selectOptionsToAdd = otherRankedCandidates.map((cand) => { const candidate = allCandidates[cand.candidateId]; const candidateLabel = t( "preferential_voting_without_equality_move_candidate_above_position_x", { index: cand.index + 1, candidate: candidate.content }, ); const destinationColumnAndIndex = `ranked~${cand.index}`; return SelectOption({ value: destinationColumnAndIndex, label: candidateLabel, }); }); otherPreferencesSelectOptions = [ ...otherPreferencesSelectOptions, ...selectOptionsToAdd, ]; // Add below bottom ranked candidate const bottomRankedCandidateId = columns["ranked"]["candidatesIds"][ columns["ranked"]["candidatesIds"].length - 1 ]; const bottomRankedCandidate = allCandidates[bottomRankedCandidateId]; if (bottomRankedCandidate.id != candidate.id) { const belowLastLabel = t( "preferential_voting_without_equality_move_candidate_below_position_x", { index: columns["ranked"]["candidatesIds"].length, candidate: bottomRankedCandidate.content, }, ); const BelowLastOption = SelectOption({ value: "ranked", label: belowLastLabel, }); otherPreferencesSelectOptions = [ ...otherPreferencesSelectOptions, BelowLastOption, ]; } } // Prepend initial option used as dropdown label const firstOption = SelectOption({ value: "default", label: t("preferential_voting_move_candidate_to"), }); otherPreferencesSelectOptions.splice(0, 0, firstOption); const renderedRank = e( "div", { className: "preferential-voting-without-equality__candidate-rank", }, showRank ? `${index + 1}.` : null, ); const children = (provided) => { return e( "div", { className: "preferential-voting-without-equality__candidate-container", ...provided.draggableProps, ...provided.dragHandleProps, ref: provided.innerRef, }, renderedRank, e( "div", { className: "preferential-voting-without-equality__candidate", }, e(MoveCandidateHandle, { //...provided.dragHandleProps }), e( "div", { className: "preferential-voting__candidate-label", }, candidate.content, ), e( "select", { className: "preferential-voting__candidate-select-destination", onChange: onSelectDestinationColumn, defaultValue: "default", disabled: disabled, }, ...otherPreferencesSelectOptions, ), ), ); }; return e(Draggable, { draggableId: candidate.id, index: index, children: children, isDragDisabled: disabled, }); }; const CandidateWithoutEquality = withTranslation()( TranslatableCandidateWithoutEquality, ); const CandidateList = ({ innerRef, placeholder, children, ...otherProps }) => { return e( "div", { className: "preferential-voting__column-candidate-list", ref: innerRef, ...otherProps, }, children, placeholder, ); }; // A Column is a list which has a title (prop label) and which can contain candidates. // These candidates can be moved to other columns by drag & drop or using the select box next to each candidate. // The user can delete a Column if it contains no candidates. // A special kind of Column is when `column.id` is "not-ranked": this Column cannot be deleted. const PreferentialVotingWithoutEqualityColumn = ({ column, label, otherColumns, columns, candidates, allCandidates, onSelectCandidateDestinationColumn, disabled, }) => { const rendered_candidates = candidates.map((candidate, index) => { return e(CandidateWithoutEquality, { key: candidate.id, candidate, index, column, otherColumns, columns, candidates, allCandidates, onSelectDestinationColumn: (event) => { const selectedValue = event.currentTarget.value; if (selectedValue === "default") { return; } const destination = selectedValue.split("~"); const destinationColumn = destination[0]; const destinationColumnCandidateIndex = destination.length > 1 ? destination[1] : null; onSelectCandidateDestinationColumn( candidate.id, index, destinationColumn, destinationColumnCandidateIndex, ); event.currentTarget.value = "default"; // restore select display }, disabled, showRank: column.id === "not-ranked" ? false : true, }); }); return e( "div", { className: "preferential-voting__column-container noselect", }, e( "div", { className: "preferential-voting__column-header", }, e( "h3", { className: "preferential-voting__column-title", }, label, ), ), e(Droppable, { droppableId: column.id, children: (provided) => { return e( CandidateList, { innerRef: provided.innerRef, ...provided.droppableProps, placeholder: provided.placeholder, }, ...rendered_candidates, ); }, }), ); }; export default PreferentialVotingWithoutEqualityColumn; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/LoadingSpinner.css0000644000175000017500000000275714476041226024656 0ustar stephsteph.lds-spinner { display: inline-block; position: relative; width: 80px; height: 80px; } .lds-spinner div { transform-origin: 40px 40px; animation: lds-spinner 1.2s linear infinite; } .lds-spinner div:after { content: " "; display: block; position: absolute; top: 3px; left: 37px; width: 6px; height: 18px; border-radius: 20%; background: #000; } .lds-spinner div:nth-child(1) { transform: rotate(0deg); animation-delay: -1.1s; } .lds-spinner div:nth-child(2) { transform: rotate(30deg); animation-delay: -1s; } .lds-spinner div:nth-child(3) { transform: rotate(60deg); animation-delay: -0.9s; } .lds-spinner div:nth-child(4) { transform: rotate(90deg); animation-delay: -0.8s; } .lds-spinner div:nth-child(5) { transform: rotate(120deg); animation-delay: -0.7s; } .lds-spinner div:nth-child(6) { transform: rotate(150deg); animation-delay: -0.6s; } .lds-spinner div:nth-child(7) { transform: rotate(180deg); animation-delay: -0.5s; } .lds-spinner div:nth-child(8) { transform: rotate(210deg); animation-delay: -0.4s; } .lds-spinner div:nth-child(9) { transform: rotate(240deg); animation-delay: -0.3s; } .lds-spinner div:nth-child(10) { transform: rotate(270deg); animation-delay: -0.2s; } .lds-spinner div:nth-child(11) { transform: rotate(300deg); animation-delay: -0.1s; } .lds-spinner div:nth-child(12) { transform: rotate(330deg); animation-delay: 0s; } @keyframes lds-spinner { 0% { opacity: 1; } 100% { opacity: 0; } } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/Breadcrumb.js0000644000175000017500000000413314476041226023622 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; function Breadcrumb(props) { const renderedSteps = props.steps.map((step, index) => { let className = "breadcrumb__step"; if (step.isCurrentStep) { className += " breadcrumb__step--current"; } return e( React.Fragment, null, e( "div", { className: className, }, e( "span", { className: "breadcrumb__step__title", }, step.title || "", ), e( "span", { className: "breadcrumb__step__short-title", title: step.title || "", }, step.shortTitle || "", ), ), e("div", { className: "breadcrumb__step-separator", }), ); }); return e( "div", { className: "breadcrumb", }, e("div", { className: "breadcrumb__step-separator", }), ...renderedSteps, ); } Breadcrumb.defaultProps = { steps: [ { title: "Title of step 1", shortTitle: "Step 1", isCurrentStep: true, }, { title: "Title of step 2", shortTitle: "Step 2", }, ], }; function TranslatableVoteBreadcrumb({ t, currentStep = 1, ...props }) { let voteBreadcrumbSteps = [ { title: t("breadcrumb_input_credential"), }, { title: t("breadcrumb_answer_to_questions"), }, { title: t("breadcrumb_review_and_encrypt"), }, { title: t("breadcrumb_authenticate"), }, { title: t("breadcrumb_confirm"), }, ]; voteBreadcrumbSteps = voteBreadcrumbSteps.map(function (el, index) { return { ...el, shortTitle: t("breadcrumb_step_x", { step: index + 1 }), isCurrentStep: currentStep === index + 1 ? true : false, }; }); return e(Breadcrumb, { steps: voteBreadcrumbSteps, ...props, }); } const VoteBreadcrumb = withTranslation()(TranslatableVoteBreadcrumb); export { Breadcrumb, TranslatableVoteBreadcrumb, VoteBreadcrumb }; export default Breadcrumb; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/MajorityJudgmentVoteSmallCandidatesList.css0000644000175000017500000000616414476041226031675 0ustar stephsteph:root { --select-css-white-arrow: url("data:image/svg+xml;charset=US-ASCII,%3Csvg%20xmlns%3D%22http%3A%2F%2Fwww.w3.org%2F2000%2Fsvg%22%20width%3D%22292.4%22%20height%3D%22292.4%22%3E%3Cpath%20fill%3D%22%23ffffff%22%20d%3D%22M287%2069.4a17.6%2017.6%200%200%200-13-5.4H18.4c-5%200-9.3%201.8-12.9%205.4A17.6%2017.6%200%200%200%200%2082.2c0%205%201.8%209.3%205.4%2012.9l128%20127.9c3.6%203.6%207.8%205.4%2012.8%205.4s9.2-1.8%2012.8-5.4L287%2095c3.5-3.5%205.4-7.8%205.4-12.8%200-5-1.9-9.2-5.5-12.8z%22%2F%3E%3C%2Fsvg%3E"); /* white triangle */ --select-css-gray-arrow: url("data:image/svg+xml;charset=US-ASCII,%3Csvg%20xmlns%3D%22http%3A%2F%2Fwww.w3.org%2F2000%2Fsvg%22%20width%3D%22292.4%22%20height%3D%22292.4%22%3E%3Cpath%20fill%3D%22%23444444%22%20d%3D%22M287%2069.4a17.6%2017.6%200%200%200-13-5.4H18.4c-5%200-9.3%201.8-12.9%205.4A17.6%2017.6%200%200%200%200%2082.2c0%205%201.8%209.3%205.4%2012.9l128%20127.9c3.6%203.6%207.8%205.4%2012.8%205.4s9.2-1.8%2012.8-5.4L287%2095c3.5-3.5%205.4-7.8%205.4-12.8%200-5-1.9-9.2-5.5-12.8z%22%2F%3E%3C%2Fsvg%3E"); /* gray triangle */ } .majority-judgment-vote-small-candidate { margin-bottom: 20px; --border-radius-size: 8px; } .majority-judgment-vote-candidates-list--blank-vote-is-selected .majority-judgment-vote-small-candidate { filter: blur(3px) grayscale(1) opacity(0.7); } .majority-judgment-vote-small-candidate--with-alert { border: 1px solid red; border-radius: var(--border-radius-size); } .majority-judgment-vote-small-candidate__candidate-info { background: #eee; border-radius: var(--border-radius-size) var(--border-radius-size) 0 0; padding: 10px; margin-bottom: 2px; } select.majority-judgment-vote-small-candidate__grade-selector.select-css { border: 1px solid transparent; } select.majority-judgment-vote-small-candidate__grade-selector.select-css:not( [data-value] ):focus, select.majority-judgment-vote-small-candidate__grade-selector.select-css:hover, select.majority-judgment-vote-small-candidate__grade-selector.select-css:not( [data-value] ):hover { border: 1px solid #aaa; } select.majority-judgment-vote-small-candidate__grade-selector.select-css[data-value]:hover { border: 1px solid #777; } select.majority-judgment-vote-small-candidate__grade-selector.select-css, select.majority-judgment-vote-small-candidate__grade-selector.select-css:focus { color: white; box-shadow: initial; background-image: var(--select-css-gray-arrow), linear-gradient(to bottom, #eeeeee 0%, #eeeeee 100%); border-radius: 0 0 var(--border-radius-size) var(--border-radius-size); } select.majority-judgment-vote-small-candidate__grade-selector.select-css[data-value=""], select.majority-judgment-vote-small-candidate__grade-selector.select-css:not( [data-value] ) { color: #444; border: 1px solid #dfdfdf; } select.majority-judgment-vote-small-candidate__grade-selector.select-css option { color: initial; } select.majority-judgment-vote-small-candidate__grade-selector.select-css[data-value] { background-image: var(--select-css-white-arrow), linear-gradient( to bottom, var(--selected-grade-color) 0%, var(--selected-grade-color) 100% ); } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/PreferentialVotingColumn.js0000644000175000017500000001151614476041226026544 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { Draggable, Droppable } from "react-beautiful-dnd"; import { markup } from "../shortcuts.js"; import { WhiteNiceButton } from "./NiceButton.js"; const TranslatableMoveCandidateHandle = ({ t, tReady, ...props }) => { // the icon visual is made using CSS return e( "div", { className: "preferential-voting__candidate-handle draggable", title: t("preferential_voting_drag_candidate"), ...props, }, e("div", { className: "preferential-voting__candidate-handle__icon", }), ); }; const MoveCandidateHandle = withTranslation()(TranslatableMoveCandidateHandle); const TranslatableCandidate = ({ candidate, index, otherColumns, onSelectDestinationColumn, disabled, t, }) => { const otherPreferencesSelectOptions = otherColumns.map((column) => { return e( "option", { value: column.id, }, column.label, ); }); otherPreferencesSelectOptions.splice( 0, 0, e( "option", { value: "default", }, t("preferential_voting_move_candidate_to"), ), ); const children = (provided) => { return e( "div", { className: "preferential-voting__candidate", ...provided.draggableProps, ...provided.dragHandleProps, ref: provided.innerRef, }, e(MoveCandidateHandle, { //...provided.dragHandleProps }), e( "div", { className: "preferential-voting__candidate-label", }, markup(candidate.content), ), e( "select", { className: "preferential-voting__candidate-select-destination", onChange: onSelectDestinationColumn, defaultValue: "default", disabled: disabled, }, ...otherPreferencesSelectOptions, ), ); }; return e(Draggable, { draggableId: candidate.id, index: index, children: children, isDragDisabled: disabled, }); }; const Candidate = withTranslation()(TranslatableCandidate); const CandidateList = ({ innerRef, placeholder, children, ...otherProps }) => { return e( "div", { className: "preferential-voting__column-candidate-list", ref: innerRef, ...otherProps, }, children, placeholder, ); }; const TranslatableDeletePreferenceLevelButton = ({ onClick, disabled, t }) => { return e(WhiteNiceButton, { tagName: "a", label: "×", // or 🗑✖ title: t("preferential_voting_delete_preference_level"), onClick: disabled ? null : onClick, className: "preferential-voting__column-actions__action preferential-voting__column-actions__action__delete-preference-level", disabled: disabled, }); }; const DeletePreferenceLevelButton = withTranslation()( TranslatableDeletePreferenceLevelButton, ); // A Column is a list which has a title (prop label) and which can contain candidates. // These candidates can be moved to other columns by drag & drop or using the select box next to each candidate. // The user can delete a Column if it contains no candidates. // A special kind of Column is when `column.id` is "not-ranked": this Column cannot be deleted. const PreferentialVotingColumn = ({ column, label, otherColumns, candidates, onClickDeleteButton, onSelectCandidateDestinationColumn, disabled, }) => { const rendered_candidates = candidates.map((candidate, index) => { return e(Candidate, { key: candidate.id, candidate, index, otherColumns, onSelectDestinationColumn: (event) => { onSelectCandidateDestinationColumn( candidate.id, index, event.currentTarget.value, ); }, disabled: disabled, }); }); const columnActions = column.id === "not-ranked" ? null : e( "div", { className: "preferential-voting__column-actions", }, e(DeletePreferenceLevelButton, { onClick: onClickDeleteButton, disabled: disabled, }), ); return e( "div", { className: "preferential-voting__column-container noselect", }, e( "div", { className: "preferential-voting__column-header", }, e( "h3", { className: "preferential-voting__column-title", }, label, ), columnActions, ), e(Droppable, { droppableId: column.id, children: (provided) => { return e( CandidateList, { innerRef: provided.innerRef, ...provided.droppableProps, placeholder: provided.placeholder, }, ...rendered_candidates, ); }, }), ); }; export default PreferentialVotingColumn; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/ReviewEncryptSection.js0000644000175000017500000001171214476041226025710 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import WholeVoteRecap from "./WholeVoteRecap.js"; import { WhiteNiceButton, BlueNiceButton, NiceButton } from "./NiceButton.js"; import LoadingSpinner from "./LoadingSpinner.js"; function TranslatableReviewEncryptSection({ electionObject = null, uncryptedBallot = [], cryptedBallot = null, smartBallotTracker = null, onClickPrevious = null, urlToPostEncryptedBallot = "", draft = null, t, }) { // identifiers are copied from original booth const smartBallotTrackerId = "smart_ballot_tracker"; const ballotContainerId = "ballot_div"; const ballotFormId = "ballot_form"; const encryptedBallotId = "ballot"; const encryptedBallotName = "encrypted_vote"; const contentWhenBallotIsBeingEncrypted = e( "div", null, e("div", null, t("ask_to_wait_during_ballot_encryption")), e(LoadingSpinner, { style: { marginTop: "15px", }, }), ); function setBrowserSelectionToSmartBallotTracker() { let el = document.getElementById(smartBallotTrackerId); const range = document.createRange(); range.selectNodeContents(el); const selection = window.getSelection(); selection.removeAllRanges(); selection.addRange(range); } function copyToClipboard() { setBrowserSelectionToSmartBallotTracker(); document.execCommand("copy"); alert(t("your_smart_ballot_tracker_has_been_copied")); } const contentWhenBallotHasBeenEncrypted = e( "div", null, e("p", null, t("your_ballot_has_been_encrypted")), e( "div", null, e("span", null, t("your_smart_ballot_tracker_is")), e( "div", { className: "review-encrypt-section__smart-ballot-tracker-container", }, e( "span", { className: "review-encrypt-section__smart-ballot-tracker", id: smartBallotTrackerId, onClick: setBrowserSelectionToSmartBallotTracker, }, smartBallotTracker, ), ), e( "div", null, e("span", null, t("ask_to_save_your_smart_ballot_tracker")), e(WhiteNiceButton, { tagName: "a", label: t("copy_to_clipboard_label"), onClick: copyToClipboard, style: { marginLeft: "5px", }, }), ), ), ); const content = cryptedBallot ? contentWhenBallotHasBeenEncrypted : contentWhenBallotIsBeingEncrypted; const navigationButtonStyle = { padding: "10px 13px", minWidth: "38px", }; const previousButton = e(NiceButton, { tagName: "a", label: t("previous_button_label"), style: { ...navigationButtonStyle, marginRight: "20px", }, onClick: onClickPrevious, }); const nextOnClick = draft == 2 ? () => { window.close(); return false; } : null; const paginationWhenBallotHasBeenEncrypted = e( "div", { style: { marginTop: "20px", textAlign: "center", }, }, previousButton, e( // this Next button submits the form BlueNiceButton, { onClick: nextOnClick, label: t("next_button_label"), style: { ...navigationButtonStyle, marginLeft: "20px", }, }, ), ); const paginationWhenBallotIsBeingEncrypted = e( "div", { style: { marginTop: "20px", textAlign: "center", }, }, previousButton, ); const pagination = cryptedBallot ? paginationWhenBallotHasBeenEncrypted : paginationWhenBallotIsBeingEncrypted; const encryptedBallotField = e( // add a hidden textarea in DOM which contains the encrypted vote, in the same way than the original booth "div", { style: { display: "none", }, }, t("encrypted_ballot_is"), e("textarea", { id: encryptedBallotId, name: encryptedBallotName, readOnly: "readonly", cols: "80", rows: "1", value: cryptedBallot ? cryptedBallot : undefined, }), ); return e( "div", { id: ballotContainerId, }, e( "form", { id: ballotFormId, method: "POST", action: urlToPostEncryptedBallot, encType: "multipart/form-data", }, encryptedBallotField, e( "div", { className: "review-encrypt-section", }, e("h2", null, t("review_ballot_for_questions")), e(WholeVoteRecap, { electionObject, uncryptedBallot, }), e( "div", { className: "review-encrypt-section__encryption-section", }, content, ), pagination, ), ), ); } const ReviewEncryptSection = withTranslation()( TranslatableReviewEncryptSection, ); export { ReviewEncryptSection, TranslatableReviewEncryptSection }; export default ReviewEncryptSection; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/ClassicVoteCandidatesList.js0000644000175000017500000000750514476041226026615 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import CandidateWithCheckbox from "./CandidateWithCheckbox.js"; import CandidateWithRadio from "./CandidateWithRadio.js"; /* Displays a list of candidates represented using instances of component CandidateWithCheckbox or CandidateWithRadio, depending on value of "type" prop. */ function TranslatableClassicVoteCandidatesList({ type, candidates, identifierPrefix, blankVoteIsAllowed, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }) { const candidate_constructor = type == "checkbox" ? CandidateWithCheckbox : CandidateWithRadio; let finalCandidates = candidates; if (blankVoteIsAllowed === true) { const blankVoteLabel = t("blank_vote"); finalCandidates = [...candidates, blankVoteLabel]; // We assume this the right way to do it } const renderedCandidates = finalCandidates.map( (candidate, candidateIndex) => { const identifier = `${identifierPrefix}_choice_${candidateIndex}`; let dispatchUpdateUserVoteForCandidateInQuestion = null; if (type == "checkbox") { dispatchUpdateUserVoteForCandidateInQuestion = ( candidate_is_selected, ) => { dispatchUpdateUserVoteForQuestion({ type: "saveVoteForCandidateInQuestion", candidate_index: candidateIndex, user_vote_for_candidate: candidate_is_selected === true ? 1 : 0, }); }; } else { // type is radio dispatchUpdateUserVoteForCandidateInQuestion = ( candidate_is_selected, ) => { dispatchUpdateUserVoteForQuestion({ type: candidate_is_selected === true ? "saveVoteForCandidateInQuestionAndResetOthers" : "saveVoteForCandidateInQuestion", candidate_index: candidateIndex, user_vote_for_candidate: candidate_is_selected === true ? 1 : 0, }); }; } const currentAlert = currentCandidatesHavingAlertsForQuestion && currentCandidatesHavingAlertsForQuestion.includes(candidateIndex); const commonProps = { candidateInfo: candidate, checked: currentUserVoteForQuestion[candidateIndex] === 1 ? true : false, id: identifier, key: candidateIndex, dispatchUpdateUserVoteForCandidateInQuestion, currentAlertsForCandidateInQuestion: currentAlert, }; const additionalProps = type == "checkbox" ? { name: identifier, } : { name: identifierPrefix, value: `choice_${candidateIndex}`, // or maybe a candidate id provided in data input, or slugification of candidate name? }; let blankVoteProps = {}; if (blankVoteIsAllowed === true && candidateIndex === candidates.length) { blankVoteProps = { style: { marginTop: "30px" }, }; } return e(candidate_constructor, { ...commonProps, ...additionalProps, ...blankVoteProps, }); }, ); return e( "div", { className: "classic-vote-candidates-list noselect", }, ...renderedCandidates, ); } TranslatableClassicVoteCandidatesList.defaultProps = { type: "checkbox", identifierPrefix: "question_1", candidates: ["Answer 1", "Answer 2", "Answer 3"], blankVoteIsAllowed: false, currentUserVoteForQuestion: [], currentCandidatesHavingAlertsForQuestion: [], dispatchUpdateUserVoteForQuestion: () => {}, t: (s) => { return s; }, }; const ClassicVoteCandidatesList = withTranslation()( TranslatableClassicVoteCandidatesList, ); export { ClassicVoteCandidatesList, TranslatableClassicVoteCandidatesList }; export default ClassicVoteCandidatesList; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/CandidateWithRadio.js0000644000175000017500000000272214476041226025245 0ustar stephstephimport React, { createElement as e } from "react"; import { markup } from "../shortcuts.js"; function CandidateWithRadio({ name, id, value, checked, candidateInfo, dispatchUpdateUserVoteForCandidateInQuestion, currentAlertsForCandidateInQuestion, ...props }) { const checkedValue = checked ? "checked" : null; const onChange = (event) => { dispatchUpdateUserVoteForCandidateInQuestion( event.target.checked === true ? true : false, ); }; let cssClasses = "candidate-with-checkbox clickable"; if (currentAlertsForCandidateInQuestion) { cssClasses += " candidate-with-checkbox--with-alert"; } return e( "div", { className: cssClasses, ...props, }, e("input", { type: "radio", name: name, id: id, value: value, defaultChecked: checkedValue, onChange: onChange, }), e( "label", { htmlFor: id, }, e("span", { className: "radio-button-appearance", }), e( "span", { className: "candidate-info", }, markup(candidateInfo), ), ), ); } CandidateWithRadio.defaultProps = { name: "radio-button-choice", id: "radio-button_1", value: "choice_1", checked: false, candidateInfo: "choice 1", dispatchUpdateUserVoteForCandidateInQuestion: () => {}, currentAlertsForCandidateInQuestion: undefined, }; export { CandidateWithRadio }; export default CandidateWithRadio; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/NiceButton.js0000644000175000017500000000143614476041226023631 0ustar stephstephimport React, { createElement as e } from "react"; // Parameter `tagName` can be "button", "input", "a" function NiceButton({ label = null, styling = "default", className = null, tagName = "button", ...props }) { props["className"] = className ? `nice-button nice-button--${styling} ${className}` : `nice-button nice-button--${styling}`; if (tagName == "input") { props["type"] = "submit"; props["value"] = label; } return e(tagName, props, tagName == "input" ? null : label); } function BlueNiceButton(props) { return NiceButton({ ...props, styling: "blue", }); } function WhiteNiceButton(props) { return NiceButton({ ...props, styling: "white", }); } export { NiceButton, BlueNiceButton, WhiteNiceButton }; export default NiceButton; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/NiceButton.css0000644000175000017500000000144314476041226024003 0ustar stephsteph.nice-button { border: 1px solid; padding: 6px 12px; border-radius: 6px; font-size: 15px; font-weight: 400; display: inline-block; line-height: initial; } .nice-button:hover { cursor: pointer; } .nice-button[disabled]:hover { cursor: initial; } .nice-button[disabled] { opacity: 0.5; } .nice-button--blue { background: #1097e6; color: white; border-color: #0046ca; background-image: linear-gradient(to bottom, #7ed0ff, #1097e6 66%, #0f8ad3); } .nice-button--white { color: black; border-color: #847f7f; background: white; background-image: linear-gradient(to bottom, #fff, #ddd 66%, #bfbebe); } .nice-button--default { background: #9d9d9d; color: white; border-color: #424242; background-image: linear-gradient(to bottom, #c4c4c4, #888 66%, #606060); } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/PreferentialVotingWithoutEqualityColumn.css0000644000175000017500000000134414476041226032020 0ustar stephsteph.preferential-voting-without-equality__candidate-container { display: flex; margin-bottom: 6px; } .preferential-voting-without-equality__candidate-rank { align-self: center; font-size: small; text-align: right; padding-right: 1ch; width: 3ch; color: rgb(0, 0, 0); transition: color 1s; } .preferential-voting-without-equality__candidate-rank--hidden { color: rgb(173, 173, 173); } .preferential-voting-without-equality__candidate { display: flex; border: 1px solid #d3d3d3; border-radius: 8px; background-color: #fff; min-height: 32px; box-sizing: border-box; } .preferential-voting-without-equality__candidate .preferential-voting__candidate-select-destination { width: 105px; margin-left: 5px; } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/PreferentialVotingVoteRecap.js0000644000175000017500000001141214476041226027172 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { markup } from "../shortcuts.js"; import { buildColumnLabel } from "./PreferentialVotingCandidatesList.js"; function PreferentialVotingVoteRecapForPreferenceLevel({ preference_level_title, preference_level_candidates, }) { if (preference_level_candidates.length === 0) { return null; } const rendered_candidates = preference_level_candidates.map((candidate) => { return e( "div", { className: "preferential-voting-vote-recap__candidate", }, markup(candidate), ); }); return e( "div", { className: "preferential-voting-vote-recap__preference-level", }, e( "div", { className: "preferential-voting-vote-recap__preference-level__title", }, preference_level_title, ), e( "div", { className: "preferential-voting-vote-recap__preference-level__candidates", }, ...rendered_candidates, ), ); } function TranslatablePreferentialVotingVoteRecap({ question, question_index, uncryptedBallot, t, }) { const questionText = question.title; const questionCandidates = question.candidates; const questionPossibleGrades = question.availableGrades; let renderedGradedCandidates = []; if ( question.blankVoteIsAllowed === true && uncryptedBallot[question_index].reduce((accumulator, value) => { if (value !== 0) { accumulator += 1; } return accumulator; }, 0) === 0 ) { renderedGradedCandidates = [ e( "div", { style: { paddingLeft: "40px", }, }, t("blank_vote"), ), ]; } else { let candidatesIndexesGroupedByPreferenceLevel = []; let notRankedCandidatesIndexes = []; uncryptedBallot[question_index].forEach( function (candidate_selected_ranking, candidate_index) { if (candidate_selected_ranking === 0) { notRankedCandidatesIndexes.push(candidate_index); } const selectedPreferenceLevelIndex = candidate_selected_ranking - 1; // We substract 1 in order to obtain the index of the selected grade in the array of available grades labels (indexes in arrays start at 0, and by convention index 0 must contain the label of the highest grade, index 2 must contain the label of the second highest grade, etc), whereas the value of answer in the uncrypted ballot represent the selected grade encoded as Belenios backend expects it, which is: grades are expected to start at 1, 1 being the highest grade, 2 being the second highest grade, etc (and 0 being interpreted as invalid vote, whereas 0 to all candidates of a question being interpreted as blank vote). if ( !Array.isArray( candidatesIndexesGroupedByPreferenceLevel[ selectedPreferenceLevelIndex ], ) ) { candidatesIndexesGroupedByPreferenceLevel[ selectedPreferenceLevelIndex ] = []; } candidatesIndexesGroupedByPreferenceLevel[ selectedPreferenceLevelIndex ].push(candidate_index); }, ); renderedGradedCandidates = candidatesIndexesGroupedByPreferenceLevel.map( (preference_level_candidates, preference_level_index) => { return e(PreferentialVotingVoteRecapForPreferenceLevel, { preference_level_title: buildColumnLabel( null, preference_level_index, t, ), preference_level_candidates: preference_level_candidates.map( (candidate_index) => questionCandidates[candidate_index], ), }); }, ); if (notRankedCandidatesIndexes.length > 0) { renderedGradedCandidates.push( e(PreferentialVotingVoteRecapForPreferenceLevel, { preference_level_title: t("preferential_voting_not_ranked"), preference_level_candidates: notRankedCandidatesIndexes.map( (candidate_index) => questionCandidates[candidate_index], ), }), ); } } const renderedVoteToQuestion = e( React.Fragment, null, e( "h3", { className: "whole-vote-recap__question-title", }, markup(questionText), ), e( "div", { className: "preferential-voting-vote-recap__answers-to-question", }, ...renderedGradedCandidates, ), ); return e( "div", { className: "preferential-voting-vote-recap", }, renderedVoteToQuestion, ); } const PreferentialVotingVoteRecap = withTranslation()( TranslatablePreferentialVotingVoteRecap, ); export { TranslatablePreferentialVotingVoteRecap, PreferentialVotingVoteRecap }; export default PreferentialVotingVoteRecap; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/PreferentialVotingCandidatesList.js0000644000175000017500000003476514476041226030215 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { DragDropContext } from "react-beautiful-dnd"; import CandidateWithCheckbox from "./CandidateWithCheckbox.js"; import PreferentialVotingColumn from "./PreferentialVotingColumn.js"; import { WhiteNiceButton } from "./NiceButton.js"; const buildColumnLabel = (column, columnOrderIndex, t) => { return column && column.title ? column.title : t("preferential_voting_preference_level", { level: columnOrderIndex + 1, }); }; const PreferenceLevelCreatorButton = ({ onClick, disabled, t }) => { return e( "div", { className: "preferential-voting-ui__level-creator noselect", }, e(WhiteNiceButton, { tagName: "a", label: t("preferential_votign_add_preference_level"), onClick: disabled ? null : onClick, className: "preferential-voting-ui__level-creator__add-icon", disabled: disabled, }), ); }; class PreferentialVotingApp extends React.Component { constructor(props) { super(props); const { initialData } = props; this.state = { ...initialData, createdColumnsCounter: initialData.columnOrder.length, }; this.onDragEnd = this.onDragEnd.bind(this); this.moveCandidate = this.moveCandidate.bind(this); this.deletePreferenceLevel = this.deletePreferenceLevel.bind(this); this.insertPreferenceLevel = this.insertPreferenceLevel.bind(this); this.render = this.render.bind(this); this.buildUserVoteForAllCandidatesInQuestion = this.buildUserVoteForAllCandidatesInQuestion.bind(this); this.saveUserVoteForAllCandidatesInQuestion = this.saveUserVoteForAllCandidatesInQuestion.bind(this); } buildUserVoteForAllCandidatesInQuestion() { let updatedVoteForCandidates = []; this.state.columnOrder.forEach((currentColumnId, currentColumnIndex) => { this.state.columns[currentColumnId].candidatesIds.forEach( (currentCandidateId) => { let candidate = this.state.candidates[currentCandidateId]; if (!candidate) { alert("could not find candidate"); } else { updatedVoteForCandidates[candidate.initialIndex] = currentColumnId === "not-ranked" ? undefined : currentColumnIndex; } }, ); }); return updatedVoteForCandidates; } saveUserVoteForAllCandidatesInQuestion() { const userVote = this.buildUserVoteForAllCandidatesInQuestion(); this.props.dispatchUpdateUserVoteForQuestion({ type: "saveVoteForAllCandidatesInQuestion", user_vote_for_all_candidates_in_question: userVote, }); } moveCandidate( candidateId, sourceColumnId, destinationColumnId, sourceColumnCandidateIndex, destinationColumnCandidateIndex, ) { const sourceColumn = this.state.columns[sourceColumnId]; const newSourceColumnCandidateIds = Array.from(sourceColumn.candidatesIds); newSourceColumnCandidateIds.splice(sourceColumnCandidateIndex, 1); if (sourceColumnId === destinationColumnId) { newSourceColumnCandidateIds.splice( destinationColumnCandidateIndex, 0, candidateId, ); } const newSourceColumn = { ...sourceColumn, candidatesIds: newSourceColumnCandidateIds, }; let changedColumns = {}; changedColumns[newSourceColumn.id] = newSourceColumn; if (sourceColumnId != destinationColumnId) { const destinationColumn = this.state.columns[destinationColumnId]; const newDestinationColumnCandidateIds = Array.from( destinationColumn.candidatesIds, ); newDestinationColumnCandidateIds.splice( destinationColumnCandidateIndex, 0, candidateId, ); const newDestinationColumn = { ...destinationColumn, candidatesIds: newDestinationColumnCandidateIds, }; changedColumns[newDestinationColumn.id] = newDestinationColumn; } const newState = { ...this.state, columns: { ...this.state.columns, ...changedColumns, }, }; this.setState(newState); // replicate the local state change in the more global state const destinationColumnIndex = this.state.columnOrder.findIndex( (element) => element == destinationColumnId, ); if (candidateId in this.state.candidates && destinationColumnIndex > -1) { const candidateIndex = this.state.candidates[candidateId].initialIndex; this.props.dispatchUpdateUserVoteForQuestion({ type: "saveVoteForCandidateInQuestion", candidate_index: candidateIndex, user_vote_for_candidate: destinationColumnIndex, }); } else { alert("candidate index not found or destination column index not found"); } } deletePreferenceLevel(columnId) { const index = this.state.columnOrder.findIndex( (element) => element == columnId, ); if (index === undefined) { console.log( `/!\\ column id ${columnId} not found in this.state.columnOrder`, ); return; } const newColumnOrder = Array.from(this.state.columnOrder); const newColumns = JSON.parse(JSON.stringify(this.state.columns)); newColumnOrder.splice(index, 1); if (newColumns.hasOwnProperty(columnId)) { delete newColumns[columnId]; } else { console.log( `/!\\ could not remove ${columnId} because it was absent from newColumns`, ); } const newState = { ...this.state, columns: newColumns, columnOrder: newColumnOrder, }; this.setState(newState, this.saveUserVoteForAllCandidatesInQuestion); } insertPreferenceLevel(insertBeforeIndex) { const newColumnId = `column-${this.state.createdColumnsCounter}`; const newColumnOrder = Array.from(this.state.columnOrder); newColumnOrder.splice(insertBeforeIndex, 0, newColumnId); const newState = { ...this.state, columns: { ...this.state.columns, [newColumnId]: { id: newColumnId, candidatesIds: [], }, }, columnOrder: newColumnOrder, createdColumnsCounter: this.state.createdColumnsCounter + 1, }; this.setState(newState, this.saveUserVoteForAllCandidatesInQuestion); } onDragEnd(result) { const { destination, source, draggableId } = result; if (!destination) { return; } if ( destination.droppableId === source.droppableId && destination.index === source.index ) { return; } this.moveCandidate( draggableId, source.droppableId, destination.droppableId, source.index, destination.index, ); } render() { const allColumns = this.state.columnOrder.map((columnId, index) => { return { id: columnId, label: buildColumnLabel( this.state.columns[columnId], index, this.props.t, ), }; }); const children = this.state.columnOrder.map((columnId, index) => { if (!this.state.columns.hasOwnProperty(columnId)) { console.log( `/!\\ Column ${columnId} is present at index ${index} in this.state.columnOrder, but is absent from this.state.columns`, ); return e("div"); } const column = this.state.columns[columnId]; const candidates = column.candidatesIds.map( (candidateId) => this.state.candidates[candidateId], ); const otherColumns = Array.from(allColumns); otherColumns.splice(index, 1); return e( "div", null, e(PreferenceLevelCreatorButton, { onClick: () => { this.insertPreferenceLevel(index); }, disabled: this.props.disabled, t: this.props.t, }), e(PreferentialVotingColumn, { key: column.id, column: column, candidates: candidates, label: buildColumnLabel(column, index, this.props.t), onClickDeleteButton: () => { const canDeleteColumn = candidates.length == 0; if (canDeleteColumn) { this.deletePreferenceLevel(column.id); } else { alert(t("preferential_voting_warning_delete_only_empty_level")); } }, otherColumns: otherColumns, onSelectCandidateDestinationColumn: ( candidateId, sourceColumnCandidateIndex, destinationColumnId, ) => { this.moveCandidate( candidateId, column.id, destinationColumnId, sourceColumnCandidateIndex, this.state.columns[destinationColumnId].candidatesIds.length, ); }, disabled: this.props.disabled, }), ); }); return e( "div", { className: "preferential-voting-ui", }, e( DragDropContext, { onDragEnd: this.onDragEnd, }, ...children, ), ); } } PreferentialVotingApp.defaultProps = { initialData: { candidates: { "candidate-0": { id: "candidate-0", initialIndex: 0, content: "Charge my phone", }, "candidate-1": { id: "candidate-1", initialIndex: 1, content: "Cook dinner", }, "candidate-2": { id: "candidate-2", initialIndex: 2, content: "Go to the pub", }, }, columns: { "column-0": { id: "column-0", candidatesIds: [], }, "column-1": { id: "column-1", candidatesIds: [], }, "not-ranked": { id: "not-ranked", title: "Non classé", candidatesIds: ["candidate-0", "candidate-1", "candidate-2"], }, }, columnOrder: ["column-0", "column-1", "not-ranked"], }, disabled: false, t: function (s) { return s; }, currentCandidatesHavingAlertsForQuestion: [], dispatchUpdateUserVoteForQuestion: () => {}, }; function TranslatablePreferentialVotingBigCandidatesList({ identifierPrefix, candidates, blankVoteIsAllowed, renderedBlankVoteComponent, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }) { /* TODO: - show alerts using currentCandidatesHavingAlertsForQuestion - optional improvement to implement a smart back button: use currentUserVoteForQuestion to build initialData */ const userHasSelectedBlankVote = blankVoteIsAllowed && currentUserVoteForQuestion.length > candidates.length && currentUserVoteForQuestion[candidates.length] === 1 ? true : false; let initialData = {}; const candidatesForInitialData = candidates.map( (candidateLabel, candidateIndex) => { return { id: `${identifierPrefix}_candidate_${candidateIndex}`, content: candidateLabel, initialIndex: candidateIndex, }; }, ); initialData.candidates = candidatesForInitialData.reduce( (accumulator, currentValue) => { accumulator[currentValue.id] = currentValue; return accumulator; }, {}, ); initialData.columns = { "column-0": { id: "column-0", candidatesIds: [], }, "column-1": { id: "column-1", candidatesIds: [], }, "not-ranked": { id: "not-ranked", title: t("preferential_voting_not_ranked"), candidatesIds: candidatesForInitialData.map((candidate) => candidate.id), }, }; // Facilitate reordering of the columns initialData.columnOrder = ["column-0", "column-1", "not-ranked"]; let additionalComponents = []; if (blankVoteIsAllowed && renderedBlankVoteComponent) { additionalComponents.push(renderedBlankVoteComponent); } return e( "div", { className: "preferential-voting-ui-container", }, e(PreferentialVotingApp, { initialData, dispatchUpdateUserVoteForQuestion, disabled: userHasSelectedBlankVote, t, }), ...additionalComponents, ); } function TranslatablePreferentialVotingCandidatesList({ identifierPrefix, candidates, blankVoteIsAllowed, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }) { let renderedBlankVoteComponent = null; const candidateIndex = candidates.length; const userHasSelectedBlankVote = blankVoteIsAllowed && currentUserVoteForQuestion.length > candidates.length && currentUserVoteForQuestion[candidateIndex] === 1 ? true : false; if (blankVoteIsAllowed) { const blankVoteLabel = t("blank_vote"); const identifier = `${identifierPrefix}_blank-vote`; const currentAlerts = currentCandidatesHavingAlertsForQuestion && currentCandidatesHavingAlertsForQuestion.includes(candidateIndex); const dispatchBlankVoteInQuestion = (blankVoteIsChecked) => { dispatchUpdateUserVoteForQuestion({ type: "saveBlankVoteInQuestion", blankVoteIsChecked, }); }; const commonProps = { candidateInfo: blankVoteLabel, checked: userHasSelectedBlankVote, id: identifier, key: candidateIndex, dispatchUpdateUserVoteForCandidateInQuestion: dispatchBlankVoteInQuestion, currentAlertsForCandidateInQuestion: currentAlerts, name: identifier, }; const blankVoteProps = { style: { margin: "50px auto 30px", maxWidth: "400px", }, }; renderedBlankVoteComponent = e(CandidateWithCheckbox, { ...commonProps, ...blankVoteProps, }); } let cssClasses = "preferential-voting-candidates-list noselect"; if (userHasSelectedBlankVote) { cssClasses += " preferential-voting-candidates-list--blank-vote-is-selected"; } return e( "div", { className: cssClasses, }, e(TranslatablePreferentialVotingBigCandidatesList, { identifierPrefix, candidates, blankVoteIsAllowed, renderedBlankVoteComponent, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }), ); } TranslatablePreferentialVotingCandidatesList.defaultProps = { identifierPrefix: "question_1", candidates: ["Candidate 1", "Candidate 2", "Candidate 3"], blankVoteIsAllowed: false, t: function (s) { return s; }, currentCandidatesHavingAlertsForQuestion: [], dispatchUpdateUserVoteForQuestion: () => {}, }; const PreferentialVotingCandidatesList = withTranslation()( TranslatablePreferentialVotingCandidatesList, ); export { PreferentialVotingCandidatesList, TranslatablePreferentialVotingCandidatesList, buildColumnLabel, }; export default PreferentialVotingCandidatesList; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/InputCredentialSection.js0000644000175000017500000000363414476041226026200 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { BlueNiceButton } from "./NiceButton.js"; import { NiceTextInput } from "./NiceInput.js"; function TranslatableInputCredentialSection({ onSubmit = null, t }) { const credentialId = "credential"; const onClick = () => { const result = document.getElementById(credentialId).value.trim(); if (result && onSubmit) { return onSubmit(result); } }; return e( "div", { className: "input-credential-section-container", style: { padding: "30px", }, }, e( "div", { className: "input-credential-section", style: { background: "rgb(229, 242, 247)", padding: "20px", textAlign: "center", borderRadius: "8px", }, }, e( "div", { className: "input-credential-section__instruction-container", style: { maxWidth: "300px", margin: "0 auto", }, }, e( "div", { className: "input-credential-section__instruction", style: { paddingBottom: "12px", }, }, e("p", null, t("ask_for_credential")), e(NiceTextInput, { id: credentialId, onKeyUp: function (e) { if (e.keyCode == 13) onClick(); }, }), ), e(BlueNiceButton, { className: "input-credential-section__button", style: { padding: "8px 28px", }, label: t("next_button_label"), onClick: onClick, }), ), ), ); } const InputCredentialSection = withTranslation()( TranslatableInputCredentialSection, ); export { InputCredentialSection, TranslatableInputCredentialSection }; export default InputCredentialSection; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/NiceInput.js0000644000175000017500000000063314476041226023453 0ustar stephstephimport React, { createElement as e } from "react"; function NicePasswordInput(props = {}) { return e("input", { type: "password", className: "nice-password-input", ...props, }); } function NiceTextInput(props = {}) { return e("input", { type: "text", className: "nice-text-input", ...props, }); } export { NicePasswordInput, NiceTextInput }; export default NicePasswordInput; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/common.css0000644000175000017500000000073614476041226023225 0ustar stephsteph.noselect { -webkit-touch-callout: none; /* iOS Safari */ -webkit-user-select: none; /* Safari */ -khtml-user-select: none; /* Konqueror HTML */ -moz-user-select: none; /* Old versions of Firefox */ -ms-user-select: none; /* Internet Explorer/Edge */ user-select: none; /* Non-prefixed version, currently supported by Chrome, Edge, Opera and Firefox */ } .clickable:hover, .clickable *:hover { cursor: pointer; } .draggable, .draggable:hover { cursor: move; } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/ReviewEncryptSection.css0000644000175000017500000000160114476041226026060 0ustar stephsteph.review-encrypt-section { padding: 0px 30px 30px 30px; } .review-encrypt-section__encryption-section { background: #e6f8fd; border-radius: 8px; padding: 20px; text-align: center; margin: 40px auto 0 auto; max-width: 600px; } .review-encrypt-section__smart-ballot-tracker-container { display: inline-block; margin-left: 5px; margin-bottom: 2px; } .review-encrypt-section__smart-ballot-tracker { display: inline-block; word-break: break-all; border: 1px solid #ccc; border-radius: 8px; padding: 5px 14px; background: white; font-family: monospace; vertical-align: middle; font-size: 10px; } @media screen and (max-width: 640px) { .review-encrypt-section { padding: 0px 14px 30px 14px; } .review-encrypt-section__encryption-section { padding: 10px; } .review-encrypt-section__smart-ballot-tracker-container { margin-left: 10px; } } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/QuestionWithVotableAnswers.js0000644000175000017500000001226714476041226027106 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { markup } from "../shortcuts.js"; import { TranslatableGenericVoteCandidatesList } from "./GenericVoteCandidatesList.js"; import { TranslatableClassicVoteCandidatesList } from "./ClassicVoteCandidatesList.js"; // FIXME: We have to import TranslatableClassicVoteCandidatesList instead of ClassicVoteCandidatesList, because otherwise Storybook throws a hook error. import { TranslatableMajorityJudgmentVoteCandidatesList } from "./MajorityJudgmentVoteCandidatesList.js"; import { TranslatablePreferentialVotingCandidatesList } from "./PreferentialVotingCandidatesList.js"; import { TranslatablePreferentialVotingWithoutEqualityCandidatesList } from "./PreferentialVotingWithoutEqualityCandidatesList.js"; import { QuestionTypeEnum, detectQuestionType } from "../election_utils.js"; function TranslatableQuestionWithVotableAnswers({ question, identifierPrefix, visible, currentUserVoteForQuestion, currentAlertsTextsForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }) { let description; let rendered_answers; if (question.type === QuestionTypeEnum.MAJORITY_JUDGMENT) { description = t("majority_judgment_question_description"); rendered_answers = e(TranslatableMajorityJudgmentVoteCandidatesList, { identifierPrefix, candidates: question.answers, blankVoteIsAllowed: question.blankVoteIsAllowed, availableGrades: question.availableGrades, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }); } else if ( question.type === QuestionTypeEnum.PREFERENTIAL_VOTING_WITH_EQUALITY ) { description = t("preferential_voting_question_description"); rendered_answers = e(TranslatablePreferentialVotingCandidatesList, { identifierPrefix, candidates: question.answers, blankVoteIsAllowed: question.blankVoteIsAllowed, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }); } else if ( question.type === QuestionTypeEnum.PREFERENTIAL_VOTING_WITHOUT_EQUALITY ) { description = t("preferential_voting_question_description"); rendered_answers = e( TranslatablePreferentialVotingWithoutEqualityCandidatesList, { identifierPrefix, candidates: question.answers, blankVoteIsAllowed: question.blankVoteIsAllowed, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }, ); } else if (question.type === QuestionTypeEnum.CLASSIC) { let minimumAnswers = question.min; let maximumAnswers = question.max; let classic_question_subtype = "checkbox"; if (minimumAnswers === 1 && maximumAnswers === 1) { classic_question_subtype = "radio"; } if (minimumAnswers === maximumAnswers) { description = t("ask_to_select_x_answers", { count: minimumAnswers }); } else { description = t("ask_to_select_between_x_and_y_answers", { min: minimumAnswers, count: maximumAnswers, }); } rendered_answers = e(TranslatableClassicVoteCandidatesList, { type: classic_question_subtype, identifierPrefix, candidates: question.answers, blankVoteIsAllowed: question.blankVoteIsAllowed, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }); } else if (question.type === QuestionTypeEnum.GENERIC) { rendered_answers = e(TranslatableGenericVoteCandidatesList, { identifierPrefix, candidates: question.answers, currentUserVoteForQuestion, currentCandidatesHavingAlertsForQuestion, dispatchUpdateUserVoteForQuestion, t, }); } const bemBlockName = "question-with-votable-answers"; const containerClassNames = visible ? bemBlockName : `${bemBlockName} ${bemBlockName}--hidden`; const alertsElements = currentAlertsTextsForQuestion.reduce( (accumulator, value) => { if (value) { accumulator.push(e("p", null, value)); } return accumulator; }, [], ); return e( "div", { className: containerClassNames, }, e( "h3", { className: `${bemBlockName}__question-title`, }, markup(question.title), ), e( "p", { className: `${bemBlockName}__question-description`, }, description, ), rendered_answers, e( "div", { className: `${bemBlockName}__alerts`, }, ...alertsElements, ), ); } TranslatableQuestionWithVotableAnswers.defaultProps = { identifierPrefix: "question_1_", visible: true, currentUserVoteForQuestion: [], currentAlertsTextsForQuestion: [], currentCandidatesHavingAlertsForQuestion: [], dispatchUpdateUserVoteForQuestion: () => {}, }; const QuestionWithVotableAnswers = withTranslation()( TranslatableQuestionWithVotableAnswers, ); export { QuestionWithVotableAnswers, TranslatableQuestionWithVotableAnswers }; export default QuestionWithVotableAnswers; belenios-2.2-10-gbb6b7ea8/frontend/booth/components/QuestionWithVotableAnswers.css0000644000175000017500000000057714476041226027263 0ustar stephsteph.question-with-votable-answers { margin: 2px 10px; } .question-with-votable-answers--hidden { display: none; } .question-with-votable-answers__question-title { font-weight: 400; margin: 8px 0 3px 0; } .question-with-votable-answers__question-description { font-size: 12px; margin: 10px 0; } .question-with-votable-answers__alerts { color: red; font-size: 12px; } belenios-2.2-10-gbb6b7ea8/frontend/booth/components/AllQuestionsWithPagination.js0000644000175000017500000005472614476041226027062 0ustar stephstephimport React, { createElement as e } from "react"; import { withTranslation } from "react-i18next"; import { QuestionWithVotableAnswers } from "./QuestionWithVotableAnswers.js"; import { QuestionTypeEnum, detectQuestionType } from "../election_utils.js"; import VoteNavigation from "./VoteNavigation.js"; const deepCloneArray = (currentArray) => { return currentArray.map((element) => { if (Array.isArray(element)) { return element.slice(); } else if (typeof element === "object") { return Object.assign({}, element); } else { return element; } }); }; const bindFunctionMergeObjectToFirstParameter = (f, obj) => { return (obj2) => { return f({ ...obj2, ...obj }); }; }; /* We chose to not use a ``, because it could increase possibilities to leak voter's choices. Instead, we use `` or `` fields outside of a ``, and classic `
Version:
Group parameters:

Trustee key generation

Generated key identifier

Generated secret key

Generated public key

Credential management

Generate anonymous credentials

Number of credentials to generate:

Generate credentials with identity matching

List of identities:

Generated private credentials

Generated public credentials

Check a credential

Credential:

Election creation

Trustee public keys:
Questions:

Output

Condorcet-Schulze method

Output

belenios-2.2-10-gbb6b7ea8/src/web/clients/tool/tool_js_fingerprint.ml0000644000175000017500000001124714476041226024477 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Js_of_ocaml open Belenios_core.Common open Belenios_js.Common let computed_fingerprint = ref "" let compute_handler input output _ = let open (val !Belenios_js.I18n.gettext) in let input = Js.to_string input##.value in computed_fingerprint := sha256_b64 input; clear_content output; Dom.appendChild output (document##createTextNode (Js.string (s_ "Computed fingerprint:"))); Dom.appendChild output (document##createTextNode (Js.string " ")); Dom.appendChild output (document##createTextNode (Js.string !computed_fingerprint)); Js._true let compare_handler input output _ = let open (val !Belenios_js.I18n.gettext) in let input = Js.to_string input##.value in if input <> "" then ( let result = if input = !computed_fingerprint then s_ "The fingerprints match!" else s_ "The fingerprints differ!" in clear_content output; Dom.appendChild output (document##createTextNode (Js.string result))); Js._true let fill_interactivity () = let open (val !Belenios_js.I18n.gettext) in let$ container = document##getElementById (Js.string "interactivity") in let result_div = Dom_html.createDiv document in let intro_div = Dom_html.createDiv document in Dom.appendChild intro_div (document##createTextNode (Js.string (s_ "Please paste the data for which you want to compute the \ fingerprint in the text area below:"))); Dom.appendChild container intro_div; let textarea_div = Dom_html.createDiv document in let textarea = Dom_html.createTextarea document in textarea##.cols := 80; textarea##.rows := 25; Dom.appendChild textarea_div textarea; Dom.appendChild container textarea_div; let compute_div = Dom_html.createDiv document in let compute = Dom_html.createButton document in let compute_label = document##createTextNode (Js.string (s_ "Compute fingerprint")) in compute##.onclick := Dom_html.handler (compute_handler textarea result_div); Dom.appendChild compute compute_label; Dom.appendChild compute_div compute; Dom.appendChild container compute_div; Dom.appendChild container result_div; let input_div = Dom_html.createDiv document in Dom.appendChild input_div (document##createTextNode (Js.string (s_ "Expected fingerprint:"))); Dom.appendChild input_div (document##createTextNode (Js.string " ")); let input = Dom_html.createInput document in input##.size := 50; Dom.appendChild input_div input; Dom.appendChild container input_div; let compare_div = Dom_html.createDiv document in let compare = Dom_html.createButton document in let compare_span = Dom_html.createB document in Dom.appendChild compare (document##createTextNode (Js.string (s_ "Compare"))); compare##.onclick := Dom_html.handler (compare_handler input compare_span); Dom.appendChild compare_div compare; Dom.appendChild compare_div (document##createTextNode (Js.string " ")); Dom.appendChild compare_div compare_span; Dom.appendChild container compare_div let () = Lwt.async (fun () -> let* _ = Js_of_ocaml_lwt.Lwt_js_events.onload () in let* () = Belenios_js.I18n.auto_init "admin" in fill_interactivity (); Lwt.return_unit) belenios-2.2-10-gbb6b7ea8/src/web/clients/tool/tool_js_ttkeygen.ml0000644000175000017500000002046414476041226024003 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Js_of_ocaml open Belenios_core open Common open Belenios open Serializable_j open Signatures open Belenios_js.Common open Belenios_api.Serializable_j let set_step i = let open (val !Belenios_js.I18n.gettext) in let$ e = document##getElementById (Js.string "current_step") in clear_content e; let t = Printf.sprintf (f_ "Step %d/3") i in let t = document##createTextNode (Js.string t) in Dom.appendChild e t let set_explain str = let$ e = document##getElementById (Js.string "explain") in clear_content e; let t = document##createTextNode (Js.string str) in Dom.appendChild e t; Dom.appendChild e (Dom_html.createBr document) let gen_cert draft e _ = let version = draft.draft_version in let group = draft.draft_group in let module G = (val Group.of_string ~version group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let module P = Trustees.MakePKI (G) (Random) in let module C = Trustees.MakeChannels (G) (Random) (P) in let module T = Trustees.MakePedersen (G) (Random) (P) (C) in Lwt.async (fun () -> let key, cert = T.step1 () in clear_content e; set_download "private_key" "text/plain" "private_key.txt" key; set_element_display "key_helper" "block"; let fp = sha256_b64 cert.s_message in let cert = string_of_cert cert in set_content "pki_fp" fp; set_textarea "data" cert; Lwt.return_unit); Js._false let proceed draft pedersen = let version = draft.draft_version in let group = draft.draft_group in let$ e = document##getElementById (Js.string "compute_private_key") in let$ e = Dom_html.CoerceTo.input e in let key = Js.to_string e##.value in let certs = { certs = pedersen.pedersen_certs } in let threshold = pedersen.pedersen_threshold in let module G = (val Group.of_string ~version group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let module P = Trustees.MakePKI (G) (Random) in let module C = Trustees.MakeChannels (G) (Random) (P) in let module T = Trustees.MakePedersen (G) (Random) (P) (C) in Lwt.async (fun () -> match pedersen.pedersen_step with | 3 -> let polynomial = T.step3 certs key threshold in set_textarea "compute_data" (string_of_polynomial polynomial); Lwt.return_unit | 5 -> let@ vinput cont = match pedersen.pedersen_vinput with | Some x -> cont x | None -> alert "Unexpected state! (missing vinput)"; Lwt.return_unit in let voutput = T.step5 certs key vinput in set_textarea "compute_data" (string_of_voutput (swrite G.to_string) voutput); Lwt.return_unit | _ -> alert "Unexpected state!"; Lwt.return_unit) let fail msg = set_content "election_url" msg; Lwt.return_unit let fill_interactivity () = let open (val !Belenios_js.I18n.gettext) in let&&* e = document##getElementById (Js.string "interactivity") in let@ uuid, token = fun cont -> let hash = Dom_html.window##.location##.hash |> Js.to_string in match extract_uuid_and_token hash with | Some (uuid, token) -> cont (uuid, token) | None -> fail "(uuid error)" in let@ () = redirect_if_admin "threshold-trustee" uuid token in set_form_target "data_form" "submit-threshold-trustee" uuid token; set_form_target "data_form_compute" "submit-threshold-trustee" uuid token; let href = Dom_html.window##.location##.href |> Js.to_string in set_content "election_url" (build_election_url href uuid); let@ draft cont = let url = Printf.sprintf "../api/drafts/%s" uuid in let* x = get draft_of_string url in match x with Some x -> cont x | None -> fail "(token error)" in let@ pedersen cont = let url = Printf.sprintf "../api/drafts/%s/trustees-pedersen" uuid in let* x = get ~token (pedersen_of_string Yojson.Safe.read_json) url in match x with Some x -> cont x | None -> fail "(pedersen error)" in let step = pedersen.pedersen_step in let@ () = fun cont -> cont (); Lwt.return_unit in match step with | 0 -> set_element_display "data_form" "none"; let t = document##createTextNode (Js.string (s_ "Waiting for the election administrator to set the \ threshold... Reload the page to check progress.")) in Dom.appendChild e t | 2 | 4 -> set_step (step / 2); set_element_display "data_form" "none"; let t = document##createTextNode (Js.string (s_ "Waiting for the other trustees... Reload the page to check \ progress.")) in Dom.appendChild e t | 6 | 7 -> set_step 3; set_element_display "data_form" "none"; let@ voutput cont = match pedersen.pedersen_voutput with | Some x -> cont x | None -> alert "Unexpected state! (missing voutput)" in let pk = Yojson.Safe.to_string voutput.vo_public_key.trustee_public_key in let fp = sha256_b64 pk in let msg = Printf.sprintf (f_ "Your job in the key establishment protocol is done! The \ fingerprint of your verification key is %s. Check that it is \ published by the server when the election is open. Your private \ key will be needed to decrypt the election result.") fp in let t = document##createTextNode (Js.string msg) in Dom.appendChild e t; set_element_display "div_instructions" "block" | 1 -> set_step 1; let b = Dom_html.createButton document in let t = document##createTextNode (Js.string (s_ "Generate private key")) in b##.onclick := Dom_html.handler (gen_cert draft e); Dom.appendChild b t; Dom.appendChild e b | 3 | 5 -> let explain = match step with | 3 -> s_ "Now, all the certificates of the trustees have been generated. \ Proceed to generate your share of the decryption key." | 5 -> s_ "Now, all the trustees have generated their secret shares. \ Proceed to the final checks so that the election can be \ validated." | _ -> failwith "impossible step" in set_step ((step + 1) / 2); set_explain explain; set_element_display "compute_form" "block"; let$ e = document##getElementById (Js.string "compute_button") in e##.onclick := Dom_html.handler (fun _ -> proceed draft pedersen; Js._false) | _ -> alert "Unexpected state!" let () = Lwt.async (fun () -> let* _ = Js_of_ocaml_lwt.Lwt_js_events.onload () in let* () = Belenios_js.I18n.auto_init "admin" in fill_interactivity ()) belenios-2.2-10-gbb6b7ea8/src/web/clients/tool/tool_js_questions.ml0000644000175000017500000005050314476041226024200 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Js_of_ocaml open Belenios_core open Serializable_j open Belenios_js.Common let return = Js.Opt.return let handler f = Dom_html.handler (fun e -> ignore (f e); Js._false) let hybrid_mode = ref false let q_answers = [| "Answer 1"; "Answer 2"; "Answer 3" |] let default_question_h = let open Question_h_t in Question.Homomorphic { q_question = "Question?"; q_min = 1; q_max = 1; q_blank = None; q_answers; } let default_question_nh = let open Question_nh_t in Question.NonHomomorphic ( { q_question = "Give a rank to each candidate (a number between 1 and 3)"; q_answers; }, None ) let default_question () = if !hybrid_mode then default_question_nh else default_question_h let default_mj_specification = "{\"type\":\"ScoreVoting\",\"blank\":true,\"grades\":[\"Excellent\",\"Good\",\"Bad\",\"Reject\"],\"method\":\"MajorityJudgment\"}" let default_schulze_specification = "{\"type\":\"PreferentialVoting\",\"blank\":true,\"method\":\"Schulze\"}" let default_stv_specification = "{\"type\":\"PreferentialVoting\",\"blank\":true,\"method\":\"STV\",\"seats\":1}" (* Getting the OCaml structure out of the DOM *) let extractAnswer a = let&& x = Dom_html.CoerceTo.input a in return (Js.to_string x##.value) let extractQuestion q = let open (val !Belenios_js.I18n.gettext) in let&& x = Dom_html.CoerceTo.input q in let q_question = Js.to_string x##.value in let&& p1 = q##.parentNode in let&& p2 = p1##.parentNode in let&& p2 = Dom.CoerceTo.element p2 in let p2 = Dom_html.element p2 in let numeric selector error_msg = let&& x = p2##querySelector (Js.string selector) in let&& x = Dom_html.CoerceTo.input x in let x = Js.to_string x##.value in try return (int_of_string x) with _ -> failwith (error_msg ^ ": " ^ x ^ ".") in let answers = p2##querySelectorAll (Js.string ".question_answer") in let q_answers = Array.init answers##.length (fun i -> let a = let&& x = answers##item i in extractAnswer x in Js.Opt.get a (fun () -> failwith "extractQuestion")) in Js.Opt.case (p2##querySelector (Js.string ".question_blank")) (fun () -> let&& x = p2##querySelector (Js.string ".question_extra") in let&& x = Dom_html.CoerceTo.input x in let x = Js.to_string x##.value in let extra = if x = "" then None else try Some (Yojson.Safe.from_string x) with _ -> failwith (s_ "Invalid counting method specification!") in let open Question_nh_t in return (Question.NonHomomorphic ({ q_question; q_answers }, extra))) (fun q_blank -> let&& q_blank = Dom_html.CoerceTo.input q_blank in let q_blank = if Js.to_bool q_blank##.checked then Some true else None in let&& q_min = numeric ".question_min" (s_ "Invalid minimum number of choices") in let&& q_max = numeric ".question_max" (s_ "Invalid maximum number of choices") in if not (q_min <= q_max) then failwith (s_ "Minimum number of choices must be less than or equal to maximum \ number of choices!"); if q_max = 0 then failwith (s_ "Maximum number of choices must be greater than 0!"); if q_max > Array.length q_answers then failwith (s_ "The given maximum is greater than the number of choices!"); let open Question_h_t in return (Question.Homomorphic { q_question; q_blank; q_min; q_max; q_answers })) let extractTemplate () = let t_name = get_input "q_election_name" in let t_description = get_textarea "q_election_description" in let questions = document##querySelectorAll (Js.string ".question_question") in let t_questions = Array.init questions##.length (fun i -> let q = let&& x = questions##item i in extractQuestion x in Js.Opt.get q (fun () -> failwith "extractTemplate")) in let t_administrator = None in let t_credential_authority = None in { t_name; t_description; t_questions; t_administrator; t_credential_authority; } (* Injecting the OCaml structure into the DOM *) let rec createAnswer a = let open (val !Belenios_js.I18n.gettext) in let container = Dom_html.createDiv document in container##.className := Js.string "question_answer_item"; let t = document##createTextNode (Js.string (s_ "Answer: ")) in let u = Dom_html.createInput document in u##.className := Js.string "question_answer"; u##.value := Js.string a; u##.size := 60; Dom.appendChild container t; Dom.appendChild container u; let btn_text = document##createTextNode (Js.string (s_ "Remove")) in let btn = Dom_html.createButton document in let f _ = let&& x = container##.parentNode in Dom.removeChild x container; return () in btn##.onclick := handler f; btn##.className := Js.string "btn_remove"; Dom.appendChild btn btn_text; Dom.appendChild container btn; let insert_text = document##createTextNode (Js.string (s_ "Insert")) in let insert_btn = Dom_html.createButton document in let f _ = let x = createAnswer "" in let&& p = container##.parentNode in Dom.insertBefore p x (Js.some container); return () in insert_btn##.onclick := handler f; insert_btn##.className := Js.string "btn_insert"; Dom.appendChild insert_btn insert_text; Dom.appendChild container insert_btn; container let createHomomorphicQuestionPropDiv min max blank = let open (val !Belenios_js.I18n.gettext) in let container = Dom_html.createDiv document in let x = Dom_html.createDiv document in let t = document##createTextNode (Js.string (s_ "The voter has to choose between ")) in Dom.appendChild x t; let h_min = Dom_html.createInput document in Dom.appendChild x h_min; h_min##.className := Js.string "question_min"; h_min##.size := 5; h_min##.value := Js.string (string_of_int min); let t = document##createTextNode (Js.string (s_ " and ")) in Dom.appendChild x t; let h_max = Dom_html.createInput document in Dom.appendChild x h_max; h_max##.className := Js.string "question_max"; h_max##.size := 5; h_max##.value := Js.string (string_of_int max); let t = document##createTextNode (Js.string (s_ " answers.")) in Dom.appendChild x t; Dom.appendChild container x; (* is blank allowed? *) let checkboxContainer = Dom_html.createDiv document in let x = Dom_html.createLabel document in let h_blank = Dom_html.createInput ~_type:(Js.string "checkbox") document in h_blank##.className := Js.string "question_blank"; (h_blank##.checked := Js.(match blank with Some true -> _true | _ -> _false)); Dom.appendChild x h_blank; let t = document##createTextNode (Js.string (s_ "Blank vote is allowed")) in Dom.appendChild x t; Dom.appendChild checkboxContainer x; Dom.appendChild container checkboxContainer; container let default_props = (None, 0, 1) let gensym = let counter = ref 0 in fun () -> incr counter; !counter let deleteQuestion q = let&& x = q##.parentNode in Dom.removeChild x q; return () let rec createQuestion q = let open (val !Belenios_js.I18n.gettext) in let question, answers, props, extra = match q with | Question.Homomorphic q -> let open Question_h_t in (q.q_question, q.q_answers, Some (q.q_blank, q.q_min, q.q_max), None) | Question.NonHomomorphic (q, extra) -> let open Question_nh_t in (q.q_question, q.q_answers, None, extra) in let container = Dom_html.createDiv document in container##.className := Js.string "question"; (* question text and remove/insert buttons *) let x = Dom_html.createDiv document in let t = document##createTextNode (Js.string (s_ "Question: ")) in Dom.appendChild x t; let h_question = Dom_html.createInput document in Dom.appendChild x h_question; h_question##.className := Js.string "question_question"; h_question##.size := 60; h_question##.value := Js.string question; let remove_text = document##createTextNode (Js.string (s_ "Remove")) in let remove_btn = Dom_html.createButton document in let f _ = let&& x = container##.parentNode in Dom.removeChild x container; return () in remove_btn##.onclick := handler f; Dom.appendChild remove_btn remove_text; Dom.appendChild x remove_btn; let insert_text = document##createTextNode (Js.string (s_ "Insert")) in let insert_btn = Dom_html.createButton document in let f _ = let x = createQuestion (default_question ()) in let&& p = container##.parentNode in Dom.insertBefore p x (Js.some container); return () in insert_btn##.onclick := handler f; Dom.appendChild insert_btn insert_text; Dom.appendChild x insert_btn; Dom.appendChild container x; (* properties *) let prop_div_h = let blank, min, max = match props with Some x -> x | None -> default_props in createHomomorphicQuestionPropDiv min max blank in let type_div = Dom_html.createDiv document in type_div##.style##.display := if !hybrid_mode then Js.string "block" else Js.string "none"; Dom.appendChild container type_div; let prop_div_nh = Dom_html.createDiv document in (* extra *) let h_extra = Dom_html.createDiv document in Dom.appendChild prop_div_nh h_extra; let title = Js.string (s_ "Counting method specification") in let fieldset = Dom_html.createFieldset document in fieldset##.className := Js.string "counting_method_specification"; Dom.appendChild h_extra fieldset; let legend = Dom_html.createLegend document in Dom.appendChild fieldset legend; Dom.appendChild legend (document##createTextNode title); let div_extra1 = Dom_html.createDiv document in Dom.appendChild fieldset div_extra1; let prefill_mj = Dom_html.createButton document in Dom.appendChild prefill_mj (document##createTextNode (Js.string (s_ "Prefill with Majority Judgment"))); Dom.appendChild div_extra1 prefill_mj; let prefill_schulze = Dom_html.createButton document in Dom.appendChild prefill_schulze (document##createTextNode (Js.string (s_ "Prefill with Condorcet-Schulze"))); Dom.appendChild div_extra1 prefill_schulze; let prefill_stv = Dom_html.createButton document in Dom.appendChild prefill_stv (document##createTextNode (Js.string (s_ "Prefill with STV"))); Dom.appendChild div_extra1 prefill_stv; let clear_spec = Dom_html.createButton document in Dom.appendChild clear_spec (document##createTextNode (Js.string (s_ "Clear"))); Dom.appendChild div_extra1 clear_spec; let div_extra2 = Dom_html.createDiv document in Dom.appendChild fieldset div_extra2; let i_extra = Dom_html.createInput document in Dom.appendChild div_extra2 i_extra; i_extra##.placeholder := title; i_extra##.className := Js.string "question_extra"; i_extra##.size := 80; (match extra with | None -> () | Some x -> i_extra##.value := Js.string (Yojson.Safe.to_string x)); prefill_mj##.onclick := Dom_html.handler (fun _ -> i_extra##.value := Js.string default_mj_specification; Js._false); prefill_schulze##.onclick := Dom_html.handler (fun _ -> i_extra##.value := Js.string default_schulze_specification; Js._false); prefill_stv##.onclick := Dom_html.handler (fun _ -> i_extra##.value := Js.string default_stv_specification; Js._false); clear_spec##.onclick := Dom_html.handler (fun _ -> i_extra##.value := Js.string ""; Js._false); let div_extra3 = Dom_html.createDiv document in div_extra3##.className := Js.string "nh_explain"; Dom.appendChild fieldset div_extra3; Dom.appendChild div_extra3 (document##createTextNode (Js.string (s_ "Leave blank for other counting methods. Note that for other \ counting methods, the voting interface is quite rough: the voter \ has to enter an integer in front of each answer."))); Dom.appendChild div_extra3 (document##createTextNode (Js.string " ")); let more_info = Dom_html.createA document in Dom.appendChild div_extra3 more_info; more_info##.href := Js.string Belenios_ui.Links.mixnet; Dom.appendChild more_info (document##createTextNode (Js.string (s_ "More information."))); (* selector *) let _type = Js.string "radio" and name = Printf.ksprintf Js.string "type%d" (gensym ()) in let type_classical = Dom_html.createDiv document in Dom.appendChild type_div type_classical; let x = Dom_html.createLabel document in Dom.appendChild type_classical x; let cb_type_classical = Dom_html.createInput ~_type ~name document in Dom.appendChild x cb_type_classical; Dom.appendChild x (document##createTextNode (Js.string (s_ "Classical (selection of answers)"))); let type_alternative = Dom_html.createDiv document in Dom.appendChild type_div type_alternative; let x = Dom_html.createLabel document in Dom.appendChild type_alternative x; let cb_type = Dom_html.createInput ~_type ~name document in cb_type##.className := Js.string "nonhomomorphic_tally"; (match props with | Some _ -> Dom.appendChild container prop_div_h; cb_type_classical##.checked := Js._true | None -> Dom.appendChild container prop_div_nh; cb_type##.checked := Js._true); let f = handler (fun _ -> let&& parent = container##.parentNode in if Js.to_bool cb_type##.checked then Dom.replaceChild parent (createQuestion default_question_nh) container else Dom.replaceChild parent (createQuestion default_question_h) container; return ()) in cb_type##.onchange := f; cb_type_classical##.onchange := f; if not (Js.to_bool (Js.Unsafe.pure_js_expr "allow_nh")) then cb_type##.disabled := Js._true; Dom.appendChild x cb_type; Dom.appendChild x (document##createTextNode (Js.string (s_ "Alternative (voters assign a number to each candidate)"))); (* answers *) let h_answers = Dom_html.createDiv document in h_answers##.className := Js.string "question_answers"; Dom.appendChild container h_answers; Array.iter (fun a -> let x = createAnswer a in Dom.appendChild h_answers x) answers; (* button for adding answer *) let x = Dom_html.createDiv document in let b = Dom_html.createButton document in let t = document##createTextNode (Js.string (s_ "Add an answer")) in let f _ = let x = createAnswer "" in Dom.appendChild h_answers x in b##.onclick := handler f; Dom.appendChild b t; Dom.appendChild x b; Dom.appendChild container x; (* horizontal rule *) let x = Dom_html.createHr document in Dom.appendChild container x; (* return *) container let createRadioItem name checked label = let container = Dom_html.createLabel document in let radio = Dom_html.createInput ~_type:(Js.string "radio") ~name document in radio##.checked := Js.bool checked; Dom.appendChild container radio; Dom.appendChild container (document##createTextNode (Js.string " ")); Dom.appendChild container (document##createTextNode (Js.string label)); (radio, container) let createTemplate template = let open (val !Belenios_js.I18n.gettext) in let container = Dom_html.createDiv document in (* name *) let x = Dom_html.createDiv document in x##.style##.display := Js.string "none"; let t = document##createTextNode (Js.string (s_ "Name of the election: ")) in Dom.appendChild x t; let h_name = Dom_html.createInput document in h_name##.id := Js.string "q_election_name"; h_name##.value := Js.string template.t_name; Dom.appendChild x h_name; Dom.appendChild container x; (* description *) let x = Dom_html.createDiv document in x##.style##.display := Js.string "none"; let y = Dom_html.createDiv document in let t = document##createTextNode (Js.string (s_ "Description:")) in Dom.appendChild y t; Dom.appendChild x y; let y = Dom_html.createDiv document in let h_description = Dom_html.createTextarea document in h_description##.id := Js.string "q_election_description"; h_description##.value := Js.string template.t_description; h_description##.cols := 80; Dom.appendChild y h_description; Dom.appendChild x y; Dom.appendChild container x; (* questions *) let x = Dom_html.createDiv document in let h_questions_div = Dom_html.createDiv document in h_questions_div##.id := Js.string "election_questions"; Dom.appendChild x h_questions_div; Dom.appendChild container x; Array.iter (fun q -> let x = createQuestion q in Dom.appendChild h_questions_div x) template.t_questions; (* button for adding question *) let x = Dom_html.createDiv document in let b = Dom_html.createButton document in let t = document##createTextNode (Js.string (s_ "Add a question")) in let f _ = let x = createQuestion (default_question ()) in Dom.appendChild h_questions_div x in b##.onclick := handler f; Dom.appendChild b t; Dom.appendChild x b; Dom.appendChild container x; (* button for submitting *) let x = Dom_html.createHr document in Dom.appendChild container x; let x = Dom_html.createDiv document in let b = Dom_html.createButton document in let t = document##createTextNode (Js.string (s_ "Save changes")) in let f _ = try let template = extractTemplate () in set_textarea "questions" (string_of_template template); let booth_version = 2 in set_input "booth_version" (string_of_int booth_version); let&& x = document##querySelector (Js.string "form") in let&& x = Dom_html.CoerceTo.form x in let () = x##submit in return () with Failure e -> alert e; return () in b##.onclick := handler f; Dom.appendChild b t; Dom.appendChild x b; Dom.appendChild container x; (* return *) container (* Handling of hybrid checkbox *) let handle_hybrid e _ = hybrid_mode := Js.to_bool e##.checked; let qs = document##querySelectorAll (Js.string ".question") in for i = 0 to qs##.length do ignore (let&& x = qs##item i in deleteQuestion x) done; let&& qsdiv = document##getElementById (Js.string "election_questions") in Dom.appendChild qsdiv (createQuestion (default_question ())); return () (* Entry point *) let fill_interactivity () = let&& e = document##getElementById (Js.string "interactivity") in let t = template_of_string (get_textarea "questions") in let has_nh = Array.exists (function Question.NonHomomorphic _ -> true | _ -> false) t.t_questions in hybrid_mode := has_nh; let div = createTemplate t in Dom.appendChild e div; let&& x = document##querySelector (Js.string "form") in x##.style##.display := Js.string "none"; let&& e = document##getElementById (Js.string "hybrid_mode") in let&& e = Dom_html.CoerceTo.input e in e##.checked := Js.bool !hybrid_mode; e##.onchange := handler (handle_hybrid e); return () let () = Lwt.async (fun () -> let* _ = Js_of_ocaml_lwt.Lwt_js_events.onload () in let* () = Belenios_js.I18n.auto_init "admin" in ignore (fill_interactivity ()); Lwt.return_unit) belenios-2.2-10-gbb6b7ea8/src/web/clients/tool/tool_js_i18n.mli0000644000175000017500000000020414476041226023067 0ustar stephstephval init : string -> string -> string -> unit Lwt.t val auto_init : string -> unit Lwt.t module Gettext : Belenios_ui.I18n.GETTEXT belenios-2.2-10-gbb6b7ea8/src/web/clients/jslib/0002755000175000017500000000000014476041226020210 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/clients/jslib/dune0000644000175000017500000000050514476041226021064 0ustar stephsteph(executable (name belenios_jslib) (modes js) (js_of_ocaml (javascript_files ../../../../ext/sjcl/sjcl.js ../../../../ext/jsbn/BigIntCompatFull.js ../../../../ext/libsodium/libsodium.js)) (libraries js_of_ocaml-lwt belenios-platform-js belenios belenios_js belenios_ui) (preprocess (pps js_of_ocaml-ppx))) belenios-2.2-10-gbb6b7ea8/src/web/clients/jslib/belenios_jslib.mli0000644000175000017500000000002614476041226023672 0ustar stephsteph(* empty interface *) belenios-2.2-10-gbb6b7ea8/src/web/clients/jslib/belenios_jslib.ml0000644000175000017500000001117614476041226023531 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Js_of_ocaml open Js_of_ocaml_lwt open Belenios_core.Common open Belenios_core open Belenios open Signatures open Serializable_j open Belenios_js.Common let computeFingerprint = sha256_b64 let checkCredential = Credential.check let encryptBallot election cred plaintext callback = let module P = (val election : ELECTION) in let module G = P.G in let module CD = Credential.MakeDerive (G) in let sk = CD.derive P.election.e_uuid cred in let b = P.E.create_ballot ~sk plaintext in let ballot = P.string_of_ballot b in let tracker = sha256_b64 ballot in callback ballot tracker class type renderingFunctions = object method text : int -> Js.js_string Js.t -> Js.Unsafe.any Js.meth method br : int -> Js.Unsafe.any Js.meth method bold : int -> Js.Unsafe.any Js.js_array Js.t -> Js.Unsafe.any Js.meth method italic : int -> Js.Unsafe.any Js.js_array Js.t -> Js.Unsafe.any Js.meth method result : Js.Unsafe.any Js.js_array Js.t -> Js.Unsafe.any Js.meth method error : Js.js_string Js.t -> Js.Unsafe.any Js.meth end let belenios = object%js method computeFingerprint x = Js._JSON##stringify x |> Js.to_string |> computeFingerprint |> Js.string method checkCredential cred = if checkCredential (Js.to_string cred) then Js._true else Js._false method encryptBallot params cred plaintext success failure = let success ballot tracker = let () = Js.Unsafe.fun_call success [| Js.Unsafe.inject (Js.string ballot); Js.Unsafe.inject (Js.string tracker); |] in Lwt.return_unit in let failure error = let () = Js.Unsafe.fun_call failure [| Js.Unsafe.inject (Js.string error) |] in Lwt.return_unit in Lwt.async (fun () -> Lwt.catch (fun () -> let* () = Lwt_js.yield () in let module R = struct let raw_election = Js._JSON##stringify params |> Js.to_string end in let module W = Election.Make (R) (Random) () in let* () = Lwt_js.yield () in let plaintext = Js._JSON##stringify plaintext |> Js.to_string |> plaintext_of_string in let* () = Lwt_js.yield () in encryptBallot (module W) (Js.to_string cred) plaintext success) (fun e -> failure (Printexc.to_string e))); Js.undefined method markup (p : renderingFunctions Js.t) x = let open Belenios_ui in let pp = { Markup.text = (fun key x -> p##text key (Js.string x)); br = (fun key -> p##br key); italic = (fun key xs -> p##italic key (Js.array @@ Array.of_list xs)); bold = (fun key xs -> p##bold key (Js.array @@ Array.of_list xs)); } in try let lexbuf = Lexing.from_string (Js.to_string x) in let xs = Markup_parser.full Markup_lexer.token lexbuf in let xs = Markup.render pp xs in p##result (Js.array @@ Array.of_list xs) with _ -> p##error x end let () = Js.export "belenios" belenios belenios-2.2-10-gbb6b7ea8/src/web/common/0002755000175000017500000000000014476041226016734 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/common/languages.ml0000644000175000017500000000414414476041226021235 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let available = [ ("ar", "العربية"); ("cs", "Čeština"); ("de", "Deutsch"); ("el", "Ελληνικά"); ("en", "English"); ("es", "Español"); ("es_419", "Español (Latinoamérica)"); ("fi", "Suomi"); ("fr", "Français"); ("it", "Italiano"); ("jpn_JP", "日本語"); ("lt", "Lietuvių"); ("ms", "Bahasa Melayu"); ("nb", "Norsk (Bokmål)"); ("nl", "Nederlands"); ("oc", "Occitan"); ("pl", "Polski"); ("pt_BR", "Português (Brasil)"); ("ro", "Română"); ("sk", "Slovenčina"); ("uk", "Українська"); ] belenios-2.2-10-gbb6b7ea8/src/web/common/mails_admin.ml0000644000175000017500000003236714476041226021554 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Common module Make (I : I18n.S) = struct let mail_credential_authority l url = let open (val l : I18n.GETTEXT) in let open Mail_formatter in let b = create () in add_sentence b (s_ "Dear credential authority,"); add_newline b; add_newline b; add_sentence b (s_ "You will find below the link to generate the voters' credentials, \ one for each voter."); add_newline b; add_newline b; add_string b " "; add_string b url; add_newline b; add_newline b; add_sentence b (s_ "Here are the instructions:"); add_newline b; add_sentence b (s_ "1. Click on the link."); add_newline b; add_sentence b (s_ "2. Click on \"Generate\"."); add_newline b; add_sentence b (s_ "3. Download the private credentials (creds.txt) and save the file to \ a secure location."); add_newline b; add_sentence b (s_ "You will use it to send credentials to voters."); add_newline b; add_sentence b (s_ "4. Download the list of voters (voters.txt)."); add_newline b; add_sentence b (s_ "This list must be the one approved by the election commission."); add_newline b; add_sentence b (s_ "5. Save the two fingerprints: fingerprint of voters and fingerprint \ of public credentials"); add_newline b; add_sentence b (s_ "Once the election is open, you must check that they match with what \ is published by the server."); add_newline b; add_sentence b (s_ "6. Click on \"Submit the public credentials\"."); add_newline b; add_newline b; add_sentence b (s_ "You will then need to send (typically by email) each private \ credential to the associated voter as written in the file creds.txt."); add_newline b; add_sentence b (s_ "You may use a script of your own or the one provided in the Belenios \ distribution, see instructions here:"); add_newline b; add_string b Links.cred_instructions; add_newline b; add_sentence b (s_ "The page also contains instructions for checking the voting record, \ after the tally."); add_newline b; add_newline b; add_sentence b (s_ "You may need to resend credentials to voters who have lost them."); add_newline b; add_newline b; add_sentence b (s_ "Once the election is finished and validated, you are expected to \ destroy the file creds.txt for stronger privacy guarantees."); add_newline b; add_newline b; add_sentence b (s_ "Thank you for your help,"); add_newline b; add_newline b; add_string b "-- "; add_newline b; add_sentence b (s_ "The election administrator"); let body = contents b in let subject = s_ "Credential authority link" in (subject, body) let mail_trustee_generation_basic_body l link = let open (val l : I18n.GETTEXT) in let open Mail_formatter in let b = create () in add_sentence b (s_ "Dear trustee,"); add_newline b; add_newline b; add_sentence b (s_ "You will find below the link to generate your private decryption \ key, used to tally the election."); add_newline b; add_newline b; add_string b " "; add_string b link; add_newline b; add_newline b; add_sentence b (s_ "Here are the instructions:"); add_newline b; add_string b "1. "; add_sentence b (s_ "Click on the link."); add_newline b; add_string b "2. "; add_sentence b (s_ "Click on \"Generate a new key pair\"."); add_newline b; add_string b "3. "; add_sentence b (s_ "Download your private key. Make sure you SAVE IT properly otherwise \ it will not be possible to tally and the election will be canceled."); add_newline b; add_string b "4. "; add_sentence b (s_ "Save the fingerprint of your verification key. Once the election is \ open, you must check that it is present in the set of verification \ keys published by the server."); add_newline b; add_string b "5. "; add_sentence b (s_ "Click on \"Submit\" to send your verification key."); add_newline b; add_newline b; add_sentence b (s_ "Regarding your private key, it is crucial you save it (otherwise the \ election will be canceled) and store it securely (if your private \ key is known together with the private keys of the other trustees, \ then vote privacy is no longer guaranteed)."); add_sentence b (s_ "We suggest two options:"); add_newline b; add_string b "1. "; add_sentence b (s_ "you may store the key on a USB stick and store it in a safe;"); add_newline b; add_string b "2. "; add_sentence b (s_ "or you may simply print it and store it in a safe."); add_newline b; add_sentence b (s_ "Of course, more cryptographic solutions are welcome as well."); add_newline b; add_newline b; add_sentence b (s_ "Thank you for your help,"); add_newline b; contents b let mail_trustee_generation_basic langs link = let* l = I.get ~component:"admin" ~lang:(List.hd langs) in let open (val l) in let subject = s_ "Link to generate the decryption key" in let* bodies = Lwt_list.map_s (fun lang -> let* l = I.get ~component:"admin" ~lang in return (mail_trustee_generation_basic_body l link)) langs in let body = String.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \n" ^ s_ "The election administrator" in return (subject, body) let mail_trustee_generation_threshold_body l link = let open (val l : I18n.GETTEXT) in let open Mail_formatter in let b = create () in add_sentence b (s_ "Dear trustee,"); add_newline b; add_newline b; add_sentence b (s_ "You will find below the link to generate your private decryption \ key, used to tally the election."); add_newline b; add_newline b; add_string b " "; add_string b link; add_newline b; add_newline b; add_sentence b (s_ "Follow the instructions."); add_sentence b (s_ "There will be 3 steps."); add_sentence b (s_ "All trustees must have completed one step before you can proceed to \ the next one."); add_newline b; add_newline b; add_sentence b (s_ "Don't forget to save:"); add_newline b; add_string b "1. "; add_sentence b (s_ "your private key. Make sure you SAVE IT properly otherwise you will \ not be able to participate to the tally and the election may be \ canceled;"); add_newline b; add_string b "2. "; add_sentence b (s_ "the fingerprint of your public key;"); add_sentence b (s_ "the fingerprint of your verification key."); add_newline b; add_newline b; add_sentence b (s_ "Once the election is open, you must check that the fingerprints of \ your two keys are present in the set of keys published by the \ server."); add_newline b; add_newline b; add_sentence b (s_ "Regarding your private key, it is crucial you save it (otherwise the \ election will be canceled) and store it securely (if your private \ key is known together with the private keys of the other trustees, \ then vote privacy is no longer guaranteed)."); add_sentence b (s_ "We suggest two options:"); add_newline b; add_string b "1. "; add_sentence b (s_ "you may store the key on a USB stick and store it in a safe;"); add_newline b; add_string b "2. "; add_sentence b (s_ "or you may simply print it and store it in a safe."); add_newline b; add_sentence b (s_ "Of course, more cryptographic solutions are welcome as well."); add_newline b; add_newline b; add_sentence b (s_ "Thank you for your help,"); add_newline b; contents b let mail_trustee_generation_threshold langs link = let* l = I.get ~component:"admin" ~lang:(List.hd langs) in let open (val l) in let subject = s_ "Link to generate the decryption key" in let* bodies = Lwt_list.map_s (fun lang -> let* l = I.get ~component:"admin" ~lang in return (mail_trustee_generation_threshold_body l link)) langs in let body = String.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \n" ^ s_ "The election administrator" in return (subject, body) let mail_trustee_tally_body l link = let open (val l : I18n.GETTEXT) in let open Mail_formatter in let b = create () in add_sentence b (s_ "Dear trustee,"); add_newline b; add_newline b; add_sentence b (s_ "The election is now closed."); add_sentence b (s_ "Here is the link to proceed to tally:"); add_newline b; add_newline b; add_string b " "; add_string b link; add_newline b; add_newline b; add_sentence b (s_ "Instructions:"); add_newline b; add_string b "1. "; add_sentence b (s_ "Follow the link."); add_newline b; add_string b "2. "; add_sentence b (s_ "Enter your private decryption key in the first box and click on \ \"Generate your contribution to decryption\"."); add_newline b; add_string b "3. "; add_sentence b (s_ "The second box is now filled with crypto material. Please press the \ button \"Submit\"."); add_newline b; add_newline b; add_sentence b (s_ "Thank you again for your help,"); add_newline b; contents b let mail_trustee_tally langs link = let* l = I.get ~component:"admin" ~lang:(List.hd langs) in let open (val l) in let subject = s_ "Link to tally the election" in let* bodies = Lwt_list.map_s (fun lang -> let* l = I.get ~component:"admin" ~lang in return (mail_trustee_tally_body l link)) langs in let body = String.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \n" ^ s_ "The election administrator" in return (subject, body) let mail_shuffle_body l link = let open (val l : I18n.GETTEXT) in let open Mail_formatter in let b = create () in add_sentence b (s_ "Dear trustee,"); add_newline b; add_newline b; add_sentence b (s_ "Below you will find the link to shuffle encrypted ballots."); add_newline b; add_newline b; add_string b " "; add_string b link; add_newline b; add_newline b; add_sentence b (s_ "Instructions:"); add_newline b; add_string b "1. "; add_sentence b (s_ "Follow the link."); add_newline b; add_string b "2. "; add_sentence b (s_ "Click on \"Compute shuffle\"."); add_newline b; add_string b "3. "; add_sentence b (s_ "The fingerprint of your shuffle will appear. Save it."); add_newline b; add_string b "4. "; add_sentence b (s_ "When the election result is published, make sure that the \ fingerprint of your shuffle appears in the result page."); add_newline b; add_newline b; add_sentence b (s_ "Thank you for your help,"); add_newline b; contents b let mail_shuffle langs link = let* l = I.get ~component:"admin" ~lang:(List.hd langs) in let open (val l) in let subject = s_ "Link to shuffle encrypted ballots" in let* bodies = Lwt_list.map_s (fun lang -> let* l = I.get ~component:"admin" ~lang in return (mail_shuffle_body l link)) langs in let body = String.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \n" ^ s_ "The election administrator" in return (subject, body) end belenios-2.2-10-gbb6b7ea8/src/web/common/markup_lexer.mll0000644000175000017500000000423214476041226022137 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2023-2023 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 Markup_parser } rule text b = parse | ("
" | "" | "" | "" | "") { lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - Lexing.lexeme_end lexbuf + Lexing.lexeme_start lexbuf; TEXT (Buffer.contents b) } | eof { TEXT (Buffer.contents b) } | "&" { Buffer.add_char b '&'; text b lexbuf } | "<" { Buffer.add_char b '<'; text b lexbuf } | ">" { Buffer.add_char b '>'; text b lexbuf } | _ as c { Buffer.add_char b c; text b lexbuf } and token = parse | "
" { BR } | "" { BOPEN } | "" { BCLOSE } | "" { IOPEN } | "" { ICLOSE } | _ as c { let b = Buffer.create 128 in Buffer.add_char b c; text b lexbuf } | eof { EOF } belenios-2.2-10-gbb6b7ea8/src/web/common/markup_types.mli0000644000175000017500000000310714476041226022161 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2023-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type t = Text of string | Br | Bold of t list | Italic of t list belenios-2.2-10-gbb6b7ea8/src/web/common/dune0000644000175000017500000000034514476041226017612 0ustar stephsteph(library (name belenios_ui) (public_name belenios-server.ui) (libraries xml-light lwt tyxml belenios) (modules_without_implementation mails_admin_sig markup_types)) (ocamllex markup_lexer) (menhir (modules markup_parser)) belenios-2.2-10-gbb6b7ea8/src/web/common/i18n.ml0000644000175000017500000000373114476041226020047 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type GETTEXT = sig val lang : string val s_ : string -> string val f_ : ('a, 'b, 'c, 'c, 'c, 'd) format6 -> ('a, 'b, 'c, 'c, 'c, 'd) format6 end module type S = sig val get : component:string -> lang:string -> (module GETTEXT) Lwt.t end let s_xml translate str = match Xml.parse_string (translate str) with | x -> (str, x) | exception _ -> ( match Xml.parse_string str with | x -> (str, x) | exception _ -> (str, PCData str)) belenios-2.2-10-gbb6b7ea8/src/web/common/mail_formatter.ml0000644000175000017500000000471714476041226022302 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let width = 72 type t = { buffer : Buffer.t; mutable current : int; mutable pending : bool } let create () = { buffer = Buffer.create 1000; current = 0; pending = false } let add_newline t = Buffer.add_string t.buffer "\n"; t.current <- 0; t.pending <- false let add_string t s = Buffer.add_string t.buffer s; t.current <- t.current + String.length s; t.pending <- false let add_word t s = let length = String.length s in let pending = if t.pending then 1 else 0 in if t.current + pending + length > width then ( add_newline t; add_string t s; t.pending <- true) else ( if t.pending then add_string t " "; add_string t s; t.pending <- true) let add_sentence t s = let n = String.length s in let rec loop i = if i < n then ( let j = try String.index_from s i ' ' with Not_found -> n in add_word t (String.sub s i (j - i)); loop (j + 1)) in loop 0 let contents t = Buffer.contents t.buffer belenios-2.2-10-gbb6b7ea8/src/web/common/markup_lexer.mli0000644000175000017500000000306714476041226022141 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2023-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) val token : Lexing.lexbuf -> Markup_parser.token belenios-2.2-10-gbb6b7ea8/src/web/common/i18n.mli0000644000175000017500000000350114476041226020213 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type GETTEXT = sig val lang : string val s_ : string -> string val f_ : ('a, 'b, 'c, 'c, 'c, 'd) format6 -> ('a, 'b, 'c, 'c, 'c, 'd) format6 end module type S = sig val get : component:string -> lang:string -> (module GETTEXT) Lwt.t end val s_xml : (string -> string) -> string -> string * Xml.xml belenios-2.2-10-gbb6b7ea8/src/web/common/languages.mli0000644000175000017500000000305514476041226021406 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) val available : (string * string) list belenios-2.2-10-gbb6b7ea8/src/web/common/links.ml0000644000175000017500000000350714476041226020411 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let belenios = "https://www.belenios.org/" let setup = "https://www.belenios.org/setup.html" let translation = "https://www.belenios.org/translation.html" let mixnet = "https://www.belenios.org/mixnet.html" let cred_instructions = "https://www.belenios.org/instructions.html#instructions-for-the-credential-authority" belenios-2.2-10-gbb6b7ea8/src/web/common/mail_formatter.mli0000644000175000017500000000325014476041226022442 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type t val create : unit -> t val add_newline : t -> unit val add_string : t -> string -> unit val add_sentence : t -> string -> unit val contents : t -> string belenios-2.2-10-gbb6b7ea8/src/web/common/pages_common.ml0000644000175000017500000001157614476041226021745 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type BASE = sig module Xml : Xml_sigs.NoWrap module Svg : Svg_sigs.Make(Xml).T module Html : Html_sigs.Make(Xml)(Svg).T module Uris : sig val home : Html.uri val logo : Html.uri val belenios : Html.uri val source_code : Html.uri val privacy_policy : Html.uri end end module Make (Base : BASE) = struct open Base open Base.Html let a_aria_label = Unsafe.string_attrib "aria-label" let a_aria_hidden = Unsafe.string_attrib "aria-hidden" "true" let base_body l ~full_title ~content ~administer ?(login_box = txt "") ?(warning = txt "") ?(lang_box = txt "") ?(footer = txt "") ?(extra_footer = txt "") () = let open (val l : I18n.GETTEXT) in [ div ~a:[ a_id "vote-app" ] [ div ~a:[ a_class [ "page" ] ] [ div ~a:[ a_id "header"; a_class [ "page-header" ] ] [ div ~a:[ a_class [ "page-header__logo" ] ] [ a ~a: [ a_href Uris.home; a_aria_label (s_ "Election server"); ] [ img ~a: [ a_class [ "page-header__logo__image" ]; a_aria_hidden; ] ~alt:(s_ "Election server") ~src:Uris.logo (); ]; ]; div ~a:[ a_class [ "page-header__titles" ] ] [ h1 ~a: [ a_class [ "page-header__titles__election-name" ]; a_id "election_name"; ] [ full_title ]; p ~a: [ a_class [ "page-header__titles__election-description" ]; a_id "election_description"; ] [ txt "" ]; (* no description provided? *) ]; div ~a:[ a_class [ "page-header__right" ] ] [ login_box ]; ]; div ~a:[ a_class [ "page-body" ] ] [ warning; div ~a:[ a_id "main" ] [ lang_box; div content ] ]; div ~a:[ a_class [ "page-footer" ] ] [ footer; txt (s_ "Powered by "); a ~a:[ a_href Uris.belenios ] [ txt "Belenios" ]; Belenios_platform.Version.( Printf.ksprintf txt " %s (%s). " version build); a ~a:[ a_href Uris.source_code ] [ txt (s_ "Get the source code") ]; txt ". "; a ~a:[ a_href Uris.privacy_policy ] [ txt (s_ "Privacy policy") ]; txt ". "; administer; txt "."; extra_footer; ]; ]; ]; ] end belenios-2.2-10-gbb6b7ea8/src/web/common/markup_parser.mly0000644000175000017500000000347714476041226022343 0ustar stephsteph/**************************************************************************/ /* BELENIOS */ /* */ /* Copyright © 2023-2023 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 Markup_types %} %token BR IOPEN ICLOSE BOPEN BCLOSE EOF %token TEXT %start full %% full: | xs = expr_list EOF { xs } expr_list: | xs = list(expr) { xs } expr: | BR { Br } | x = TEXT { Text x } | IOPEN xs = expr_list ICLOSE { Italic xs } | BOPEN xs = expr_list BCLOSE { Bold xs } belenios-2.2-10-gbb6b7ea8/src/web/common/mails_admin_sig.mli0000644000175000017500000000356714476041226022567 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type mail_template = string list -> string -> (string * string) Lwt.t module type S = sig val mail_credential_authority : (module I18n.GETTEXT) -> string -> string * string val mail_trustee_generation_basic : mail_template val mail_trustee_generation_threshold : mail_template val mail_shuffle : mail_template val mail_trustee_tally : mail_template end belenios-2.2-10-gbb6b7ea8/src/web/common/mails_admin.mli0000644000175000017500000000306314476041226021714 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (I : I18n.S) : Mails_admin_sig.S belenios-2.2-10-gbb6b7ea8/src/web/common/markup.ml0000644000175000017500000000356314476041226020572 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2023-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type 'a rendering_functions = { text : int -> string -> 'a; br : int -> 'a; bold : int -> 'a list -> 'a; italic : int -> 'a list -> 'a; } let rec render p xs = List.mapi (render_item p) xs and render_item p i = function | Markup_types.Text s -> p.text i s | Br -> p.br i | Bold xs -> p.bold i (render p xs) | Italic xs -> p.italic i (render p xs) belenios-2.2-10-gbb6b7ea8/src/web/server/0002755000175000017500000000000014476041226016752 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/server/common/0002755000175000017500000000000014476041226020242 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/server/common/web_i18n_sig.mli0000644000175000017500000000315614476041226023226 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type S = sig val get_preferred_gettext : string -> (module Belenios_ui.I18n.GETTEXT) Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth.ml0000644000175000017500000003013714476041226022374 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Eliom_service open Belenios_core.Common open Web_serializable_j open Web_common open Web_auth_sig module Make (Web_state : Web_state_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) = struct open Web_services type post_login_handler = { post_login_handler : 'a. uuid option -> auth_config -> ((string * string) option -> 'a Lwt.t) -> 'a Lwt.t; } let scope = `Session (Eliom_common.create_scope_hierarchy "belenios-auth") let auth_env = Eliom_reference.eref ~scope None let get_cont login_or_logout x = let open Eliom_registration in let redir = match x with | `Election uuid -> `R (Redirection (preapply ~service:election_cast_confirm uuid)) | `Site { path = ContSiteHome; _ } -> `R (Redirection home) | `Site { path = ContSiteAdmin; admin = admin_ui } -> ( match admin_ui with | Classic -> `R (Redirection admin) | Basic -> `R (Redirection (admin_basic ())) | New -> `R (Redirection (admin_new ()))) | `Site { path = ContSiteElection uuid; admin = admin_ui } -> ( match login_or_logout with | `Login -> ( match admin_ui with | Classic -> `R (Redirection (preapply ~service:election_admin uuid)) | Basic -> let base = Eliom_uri.make_string_uri ~service:(admin_basic ()) ~absolute:true () |> rewrite_prefix in `S (Printf.sprintf "%s#elections/%s" base (Uuid.unwrap uuid)) | New -> let base = Eliom_uri.make_string_uri ~service:(admin_new ()) ~absolute:true () |> rewrite_prefix in `S (Printf.sprintf "%s#%s" base (Uuid.unwrap uuid))) | `Logout -> `R (Redirection (preapply ~service:election_home (uuid, ())))) in fun () -> match redir with | `R r -> Redirection.send r | `S s -> String_redirection.send s let restart_login service = function | `Election uuid -> preapply ~service:election_login ((uuid, ()), Some service) | `Site cont -> preapply ~service:site_login (Some service, cont) let run_post_login_handler ~auth_system ~state { post_login_handler } = let* env = Eliom_reference.get auth_env in match env with | None -> Eliom_registration.Action.send () | Some (uuid, a, kind, st) -> let restart_login () = let service = restart_login a.auth_instance kind in Pages_common.login_failed ~service () >>= Eliom_registration.Html.send ~code:401 in if auth_system = a.auth_system && st = state then let cont = function | Some (name, email) -> let@ () = fun cont -> match List.assoc_opt "allowlist" a.auth_config with | None -> cont () | Some f -> let* allowlist = Lwt_io.lines_of_file f |> Lwt_stream.to_list in if List.mem name allowlist then cont () else restart_login () in let* () = Eliom_state.discard ~scope () in let user = { user_domain = a.auth_instance; user_name = name } in let* () = match uuid with | None -> let* account = let* x = Accounts.get_account user in match x with | None -> let* a = Accounts.create_account ~email user in let* () = Web_persist.clear_elections_by_owner_cache () in return a | Some x -> let last_connected = Datetime.now () in let x = { x with last_connected } in let* () = Accounts.update_account x in return x in let* token = Api_generic.new_token account in Eliom_reference.set Web_state.site_user (Some (user, account, token)) | Some uuid -> Eliom_reference.set Web_state.election_user (Some (uuid, user)) in get_cont `Login kind () | None -> restart_login () in post_login_handler uuid a cont else restart_login () let auth_systems = ref ([] : (string * auth_system) list) let get_pre_login_handler uuid username_or_address kind a = let state = generate_token () in let* () = Eliom_reference.set auth_env (Some (uuid, a, kind, state)) in match List.assoc_opt a.auth_system !auth_systems with | Some auth_system -> let module X = (val auth_system uuid a) in X.pre_login_handler username_or_address ~state | None -> fail_http `Not_found let register ~auth_system handler = auth_systems := (auth_system, handler) :: !auth_systems; run_post_login_handler ~auth_system let rec find_auth_instance x = function | [] -> None | ({ auth_instance = i; _ } as y) :: _ when i = x -> Some y | _ :: xs -> find_auth_instance x xs let get_election_auth_configs uuid = let* metadata = Web_persist.get_election_metadata uuid in match metadata.e_auth_config with | None -> return [] | Some x -> x |> List.map (function | { auth_system = "import"; auth_instance = name; _ } -> ( match List.find_opt (function | `Export x -> x.auth_instance = name | _ -> false) !Web_config.exported_auth_config with | Some (`Export x) -> [ x ] | _ -> []) | x -> [ x ]) |> List.flatten |> return let login_handler service kind = let uuid = match kind with `Site _ -> None | `Election uuid -> Some uuid in let myself service = match kind with | `Site cont -> preapply ~service:site_login (service, cont) | `Election uuid -> preapply ~service:election_login ((uuid, ()), service) in let* user = match uuid with | None -> let* x = Eliom_reference.get Web_state.site_user in let&* a, _, _ = x in return_some a | Some uuid -> Web_state.get_election_user uuid in match (user, uuid) with | Some _, None -> get_cont `Login kind () | Some _, Some _ | None, _ -> ( let* c = match uuid with | None -> return !Web_config.site_auth_config | Some uuid -> get_election_auth_configs uuid in match service with | Some s -> ( let* site_or_election, username_or_address = match uuid with | None -> return (`Site, `Username) | Some uuid -> let* username_or_address = Web_persist.get_username_or_address uuid in return (`Election, username_or_address) in let* a = match find_auth_instance s c with | Some x -> return x | None -> fail_http `Not_found in let* x = get_pre_login_handler uuid username_or_address kind a in match x with | Html x -> let* title = Pages_common.login_title site_or_election a.auth_instance in Pages_common.base ~title ~content:[ x ] () >>= Eliom_registration.Html.send | Redirection x -> Eliom_registration.String_redirection.send x) | None -> ( match c with | [ s ] -> Eliom_registration.( Redirection.send (Redirection (myself (Some s.auth_instance)))) | _ -> let builder = match kind with | `Site cont -> fun s -> preapply ~service:Web_services.site_login (Some s, cont) | `Election uuid -> fun s -> preapply ~service:Web_services.election_login ((uuid, ()), Some s) in Pages_common.login_choose (List.map (fun x -> x.auth_instance) c) builder () >>= Eliom_registration.Html.send)) let logout_handler cont = let* () = let* x = Eliom_reference.get Web_state.site_user in match x with | None -> Lwt.return_unit | Some (_, _, token) -> let () = Api_generic.invalidate_token token in Lwt.return_unit in let* () = Web_state.discard () in get_cont `Logout (`Site cont) () let () = Eliom_registration.Any.register ~service:site_login (fun (service, cont) () -> login_handler service (`Site cont)) let () = Eliom_registration.Any.register ~service:logout (fun cont () -> logout_handler cont) let () = Eliom_registration.Any.register ~service:election_login (fun ((uuid, ()), service) () -> login_handler service (`Election uuid)) let get_site_login_handler service = match find_auth_instance service !Web_config.site_auth_config with | None -> return @@ Html (Eliom_content.Html.F.div []) | Some a -> get_pre_login_handler None `Username (`Site (default_admin ContSiteAdmin)) a let direct_voter_auth uuid x = let fail () = failwith "invalid direct auth" in let* c = let* cs = get_election_auth_configs uuid in match cs with | [ c ] -> Lwt.return c | _ -> ( match x with | `Assoc x -> ( match List.assoc_opt "service" x with | Some (`String service) -> ( match find_auth_instance service cs with | Some c -> Lwt.return c | None -> fail ()) | _ -> fail ()) | _ -> fail ()) in match List.assoc_opt c.auth_system !auth_systems with | Some auth_system -> let module X = (val auth_system (Some uuid) c) in let* user_name = X.direct x in Lwt.return { user_name; user_domain = c.auth_instance } | None -> fail () end belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_drafts.mli0000644000175000017500000000747714476041226023076 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_core.Common open Belenios_api.Serializable_t open Web_serializable_t val api_of_draft : draft_election -> draft Lwt.t val draft_of_api : account -> draft_election -> draft -> draft_election val post_drafts : account -> draft -> uuid option Lwt.t val get_draft_voters : draft_election -> voter_list val put_draft_voters : uuid -> draft_election -> voter_list -> unit Lwt.t type generate_credentials_on_server_error = [ `NoVoters | `TooManyVoters | `Already | `NoServer ] val generate_credentials_on_server : (recipient:string -> login:string -> weight:weight -> credential:string -> 'a Lwt.t) -> uuid -> draft_election -> ('a list, generate_credentials_on_server_error) Stdlib.result Lwt.t val exn_of_generate_credentials_on_server_error : generate_credentials_on_server_error -> exn val submit_public_credentials : uuid -> draft_election -> public_credentials -> unit Lwt.t val generate_server_trustee : draft_election -> draft_trustee Lwt.t val get_draft_trustees : is_admin:bool -> draft_election -> Belenios_api.Serializable_t.draft_trustees val post_draft_trustees : uuid -> draft_election -> Yojson.Safe.t trustee -> unit Lwt.t val delete_draft_trustee : uuid -> draft_election -> string -> bool Lwt.t val set_threshold : uuid -> draft_election -> int -> (unit, [ `NoTrustees | `OutOfBounds ]) Stdlib.result Lwt.t val get_draft_trustees_mode : draft_election -> [ `Basic | `Threshold of int ] val put_draft_trustees_mode : uuid -> draft_election -> [ `Basic | `Threshold of int ] -> unit Lwt.t val get_draft_status : uuid -> draft_election -> draft_status Lwt.t val merge_voters : draft_voter list -> Voter.t list -> (Voter.t -> (string * string) option) -> (draft_voter list * weight, Voter.t) Stdlib.result val import_voters : uuid -> draft_election -> uuid -> ( unit, [ `Forbidden | `NotFound | `TotalWeightTooBig of weight | `Duplicate of string ] ) Stdlib.result Lwt.t val import_trustees : uuid -> draft_election -> uuid -> metadata -> ( [> `Basic | `Threshold ], [> `Inconsistent | `Invalid | `MissingPrivateKeys | `None | `Unsupported ] ) Stdlib.result Lwt.t open Api_generic val dispatch : token:string option -> ifmatch:string option -> string list -> [ `GET | `POST | `PUT | `DELETE ] -> body -> result Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_dummy.ml0000644000175000017500000000532314476041226023606 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Lwt module Make (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Web_auth : Web_auth_sig.S) = struct let auth_system uuid _ = let module X = struct let pre_login_handler username_or_address ~state = let site_or_election = match uuid with None -> `Site | Some _ -> `Election in let* page = Pages_common.login_dummy site_or_election username_or_address ~state in return @@ Web_auth_sig.Html page let direct x = let fail () = failwith "invalid direct dummy authentication" in match x with | `Assoc x -> ( match List.assoc_opt "username" x with | Some (`String x) -> Lwt.return x | _ -> fail ()) | _ -> fail () end in (module X : Web_auth_sig.AUTH_SYSTEM) let run_post_login_handler = Web_auth.register ~auth_system:"dummy" auth_system let () = Eliom_registration.Any.register ~service:Web_services.dummy_post (fun () (state, name) -> run_post_login_handler ~state { Web_auth.post_login_handler = (fun _ _ cont -> cont (Some (name, ""))); }) end belenios-2.2-10-gbb6b7ea8/src/web/server/common/mails_voter.ml0000644000175000017500000003223614476041226023124 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Serializable_j open Common open Web_serializable_j open Web_common let contact_footer l contact = let open (val l : Belenios_ui.I18n.GETTEXT) in match contact with | None -> fun _ -> () | Some x -> fun b -> let open Belenios_ui.Mail_formatter in add_newline b; add_newline b; add_sentence b (s_ "To get more information, please contact:"); add_newline b; add_string b " "; add_string b x let mail_password l title login password weight url contact = let open (val l : Belenios_ui.I18n.GETTEXT) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (s_ "Please find below your login and password for the election"); add_newline b; add_newline b; add_string b " "; add_string b title; add_newline b; add_newline b; add_sentence b (s_ "Note that you also need a credential, sent in a separate email, to \ start voting."); add_newline b; add_newline b; add_string b (s_ "Username:"); add_string b " "; add_string b login; add_newline b; add_string b (s_ "Password:"); add_string b " "; add_string b password; add_newline b; add_newline b; (match weight with | Some weight -> add_string b (s_ "Number of votes:"); add_string b " "; add_string b (Weight.to_string weight); add_newline b | None -> ()); add_string b (s_ "Page of the election:"); add_string b " "; add_string b url; add_newline b; add_newline b; add_sentence b (s_ "You are allowed to vote several times."); add_sentence b (s_ "Only the last vote counts."); contact_footer l contact b; contents b let format_password_email (x : password_email) = let url = get_election_home_url x.uuid in let* bodies = Lwt_list.map_s (fun lang -> let* l = Web_i18n.get ~component:"voter" ~lang in return (mail_password l x.title x.login x.password x.weight url x.contact)) x.langs in let body = String.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \nBelenios" in let* subject = let* l = Web_i18n.get ~component:"voter" ~lang:(List.hd x.langs) in let open (val l) in Printf.kprintf return (f_ "Your password for election %s") x.title in Lwt.return (subject, body) open Belenios_platform.Platform let generate_password_email metadata langs title uuid v show_weight = let (_, { address; login; weight }) : Voter.t = v in let weight = if show_weight then weight else None in let salt = generate_token () in let* password = let x = generate_token ~length:15 () in return (format_password x) in let hashed = sha256_hex (salt ^ password) in let x : password_email = { uuid; title; login = Option.value login ~default:address; password; weight; contact = metadata.e_contact; langs; recipient = address; } in return (`Password x, (salt, hashed)) let mail_credential l has_passwords title ~login cred weight url metadata = let open (val l : Belenios_ui.I18n.GETTEXT) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (s_ "You are listed as a voter for the election"); add_newline b; add_newline b; add_string b " "; add_string b title; add_newline b; add_newline b; add_sentence b (s_ "You will find below your credential."); add_sentence b (s_ "You will be asked to enter your credential before entering the voting \ booth."); if has_passwords then add_sentence b (s_ "To cast a vote, you will also need a password, sent in a separate \ email."); add_newline b; add_newline b; add_string b (s_ "Credential:"); add_string b " "; add_string b cred; add_newline b; add_newline b; add_string b (s_ "Username:"); add_string b " "; add_string b login; add_newline b; (match weight with | Some weight -> add_string b (s_ "Number of votes:"); add_string b " "; add_string b (Weight.to_string weight); add_newline b | None -> ()); add_string b (s_ "Page of the election:"); add_string b " "; add_string b url; add_newline b; add_newline b; add_sentence b (s_ "You are allowed to vote several times."); add_sentence b (s_ "Only the last vote counts."); contact_footer l metadata b; contents b let format_credential_email (x : credential_email) = let url = get_election_home_url x.uuid in let* bodies = Lwt_list.map_s (fun lang -> let* l = Web_i18n.get ~component:"voter" ~lang in return (mail_credential l x.has_passwords x.title ~login:x.login x.credential x.weight url x.contact)) x.langs in let body = String.concat "\n\n----------\n\n" bodies in let body = body ^ "\n\n-- \nBelenios" in let* subject = let* l = Web_i18n.get ~component:"voter" ~lang:(List.hd x.langs) in let open (val l) in Printf.ksprintf return (f_ "Your credential for election %s") x.title in return (subject, body) let generate_credential_email uuid se = let title = se.se_questions.t_name in let show_weight = has_explicit_weights se.se_voters in let has_passwords = match se.se_metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> true | _ -> false in let langs = get_languages se.se_metadata.e_languages in fun ~recipient ~login ~weight ~credential -> let oweight = if show_weight then Some weight else None in let x : credential_email = { uuid; title; login; credential; weight = oweight; contact = se.se_metadata.e_contact; langs; has_passwords; recipient; } in Lwt.return @@ `Credential x let send_bulk_email = function | `Password x -> let* subject, body = format_password_email x in send_email (MailPassword x.uuid) ~recipient:x.recipient ~subject ~body | `Credential x -> let* subject, body = format_credential_email x in send_email (MailCredential x.uuid) ~recipient:x.recipient ~subject ~body module Bulk_processor = struct type t = { mutable locked : bool; mutable queue : bulk_emails option; submitters : unit Lwt.u Queue.t; processors : unit Lwt.u Queue.t; } let create () = { locked = false; queue = None; submitters = Queue.create (); processors = Queue.create (); } let lock ~is_submitter m = if m.locked then ( let q = if is_submitter then m.submitters else m.processors in let t, u = Lwt.wait () in Queue.push u q; t) else ( m.locked <- true; Lwt.return_unit) let unlock m = if m.locked then match Queue.take_opt m.submitters with | None -> ( match Queue.take_opt m.processors with | None -> m.locked <- false | Some u -> Lwt.wakeup_later u ()) | Some u -> Lwt.wakeup_later u () let with_lock ~is_submitter m f = let* () = lock ~is_submitter m in Lwt.finalize f (fun () -> unlock m; Lwt.return_unit) end module Ocsipersist_bulk = struct module F = Ocsipersist.Functorial module T = F.Table (struct let name = "belenios_bulk_emails" end) (F.Column.String) (F.Column.String) module type SerializableInput = sig type t val name : string val default : t val of_string : string -> t val to_string : t -> string end module type SerializableOutput = sig type t val get : unit -> t Lwt.t val set : t -> unit Lwt.t end module MakeSerializable (I : SerializableInput) : SerializableOutput with type t := I.t = struct let default = I.to_string I.default let var = T.Variable.make ~name:I.name ~default let get () = let* x = T.Variable.get var in Lwt.return (I.of_string x) let set x = T.Variable.set var (I.to_string x) end module PrimaryQueueInput = struct type t = bulk_emails let name = "primary_queue" let default = [||] let of_string = bulk_emails_of_string let to_string x = string_of_bulk_emails x end module SecondaryQueueInput = struct type t = bulk_emails let name = "secondary_queue" let default = [||] let of_string = bulk_emails_of_string let to_string x = string_of_bulk_emails x end module ProcessedInput = struct type t = bulk_processed let name = "processed" let default = { mode = `Primary; processed = 0 } let of_string = bulk_processed_of_string let to_string x = string_of_bulk_processed x end module PrimaryQueue = MakeSerializable (PrimaryQueueInput) module SecondaryQueue = MakeSerializable (SecondaryQueueInput) module Processed = MakeSerializable (ProcessedInput) let m = Bulk_processor.create () let get_queue () = let* p = Processed.get () in match m.queue with | Some x -> Lwt.return (p, x) | None -> let* x = match p.mode with | `Primary -> PrimaryQueue.get () | `Secondary -> SecondaryQueue.get () in m.queue <- Some x; Lwt.return (p, x) let submit jobs = let jobs = Array.of_list jobs in let@ () = Bulk_processor.with_lock ~is_submitter:true m in let* p, current = get_queue () in let newset, newmode, oldset = match p.mode with | `Primary -> (SecondaryQueue.set, `Secondary, PrimaryQueue.set) | `Secondary -> (PrimaryQueue.set, `Primary, SecondaryQueue.set) in let current = Array.sub current p.processed (Array.length current - p.processed) in let newqueue = Array.append current jobs in let* () = newset newqueue in let* () = Processed.set { mode = newmode; processed = 0 } in m.queue <- Some newqueue; let* () = oldset [||] in Lwt.return_unit let process_one () = let@ () = Bulk_processor.with_lock ~is_submitter:false m in let* p, current = get_queue () in let i = p.processed in if i < Array.length current then let* () = send_bulk_email current.(i) in let* () = Processed.set { p with processed = i + 1 } in Lwt.return_true else Lwt.return_false let rec process () = let* continue = process_one () in if continue then process () else submit [] end let process_bulk_emails = Ocsipersist_bulk.process let submit_bulk_emails jobs = let* () = Ocsipersist_bulk.submit jobs in Lwt.async process_bulk_emails; Lwt.return_unit let mail_confirmation l user title weight hash revote url1 url2 contact = let open (val l : Belenios_ui.I18n.GETTEXT) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (Printf.sprintf (f_ "Dear %s,") user); add_newline b; add_newline b; add_sentence b (s_ "Your vote for election"); add_newline b; add_newline b; add_string b " "; add_string b title; add_newline b; add_newline b; add_sentence b (s_ "has been recorded."); (match weight with | Some weight -> add_sentence b (Printf.sprintf (f_ "Your weight is %s.") (Weight.to_string weight)) | None -> ()); add_sentence b (s_ "Your smart ballot tracker is"); add_newline b; add_newline b; add_string b " "; add_string b hash; add_newline b; if revote then ( add_newline b; add_sentence b (s_ "This vote replaces any previous vote."); add_newline b); add_newline b; add_sentence b (s_ "You can check its presence in the ballot box, accessible at"); add_newline b; add_string b " "; add_string b url1; add_newline b; add_newline b; add_sentence b (s_ "Results will be published on the election page"); add_newline b; add_string b " "; add_string b url2; contact_footer l contact b; add_newline b; add_newline b; add_string b "-- "; add_newline b; add_string b "Belenios"; contents b belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_state.ml0000644000175000017500000000515114476041226022551 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax module Make () = struct let default_scope = Eliom_common.default_session_scope let belenios_scope = `Session (Eliom_common.create_scope_hierarchy "belenios") let show_cookie_disclaimer = Eliom_reference.eref ~scope:default_scope true let site_user = Eliom_reference.eref ~scope:belenios_scope None let election_user = Eliom_reference.eref ~scope:belenios_scope None let get_election_user uuid = let* user = Eliom_reference.get election_user in match user with | Some (u, x) when u = uuid -> return_some x | _ -> return_none let ballot = Eliom_reference.eref ~scope:belenios_scope None let precast_data = Eliom_reference.eref ~scope:belenios_scope None let cast_confirmed = Eliom_reference.eref ~scope:belenios_scope None let language = Eliom_reference.eref ~scope:default_scope None let signup_address = Eliom_reference.eref ~scope:belenios_scope None let signup_env = Eliom_reference.eref ~scope:belenios_scope None let set_email_env = Eliom_reference.eref ~scope:belenios_scope None let discard () = Eliom_state.discard ~scope:belenios_scope () end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_state.mli0000644000175000017500000000304714476041226022724 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make () : Web_state_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_config.ml0000644000175000017500000000434314476041226022700 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let prefix = ref "" let site_auth_config = ref [] let exported_auth_config = ref [] let locales_dir = ref "." let spool_dir = ref "." let accounts_dir = ref "." let server_name = ref "Belenios public server" let server_mail = ref "noreply@example.org" let return_path = ref None let contact_uri = ref None let gdpr_uri = ref "" let warning_file = ref None let footer_file = ref None let admin_home = ref None let success_snippet = ref None let source_file = ref "belenios.tar.gz" let logo = ref None let favicon = ref None let sealing = ref None let maxmailsatonce = ref 1000 let uuid_length = ref None let default_group = ref "" let nh_group = ref "" let domain = ref "" let deny_revote = ref false let deny_newelection = ref false belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_persist.mli0000644000175000017500000001425714476041226023302 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_core open Serializable_t open Common open Web_common open Web_serializable_t val get_spool_version : unit -> int Lwt.t val get_draft_election : uuid -> draft_election option Lwt.t val set_draft_election : uuid -> draft_election -> unit Lwt.t val release_tally : uuid -> unit Lwt.t val get_election_state : uuid -> election_state Lwt.t val get_election_dates : uuid -> election_dates Lwt.t val get_partial_decryptions : uuid -> string owned list Lwt.t val add_partial_decryption : uuid -> int * string -> unit Lwt.t val get_decryption_tokens : uuid -> decryption_tokens option Lwt.t val set_decryption_tokens : uuid -> decryption_tokens -> unit Lwt.t val get_raw_election : uuid -> string option Lwt.t val get_election_metadata : uuid -> metadata Lwt.t val get_election_result : uuid -> string option Lwt.t val get_election_result_hidden : uuid -> datetime option Lwt.t val set_election_result_hidden : uuid -> datetime option -> unit Lwt.t type election_kind = [ `Draft | `Validated | `Tallied | `Archived ] val get_elections_by_owner : int -> (election_kind * uuid * datetime * string) list Lwt.t val clear_elections_by_owner_cache : unit -> unit Lwt.t val get_passwords : uuid -> (string * string) SMap.t option Lwt.t val get_private_key : uuid -> number option Lwt.t val get_private_keys : uuid -> string list option Lwt.t val get_trustees : uuid -> string Lwt.t val get_has_explicit_weights : uuid -> bool Lwt.t val get_username_or_address : uuid -> [ `Username | `Address ] Lwt.t val get_voter : uuid -> string -> Voter.t option Lwt.t val get_all_voters : uuid -> Voter.t list Lwt.t val get_ballot_hashes : uuid -> (string * Weight.t) list Lwt.t val get_ballot_by_hash : uuid -> string -> string option Lwt.t val get_ballot_weight : (module Site_common_sig.ELECTION) -> string -> Weight.t Lwt.t val get_shuffles : uuid -> (hash * hash owned * string) list option Lwt.t val get_sized_encrypted_tally : uuid -> string option Lwt.t val get_latest_encrypted_tally : (module Site_common_sig.ELECTION) -> string option Lwt.t val get_shuffle_token : uuid -> shuffle_token option Lwt.t val gen_shuffle_token : uuid -> string -> int -> string option -> shuffle_token Lwt.t val clear_shuffle_token : uuid -> unit Lwt.t val get_nh_ciphertexts : (module Site_common_sig.ELECTION) -> string Lwt.t val append_to_shuffles : (module Site_common_sig.ELECTION) -> int -> string -> string option Lwt.t val has_voted : uuid -> user -> bool Lwt.t val init_credential_mapping : uuid -> string list -> unit Lwt.t val precast_ballot : (module Site_common_sig.ELECTION) -> rawballot:string -> (string * credential_record, Signatures.cast_error) result Lwt.t val cast_ballot : (module Site_common_sig.ELECTION) -> rawballot:string -> user:string -> weight:Weight.t -> datetime -> precast_data:string * credential_record -> (string * bool, Signatures.cast_error) result Lwt.t val get_audit_cache : uuid -> audit_cache Lwt.t val remove_audit_cache : uuid -> unit Lwt.t val get_archive : uuid -> string option Lwt.t val archive_election : uuid -> unit Lwt.t val delete_election : uuid -> unit Lwt.t val check_password : uuid -> user:string -> password:string -> (string * string) option Lwt.t val regen_password : (module Site_common_sig.ELECTION) -> metadata -> string -> bool Lwt.t val get_private_creds_filename : uuid -> string val get_private_creds_downloaded : uuid -> bool Lwt.t val set_private_creds_downloaded : uuid -> unit Lwt.t val get_election_file : uuid -> election_file -> string val validate_election : uuid -> draft_election -> Belenios_api.Serializable_t.draft_status -> unit Lwt.t val delete_draft : uuid -> unit Lwt.t val create_draft : uuid -> draft_election -> unit Lwt.t val compute_encrypted_tally : (module Site_common_sig.ELECTION) -> bool Lwt.t val finish_shuffling : (module Site_common_sig.ELECTION) -> bool Lwt.t val get_skipped_shufflers : uuid -> string list option Lwt.t val set_skipped_shufflers : uuid -> string list -> unit Lwt.t val get_next_actions : unit -> ([> `Archive | `Delete | `Destroy ] * uuid * datetime) list Lwt.t val open_election : uuid -> bool Lwt.t val close_election : uuid -> bool Lwt.t val get_election_automatic_dates : uuid -> Belenios_api.Serializable_t.election_auto_dates Lwt.t val set_election_automatic_dates : uuid -> Belenios_api.Serializable_t.election_auto_dates -> unit Lwt.t val set_draft_public_credentials : uuid -> public_credentials -> unit Lwt.t val get_draft_public_credentials : uuid -> string option Lwt.t val get_draft_private_credentials : uuid -> string option Lwt.t val set_draft_private_credentials : uuid -> string -> unit Lwt.t val get_records : uuid -> string list option Lwt.t val get_voters_file : uuid -> string option Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_cas.mli0000644000175000017500000000307014476041226023367 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_auth : Web_auth_sig.S) : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_events.mli0000644000175000017500000000365214476041226023112 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Serializable_t open Web_serializable_t val get_data : uuid:uuid -> hash -> string option Lwt.t val get_event : uuid:uuid -> hash -> event option Lwt.t val get_roots : uuid:uuid -> roots Lwt.t type append_operation = Data of string | Event of event_type * hash option exception RaceCondition val append : ?lock:bool -> uuid:uuid -> ?last:last_event -> append_operation list -> unit Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_common.mli0000644000175000017500000000315114476041226023412 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_i18n : Web_i18n_sig.S) (Web_services : Web_services_sig.S) : Pages_common_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_voter.ml0000644000175000017500000003631314476041226022763 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Belenios open Serializable_j open Common open Web_serializable_j open Web_common module Make (X : Pages_sig.S) (Site_common : Site_common_sig.S) (Site_admin : Site_admin_sig.S) = struct open X open Web_services open Site_common open Eliom_service open Eliom_registration let get_preferred_gettext () = Web_i18n.get_preferred_gettext "voter" (* Make sure this module is loaded after Site_admin *) let _ignored = Site_admin.data_policy_loop let () = Redirection.register ~service:election_home_dir (fun uuid () -> return (Redirection (preapply ~service:election_home (uuid, ())))) let () = Any.register ~service:election_home (fun (uuid, ()) () -> let@ election = with_election uuid in let* x = Eliom_reference.get Web_state.cast_confirmed in let* () = Web_state.discard () in match x with | Some result -> Pages_voter.cast_confirmed election ~result () >>= Html.send | None -> let* state = Web_persist.get_election_state uuid in Pages_voter.election_home election state () >>= Html.send) let () = Any.register ~service:election_cast (fun uuid () -> let@ election = with_election uuid in Pages_voter.cast_raw election () >>= Html.send) let submit_ballot ballot = let ballot = Stdlib.String.trim ballot in let* () = Eliom_reference.set Web_state.ballot (Some ballot) in redir_preapply election_submit_ballot_check () () let () = Any.register ~service:election_submit_ballot (fun () ballot -> submit_ballot ballot) let () = Any.register ~service:election_submit_ballot_file (fun () ballot -> let fname = ballot.Ocsigen_extensions.tmp_filename in let* ballot = Lwt_stream.to_string (Lwt_io.chars_of_file fname) in let* () = Lwt_unix.unlink fname in submit_ballot ballot) let () = Any.register ~service:election_submit_ballot_check (fun () () -> let* l = get_preferred_gettext () in let open (val l) in let* ballot = Eliom_reference.get Web_state.ballot in match ballot with | None -> Pages_common.generic_page ~title:(s_ "Cookies are blocked") (s_ "Your browser seems to block cookies. Please enable them.") () >>= Html.send | Some rawballot -> ( match Election.election_uuid_of_string_ballot rawballot with | exception _ -> Pages_common.generic_page ~title:(s_ "Error") (s_ "Ill-formed ballot") () >>= Html.send | uuid -> ( let* election = find_election uuid in match election with | Some e -> let@ precast_data cont = let* x = Web_persist.precast_ballot e ~rawballot in match x with | Ok x -> cont x | Error e -> let msg = Printf.sprintf (f_ "Your ballot is rejected because %s.") (explain_error l (CastError e)) in Pages_common.generic_page ~title:(s_ "Error") msg () >>= Html.send in let* () = Eliom_reference.set Web_state.precast_data (Some precast_data) in redir_preapply election_login ((uuid, ()), None) () | None -> ( let* election = Web_persist.get_draft_election uuid in match election with | Some _ -> redir_preapply election_draft uuid () | None -> let msg = s_ "Unknown election" in Pages_common.generic_page ~title:(s_ "Error") msg () >>= Html.send)))) let send_confirmation_email uuid revote user recipient weight hash = let* election = let* election = find_election uuid in match election with | Some election -> return election | None -> let msg = Printf.sprintf "send_confirmation_email: %s not found" (Uuid.unwrap uuid) in Lwt.fail (Failure msg) in let open (val election) in let title = election.e_name in let* 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 let url2 = Eliom_uri.make_string_uri ~absolute:true ~service:Web_services.election_home x |> rewrite_prefix in let* l = get_preferred_gettext () in let open (val l) in let subject = Printf.sprintf (f_ "Your vote for election %s") title in let body = Mails_voter.mail_confirmation l user title weight hash revote url1 url2 metadata.e_contact in Lwt.catch (fun () -> let* () = send_email (MailConfirmation uuid) ~recipient ~subject ~body in Lwt.return true) (fun _ -> Lwt.return false) let () = Any.register ~service:election_cast_confirm (fun uuid () -> let@ election = with_election uuid in let* ballot = Eliom_reference.get Web_state.ballot in let* precast_data = Eliom_reference.get Web_state.precast_data in match (ballot, precast_data) with | None, _ | _, None -> Pages_voter.lost_ballot election () >>= Html.send | Some rawballot, Some precast_data -> ( let* () = Eliom_reference.unset Web_state.ballot in let* user = Web_state.get_election_user uuid in match user with | None -> forbidden () | Some user -> let* () = Eliom_reference.unset Web_state.election_user in let* result = Lwt.catch (fun () -> let* hash = Api_elections.cast_ballot send_confirmation_email election ~rawballot ~user ~precast_data in return (Ok hash)) (function | BeleniosWebError e -> return (Error e) | e -> Lwt.fail e) in let* () = Eliom_reference.set Web_state.cast_confirmed (Some result) in redir_preapply election_home (uuid, ()) ())) let () = Any.register ~service:election_pretty_ballots (fun (uuid, ()) () -> let@ election = with_election uuid in Pages_voter.pretty_ballots election >>= Html.send) let () = Any.register ~service:election_pretty_ballot (fun ((uuid, ()), hash) () -> let* ballot = Web_persist.get_ballot_by_hash uuid hash in match ballot with | None -> fail_http `Not_found | Some b -> String.send (b, "application/json") >>= fun x -> return @@ cast_unknown_content_kind x) let handle_method uuid question f = let* l = get_preferred_gettext () in let open (val l) in let@ election = with_election uuid in let open (val election) in let questions = election.e_questions in if 0 <= question && question < Array.length questions then match questions.(question) with | Question.NonHomomorphic (q, extra) -> f l q extra (fun continuation -> let* result = Web_persist.get_election_result uuid in match result with | Some result -> ( let result = election_result_of_string read_result result in match Election_result.nth result.result question with | `NonHomomorphic ballots -> continuation ballots | _ -> failwith "handle_method") | None -> Pages_common.generic_page ~title:(s_ "Error") (s_ "The result of this election is not available.") () >>= Html.send ~code:404) | Question.Homomorphic _ -> Pages_common.generic_page ~title:(s_ "Error") (s_ "This question is homomorphic, this method cannot be applied to \ its result.") () >>= Html.send ~code:403 else Pages_common.generic_page ~title:(s_ "Error") (s_ "Invalid index for question.") () >>= Html.send ~code:404 let () = Any.register ~service:method_schulze (fun (uuid, question) () -> handle_method uuid question (fun _ q extra continuation -> continuation (fun ballots -> let nchoices = Array.length q.Question_nh_t.q_answers in let blank_allowed = match Question.get_counting_method extra with | `Schulze o -> o.schulze_extra_blank | _ -> false in let schulze = Schulze.compute ~nchoices ~blank_allowed ballots in Pages_voter.schulze q schulze >>= Html.send))) let () = Any.register ~service:method_mj (fun (uuid, (question, ngrades)) () -> handle_method uuid question (fun l q extra continuation -> let open (val l : Belenios_ui.I18n.GETTEXT) in match ngrades with | None -> Pages_voter.majority_judgment_select uuid question >>= Html.send | Some ngrades -> if ngrades > 0 then let blank_allowed = match Question.get_counting_method extra with | `MajorityJudgment o -> o.mj_extra_blank | _ -> false in continuation (fun ballots -> let nchoices = Array.length q.Question_nh_t.q_answers in let mj = Majority_judgment.compute ~nchoices ~ngrades ~blank_allowed ballots in Pages_voter.majority_judgment q mj >>= Html.send) else Pages_common.generic_page ~title:(s_ "Error") (s_ "The number of grades is invalid.") () >>= Html.send ~code:400)) let () = Any.register ~service:method_stv (fun (uuid, (question, nseats)) () -> handle_method uuid question (fun l q _ continuation -> let open (val l : Belenios_ui.I18n.GETTEXT) in match nseats with | None -> Pages_voter.stv_select uuid question >>= Html.send | Some nseats -> if nseats > 0 then continuation (fun ballots -> let stv = Stv.compute ~nseats ballots in Pages_voter.stv q stv >>= Html.send) else Pages_common.generic_page ~title:(s_ "Error") (s_ "The number of seats is invalid.") () >>= Html.send ~code:400)) let content_type_of_file = function | ESRaw -> "application/json; charset=utf-8" | ESETally | ESResult -> "application/json" | ESArchive _ -> "application/x-belenios" | ESRecords | ESVoters -> "text/plain" let handle_pseudo_file ~preload uuid f site_user = let* confidential = match f with | ESRaw | ESETally | ESArchive _ -> return false | ESRecords | ESVoters -> return true | ESResult -> ( let* hidden = Web_persist.get_election_result_hidden uuid in match hidden with None -> return false | Some _ -> return true) in let* allowed = if confidential then let* metadata = Web_persist.get_election_metadata uuid in match site_user with | Some (_, a, _) when Accounts.check a metadata.e_owners -> return_true | _ -> return_false else return_true in if allowed then let content_type = content_type_of_file f in match f with | ESRaw -> ( let* x = Web_persist.get_raw_election uuid in match x with | Some x -> let () = if preload then Lwt.async (fun () -> let* _ = Web_persist.get_username_or_address uuid in Lwt.return_unit) in let* x = String.send (x, content_type) in return @@ cast_unknown_content_kind x | None -> fail_http `Not_found) | ESETally -> ( let@ election = with_election uuid in let* x = Web_persist.get_latest_encrypted_tally election in match x with | Some x -> let* x = String.send (x, content_type) in return @@ cast_unknown_content_kind x | None -> fail_http `Not_found) | ESResult -> ( let* x = Web_persist.get_election_result uuid in match x with | Some x -> let* x = String.send (x, content_type) in return @@ cast_unknown_content_kind x | None -> fail_http `Not_found) | f -> let filename = Web_persist.get_election_file uuid f in File.send ~content_type filename else forbidden () let () = Any.register ~service:election_dir (fun (uuid, f) () -> let preload = let ri = Eliom_request_info.get_ri () in match Ocsigen_request.header ri Ocsigen_header.Name.referer with | None -> false | Some referer -> Stdlib.String.ends_with ~suffix:"/vote.html" referer in let* site_user = Eliom_reference.get Web_state.site_user in handle_pseudo_file ~preload uuid f site_user) end belenios-2.2-10-gbb6b7ea8/src/web/server/common/dune0000644000175000017500000000121114476041226021111 0ustar stephsteph(library (name belenios_server) (public_name belenios-server) (libraries belenios-platform-native belenios belenios_api belenios_ui lwt calendar csv eliom.server gettext-camomile netstring) (modules_without_implementation web_i18n_sig web_services_sig web_state_sig pages_common_sig pages_admin_sig pages_voter_sig pages_sig site_common_sig site_admin_sig web_auth_sig)) (rule (targets web_serializable_t.ml web_serializable_t.mli) (deps web_serializable.atd) (action (run atdgen -t %{deps}))) (rule (targets web_serializable_j.ml web_serializable_j.mli) (deps web_serializable.atd) (action (run atdgen -j -j-std %{deps}))) belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_serializable.atd0000644000175000017500000001766214476041226024251 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** {1 Predefined types} *) type number = string wrap type weight = abstract wrap type uuid = string wrap type hash = string wrap type datetime = string wrap type proof = abstract type template = abstract type election_checksums = abstract type cert = abstract type polynomial = abstract type vinput = abstract (** {1 Web-specific types} *) type user = { domain : string; name : string; } type auth_config = { auth_system : string; auth_instance : string; auth_config : (string * string) list; } type metadata = { owners: int list; ?auth_config: auth_config list option; ?cred_authority : string option; ?trustees : string list option; ?languages : string list option; ?contact : string option; ?booth_version : int option; } type election_dates = { ?creation : datetime option; ?finalization : datetime option; ?tally : datetime option; ?archive : datetime option; ?last_mail : datetime option; ?auto_open : datetime option; ?auto_close : datetime option; } type extended_record = { username : string; date : datetime; credential : string; } type credential_mapping = { credential : string; ?ballot : string option; } type election_state = [ Open | Closed | Shuffling | EncryptedTally | Tallied | Archived ] type decryption_tokens = string list (* The following is a supertype of trustee_public_key *) type 'a web_trustee_public_key = { pok : proof; public_key : 'a; ?server : bool option; } type audit_cache = { voters_hash : hash; checksums : election_checksums; ?threshold : int option; } (** {1 Types related to elections being prepared} *) type voter = abstract type draft_voter = { id : voter; ?password : (string * string) option; } type draft_trustee = { id : string; token : string; public_key : string; ?private_key : number option; ?name : string option; } type draft_threshold_trustee = { id : string; token : string; ?step : int option; ?cert : cert option; ?polynomial : polynomial option; ?vinput : vinput option; ?voutput : string option; ?name : string option; } type draft_basic_params = { trustees : draft_trustee list; } type draft_threshold_params = { ?threshold : int option; trustees : draft_threshold_trustee list; ?parameters : string option; ?error : string option; } type draft_trustees = [ Basic of draft_basic_params | Threshold of draft_threshold_params ] type draft_election = { version : int; owners : int list; group : string; voters : draft_voter list; questions : template; trustees : draft_trustees; metadata : metadata; public_creds : string; public_creds_received : bool; ?creation_date : datetime option; ?administrator : string option; ~credential_authority_visited : bool; ~voter_authentication_visited : bool; ~trustees_setup_step : int; } (** {1 Types related to elections being tallied} *) type skipped_shufflers = string list type shuffle_token = { trustee : string; token : string; trustee_id : int; ?name : string option; } (** {1 Types related to deleted elections} *) type authentication_method = [ CAS of string | Password | Unknown ] type credential_method = [ Automatic | Manual ] type deleted_trustee = [ Single | Pedersen of (int * int) ] type deleted_election = { uuid : uuid; template : template; owners : int list; nb_voters : int; nb_ballots : int; date : datetime; tallied : bool; authentication_method : authentication_method; credential_method : credential_method; trustees : deleted_trustee list; has_weights : bool; } (** {1 OpenID Connect-related types} *) type oidc_configuration = { authorization_endpoint : string; token_endpoint : string; userinfo_endpoint : string; } type oidc_tokens = { access_token : string; token_type : string; id_token : string; } type oidc_userinfo = { sub : string; ?email : string option; } (** {1 Administrator accounts} *) type account = { id : int; name : string; email : string; last_connected : datetime; authentications : user list; ?consent : datetime option; ?capabilities : int option; ?language : string option; ~default_voter_languages : string list; ~default_contact : string; } (** {1 Bulk emails} *) type password_email = { recipient : string; uuid : uuid; title : string; login : string; password : string; ?weight : weight option; ?contact : string option; langs : string list; } type credential_email = { recipient : string; uuid : uuid; title : string; login : string; credential : string; ?weight : weight option; ?contact : string option; langs : string list; has_passwords : bool; } type bulk_email = [ Password of password_email | Credential of credential_email ] type bulk_emails = bulk_email list type bulk_mode = [ Primary | Secondary ] type bulk_processed = { mode : bulk_mode; processed : int; } belenios-2.2-10-gbb6b7ea8/src/web/server/common/filesystem.ml0000644000175000017500000000607414476041226022765 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core.Common open Web_common let file_exists x = Lwt.catch (fun () -> let* () = Lwt_unix.(access x [ R_OK ]) in Lwt.return_true) (fun _ -> Lwt.return_false) let get_fname uuid x = match uuid with None -> x | Some uuid -> uuid /// x let read_file ?uuid x = Lwt.catch (fun () -> let* lines = Lwt_io.lines_of_file (get_fname uuid x) |> Lwt_stream.to_list in Lwt.return_some lines) (fun _ -> Lwt.return_none) let read_whole_file ?uuid x = Lwt.catch (fun () -> let* x = Lwt_io.chars_of_file (get_fname uuid x) |> Lwt_stream.to_string in Lwt.return_some x) (fun _ -> Lwt.return_none) let read_file_single_line ?uuid filename = let* x = read_file ?uuid filename in match x with Some [ x ] -> Lwt.return_some x | _ -> Lwt.return_none let write_file ?uuid x lines = let fname = get_fname uuid x in let fname_new = fname ^ ".new" in let* () = let open Lwt_io in let@ oc = with_file ~mode:Output fname_new in Lwt_list.iter_s (write_line oc) lines in Lwt_unix.rename fname_new fname let write_whole_file ?uuid x data = let fname = get_fname uuid x in let fname_new = fname ^ ".new" in let* () = let open Lwt_io in let@ oc = with_file ~mode:Output fname_new in write oc data in Lwt_unix.rename fname_new fname let cleanup_file f = Lwt.catch (fun () -> Lwt_unix.unlink f) (fun _ -> Lwt.return_unit) let rmdir dir = let command = ("rm", [| "rm"; "-rf"; dir |]) in let* _ = Lwt_process.exec command in Lwt.return_unit belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_email.mli0000644000175000017500000000325614476041226023716 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_state : Web_state_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Web_auth : Web_auth_sig.S) : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_oidc.ml0000644000175000017500000001472414476041226023376 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Eliom_service open Web_serializable_j open Web_common module Make (Web_auth : Web_auth_sig.S) = struct let scope = `Session (Eliom_common.create_scope_hierarchy "belenios-auth-oidc") let oidc_config = Eliom_reference.eref ~scope None let login_oidc = Eliom_service.create ~path:(Eliom_service.Path [ "auth"; "oidc" ]) ~meth:(Eliom_service.Get Eliom_parameter.any) () let oidc_self = lazy (Eliom_uri.make_string_uri ~absolute:true ~service:(preapply ~service:login_oidc []) () |> rewrite_prefix) let oidc_get_userinfo ocfg info = try let info = oidc_tokens_of_string info in let access_token = info.oidc_access_token in let url = ocfg.userinfo_endpoint in let headers = Cohttp.Header.init_with "Authorization" ("Bearer " ^ access_token) in let* _, body = Cohttp_lwt_unix.Client.get ~headers (Uri.of_string url) in let* info = Cohttp_lwt.Body.to_string body in try let x = oidc_userinfo_of_string info in return_some (match x.oidc_email with | Some x -> (x, x) | None -> (x.oidc_sub, "")) with _ -> return_none with _ -> return_none let oidc_get_name ocfg client_id client_secret code = let params = [ ("code", [ code ]); ("client_id", [ client_id ]); ("client_secret", [ client_secret ]); ("redirect_uri", [ Lazy.force oidc_self ]); ("grant_type", [ "authorization_code" ]); ] in let* _, body = Cohttp_lwt_unix.Client.post_form ~params (Uri.of_string ocfg.token_endpoint) in let* info = Cohttp_lwt.Body.to_string body in oidc_get_userinfo ocfg info let get_oidc_configuration server = let url = server ^ "/.well-known/openid-configuration" in let* _, body = Cohttp_lwt_unix.Client.get (Uri.of_string url) in let* info = Cohttp_lwt.Body.to_string body in try return (oidc_configuration_of_string info) with _ -> fail_http `Not_found let split_prefix_path url = let n = String.length url in let i = String.rindex url '/' in (String.sub url 0 i, [ String.sub url (i + 1) (n - i - 1) ]) let auth_system _ a = let get x = List.assoc_opt x a.auth_config in let module X = struct let pre_login_handler _ ~state = match (get "server", get "client_id") with | Some server, Some client_id -> let* ocfg = get_oidc_configuration server in let* () = Eliom_reference.set oidc_config (Some ocfg) in let prefix, path = split_prefix_path ocfg.authorization_endpoint in let auth_endpoint = Eliom_service.extern ~prefix ~path ~meth: (Eliom_service.Get Eliom_parameter.( string "redirect_uri" ** string "response_type" ** string "client_id" ** string "scope" ** string "state" ** string "prompt")) () in let service = preapply ~service:auth_endpoint ( Lazy.force oidc_self, ("code", (client_id, ("openid email", (state, "consent")))) ) in let url = Eliom_uri.make_string_uri ~service ~absolute:true () |> rewrite_prefix in return @@ Web_auth_sig.Redirection url | _ -> failwith "oidc_login_handler invoked with bad config" let direct _ = failwith "direct authentication not implemented for OpenID Connect" end in (module X : Web_auth_sig.AUTH_SYSTEM) let run_post_login_handler = Web_auth.register ~auth_system:"oidc" auth_system let oidc_handler params () = let code = List.assoc_opt "code" params in let state = List.assoc_opt "state" params in match (code, state) with | Some code, Some state -> run_post_login_handler ~state { Web_auth.post_login_handler = (fun _ a cont -> let get x = List.assoc_opt x a.auth_config in match (get "client_id", get "client_secret") with | Some client_id, Some client_secret -> let* ocfg = let* config = Eliom_reference.get oidc_config in match config with | None -> failwith "oidc handler was invoked without discovered \ configuration" | Some x -> return x in let* () = Eliom_state.discard ~scope () in let* name = oidc_get_name ocfg client_id client_secret code in cont name | _, _ -> fail_http `Service_unavailable); } | _, _ -> fail_http `Unauthorized let () = Eliom_registration.Any.register ~service:login_oidc oidc_handler end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_signup.ml0000644000175000017500000001023714476041226022737 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core open Common open Web_common module Sender = struct type payload = Web_state_sig.signup_env type context = { kind : Web_state_sig.signup_kind; gettext : (module Belenios_ui.I18n.GETTEXT); } let send ~context ~address ~code = match context.kind with | CreateAccount -> let subject, body = Pages_admin.mail_confirmation_link context.gettext address code in send_email MailAccountCreation ~recipient:address ~subject ~body | ChangePassword _ -> let subject, body = Pages_admin.mail_changepw_link context.gettext address code in send_email MailPasswordChange ~recipient:address ~subject ~body end module Otp = Otp.Make (Sender) () let send_confirmation_code gettext ~service address = let kind = Web_state_sig.CreateAccount in let payload = Web_state_sig.{ kind; service } in let context = Sender.{ kind; gettext } in Otp.generate ~payload ~context ~address let send_changepw_code gettext ~service ~address ~username = let kind = Web_state_sig.ChangePassword { username } in let payload = Web_state_sig.{ kind; service } in let context = Sender.{ kind; gettext } in Otp.generate ~payload ~context ~address let confirm_code = Otp.check let cracklib = let x = "cracklib-check" in (x, [| x |]) let extract_comment x = let n = String.length x in match String.rindex_opt x ':' with | Some i when i < n - 2 -> let x = String.sub x (i + 2) (n - i - 3) in if x = "OK" then None else Some x | _ -> Some "unknown error" let cracklib_check password = match String.index_opt password '\n' with | None -> let* x = Lwt_process.pmap ~env:[| "LANG=C" |] cracklib password in Lwt.return (extract_comment x) | Some _ -> Lwt.return_some "newline in password" let is_lower = function 'a' .. 'z' -> true | _ -> false let is_upper = function 'A' .. 'Z' -> true | _ -> false let is_digit = function '0' .. '9' -> true | _ -> false let is_special c = let i = int_of_char c in (32 < i && i < 48) || (57 < i && i < 65) || (90 < i && i < 97) || (122 < i && i < 127) let complexity_check password = if String.length password < 12 then Some "less than 12 characters" else if not (String.exists is_lower password) then Some "no lowercase letter" else if not (String.exists is_upper password) then Some "no uppercase letter" else if not (String.exists is_digit password) then Some "no digit" else if not (String.exists is_special password) then Some "no special character" else None let check_password password = match complexity_check password with | Some x -> Lwt.return_some x | None -> cracklib_check password belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_services.mli0000644000175000017500000000305214476041226023423 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make () : Web_services_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_password.mli0000644000175000017500000000404314476041226024464 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_serializable_t open Web_common module Make (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Web_auth : Web_auth_sig.S) : sig end (** Password-protected admin account management *) val add_account : user -> password:string -> email:string -> (unit, add_account_error) result Lwt.t val change_password : user -> password:string -> (unit, add_account_error) result Lwt.t val lookup_account : service:string -> username:string -> email:string -> (string * string) option Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_admin.mli0000644000175000017500000000320114476041226023053 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (X : Pages_sig.S) (Site_common : Site_common_sig.S) (Web_auth : Web_auth_sig.S) : Site_admin_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_sig.mli0000644000175000017500000000341614476041226022710 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type S = sig module Web_state : Web_state_sig.S module Web_i18n : Web_i18n_sig.S module Web_services : Web_services_sig.S module Pages_common : Pages_common_sig.S module Pages_admin : Pages_admin_sig.S module Pages_voter : Pages_voter_sig.S end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth.mli0000644000175000017500000000322514476041226022543 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_state : Web_state_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) : Web_auth_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/spool.mli0000644000175000017500000000435114476041226022102 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_core.Serializable_t open Web_serializable_t type 'a t val get : uuid:uuid -> 'a t -> 'a option Lwt.t val set : uuid:uuid -> 'a t -> 'a -> unit Lwt.t val del : uuid:uuid -> 'a t -> unit Lwt.t (* draft elections *) val draft : draft_election t val draft_public_credentials : string t val draft_private_credentials : string t (* sensitive data *) val state : election_state t val private_key : number t val private_keys : string list t val decryption_tokens : decryption_tokens t (* other data *) val last_event : last_event t val dates : election_dates t val metadata : metadata t val audit_cache : audit_cache t val hide_result : datetime t val shuffle_token : shuffle_token t val skipped_shufflers : skipped_shufflers t belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_common.mli0000644000175000017500000000307014476041226023257 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (X : Pages_sig.S) : Site_common_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_voter.mli0000644000175000017500000000317414476041226023133 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (X : Pages_sig.S) (Site_common : Site_common_sig.S) (Site_admin : Site_admin_sig.S) : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_main.ml0000644000175000017500000002440514476041226022360 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core.Common open Web_serializable_j open Web_common module Make () = struct (** Parse configuration from *) let prefix = ref None let locales_dir = ref None let spool_dir = ref None let accounts_dir = ref None let source_file = ref None let auth_instances = ref [] let auth_instances_export = ref [] let gdpr_uri = ref None let default_group_file = ref None let nh_group_file = ref None let domain = ref None let () = Eliom_config.get_config () |> let open Xml in List.iter @@ function | PCData x -> Ocsigen_extensions.Configuration.ignore_blank_pcdata ~in_tag:"belenios" x | Element ("prefix", [ ("value", x) ], []) -> prefix := Some x | Element ("maxrequestbodysizeinmemory", [ ("value", m) ], []) -> Ocsigen_config.set_maxrequestbodysizeinmemory (int_of_string m) | Element ("log", [ ("file", file) ], []) -> Lwt_main.run (open_security_log file) | Element ("source", [ ("file", file) ], []) -> source_file := Some file | Element ("logo", [ ("file", file); ("mime-type", mime_type) ], []) -> Web_config.logo := Some (file, mime_type) | Element ("favicon", [ ("file", file); ("mime-type", mime_type) ], []) -> Web_config.favicon := Some (file, mime_type) | Element ("sealing", [ ("file", file); ("mime-type", mime_type) ], []) -> Web_config.sealing := Some (file, mime_type) | Element ("default-group", [ ("file", file) ], []) -> default_group_file := Some (`File file) | Element ("nh-group", [ ("file", file) ], []) -> nh_group_file := Some (`File file) | Element ("default-group", [ ("group", group) ], []) -> default_group_file := Some (`Group group) | Element ("nh-group", [ ("group", group) ], []) -> nh_group_file := Some (`Group group) | Element ("maxmailsatonce", [ ("value", limit) ], []) -> Web_config.maxmailsatonce := int_of_string limit | Element ("uuid", [ ("length", length) ], []) -> let length = int_of_string length in if length >= Uuid.min_length then Web_config.uuid_length := Some length else failwith "UUID length is too small" | Element ("contact", [ ("uri", uri) ], []) -> Web_config.contact_uri := Some uri | Element ("gdpr", [ ("uri", uri) ], []) -> gdpr_uri := Some uri | Element ("server", attrs, []) -> let set check_email attr setter = match List.assoc_opt attr attrs with | Some mail -> if (not check_email) || is_email mail then setter mail else Printf.ksprintf failwith "%s is not a valid e-mail address" mail | None -> () in set true "mail" (fun x -> Web_config.server_mail := x); set true "return-path" (fun x -> Web_config.return_path := Some x); set false "name" (fun x -> Web_config.server_name := x) | Element ("locales", [ ("dir", dir) ], []) -> locales_dir := Some dir | Element ("spool", [ ("dir", dir) ], []) -> spool_dir := Some dir | Element ("accounts", [ ("dir", dir) ], []) -> accounts_dir := Some dir | Element ("warning", [ ("file", file) ], []) -> Web_config.warning_file := Some file | Element ("footer", [ ("file", file) ], []) -> Web_config.footer_file := Some file | Element ("admin-home", [ ("file", file) ], []) -> Web_config.admin_home := Some file | Element ("success-snippet", [ ("file", file) ], []) -> Web_config.success_snippet := Some file | Element ("rewrite-prefix", [ ("src", src); ("dst", dst) ], []) -> set_rewrite_prefix ~src ~dst | Element ( "auth", [ ("name", auth_instance) ], [ Element (auth_system, auth_config, []) ] ) -> let i = { auth_system; auth_instance; auth_config } in auth_instances := i :: !auth_instances | Element ("auth-export", [ ("name", "builtin-password") ], []) -> auth_instances_export := `BuiltinPassword :: !auth_instances_export | Element ("auth-export", [ ("name", "builtin-cas") ], []) -> auth_instances_export := `BuiltinCAS :: !auth_instances_export | Element ( "auth-export", [ ("name", auth_instance) ], [ Element (auth_system, auth_config, []) ] ) -> let i = { auth_system; auth_instance; auth_config } in auth_instances_export := `Export i :: !auth_instances_export | Element ("domain", [ ("name", name) ], []) -> domain := Some name | Element ("deny-revote", [], []) -> Web_config.deny_revote := true | Element ("deny-newelection", [], []) -> Web_config.deny_newelection := true | Element (tag, _, _) -> Printf.ksprintf failwith "invalid configuration for tag %s in belenios" tag let () = match !prefix with | None -> failwith "missing in configuration" | Some x -> Web_config.prefix := x let () = match !gdpr_uri with | None -> failwith "You must provide a GDPR URI" | Some x -> Web_config.gdpr_uri := x (** Parse configuration from other sources *) let source_file = Lwt_main.run (match !source_file with | Some f -> let* b = Filesystem.file_exists f in if b then return f else Printf.ksprintf failwith "file %s does not exist" f | None -> failwith "missing in configuration") let locales_dir = match !locales_dir with | Some d -> d | None -> failwith "missing in configuration" let spool_dir = match !spool_dir with | Some d -> d | None -> failwith "missing in configuration" let accounts_dir = match !accounts_dir with | Some d -> d | None -> failwith "missing in configuration" let default_group = Lwt_main.run (match !default_group_file with | None -> failwith "missing in configuration" | Some (`Group x) -> return x | Some (`File x) -> ( let* x = Lwt_io.lines_of_file x |> Lwt_stream.to_list in match x with | [ x ] -> return x | _ -> failwith "invalid default group file")) let nh_group = Lwt_main.run (match !nh_group_file with | None -> failwith "missing in configuration" | Some (`Group x) -> return x | Some (`File x) -> ( let* x = Lwt_io.lines_of_file x |> Lwt_stream.to_list in match x with | [ x ] -> return x | _ -> failwith "invalid NH group file")) let domain = match !domain with | Some d -> d | None -> failwith "missing in configuration" (** Build up the site *) let () = Web_config.source_file := source_file let () = Web_config.locales_dir := locales_dir let () = Web_config.spool_dir := spool_dir let () = Web_config.accounts_dir := accounts_dir let () = Web_config.default_group := default_group let () = Web_config.nh_group := nh_group let () = Web_config.site_auth_config := List.rev !auth_instances let () = Web_config.exported_auth_config := List.rev !auth_instances_export let () = Web_config.domain := domain module X : Pages_sig.S = struct module Mails_admin = Belenios_ui.Mails_admin.Make (Web_i18n) module Web_state = Web_state.Make () module Web_services = Web_services.Make () module Web_i18n = Web_i18n.Make (Web_state) module Pages_common = Pages_common.Make (Web_i18n) (Web_services) module Pages_admin = Pages_admin.Make (Web_state) (Web_i18n) (Web_services) (Pages_common) (Mails_admin) module Pages_voter = Pages_voter.Make (Web_state) (Web_i18n) (Web_services) (Pages_common) end module Api = Api_eliom.Make () module Web_captcha = Web_captcha.Make (X.Web_services) module Web_auth = Web_auth.Make (X.Web_state) (X.Web_services) (X.Pages_common) module Web_auth_dummy = Web_auth_dummy.Make (X.Web_services) (X.Pages_common) (Web_auth) module Web_auth_password = Web_auth_password.Make (X.Web_services) (X.Pages_common) (Web_auth) module Web_auth_email = Web_auth_email.Make (X.Web_state) (X.Web_services) (X.Pages_common) (Web_auth) module Web_auth_cas = Web_auth_cas.Make (Web_auth) module Web_auth_oidc = Web_auth_oidc.Make (Web_auth) module Site_common = Site_common.Make (X) module Site_admin = Site_admin.Make (X) (Site_common) (Web_auth) module Site_voter = Site_voter.Make (X) (Site_common) (Site_admin) let check_spool_version () = let* x = Web_persist.get_spool_version () in match x with | 1 -> Lwt.return_unit | _ -> Lwt.fail (Failure "unknown spool version") let () = Api_elections.direct_voter_auth := Web_auth.direct_voter_auth let () = Lwt_main.run @@ check_spool_version () let () = Lwt.async Site_admin.data_policy_loop let () = Lwt.async Mails_voter.process_bulk_emails end let main () = let module M = Make () in () belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_i18n.mli0000644000175000017500000000313414476041226022360 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 *) (* . *) (**************************************************************************) include Belenios_ui.I18n.S module Make (Web_state : Web_state_sig.S) : Web_i18n_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_signup.mli0000644000175000017500000000360714476041226023113 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) val send_confirmation_code : (module Belenios_ui.I18n.GETTEXT) -> service:string -> string -> unit Lwt.t val send_changepw_code : (module Belenios_ui.I18n.GETTEXT) -> service:string -> address:string -> username:string -> unit Lwt.t val confirm_code : address:string -> code:string -> Web_state_sig.signup_env option val check_password : string -> string option Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_services.ml0000644000175000017500000004402414476041226023256 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Eliom_service open Eliom_parameter open Web_common module Make () = struct let uuid_and_token = uuid "uuid" ** string "token" let home = create ~path:(Path [ "" ]) ~meth:(Get unit) () let admin = create ~path:(Path [ "admin" ]) ~meth:(Get unit) () let admin_basic () = Eliom_service.preapply ~service:(Eliom_service.static_dir ()) [ "static"; "admin_basic.html" ] let admin_new () = Eliom_service.preapply ~service:(Eliom_service.static_dir ()) [ "static"; "admin.html" ] let privacy_notice_accept = create ~path:No_path ~csrf_safe:true ~meth:(Post (unit, privacy_cont "cont")) () let site_login = create ~path:(Path [ "login" ]) ~meth:(Get (opt (string "service") ** site_cont "cont")) () let logout = create ~path:(Path [ "logout" ]) ~meth:(Get (site_cont "cont")) () let source_code = create ~path:(Path [ "belenios.tar.gz" ]) ~meth:(Get unit) () let logo = create ~path:(Path [ "LOGO" ]) ~meth:(Get unit) () let favicon = create ~path:(Path [ "favicon.ico" ]) ~meth:(Get unit) () let sealing = create ~path:(Path [ "SEALING" ]) ~meth:(Get unit) () let election_draft_new = create_attached_post ~csrf_safe:true ~fallback:admin ~post_params: (radio string "credmgmt" ** radio string "auth" ** opt (string "cas_server")) () let election_draft_pre = create ~path:(Path [ "draft"; "new" ]) ~meth:(Get unit) () let election_draft = create ~path:(Path [ "draft"; "election" ]) ~meth:(Get (uuid "uuid")) () let election_draft_questions = create ~path:(Path [ "draft"; "questions" ]) ~meth:(Get (uuid "uuid")) () let election_draft_questions_post = create_attached_post ~csrf_safe:true ~fallback:election_draft_questions ~post_params:(string "questions" ** int "booth_version") () let election_draft_preview = create ~path:(Path [ "draft"; "preview" ]) ~meth:(Get (suffix (uuid "uuid" ** suffix_const "election.json"))) () let election_draft_description = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:(string "name" ** string "description") () let election_draft_languages = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:(string "languages") () let election_draft_contact = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:(string "contact") () let election_draft_admin_name = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:(string "name") () let election_draft_voters = create ~path:(Path [ "draft"; "voters" ]) ~meth:(Get (uuid "uuid")) () let election_draft_voters_add = create_attached_post ~csrf_safe:true ~fallback:election_draft_voters ~post_params:(string "voters") () let election_draft_voters_remove = create_attached_post ~csrf_safe:true ~fallback:election_draft_voters ~post_params:(string "voter") () let election_draft_voters_remove_all = create_attached_post ~csrf_safe:true ~fallback:election_draft_voters ~post_params:unit () let election_draft_voters_passwd = create_attached_post ~csrf_safe:true ~fallback:election_draft_voters ~post_params:(string "voter") () let election_draft_trustee_add = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:(string "id" ** string "name") () let election_draft_trustee_del = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:(string "address") () let election_draft_credential_authority = create ~path:(Path [ "draft"; "credential-authority" ]) ~meth:(Get (uuid "uuid")) () let election_draft_set_credential_authority = create_attached_post ~csrf_safe:true ~fallback:election_draft_credential_authority ~post_params:(string "name") () let election_draft_credentials = create ~path:(Path [ "draft"; "credentials" ]) ~meth:(Get (suffix uuid_and_token)) () let election_draft_credentials_static = create ~path:(Path [ "draft"; "credentials.html" ]) ~meth:(Get unit) () let election_draft_credentials_post = create ~csrf_safe:true ~path:(Path [ "draft"; "submit-credentials" ]) ~meth:(Post (uuid_and_token, string "public_creds")) () let election_draft_credentials_post_file = create ~csrf_safe:true ~path:(Path [ "draft"; "submit-credentials-file" ]) ~meth:(Post (uuid_and_token, file "public_creds")) () let election_draft_credentials_server = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:unit () let election_draft_credentials_get = create ~path:(Path [ "draft"; "get-credentials" ]) ~meth:(Get (uuid "uuid")) () let election_draft_trustees = create ~path:(Path [ "draft"; "trustees" ]) ~meth:(Get (uuid "uuid")) () let election_draft_trustee = create ~path:(Path [ "draft"; "trustee" ]) ~meth:(Get (suffix uuid_and_token)) () let election_draft_trustee_static = create ~path:(Path [ "draft"; "trustee.html" ]) ~meth:(Get unit) () let election_draft_trustee_post = create ~csrf_safe:true ~path:(Path [ "draft"; "submit-trustee" ]) ~meth:(Post (uuid_and_token, string "public_key")) () let election_draft_threshold_trustees = create ~path:(Path [ "draft"; "threshold-trustees" ]) ~meth:(Get (uuid "uuid")) () let election_draft_threshold_trustee = create ~path:(Path [ "draft"; "threshold-trustee" ]) ~meth:(Get (suffix uuid_and_token)) () let election_draft_threshold_trustee_static = create ~path:(Path [ "draft"; "threshold-trustee.html" ]) ~meth:(Get unit) () let election_draft_threshold_trustee_post = create ~csrf_safe:true ~path:(Path [ "draft"; "submit-threshold-trustee" ]) ~meth:(Post (uuid_and_token, string "data")) () let election_draft_threshold_set = create_attached_post ~csrf_safe:true ~fallback:election_draft_threshold_trustees ~post_params:(int "threshold") () let election_draft_threshold_trustee_add = create_attached_post ~csrf_safe:true ~fallback:election_draft_threshold_trustees ~post_params:(string "id" ** string "name") () let election_draft_threshold_trustee_del = create_attached_post ~csrf_safe:true ~fallback:election_draft_threshold_trustees ~post_params:(string "address") () let election_draft_confirm = create ~path:(Path [ "draft"; "confirm" ]) ~meth:(Get (uuid "uuid")) () let election_draft_create = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:unit () let election_draft_destroy = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:unit () let election_draft_auth_genpwd = create_attached_post ~csrf_safe:true ~fallback:election_draft ~post_params:unit () let election_draft_import = create ~path:(Path [ "draft"; "import" ]) ~meth:(Get (uuid "uuid")) () let election_draft_import_post = create_attached_post ~csrf_safe:true ~fallback:election_draft_import ~post_params:(string "from") () let election_draft_import_trustees = create ~path:(Path [ "draft"; "import-trustees" ]) ~meth:(Get (uuid "uuid")) () let election_draft_import_trustees_post = create_attached_post ~csrf_safe:true ~fallback:election_draft_import_trustees ~post_params:(string "from") () let election_home_dir = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid"))) () let election_home = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid" ** suffix_const ""))) () let set_cookie_disclaimer = create ~path:No_path ~meth:(Get (site_cont "cont")) () let election_admin = create ~path:(Path [ "election"; "admin" ]) ~meth:(Get (uuid "uuid")) () let election_regenpwd = create ~path:(Path [ "election"; "regenpwd" ]) ~meth:(Get (uuid "uuid")) () let election_regenpwd_post = create_attached_post ~csrf_safe:true ~fallback:election_regenpwd ~post_params:(string "user") () let election_login = create ~path:(Path [ "elections" ]) ~meth: (Get (suffix_prod (uuid "uuid" ** suffix_const "login") (opt (string "service")))) () let election_open = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_close = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_hide_result = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:(string "date") () let election_show_result = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_auto_post = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:(string "open" ** string "close") () let election_delete = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let booth_v2 () = Eliom_service.preapply ~service:(Eliom_service.static_dir ()) [ "static"; "frontend"; "booth"; "vote.html" ] type booth = | Booth : (unit -> ( unit, unit, get, att, non_co, non_ext, 'reg, [ `WithoutSuffix ], unit, unit, non_ocaml ) Eliom_service.t) -> booth let booths = [| (Booth booth_v2, "Version 2") |] let election_cast = create ~path:(Path [ "election"; "cast" ]) ~meth:(Get (uuid "uuid")) () let election_submit_ballot = create ~path:(Path [ "election"; "submit-ballot" ]) ~meth:(Post (unit, string "encrypted_vote")) () let election_submit_ballot_file = create ~path:(Path [ "election"; "submit-ballot-file" ]) ~meth:(Post (unit, file "encrypted_vote")) () let election_submit_ballot_check = create ~path:(Path [ "election"; "submit-ballot-check" ]) ~meth:(Get unit) () let election_cast_confirm = create ~path:(Path [ "election"; "confirm" ]) ~meth:(Get (uuid "uuid")) () let election_pretty_ballots = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid" ** suffix_const "ballots"))) () let election_pretty_ballot = create ~path:(Path [ "elections" ]) ~meth: (Get (suffix_prod (uuid "uuid" ** suffix_const "ballot") (string "hash"))) () let election_pretty_records = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid" ** suffix_const "pretty-records"))) () let election_project_result = create ~path:(Path [ "elections" ]) ~meth: (Get (suffix_prod (uuid "uuid" ** suffix_const "project-result") (int "index"))) () let election_missing_voters = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid" ** suffix_const "missing"))) () let election_download_archive = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid" ** suffix_const "archive.zip"))) () let election_compute_encrypted_tally = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_nh_ciphertexts = create ~path:(Path [ "election"; "nh-ciphertexts" ]) ~meth:(Get (uuid "uuid")) () let election_shuffle_link = create ~path:(Path [ "election"; "shuffle" ]) ~meth:(Get (suffix uuid_and_token)) () let election_shuffle_link_static = create ~path:(Path [ "election"; "shuffle.html" ]) ~meth:(Get unit) () let election_shuffle_post = create ~path:(Path [ "election"; "submit-shuffle" ]) ~meth:(Post (uuid_and_token, string "shuffle")) () let election_shuffler_select = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, uuid "uuid" ** string "trustee")) () let election_shuffler_skip_confirm = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, uuid "uuid" ** string "trustee")) () let election_shuffler_skip = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, uuid "uuid" ** string "trustee")) () let election_decrypt = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_tally_trustees = create ~path:(Path [ "election"; "trustees" ]) ~meth:(Get (suffix uuid_and_token)) () let election_tally_trustees_static = create ~path:(Path [ "election"; "trustees.html" ]) ~meth:(Get unit) () let election_tally_trustees_post = create ~csrf_safe:true ~path:(Path [ "election"; "submit-partial-decryption" ]) ~meth:(Post (uuid_and_token, string "partial_decryption")) () let election_tally_release = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_dir = create ~path:(Path [ "elections" ]) ~meth:(Get (suffix (uuid "uuid" ** election_file "file"))) () let dummy_post = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, string "state" ** string "username")) () let email_post = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, string "state" ** string "username")) () let email_election_login = create ~path:No_path ~meth:(Get unit) () let email_captcha_post = create ~csrf_safe:true ~path:No_path ~meth: (Post ( unit, string "state" ** string "challenge" ** string "response" ** string "username" )) () let email_login_post = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, string "code")) () let password_post = create ~csrf_safe:true ~path:No_path ~meth: (Post (unit, string "state" ** string "username" ** string "password")) () let set_language = create ~csrf_safe:true ~path:No_path ~meth:(Get (string "lang" ** site_cont "cont")) () let signup_captcha = create ~path:(Path [ "signup"; "" ]) ~meth:(Get (string "service")) () let signup_captcha_post = create_attached_post ~csrf_safe:true ~fallback:signup_captcha ~post_params:(string "challenge" ** string "response" ** string "email") () let signup_captcha_img = create ~path:(Path [ "signup"; "captcha" ]) ~meth:(Get (string "challenge")) () let signup_login_post = create ~csrf_safe:true ~path:No_path ~meth:(Post (unit, string "code")) () let signup = create ~path:(Path [ "signup"; "account" ]) ~meth:(Get unit) () let signup_post = create_attached_post ~csrf_safe:true ~fallback:signup ~post_params:(string "username" ** string "password" ** string "password2") () let changepw_captcha = create ~path:(Path [ "signup"; "changepw" ]) ~meth:(Get (string "service")) () let changepw_captcha_post = create_attached_post ~csrf_safe:true ~fallback:changepw_captcha ~post_params: (string "challenge" ** string "response" ** string "email" ** string "username") () let changepw_post = create_attached_post ~csrf_safe:true ~fallback:signup ~post_params:(string "password" ** string "password2") () let method_schulze = create ~path:(Path [ "methods"; "schulze" ]) ~meth:(Get (uuid "uuid" ** int "question")) () let method_mj = create ~path:(Path [ "methods"; "mj" ]) ~meth:(Get (uuid "uuid" ** int "question" ** opt (int "ngrades"))) () let method_stv = create ~path:(Path [ "methods"; "stv" ]) ~meth:(Get (uuid "uuid" ** int "question" ** opt (int "nseats"))) () let compute_fingerprint = create ~path:(Path [ "tools"; "compute-fingerprint" ]) ~meth:(Get unit) () let set_email_post = create_attached_post ~csrf_safe:true ~fallback:admin ~post_params:(string "email") () let set_email_confirm = create_attached_post ~csrf_safe:true ~fallback:admin ~post_params:(string "code") () let sudo = create ~path:(Path [ "sudo" ]) ~meth:(Get unit) () let sudo_post = create_attached_post ~csrf_safe:true ~fallback:sudo ~post_params:(string "domain" ** string "name") () let account = create ~path:(Path [ "account" ]) ~meth:(Get unit) () let account_post = create_attached_post ~csrf_safe:true ~fallback:account ~post_params:(string "name") () let api_token = create ~path:(Path [ "api-token" ]) ~meth:(Get unit) () end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_i18n.ml0000644000175000017500000001070414476041226022210 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core.Common let default_lang = "en" let devel_lang = "en_devel" let components = Hashtbl.create 2 module type LANG = sig val lang : string val mo_file : string end module Belenios_Gettext (L : LANG) (T : GettextTranslate.TRANSLATE_TYPE) : Belenios_ui.I18n.GETTEXT = struct let lang = L.lang open GettextCategory open GettextTypes let t = { failsafe = Ignore; textdomains = MapTextdomain.empty; categories = MapCategory.empty; language = Some L.lang; codeset = "UTF-8"; path = []; default = "belenios"; } let u = T.create t L.mo_file (fun x -> x) let s_ str = T.translate u false str None let f_ str = Scanf.format_from_string (T.translate u true (string_of_format str) None) str end let build_gettext_input component lang = (module struct let lang = lang let mo_file = !Web_config.locales_dir // component // (lang ^ ".mo") end : LANG) let default_gettext component = let module L = (val build_gettext_input component devel_lang) in let module G = Belenios_Gettext (L) (GettextTranslate.Dummy) in (module G : Belenios_ui.I18n.GETTEXT) let () = List.iter (fun component -> let h = Hashtbl.create 10 in Hashtbl.add h devel_lang (default_gettext component); Hashtbl.add components component h) [ "voter"; "admin" ] let lang_mutex = Lwt_mutex.create () let get ~component ~lang = let langs = Hashtbl.find components component in match Hashtbl.find_opt langs lang with | Some l -> Lwt.return l | None -> Lwt_mutex.with_lock lang_mutex (fun () -> match Hashtbl.find_opt langs lang with | Some l -> Lwt.return l | None -> let module L = (val build_gettext_input component lang) in let* b = Lwt_unix.file_exists L.mo_file in if b then ( let get () = let module L = Belenios_Gettext (L) (GettextTranslate.Map) in (module L : Belenios_ui.I18n.GETTEXT) in let* l = Lwt_preemptive.detach get () in Hashtbl.add langs lang l; Lwt.return l) else Lwt.return (Hashtbl.find langs devel_lang)) let parse_lang = let rex = Pcre.regexp "^([a-z]{2})(?:-.*)?$" in fun s -> match Pcre.exec ~rex s with | groups -> Some (Pcre.get_substring groups 1) | exception Not_found -> None let get_preferred_language () = let langs = Eliom_request_info.get_accept_language () in match langs with | [] -> default_lang | (lang, _) :: _ -> ( match parse_lang lang with None -> default_lang | Some lang -> lang) module Make (Web_state : Web_state_sig.S) = struct let get_preferred_gettext component = let* lang = let* x = Eliom_reference.get Web_state.language in match x with | None -> Lwt.return (get_preferred_language ()) | Some lang -> Lwt.return lang in get ~component ~lang end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_types.mli0000644000175000017500000000371214476041226022747 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Datetime : sig type t val now : unit -> t val wrap : string -> t val unwrap : t -> string val compare : t -> t -> int val format : ?fmt:string -> t -> string val to_unixfloat : t -> float val from_unixfloat : float -> t end module Period : sig type t val day : int -> t val second : int -> t val add : Datetime.t -> t -> Datetime.t val sub : Datetime.t -> Datetime.t -> t val ymds : t -> int * int * int * int end belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_common.ml0000644000175000017500000004362214476041226023250 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_platform open Belenios_core open Common open Web_common open Eliom_content.Html.F open Eliom_content.Html.F.Form module Make (Web_i18n : Web_i18n_sig.S) (Web_services : Web_services_sig.S) = struct open Web_services let direct_a ?target uri text = let attributes = match target with Some x -> [ a_target x ] | None -> [] in Eliom_content.Html.F.Raw.a ~a:(a_href (Xml.uri_of_string uri) :: attributes) [ txt text ] let raw_a ~service ?(a = []) contents x = let href = Xml.uri_of_string (Eliom_uri.make_string_uri ~service x) in Eliom_content.Html.F.Raw.a ~a:(a_href href :: a) contents let absolute_uri_of_service ~service x = Eliom_uri.make_string_uri ~absolute:true ~service x |> rewrite_prefix |> Eliom_content.Xml.uri_of_string let static x = let service = Eliom_service.static_dir_with_params ~get_params:(Eliom_parameter.string "version") () in Eliom_uri.make_string_uri ~absolute:true ~service ([ "static"; x ], Version.build) |> rewrite_prefix |> Eliom_content.Xml.uri_of_string let get_preferred_gettext () = Web_i18n.get_preferred_gettext "voter" let read_snippet ?(default = txt "") ~lang file = match file with | None -> return default | Some f -> ( let* f = let f' = f ^ "." ^ lang in let* b = Lwt_unix.file_exists f' in return (if b then f' else f) in let* file = Filesystem.read_file f in match file with | None -> return default | Some x -> return @@ Unsafe.data (String.concat "\n" x)) module UiBase = struct module Xml = Eliom_content.Xml module Svg = Eliom_content.Svg.F.Raw module Html = Eliom_content.Html.F.Raw module Uris = struct let home = absolute_uri_of_service ~service:home () let logo = absolute_uri_of_service ~service:logo () let belenios = Eliom_content.Xml.uri_of_string Belenios_ui.Links.belenios let source_code = absolute_uri_of_service ~service:source_code () let privacy_policy = Xml.uri_of_string !Web_config.gdpr_uri end end module Ui = Belenios_ui.Pages_common.Make (UiBase) let base ~title ?full_title ?(login_box = txt "") ?lang_box ~content ?(footer = txt "") ?uuid ?static:(static_page = false) () = let* l = get_preferred_gettext () in let open (val l) in let administer = match uuid with | None -> raw_a ~service:admin [ txt (s_ "Administer elections") ] () | Some uuid -> raw_a ~service:election_admin ~a:[ a_id ("election_admin_" ^ Uuid.unwrap uuid) ] [ txt (s_ "Administer this election") ] uuid in let lang_box = match lang_box with | None -> txt "" | Some x -> div [ x; div ~a:[ a_style "clear: both;" ] [] ] in let maybe_static x = if static_page then Lwt.return @@ txt "" else read_snippet ~lang x in let* warning = maybe_static !Web_config.warning_file in let* extra_footer = maybe_static !Web_config.footer_file in let full_title = match full_title with None -> markup title | Some x -> markup x in Lwt.return (html ~a:[ a_dir `Ltr; a_xml_lang lang ] (head (Eliom_content.Html.F.title (txt title)) [ meta ~a: [ a_name "viewport"; a_content "width=device-width, initial-scale=1"; ] (); script (txt "window.onbeforeunload = function () {};"); link ~rel:[ `Stylesheet ] ~href:(static "site.bundle.css") (); ]) (body (Ui.base_body l ~full_title ~login_box ~warning ~lang_box ~content ~footer ~administer ~extra_footer ()))) let lang_box cont = let cont = default_admin cont in let* l = get_preferred_gettext () in let open (val l) in let langs = List.map (fun (l, x) -> Option ([], l, Some (txt x), l = lang)) Belenios_ui.Languages.available in let form = get_form ~a:[ a_id "lang_form" ] ~service:set_language (fun (nlang, ncont) -> [ input ~input_type:`Hidden ~name:ncont ~value:cont (user string_of_site_cont); txt (s_ "Language:"); txt " "; select ~a:[ a_id "lang_select" ] ~name:nlang string (List.hd langs) (List.tl langs); input ~a:[ a_id "lang_submit" ] ~input_type:`Submit ~value:(s_ "Set") string; ]) in return @@ div ~a:[ a_class [ "lang_box" ] ] [ form; div ~a: [ a_style "font-size: 80%; font-style: italic; text-align: right;"; ] [ txt "("; direct_a Belenios_ui.Links.translation (s_ "Wish to help with translations?"); txt ")"; ]; ] let make_a_with_hash ~service ?hash ?style contents = let uri = Eliom_uri.make_string_uri ~service () in let uri = match hash with None -> uri | Some x -> uri ^ "#" ^ x in let href = [ a_href (Xml.uri_of_string uri) ] in let style = match style with None -> [] | Some x -> [ a_style x ] in Eliom_content.Html.F.Raw.a ~a:(href @ style) [ txt contents ] let a_mailto ?(dest = "") ~subject ~body contents = let uri = Printf.sprintf "mailto:%s?subject=%s&body=%s" dest (Netencoding.Url.encode ~plus:false subject) (Netencoding.Url.encode ~plus:false body) in (* target="_blank" does not work in Firefox, see https://bugzilla.mozilla.org/show_bug.cgi?id=646552 *) direct_a ~target:"_blank" uri contents let generic_page ~title ?service message () = let* l = get_preferred_gettext () in let open (val l) in let proceed = match service with | None -> txt "" | Some service -> div [ a ~service ~a:[ a_id "generic_proceed_link" ] [ txt (s_ "Proceed") ] (); ] in let content = [ p [ txt message ]; proceed ] in base ~title ~content () let raw_textarea ?rows ?cols id contents = let id = [ a_id id ] in let rows = match rows with None -> [] | Some i -> [ a_rows i ] in let cols = match cols with None -> [] | Some i -> [ a_cols i ] in Eliom_content.Html.F.Raw.textarea ~a:(id @ rows @ cols) (txt contents) let login_title site_or_election service = let* l = get_preferred_gettext () in let open (val l) in let format = match site_or_election with | `Site -> f_ "Log in with %s" | `Election -> f_ "Authenticate with %s" in Printf.ksprintf return format service let login_choose auth_systems service () = let* l = get_preferred_gettext () in let open (val l) in let auth_systems = auth_systems |> List.map (fun name -> a ~service:(service name) [ txt name ] ()) |> List.join (txt ", ") in let content = [ div [ p ([ txt (s_ "Please log in:"); txt " [" ] @ auth_systems @ [ txt "]" ]); ]; ] in base ~title:(s_ "Log in") ~content () let login_generic site_or_election username_or_address ~service ~state = let* l = get_preferred_gettext () in let open (val l) in let field_name = match username_or_address with | `Username -> s_ "Username:" | `Address -> s_ "E-mail address:" in let form = post_form ~service (fun (nstate, name) -> [ input ~input_type:`Hidden ~name:nstate ~value:state string; tablex [ tbody [ tr [ th [ label ~a:[ a_label_for "username" ] [ txt field_name ]; ]; td [ input ~a:[ a_id "username" ] ~input_type:`Text ~name string; ]; ]; ]; ]; div [ (let value = match site_or_election with | `Site -> s_ "Log in" | `Election -> s_ "Authenticate" in input ~input_type:`Submit ~value string); ]; ]) () in return @@ div [ form ] let login_dummy = login_generic ~service:dummy_post let login_email = login_generic ~service:email_post let login_password site_or_election username_or_address ~service ~allowsignups ~state = let* l = get_preferred_gettext () in let open (val l) in let signup = if allowsignups then div [ br (); txt (s_ "You can also "); a ~service:signup_captcha [ txt (s_ "create an account") ] service; txt (s_ ", or "); a ~service:changepw_captcha [ txt (s_ "change your password") ] service; txt (s_ " (if you forgot it, for example)."); ] else txt "" in let username_label = match username_or_address with | `Username -> s_ "Username:" | `Address -> s_ "E-mail address:" in let form = post_form ~service:password_post (fun (lstate, (llogin, lpassword)) -> [ input ~input_type:`Hidden ~name:lstate ~value:state string; tablex ~a:[ a_class [ "authentication-table" ] ] [ tbody [ tr [ th [ label ~a:[ a_label_for "username" ] [ txt username_label ]; ]; td [ input ~a: [ a_id "username"; a_class [ "nice-text-input" ]; ] ~input_type:`Text ~name:llogin string; ]; ]; tr [ th [ label ~a:[ a_label_for "password" ] [ txt (s_ "Password:") ]; ]; td [ input ~a: [ a_id "password"; a_class [ "nice-password-input" ]; ] ~input_type:`Password ~name:lpassword string; ]; ]; ]; ]; div ~a:[ a_style "text-align: center;" ] [ (let value = match site_or_election with | `Site -> s_ "Log in" | `Election -> s_ "Authenticate" in input ~a:[ a_class [ "nice-button nice-button--blue" ] ] ~input_type:`Submit ~value string); ]; ]) () in return @@ div [ form; signup ] let login_failed ~service () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Authentication failed" in let content = [ div [ txt (s_ "Authentication failed, probably because of a bad username or \ password, or you are not allowed to perform this operation."); ]; div [ txt (s_ "You can "); a ~service [ txt (s_ "try to log in again") ] (); txt "."; ]; ] in base ~title ~content () let email_login ?address site_or_election = let* l = get_preferred_gettext () in let open (val l) in let address = match address with | None -> txt "" | Some address -> div [ txt @@ Printf.sprintf (f_ "A verification code has been sent to %s.") address; ] in let form = post_form ~service:email_login_post (fun lcode -> [ address; div [ txt (s_ "Please enter the verification code received by e-mail:"); txt " "; input ~input_type:`Text ~name:lcode string; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) () in let content = [ form ] in let title = match site_or_election with | `Site -> s_ "Log in" | `Election -> s_ "Authenticate" in base ~title ~content () let email_email ~address ~code = let* l = get_preferred_gettext () in let open (val l) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (Printf.sprintf (f_ "Dear %s,") address); add_newline b; add_newline b; add_sentence b (s_ "Your e-mail address has been used to authenticate with our Belenios \ server."); add_sentence b (s_ "Use the following code:"); add_newline b; add_newline b; add_string b " "; add_string b code; add_newline b; add_newline b; add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent \ to this address are no longer valid."); add_newline b; add_newline b; add_sentence b (s_ "Best regards,"); add_newline b; add_newline b; add_string b "-- "; add_newline b; add_string b (s_ "Belenios Server"); let body = contents b in let subject = s_ "Belenios authentication" in Lwt.return (subject, body) let signup_captcha_img challenge = let src = make_uri ~service:signup_captcha_img challenge in img ~src ~alt:"CAPTCHA" () let format_captcha_error l e = let open (val l : Belenios_ui.I18n.GETTEXT) in match e with | None -> txt "" | Some x -> let msg = match x with | BadCaptcha -> s_ "Bad security code!" | BadAddress -> s_ "Bad e-mail address!" in div ~a:[ a_style "color: red;" ] [ txt msg ] let login_email_captcha ~state error challenge email = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:email_captcha_post (fun (lstate, (lchallenge, (lresponse, lemail))) -> [ div [ txt (s_ "E-mail address:"); txt " "; input ~input_type:`Text ~name:lemail ~value:email string; ]; div [ input ~input_type:`Hidden ~name:lstate ~value:state string; input ~input_type:`Hidden ~name:lchallenge ~value:challenge string; txt (s_ "Please enter "); signup_captcha_img challenge; txt (s_ " in the following box: "); input ~input_type:`Text ~name:lresponse string; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) () in let error = format_captcha_error l error in return @@ div [ error; form ] let login_email_not_now () = let* l = get_preferred_gettext () in let open (val l) in return @@ div [ txt (s_ "You cannot log in now. Please try later.") ] let authentication_impossible () = let* l = get_preferred_gettext () in let open (val l) in let content = [ txt @@ s_ "Authentication is impossible."; txt @@ " "; txt @@ s_ "Maybe cookies are blocked."; ] in let title = s_ "Authentication impossible" in base ~title ~content () end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_election_mutex.ml0000644000175000017500000000432414476041226024456 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common let mutexes = ref SMap.empty let lock uuid_s = match SMap.find_opt uuid_s !mutexes with | None -> mutexes := SMap.add uuid_s (Queue.create ()) !mutexes; Lwt.return_unit | Some waiters -> let t, u = Lwt.task () in Queue.push u waiters; t let unlock uuid_s = match SMap.find_opt uuid_s !mutexes with | None -> () | Some waiters -> ( match Queue.take_opt waiters with | None -> mutexes := SMap.remove uuid_s !mutexes | Some u -> Lwt.wakeup_later u ()) let with_lock uuid f = let uuid_s = Uuid.unwrap uuid in Lwt.bind (lock uuid_s) (fun () -> Lwt.finalize f (fun () -> unlock uuid_s; Lwt.return_unit)) belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_generic.ml0000644000175000017500000001226314476041226023043 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Web_serializable_t open Belenios_core.Common open Belenios_api.Serializable_j open Web_common let ( let& ) = Option.bind type token = { expiration : datetime; account : account } let tokens = ref SMap.empty let new_token account = let token = generate_token ~length:22 () in let expiration = Period.add (Datetime.now ()) (Period.day 1) in tokens := SMap.add token { expiration; account } !tokens; Lwt.return token let filter tokens = let now = Datetime.now () in SMap.filter (fun _ { expiration; _ } -> Datetime.compare now expiration < 0) tokens let lookup_token token = tokens := filter !tokens; let& { account; _ } = SMap.find_opt token !tokens in Some account let invalidate_token token = tokens := SMap.remove token !tokens let () = let@ a = Accounts.add_update_hook in let f { expiration; account } = let account = if a.id = account.id then a else account in { expiration; account } in tokens := SMap.map f !tokens; Lwt.return_unit exception Error of Belenios_api.Serializable_t.error type result = int * string type body = { run : 'a. (string -> 'a) -> ('a -> result Lwt.t) -> result Lwt.t } let ok = Lwt.return (200, "{}") let bad_request = Lwt.return (400, "\"Bad Request\"") let unauthorized = Lwt.return (401, "\"Unauthorized\"") let forbidden = Lwt.return (403, "\"Forbidden\"") let not_found = Lwt.return (404, "\"Not Found\"") let method_not_allowed = Lwt.return (405, "\"Method Not Allowed\"") let precondition_failed = Lwt.return (412, "\"Precondition Failed\"") let handle_ifmatch ifmatch current cont = match ifmatch with | None -> cont () | Some x -> let* current = current () in if sha256_b64 current = x then cont () else precondition_failed let handle_generic_error f = Lwt.catch f (function | Error error -> let request_status = { code = 400; status = "Bad Request"; error } in Lwt.return (400, string_of_request_status request_status) | _ -> bad_request) let handle_get get = let@ () = handle_generic_error in let* x = get () in Lwt.return (200, x) let handle_get_option get = let@ () = handle_generic_error in let* x = get () in match x with None -> not_found | Some x -> Lwt.return (200, x) let get_configuration () = { privacy_policy = !Web_config.gdpr_uri; belenios_version = Belenios_platform.Version.version; belenios_build = Belenios_platform.Version.build; spec_version = Belenios_platform.Version.spec; api_version = 3; supported_crypto_versions; supported_booth_versions; authentications = List.map (function | `BuiltinPassword -> `Password | `BuiltinCAS -> `CAS | `Export a -> `Configured { configured_instance = a.auth_instance; configured_system = a.auth_system; }) !Web_config.exported_auth_config; default_group = !Web_config.default_group; default_nh_group = !Web_config.nh_group; max_voters = !Web_config.maxmailsatonce; languages = Belenios_ui.Languages.available; } let get_account (a : account) = { id = a.id; name = a.name; address = a.email; language = a.language; default_voter_languages = a.default_voter_languages; default_contact = a.default_contact; } let put_account (a : account) (b : api_account) = if b.address <> a.email then raise (Error (`CannotChange "address")); if b.id <> a.id then raise (Error (`CannotChange "id")); let a = { a with name = b.name; language = b.language; default_voter_languages = b.default_voter_languages; default_contact = b.default_contact; } in Accounts.update_account a belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_main.mli0000644000175000017500000000003014476041226022515 0ustar stephstephval main : unit -> unit belenios-2.2-10-gbb6b7ea8/src/web/server/common/otp.mli0000644000175000017500000000367314476041226021556 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type SENDER = sig type payload type context val send : context:context -> address:string -> code:string -> unit Lwt.t end module type S = sig type payload type context val generate : context:context -> address:string -> payload:payload -> unit Lwt.t val check : address:string -> code:string -> payload option end module Make (I : SENDER) () : S with type payload = I.payload and type context = I.context belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_admin.ml0000644000175000017500000036235214476041226023054 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Serializable_j open Common open Belenios_api.Serializable_t open Web_serializable_j open Web_common open Eliom_content.Html.F open Eliom_content.Html.F.Form module Make (Web_state : Web_state_sig.S) (Web_i18n : Web_i18n_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Mails_admin : Belenios_ui.Mails_admin_sig.S) = struct open Web_services open Pages_common let admin_background = " background: #FF9999;" let get_preferred_gettext () = Web_i18n.get_preferred_gettext "admin" let privacy_notice cont = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Election server" ^ " — " ^ s_ "Personal data processing notice" in let content = [ div [ txt (s_ "To use this site, you must accept our "); direct_a !Web_config.gdpr_uri (s_ "personal data policy"); txt "."; ]; post_form ~service:privacy_notice_accept (fun ncont -> [ div [ input ~input_type:`Hidden ~name:ncont ~value:cont (user string_of_privacy_cont); input ~input_type:`Submit ~value:(s_ "Accept") string; ]; ]) (); ] in base ~title ~content () let checkpriv_link l uuid = let open (val l : Belenios_ui.I18n.GETTEXT) in let uri_base = let service = Eliom_service.static_dir () in Eliom_uri.make_string_uri ~absolute:true ~service [ "static"; "checkpriv.html" ] |> rewrite_prefix in let uri = uri_base ^ "#" ^ Uuid.unwrap uuid |> Eliom_content.Xml.uri_of_string in Eliom_content.Html.F.Raw.a ~a:[ a_href uri ] [ txt @@ s_ "Check private key ownership" ] let login_box ?cont () = let* l = get_preferred_gettext () in let open (val l) in let style = "float: right; text-align: right;" ^ admin_background in let* user = Eliom_reference.get Web_state.site_user in let auth_systems = List.map (fun x -> x.auth_instance) !Web_config.site_auth_config in let cont = match cont with None -> ContSiteHome | Some x -> x in let cont = default_admin cont in let login service = Eliom_service.preapply ~service:site_login (Some service, cont) in let logout () = Eliom_service.preapply ~service:logout cont in let body = match user with | Some (_, account, _) -> [ div [ txt (s_ "Logged in as"); txt " "; em [ a ~service:Web_services.account [ txt account.name ] () ]; txt "."; ]; div [ a ~a:[ a_id "logout" ] ~service:(logout ()) [ txt (s_ "Log out") ] (); txt "."; ]; ] | None -> [ div [ txt (s_ "Not logged in.") ]; (let auth_systems = List.map (fun name -> a ~a:[ a_id ("login_" ^ name) ] ~service:(login name) [ txt name ] ()) auth_systems |> List.join (txt ", ") in div ([ txt (s_ "Log in:"); txt " [" ] @ auth_systems @ [ txt "]" ])); ] in return (div ~a:[ a_style style ] body) let admin_login get_handler = let* l = get_preferred_gettext () in let open (val l) in let contact = match !Web_config.contact_uri with | None -> txt "" | Some uri -> div [ txt (s_ "If you do not have any account, you may "); direct_a ~target:"_blank" uri (s_ "contact us"); txt "."; ] in let* auth_div = match !Web_config.site_auth_config with | [] -> return @@ txt "" | { auth_instance = service; _ } :: others -> let* default = get_handler service in let default = match default with | Web_auth_sig.Html x -> div ~a:[ a_class [ "embedded-login-form" ] ] [ x ] | Web_auth_sig.Redirection _ -> div [ txt (s_ "Log in with"); txt " "; a ~service:site_login [ txt service ] (Some service, default_admin ContSiteAdmin); txt "."; ] in let others = List.map (fun { auth_instance = service; _ } -> div [ txt (s_ "You can also log in with"); txt " "; a ~service:site_login [ txt service ] (Some service, default_admin ContSiteAdmin); txt "."; ]) others in return @@ div (default :: others) in let* body = let default = div [ txt (s_ "To administer an election, you need to log in."); contact ] in read_snippet ~default ~lang !Web_config.admin_home in let content = [ body; auth_div ] in let title = "Belenios" ^ " — " ^ s_ "Verifiable online voting platform" in let* login_box = login_box ~cont:ContSiteAdmin () in base ~title ~login_box ~content () let admin ~elections = let* l = get_preferred_gettext () in let open (val l) in let format_election (uuid, name) = let name = if name = "" then s_ "(untitled)" else name in li [ a ~service:election_admin ~a:[ a_id ("election_admin_" ^ Uuid.unwrap uuid) ] [ txt name ] uuid; ] in let format_draft_election (uuid, name) = let name = if name = "" then s_ "(untitled)" else name in li [ a ~service:election_draft ~a:[ a_id ("election_draft_" ^ Uuid.unwrap uuid) ] [ txt name ] uuid; ] in let title = s_ "Election server" ^ " — " ^ s_ "Administration" in match elections with | draft, elections, tallied, archived -> let draft = match draft with | [] -> p [ txt (s_ "You own no such elections!") ] | _ -> ul @@ List.map format_draft_election draft in let elections = match elections with | [] -> p [ txt (s_ "You own no such elections!") ] | _ -> ul @@ List.map format_election elections in let tallied = match tallied with | [] -> p [ txt (s_ "You own no such elections!") ] | _ -> ul @@ List.map format_election tallied in let archived = match archived with | [] -> p [ txt (s_ "You own no such elections!") ] | _ -> ul @@ List.map format_election archived in let try_new_ui = div @@ let str, xml = let s_ = Belenios_ui.I18n.s_xml s_ in s_ "
New: try the experimental interface (more \ ergonomic)
" in match xml with | Element ("div", [], xs) -> List.map (function | Xml_light_types.PCData x -> txt x | Element ("b", [], [ PCData x ]) -> span ~a:[ a_class [ "markup-b" ] ] [ txt x ] | Element ("a", [], [ PCData x ]) -> a ~service:(admin_new ()) [ txt x ] () | _ -> txt str) xs | _ -> [ txt str ] in let prepare_new_election = if !Web_config.deny_newelection then div [ txt (s_ "New elections are not allowed on this server.") ] else div [ a ~a:[ a_id "prepare_new_election" ] ~service:election_draft_pre [ txt (s_ "Prepare a new election") ] (); ] in let content = [ div [ prepare_new_election; div [ br () ]; try_new_ui; div [ br () ]; h2 [ txt (s_ "Elections being prepared") ]; draft; div [ br () ]; h2 [ txt (s_ "Elections you can administer") ]; elections; div [ br () ]; h2 [ txt (s_ "Tallied elections") ]; tallied; div [ br () ]; h2 [ txt (s_ "Archived elections") ]; archived; ]; ] in let* login_box = login_box () in let* lang_box = lang_box ContSiteAdmin in base ~lang_box ~title ~login_box ~content () let new_election_failure reason () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Create new election" in let reason = match reason with | `Exists -> txt (s_ "An election with the same UUID already exists.") | `Exception e -> txt @@ Printexc.to_string e in let content = [ div [ p [ txt (s_ "The creation failed.") ]; p [ reason ] ] ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_pre () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Prepare a new election" in let form = post_form ~service:election_draft_new (fun (credmgmt, (auth, cas_server)) -> let auth_systems = !Web_config.exported_auth_config |> List.mapi (fun i x -> let checked = i = 0 in match x with | `BuiltinPassword -> div [ label [ radio ~checked ~name:auth ~value:"password" string; txt " "; txt (s_ "sent in advance by e-mail (useful for \ multiple elections)"); ]; ] | `BuiltinCAS -> div [ label [ radio ~checked ~name:auth ~value:"cas" string; txt " "; txt (s_ "CAS (external authentication server, \ offers better security guarantees when \ applicable)"); ]; div ~a:[ a_style "margin-left: 5em;" ] [ txt (s_ "Server address:"); txt " "; input ~input_type:`Text ~name:cas_server string; txt " "; txt (s_ "(for example: https://cas.inria.fr/cas)"); ]; ] | `Export a -> let legend = match a.auth_system with | "email" -> [ txt (s_ "sent by email when voting (a short \ password, renewed for each vote)"); ] | _ -> [ txt a.auth_instance; txt " "; txt (s_ "(imported from server)"); ] in div [ label (radio ~checked ~name:auth ~value:("%" ^ a.auth_instance) string :: txt " " :: legend); ]) in [ div [ txt (s_ "For a better control of eligibility, voters will be \ authenticated by two factors: credentials and passwords"); txt " ("; direct_a Belenios_ui.Links.setup (s_ "more info"); txt ")."; ]; ol [ li [ txt (s_ "Credentials:"); div [ label [ radio ~checked:true ~name:credmgmt ~value:"auto" string; txt " "; txt (s_ "sent by our server (easier mode but offers \ less security)"); ]; ]; div [ label [ radio ~name:credmgmt ~value:"manual" string; txt " "; txt (s_ "sent by a third party chosen by you (safe \ mode)"); ]; ]; ]; li (txt (s_ "Passwords:") :: auth_systems); ]; div [ input ~input_type:`Submit ~value:(s_ "Proceed") string ]; ]) () in let content = [ form ] in let* login_box = login_box () in base ~title ~login_box ~content () let preview_booth l uuid metadata = let open (val l : Belenios_ui.I18n.GETTEXT) in let hash = Netencoding.Url.mk_url_encoded_parameters [ ("uuid", Uuid.unwrap uuid); ("lang", lang); ("draft", "1") ] in match get_booth_index metadata.e_booth_version with | Some i -> let (Booth election_vote) = fst booths.(i) in let service = Eliom_uri.make_string_uri ~service:(election_vote ()) ~absolute:true () |> rewrite_prefix in span [ direct_a (service ^ "#" ^ hash) (s_ "Preview booth") ] | None -> span [ txt @@ s_ "Unsupported booth version" ] let election_draft uuid se () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Preparation of election %s") se.se_questions.t_name in let available_languages = List.map fst Belenios_ui.Languages.available in let form_languages = post_form ~service:election_draft_languages (fun languages -> [ div [ txt (s_ "Languages:"); txt " "; input ~name:languages ~input_type:`Text ~value:(string_of_languages se.se_metadata.e_languages) string; txt " ("; txt (s_ "Available languages:"); txt " "; txt (string_of_languages (Some available_languages)); txt ")"; ]; div [ txt (s_ "This is a space-separated list of languages that will be \ used in emails sent by the server."); ]; div [ input ~input_type:`Submit ~value:(s_ "Save changes") string ]; ]) uuid in let div_languages = div [ h2 [ txt (s_ "Languages") ]; form_languages ] in let form_description = post_form ~service:election_draft_description ~a:[ a_id "name_and_description_form" ] (fun (name, description) -> [ div [ txt (s_ "Name of the election:"); txt " "; input ~name ~input_type:`Text ~value:se.se_questions.t_name ~a:[ a_placeholder (s_ "Name of the election") ] string; ]; div [ div [ txt (s_ "Description of the election:"); txt " " ]; div [ textarea ~name:description ~a: [ a_cols 80; a_placeholder (s_ "Description of the election."); ] ~value:se.se_questions.t_description (); ]; ]; div [ input ~input_type:`Submit ~value:(s_ "Save changes") string ]; ]) uuid in let div_description = div [ h2 [ txt (s_ "Name and description of the election") ]; form_description; ] in let form_admin_name = post_form ~service:election_draft_admin_name ~a:[ a_id "form_admin_name" ] (fun name -> [ div [ txt (s_ "Public name of the administrator:"); txt " "; (let value = match se.se_administrator with Some x -> x | None -> "" in input ~name ~input_type:`Text ~value string); ]; div [ txt (s_ "This name will be published on the election result page."); ]; div [ input ~input_type:`Submit ~value:(s_ "Save changes") string ]; ]) uuid in let div_admin_name = div [ h2 [ txt (s_ "Public name of the administrator") ]; form_admin_name ] in let form_contact = post_form ~service:election_draft_contact ~a:[ a_id "form_contact" ] (fun contact -> [ div [ txt (s_ "Contact:"); txt " "; (let value = match se.se_metadata.e_contact with | Some x -> x | None -> default_contact in input ~name:contact ~input_type:`Text ~value ~a:[ a_placeholder (s_ "Name ") ] string); ]; div [ txt (s_ "This contact will be added to emails sent to the voters."); ]; div [ input ~input_type:`Submit ~value:(s_ "Save changes") string ]; ]) uuid in let div_contact = div [ h2 [ txt (s_ "Contact") ]; form_contact ] in let auth = match se.se_metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> `Password | Some [ { auth_system = "dummy"; _ } ] -> `Dummy | Some [ { auth_system = "cas"; auth_config = [ ("server", server) ]; _ } ] -> `CAS server | Some [ { auth_system = "import"; auth_instance = name; _ } ] -> `Import name | _ -> failwith "unknown authentication scheme in election_draft" in let div_auth = div [ h2 [ txt (s_ "Authentication") ]; (match auth with | `Password -> div [ txt (s_ "Authentication scheme: password"); (if List.for_all (fun v -> v.sv_password <> None) se.se_voters then div [ txt (s_ "All passwords have been sent!") ] else post_form ~service:election_draft_auth_genpwd (fun () -> [ input ~input_type:`Submit ~value:(s_ "Generate and mail missing passwords") string; ]) uuid); ] | `Dummy -> div [ txt (s_ "Authentication scheme: dummy") ] | `CAS server -> div [ txt (s_ "Authentication scheme: CAS with server "); txt server; ] | `Import name -> div [ txt (Printf.sprintf (f_ "Authentication scheme: %s (imported from server)") name); ]); ] in let div_questions = div [ h2 [ a ~a:[ a_id "edit_questions" ] ~service:election_draft_questions [ txt (s_ "Edit questions") ] uuid; ]; preview_booth l uuid se.se_metadata; ] in let div_voters = div [ h2 [ a ~a:[ a_id "edit_voters" ] ~service:election_draft_voters [ txt (s_ "Edit voters") ] uuid; ]; div [ txt @@ string_of_int @@ List.length se.se_voters; txt (s_ " voter(s) registered"); ]; ] in let div_trustees = div [ h2 [ txt (s_ "Trustees") ]; div [ txt (s_ "By default, the election server manages the keys of the \ election (degraded privacy mode)."); txt " "; txt (s_ "For real elections, the key must be shared among \ independent trustees."); txt " "; txt (s_ "Click "); a ~service:election_draft_trustees [ txt (s_ "here") ] uuid; txt (s_ " to set up the election key."); ]; ] in let cred_auth_is_server = se.se_metadata.e_cred_authority = Some "server" in let div_credentials = div [ h2 [ txt (s_ "Credentials") ]; (if se.se_public_creds_received then let div_private_creds = if cred_auth_is_server then div [ a ~service:election_draft_credentials_get [ txt (s_ "Download private credentials") ] uuid; ] else txt "" in let div_edit_credential_authority_name = if cred_auth_is_server then txt "" else div [ a ~service:election_draft_credential_authority [ txt (s_ "Edit credential authority name") ] uuid; ] in div [ div [ txt (s_ "Credentials have already been generated!") ]; div_edit_credential_authority_name; div_private_creds; ] else div [ txt (s_ "Warning: this will freeze the voter list!"); (if cred_auth_is_server then post_form ~service:election_draft_credentials_server (fun () -> [ input ~input_type:`Submit ~value:(s_ "Generate on server") string; ]) uuid else div [ a ~service:election_draft_credential_authority [ txt (s_ "Credential management") ] uuid; ]); ]); ] in let link_confirm = div [ h2 [ txt (s_ "Validate creation") ]; a ~service:election_draft_confirm [ txt (s_ "Create election") ] uuid; ] in let form_destroy = let t = Option.value se.se_creation_date ~default:default_creation_date in let t = Period.add t (Period.day days_to_delete) in post_form ~service:election_draft_destroy (fun () -> [ div [ h2 [ txt (s_ "Destroy election") ]; div [ txt (s_ "Note: this election will be automatically destroyed \ after "); txt (Datetime.format t); txt "."; ]; input ~input_type:`Submit ~value:(s_ "Destroy election") string; ]; ]) uuid in let content = [ div_description; hr (); div_admin_name; hr (); div_languages; hr (); div_contact; hr (); div_questions; hr (); div_voters; hr (); div_credentials; hr (); div_auth; hr (); div_trustees; hr (); link_confirm; hr (); form_destroy; ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_trustees ?token uuid se () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Trustees for election %s") se.se_questions.t_name in let form_trustees_add = post_form ~service:election_draft_trustee_add (fun (n_id, n_comment) -> [ txt (s_ "Trustee's e-mail address:"); txt " "; input ~input_type:`Text ~name:n_id string; txt ", "; txt (s_ "public name:"); txt " "; input ~input_type:`Text ~name:n_comment string; input ~input_type:`Submit ~value:(s_ "Add") string; ]) uuid in let mk_form_trustee_del value = post_form ~service:election_draft_trustee_del (fun name -> [ input ~input_type:`Hidden ~name ~value string; input ~input_type:`Submit ~value:(s_ "Remove") string; ]) uuid in let langs = get_languages se.se_metadata.e_languages in let* trustees = match se.se_trustees with | `Basic x when x.dbp_trustees <> [] -> let ts = x.dbp_trustees in let* ts = Lwt_list.map_s (fun t -> let this_line = match token with | Some x when x = t.st_token -> true | _ -> false in let uri = compute_hash_link ~uuid ~token:t.st_token ~service:election_draft_trustee_static in let* mail_cell, link_cell = if t.st_token <> "" then if t.st_public_key = "" then let* subject, body = Mails_admin.mail_trustee_generation_basic langs uri in let mail_cell = a_mailto ~dest:t.st_id ~subject ~body (s_ "E-mail") in let link_cell = if this_line then a ~service:election_draft_trustees [ txt (s_ "Hide link") ] uuid else Raw.a ~a:[ a_href (Xml.uri_of_string uri) ] [ txt (s_ "Link") ] in return (mail_cell, link_cell) else let cell = txt (s_ "(done)") in return (cell, cell) else let cell = txt (s_ "(server)") in return (cell, cell) in let first_line = tr [ td [ txt t.st_id ]; td [ (match t.st_name with | None -> txt (s_ "(not available)") | Some x -> txt x); ]; td [ mail_cell ]; td [ link_cell ]; td [ txt (if t.st_public_key = "" then s_ "No" else s_ "Yes"); ]; td [ (if t.st_id = "server" then txt (s_ "(cannot be removed)") else mk_form_trustee_del t.st_id); ]; ] in let second_line = if this_line then [ tr [ td ~a:[ a_colspan 6 ] [ txt (s_ "The link that must be sent to trustee "); txt t.st_id; txt (s_ " is:"); br (); txt uri; ]; ]; ] else [] in return (first_line :: second_line)) ts in return @@ table (tr [ th [ txt (s_ "Trustee") ]; th [ txt (s_ "Public name") ]; th [ txt (s_ "E-mail") ]; th [ txt (s_ "Link") ]; th [ txt (s_ "Done?") ]; th [ txt (s_ "Remove") ]; ] :: List.flatten ts) | _ -> return (txt "") in let import_link = div [ a ~service:Web_services.election_draft_import_trustees [ txt (s_ "Import trustees from another election") ] uuid; ] in let div_trustees = match se.se_trustees with | `Basic x -> div [ trustees; (if x.dbp_trustees <> [] then div [ txt (s_ "There is one link per trustee. Send each trustee \ the respective link."); br (); br (); ] else txt ""); form_trustees_add; ] | `Threshold _ -> txt "" in let div_content = div [ div [ txt (s_ "To set up the election key, you need to nominate trustees. \ Each trustee will create a secret key."); txt " "; txt (s_ "To set up the election so that only a subset of trustees \ is needed, go to the "); a ~service:election_draft_threshold_trustees [ txt (s_ "threshold mode") ] uuid; txt "."; ]; br (); div_trustees; ] in let back_link = div [ a ~service:Web_services.election_draft [ txt (s_ "Go back to election draft") ] uuid; ] in let content = [ div_content; import_link; back_link ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_threshold_trustees ?token uuid se () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Trustees for election %s") se.se_questions.t_name in let dtp = match se.se_trustees with | `Basic _ -> { dtp_threshold = None; dtp_trustees = []; dtp_parameters = None; dtp_error = None; } | `Threshold x -> x in let show_add_remove = dtp.dtp_threshold = None in let form_trustees_add = if show_add_remove then post_form ~service:election_draft_threshold_trustee_add (fun (n_id, n_comment) -> [ txt (s_ "Trustee's e-mail address:"); txt " "; input ~input_type:`Text ~name:n_id string; txt ", "; txt (s_ "public name:"); txt " "; input ~input_type:`Text ~name:n_comment string; input ~input_type:`Submit ~value:(s_ "Add") string; ]) uuid else txt "" in let mk_form_trustee_del value = post_form ~service:election_draft_threshold_trustee_del (fun name -> [ input ~input_type:`Hidden ~name ~value string; input ~input_type:`Submit ~value:(s_ "Remove") string; ]) uuid in let langs = get_languages se.se_metadata.e_languages in let* trustees = match dtp.dtp_trustees with | [] -> return (txt "") | ts -> let* ts = Lwt_list.map_s (fun t -> let this_line = match token with | Some x when x = t.stt_token -> true | _ -> false in let state = match t.stt_step with | None -> "init" | Some 1 -> "1a" | Some 2 -> "1b" | Some 3 -> "2a" | Some 4 -> "2b" | Some 5 -> "3a" | Some 6 -> "3b" | Some 7 -> "done" | _ -> "unknown" in let uri = compute_hash_link ~uuid ~token:t.stt_token ~service:election_draft_threshold_trustee_static in let* mail_cell = let* subject, body = Mails_admin.mail_trustee_generation_threshold langs uri in return (a_mailto ~dest:t.stt_id ~subject ~body (s_ "E-mail")) in let first_line = tr ([ td [ txt t.stt_id ]; td [ (match t.stt_name with | None -> txt (s_ "(not available)") | Some x -> txt x); ]; td [ mail_cell ]; td [ (if this_line then a ~service:election_draft_threshold_trustees [ txt (s_ "Hide link") ] uuid else Raw.a ~a:[ a_href (Xml.uri_of_string uri) ] [ txt (s_ "Link") ]); ]; td [ txt state ]; ] @ if show_add_remove then [ td [ mk_form_trustee_del t.stt_id ] ] else []) in let second_line = if this_line then [ tr [ td ~a:[ a_colspan (if show_add_remove then 6 else 5) ] [ txt (s_ "The link that must be sent to trustee "); txt t.stt_id; txt (s_ " is:"); br (); txt uri; ]; ]; ] else [] in return (first_line :: second_line)) ts in return @@ div [ table (tr ([ th [ txt (s_ "Trustee") ]; th [ txt (s_ "Public name") ]; th [ txt (s_ "Mail") ]; th [ txt (s_ "Link") ]; th [ txt (s_ "State") ]; ] @ if show_add_remove then [ th [ txt (s_ "Remove") ] ] else []) :: List.flatten ts); div [ txt (s_ "Meaning of states:"); ul [ li [ txt (s_ "init: administrator needs to set threshold"); ]; li [ txt (s_ "1a: action needed from trustee: generate \ private key"); ]; li [ txt (s_ "2a, 3a: action needed from trustee: enter \ private key"); ]; li [ txt (s_ "1b, 2b, 3b: waiting for other trustees") ]; li [ txt (s_ "done: the key establishment protocol is \ finished"); ]; ]; ]; br (); ] in let form_threshold, form_reset = match dtp.dtp_trustees with | [] -> (txt "", txt "") | ts -> ( match dtp.dtp_threshold with | None -> ( post_form ~service:election_draft_threshold_set (fun name -> [ txt (s_ "Threshold:"); txt " "; input ~input_type:`Text ~name int; input ~input_type:`Submit ~value:(s_ "Set") string; txt " "; txt (s_ "(the threshold must be smaller than the number of \ trustees)"); ]) uuid, txt "" ) | Some i -> ( div [ txt (string_of_int i); txt (s_ " out of "); txt (string_of_int (List.length ts)); txt (s_ " trustees will be needed to decrypt the result."); ], post_form ~service:election_draft_threshold_set (fun name -> [ input ~input_type:`Hidden ~name ~value:0 int; input ~input_type:`Submit ~value:(s_ "Reset threshold") string; ]) uuid )) in let maybe_error = match dtp.dtp_error with | None -> txt "" | Some e -> div [ b [ txt "Error: " ]; txt e; br (); br () ] in let div_content = div [ div [ txt (s_ "On this page, you can configure a group of trustees so \ that only a subset of them is needed to perform the \ decryption."); ]; br (); form_threshold; br (); trustees; (if dtp.dtp_trustees <> [] then div [ txt (s_ "There is one link per trustee. Send a link to each \ trustee."); br (); br (); maybe_error; ] else txt ""); form_trustees_add; form_reset; ] in let back_link = div [ a ~service:Web_services.election_draft [ txt (s_ "Go back to election draft") ] uuid; ] in let content = [ div_content; br (); back_link ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_credential_authority uuid se () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Credentials for election %s") se.se_questions.t_name in let public_name_form = post_form ~service:election_draft_set_credential_authority (fun name -> let value = match se.se_metadata.e_cred_authority with | Some x -> x | None -> "" in [ txt (s_ "Public name of the credential authority:"); txt " "; input ~input_type:`Text ~name ~value string; input ~input_type:`Submit ~value:(s_ "Set") string; ]) uuid in let back = div [ a ~service:Web_services.election_draft [ txt (s_ "Back to election preparation page") ] uuid; ] in let url = compute_hash_link ~uuid ~token:se.se_public_creds ~service:election_draft_credentials_static in let content = [ back; public_name_form; div [ (let subject, body = Mails_admin.mail_credential_authority l url in a_mailto ~subject ~body (s_ "Send instructions to the credential authority")); ]; div [ txt (s_ "Alternatively, you can send the credential authority the \ following link:"); ]; ul [ li [ Raw.a ~a: [ a_id "credential_authority_link"; a_href (Xml.uri_of_string url); ] [ txt url ]; ]; ]; div [ txt (s_ "Note that this authority will personally have to send each \ credential to its respective voter."); ]; ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_credentials_done se () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Credentials for election %s") se.se_questions.t_name in let content = [ div [ txt (s_ "Credentials have been received and checked!") ]; div [ div [ b [ txt (s_ "Instructions") ] ]; div [ txt (s_ "Once the election is open, check that:"); ol [ li [ txt (s_ "the number of voters is correct, and the \ fingerprint of the voter list matches what has \ been saved;"); ]; li [ txt (s_ "the fingerprint of public credentials matches \ what has been saved;"); ]; li [ txt (s_ "you can send the private credential back to its \ rightful owner in case it gets lost."); ]; ]; ]; div [ txt (s_ "Once the election is over, the file creds.txt must be \ destroyed."); ]; ]; ] in base ~title ~content () let script_with_lang ~lang file = let file = static file in let dir = Filename.dirname (string_of_uri file) in div [ Printf.ksprintf Unsafe.data "" lang (dir ^ "/"); script ~a:[ a_src file ] (txt ""); ] let election_draft_questions uuid se () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Questions for election %s") se.se_questions.t_name in let booth_version = match se.se_metadata.e_booth_version with None -> 1 | Some v -> v in let form = let value = string_of_template se.se_questions in post_form ~service:election_draft_questions_post (fun (nquestions, nbooth) -> [ div [ txt (s_ "Questions:") ]; div [ textarea ~a:[ a_id "questions"; a_rows 5; a_cols 80 ] ~name:nquestions ~value (); ]; div [ input ~input_type:`Text ~a:[ a_id "booth_version" ] ~name:nbooth ~value:booth_version int; ]; div [ input ~input_type:`Submit ~value:(s_ "Save changes") string ]; ]) uuid in let allow_nh = match get_suitable_group_kind se.se_questions with | `NH -> true | `H -> not (is_group_fixed se) in let hybrid_box = div ~a:[ a_class [ "hybrid_box" ] ] [ div [ txt (s_ "Alternative voting methods (warning, still experimental):"); ]; div [ txt (s_ "You may wish voters to rank candidates or give each \ candidate a score."); txt " "; txt (s_ "This allows deciding the winner according to your favorite \ counting method."); txt " "; txt (s_ "Our platform currently supports Condorcet, STV and \ majority judgment, but you may also apply your own method \ on the raw result (shuffled list of ballots)."); ]; div [ txt (s_ "Note that:") ]; ol [ li [ txt (s_ "the after-the-vote procedure will require more steps;"); ]; li [ txt (s_ "the voting interface will depend on the selected \ counting method. In some cases, you should explain to \ voters (e.g. in the question field) how they are \ supposed to express their vote."); txt " "; direct_a Belenios_ui.Links.mixnet (s_ "More information."); ]; ]; div [ label [ input ~a:[ a_id "hybrid_mode" ] ~input_type:`Checkbox string; txt (s_ "Tick the box to activate this mode."); ]; ]; ] in let interactivity = div ~a:[ a_id "interactivity" ] [ script (Printf.ksprintf txt "var allow_nh = %b;" allow_nh); script_with_lang ~lang "tool_js_questions.js"; hybrid_box; ] in let back = div [ a ~service:Web_services.election_draft [ txt (s_ "Go back to election draft") ] uuid; ] in let content = [ back; interactivity; form ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_voters uuid se maxvoters () = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Voters for election %s") se.se_questions.t_name in let tooltip = div ~a: [ a_class [ "tooltip" ]; a_style "position:relative;display:inline-block;"; ] [ div ~a: [ a_style "display:inline-block;width:3ex;line-height:3ex;text-align:center;border-radius:1.5ex;background-color:black;color:white;"; ] [ txt "?" ]; div ~a: [ a_class [ "tooltiptext" ]; a_style "position:absolute;left:3ex;line-height:2.5ex;border:1px \ solid \ black;font-size:90%;display:inline-block;width:400px;padding:3px;background-color:#eee;"; ] [ txt (s_ "An identity is either \"address\", or \ \"address,username\", or \"address,username,weight\", or \ \"address,,weight\" where \"address\" is an e-mail \ address, \"username\" the associated user name for \ authentication, and \"weight\" is the number of votes of \ the voter (in case voters don't have all the same number \ of votes)."); ]; ] in let form = let placeholder = "bart.simpson@example.com # " ^ s_ "typical use" ^ "\nalbert.einstein@example.com,albert_e # " ^ s_ "when a login is needed, e.g. CAS" ^ "\nasterix.legaulois@example.com,,2 # " ^ s_ "when some voters have several votes" in post_form ~service:election_draft_voters_add (fun name -> [ div [ textarea ~a: [ a_style "vertical-align:top"; a_placeholder placeholder; a_rows 20; a_cols 80; ] ~name (); tooltip; ]; div [ input ~input_type:`Submit ~value:(s_ "Add") string ]; ]) uuid in let mk_remove_button voter = let _, value, _ = Voter.get voter in post_form ~service:election_draft_voters_remove (fun name -> [ input ~input_type:`Hidden ~name ~value string; input ~input_type:`Submit ~value:(s_ "Remove") string; ]) uuid in let remove_all_button = if se.se_public_creds_received then div [] else post_form ~service:election_draft_voters_remove_all (fun () -> [ input ~input_type:`Submit ~value:(s_ "Remove all") string ]) uuid in let has_passwords = match se.se_metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> true | _ -> false in let mk_regen_passwd voter = let _, value, _ = Voter.get voter in post_form ~service:election_draft_voters_passwd ~a:[ a_style "display: inline;" ] (fun name -> [ input ~input_type:`Hidden ~name ~value string; input ~input_type:`Submit ~value:(s_ "Send again") string; ]) uuid in let format_password_cell x = match x.sv_password with | Some _ -> [ txt (s_ "Yes"); txt " "; mk_regen_passwd x.sv_id ] | None -> [ txt (s_ "No") ] in let voters = List.map (fun v -> tr ([ td [ txt @@ Voter.to_string v.sv_id ] ] @ (if has_passwords then [ td (format_password_cell v) ] else []) @ if se.se_public_creds_received then [] else [ td [ mk_remove_button v.sv_id ] ])) se.se_voters in let form_passwords = if has_passwords then post_form ~service:election_draft_auth_genpwd (fun () -> [ input ~input_type:`Submit ~value:(s_ "Generate and mail missing passwords") string; ]) uuid else txt "" in let voters = match voters with | [] -> div [ txt (s_ "No voters") ] | _ :: _ -> div [ form_passwords; br (); table (tr ([ th [ txt (s_ "Identity") ] ] @ (if has_passwords then [ th [ txt (s_ "Password sent?") ] ] else []) @ if se.se_public_creds_received then [] else [ th [ txt (s_ "Remove") ] ]) :: voters); remove_all_button; ] in let back = div [ a ~service:Web_services.election_draft [ txt (s_ "Go back to election draft") ] uuid; ] in let div_add = if se.se_public_creds_received then txt "" else div [ div [ txt (s_ "Please enter the identities of voters to add, one per \ line"); txt " (max "; txt (string_of_int maxvoters); txt ")."; ]; form; ] in let warning = div [ div ~a:[ a_style "text-align:center;font-size:120%;" ] [ b [ txt (s_ "Warning:") ]; txt " "; txt (s_ "you have to make sure that the email addresses are valid."); ]; div ~a: [ a_style "text-align:center;font-style:italic;width:80%;margin-left:auto;margin-right:auto;"; ] [ txt (s_ "You won't be able to change the email addresses once the \ credentials are created. Voters with invalid email \ addresses won't be able to vote."); ]; ] in let div_import = div [ a ~service:election_draft_import [ txt (s_ "Import voters from another election") ] uuid; ] in let content = [ back; div_import; br (); warning; voters; div_add ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_credentials_already_generated () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Credential generation" in let content = [ div [ txt (s_ "Credentials have already been generated!") ] ] in base ~title ~content () let election_draft_credentials_static () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Credential generation" in let div_link = div [ txt (s_ "The link to the election will be:"); ul [ li [ span ~a:[ a_id "election_url" ] [] ] ]; ] in let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in let form_textarea = post_form ~a:[ a_id "submit_form"; a_style "display:none;" ] ~service:election_draft_credentials_post (fun name -> [ div [ div [ txt (s_ "Public credentials:") ]; div [ textarea ~a:[ a_id "pks"; a_rows 5; a_cols 40 ] ~name () ]; div [ txt (s_ "Fingerprint of public credentials:"); txt " "; span ~a:[ a_id "public_creds_fp" ] []; ]; div [ b [ txt (s_ "Instructions:") ]; ol [ li [ txt (s_ "Download "); raw_a ~service:home ~a:[ a_id "creds" ] [ txt (s_ "private credentials") ] (); txt (s_ " and save the file to a secure location."); br (); txt (s_ "You will use it to send credentials to \ voters."); ]; li [ txt (s_ "Download "); raw_a ~service:home ~a:[ a_id "voters_txt" ] [ txt (s_ "the list of voters") ] (); txt "."; br (); txt (s_ "This list must be the one approved by the \ election commission."); ]; li [ txt (s_ "Save the two fingerprints above."); br (); txt (s_ "Once the election is open, you must check \ that they match with what is published by \ the server."); ]; li [ txt (s_ "Submit public credentials using the button \ below."); ]; ]; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit public credentials") string; ]; ]; ]) (uuid, token) in let disclaimer = p [ b [ txt (s_ "Note:") ]; txt " "; txt (s_ "submitting a large number of credentials using the above form \ may fail; in this case, you have to use the command-line tool \ and the form below."); ] in let form_file = post_form ~a:[ a_id "submit_form_file" ] ~service:election_draft_credentials_post_file (fun name -> [ div [ h2 [ txt (s_ "Submit by file") ]; div [ txt (s_ "Use this form to upload public credentials generated \ with the command-line tool."); ]; div [ file_input ~name () ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]; ]) (uuid, token) in let voters = let hash = span ~a:[ a_id "voters_hash" ] [] in div [ div [ txt (s_ "List of voters:") ]; div [ raw_textarea ~rows:5 ~cols:40 "voters" "" ]; div [ txt (s_ "Fingerprint of voters:"); txt " "; hash ]; ] in let interactivity = div ~a:[ a_id "interactivity" ] [ script_with_lang ~lang "tool_js_credgen.js" ] in let div_textarea = div [ voters; interactivity; form_textarea; disclaimer ] in let content = div ~a:[ a_id "initially_hidden_content"; a_style "display: none;" ] [ div_link; div_textarea; form_file ] in base ~title ~content:[ content ] ~static:true () let election_draft_trustee_static () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Trustee key generation" in let div_link = div [ txt (s_ "The link to the election will be:"); ul [ li [ span ~a:[ a_id "election_url" ] [] ] ]; ] in let form = let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in let service = Eliom_service.preapply ~service:election_draft_trustee_post (uuid, token) in post_form ~a:[ a_id "data_form" ] ~service (fun name -> [ div ~a:[ a_id "submit_form"; a_style "display:none;" ] [ div [ txt (s_ "Public key:") ]; div [ textarea ~a:[ a_rows 5; a_cols 40; a_id "pk" ] ~name () ]; div [ txt (s_ "Fingerprint of the verification key:"); txt " "; span ~a:[ a_id "public_key_fp" ] []; ]; div [ b [ txt (s_ "Instructions:") ]; ol [ li [ txt (s_ "Download your "); raw_a ~service:home ~a:[ a_id "private_key" ] [ txt (s_ "private key") ] (); txt (s_ " and save it to a secure location."); br (); txt (s_ "You will use it to decrypt the final result."); ]; li [ txt (s_ "Save the fingerprint above."); br (); txt (s_ "Once the election is open, you must check \ that it is present in the set of public keys \ published by the server."); ]; li [ txt (s_ "Submit your public key using the button \ below."); ]; ]; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit public key") string; ]; ]; ]) () in let interactivity = div ~a:[ a_id "interactivity" ] [ script_with_lang ~lang "tool_js_tkeygen.js" ] in let content = div ~a:[ a_id "initially_hidden_content"; a_style "display: none;" ] [ div_link; interactivity; form ] in base ~title ~content:[ content ] ~static:true () let election_draft_threshold_trustee_static () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Trustee key generation" in let header = div ~a:[ a_style "text-align:center;" ] [ h2 [ txt (s_ "Collaborative key generation") ]; div ~a:[ a_id "current_step" ] [ txt (s_ "Step 0/3") ]; ] in let div_link = div [ txt (s_ "The link to the election will be:"); ul [ li [ span ~a:[ a_id "election_url" ] [] ] ]; ] in let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in let form = post_form ~service:election_draft_threshold_trustee_post ~a:[ a_id "data_form" ] (fun data -> [ div ~a:[ a_id "key_helper"; a_style "display:none;" ] [ b [ txt (s_ "Instructions:") ]; ol [ li [ txt (s_ "Download your "); raw_a ~service:home ~a:[ a_id "private_key" ] [ txt (s_ "private key") ] (); txt (s_ " and save it to a secure location."); br (); txt (s_ "You will use it in the next steps and to decrypt \ the final result."); ]; li [ txt (s_ "The fingerprint of your public key is "); span ~a:[ a_id "pki_fp" ] []; txt (s_ ". Save it so that you can check that it appears \ on the election home later."); ]; li [ txt (s_ "Submit data using the following button:"); txt " "; input ~input_type:`Submit ~value:(s_ "Submit") string; txt "."; div [ txt (s_ "Data:"); txt " "; textarea ~a:[ a_id "data"; a_rows 5; a_cols 40 ] ~name:data (); ]; ]; ]; ]; ]) (uuid, token) in let form_compute = div ~a:[ a_id "compute_form"; a_style "display: none;" ] [ b [ txt (s_ "Instructions:") ]; ol [ li [ txt (s_ "Enter your private key:"); txt " "; input ~input_type:`Text ~a:[ a_id "compute_private_key" ] string; txt " "; button_no_value ~a:[ a_id "compute_button" ] ~button_type:`Button [ txt (s_ "Proceed") ]; ]; li [ txt (s_ "Submit data using the following button:"); post_form ~a:[ a_id "data_form_compute" ] ~service:election_draft_threshold_trustee_post (fun data -> [ input ~input_type:`Submit ~value:(s_ "Submit") string; div [ txt (s_ "Data:"); txt " "; textarea ~a:[ a_id "compute_data"; a_rows 5; a_cols 40 ] ~name:data (); ]; ]) (uuid, token); ]; ]; ] in let interactivity = div ~a:[ a_id "interactivity" ] [ script_with_lang ~lang "tool_js_ttkeygen.js" ] in let div_instructions = div ~a:[ a_id "div_instructions"; a_style "display: none;" ] [ b [ txt (s_ "Instructions") ]; ol [ li [ txt (s_ "Save the fingerprint above.") ]; li [ txt (s_ "Once the election is open, you must check that it is \ present in the set of verification keys published by \ the server."); ]; li [ txt (s_ "Remember that you must also check the presence of your \ public key."); ]; li [ txt (s_ "Remember to store you private key securely.") ]; ]; ] in let content = div ~a:[ a_id "initially_hidden_content"; a_style "display: none;" ] [ header; div_link; br (); div ~a:[ a_id "explain" ] []; interactivity; form; form_compute; div_instructions; ] in base ~title ~content:[ content ] ~static:true () let election_draft_importer l ~service ~title ~note uuid (elections, tallied, archived) = let open (val l : Belenios_ui.I18n.GETTEXT) in let format_election (from_uuid, name) = let from_uuid = Uuid.unwrap from_uuid in let form = post_form ~service (fun from -> [ div [ txt name; txt " ("; txt from_uuid; txt ")" ]; div [ input ~input_type:`Hidden ~name:from ~value:from_uuid string; input ~input_type:`Submit ~value:(s_ "Import from this election") string; ]; ]) uuid in li [ form ] in let itemize xs = match xs with | [] -> p [ txt (s_ "You own no such elections!") ] | _ -> ul @@ List.map format_election xs in let content = [ b [ txt (s_ "Note:") ]; txt " "; txt note; h2 [ txt (s_ "Elections you can administer") ]; itemize elections; h2 [ txt (s_ "Tallied elections") ]; itemize tallied; h2 [ txt (s_ "Archived elections") ]; itemize archived; ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_draft_import uuid se elections () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Election " ^ se.se_questions.t_name ^ " — " ^ s_ "Import voters from another election" in let note = s_ "Imported voters will have the same password as in the original \ election, and no new e-mail will be sent." in let service = election_draft_import_post in election_draft_importer l ~service ~title ~note uuid elections let election_draft_import_trustees uuid se elections () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Election " ^ se.se_questions.t_name ^ " — " ^ s_ "Import trustees from another election" in let note = s_ "Imported trustees will have the same keys as in the original election." in let service = election_draft_import_trustees_post in election_draft_importer l ~service ~title ~note uuid elections let election_draft_confirm uuid se () = let* l = get_preferred_gettext () in let open (val l) in let notok x = span ~a:[ a_style "color: red;" ] [ txt x ] in let ok x = txt x in let title = s_ "Election " ^ se.se_questions.t_name ^ " — " ^ s_ "Validate creation" in let* s = Api_drafts.get_draft_status uuid se in let ready = true in let ready, name = if se.se_questions.t_name = default_name then (false, notok (s_ "Not edited")) else (ready, ok "OK") in let ready, description = if se.se_questions.t_description = default_description then (false, notok (s_ "Not edited")) else (ready, ok "OK") in let ready, admin_name = if se.se_administrator = None then (false, notok (s_ "Missing")) else (ready, ok "OK") in let ready, questions = if se.se_questions.t_questions = default_questions then (false, notok (s_ "Not edited")) else (ready, ok "OK") in let ready, voters = match s.num_voters with | 0 -> (false, notok "Missing") | n -> (ready, ok (Printf.sprintf (f_ "%d voter(s)") n)) in let ready, passwords = match s.passwords_ready with | Some true -> (ready, ok "OK") | Some false -> (false, notok (s_ "Missing")) | None -> (ready, ok (s_ "Not applicable")) in let ready, credential_authority = match se.se_metadata.e_cred_authority with | None | Some "" -> (false, notok (s_ "Missing")) | Some _ -> (ready, ok "OK") in let ready, credentials = match s.credentials_ready with | true -> (ready, ok "OK") | false -> (false, notok (s_ "Missing")) in let private_creds = match s.private_credentials_downloaded with | Some true -> ok "OK" | Some false -> span [ notok (s_ "Not downloaded."); txt " "; txt (s_ "Please "); a ~service:election_draft_credentials_get [ txt (s_ "download") ] uuid; txt (s_ " and save them securely."); ] | None -> ok (s_ "Not applicable") in let ready, trustees = match s.trustees_ready with | true -> (ready, ok "OK") | false -> (false, notok (s_ "Missing")) in let ready, nh_and_weights = match s.nh_and_weights_compatible with | true -> (ready, []) | false -> ( false, [ tr [ td [ txt (s_ "Compatibility of weights with questions?") ]; td [ notok (s_ "Alternative questions cannot be combined with \ weights."); ]; ]; ] ) in let div_trustee_warning = match se.se_trustees with | `Basic x when x.dbp_trustees = [] -> div [ b [ txt (s_ "Warning:") ]; txt " "; txt (s_ "No trustees were set. This means the server will manage \ the election key by itself."); ] | _ -> txt "" in let contact, div_contact_warning = match se.se_metadata.e_contact with | None -> ( s_ "No", div [ b [ txt (s_ "Warning:") ]; txt " "; txt (s_ "No contact was set!"); ] ) | Some _ -> (s_ "Yes", txt "") in let table_checklist = [ [ tr [ td [ txt (s_ "Name?") ]; td [ name ] ]; tr [ td [ txt (s_ "Description?") ]; td [ description ] ]; tr [ td [ txt (s_ "Public name of the administrator?") ]; td [ admin_name ]; ]; tr [ td [ txt (s_ "Questions?") ]; td [ questions; txt " "; preview_booth l uuid se.se_metadata ]; ]; tr [ td [ txt (s_ "Voters?") ]; td [ voters ] ]; tr [ td [ txt (s_ "Passwords?") ]; td [ passwords ] ]; tr [ td [ txt (s_ "Credential authority?") ]; td [ credential_authority ]; ]; tr [ td [ txt (s_ "Credentials?") ]; td [ credentials ] ]; tr [ td [ txt (s_ "Private credentials?") ]; td [ private_creds ] ]; tr [ td [ txt (s_ "Trustees?") ]; td [ trustees; txt " ("; checkpriv_link l uuid; txt ")" ]; ]; tr [ td [ txt (s_ "Contact?") ]; td [ txt contact ] ]; ]; nh_and_weights; ] |> List.flatten |> table in let status = if ready then span ~a:[ a_style "color: green;" ] [ txt (s_ "election ready") ] else span ~a:[ a_style "color: red;" ] [ txt (s_ "election not ready") ] in let checklist = div [ h2 [ txt (s_ "Checklist:"); txt " "; status ]; table_checklist; div_trustee_warning; div_contact_warning; ] in let form_create = if ready then post_form ~service:election_draft_create (fun () -> [ div [ h2 [ txt (s_ "Validate creation") ]; input ~input_type:`Submit ~value:(s_ "Create election") string; txt " "; txt (s_ "(Warning: This action is irreversible.)"); ]; ]) uuid else div [] in let back = div [ a ~service:Web_services.election_draft [ txt (s_ "Go back to election draft") ] uuid; ] in let content = [ back; checklist; form_create ] in let* login_box = login_box () in base ~title ~login_box ~content () let election_admin ?shuffle_token ?tally_token election metadata status () = let langs = get_languages metadata.e_languages in let* l = get_preferred_gettext () in let open (val l) in let open (val election : Site_common_sig.ELECTION) in let uuid = election.e_uuid in let title = election.e_name ^ " — " ^ s_ "Administration" in let auto_form () = let* d = Web_persist.get_election_automatic_dates uuid in let format = function | None -> "" | Some x -> Datetime.format @@ Datetime.from_unixfloat x in return @@ post_form ~service:election_auto_post (fun (lopen, lclose) -> [ div [ txt (s_ "Alternatively, you may set up automatic dates.") ]; div [ b [ txt (s_ "Note:") ]; txt " "; txt (s_ "times are in UTC. Now is "); txt (Datetime.format @@ Datetime.now ()); txt "."; ]; div ~a:[ a_style "margin-left: 3em;" ] [ div [ txt (s_ "Automatically open the election at:"); txt " "; input ~name:lopen ~input_type:`Text ~value:(format d.auto_date_open) string; ]; div [ txt (s_ "Automatically close the election at:"); txt " "; input ~name:lclose ~input_type:`Text ~value:(format d.auto_date_close) string; ]; div [ txt (s_ "Enter dates in UTC format, as per YYYY-MM-DD \ HH:MM:SS, leave empty for no date."); ]; ]; div [ input ~input_type:`Submit ~value:(s_ "Change automatic dates") string; ]; ]) uuid in let state_form checked = let service, value, msg, msg2 = if checked then ( election_close, s_ "Close election", s_ "The election is open. Voters can vote.", s_ " You may re-open the election when it is closed." ) else ( election_open, s_ "Open election", s_ "The election is closed. No one can vote.", "" ) in post_form ~service (fun () -> [ div ~a:[ a_style "text-align: center;" ] [ txt msg; txt " " ]; br (); input ~input_type:`Submit ~value string; txt msg2; ]) uuid in let* state_div = match status.status_state with | `Open -> let* auto_form = auto_form () in return @@ div [ state_form true; br (); auto_form ] | `Closed -> let* auto_form = auto_form () in return @@ div [ state_form false; br (); auto_form; br (); hr (); post_form ~service:election_compute_encrypted_tally (fun () -> [ input ~input_type:`Submit ~value:(s_ "Proceed to vote counting") string; txt " "; txt (s_ "Warning: This action is irreversible; the \ election will be definitively closed."); ]) uuid; ] | `Shuffling -> let* shuffles = Api_elections.get_shuffles uuid metadata in let shufflers = shuffles.shuffles_shufflers in let select_disabled = List.exists (fun x -> x.shuffler_token <> None) shufflers in let* table_contents = Lwt_list.map_s (fun x -> let skip, hash, done_ = let mk_skip disabled = post_form ~service:election_shuffler_skip_confirm (fun (nuuid, ntrustee) -> let a = if disabled then [ a_disabled () ] else [] in [ input ~input_type:`Hidden ~name:nuuid ~value:uuid (user Uuid.unwrap); input ~input_type:`Hidden ~name:ntrustee ~value:x.shuffler_address string; input ~a ~input_type:`Submit ~value:(s_ "Skip") string; ]) () in match x.shuffler_fingerprint with | None -> (mk_skip false, txt "", false) | Some h -> ( mk_skip true, txt (if h = "" then s_ "(skipped)" else h), true ) in let this_line = match shuffle_token with | Some y when x.shuffler_token = Some y -> true | _ -> false in let* cell = match x.shuffler_token with | Some token -> let uri = compute_hash_link ~uuid ~token ~service:election_shuffle_link_static in let* subject, body = Mails_admin.mail_shuffle langs uri in return @@ div [ a_mailto ~dest:x.shuffler_address ~subject ~body (s_ "Mail"); txt " | "; (if this_line then a ~service:election_admin [ txt (s_ "Hide link") ] uuid else Raw.a ~a: [ a_href (Xml.uri_of_string uri); a_id "shuffle-link"; ] [ txt (s_ "Link") ]); ] | None -> return @@ post_form ~service:election_shuffler_select (fun (nuuid, ntrustee) -> let a = if select_disabled || done_ then [ a_disabled () ] else [] in [ input ~input_type:`Hidden ~name:nuuid ~value:uuid (user Uuid.unwrap); input ~input_type:`Hidden ~name:ntrustee ~value:x.shuffler_address string; input ~a ~input_type:`Submit ~value:(s_ "Select this trustee") string; ]) () in let first_line = tr [ td [ txt x.shuffler_address ]; td [ cell ]; td [ (if done_ then txt (s_ "Yes") else txt (s_ "No")) ]; td [ skip ]; td [ hash ]; ] in let second_line = match (this_line, x.shuffler_token) with | true, Some token -> let uri = compute_hash_link ~uuid ~token ~service:election_shuffle_link_static in [ tr [ td ~a:[ a_colspan 5 ] [ txt (s_ "The link that must be sent to trustee "); txt x.shuffler_address; txt (s_ " is:"); br (); txt uri; ]; ]; ] | _, _ -> [] in return (first_line :: second_line)) shufflers in let proceed = if List.for_all (fun x -> x.shuffler_fingerprint <> None) shufflers then post_form ~service:election_decrypt (fun () -> [ input ~input_type:`Submit ~value:(s_ "Proceed to decryption") string; ]) uuid else txt "" in return (div [ div [ div ~a:[ a_style "text-align: center;" ] [ txt (s_ "Shuffling of ballots") ]; table (tr [ th [ txt (s_ "Trustee") ]; th []; th [ txt (s_ "Done?") ]; th []; th [ txt (s_ "Fingerprint") ]; ] :: List.flatten table_contents); ]; proceed; ]) | `EncryptedTally -> let* p = Api_elections.get_partial_decryptions uuid metadata in let threshold_or_not = match p.partial_decryptions_threshold with | None -> txt "" | Some x -> txt (" " ^ Printf.sprintf (f_ "At least %d trustee(s) must act.") x) in let* trustees = p.partial_decryptions_trustees |> Lwt_list.map_s (fun t -> let this_line = match tally_token with | Some x when x = t.trustee_pd_token -> true | _ -> false in let uri = compute_hash_link ~uuid ~token:t.trustee_pd_token ~service:election_tally_trustees_static in let* mail, link = if t.trustee_pd_address = "server" then return (txt (s_ "(server)"), txt (s_ "(server)")) else let* subject, body = Mails_admin.mail_trustee_tally langs uri in let mail = a_mailto ~dest:t.trustee_pd_address ~subject ~body (s_ "E-mail") in let link = if this_line then a ~service:election_admin [ txt (s_ "Hide link") ] uuid else Raw.a ~a:[ a_href (Xml.uri_of_string uri) ] [ txt (s_ "Link") ] in return (mail, link) in let first_line = tr [ td [ txt t.trustee_pd_address ]; td [ mail ]; td [ link ]; td [ txt (if t.trustee_pd_done then s_ "Yes" else s_ "No"); ]; ] in let second_line = if this_line then [ tr [ td ~a:[ a_colspan 4 ] [ txt (s_ "The link that must be sent to trustee "); txt t.trustee_pd_address; txt (s_ " is:"); br (); txt uri; ]; ]; ] else [] in return (first_line :: second_line)) in let* release_form = let* hidden = Web_persist.get_election_result_hidden uuid in match hidden with | Some t -> let scheduled = div [ Printf.sprintf (f_ "The result is scheduled to be published after %s.") (Datetime.unwrap t) |> txt; ] in post_form ~service:election_show_result (fun () -> [ scheduled; input ~input_type:`Submit ~value:(s_ "Publish the result as soon as possible") string; ]) uuid |> return | None -> let postpone_form = post_form ~service:election_hide_result (fun date -> [ div [ Printf.ksprintf txt (f_ "You may postpone the publication of the \ election result up to %d days in the future.") days_to_publish_result; ]; div [ input ~input_type:`Submit ~value:(s_ "Postpone publication until") string; txt " "; input ~name:date ~input_type:`Text string; ]; div [ txt (s_ "Enter the date in UTC fornat, as per \ YYYY-MM-DD HH:MM:SS. For example, today is "); txt (String.sub (string_of_datetime (Datetime.now ())) 1 19); txt "."; ]; ]) uuid in let release_form = post_form ~service:election_tally_release (fun () -> [ div [ txt @@ s_ "You may force the computation of the result \ now, if the required number of trustees have \ done their job, by clicking on the following \ button."; txt " "; txt @@ s_ "Note: no more partial decryptions will be \ allowed."; ]; div [ input ~input_type:`Submit ~value:(s_ "Compute the result") string; ]; ]) uuid in div [ postpone_form; hr (); release_form ] |> return in return @@ div [ div [ txt (s_ "The "); a ~service:election_dir [ txt (s_ "encrypted tally") ] (uuid, ESETally); txt (s_ " has been computed."); ]; div [ div [ txt (s_ "Awaiting trustees…"); threshold_or_not ]; table (tr [ th [ txt (s_ "Trustee") ]; th [ txt (s_ "E-mail") ]; th [ txt (s_ "Link") ]; th [ txt (s_ "Done?") ]; ] :: List.flatten trustees); ]; release_form; ] | `Tallied -> return @@ div [ div [ txt (s_ "This election has been tallied."); txt " "; a ~service:election_download_archive [ txt (s_ "Download archive.") ] (uuid, ()); ]; ] | `Archived -> return @@ div [ txt (s_ "This election is archived."); txt " "; a ~service:election_download_archive [ txt (s_ "Download archive.") ] (uuid, ()); ] in let archive_date = match status.status_auto_archive_date with | None -> txt "" | Some t -> div [ txt (s_ "This election will be automatically archived after "); txt (Datetime.format @@ Datetime.from_unixfloat t); txt "."; ] in let div_archive = match status.status_state with | `Archived -> txt "" | _ -> div [ br (); hr (); archive_date ] in let delete_date = let t = status.status_auto_delete_date in div [ txt (s_ "This election will be automatically deleted after "); txt (Datetime.format @@ Datetime.from_unixfloat t); txt "."; ] in let div_delete = div [ br (); hr (); delete_date; post_form ~service:election_delete (fun () -> [ input ~input_type:`Submit ~value:(s_ "Delete election") string; txt " "; txt (s_ "Warning: This action is irreversible."); ]) uuid; ] in let password = match metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> true | _ -> false in let div_regenpwd = if password && match status.status_state with `Open | `Closed -> true | _ -> false then div [ a ~a:[ a_id "election_regenpwd" ] ~service:election_regenpwd [ txt (s_ "Regenerate and e-mail a password") ] uuid; ] else txt "" in let content = [ div [ a ~service:Web_services.election_home [ txt (s_ "Election home") ] (uuid, ()); ]; div [ a ~service:election_dir [ txt (s_ "Voter list") ] (uuid, ESVoters) ]; div [ a ~service:election_pretty_records [ txt (s_ "Voting records") ] (uuid, ()); ]; div [ a ~service:election_missing_voters [ txt (s_ "Missing voters") ] (uuid, ()); ]; div [ checkpriv_link l uuid ]; div_regenpwd; hr (); div [ state_div ]; div_archive; div_delete; ] in let* login_box = login_box ~cont:(ContSiteElection uuid) () in base ~title ~login_box ~content () let regenpwd uuid () = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:election_regenpwd_post (fun user -> [ div [ txt (s_ "Username:"); txt " "; input ~name:user ~input_type:`Text string; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) uuid in let content = [ form ] in let title = s_ "Regenerate and e-mail password" in let* login_box = login_box ~cont:(ContSiteElection uuid) () in base ~title ~login_box ~content ~uuid () let pretty_records election records () = let* l = get_preferred_gettext () in let open (val l) in let open (val election : Site_common_sig.ELECTION) in let uuid = election.e_uuid in let title = election.e_name ^ " — " ^ s_ "Records" in let nrecords = List.length records in let records = List.map (fun { vr_date; vr_username } -> tr [ td [ txt @@ Datetime.format @@ Datetime.from_unixfloat vr_date ]; td [ txt vr_username ]; ]) records in let* voters = Web_persist.get_all_voters uuid in let nvoters = List.length voters in let summary = div [ Printf.ksprintf txt (f_ "Number of records: %d/%d") nrecords nvoters ] in let table = match records with | [] -> div [ txt (s_ "Nobody voted!") ] | _ -> div [ table (tr [ th [ txt (s_ "Date/Time (UTC)") ]; th [ txt (s_ "Username") ]; ] :: records); ] in let content = [ div [ txt (s_ "You can also access the "); a ~service:election_dir [ txt (s_ "raw data") ] (uuid, ESRecords); txt "."; ]; summary; table; ] in let* login_box = login_box ~cont:(ContSiteElection uuid) () in base ~title ~login_box ~content () let election_shuffler_skip_confirm uuid trustee = let* l = get_preferred_gettext () in let open (val l) in let title = Printf.sprintf (f_ "Skipping trustee %s") trustee in let content = [ post_form ~service:election_shuffler_skip (fun (nuuid, ntrustee) -> [ div [ txt (s_ "You may skip a trustee if they do not answer. Be aware \ that this reduces the security."); ]; div [ input ~input_type:`Hidden ~name:nuuid ~value:uuid (user Uuid.unwrap); input ~input_type:`Hidden ~name:ntrustee ~value:trustee string; input ~input_type:`Submit ~value:(s_ "Confirm") string; txt " "; a ~service:Web_services.election_admin [ txt (s_ "Cancel") ] uuid; ]; ]) (); ] in base ~title ~content () let shuffle_static () = let* l = get_preferred_gettext () in let open (val l) in let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in let title = s_ "Shuffle" in let content = div ~a:[ a_id "initially_hidden_content"; a_style "display: none;" ] [ div [ txt (s_ "As a trustee, your first role is to shuffle the encrypted \ ballots."); ]; div [ txt (s_ "Current list of ballots:"); txt " "; raw_textarea ~rows:5 ~cols:40 "current_ballots" ""; txt " "; (let service = Eliom_service.preapply ~service:election_nh_ciphertexts uuid in raw_a ~a:[ a_id "nh_ciphertexts_link" ] ~service [ txt (s_ "Download as a file") ] ()); ]; div ~a:[ a_id "estimation" ] [ txt (s_ "Estimating computation time…") ]; div ~a:[ a_id "wait_div" ] [ txt (s_ "Please wait… "); img ~src:(static "encrypting.gif") ~alt:(s_ "Loading…") (); ]; div ~a:[ a_id "controls_div"; a_style "display: none;" ] [ button_no_value ~button_type:`Button ~a:[ a_id "compute_shuffle" ] [ txt (s_ "Compute shuffle") ]; ]; post_form ~service:election_shuffle_post ~a:[ a_id "submit_form" ] (fun nshuffle -> [ div [ txt (s_ "Shuffled list of ballots:"); txt " "; textarea ~a:[ a_rows 5; a_cols 40; a_id "shuffle" ] ~name:nshuffle (); ]; div ~a:[ a_id "hash_div"; a_style "display:none;" ] [ div [ txt (s_ "The fingerprint of your shuffle is:"); txt " "; b ~a:[ a_id "hash" ] []; txt "."; ]; div [ txt (s_ "You must record this fingerprint and check that \ it appears on the election result page."); ]; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) (uuid, token); script_with_lang ~lang "tool_js_shuffle.js"; ] in base ~title ~content:[ content ] ~static:true () let tally_trustees_static () = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Partial decryption" in let content = div ~a:[ a_id "initially_hidden_content"; a_style "display: none;" ] [ p [ txt (s_ "It is now time to compute your partial decryption factors."); ]; p [ txt (s_ "The fingerprint of the encrypted tally is "); b [ span ~a:[ a_id "hash" ] [] ]; txt "."; ]; hr (); div [ b [ txt (s_ "Instructions:") ]; ol [ li [ div ~a:[ a_id "input_private_key" ] [ div [ p [ txt (s_ "Please enter your private key:") ]; input ~a:[ a_id "private_key"; a_size 80 ] ~input_type:`Text string; ]; div [ p [ txt (s_ "Or load it from a file:") ]; input ~a:[ a_id "private_key_file" ] ~input_type:`File string; ]; ]; br (); ]; li [ div [ button_no_value ~a:[ a_id "compute" ] ~button_type:`Button [ txt (s_ "Generate your contribution to decryption"); ]; ]; br (); ]; li [ div ~a:[ a_id "pd_done" ] [ (let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in post_form ~a:[ a_id "pd_form" ] ~service:election_tally_trustees_post (fun pd -> [ div [ input ~input_type:`Submit ~value:(s_ "Submit") string; txt (s_ " your contribution to decryption."); ]; div [ txt "Data: "; textarea ~a:[ a_rows 5; a_cols 40; a_id "pd" ] ~name:pd (); ]; ]) (uuid, token)); ]; ]; ]; ]; script_with_lang ~lang "tool_js_pd.js"; ] in base ~title ~content:[ content ] ~static:true () let signup_captcha ~service error challenge email = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:signup_captcha_post (fun (lchallenge, (lresponse, lemail)) -> [ div [ txt (s_ "E-mail address:"); txt " "; input ~input_type:`Text ~name:lemail ~value:email string; ]; div [ input ~input_type:`Hidden ~name:lchallenge ~value:challenge string; txt (s_ "Please enter "); Pages_common.signup_captcha_img challenge; txt (s_ " in the following box: "); input ~input_type:`Text ~name:lresponse string; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) service in let error = format_captcha_error l error in let content = [ error; form ] in base ~title:(s_ "Create an account") ~content () let signup_changepw ~service error challenge email username = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:changepw_captcha_post (fun (lchallenge, (lresponse, (lemail, lusername))) -> [ div [ txt (s_ "E-mail address:"); txt " "; input ~input_type:`Text ~name:lemail ~value:email string; txt (s_ " or username: "); input ~input_type:`Text ~name:lusername ~value:username string; txt "."; ]; div [ input ~input_type:`Hidden ~name:lchallenge ~value:challenge string; txt (s_ "Please enter "); Pages_common.signup_captcha_img challenge; txt (s_ " in the following box: "); input ~input_type:`Text ~name:lresponse string; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) service in let error = format_captcha_error l error in let content = [ error; form ] in base ~title:(s_ "Change password") ~content () let signup_login () = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:signup_login_post (fun lcode -> [ div [ txt (s_ "Please enter the verification code received by e-mail:"); txt " "; input ~input_type:`Text ~name:lcode string; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) () in let content = [ form ] in base ~title:(s_ "Account management") ~content () let signup address error username = let* l = get_preferred_gettext () in let open (val l) in let error = match error with | None -> txt "" | Some e -> let msg = match e with | UsernameTaken -> s_ "the username is already taken" | AddressTaken -> s_ "there is already an account with this e-mail address" | BadUsername -> s_ "the username is invalid" | BadPassword e -> Printf.sprintf (f_ "the password is too weak (%s)") e | PasswordMismatch -> s_ "the two passwords are not the same" | BadSpaceInPassword -> s_ "the password starts or ends with a space" in div [ txt (s_ "The account creation "); span ~a:[ a_style "color: red;" ] [ txt (s_ "failed") ]; txt (s_ " because "); txt msg; txt (s_ ". Please try again with a different one."); ] in let form = post_form ~service:signup_post (fun (lusername, (lpassword, lpassword2)) -> [ div [ txt (s_ "Your e-mail address is: "); txt address; txt "." ]; div [ txt (s_ "Please choose a username: "); input ~input_type:`Text ~name:lusername ~value:username string; txt (s_ " and a password: "); input ~input_type:`Password ~name:lpassword string; txt "."; ]; div [ txt (s_ "Type the password again: "); input ~input_type:`Password ~name:lpassword2 string; txt "."; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) () in let content = [ error; form ] in base ~title:(s_ "Create an account") ~content () let changepw ~username ~address error = let* l = get_preferred_gettext () in let open (val l) in let error = match error with | None -> txt "" | Some e -> let reason = match e with | PasswordMismatch -> s_ "the two passwords are not the same" | BadPassword e -> Printf.sprintf (f_ "the new password is too weak (%s)") e | BadSpaceInPassword -> s_ "the new password starts or ends with a space" | _ -> s_ "of an unknown reason" in div [ txt (s_ "The change "); span ~a:[ a_style "color: red;" ] [ txt (s_ "failed") ]; txt (s_ " because "); txt reason; txt (s_ ". Please try again with a different one."); ] in let form = post_form ~service:changepw_post (fun (lpassword, lpassword2) -> [ div [ txt (s_ "Your username is: "); txt username; txt (s_ " and your e-mail address is: "); txt address; txt "."; ]; div [ txt (s_ "Please choose a password: "); input ~input_type:`Password ~name:lpassword string; txt "."; ]; div [ txt (s_ "Type the password again: "); input ~input_type:`Password ~name:lpassword2 string; txt "."; ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) () in let content = [ error; form ] in base ~title:(s_ "Change password") ~content () let compute_fingerprint () = let* l = get_preferred_gettext () in let open (val l) in let interactivity = div ~a:[ a_id "interactivity" ] [ script_with_lang ~lang "tool_js_fingerprint.js" ] in let content = [ interactivity ] in base ~title:(s_ "Compute fingerprint") ~content () let set_email () = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:set_email_post (fun name -> [ div [ txt (s_ "There is no e-mail address attached to your account."); txt " "; txt (s_ "Please provide one:"); txt " "; input ~input_type:`Text ~name string; ]; div [ input ~input_type:`Submit ~value:(s_ "Proceed") string ]; ]) () in let content = [ form ] in let title = s_ "Your e-mail address" in base ~title ~content () let set_email_confirm ~address = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:set_email_confirm (fun name -> [ div [ txt (Printf.sprintf (f_ "An e-mail with a code has been sent to %s.") address); txt " "; txt (s_ "Please enter the code here:"); txt " "; input ~input_type:`Text ~name string; ]; div [ input ~input_type:`Submit ~value:(s_ "Proceed") string ]; ]) () in let content = [ form ] in let title = s_ "Your e-mail address" in base ~title ~content () let sudo () = let* l = get_preferred_gettext () in let open (val l) in let form = post_form ~service:sudo_post (fun (ndomain, nuser) -> [ div [ txt "Domain: "; input ~input_type:`Text ~name:ndomain string; txt ", user: "; input ~input_type:`Text ~name:nuser string; ]; div [ input ~input_type:`Submit ~value:(s_ "Proceed") string ]; ]) () in let content = [ form ] in let title = s_ "Impersonate a user" in base ~title ~content () let account account = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Account settings" in let content = [ post_form ~service:account_post (fun name -> [ div [ txt (s_ "Name:"); txt " "; input ~input_type:`Text ~name ~value:account.name string; ]; div [ txt (s_ "E-mail address:"); txt " "; txt account.email ]; div [ txt (s_ "Authentication methods:"); txt " "; ul (List.map (fun u -> li [ Printf.ksprintf txt "%s:%s" u.user_domain u.user_name; ]) account.authentications); ]; div [ txt (s_ "Consent date:"); txt " "; txt (match account.consent with | None -> s_ "(none)" | Some t -> Datetime.format t); ]; div [ input ~input_type:`Submit ~value:(s_ "Submit") string ]; ]) (); ] in base ~title ~content () end let mail_confirmation_link l address code = let open (val l : Belenios_ui.I18n.GETTEXT) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (Printf.sprintf (f_ "Dear %s,") address); add_newline b; add_newline b; add_sentence b (s_ "Your e-mail address has been used to create an account on our Belenios \ server."); add_sentence b (s_ "To confirm this creation, please use the following code:"); add_newline b; add_newline b; add_string b " "; add_string b code; add_newline b; add_newline b; add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent to \ this address are no longer valid."); add_newline b; add_newline b; add_sentence b (s_ "Best regards,"); add_newline b; add_newline b; add_string b "-- "; add_newline b; add_string b (s_ "Belenios Server"); let body = contents b in let subject = s_ "Belenios account creation" in (subject, body) let mail_changepw_link l address code = let open (val l : Belenios_ui.I18n.GETTEXT) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (Printf.sprintf (f_ "Dear %s,") address); add_newline b; add_newline b; add_sentence b (s_ "There has been a request to change the password of your account on our \ Belenios server."); add_sentence b (s_ "To confirm this, please use the following code:"); add_newline b; add_newline b; add_string b " "; add_string b code; add_newline b; add_newline b; add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent to \ this address are no longer valid."); add_newline b; add_newline b; add_sentence b (s_ "Best regards,"); add_newline b; add_newline b; add_string b "-- "; add_newline b; add_string b (s_ "Belenios Server"); let body = contents b in let subject = s_ "Belenios password change" in (subject, body) let mail_set_email l address code = let open (val l : Belenios_ui.I18n.GETTEXT) in let open Belenios_ui.Mail_formatter in let b = create () in add_sentence b (Printf.sprintf (f_ "Dear %s,") address); add_newline b; add_newline b; add_sentence b (s_ "Someone is trying to associate your e-mail address to an account on \ our Belenios server."); add_sentence b (s_ "To confirm this, please use the following code:"); add_newline b; add_newline b; add_string b " "; add_string b code; add_newline b; add_newline b; add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent to \ this address are no longer valid."); add_newline b; add_newline b; add_sentence b (s_ "Best regards,"); add_newline b; add_newline b; add_string b "-- "; add_newline b; add_string b (s_ "Belenios Server"); let body = contents b in let subject = s_ "Belenios account e-mail address change" in (subject, body) belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_eliom.mli0000644000175000017500000000303714476041226022704 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make () : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_voter.mli0000644000175000017500000000327014476041226023263 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_state : Web_state_sig.S) (Web_i18n : Web_i18n_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) : Pages_voter_sig.S belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_admin.mli0000644000175000017500000000403114476041226023210 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_state : Web_state_sig.S) (Web_i18n : Web_i18n_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Mails_admin : Belenios_ui.Mails_admin_sig.S) : Pages_admin_sig.S val mail_confirmation_link : (module Belenios_ui.I18n.GETTEXT) -> string -> string -> string * string val mail_changepw_link : (module Belenios_ui.I18n.GETTEXT) -> string -> string -> string * string val mail_set_email : (module Belenios_ui.I18n.GETTEXT) -> string -> string -> string * string belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_password.ml0000644000175000017500000001762614476041226024326 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_platform open Belenios_core.Common open Web_serializable_j open Platform open Web_common let does_allow_signups c = match List.assoc_opt "allowsignups" c with | Some x -> bool_of_string x | None -> false module Channel = struct type t = { uuid : uuid option; name : string } let equal = Stdlib.( = ) let hash = Hashtbl.hash end module Throttle = Lwt_throttle.Make (Channel) module Make (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Web_auth : Web_auth_sig.S) = struct let throttle = Throttle.create ~rate:1 ~max:5 ~n:!Web_config.maxmailsatonce let check uuid a name password = let channel = Channel.{ uuid; name } in let* b = Throttle.wait throttle channel in if b then match uuid with | None -> ( match List.assoc_opt "db" a.auth_config with | Some db -> check_password_with_file ~db ~name_or_email:name ~password | _ -> failwith "invalid configuration for admin site") | Some uuid -> Web_persist.check_password uuid ~user:name ~password else Lwt.return_none let auth_system uuid a = let module X = struct let pre_login_handler username_or_address ~state = let allowsignups = does_allow_signups a.auth_config in let site_or_election = match uuid with None -> `Site | Some _ -> `Election in let service = a.auth_instance in Pages_common.login_password site_or_election username_or_address ~service ~allowsignups ~state >>= fun x -> return @@ Web_auth_sig.Html x let direct x = let fail () = failwith "invalid direct password authentication" in match x with | `Assoc x -> ( match (List.assoc_opt "username" x, List.assoc_opt "password" x) with | Some (`String username), Some (`String password) -> ( let* x = check uuid a username password in match x with | Some (username, _) -> Lwt.return username | None -> fail ()) | _ -> fail ()) | _ -> fail () end in (module X : Web_auth_sig.AUTH_SYSTEM) let run_post_login_handler = Web_auth.register ~auth_system:"password" auth_system let password_handler () (state, (name, password)) = run_post_login_handler ~state { Web_auth.post_login_handler = (fun uuid a cont -> let* ok = check uuid a name password in cont ok); } let () = Eliom_registration.Any.register ~service:Web_services.password_post password_handler end let get_password_db_fname service = let rec find = function | [] -> None | { auth_system = "password"; auth_config = c; auth_instance = i } :: _ when i = service && does_allow_signups c -> List.assoc_opt "db" c | _ :: xs -> find xs in find !Web_config.site_auth_config let password_db_mutex = Lwt_mutex.create () let do_add_account ~db_fname ~username ~password ~email () = let username_ = String.lowercase_ascii username in let email_ = String.lowercase_ascii email in let* db = Lwt_preemptive.detach Csv.load db_fname in let salt = generate_token ~length:8 () in let hashed = sha256_hex (salt ^ password) in let rec append accu = function | [] -> Ok (List.rev ([ username; salt; hashed; email ] :: accu)) | (u :: _ :: _ :: _) :: _ when String.lowercase_ascii u = username_ -> Error UsernameTaken | (_ :: _ :: _ :: e :: _) :: _ when String.lowercase_ascii e = email_ -> Error AddressTaken | x :: xs -> append (x :: accu) xs in match append [] db with | Error _ as x -> Lwt.return x | Ok db -> let db = List.map (String.concat ",") db in let* () = Filesystem.write_file db_fname db in Lwt.return (Ok ()) let do_change_password ~db_fname ~username ~password () = let username = String.lowercase_ascii username in let* db = Lwt_preemptive.detach Csv.load db_fname in let salt = generate_token ~length:8 () in let hashed = sha256_hex (salt ^ password) in let rec change accu = function | [] -> accu | (u :: _ :: _ :: x) :: xs when String.lowercase_ascii u = username -> change ((u :: salt :: hashed :: x) :: accu) xs | x :: xs -> change (x :: accu) xs in let db = List.rev_map (String.concat ",") (change [] db) in let* () = Filesystem.write_file db_fname db in return_unit let add_account user ~password ~email = if String.trim password = password then if is_username user.user_name then let* c = Web_signup.check_password password in match c with | Some e -> return (Error (BadPassword e)) | None -> ( match get_password_db_fname user.user_domain with | None -> Lwt.fail (Failure (Printf.sprintf "add_account: unknown domain: %s" user.user_domain)) | Some db_fname -> Lwt_mutex.with_lock password_db_mutex (do_add_account ~db_fname ~username:user.user_name ~password ~email)) else return (Error BadUsername) else return (Error BadSpaceInPassword) let change_password user ~password = if String.trim password = password then let* c = Web_signup.check_password password in match c with | Some e -> return (Error (BadPassword e)) | None -> ( match get_password_db_fname user.user_domain with | None -> Lwt.fail (Failure (Printf.sprintf "change_password: unknown domain: %s" user.user_domain)) | Some db_fname -> let* () = Lwt_mutex.with_lock password_db_mutex (do_change_password ~db_fname ~username:user.user_name ~password) in return (Ok ())) else return (Error BadSpaceInPassword) let lookup_account ~service ~username ~email = let username = String.trim username |> String.lowercase_ascii in let email = email |> String.lowercase_ascii in let&* db = get_password_db_fname service in let* db = Lwt_preemptive.detach Csv.load db in match List.find_opt (function | u :: _ :: _ :: _ when String.lowercase_ascii u = username -> true | _ :: _ :: _ :: e :: _ when String.lowercase_ascii e = email -> true | _ -> false) db with | Some (u :: _ :: _ :: e :: _) when is_email e -> return_some (u, e) | _ -> return_none belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_common.mli0000644000175000017500000001370314476041226023074 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_core open Signatures open Serializable_t open Web_serializable_t val ( let&* ) : 'a option -> ('a -> 'b option Lwt.t) -> 'b option Lwt.t val ( !! ) : string -> string val ( /// ) : uuid -> string -> string module Datetime = Web_types.Datetime module Period = Web_types.Period module Random : RANDOM type error = ElectionClosed | UnauthorizedVoter | CastError of cast_error exception BeleniosWebError of error val fail : error -> 'a Lwt.t val explain_error : (module Belenios_ui.I18n.GETTEXT) -> error -> string val format_period : (module Belenios_ui.I18n.GETTEXT) -> Period.t -> string val open_security_log : string -> unit Lwt.t (** Set the path to the security logger. *) val security_log : (unit -> string) -> unit Lwt.t (** Add an entry to the security log. *) val fail_http : Cohttp.Code.status -> 'a Lwt.t val rewrite_prefix : string -> string val set_rewrite_prefix : src:string -> dst:string -> unit val get_election_home_url : uuid -> string type election_file = | ESArchive of uuid | ESRaw | ESVoters | ESRecords | ESETally | ESResult val election_file_of_string : string -> election_file val string_of_election_file : election_file -> string val election_file : string -> ( election_file, [ `WithoutSuffix ], [ `One of election_file ] Eliom_parameter.param_name ) Eliom_parameter.params_type val uuid : string -> ( uuid, [ `WithoutSuffix ], [ `One of uuid ] Eliom_parameter.param_name ) Eliom_parameter.params_type type site_cont_path = ContSiteHome | ContSiteAdmin | ContSiteElection of uuid type site_cont_admin = Classic | Basic | New type site_cont = { path : site_cont_path; admin : site_cont_admin } val default_admin : site_cont_path -> site_cont val string_of_site_cont : site_cont -> string val site_cont : string -> ( site_cont, [ `WithoutSuffix ], [ `One of site_cont ] Eliom_parameter.param_name ) Eliom_parameter.params_type type privacy_cont = ContAdmin | ContSignup of string val string_of_privacy_cont : privacy_cont -> string val privacy_cont : string -> ( privacy_cont, [ `WithoutSuffix ], [ `One of privacy_cont ] Eliom_parameter.param_name ) Eliom_parameter.params_type type captcha_error = BadCaptcha | BadAddress type add_account_error = | UsernameTaken | AddressTaken | BadUsername | BadPassword of string | PasswordMismatch | BadSpaceInPassword val generate_token : ?length:int -> unit -> string val generate_numeric : ?length:int -> unit -> string val format_password : string -> string val string_of_user : user -> string type mail_kind = | MailCredential of uuid | MailPassword of uuid | MailConfirmation of uuid | MailAutomaticWarning of uuid | MailAccountCreation | MailPasswordChange | MailLogin | MailSetEmail val send_email : mail_kind -> recipient:string -> subject:string -> body:string -> unit Lwt.t val get_languages : string list option -> string list val string_of_languages : string list option -> string val languages_of_string : string -> string list val urlize : string -> string val unurlize : string -> string val markup : string -> [> Html_types.span ] Eliom_content.Html.elt val webize_trustee_public_key : 'a trustee_public_key -> 'a web_trustee_public_key val unwebize_trustee_public_key : 'a web_trustee_public_key -> 'a trustee_public_key val get_suitable_group_kind : template -> [ `H | `NH ] val is_group_fixed : draft_election -> bool val get_booth_index : int option -> int option val compute_hash_link : service: ( unit, unit, Eliom_service.get, 'a, 'b, 'c, 'd, [ `WithoutSuffix ], 'e, unit, 'f ) Eliom_service.t -> uuid:uuid -> token:string -> string type credential_record = { cr_ballot : string option; cr_weight : weight; cr_username : string option; } val check_password_with_file : db:string -> name_or_email:string -> password:string -> (string * string) option Lwt.t val has_explicit_weights : draft_voter list -> bool val default_contact : string val default_questions : question array val default_name : string val default_description : string val default_creation_date : datetime val default_validation_date : datetime val default_tally_date : datetime val default_archive_date : datetime val days_to_archive : int val days_to_delete : int val days_to_mail : int val days_between_mails : int val days_to_publish_result : int val max_election_name_size : int val max_total_weight : int val supported_booth_versions : int list belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_eliom.ml0000644000175000017500000001122414476041226022530 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core open Common open Belenios_api.Serializable_j open Api_generic let ( let& ) = Option.bind module Make () = struct let dispatch endpoint method_ _params body = let sp = Eliom_common.get_sp () in let token = let& x = Ocsigen_request.header sp.Eliom_common.sp_request.request_info (Ocsigen_header.Name.of_string "Authorization") in String.drop_prefix ~prefix:"Bearer " x in let ifmatch = Ocsigen_request.header sp.Eliom_common.sp_request.request_info (Ocsigen_header.Name.of_string "If-Match") in let body = { run = (fun of_string f -> let@ _, body = Option.unwrap bad_request body in let* x = Cohttp_lwt.Body.to_string body in let@ x = Option.unwrap bad_request (Option.wrap of_string x) in f x); } in let* code, response = match endpoint with | [ "configuration" ] -> ( match method_ with | `GET -> let x = Api_generic.get_configuration () in Lwt.return (200, string_of_configuration x) | _ -> method_not_allowed) | [ "account" ] -> ( let@ token = Option.unwrap unauthorized token in let@ account = Option.unwrap unauthorized (lookup_token token) in let get () = let x = Api_generic.get_account account in Lwt.return @@ string_of_api_account x in match method_ with | `GET -> handle_get get | `PUT -> let@ () = handle_ifmatch ifmatch get in let@ x = body.run api_account_of_string in let@ () = handle_generic_error in let* () = Api_generic.put_account account x in ok | _ -> method_not_allowed) | "drafts" :: endpoint -> Api_drafts.dispatch ~token ~ifmatch endpoint method_ body | "elections" :: endpoint -> Api_elections.dispatch ~token ~ifmatch endpoint method_ body | _ -> not_found in Eliom_registration.String.send ~code (response, "application/json") open Eliom_service open Eliom_parameter let api_get = create ~path:(Path [ "api" ]) ~meth:(Get (suffix_prod (all_suffix "endpoint") any)) () let api_post = create ~path:(Path [ "api" ]) ~meth:(Post (suffix_prod (all_suffix "endpoint") any, raw_post_data)) () let api_put = create ~path:(Path [ "api" ]) ~meth:(Put (suffix_prod (all_suffix "endpoint") any)) () let api_delete = create ~path:(Path [ "api" ]) ~meth:(Delete (suffix_prod (all_suffix "endpoint") any)) () open Eliom_registration.Any let () = register ~service:api_get (fun (endpoint, params) () -> dispatch endpoint `GET params None) let () = register ~service:api_post (fun (endpoint, params) x -> dispatch endpoint `POST params (Some x)) let () = register ~service:api_put (fun (endpoint, params) x -> dispatch endpoint `PUT params (Some x)) let () = register ~service:api_delete (fun (endpoint, params) x -> dispatch endpoint `DELETE params (Some x)) end belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_common_sig.mli0000644000175000017500000001356014476041226024261 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type S = sig val direct_a : ?target:string -> string -> string -> [> [> Html_types.txt ] Html_types.a ] Eliom_content.Html.elt val raw_a : service: ( 'a, unit, Eliom_service.get, 'b, 'c, 'd, 'e, [< `WithSuffix | `WithoutSuffix ], 'f, unit, 'g ) Eliom_service.t -> ?a:[< Html_types.a_attrib > `Href ] Eliom_content.Html.attrib list -> 'h Eliom_content.Html.elt list -> 'a -> [> 'h Html_types.a ] Eliom_content.Html.elt val make_a_with_hash : service: ( unit, unit, Eliom_service.get, 'a, 'b, 'c, 'd, [< `WithSuffix | `WithoutSuffix ], 'e, unit, 'f ) Eliom_service.t -> ?hash:string -> ?style:string -> string -> [> [> Html_types.txt ] Html_types.a ] Eliom_content.Html.elt val a_mailto : ?dest:string -> subject:string -> body:string -> string -> [> [> Html_types.txt ] Html_types.a ] Eliom_content.Html.elt val raw_textarea : ?rows:int -> ?cols:int -> string -> string -> [> `Textarea ] Eliom_content.Html.elt val static : string -> Eliom_content.Xml.uri val read_snippet : ?default:([> Html_types.div_content_fun ] as 'a) Eliom_content.Html.elt -> lang:string -> string option -> 'a Eliom_content.Html.elt Lwt.t val base : title:string -> ?full_title:string -> ?login_box: [< Html_types.div_content_fun > `Div `PCDATA ] Eliom_content.Html.elt -> ?lang_box:[< Html_types.div_content_fun > `Div ] Eliom_content.Html.elt -> content:[< Html_types.div_content_fun ] Eliom_content.Html.elt list -> ?footer: [< Html_types.div_content_fun > `A `Div `PCDATA ] Eliom_content.Html.elt -> ?uuid:Web_serializable_t.uuid -> ?static:bool -> unit -> [> Html_types.html ] Eliom_content.Html.elt Lwt.t val lang_box : Web_common.site_cont_path -> [> Html_types.div ] Eliom_content.Html.elt Lwt.t val generic_page : title:string -> ?service: ( unit, unit, Eliom_service.get, 'a, 'b, 'c, 'd, [< `WithSuffix | `WithoutSuffix ], 'e, unit, Eliom_service.non_ocaml ) Eliom_service.t -> string -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val login_title : [ `Site | `Election ] -> string -> string Lwt.t val login_choose : string list -> (string -> ( unit, unit, Eliom_service.get, 'a, 'b, 'c, 'd, [< `WithSuffix | `WithoutSuffix ], 'e, unit, Eliom_service.non_ocaml ) Eliom_service.t) -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val login_dummy : [ `Site | `Election ] -> [ `Username | `Address ] -> state:string -> [> Html_types.div ] Eliom_content.Html.F.elt Lwt.t val login_email : [ `Site | `Election ] -> [ `Username | `Address ] -> state:string -> [> Html_types.div ] Eliom_content.Html.F.elt Lwt.t val login_password : [ `Site | `Election ] -> [ `Username | `Address ] -> service:string -> allowsignups:bool -> state:string -> [> Html_types.div ] Eliom_content.Html.F.elt Lwt.t val login_failed : service: ( unit, unit, Eliom_service.get, 'a, 'b, 'c, 'd, [< `WithSuffix | `WithoutSuffix ], 'e, unit, Eliom_service.non_ocaml ) Eliom_service.t -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val email_login : ?address:string -> [ `Site | `Election ] -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val email_email : address:string -> code:string -> (string * string) Lwt.t val signup_captcha_img : string -> [> Html_types.img ] Eliom_content.Html.elt val format_captcha_error : (module Belenios_ui.I18n.GETTEXT) -> Web_common.captcha_error option -> [> `Div | `PCDATA ] Eliom_content.Html.elt val login_email_captcha : state:string -> Web_common.captcha_error option -> string -> string -> [> Html_types.div ] Eliom_content.Html.elt Lwt.t val login_email_not_now : unit -> [> Html_types.div ] Eliom_content.Html.elt Lwt.t val authentication_impossible : unit -> [> Html_types.html ] Eliom_content.Html.F.elt Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_services_sig.mli0000644000175000017500000013731114476041226024273 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type S = sig val uuid_and_token : ( Web_serializable_t.uuid * string, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name ) Eliom_service.params val home : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val admin : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val admin_basic : unit -> ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.non_reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val admin_new : unit -> ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.non_reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val privacy_notice_accept : ( unit, Web_common.privacy_cont, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of Web_common.privacy_cont ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val site_login : ( string option * Web_common.site_cont, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name * [ `One of Web_common.site_cont ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val logout : ( Web_common.site_cont, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_common.site_cont ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val source_code : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val logo : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val favicon : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val sealing : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_new : ( unit, string option * (string option * string option), Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `Radio of string ] Eliom_parameter.param_name * ([ `Radio of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name), Eliom_service.non_ocaml ) Eliom_service.t val election_draft_pre : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_questions : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_questions_post : ( Web_serializable_t.uuid, string * int, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * [ `One of int ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_preview : ( Web_serializable_t.uuid * unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_description : ( Web_serializable_t.uuid, string * string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_languages : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_contact : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_admin_name : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_voters : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_voters_add : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_voters_remove : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_voters_remove_all : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_voters_passwd : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_trustee_add : ( Web_serializable_t.uuid, string * string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_trustee_del : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credential_authority : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_set_credential_authority : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credentials : ( Web_serializable_t.uuid * string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credentials_static : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credentials_post : ( Web_serializable_t.uuid * string, string, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credentials_post_file : ( Web_serializable_t.uuid * string, Ocsigen_multipart.file_info, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, [ `One of Ocsigen_multipart.file_info ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credentials_server : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_credentials_get : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_trustees : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_trustee : ( Web_serializable_t.uuid * string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_trustee_static : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_trustee_post : ( Web_serializable_t.uuid * string, string, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_trustees : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_trustee : ( Web_serializable_t.uuid * string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_trustee_static : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_trustee_post : ( Web_serializable_t.uuid * string, string, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_set : ( Web_serializable_t.uuid, int, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of int ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_trustee_add : ( Web_serializable_t.uuid, string * string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_threshold_trustee_del : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_confirm : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_create : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_destroy : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_auth_genpwd : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_import : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_import_post : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_import_trustees : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_draft_import_trustees_post : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_home_dir : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_home : ( Web_serializable_t.uuid * unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val set_cookie_disclaimer : ( Web_common.site_cont, unit, Eliom_service.get, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_common.site_cont ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_admin : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_regenpwd : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_regenpwd_post : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_login : ( (Web_serializable_t.uuid * unit) * string option, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], ([ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name) * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_open : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_close : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_hide_result : ( Web_serializable_t.uuid, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_show_result : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_auto_post : ( Web_serializable_t.uuid, string * string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_delete : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val booth_v2 : unit -> ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.non_reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t type booth = | Booth : (unit -> ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, 'reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t) -> booth val booths : (booth * string) array val election_cast : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_submit_ballot : ( unit, string, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_submit_ballot_file : ( unit, Ocsigen_multipart.file_info, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of Ocsigen_multipart.file_info ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_submit_ballot_check : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_cast_confirm : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_pretty_ballots : ( Web_serializable_t.uuid * unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_pretty_ballot : ( (Web_serializable_t.uuid * unit) * string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], ([ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name) * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_pretty_records : ( Web_serializable_t.uuid * unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_project_result : ( (Web_serializable_t.uuid * unit) * int, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], ([ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name) * [ `One of int ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_missing_voters : ( Web_serializable_t.uuid * unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_download_archive : ( Web_serializable_t.uuid * unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of unit ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_compute_encrypted_tally : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_nh_ciphertexts : ( Web_serializable_t.uuid, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_shuffle_link : ( Web_serializable_t.uuid * string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_shuffle_link_static : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_shuffle_post : ( Web_serializable_t.uuid * string, string, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_shuffler_select : ( unit, Web_serializable_t.uuid * string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_shuffler_skip_confirm : ( unit, Web_serializable_t.uuid * string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_shuffler_skip : ( unit, Web_serializable_t.uuid * string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_decrypt : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_tally_trustees : ( Web_serializable_t.uuid * string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_tally_trustees_static : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_tally_trustees_post : ( Web_serializable_t.uuid * string, string, Eliom_service.post, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val election_tally_release : ( Web_serializable_t.uuid, unit, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val election_dir : ( Web_serializable_t.uuid * Web_common.election_file, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of Web_common.election_file ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val dummy_post : ( unit, string * string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val email_post : ( unit, string * string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val email_election_login : ( unit, unit, Eliom_service.get, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val email_captcha_post : ( unit, string * (string * (string * string)), Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name)), Eliom_service.non_ocaml ) Eliom_service.t val email_login_post : ( unit, string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val password_post : ( unit, string * (string * string), Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name), Eliom_service.non_ocaml ) Eliom_service.t val set_language : ( string * Web_common.site_cont, unit, Eliom_service.get, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name * [ `One of Web_common.site_cont ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val signup_captcha : ( string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val signup_captcha_post : ( string, string * (string * string), Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name), Eliom_service.non_ocaml ) Eliom_service.t val signup_captcha_img : ( string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val signup_login_post : ( unit, string, Eliom_service.post, Eliom_service.non_att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val signup : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val signup_post : ( unit, string * (string * string), Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name), Eliom_service.non_ocaml ) Eliom_service.t val changepw_captcha : ( string, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val changepw_captcha_post : ( string, string * (string * (string * string)), Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name, [ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name)), Eliom_service.non_ocaml ) Eliom_service.t val changepw_post : ( unit, string * string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val method_schulze : ( Web_serializable_t.uuid * int, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * [ `One of int ] Eliom_parameter.param_name, unit, Eliom_service.non_ocaml ) Eliom_service.t val method_mj : ( Web_serializable_t.uuid * (int * int option), unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * ([ `One of int ] Eliom_parameter.param_name * [ `One of int ] Eliom_parameter.param_name), unit, Eliom_service.non_ocaml ) Eliom_service.t val method_stv : ( Web_serializable_t.uuid * (int * int option), unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], [ `One of Web_serializable_t.uuid ] Eliom_parameter.param_name * ([ `One of int ] Eliom_parameter.param_name * [ `One of int ] Eliom_parameter.param_name), unit, Eliom_service.non_ocaml ) Eliom_service.t val compute_fingerprint : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val set_email_post : ( unit, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val set_email_confirm : ( unit, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val sudo : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val sudo_post : ( unit, string * string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val account : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t val account_post : ( unit, string, Eliom_service.post, Eliom_service.att, Eliom_service.co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, [ `One of string ] Eliom_parameter.param_name, Eliom_service.non_ocaml ) Eliom_service.t val api_token : ( unit, unit, Eliom_service.get, Eliom_service.att, Eliom_service.non_co, Eliom_service.non_ext, Eliom_service.reg, [ `WithoutSuffix ], unit, unit, Eliom_service.non_ocaml ) Eliom_service.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_common_sig.mli0000644000175000017500000000454114476041226024125 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type ELECTION = Belenios_core.Signatures.ELECTION module type S = sig val find_election : Web_serializable_t.uuid -> (module ELECTION) option Lwt.t val election_not_found : unit -> Eliom_registration.Html.result Lwt.t val with_election : Web_serializable_t.uuid -> ((module ELECTION) -> Eliom_registration.Html.result Lwt.t) -> Eliom_registration.Html.result Lwt.t val redir_preapply : ( 'a, unit, Eliom_service.get, Eliom_service.att, 'b, 'c, 'd, [< `WithSuffix | `WithoutSuffix ], 'e, unit, 'f ) Eliom_service.t -> 'a -> unit -> 'g Eliom_registration.kind Lwt.t val wrap_handler : (unit -> Eliom_registration.Html.result Lwt.t) -> Eliom_registration.Html.result Lwt.t val forbidden : unit -> Eliom_registration.Html.result Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_captcha.mli0000644000175000017500000000360014476041226023202 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) val create_captcha : unit -> string Lwt.t (** Returns a challenge string, used to identify the captcha in following functions. *) val get_captcha : challenge:string -> (string * string) Lwt.t (** Returns the image associated to a challenge. *) val check_captcha : challenge:string -> response:string -> bool Lwt.t module Make (Web_services : Web_services_sig.S) : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_types.ml0000644000175000017500000000553414476041226022602 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Datetime = struct open CalendarLib let datetime_format = "%Y-%m-%d %H:%M:%S" type t = Calendar.Precise.t let now () = Calendar.Precise.now () let unwrap n = let n = Calendar.Precise.to_gmt n in Printer.Precise_Calendar.sprint datetime_format n let wrap s = match String.index_opt s '.' with | None -> let l = Printer.Precise_Calendar.from_fstring datetime_format s in Calendar.Precise.from_gmt l | Some i -> let l = Printer.Precise_Calendar.from_fstring datetime_format (String.sub s 0 i) in let l = Calendar.Precise.from_gmt l in let r = float_of_string ("0" ^ String.sub s i (String.length s - i)) in let r = int_of_float (Float.round r) in Calendar.Precise.add l (Calendar.Precise.Period.second r) let compare = Calendar.Precise.compare let format ?(fmt = datetime_format) a = Printer.Precise_Calendar.sprint fmt a let to_unixfloat a = Calendar.Precise.to_unixfloat a |> Float.round let from_unixfloat t = Calendar.Precise.from_unixfloat t end module Period = struct open CalendarLib type t = Calendar.Precise.Period.t let day = Calendar.Precise.Period.day let second = Calendar.Precise.Period.second let add = Calendar.Precise.add let sub = Calendar.Precise.sub let ymds = Calendar.Precise.Period.ymds end belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_generic.mli0000644000175000017500000000466614476041226023224 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_serializable_t open Belenios_api.Serializable_t val new_token : account -> string Lwt.t val lookup_token : string -> account option val invalidate_token : string -> unit exception Error of error type result = int * string type body = { run : 'a. (string -> 'a) -> ('a -> result Lwt.t) -> result Lwt.t } val ok : result Lwt.t val bad_request : result Lwt.t val unauthorized : result Lwt.t val forbidden : result Lwt.t val not_found : result Lwt.t val method_not_allowed : result Lwt.t val handle_ifmatch : string option -> (unit -> string Lwt.t) -> (unit -> result Lwt.t) -> result Lwt.t val handle_generic_error : (unit -> result Lwt.t) -> result Lwt.t val handle_get : (unit -> string Lwt.t) -> result Lwt.t val handle_get_option : (unit -> string option Lwt.t) -> result Lwt.t val get_configuration : unit -> configuration val get_account : account -> api_account val put_account : account -> api_account -> unit Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/otp.ml0000644000175000017500000000617214476041226021402 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common open Web_common module type SENDER = sig type payload type context val send : context:context -> address:string -> code:string -> unit Lwt.t end module type S = sig type payload type context val generate : context:context -> address:string -> payload:payload -> unit Lwt.t val check : address:string -> code:string -> payload option end module Make (I : SENDER) () = struct type payload = I.payload type context = I.context type code = { code : string; payload : payload; expiration_time : Datetime.t; mutable trials_left : int; } let codes = ref SMap.empty let filter_codes_by_time now table = SMap.filter (fun _ { expiration_time; _ } -> Datetime.compare now expiration_time <= 0) table let generate ~context ~address ~payload = let now = Datetime.now () in let codes_ = filter_codes_by_time now !codes in let code = generate_numeric () in let expiration_time = Period.add now (Period.second 900) in codes := SMap.add address { code; payload; expiration_time; trials_left = 10 } codes_; I.send ~context ~address ~code let check ~address ~code = let now = Datetime.now () in let codes_ = filter_codes_by_time now !codes in codes := codes_; match SMap.find_opt address codes_ with | None -> None | Some x -> if x.code = code then ( codes := SMap.remove address codes_; Some x.payload) else ( if x.trials_left > 0 then x.trials_left <- x.trials_left - 1 else codes := SMap.remove address codes_; None) end belenios-2.2-10-gbb6b7ea8/src/web/server/common/spool.ml0000644000175000017500000001165114476041226021732 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core.Serializable_j open Web_serializable_j open Web_common type 'a file = { of_string : string -> 'a; to_string : 'a -> string; filename : string; } type 'a abstract = { get : uuid -> 'a option Lwt.t; set : uuid -> 'a -> unit Lwt.t; del : uuid -> unit Lwt.t; } type 'a t = File of 'a file | Abstract of 'a abstract let get ~uuid file = match file with | File file -> ( let* x = Filesystem.read_file_single_line ~uuid file.filename in let&* x = x in try Lwt.return_some (file.of_string x) with _ -> Lwt.return_none) | Abstract a -> a.get uuid let set ~uuid file x = match file with | File file -> Filesystem.write_file ~uuid file.filename [ file.to_string x ] | Abstract a -> a.set uuid x let del ~uuid file = match file with | File file -> Filesystem.cleanup_file (uuid /// file.filename) | Abstract a -> a.del uuid let make_file x = File x let draft = { of_string = draft_election_of_string; to_string = string_of_draft_election; filename = "draft.json"; } |> make_file let draft_public_credentials = let filename = "public_creds.json" in let get uuid = Filesystem.read_whole_file ~uuid filename in let set uuid x = Filesystem.write_file ~uuid filename [ x ] in let del uuid = Filesystem.cleanup_file (uuid /// filename) in Abstract { get; set; del } let draft_private_credentials = let filename = "private_creds.txt" in let get uuid = Filesystem.read_whole_file ~uuid filename in let set uuid x = Filesystem.write_whole_file ~uuid filename x in let del uuid = Filesystem.cleanup_file (uuid /// filename) in Abstract { get; set; del } let hide_result = { of_string = datetime_of_string; to_string = string_of_datetime; filename = "hide_result"; } |> make_file let dates = { of_string = election_dates_of_string; to_string = string_of_election_dates; filename = "dates.json"; } |> make_file let state = { of_string = election_state_of_string; to_string = string_of_election_state; filename = "state.json"; } |> make_file let decryption_tokens = { of_string = decryption_tokens_of_string; to_string = string_of_decryption_tokens; filename = "decryption_tokens.json"; } |> make_file let metadata = { of_string = metadata_of_string; to_string = string_of_metadata; filename = "metadata.json"; } |> make_file let private_key = { of_string = number_of_string; to_string = string_of_number; filename = "private_key.json"; } |> make_file let private_keys = let filename = "private_keys.jsons" in let get uuid = Filesystem.read_file ~uuid filename in let set uuid x = Filesystem.write_file ~uuid filename x in let del uuid = Filesystem.cleanup_file (uuid /// filename) in Abstract { get; set; del } let skipped_shufflers = { of_string = skipped_shufflers_of_string; to_string = string_of_skipped_shufflers; filename = "skipped_shufflers.json"; } |> make_file let shuffle_token = { of_string = shuffle_token_of_string; to_string = string_of_shuffle_token; filename = "shuffle_token.json"; } |> make_file let audit_cache = { of_string = audit_cache_of_string; to_string = string_of_audit_cache; filename = "audit_cache.json"; } |> make_file let last_event = { of_string = last_event_of_string; to_string = string_of_last_event; filename = "last_event.json"; } |> make_file belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_admin_sig.mli0000644000175000017500000001320514476041226024055 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_api.Serializable_t open Web_serializable_t open Web_common module type S = sig val privacy_notice : privacy_cont -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val admin_login : (string -> Web_auth_sig.result Lwt.t) -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val admin : elections: (uuid * string) list * (uuid * string) list * (uuid * string) list * (uuid * string) list -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_pre : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft : uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_voters : uuid -> draft_election -> int -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_questions : uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_credential_authority : uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_credentials_done : draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_credentials_already_generated : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_credentials_static : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_trustees : ?token:string -> uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_threshold_trustees : ?token:string -> uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_trustee_static : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_threshold_trustee_static : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_import : uuid -> draft_election -> (uuid * string) list * (uuid * string) list * (uuid * string) list -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_import_trustees : uuid -> draft_election -> (uuid * string) list * (uuid * string) list * (uuid * string) list -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_draft_confirm : uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_admin : ?shuffle_token:string -> ?tally_token:string -> (module Site_common_sig.ELECTION) -> Web_serializable_j.metadata -> election_status -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val regenpwd : uuid -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val pretty_records : (module Site_common_sig.ELECTION) -> records -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val election_shuffler_skip_confirm : uuid -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val shuffle_static : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val tally_trustees_static : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val signup_captcha : service:string -> captcha_error option -> string -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val signup_changepw : service:string -> captcha_error option -> string -> string -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val signup_login : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val signup : string -> add_account_error option -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val changepw : username:string -> address:string -> add_account_error option -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val compute_fingerprint : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val set_email : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val set_email_confirm : address:string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val sudo : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val account : account -> [> `Html ] Eliom_content.Html.F.elt Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_config.mli0000644000175000017500000000466214476041226023055 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_serializable_t val prefix : string ref val site_auth_config : auth_config list ref val exported_auth_config : [ `BuiltinPassword | `BuiltinCAS | `Export of auth_config ] list ref val locales_dir : string ref val spool_dir : string ref val accounts_dir : string ref val server_name : 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 warning_file : string option ref val footer_file : string option ref val admin_home : string option ref val success_snippet : string option ref val source_file : string ref val logo : (string * string) option ref val favicon : (string * string) option ref val sealing : (string * string) option ref val maxmailsatonce : int ref val uuid_length : int option ref val default_group : string ref val nh_group : string ref val domain : string ref val deny_revote : bool ref val deny_newelection : bool ref belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_oidc.mli0000644000175000017500000000307014476041226023537 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_auth : Web_auth_sig.S) : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/mails_voter.mli0000644000175000017500000000437414476041226023277 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_core.Common open Web_serializable_t val generate_password_email : Web_serializable_t.metadata -> string list -> string -> Web_serializable_t.uuid -> Voter.t -> bool -> (bulk_email * (string * string)) Lwt.t val generate_credential_email : Web_serializable_t.uuid -> Web_serializable_t.draft_election -> recipient:string -> login:string -> weight:Web_serializable_t.weight -> credential:string -> bulk_email Lwt.t val submit_bulk_emails : bulk_email list -> unit Lwt.t val process_bulk_emails : unit -> unit Lwt.t val mail_confirmation : (module Belenios_ui.I18n.GETTEXT) -> string -> string -> Web_serializable_t.weight option -> string -> bool -> string -> string -> string option -> string belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_dummy.mli0000644000175000017500000000321414476041226023754 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Web_auth : Web_auth_sig.S) : sig end belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_admin_sig.mli0000644000175000017500000000311014476041226023714 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type S = sig val data_policy_loop : unit -> 'a Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_drafts.ml0000644000175000017500000012171414476041226022714 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_platform.Platform open Belenios_core.Common open Belenios_core.Serializable_j open Belenios_core.Signatures open Belenios open Belenios_api.Serializable_j open Web_serializable_j open Web_common open Api_generic let with_administrator token se f = let@ token = Option.unwrap unauthorized token in match lookup_token token with | Some a when Accounts.check a se.se_owners -> f a | _ -> not_found let with_administrator_or_credential_authority token se f = let@ token = Option.unwrap unauthorized token in if token = se.se_public_creds then f `CredentialAuthority else match lookup_token token with | Some a when Accounts.check a se.se_owners -> f (`Administrator a) | _ -> not_found let with_administrator_or_nobody token se f = match token with | None -> f `Nobody | Some token -> ( match lookup_token token with | Some a when Accounts.check a se.se_owners -> f (`Administrator a) | _ -> not_found) let with_threshold_trustee token se f = let@ token = Option.unwrap unauthorized token in match se.se_trustees with | `Basic _ -> not_found | `Threshold t -> ( match List.find_opt (fun x -> x.stt_token = token) t.dtp_trustees with | Some x -> f (x, t) | None -> not_found) let get_authentication se = match se.se_metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> `Password | Some [ { auth_system = "cas"; auth_config; _ } ] -> `CAS (List.assoc "server" auth_config) | Some [ { auth_system = "import"; auth_instance; _ } ] -> `Configured auth_instance | _ -> raise (Error (`Invalid "authentication")) let auth_config_of_authentication = function | `Password -> { auth_system = "password"; auth_instance = "password"; auth_config = [] } | `CAS server -> { auth_system = "cas"; auth_instance = "cas"; auth_config = [ ("server", server) ]; } | `Configured auth_instance -> { auth_system = "import"; auth_instance; auth_config = [] } let api_of_draft se = let draft_questions = { se.se_questions with t_credential_authority = Some (Option.value se.se_metadata.e_cred_authority ~default:""); t_administrator = Some (Option.value se.se_administrator ~default:""); } in Lwt.return { draft_version = se.se_version; draft_owners = se.se_owners; draft_questions; draft_languages = Option.value se.se_metadata.e_languages ~default:[]; draft_contact = se.se_metadata.e_contact; draft_booth = Option.value se.se_metadata.e_booth_version ~default:1; draft_authentication = get_authentication se; draft_group = se.se_group; } let assert_ msg b f = if b then f () else raise (Error msg) let draft_of_api a se d = let version = se.se_version in let () = if d.draft_version <> version then raise (Error (`CannotChange "version")) in let@ () = assert_ (`Invalid "booth version") (List.mem d.draft_booth supported_booth_versions) in let@ () = assert_ (`Invalid "languages") (List.length d.draft_languages >= 1) in let@ () = assert_ (`Invalid "owners") (List.mem a.id d.draft_owners) in let e_cred_authority = d.draft_questions.t_credential_authority in let () = let old = se.se_metadata.e_cred_authority in if e_cred_authority <> old then if se.se_public_creds_received && (old = Some "server" || e_cred_authority = Some "server") then raise (Error (`CannotChange "credential authority")) in let se_group = d.draft_group in let () = let old = se.se_group in if se_group <> old then if se.se_public_creds_received then raise (Error (`CannotChange "group")) else try let module G = (val Group.of_string ~version se_group) in () with _ -> raise (Error (`Invalid "group")) in let () = let has_nh_questions = Array.exists (function | Belenios_core.Question.NonHomomorphic _ -> true | _ -> false) d.draft_questions.t_questions in if has_nh_questions then match se_group with | "RFC-3526-2048" | "Ed25519" -> () | _ -> raise (Error (`Invalid "NH group")) in let se_metadata = { se.se_metadata with e_contact = d.draft_contact; e_languages = Some d.draft_languages; e_booth_version = Some d.draft_booth; e_cred_authority; e_auth_config = Some [ auth_config_of_authentication d.draft_authentication ]; } in { se with se_metadata; se_owners = d.draft_owners; se_questions = d.draft_questions; se_administrator = d.draft_questions.t_administrator; se_group; } let generate_uuid () = let length = !Web_config.uuid_length in let token = generate_token ?length () in Lwt.return (Uuid.wrap token) let post_drafts account draft = let@ () = fun cont -> if !Web_config.deny_newelection then Lwt.return_none else Lwt.(cont () >>= return_some) in let owners = [ account.id ] in let* uuid = generate_uuid () in let token = generate_token () in let se_metadata = { e_owners = owners; e_auth_config = None; e_cred_authority = None; e_trustees = None; e_languages = None; e_contact = None; e_booth_version = None; } in let se_questions = { t_description = ""; t_name = ""; t_questions = [||]; t_administrator = None; t_credential_authority = None; } in let se = { se_version = List.hd supported_crypto_versions; se_owners = owners; se_group = !Web_config.default_group; se_voters = []; se_questions; se_trustees = `Basic { dbp_trustees = [] }; se_metadata; se_public_creds = token; se_public_creds_received = false; se_creation_date = Some (Datetime.now ()); se_administrator = None; se_credential_authority_visited = false; se_voter_authentication_visited = false; se_trustees_setup_step = 1; } in let se = draft_of_api account se draft in let* () = Web_persist.create_draft uuid se in Lwt.return uuid let get_draft_voters se = se.se_voters |> List.map (fun x -> x.sv_id) let put_draft_voters uuid se voters = let existing_voters = List.fold_left (fun accu v -> let _, login, _ = Voter.get v.sv_id in SMap.add (String.lowercase_ascii login) v accu) SMap.empty se.se_voters in let se_voters = List.map (fun voter -> if not (Voter.validate voter) then raise @@ Error (`Invalid "identity"); let _, login, _ = Voter.get voter in match SMap.find_opt (String.lowercase_ascii login) existing_voters with | None -> { sv_id = voter; sv_password = None } | Some v -> v.sv_id <- voter; v) voters in let* total_weight, _, _ = Lwt_list.fold_left_s (fun (total_weight, shape, voters) v -> let shape = let shape' = let (typ, { login; weight; _ }) : Voter.t = v.sv_id in match typ with | `Plain -> `Plain (login <> None, weight <> None) | `Json -> `Json in match shape with | Some x when x <> shape' -> raise @@ Error (`Invalid "format mix") | _ -> Some shape' in let _, login, weight = Voter.get v.sv_id in let login = String.lowercase_ascii login in let* voters = if SSet.mem login voters then Lwt.fail @@ Error (`Invalid "duplicate login") else Lwt.return (SSet.add login voters) in Lwt.return (Weight.(total_weight + weight), shape, voters)) (Weight.zero, None, SSet.empty) se_voters in let* () = let expanded = Weight.expand ~total:total_weight total_weight in if Z.compare expanded Weight.max_expanded_weight > 0 then Lwt.fail @@ Error (`GenericError (Printf.sprintf "expanded total weight too big: %s/%s" (Z.to_string expanded) (Z.to_string Weight.max_expanded_weight))) else Lwt.return_unit in let se = { se with se_voters } in Web_persist.set_draft_election uuid se let get_draft_passwords se = se.se_voters |> List.filter_map (fun x -> Option.map (fun _ -> let _, login, _ = Voter.get x.sv_id in login) x.sv_password) let post_draft_passwords generate uuid se voters = let se_voters = List.fold_left (fun accu v -> let _, login, _ = Voter.get v.sv_id in SMap.add (String.lowercase_ascii login) v accu) SMap.empty se.se_voters in let () = if SMap.cardinal se_voters > !Web_config.maxmailsatonce then raise (Error (`ValidationError `TooManyVoters)) in let voters = List.map (fun login -> match SMap.find_opt (String.lowercase_ascii login) se_voters with | None -> raise (Error (`Missing login)) | Some v -> v) voters in let* jobs = Lwt_list.fold_left_s (fun jobs v -> let* job, x = generate se.se_metadata v.sv_id in v.sv_password <- Some x; Lwt.return (job :: jobs)) [] voters in let* () = Web_persist.set_draft_election uuid se in Lwt.return jobs let get_credentials_token se = if se.se_metadata.e_cred_authority = Some "server" then Lwt.return_none else Lwt.return_some se.se_public_creds type generate_credentials_on_server_error = [ `NoVoters | `TooManyVoters | `Already | `NoServer ] module CG = Belenios_core.Credential.MakeGenerate (Random) let generate_credentials_on_server send uuid se = let nvoters = List.length se.se_voters in if nvoters > !Web_config.maxmailsatonce then Lwt.return (Stdlib.Error `TooManyVoters) else if nvoters = 0 then Lwt.return (Stdlib.Error `NoVoters) else if se.se_public_creds_received then Lwt.return (Stdlib.Error `Already) else if se.se_metadata.e_cred_authority <> Some "server" then Lwt.return (Stdlib.Error `NoServer) else let show_weight = has_explicit_weights se.se_voters in let version = se.se_version in let module G = (val Group.of_string ~version se.se_group : GROUP) in let module CMap = Map.Make (G) in let module CD = Belenios_core.Credential.MakeDerive (G) in let* public_creds, private_creds, jobs = Lwt_list.fold_left_s (fun (public_creds, private_creds, jobs) v -> let recipient, login, weight = Voter.get v.sv_id in let credential = CG.generate () in let pub_cred = let x = CD.derive uuid credential in G.(g **~ x) in let* job = send ~recipient ~login ~weight ~credential in Lwt.return ( CMap.add pub_cred (weight, login) public_creds, (login, credential) :: private_creds, job :: jobs )) (CMap.empty, [], []) se.se_voters in let private_creds = List.rev private_creds |> string_of_private_credentials in let* () = Web_persist.set_draft_private_credentials uuid private_creds in let public_creds = CMap.bindings public_creds |> List.map (fun (cred, (weight, login)) -> G.to_string cred ^ (if show_weight then Printf.sprintf ",%s" (Weight.to_string weight) else ",") ^ Printf.sprintf ",%s" login) in let* () = Web_persist.set_draft_public_credentials uuid public_creds in se.se_public_creds_received <- true; let* () = Web_persist.set_draft_election uuid se in Lwt.return (Ok jobs) let exn_of_generate_credentials_on_server_error = function | `NoVoters -> Error (`ValidationError `NoVoters) | `TooManyVoters -> Error (`ValidationError `TooManyVoters) | `Already -> Error (`GenericError "already done") | `NoServer -> Error (`GenericError "credential authority is not the server") let submit_public_credentials uuid se credentials = let () = if se.se_voters = [] then raise (Error (`ValidationError `NoVoters)) in let version = se.se_version in let module G = (val Group.of_string ~version se.se_group : GROUP) in let usernames = List.fold_left (fun accu { sv_id; _ } -> let _, username, weight = Voter.get sv_id in if SMap.mem username accu then raise (Error (`GenericError (Printf.sprintf "duplicate username %s" username))) else SMap.add username (weight, ref false) accu) SMap.empty se.se_voters in let _ = List.fold_left (fun (i, accu) x -> let invalid fmt = Printf.ksprintf (fun x -> raise (Error (`GenericError (Printf.sprintf "invalid %s at index %d" x i)))) fmt in let cred, weight, username = match String.split_on_char ',' x with | [ c; ""; u ] -> (G.of_string c, Weight.one, u) | [ c; w; u ] -> (G.of_string c, Weight.of_string w, u) | _ -> invalid "record" in let cred_s = G.to_string cred in let () = match SMap.find_opt username usernames with | None -> invalid "username %s" username | Some (w, used) -> if !used then invalid "duplicate username %s" username else if Weight.compare w weight <> 0 then invalid "differing weight" else if SSet.mem cred_s accu then invalid "duplicate credential" else if not (G.check cred) then invalid "public credential" else used := true in (i + 1, SSet.add cred_s accu)) (0, SSet.empty) credentials in let* () = Web_persist.set_draft_public_credentials uuid credentials in se.se_public_creds_received <- true; Web_persist.set_draft_election uuid se let get_draft_trustees ~is_admin se = match se.se_trustees with | `Basic x -> let bt_trustees = List.filter_map (fun t -> if t.st_id = "server" then None else let trustee_state, trustee_key = if t.st_public_key = "" then (Some 0, None) else ( Some 1, Some (trustee_public_key_of_string Yojson.Safe.read_json t.st_public_key) ) in let trustee_address, trustee_token, trustee_state = if is_admin then (Some t.st_id, Some t.st_token, trustee_state) else (None, None, None) in Some { trustee_address; trustee_name = Option.value t.st_name ~default:""; trustee_token; trustee_state; trustee_key; }) x.dbp_trustees in `Basic { bt_trustees } | `Threshold x -> let tt_trustees = List.map (fun t -> let trustee_address, trustee_token, trustee_state = if is_admin then ( Some t.stt_id, Some t.stt_token, Some (Option.value t.stt_step ~default:0) ) else (None, None, None) in { trustee_address; trustee_name = Option.value t.stt_name ~default:""; trustee_token; trustee_state; trustee_key = t.stt_cert; }) x.dtp_trustees in `Threshold { tt_threshold = x.dtp_threshold; tt_trustees } let check_address address = if not @@ is_email address then raise (Error (`Invalid "e-mail address")) let ensure_none label x = if x <> None then raise (Error (`GenericError (Printf.sprintf "%s must not be set" label))) let generate_server_trustee se = let st_id = "server" and st_token = "" in let version = se.se_version in let module G = (val Group.of_string ~version se.se_group) in let module Trustees = (val Trustees.get_by_version version) in let module K = Trustees.MakeSimple (G) (Random) in let private_key = K.generate () in let public_key = K.prove private_key in let st_public_key = string_of_trustee_public_key (swrite G.to_string) public_key in let st_private_key = Some private_key in let st_name = Some "server" in Lwt.return { st_id; st_token; st_public_key; st_private_key; st_name } let post_draft_trustees uuid se t = let address = match t.trustee_address with | Some x -> check_address x; x | None -> raise (Error (`Missing "address")) in let () = ensure_none "token" t.trustee_token in let () = ensure_none "state" t.trustee_state in let () = ensure_none "key" t.trustee_key in match se.se_trustees with | `Basic x -> let* ts = let ts = x.dbp_trustees in if List.exists (fun x -> x.st_id = "server") ts then Lwt.return ts else let* server = generate_server_trustee se in Lwt.return (ts @ [ server ]) in let () = if List.exists (fun x -> x.st_id = address) ts then raise (Error (`GenericError "address already used")) in let st_token = generate_token () in let t = { st_id = address; st_name = Some t.trustee_name; st_public_key = ""; st_private_key = None; st_token; } in x.dbp_trustees <- ts @ [ t ]; Web_persist.set_draft_election uuid se | `Threshold x -> let ts = x.dtp_trustees in let () = if List.exists (fun x -> x.stt_id = address) ts then raise (Error (`GenericError "address already used")) in let stt_token = generate_token () in let t = { stt_id = address; stt_name = Some t.trustee_name; stt_token; stt_step = None; stt_cert = None; stt_polynomial = None; stt_vinput = None; stt_voutput = None; } in x.dtp_trustees <- ts @ [ t ]; Web_persist.set_draft_election uuid se let rec filter_out_first f = function | [] -> (false, []) | x :: xs -> if f x then (true, xs) else let touched, xs = filter_out_first f xs in (touched, x :: xs) let delete_draft_trustee uuid se trustee = match se.se_trustees with | `Basic x -> let ts = x.dbp_trustees in let touched, ts = filter_out_first (fun x -> x.st_id = trustee) ts in if touched then ( x.dbp_trustees <- ts; let* () = Web_persist.set_draft_election uuid se in Lwt.return_true) else Lwt.return_false | `Threshold x -> let ts = x.dtp_trustees in let touched, ts = filter_out_first (fun x -> x.stt_id = trustee) ts in if touched then ( x.dtp_trustees <- ts; let* () = Web_persist.set_draft_election uuid se in Lwt.return_true) else Lwt.return_false let set_threshold uuid se threshold = match se.se_trustees with | `Basic _ -> Lwt.return @@ Stdlib.Error `NoTrustees | `Threshold x when x.dtp_trustees = [] -> Lwt.return @@ Stdlib.Error `NoTrustees | `Threshold x -> let ts = x.dtp_trustees in let maybe_threshold, step = if threshold = 0 then (None, None) else (Some threshold, Some 1) in if 0 <= threshold && threshold < List.length ts then ( List.iter (fun t -> t.stt_step <- step) ts; x.dtp_threshold <- maybe_threshold; let* () = Web_persist.set_draft_election uuid se in Lwt.return @@ Ok ()) else Lwt.return @@ Stdlib.Error `OutOfBounds let get_draft_trustees_mode se = match se.se_trustees with | `Basic _ -> `Basic | `Threshold x -> `Threshold (Option.value x.dtp_threshold ~default:0) let put_draft_trustees_mode uuid se mode = match (get_draft_trustees_mode se, mode) with | a, b when a = b -> Lwt.return_unit | _, `Basic -> se.se_trustees <- `Basic { dbp_trustees = [] }; Web_persist.set_draft_election uuid se | `Basic, `Threshold 0 -> let dtp = { dtp_threshold = None; dtp_trustees = []; dtp_parameters = None; dtp_error = None; } in se.se_trustees <- `Threshold dtp; Web_persist.set_draft_election uuid se | `Threshold _, `Threshold threshold -> ( let* x = set_threshold uuid se threshold in match x with | Ok () -> Lwt.return_unit | Error `NoTrustees -> Lwt.fail (Error (`GenericError "no trustees")) | Error `OutOfBounds -> Lwt.fail (Error (`GenericError "threshold out of bounds"))) | _, _ -> Lwt.fail (Error (`GenericError "change not allowed")) let get_draft_status uuid se = let* private_credentials_downloaded = if se.se_metadata.e_cred_authority = Some "server" then let* b = Web_persist.get_private_creds_downloaded uuid in Lwt.return_some b else Lwt.return_none in Lwt.return { num_voters = List.length se.se_voters; passwords_ready = (match se.se_metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> Some (List.for_all (fun v -> v.sv_password <> None) se.se_voters) | _ -> None); credentials_ready = se.se_public_creds_received; private_credentials_downloaded; trustees_ready = (match se.se_trustees with | `Basic x -> List.for_all (fun t -> t.st_public_key <> "") x.dbp_trustees | `Threshold x -> List.for_all (fun t -> t.stt_step = Some 7) x.dtp_trustees); nh_and_weights_compatible = (let has_weights = has_explicit_weights se.se_voters in let has_nh = Array.exists (function | Belenios_core.Question.NonHomomorphic _ -> true | _ -> false) se.se_questions.t_questions in not (has_weights && has_nh)); credential_authority_visited = se.se_credential_authority_visited; voter_authentication_visited = se.se_voter_authentication_visited; trustees_setup_step = se.se_trustees_setup_step; } let merge_voters a b f = let weights = List.fold_left (fun accu sv -> let _, login, weight = Voter.get sv.sv_id in let login = String.lowercase_ascii login in SMap.add login weight accu) SMap.empty a in let rec loop weights accu = function | [] -> Ok (List.rev accu, Weight.(SMap.fold (fun _ x y -> x + y) weights zero)) | sv_id :: xs -> let _, login, weight = Voter.get sv_id in let login = String.lowercase_ascii login in if SMap.mem login weights then Stdlib.Error sv_id else loop (SMap.add login weight weights) ({ sv_id; sv_password = f sv_id } :: accu) xs in loop weights (List.rev a) b let import_voters uuid se from = let* voters = Web_persist.get_all_voters from in let* passwords = Web_persist.get_passwords from in let get_password = match passwords with | None -> fun _ -> None | Some p -> fun sv_id -> let _, login, _ = Voter.get sv_id in SMap.find_opt (String.lowercase_ascii login) p in if se.se_public_creds_received then Lwt.return @@ Stdlib.Error `Forbidden else match merge_voters se.se_voters voters get_password with | Ok (voters, total_weight) -> let expanded = Weight.expand ~total:total_weight total_weight in if Z.compare expanded Weight.max_expanded_weight <= 0 then ( se.se_voters <- voters; let* () = Web_persist.set_draft_election uuid se in Lwt.return @@ Ok ()) else Lwt.return @@ Stdlib.Error (`TotalWeightTooBig total_weight) | Error x -> let _, login, _ = Voter.get x in Lwt.return @@ Stdlib.Error (`Duplicate login) let import_trustees uuid se from metadata = let open Belenios_core.Serializable_j in match metadata.e_trustees with | None -> Lwt.return @@ Stdlib.Error `None | Some names -> ( let* trustees = Web_persist.get_trustees from in let version = se.se_version in let module G = (val Group.of_string ~version se.se_group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let module K = Trustees.MakeCombinator (G) in let trustees = trustees_of_string (sread G.of_string) trustees in if not (K.check trustees) then Lwt.return @@ Stdlib.Error `Invalid else let import_pedersen t names = let* privs = Web_persist.get_private_keys from in let* x = 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 stt_name = vo_public_key.trustee_name in let stt_token = generate_token () in let stt_voutput = { vo_public_key; vo_private_key } in let stt_voutput = Some (string_of_voutput (swrite G.to_string) stt_voutput) in let stt = { stt_id; stt_token; stt_voutput; stt_step = Some 7; stt_cert = None; stt_polynomial = None; stt_vinput = None; stt_name; } in loop ts pubs privs (stt :: accu) | [], [], [] -> Lwt.return @@ Ok (List.rev accu) | _, _, _ -> Lwt.return @@ Stdlib.Error `Inconsistent in loop names (Array.to_list t.t_verification_keys) privs [] | None -> Lwt.return @@ Stdlib.Error `MissingPrivateKeys in match x with | Ok se_threshold_trustees -> let dtp = { dtp_threshold = Some t.t_threshold; dtp_trustees = se_threshold_trustees; dtp_parameters = Some (string_of_threshold_parameters (swrite G.to_string) t); dtp_error = None; } in se.se_trustees <- `Threshold dtp; let* () = Web_persist.set_draft_election uuid se in Lwt.return @@ Ok `Threshold | Stdlib.Error _ as x -> Lwt.return x in match trustees with | [ `Pedersen t ] -> import_pedersen t names | [ `Single x; `Pedersen t ] when x.trustee_name = Some "server" -> import_pedersen t (List.tl names) | ts -> let@ ts cont = try ts |> List.map (function | `Single x -> x | `Pedersen _ -> raise Exit) |> cont with Exit -> Lwt.return @@ Stdlib.Error `Unsupported in let* ts = let module KG = Trustees.MakeSimple (G) (Random) in List.combine names ts |> Lwt_list.map_p (fun (st_id, public_key) -> let* st_token, st_private_key, st_public_key = if st_id = "server" then let private_key = KG.generate () in let public_key = KG.prove private_key in let public_key = string_of_trustee_public_key (swrite G.to_string) public_key in Lwt.return ("", Some private_key, public_key) else let st_token = generate_token () in let public_key = string_of_trustee_public_key (swrite G.to_string) public_key in Lwt.return (st_token, None, public_key) in let st_name = public_key.trustee_name in Lwt.return { st_id; st_token; st_public_key; st_private_key; st_name; }) in se.se_trustees <- `Basic { dbp_trustees = ts }; let* () = Web_persist.set_draft_election uuid se in Lwt.return @@ Ok `Basic) let check_owner account uuid cont = let* metadata = Web_persist.get_election_metadata uuid in if Accounts.check account metadata.e_owners then cont metadata else unauthorized let post_draft_status uuid se = function | `SetDownloaded -> let* () = Web_persist.set_private_creds_downloaded uuid in ok | `ValidateElection -> let* s = get_draft_status uuid se in let* () = Web_persist.validate_election uuid se s in ok | `SetCredentialAuthorityVisited -> let* () = if se.se_credential_authority_visited <> true then ( se.se_credential_authority_visited <- true; let* () = Web_persist.set_draft_election uuid se in Lwt.return_unit) else Lwt.return_unit in ok | `SetVoterAuthenticationVisited -> let* () = if se.se_voter_authentication_visited <> true then ( se.se_voter_authentication_visited <- true; let* () = Web_persist.set_draft_election uuid se in Lwt.return_unit) else Lwt.return_unit in ok | `SetTrusteesSetupStep i -> let* () = if se.se_trustees_setup_step <> i then ( se.se_trustees_setup_step <- i; let* () = Web_persist.set_draft_election uuid se in Lwt.return_unit) else Lwt.return_unit in ok let dispatch_credentials ~token endpoint method_ body uuid se = match endpoint with | [ "token" ] -> ( let@ _ = with_administrator token se in match method_ with | `GET -> handle_get_option (fun () -> get_credentials_token se) | _ -> method_not_allowed) | [ "private" ] -> ( let@ _ = with_administrator token se in match method_ with | `GET -> handle_get_option (fun () -> Web_persist.get_draft_private_credentials uuid) | _ -> method_not_allowed) | [ "public" ] -> ( match method_ with | `GET -> handle_get_option (fun () -> Web_persist.get_draft_public_credentials uuid) | `POST -> ( let@ who = with_administrator_or_credential_authority token se in if se.se_public_creds_received then forbidden else let@ x = body.run public_credentials_of_string in match (who, x) with | `Administrator _, [] -> ( let@ () = handle_generic_error in let send = Mails_voter.generate_credential_email uuid se in let* x = generate_credentials_on_server send uuid se in match x with | Ok jobs -> let* () = Mails_voter.submit_bulk_emails jobs in ok | Error e -> Lwt.fail @@ exn_of_generate_credentials_on_server_error e) | `CredentialAuthority, credentials -> let@ () = handle_generic_error in let* () = submit_public_credentials uuid se credentials in ok | _ -> forbidden) | _ -> method_not_allowed) | _ -> not_found let dispatch_draft ~token ~ifmatch endpoint method_ body uuid se = match endpoint with | [] -> ( let@ who = with_administrator_or_nobody token se in let get () = let* x = api_of_draft se in Lwt.return @@ string_of_draft x in match (method_, who) with | `GET, _ -> handle_get get | `PUT, `Administrator account -> let@ () = handle_ifmatch ifmatch get in let@ draft = body.run draft_of_string in let@ () = handle_generic_error in let update_cache = draft.draft_questions.t_name <> se.se_questions.t_name || se.se_owners <> draft.draft_owners in let se = draft_of_api account se draft in let* () = Web_persist.set_draft_election uuid se in let* () = if update_cache then Web_persist.clear_elections_by_owner_cache () else Lwt.return_unit in ok | `POST, `Administrator _ -> let@ () = handle_ifmatch ifmatch get in let@ x = body.run draft_request_of_string in let@ () = handle_generic_error in post_draft_status uuid se x | `DELETE, `Administrator _ -> let@ () = handle_ifmatch ifmatch get in let@ () = handle_generic_error in let* () = Web_persist.delete_draft uuid in ok | _ -> method_not_allowed) | [ "voters" ] -> ( let@ who = with_administrator_or_credential_authority token se in let get () = let x = get_draft_voters se in Lwt.return @@ string_of_voter_list x in match (method_, who) with | `GET, _ -> handle_get get | `PUT, `Administrator _ -> let@ () = handle_ifmatch ifmatch get in if se.se_public_creds_received then forbidden else let@ voters = body.run voter_list_of_string in let@ () = handle_generic_error in let* () = put_draft_voters uuid se voters in ok | `POST, `Administrator account -> ( let@ () = handle_ifmatch ifmatch get in let@ request = body.run voters_request_of_string in let@ () = handle_generic_error in match request with | `Import from -> ( let@ _ = check_owner account from in let* x = import_voters uuid se from in match x with | Ok () -> ok | Stdlib.Error `Forbidden -> forbidden | Stdlib.Error `NotFound -> not_found | Stdlib.Error (`TotalWeightTooBig _) -> Lwt.fail (Error (`GenericError "total weight too big")) | Stdlib.Error (`Duplicate x) -> Lwt.fail (Error (`GenericError ("duplicate: " ^ x))))) | _ -> method_not_allowed) | [ "passwords" ] -> ( let@ _ = with_administrator token se in let get () = let x = get_draft_passwords se in Lwt.return @@ string_of_string_list x in match method_ with | `GET -> handle_get get | `POST -> let@ () = handle_ifmatch ifmatch get in let@ voters = body.run string_list_of_string in let@ () = handle_generic_error in let generate = let title = se.se_questions.t_name in let langs = get_languages se.se_metadata.e_languages in let show_weight = has_explicit_weights se.se_voters in fun metadata id -> Mails_voter.generate_password_email metadata langs title uuid id show_weight in let* jobs = post_draft_passwords generate uuid se voters in let* () = Mails_voter.submit_bulk_emails jobs in ok | _ -> method_not_allowed) | "credentials" :: endpoint -> dispatch_credentials ~token endpoint method_ body uuid se | [ "trustees-pedersen" ] -> ( let@ trustee, dtp = with_threshold_trustee token se in let get () = let pedersen_certs = List.fold_left (fun accu x -> match x.stt_cert with None -> accu | Some c -> c :: accu) [] dtp.dtp_trustees |> List.rev |> Array.of_list in let r = { pedersen_threshold = Option.value ~default:0 dtp.dtp_threshold; pedersen_step = Option.value ~default:0 trustee.stt_step; pedersen_certs; pedersen_vinput = trustee.stt_vinput; pedersen_voutput = Option.map (voutput_of_string Yojson.Safe.read_json) trustee.stt_voutput; } in Lwt.return @@ string_of_pedersen Yojson.Safe.write_json r in match method_ with `GET -> handle_get get | _ -> method_not_allowed) | [ "trustees" ] -> ( let@ who = with_administrator_or_nobody token se in let get is_admin () = let open Belenios_api.Serializable_j in let x = get_draft_trustees ~is_admin se in Lwt.return @@ string_of_draft_trustees x in match (method_, who) with | `GET, `Nobody -> handle_get (get false) | `GET, `Administrator _ -> handle_get (get true) | `POST, `Administrator account -> ( let@ () = handle_ifmatch ifmatch (get true) in let@ request = body.run trustees_request_of_string in let@ () = handle_generic_error in match request with | `Add trustee -> let* () = post_draft_trustees uuid se trustee in ok | `SetBasic -> let* () = put_draft_trustees_mode uuid se `Basic in ok | `SetThreshold t -> let* () = put_draft_trustees_mode uuid se (`Threshold t) in ok | `Import from -> ( let@ metadata = check_owner account from in let* x = import_trustees uuid se from metadata in match x with | Ok _ -> ok | Stdlib.Error e -> let msg = match e with | `None -> "none" | `Invalid -> "invalid" | `Inconsistent -> "inconsistent" | `MissingPrivateKeys -> "missing private keys" | `Unsupported -> "unsupported" in Lwt.fail (Error (`GenericError msg)))) | _ -> method_not_allowed) | [ "trustees"; trustee ] -> ( let@ _ = with_administrator token se in match method_ with | `DELETE -> let@ () = handle_generic_error in let* x = delete_draft_trustee uuid se trustee in if x then ok else not_found | _ -> method_not_allowed) | [ "status" ] -> ( let@ _ = with_administrator token se in match method_ with | `GET -> let@ () = handle_generic_error in let* x = get_draft_status uuid se in Lwt.return (200, string_of_draft_status x) | _ -> method_not_allowed) | _ -> not_found let dispatch ~token ~ifmatch endpoint method_ body = match endpoint with | [] -> ( let@ token = Option.unwrap unauthorized token in let@ account = Option.unwrap unauthorized (lookup_token token) in let get () = let* elections = Web_persist.get_elections_by_owner account.id in let elections = List.fold_left (fun accu (kind, summary_uuid, date, summary_name) -> let summary_date = Datetime.to_unixfloat date in let summary_kind = None in if kind = `Draft then { summary_uuid; summary_name; summary_date; summary_kind } :: accu else accu) [] elections in Lwt.return @@ string_of_summary_list elections in match method_ with | `GET -> handle_get get | `POST -> ( let@ () = handle_ifmatch ifmatch get in let@ draft = body.run draft_of_string in let@ () = handle_generic_error in let* uuid = post_drafts account draft in match uuid with | Some uuid -> Lwt.return (200, string_of_uuid uuid) | None -> forbidden) | _ -> method_not_allowed) | uuid :: endpoint -> let@ uuid = Option.unwrap bad_request (Option.wrap Uuid.wrap uuid) in let* se = Web_persist.get_draft_election uuid in let@ se = Option.unwrap not_found se in dispatch_draft ~token ~ifmatch endpoint method_ body uuid se belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_captcha.ml0000644000175000017500000000666214476041226023044 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core open Common open Web_common type captcha = { content_type : string; contents : string; response : string; c_expiration_time : Datetime.t; } let captchas = ref SMap.empty let filter_captchas_by_time table = let now = Datetime.now () in SMap.filter (fun _ { c_expiration_time; _ } -> Datetime.compare now c_expiration_time <= 0) table let format_content_type = function | "png" -> "image/png" | x -> Printf.ksprintf failwith "Unknown captcha type: %s" x let captcha = let x = "belenios-captcha" in (x, [| x |]) let create_captcha () = let* raw = Lwt_process.pread_lines captcha |> Lwt_stream.to_list in match raw with | content_type :: response :: contents -> let content_type = format_content_type content_type in let contents = let open Cryptokit in String.concat "\n" contents |> transform_string (Base64.decode ()) in let challenge = sha256_b64 contents in let c_expiration_time = Period.add (Datetime.now ()) (Period.second 300) in let x = { content_type; contents; response; c_expiration_time } in captchas := SMap.add challenge x !captchas; Lwt.return challenge | _ -> Lwt.fail (Failure "Captcha generation failed") let get challenge = captchas := filter_captchas_by_time !captchas; SMap.find_opt challenge !captchas let get_captcha ~challenge = match get challenge with | None -> fail_http `Not_found | Some { content_type; contents; _ } -> Lwt.return (contents, content_type) let check_captcha ~challenge ~response = match get challenge with | None -> Lwt.return false | Some x -> captchas := SMap.remove challenge !captchas; Lwt.return (response = x.response) module Make (Web_services : Web_services_sig.S) = struct let () = Eliom_registration.String.register ~service:Web_services.signup_captcha_img (fun challenge () -> get_captcha ~challenge) end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_events.ml0000644000175000017500000002166614476041226022746 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core.Serializable_j open Belenios_core.Common open Belenios_core.Events open Web_common module Archive = Belenios_core.Archive let block_size = Archive.block_size let block_sizeL = Int64.of_int block_size type index = { timeout : Lwt_timeout.t; map : (hash, location) Hashtbl.t; mutable roots : roots; timestamp : int64; } module IoReader = struct include Lwt let yield = Lwt.pause open Lwt_io type file = input_channel let get_pos ic = Lwt.return @@ position ic let set_pos = set_position let read_block ic buffer = read_into_exactly ic buffer 0 block_size end module Reader = Archive.MakeReader (IoReader) module IoWriter = struct include Lwt let yield = Lwt.pause open Lwt_io (* `Lwt_io`'s position does not work with files opened in append mode, so we implement it here *) type file = { channel : output_channel; mutable position : int64 } let get_pos oc = Lwt.return oc.position let write_block oc buffer = let* () = write_from_exactly oc.channel buffer 0 block_size in oc.position <- Int64.add oc.position block_sizeL; Lwt.return_unit end module Writer = Archive.MakeWriter (IoWriter) let indexes = Hashtbl.create 100 let write_header ~filename ~header = let open Lwt_unix in let* fd = openfile filename [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in Lwt.finalize (fun () -> let* () = LargeFile.ftruncate fd 0L in let oc = { IoWriter.channel = Lwt_io.of_fd ~mode:Output fd; position = 0L } in let* () = Writer.write_header oc header in Lwt_io.flush oc.channel) (fun () -> close fd) let build_roots ~size ~pos filename = let r = Hashtbl.create size in let@ () = fun cont -> if pos > 0L then cont () else let header = Archive.new_header () in let* () = write_header ~filename ~header in Lwt.return (r, empty_roots, Archive.get_timestamp header) in let* fd = Lwt_unix.openfile filename [ Unix.O_RDONLY ] 0o644 in let open Lwt_io in let ic = of_fd ~mode:Input fd in let* header = Reader.read_header ic in let rec loop accu = let location_offset = position ic in if location_offset < pos then ( let* record = Reader.read_record ic in let accu = match record.typ with | Data -> accu | Event event -> update_roots record.hash event accu in Hashtbl.add r record.hash record.location; loop accu) else Lwt.return (r, accu, Archive.get_timestamp header) in Lwt.finalize (fun () -> loop empty_roots) (fun () -> close ic) let chain_filename uuid = string_of_election_file (ESArchive uuid) let do_get_index ~uuid = let* last = Spool.get ~uuid Spool.last_event in let size, pos = match last with | None -> (100, 0L) | Some x -> (x.last_height + 100, x.last_pos) in let ( ! ) x = uuid /// x in let* map, roots, timestamp = build_roots ~size ~pos !(chain_filename uuid) in let remove () = Hashtbl.remove indexes uuid in let timeout = Lwt_timeout.create 3600 remove in let r = { timeout; map; roots; timestamp } in Hashtbl.add indexes uuid r; Lwt.return r let get_index ?(lock = true) uuid = let* r = match Hashtbl.find_opt indexes uuid with | Some r -> Lwt.return r | None -> if lock then let@ () = Web_election_mutex.with_lock uuid in match Hashtbl.find_opt indexes uuid with | Some r -> Lwt.return r | None -> do_get_index ~uuid else do_get_index ~uuid in Lwt_timeout.start r.timeout; Lwt.return r let raw_append ~uuid ~filename ~timestamp offset xs = let open Lwt_unix in let* fd = openfile (uuid /// filename) [ O_WRONLY; O_APPEND ] 0o644 in Lwt.finalize (fun () -> let* () = let* pos = LargeFile.lseek fd 0L SEEK_END in if pos = offset then Lwt.return_unit else LargeFile.ftruncate fd offset in let oc = { IoWriter.channel = Lwt_io.of_fd ~mode:Output fd; position = offset } in let* records = Lwt_list.fold_left_s (fun accu (typ, x) -> let* record = Writer.write_record oc ~timestamp typ x in Lwt.return @@ (record :: accu)) [] xs in let* () = Lwt_io.flush oc.channel in let* () = fsync fd in Lwt.return (oc.position, records)) (fun () -> close fd) let gethash ~uuid ~index ~filename x = match Hashtbl.find_opt index x with | None -> Lwt.return_none | Some i -> let open Lwt_unix in let* fd = openfile (uuid /// filename) [ O_RDONLY ] 0o644 in Lwt.finalize (fun () -> let* _ = LargeFile.lseek fd i.location_offset SEEK_SET in assert (i.location_length <= Int64.of_int Sys.max_string_length); let length = Int64.to_int i.location_length in let buffer = Bytes.create length in let ic = Lwt_io.of_fd ~mode:Input fd in let* () = Lwt_io.read_into_exactly ic buffer 0 length in Lwt.return_some @@ Bytes.to_string buffer) (fun () -> close fd) let with_archive uuid default f = let filename = chain_filename uuid in let* b = Lwt_unix.file_exists (uuid /// filename) in if b then f filename else Lwt.return default let get_data ~uuid x = let@ filename = with_archive uuid None in let* r = get_index uuid in gethash ~uuid ~index:r.map ~filename x let get_event ~uuid x = let@ filename = with_archive uuid None in let* r = get_index uuid in let* x = gethash ~uuid ~index:r.map ~filename x in Lwt.return @@ Option.map event_of_string x let get_roots ~uuid = let@ _ = with_archive uuid empty_roots in let* r = get_index uuid in Lwt.return r.roots type append_operation = Data of string | Event of event_type * hash option exception RaceCondition let append ?(lock = true) ~uuid ?last ops = let@ () = fun cont -> if lock then Web_election_mutex.with_lock uuid cont else cont () in let@ last cont = let* x = Spool.get ~uuid Spool.last_event in match last with | None -> cont x | Some last -> if x = Some last then cont x else Lwt.fail RaceCondition in let* index = get_index ~lock:false uuid in let event_parent, event_height, pos = match last with | None -> (None, -1, 1024L (* header size *)) | Some x -> (Some x.last_hash, x.last_height, x.last_pos) in let last_hash, last_height, roots, items = List.fold_left (fun (event_parent, event_height, roots, accu) x -> match x with | Event (event_typ, event_payload) -> let event_height = event_height + 1 in let event = { event_parent; event_height; event_typ; event_payload } in let event_s = string_of_event event in let event_h = Hash.hash_string event_s in let accu = (Archive.Event event, event_s) :: accu in (Some event_h, event_height, update_roots event_h event roots, accu) | Data payload -> let accu = (Archive.Data, payload) :: accu in (event_parent, event_height, roots, accu)) (event_parent, event_height, index.roots, []) ops in let last_hash = match last_hash with None -> assert false | Some x -> x in let items = List.rev items in let* last_pos, records = raw_append ~uuid ~filename:(chain_filename uuid) ~timestamp:index.timestamp pos items in let* () = Spool.set ~uuid Spool.last_event { last_hash; last_height; last_pos } in List.iter (fun r -> Hashtbl.add index.map r.Archive.hash r.location) records; index.roots <- roots; Lwt.return_unit belenios-2.2-10-gbb6b7ea8/src/web/server/common/accounts.ml0000644000175000017500000001164114476041226022414 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Lwt.Infix open Belenios_core.Common open Web_common open Web_serializable_j module UMap = Map.Make (struct type t = user let compare = compare end) let cache = ref None let counter_mutex = Lwt_mutex.create () let account_mutex = Lwt_mutex.create () let cache_mutex = Lwt_mutex.create () let clear_account_cache () = let@ () = Lwt_mutex.with_lock cache_mutex in cache := None; Lwt.return_unit let account_of_filename filename = let&* id = Filename.chop_suffix_opt ~suffix:".json" filename in let&* _ = int_of_string_opt id in let* contents = Filesystem.read_file (!Web_config.accounts_dir // filename) in match contents with | Some [ x ] -> Lwt.return (try Some (account_of_string x) with _ -> None) | _ -> Lwt.return_none let get_account_by_id id = account_of_filename (Printf.sprintf "%d.json" id) let update_hooks = ref [] let add_update_hook f = update_hooks := f :: !update_hooks let update_account account = let* () = let@ () = Lwt_mutex.with_lock account_mutex in Filesystem.write_file (!Web_config.accounts_dir // Printf.sprintf "%d.json" account.id) [ string_of_account account ] in Lwt_list.iter_s (fun f -> f account) !update_hooks let drop_after_at x = match String.index_opt x '@' with None -> x | Some i -> String.sub x 0 i let create_account ~email user = let@ () = Lwt_mutex.with_lock counter_mutex in let* counter = let* x = Filesystem.read_file (!Web_config.accounts_dir // "counter") in match x with | Some [ x ] -> Lwt.return (match int_of_string_opt x with None -> 1 | Some x -> x) | _ -> Lwt.return 1 in let rec find_free_id n = let* x = get_account_by_id n in match x with None -> Lwt.return n | Some _ -> find_free_id (n + 1) in let* id = find_free_id counter in let last_connected = Datetime.now () in let name = let x = drop_after_at user.user_name in if x = "" then Printf.sprintf "User #%d" id else x in let account = { id; name; email; last_connected; authentications = [ user ]; consent = None; capabilities = None; language = None; default_voter_languages = []; default_contact = ""; } in let* () = update_account account in let* () = Filesystem.write_file (!Web_config.accounts_dir // "counter") [ string_of_int (id + 1) ] in let* () = clear_account_cache () in Lwt.return account let build_account_cache () = Lwt_unix.files_of_directory !Web_config.accounts_dir |> Lwt_stream.to_list >>= Lwt_list.fold_left_s (fun accu f -> let* account = account_of_filename f in match account with | None -> Lwt.return accu | Some account -> List.fold_left (fun accu u -> UMap.add u account.id accu) accu account.authentications |> Lwt.return) UMap.empty let get_account user = let* cache = match !cache with | Some x -> Lwt.return x | None -> let@ () = Lwt_mutex.with_lock cache_mutex in let* x = build_account_cache () in cache := Some x; Lwt.return x in let&* id = UMap.find_opt user cache in get_account_by_id id type capability = Sudo let mask_of_capability = function Sudo -> 1 let has_capability cap account = match account.capabilities with | None -> false | Some i -> i land mask_of_capability cap <> 0 let check a i = List.mem a.id i belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_voter_sig.mli0000644000175000017500000000546014476041226024130 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common open Belenios_core open Serializable_t open Web_serializable_t module type S = sig val election_home : (module Site_common_sig.ELECTION) -> election_state -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val cast_raw : (module Site_common_sig.ELECTION) -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val lost_ballot : (module Site_common_sig.ELECTION) -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val cast_confirmed : (module Site_common_sig.ELECTION) -> result:(user * string * bool * Weight.t * bool, Web_common.error) result -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val pretty_ballots : (module Site_common_sig.ELECTION) -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val schulze : Question_nh_t.question -> schulze_result -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val majority_judgment_select : uuid -> int -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val majority_judgment : Question_nh_t.question -> mj_result -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val stv_select : uuid -> int -> [> `Html ] Eliom_content.Html.F.elt Lwt.t val stv : Question_nh_t.question -> stv_result -> [> `Html ] Eliom_content.Html.F.elt Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/filesystem.mli0000644000175000017500000000374114476041226023134 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_serializable_t val file_exists : string -> bool Lwt.t val read_file : ?uuid:uuid -> string -> string list option Lwt.t val read_whole_file : ?uuid:uuid -> string -> string option Lwt.t val read_file_single_line : ?uuid:uuid -> string -> string option Lwt.t val write_file : ?uuid:uuid -> string -> string list -> unit Lwt.t val write_whole_file : ?uuid:uuid -> string -> string -> unit Lwt.t val cleanup_file : string -> unit Lwt.t val rmdir : string -> unit Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_admin.ml0000644000175000017500000022776614476041226022732 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_platform open Platform open Belenios_core open Belenios open Serializable_j open Signatures open Common open Web_serializable_j open Web_common module Pages_admin_root = Pages_admin module Make (X : Pages_sig.S) (Site_common : Site_common_sig.S) (Web_auth : Web_auth_sig.S) = struct open X open Web_services open Site_common open Eliom_service open Eliom_registration let get_preferred_gettext () = Web_i18n.get_preferred_gettext "admin" let () = Any.register ~service:home (fun () () -> Redirection.send (Redirection admin)) let get_elections_by_owner_sorted u = let* elections = Web_persist.get_elections_by_owner u in let filter kind = List.filter (fun (x, _, _, _) -> x = kind) elections |> List.map (fun (_, a, b, c) -> (a, b, c)) in let draft = filter `Draft in let elections = filter `Validated in let tallied = filter `Tallied in let archived = filter `Archived in let sort l = List.sort (fun (_, x, _) (_, y, _) -> Datetime.compare x y) l |> List.map (fun (x, _, y) -> (x, y)) in return (sort draft, sort elections, sort tallied, sort archived) let () = let@ a = Accounts.add_update_hook in let* user = Eliom_reference.get Web_state.site_user in match user with | Some (u, b, t) when a.id = b.id -> Eliom_reference.set Web_state.site_user (Some (u, a, t)) | _ -> Lwt.return_unit let with_site_user f = let* user = Eliom_reference.get Web_state.site_user in match user with Some u -> f u | None -> forbidden () let with_metadata_check_owner uuid f = let* user = Eliom_reference.get Web_state.site_user in let* metadata = Web_persist.get_election_metadata uuid in match user with | Some (_, a, _) when Accounts.check a metadata.e_owners -> f metadata | _ -> forbidden () let without_site_user ?fallback () f = let* l = get_preferred_gettext () in let open (val l) in let* user = Eliom_reference.get Web_state.site_user in match user with | None -> f () | Some u -> ( match fallback with | Some g -> g u | None -> Pages_common.generic_page ~title:(s_ "Error") (s_ "This page is not accessible to authenticated administrators, \ because it is meant to be used by third parties.") () >>= Html.send) let () = Redirection.register ~service:privacy_notice_accept (fun () cont -> let* () = Eliom_reference.set Web_state.show_cookie_disclaimer false in let cont = match cont with | ContAdmin -> Redirection admin | ContSignup service -> Redirection (preapply ~service:signup_captcha service) in return cont) let () = Any.register ~service:sealing (fun () () -> let* site_user = Eliom_reference.get Web_state.site_user in match site_user with | None -> forbidden () | Some _ -> ( match !Web_config.sealing with | Some (file, content_type) -> File.send ~content_type file | None -> fail_http `Not_found)) let () = Html.register ~service:admin (fun () () -> let* site_user = Eliom_reference.get Web_state.site_user in match site_user with | None -> Pages_admin.admin_login Web_auth.get_site_login_handler | Some (_, a, _) -> let* show = match a.consent with | Some _ -> return_false | None -> let* b = Eliom_reference.get Web_state.show_cookie_disclaimer in if b then return_true else let consent = Some (Datetime.now ()) in let a = { a with consent } in let* () = Accounts.update_account { a with consent } in return_false in if show then Pages_admin.privacy_notice ContAdmin else if a.email = "" then Pages_admin.set_email () else let* elections = get_elections_by_owner_sorted a.id in Pages_admin.admin ~elections) module SetEmailSender = struct type payload = unit type context = unit let send ~context:() ~address ~code = let* l = get_preferred_gettext () in let subject, body = Pages_admin_root.mail_set_email l address code in send_email ~subject ~recipient:address ~body MailSetEmail end module SetEmailOtp = Otp.Make (SetEmailSender) () let () = Any.register ~service:set_email_post (fun () address -> let@ _ = with_site_user in if is_email address then let* () = Eliom_reference.set Web_state.set_email_env (Some address) in let* () = SetEmailOtp.generate ~context:() ~address ~payload:() in Pages_admin.set_email_confirm ~address >>= Html.send else let* l = get_preferred_gettext () in let open (val l) in let msg = s_ "This e-mail address is invalid!" in let title = s_ "Error" in Pages_common.generic_page ~title msg () >>= Html.send ~code:400) let () = Any.register ~service:set_email_confirm (fun () code -> let* u = Eliom_reference.get Web_state.site_user in let* x = Eliom_reference.get Web_state.set_email_env in match (x, u) with | None, _ | _, None -> forbidden () | Some address, Some (_, a, _) -> ( match SetEmailOtp.check ~address ~code with | Some () -> let a = { a with email = address } in let* () = Accounts.update_account a in let* () = Web_state.discard () in Redirection.send (Redirection admin) | None -> let* l = get_preferred_gettext () in let open (val l) in let msg = s_ "The provided code is incorrect. Please go back and try \ again." in let title = s_ "Incorrect code" in Pages_common.generic_page ~title msg () >>= Html.send ~code:403)) let create_new_election (account : account) cred draft_authentication = let open Belenios_api.Serializable_t in let draft_questions = { t_description = default_description; t_name = default_name; t_questions = default_questions; t_administrator = Some account.name; t_credential_authority = Some (match cred with `Automatic -> "server" | `Manual -> ""); } in let draft = { draft_version = List.hd supported_crypto_versions; draft_owners = [ account.id ]; draft_questions; draft_languages = [ "en"; "fr" ]; draft_contact = Some (Printf.sprintf "%s <%s>" account.name account.email); draft_booth = 2; draft_authentication; draft_group = !Web_config.default_group; } in let* uuid = Api_drafts.post_drafts account draft in match uuid with | Some uuid -> redir_preapply election_draft uuid () | None -> let* l = get_preferred_gettext () in let open (val l) in Pages_common.generic_page ~title:(s_ "Error") (s_ "Creating new elections is forbidden on this server!") () >>= Html.send let () = Any.register ~service:election_draft_pre (fun () () -> let@ _ = with_site_user in Pages_admin.election_draft_pre () >>= Html.send) let http_rex = "^https?://[a-z0-9/.-]+$" let is_http_url = let rex = Re.Pcre.regexp ~flags:[ `CASELESS ] http_rex in fun x -> match re_exec_opt ~rex x with Some _ -> true | None -> false let () = Any.register ~service:election_draft_new (fun () (credmgmt, (auth, cas_server)) -> let* l = get_preferred_gettext () in let open (val l) in let@ _, a, _ = with_site_user in let* credmgmt = match credmgmt with | Some "auto" -> return `Automatic | Some "manual" -> return `Manual | _ -> fail_http `Bad_request in let* auth_parsed = match auth with | Some "password" -> return `Password | Some "cas" -> ( match cas_server with | None -> fail_http `Bad_request | Some cas_server -> return @@ `CAS (Stdlib.String.trim cas_server)) | Some x -> let n = Stdlib.String.length x in if n > 1 && Stdlib.String.get x 0 = '%' then let name = Stdlib.String.sub x 1 (n - 1) in return @@ `Configured name else fail_http `Bad_request | _ -> fail_http `Bad_request in let has_cas_server = match cas_server with None | Some "" -> false | Some _ -> true in match auth_parsed with | `CAS cas_server when not (is_http_url cas_server) -> Pages_common.generic_page ~title:(s_ "Error") (s_ "Bad CAS server!") () >>= Html.send | _ when has_cas_server && auth <> Some "cas" -> Pages_common.generic_page ~title:(s_ "Error") (s_ "Non-empty CAS server, but CAS authentication not selected!") () >>= Html.send | _ -> create_new_election a credmgmt auth_parsed) let with_draft_election_ro uuid f = let@ _, a, _ = with_site_user in let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> if Accounts.check a se.se_owners then f se else forbidden () let () = Any.register ~service:election_draft (fun uuid () -> let@ se = with_draft_election_ro uuid in Pages_admin.election_draft uuid se () >>= Html.send) let () = Any.register ~service:election_draft_trustees (fun uuid () -> let@ se = with_draft_election_ro uuid in match se.se_trustees with | `Basic _ -> Pages_admin.election_draft_trustees uuid se () >>= Html.send | `Threshold _ -> redir_preapply election_draft_threshold_trustees uuid ()) let () = Any.register ~service:election_draft_threshold_trustees (fun uuid () -> let@ se = with_draft_election_ro uuid in Pages_admin.election_draft_threshold_trustees uuid se () >>= Html.send) let () = Any.register ~service:election_draft_credential_authority (fun uuid () -> let@ se = with_draft_election_ro uuid in Pages_admin.election_draft_credential_authority uuid se () >>= Html.send) let with_draft_election ?(save = true) uuid f = let@ _, a, _ = with_site_user in let* l = get_preferred_gettext () in let open (val l) in let@ () = Web_election_mutex.with_lock uuid in let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> if Accounts.check a se.se_owners then Lwt.catch (fun () -> let* r = f se in let* () = if save then Web_persist.set_draft_election uuid se else return_unit in return r) (fun e -> let msg = match e with Failure s -> s | _ -> Printexc.to_string e in let service = preapply ~service:election_draft uuid in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send) else forbidden () let () = Any.register ~service:election_draft_set_credential_authority (fun uuid name -> let@ se = with_draft_election uuid in let* l = get_preferred_gettext () in let open (val l) in let service = Eliom_service.preapply ~service:election_draft_credential_authority uuid in match if se.se_metadata.e_cred_authority = Some "server" then Error (s_ "You cannot set the credential authority for this election!") else match name with | "" -> Ok None | "server" -> Error (s_ "Invalid public name for credential authority!") | x -> Ok (Some x) with | Ok e_cred_authority -> se.se_metadata <- { se.se_metadata with e_cred_authority }; let msg = s_ "The public name of the credential authority has been set \ successfully!" in Pages_common.generic_page ~title:(s_ "Success") ~service msg () >>= Html.send | Error msg -> Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send) let () = Any.register ~service:election_draft_languages (fun uuid languages -> let@ se = with_draft_election uuid in let* l = get_preferred_gettext () in let open (val l) in let langs = languages_of_string languages in match langs with | [] -> let service = preapply ~service:election_draft uuid in Pages_common.generic_page ~title:(s_ "Error") ~service (s_ "You must select at least one language!") () >>= Html.send | _ :: _ -> ( let available_languages = List.map fst Belenios_ui.Languages.available in 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_draft uuid () | l :: _ -> let service = preapply ~service:election_draft uuid in Pages_common.generic_page ~title:(s_ "Error") ~service (Printf.sprintf (f_ "No such language: %s") l) () >>= Html.send)) let () = Any.register ~service:election_draft_contact (fun uuid contact -> let@ se = with_draft_election uuid in 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_draft uuid ()) let () = Any.register ~service:election_draft_admin_name (fun uuid name -> let@ se = with_draft_election uuid in let administrator = if name = "" then None else Some name in se.se_administrator <- administrator; redir_preapply election_draft uuid ()) let () = Any.register ~service:election_draft_description (fun uuid (name, description) -> let@ se = with_draft_election uuid in let* l = get_preferred_gettext () in let open (val l) in if Stdlib.String.length name > max_election_name_size then let msg = Printf.sprintf (f_ "The election name must be %d characters or less!") max_election_name_size in Pages_common.generic_page ~title:(s_ "Error") msg () >>= Html.send else ( se.se_questions <- { se.se_questions with t_name = name; t_description = description }; let* () = Web_persist.clear_elections_by_owner_cache () in redir_preapply election_draft uuid ())) let handle_password se uuid ~force voters = let* l = get_preferred_gettext () in let open (val l) in if List.length voters > !Web_config.maxmailsatonce then Lwt.fail (Failure (Printf.sprintf (f_ "Cannot send passwords, there are too many voters (max is %d)") !Web_config.maxmailsatonce)) else if se.se_questions.t_name = default_name then Lwt.fail (Failure (s_ "The election name has not been edited!")) else let title = se.se_questions.t_name in let langs = get_languages se.se_metadata.e_languages in let show_weight = has_explicit_weights voters in let* jobs = Lwt_list.fold_left_s (fun jobs id -> match id.sv_password with | Some _ when not force -> Lwt.return jobs | None | Some _ -> let* email, x = Mails_voter.generate_password_email se.se_metadata langs title uuid id.sv_id show_weight in id.sv_password <- Some x; Lwt.return (email :: jobs)) [] voters in let* () = Mails_voter.submit_bulk_emails jobs in let service = preapply ~service:election_draft uuid in Pages_common.generic_page ~title:(s_ "Success") ~service (s_ "Passwords have been generated and mailed!") () >>= Html.send let () = Any.register ~service:election_draft_auth_genpwd (fun uuid () -> let@ se = with_draft_election uuid in handle_password se uuid ~force:false se.se_voters) let () = Any.register ~service:election_regenpwd (fun uuid () -> Pages_admin.regenpwd uuid () >>= Html.send) let () = Any.register ~service:election_regenpwd_post (fun uuid user -> let@ metadata = with_metadata_check_owner uuid in let* l = get_preferred_gettext () in let open (val l) in let@ election = with_election uuid in let service = preapply ~service:election_admin uuid in let* b = Web_persist.regen_password election metadata user in if b then Pages_common.generic_page ~title:(s_ "Success") ~service (Printf.sprintf (f_ "A new password has been mailed to %s.") user) () >>= Html.send else Pages_common.generic_page ~title:(s_ "Error") ~service (Printf.sprintf (f_ "%s is not a registered user for this election.") user) () >>= Html.send) let () = Any.register ~service:election_draft_questions (fun uuid () -> let@ se = with_draft_election_ro uuid in Pages_admin.election_draft_questions uuid se () >>= Html.send) let () = Any.register ~service:election_draft_questions_post (fun uuid (template, booth_version) -> let@ se = with_draft_election uuid in let* l = get_preferred_gettext () in let open (val l) in let template = template_of_string template in let fixed_group = is_group_fixed se in (match ( get_suitable_group_kind se.se_questions, get_suitable_group_kind template ) with | `NH, `NH | `H, `H -> () | `NH, `H when fixed_group -> () | `NH, `H -> se.se_group <- !Web_config.default_group | `H, `NH when fixed_group -> failwith (s_ "This kind of change is not allowed now!") | `H, `NH -> se.se_group <- !Web_config.nh_group); se.se_questions <- template; let e_booth_version = match booth_version with 1 -> None | x -> Some x in se.se_metadata <- { se.se_metadata with e_booth_version }; redir_preapply election_draft uuid ()) let () = Any.register ~service:election_draft_preview (fun (uuid, ()) () -> let@ se = with_draft_election_ro uuid in let version = se.se_version in let group = se.se_group in let module G = (val Group.of_string ~version group : GROUP) in let params = { e_version = version; e_description = se.se_questions.t_description; e_name = se.se_questions.t_name; e_questions = se.se_questions.t_questions; e_uuid = uuid; e_administrator = se.se_administrator; e_credential_authority = se.se_metadata.e_cred_authority; } in let public_key = G.to_string G.g in let raw_election = Election.make_raw_election params ~group ~public_key in let* x = String.send (raw_election, "application/json") in return @@ Eliom_registration.cast_unknown_content_kind x) let () = Any.register ~service:election_draft_voters (fun uuid () -> let@ se = with_draft_election_ro uuid in Pages_admin.election_draft_voters uuid se !Web_config.maxmailsatonce () >>= Html.send) let check_consistency voters = let get_shape voter = match voter.sv_id with | `Plain, { login; weight; _ } -> `Plain (login <> None, weight <> None) | `Json, _ -> `Json in match voters with | [] -> true | voter :: voters -> let shape = get_shape voter in let rec loop = function | [] -> true | voter :: voters -> get_shape voter = shape && loop voters in loop voters let () = Any.register ~service:election_draft_voters_add (fun uuid voters -> let@ se = with_draft_election uuid in let* l = get_preferred_gettext () in let open (val l) in if se.se_public_creds_received then forbidden () else let voters = split_lines voters |> List.map (fun x -> match Voter.of_string x with | exception _ -> Printf.ksprintf failwith (f_ "%S is not a valid identity") x | voter -> if not (Voter.validate voter) then Printf.ksprintf failwith (f_ "%S is not a valid identity") x; voter) in match Api_drafts.merge_voters se.se_voters voters (fun _ -> None) with | Error x -> let _, x, _ = Voter.get x in Printf.ksprintf failwith (f_ "Duplicate voter: %s. This is not allowed. If two voters \ have the same address, use different logins.") x | Ok (voters, total_weight) -> let () = let expanded = Weight.expand ~total:total_weight total_weight in if Z.compare expanded Weight.max_expanded_weight > 0 then Printf.ksprintf failwith (f_ "The total weight (%s) cannot be handled. Its expanded \ value must be less than %s.") Weight.(to_string total_weight) (Z.to_string Weight.max_expanded_weight) in if not (check_consistency voters) then failwith (s_ "The voter list is not consistent (a login or a weight is \ missing)."); let uses_password_auth = match se.se_metadata.e_auth_config with | Some configs -> List.exists (fun { auth_system; _ } -> auth_system = "password") configs | None -> false in let cred_auth_is_server = se.se_metadata.e_cred_authority = Some "server" in if (uses_password_auth || cred_auth_is_server) && List.length voters > !Web_config.maxmailsatonce then Lwt.fail (Failure (Printf.sprintf (f_ "There are too many voters (max is %d)") !Web_config.maxmailsatonce)) else ( se.se_voters <- voters; redir_preapply election_draft_voters uuid ())) let () = Any.register ~service:election_draft_voters_remove (fun uuid voter -> let@ se = with_draft_election uuid in if se.se_public_creds_received then forbidden () else let filter v = let _, login, _ = Voter.get v.sv_id in login <> voter in se.se_voters <- List.filter filter se.se_voters; redir_preapply election_draft_voters uuid ()) let () = Any.register ~service:election_draft_voters_remove_all (fun uuid () -> let@ se = with_draft_election uuid in if se.se_public_creds_received then forbidden () else ( se.se_voters <- []; redir_preapply election_draft_voters uuid ())) let () = Any.register ~service:election_draft_voters_passwd (fun uuid voter -> let@ se = with_draft_election uuid in let filter v = let _, login, _ = Voter.get v.sv_id in login = voter in let voter = List.filter filter se.se_voters in handle_password se uuid ~force:true voter) let ensure_trustees_mode uuid se mode = match (se.se_trustees, mode) with | `Basic _, `Basic | `Threshold _, `Threshold _ -> Lwt.return se | `Threshold _, `Basic | `Basic _, `Threshold _ -> ( let* () = Api_drafts.put_draft_trustees_mode uuid se mode in let* x = Web_persist.get_draft_election uuid in match x with | Some se -> Lwt.return se | None -> Lwt.fail (Failure "inconsistency in ensure_trustees_mode")) let handle_trustee_add mode uuid (trustee_address, trustee_name) = let@ se = with_draft_election ~save:false uuid in let* l = get_preferred_gettext () in let open (val l) in if is_email trustee_address then let* se = ensure_trustees_mode uuid se mode in let open Belenios_api.Serializable_t in let trustee = { trustee_address = Some trustee_address; trustee_name; trustee_token = None; trustee_state = None; trustee_key = None; } in let* () = Api_drafts.post_draft_trustees uuid se trustee in redir_preapply election_draft_trustees uuid () else let msg = Printf.sprintf (f_ "%s is not a valid e-mail address!") trustee_address in let service = preapply ~service:election_draft_trustees uuid in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send let handle_trustee_del service uuid address = let@ se = with_draft_election ~save:false uuid in let* _ = Api_drafts.delete_draft_trustee uuid se address in redir_preapply service uuid () let () = Any.register ~service:election_draft_trustee_add (handle_trustee_add `Basic) let () = Any.register ~service:election_draft_trustee_del (handle_trustee_del election_draft_trustees) let () = Any.register ~service:election_draft_credentials (fun (uuid, token) () -> let@ () = without_site_user () in let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> if se.se_public_creds_received then Pages_admin.election_draft_credentials_already_generated () >>= Html.send else Printf.sprintf "%s/draft/credentials.html#%s-%s" !Web_config.prefix (Uuid.unwrap uuid) token |> String_redirection.send) let () = Html.register ~service:election_draft_credentials_static (fun () () -> Pages_admin.election_draft_credentials_static ()) let handle_credentials_post uuid token creds = let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> if se.se_public_creds <> token then forbidden () else if se.se_public_creds_received then forbidden () else let creds = public_credentials_of_string creds in let* () = Api_drafts.submit_public_credentials uuid se creds in Pages_admin.election_draft_credentials_done se () >>= Html.send let () = Any.register ~service:election_draft_credentials_post (fun (uuid, token) creds -> let@ () = without_site_user () in wrap_handler (fun () -> handle_credentials_post uuid token creds)) let () = Any.register ~service:election_draft_credentials_post_file (fun (uuid, token) creds -> let@ () = without_site_user () in let fname = creds.Ocsigen_extensions.tmp_filename in let* creds = Lwt_stream.to_string (Lwt_io.chars_of_file fname) in let* () = Lwt_unix.unlink fname in wrap_handler (fun () -> handle_credentials_post uuid token creds)) let () = Any.register ~service:election_draft_credentials_server (fun uuid () -> let@ se = with_draft_election uuid in let* l = get_preferred_gettext () in let open (val l) in if se.se_questions.t_name = default_name then Lwt.fail (Failure (s_ "The election name has not been edited!")) else let send = Mails_voter.generate_credential_email uuid se in let* x = Api_drafts.generate_credentials_on_server send uuid se in match x with | Ok jobs -> let* () = Mails_voter.submit_bulk_emails jobs in let service = preapply ~service:election_draft uuid in Pages_common.generic_page ~title:(s_ "Success") ~service (s_ "Credentials have been generated and mailed! You should \ download private credentials (and store them securely), in \ case someone loses his/her credential.") () >>= Html.send | Error `Already -> Lwt.fail (Failure (s_ "The credentials were already sent")) | Error `NoVoters -> Lwt.fail (Failure (s_ "No voters")) | Error `TooManyVoters -> Lwt.fail (Failure (Printf.sprintf (f_ "Cannot send credentials, there are too many voters \ (max is %d)") !Web_config.maxmailsatonce)) | Error `NoServer -> Lwt.fail (Failure (s_ "The authority is not the server"))) let () = Any.register ~service:election_draft_credentials_get (fun uuid () -> let@ _ = with_draft_election_ro uuid in let* () = Web_persist.set_private_creds_downloaded uuid in let filename = Web_persist.get_private_creds_filename uuid in File.send ~content_type:"text/plain" filename) let () = Any.register ~service:election_draft_trustee (fun (uuid, token) () -> let* l = get_preferred_gettext () in let open (val l) in let@ () = without_site_user ~fallback:(fun (_, a, _) -> let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> if Accounts.check a se.se_owners then Pages_admin.election_draft_trustees ~token uuid se () >>= Html.send else forbidden ()) () in let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> ( let ts = match se.se_trustees with | `Basic x -> x.dbp_trustees | `Threshold _ -> [] in match List.find_opt (fun t -> t.st_token = token) ts with | None -> forbidden () | Some t -> if t.st_public_key <> "" then let msg = s_ "Your public key has already been received!" in let title = s_ "Error" in Pages_common.generic_page ~title msg () >>= Html.send ~code:403 else Printf.sprintf "%s/draft/trustee.html#%s-%s" !Web_config.prefix (Uuid.unwrap uuid) token |> String_redirection.send)) let () = Html.register ~service:election_draft_trustee_static (fun () () -> Pages_admin.election_draft_trustee_static ()) let () = Any.register ~service:election_draft_trustee_post (fun (uuid, token) public_key -> let@ () = without_site_user () in let* l = get_preferred_gettext () in let open (val l) in if token = "" then forbidden () else let* x = Web_election_mutex.with_lock uuid (fun () -> let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> let ts = match se.se_trustees with | `Basic x -> x.dbp_trustees | `Threshold _ -> [] in let&* t = List.find_opt (fun x -> token = x.st_token) ts in if t.st_public_key <> "" then let msg = s_ "A public key already existed, the key you've just \ uploaded has been ignored!" in let title = s_ "Error" in return_some (title, msg, 400) else let version = se.se_version in let module G = (val Group.of_string ~version se.se_group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let pk = trustee_public_key_of_string (sread G.of_string) public_key in let module K = Trustees.MakeCombinator (G) in if not (K.check [ `Single pk ]) then let msg = s_ "Invalid public key!" in let title = s_ "Error" in return_some (title, msg, 400) else ( (* we keep pk as a string because of G.t *) t.st_public_key <- public_key; let* () = Web_persist.set_draft_election uuid se in let msg = s_ "Your key has been received and checked!" in let title = s_ "Success" in return_some (title, msg, 200))) in match x with | None -> forbidden () | Some (title, msg, code) -> Pages_common.generic_page ~title msg () >>= Html.send ~code) let () = Any.register ~service:election_draft_confirm (fun uuid () -> let@ se = with_draft_election_ro uuid in Pages_admin.election_draft_confirm uuid se () >>= Html.send) let () = Any.register ~service:election_draft_create (fun uuid () -> let@ _, account, _ = with_site_user in let@ se = with_draft_election ~save:false uuid in Lwt.catch (fun () -> if Accounts.check account se.se_owners then let* s = Api_drafts.get_draft_status uuid se in let* () = Web_persist.validate_election uuid se s in redir_preapply election_admin uuid () else Lwt.fail (Failure "Forbidden")) (fun e -> Pages_admin.new_election_failure (`Exception e) () >>= Html.send)) let () = Any.register ~service:election_draft_destroy (fun uuid () -> let@ _ = with_draft_election ~save:false uuid in let* () = Web_persist.delete_draft uuid in Redirection.send (Redirection admin)) let () = Any.register ~service:election_draft_import (fun uuid () -> let@ _, account, _ = with_site_user in let@ se = with_draft_election_ro uuid in let* _, a, b, c = get_elections_by_owner_sorted account.id in Pages_admin.election_draft_import uuid se (a, b, c) () >>= Html.send) let () = Any.register ~service:election_draft_import_post (fun uuid from_s -> let from = Uuid.wrap from_s in let@ se = with_draft_election ~save:false uuid in let@ _ = with_metadata_check_owner from in let* l = get_preferred_gettext () in let open (val l) in let* x = Api_drafts.import_voters uuid se from in match x with | Ok () -> redir_preapply election_draft_voters uuid () | Error `Forbidden -> forbidden () | Error `NotFound -> Pages_common.generic_page ~title:(s_ "Error") ~service:(preapply ~service:election_draft_voters uuid) (Printf.sprintf (f_ "Could not retrieve voter list from election %s") from_s) () >>= Html.send | Error (`TotalWeightTooBig total_weight) -> Pages_common.generic_page ~title:(s_ "Error") ~service:(preapply ~service:election_draft_voters uuid) (Printf.sprintf (f_ "The total weight (%s) cannot be handled. Its expanded \ value must be less than %s.") Weight.(to_string total_weight) (Z.to_string Weight.max_expanded_weight)) () >>= Html.send | Error (`Duplicate x) -> Pages_common.generic_page ~title:(s_ "Error") ~service:(preapply ~service:election_draft_voters uuid) (Printf.sprintf (f_ "Duplicate voter: %s. This is not allowed. If two voters \ have the same address, use different logins.") x) () >>= Html.send) let () = Any.register ~service:election_draft_import_trustees (fun uuid () -> let@ _, account, _ = with_site_user in let@ se = with_draft_election_ro uuid in let* _, a, b, c = get_elections_by_owner_sorted account.id in Pages_admin.election_draft_import_trustees uuid se (a, b, c) () >>= Html.send) let () = Any.register ~service:election_draft_import_trustees_post (fun uuid from -> let from = Uuid.wrap from in let@ se = with_draft_election ~save:false uuid in let@ _ = with_metadata_check_owner from in let* metadata = Web_persist.get_election_metadata from in let* x = Api_drafts.import_trustees uuid se from metadata in match x with | Ok `Basic -> redir_preapply election_draft_trustees uuid () | Ok `Threshold -> redir_preapply election_draft_threshold_trustees uuid () | Stdlib.Error e -> let* l = get_preferred_gettext () in let open (val l) in let msg = match e with | `None -> s_ "Could not retrieve trustees from selected election!" | `Invalid -> s_ "Imported trustees are invalid for this election!" | `Inconsistent -> s_ "Inconsistency in imported election!" | `MissingPrivateKeys -> s_ "Encrypted decryption keys are missing!" | `Unsupported -> s_ "Unsupported trustees!" in Pages_common.generic_page ~title:(s_ "Error") ~service:(preapply ~service:election_draft_trustees uuid) msg () >>= Html.send) let election_admin_handler ?shuffle_token ?tally_token uuid = let* l = get_preferred_gettext () in let open (val l) in let@ election = with_election uuid in let* metadata = Web_persist.get_election_metadata uuid in let* site_user = Eliom_reference.get Web_state.site_user in match site_user with | Some (_, a, _) when Accounts.check a metadata.e_owners -> let* status = Api_elections.get_election_status uuid in Pages_admin.election_admin ?shuffle_token ?tally_token election metadata status () >>= Html.send | Some _ -> let msg = s_ "You are not allowed to administer this election!" in Pages_common.generic_page ~title:(s_ "Forbidden") msg () >>= Html.send ~code:403 | _ -> redir_preapply site_login (None, default_admin (ContSiteElection uuid)) () let () = Any.register ~service:election_admin (fun uuid () -> election_admin_handler uuid) let election_set_state state uuid () = let@ _ = with_metadata_check_owner uuid in let set = Web_persist.(if state then open_election else close_election) in let* b = set uuid in if b then 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 election_set_result_hidden uuid date = let@ _ = with_metadata_check_owner uuid in let* b = Api_elections.set_postpone_date uuid date in if b then redir_preapply election_admin uuid () else let* l = get_preferred_gettext () in let open (val l) in let service = preapply ~service:election_admin uuid in let msg = Printf.sprintf (f_ "The date must be less than %d days in the future!") days_to_publish_result in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send let parse_datetime_from_post l x = let open (val l : Belenios_ui.I18n.GETTEXT) in try Datetime.wrap x with _ -> Printf.ksprintf failwith (f_ "%s is not a valid date!") x let () = Any.register ~service:election_hide_result (fun uuid date -> let@ date cont = match Option.wrap Datetime.wrap date with | None -> let* l = get_preferred_gettext () in let open (val l) in let service = preapply ~service:election_admin uuid in let msg = Printf.sprintf (f_ "%s is not a valid date!") date in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send | Some t -> cont @@ Datetime.to_unixfloat t in election_set_result_hidden uuid (Some date)) let () = Any.register ~service:election_show_result (fun uuid () -> election_set_result_hidden uuid None) let () = Any.register ~service:election_auto_post (fun uuid (auto_open, auto_close) -> let@ _ = with_metadata_check_owner uuid in let* l = get_preferred_gettext () in let open (val l) in let auto_dates = try let format x = if x = "" then None else Some (parse_datetime_from_post l x) in Ok (format auto_open, format auto_close) with Failure e -> Error e in match auto_dates with | Ok (e_auto_open, e_auto_close) -> let open Belenios_api.Serializable_t in let dates = { auto_date_open = Option.map Datetime.to_unixfloat e_auto_open; auto_date_close = Option.map Datetime.to_unixfloat e_auto_close; } in let* () = Web_persist.set_election_automatic_dates uuid dates in redir_preapply election_admin uuid () | Error msg -> let service = preapply ~service:election_admin uuid in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send) let () = Any.register ~service:election_delete (fun uuid () -> let@ _ = with_metadata_check_owner uuid in let* () = Web_persist.delete_election uuid in redir_preapply admin () ()) let () = let rex = Pcre.regexp "\".*\" \".*:(.*)\"" in Any.register ~service:election_missing_voters (fun (uuid, ()) () -> let@ _ = with_metadata_check_owner uuid in let* voters = Web_persist.get_all_voters uuid in let voters = List.fold_left (fun accu x -> let _, login, _ = Voter.get x in SMap.add (Stdlib.String.lowercase_ascii login) x accu) SMap.empty voters in let* voters = let* file = Web_persist.get_records uuid in match file 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 SMap.remove (Stdlib.String.lowercase_ascii v) accu) voters rs) | None -> return voters in let buf = Buffer.create 128 in SMap.iter (fun v _ -> Buffer.add_string buf v; Buffer.add_char buf '\n') voters; let* x = String.send (Buffer.contents buf, "text/plain") in return @@ Eliom_registration.cast_unknown_content_kind x) let () = Any.register ~service:election_pretty_records (fun (uuid, ()) () -> let@ _ = with_metadata_check_owner uuid in let@ election = with_election uuid in let* records = Api_elections.get_records uuid in Pages_admin.pretty_records election records () >>= Html.send) let () = Any.register ~service:election_project_result (fun ((uuid, ()), index) () -> if index < 0 then fail_http `Not_found else let* hidden = let* x = Web_persist.get_election_result_hidden uuid in match x with None -> return_false | Some _ -> return_true in let* allow = if hidden then let* metadata = Web_persist.get_election_metadata uuid in let* site_user = Eliom_reference.get Web_state.site_user in match site_user with | Some (_, a, _) when Accounts.check a metadata.e_owners -> return_true | _ -> return_false else return_true in if allow then let* result = Web_persist.get_election_result uuid in match result with | None -> fail_http `Not_found | Some result -> ( let result = election_result_of_string Yojson.Safe.read_json result in match result.result with | `List xs -> ( match List.nth_opt xs index with | None -> fail_http `Not_found | Some x -> let* x = String.send (Yojson.Safe.to_string x, "application/json") in return @@ Eliom_registration.cast_unknown_content_kind x ) | _ -> fail_http `Not_found) else forbidden ()) let () = Any.register ~service:election_download_archive (fun (uuid, ()) () -> let@ _ = with_metadata_check_owner uuid in let* l = get_preferred_gettext () in let open (val l) in let* x = Web_persist.get_archive uuid in match x with | Some archive_name -> File.send ~content_type:"application/zip" archive_name | None -> let service = preapply ~service:election_admin uuid in Pages_common.generic_page ~title:(s_ "Error") ~service (s_ "The election is not archived!") () >>= Html.send) let find_trustee_id uuid token = let* x = Web_persist.get_decryption_tokens uuid in match x with | None -> return (int_of_string_opt token) | Some tokens -> let rec find i = function | [] -> None | t :: ts -> if t = token then Some i else find (i + 1) ts in return (find 1 tokens) let () = Any.register ~service:election_tally_trustees (fun (uuid, token) () -> let@ () = without_site_user ~fallback:(fun _ -> election_admin_handler ~tally_token:token uuid) () in let* l = get_preferred_gettext () in let open (val l) in let* state = Web_persist.get_election_state uuid in match state with | `EncryptedTally -> ( let* x = find_trustee_id uuid token in match x with | Some trustee_id -> let* pds = Web_persist.get_partial_decryptions uuid in if List.exists (fun x -> x.owned_owner = trustee_id) pds then Pages_common.generic_page ~title:(s_ "Error") (s_ "Your partial decryption has already been received and \ checked!") () >>= Html.send else Printf.sprintf "%s/election/trustees.html#%s-%s" !Web_config.prefix (Uuid.unwrap uuid) token |> String_redirection.send | None -> forbidden ()) | `Open | `Closed | `Shuffling -> let msg = s_ "The election is not ready to be tallied. Please come back \ later." in Pages_common.generic_page ~title:(s_ "Forbidden") msg () >>= Html.send ~code:403 | `Tallied | `Archived -> let msg = s_ "The election has already been tallied." in Pages_common.generic_page ~title:(s_ "Forbidden") msg () >>= Html.send ~code:403) let () = Html.register ~service:election_tally_trustees_static (fun () () -> Pages_admin.tally_trustees_static ()) exception TallyEarlyError let render_tally_early_error_as_forbidden f = Lwt.catch f (function TallyEarlyError -> forbidden () | e -> Lwt.fail e) let () = Any.register ~service:election_tally_trustees_post (fun (uuid, token) partial_decryption -> let@ () = render_tally_early_error_as_forbidden in let* l = get_preferred_gettext () in let open (val l) in let* () = let* state = Web_persist.get_election_state uuid in match state with | `EncryptedTally -> return () | _ -> Lwt.fail TallyEarlyError in let* trustee_id = let* x = find_trustee_id uuid token in match x with Some x -> return x | None -> Lwt.fail TallyEarlyError in let* pds = Web_persist.get_partial_decryptions uuid in let* () = if List.exists (fun x -> x.owned_owner = trustee_id) pds then Lwt.fail TallyEarlyError else return () in let* () = if trustee_id > 0 then return () else fail_http `Not_found in let@ election = with_election uuid in let module W = (val election) in let* pks = let* trustees = Web_persist.get_trustees uuid in let trustees = trustees_of_string W.(sread G.of_string) trustees in trustees |> List.map (function | `Single x -> [ x ] | `Pedersen t -> Array.to_list t.t_verification_keys) |> List.flatten |> Array.of_list |> return in let pk = pks.(trustee_id - 1).trustee_public_key in let pd = partial_decryption_of_string W.(sread G.of_string) partial_decryption in let* et = let* x = Web_persist.get_latest_encrypted_tally election in match x with | None -> assert false | Some x -> Lwt.return @@ encrypted_tally_of_string W.(sread G.of_string) x in if string_of_partial_decryption W.(swrite G.to_string) pd = partial_decryption && W.E.check_factor et pk pd then let pd = (trustee_id, partial_decryption) in let* () = Web_persist.add_partial_decryption uuid pd in Pages_common.generic_page ~title:(s_ "Success") (s_ "Your partial decryption has been received and checked!") () >>= Html.send else let service = preapply ~service:election_tally_trustees (uuid, token) in Pages_common.generic_page ~title:(s_ "Error") ~service (s_ "The partial decryption didn't pass validation!") () >>= Html.send) let handle_election_tally_release uuid () = let@ _ = with_metadata_check_owner uuid in let* l = get_preferred_gettext () in let open (val l) in Lwt.catch (fun () -> let* () = Web_persist.release_tally uuid in redir_preapply election_home (uuid, ()) ()) (fun e -> let msg = Printf.sprintf (f_ "An error occurred while computing the result (%s). Most \ likely, it means that some trustee has not done his/her job.") (Printexc.to_string e) in Pages_common.generic_page ~title:(s_ "Error") msg () >>= Html.send) let () = Any.register ~service:election_tally_release handle_election_tally_release let () = Any.register ~service:election_compute_encrypted_tally (fun uuid () -> let@ _ = with_metadata_check_owner uuid in let@ election = with_election uuid in let* _ = Web_persist.compute_encrypted_tally election in redir_preapply election_admin uuid ()) let () = Any.register ~service:election_shuffle_link (fun (uuid, token) () -> let@ () = without_site_user ~fallback:(fun _ -> election_admin_handler ~shuffle_token:token uuid) () in let* expected_token = Web_persist.get_shuffle_token uuid in match expected_token with | Some x when token = x.tk_token -> Printf.sprintf "%s/election/shuffle.html#%s-%s" !Web_config.prefix (Uuid.unwrap uuid) token |> String_redirection.send | _ -> forbidden ()) let () = Html.register ~service:election_shuffle_link_static (fun () () -> Pages_admin.shuffle_static ()) let () = Any.register ~service:election_shuffle_post (fun (uuid, token) shuffle -> let@ election = with_election uuid in let@ () = without_site_user () in let* l = get_preferred_gettext () in let open (val l) in let* expected_token = Web_persist.get_shuffle_token uuid in match expected_token with | Some x when token = x.tk_token -> Lwt.catch (fun () -> let* y = Web_persist.append_to_shuffles election x.tk_trustee_id shuffle in match y with | Some _ -> let* () = Web_persist.clear_shuffle_token uuid in let* () = Web_persist.remove_audit_cache uuid in Pages_common.generic_page ~title:(s_ "Success") (s_ "The shuffle has been successfully applied!") () >>= Html.send | None -> Pages_common.generic_page ~title:(s_ "Error") (s_ "An error occurred while applying the shuffle.") () >>= Html.send) (fun e -> Pages_common.generic_page ~title:(s_ "Error") (Printf.sprintf (f_ "Data is invalid! (%s)") (Printexc.to_string e)) () >>= Html.send) | _ -> forbidden ()) let () = Any.register ~service:election_shuffler_select (fun () (uuid, trustee) -> let@ metadata = with_metadata_check_owner uuid in let* () = Api_elections.select_shuffler uuid metadata trustee in redir_preapply election_admin uuid ()) let () = Any.register ~service:election_shuffler_skip_confirm (fun () (uuid, trustee) -> let@ _ = with_metadata_check_owner uuid in Pages_admin.election_shuffler_skip_confirm uuid trustee >>= Html.send) let () = Any.register ~service:election_shuffler_skip (fun () (uuid, trustee) -> let@ _ = with_metadata_check_owner uuid in let* () = Api_elections.skip_shuffler uuid trustee in redir_preapply election_admin uuid ()) let () = Any.register ~service:election_decrypt (fun uuid () -> let@ _ = with_metadata_check_owner uuid in let@ election = with_election uuid in let* _ = Web_persist.finish_shuffling election in redir_preapply election_admin uuid ()) let () = Any.register ~service:election_draft_threshold_set (fun uuid threshold -> let@ se = with_draft_election ~save:false uuid in let* l = get_preferred_gettext () in let open (val l) in let* x = Api_drafts.set_threshold uuid se threshold in match x with | Ok () -> redir_preapply election_draft_threshold_trustees uuid () | Error `NoTrustees -> let msg = s_ "Please add some trustees first!" in let service = preapply ~service:election_draft_threshold_trustees uuid in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send | Error `OutOfBounds -> let msg = s_ "The threshold must be positive and smaller than the number of \ trustees!" in let service = preapply ~service:election_draft_threshold_trustees uuid in Pages_common.generic_page ~title:(s_ "Error") ~service msg () >>= Html.send) let () = Any.register ~service:election_draft_threshold_trustee_add (handle_trustee_add (`Threshold 0)) let () = Any.register ~service:election_draft_threshold_trustee_del (handle_trustee_del election_draft_threshold_trustees) let () = Any.register ~service:election_draft_threshold_trustee (fun (uuid, token) () -> let@ () = without_site_user ~fallback:(fun (_, a, _) -> let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> if Accounts.check a se.se_owners then Pages_admin.election_draft_threshold_trustees ~token uuid se () >>= Html.send else forbidden ()) () in let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some _ -> Printf.sprintf "%s/draft/threshold-trustee.html#%s-%s" !Web_config.prefix (Uuid.unwrap uuid) token |> String_redirection.send) let () = Html.register ~service:election_draft_threshold_trustee_static (fun () () -> Pages_admin.election_draft_threshold_trustee_static ()) let wrap_handler_without_site_user f = without_site_user () (fun () -> wrap_handler f) let () = Any.register ~service:election_draft_threshold_trustee_post (fun (uuid, token) data -> let@ () = wrap_handler_without_site_user in let* () = Web_election_mutex.with_lock uuid (fun () -> let* election = Web_persist.get_draft_election uuid in match election with | None -> fail_http `Not_found | Some se -> let dtp = match se.se_trustees with | `Basic _ -> failwith "No threshold trustees" | `Threshold x -> x in let ts = Array.of_list dtp.dtp_trustees 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 version = se.se_version in let module G = (val Group.of_string ~version se.se_group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let module P = Trustees.MakePKI (G) (Random) in let module C = Trustees.MakeChannels (G) (Random) (P) in let module K = Trustees.MakePedersen (G) (Random) (P) (C) in let* () = 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 (sread G.of_string) 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" in let* () = if Array.for_all (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 -> dtp.dtp_error <- Some (Printexc.to_string e)); return_unit) else return_unit in let* () = if Array.for_all (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 -> dtp.dtp_error <- Some (Printexc.to_string e)); return_unit) else return_unit in let* () = if Array.for_all (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 (sread G.of_string) y) ts in let p = K.step6 certs polynomials voutputs in dtp.dtp_parameters <- Some (string_of_threshold_parameters (swrite G.to_string) p); Array.iter (fun x -> x.stt_step <- Some 7) ts with e -> dtp.dtp_error <- Some (Printexc.to_string e)); return_unit) else return_unit in Web_persist.set_draft_election uuid se) in redir_preapply election_draft_threshold_trustee (uuid, token) ()) module HashedInt = struct type t = int let equal = ( = ) let hash x = x end module Captcha_throttle = Lwt_throttle.Make (HashedInt) let captcha_throttle = Captcha_throttle.create ~rate:1 ~max:5 ~n:1 let signup_captcha_handler service error email = let* l = get_preferred_gettext () in let open (val l) in let* b = Captcha_throttle.wait captcha_throttle 0 in if b then let* challenge = Web_captcha.create_captcha () in Pages_admin.signup_captcha ~service error challenge email else let service = preapply ~service:signup_captcha service in Pages_common.generic_page ~title:(s_ "Account creation") ~service (s_ "You cannot create an account now. Please try later.") () let () = Html.register ~service:signup_captcha (fun service () -> let* b = Eliom_reference.get Web_state.show_cookie_disclaimer in if b then Pages_admin.privacy_notice (ContSignup service) else signup_captcha_handler service None "") let () = Html.register ~service:signup_captcha_post (fun service (challenge, (response, email)) -> let* l = get_preferred_gettext () in let open (val l) in let* error = let* ok = Web_captcha.check_captcha ~challenge ~response in if ok then if is_email email then return_none else return_some BadAddress else return_some BadCaptcha in match error with | None -> let* () = Web_signup.send_confirmation_code l ~service email in let* () = Eliom_reference.set Web_state.signup_address (Some email) in Pages_admin.signup_login () | _ -> signup_captcha_handler service error email) let changepw_captcha_handler service error email username = let* l = get_preferred_gettext () in let open (val l) in let* b = Captcha_throttle.wait captcha_throttle 1 in if b then let* challenge = Web_captcha.create_captcha () in Pages_admin.signup_changepw ~service error challenge email username else let service = preapply ~service:changepw_captcha service in Pages_common.generic_page ~title:(s_ "Change password") ~service (s_ "You cannot change your password now. Please try later.") () let () = Html.register ~service:changepw_captcha (fun service () -> changepw_captcha_handler service None "" "") let () = Html.register ~service:changepw_captcha_post (fun service (challenge, (response, (email, username))) -> let* l = get_preferred_gettext () in let open (val l) in let* error = let* ok = Web_captcha.check_captcha ~challenge ~response in if ok then return_none else return_some BadCaptcha in match error with | None -> let* () = let* x = Web_auth_password.lookup_account ~service ~email ~username in match x with | None -> return (Printf.ksprintf Ocsigen_messages.warning "Unsuccessful attempt to change the password of %S (%S) \ for service %s" username email service) | Some (username, address) -> let* () = Eliom_reference.set Web_state.signup_address (Some address) in Web_signup.send_changepw_code l ~service ~address ~username in Pages_admin.signup_login () | _ -> changepw_captcha_handler service error email username) let () = Any.register ~service:signup_login_post (fun () code -> let code = Stdlib.String.trim code in let* address = Eliom_reference.get Web_state.signup_address in match address with | None -> forbidden () | Some address -> ( match Web_signup.confirm_code ~address ~code with | Some x -> let* () = Eliom_reference.set Web_state.signup_env (Some x) in redir_preapply signup () () | _ -> forbidden ())) let () = Any.register ~service:signup (fun () () -> let* address = Eliom_reference.get Web_state.signup_address in let* x = Eliom_reference.get Web_state.signup_env in match (address, x) with | Some address, Some { kind = CreateAccount; _ } -> Pages_admin.signup address None "" >>= Html.send | Some address, Some { kind = ChangePassword { username }; _ } -> Pages_admin.changepw ~username ~address None >>= Html.send | _ -> forbidden ()) let () = Any.register ~service:signup_post (fun () (username, (password, password2)) -> let* l = get_preferred_gettext () in let open (val l) in let* address = Eliom_reference.get Web_state.signup_address in let* x = Eliom_reference.get Web_state.signup_env in match (address, x) with | Some email, Some { service; kind = CreateAccount } -> if password = password2 then let user = { user_name = username; user_domain = service } in let* x = Web_auth_password.add_account user ~password ~email in match x with | Ok () -> let* () = Web_state.discard () in let service = preapply ~service:site_login (Some service, default_admin ContSiteAdmin) in Pages_common.generic_page ~title:(s_ "Account creation") ~service (s_ "The account has been created.") () >>= Html.send | Error e -> Pages_admin.signup email (Some e) username >>= Html.send else Pages_admin.signup email (Some PasswordMismatch) username >>= Html.send | _ -> forbidden ()) let () = Any.register ~service:changepw_post (fun () (password, password2) -> let* l = get_preferred_gettext () in let open (val l) in let* address = Eliom_reference.get Web_state.signup_address in let* x = Eliom_reference.get Web_state.signup_env in match (address, x) with | Some address, Some { service; kind = ChangePassword { username } } -> if password = password2 then let user = { user_name = username; user_domain = service } in let* x = Web_auth_password.change_password user ~password in match x with | Ok () -> let* () = Web_state.discard () in let service = preapply ~service:site_login (Some service, default_admin ContSiteAdmin) in Pages_common.generic_page ~title:(s_ "Change password") ~service (s_ "The password has been changed.") () >>= Html.send | Error e -> Pages_admin.changepw ~username ~address (Some e) >>= Html.send else Pages_admin.changepw ~username ~address (Some PasswordMismatch) >>= Html.send | _ -> forbidden ()) let () = Html.register ~service:compute_fingerprint (fun () () -> Pages_admin.compute_fingerprint ()) let has_sudo_capability f = let* x = Eliom_reference.get Web_state.site_user in match x with | Some (_, a, token) when Accounts.(has_capability Sudo a) -> f token | _ -> forbidden () let () = Any.register ~service:sudo (fun () () -> let@ _ = has_sudo_capability in Pages_admin.sudo () >>= Html.send) let () = Any.register ~service:sudo_post (fun () (user_domain, user_name) -> let@ token = has_sudo_capability in let u = { user_domain; user_name } in let* x = Accounts.get_account u in match x with | None -> let* l = get_preferred_gettext () in let open (val l) in let msg = s_ "This account does not exist" in let title = s_ "Account not found" in Pages_common.generic_page ~title ~service:sudo msg () >>= Html.send | Some a -> let () = Api_generic.invalidate_token token in let* token = Api_generic.new_token a in let* () = Eliom_reference.set Web_state.site_user (Some (u, a, token)) in Redirection.send (Redirection admin)) let with_user_and_account f = let* x = Eliom_reference.get Web_state.site_user in match x with Some x -> f x | None -> forbidden () let () = Any.register ~service:account (fun () () -> let@ _, a, _ = with_user_and_account in Pages_admin.account a >>= Html.send) let () = Any.register ~service:account_post (fun () name -> let@ _, a, _ = with_user_and_account in let a = { a with name } in let* () = Accounts.update_account a in Redirection.send (Redirection admin)) let () = Any.register ~service:api_token (fun () () -> let* x = Eliom_reference.get Web_state.site_user in let code, content = match x with | None -> (403, "Forbidden") | Some (_, _, token) -> (200, token) in String.send ~code (content, "text/plain")) let process_election_for_data_policy (action, uuid, next_t) = let uuid_s = Uuid.unwrap uuid in let now = Datetime.now () in let action, comment = match action with | `Destroy -> (Web_persist.delete_draft, "destroyed") | `Delete -> (Web_persist.delete_election, "deleted") | `Archive -> (Web_persist.archive_election, "archived") in if Datetime.compare now next_t > 0 then let* () = action uuid in return (Printf.ksprintf Ocsigen_messages.warning "Election %s has been automatically %s" uuid_s comment) else return_unit let rec data_policy_loop () = let open Ocsigen_messages in let () = accesslog "Data policy process started" in let* elections = Web_persist.get_next_actions () in let* () = Lwt_list.iter_s process_election_for_data_policy elections in let () = accesslog "Data policy process completed" in let* () = Lwt_unix.sleep 3600. in data_policy_loop () end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_cas.ml0000644000175000017500000001463514476041226023227 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Eliom_service open Belenios_core.Common open Web_common module Make (Web_auth : Web_auth_sig.S) = struct let next_lf str i = String.index_from_opt str i '\n' let login_cas = Eliom_service.create ~path:(Eliom_service.Path [ "auth"; "cas" ]) ~meth: (Eliom_service.Get Eliom_parameter.(string "state" ** opt (string "ticket"))) () let cas_self ~state = Eliom_uri.make_string_uri ~absolute:true ~service:(preapply ~service:login_cas (state, None)) () |> rewrite_prefix let extract tag xs = let rec loop = function | [] -> None | x :: xs -> ( match x with | Xml.Element (tag', _, children) when tag = tag' -> Some children | _ -> loop xs) in loop xs let extract_pcdata = function [ Xml.PCData x ] -> Some x | _ -> None let parse_cas_validation_v2 info = let ( >>= ) = Option.bind and ( let* ) = Option.bind in try let* info = Some [ Xml.parse_string info ] >>= extract "cas:serviceResponse" >>= extract "cas:authenticationSuccess" in let* user = extract "cas:user" info >>= extract_pcdata in let mail = extract "cas:attributes" info >>= extract "cas:mail" >>= extract_pcdata in let mail = match mail with Some x -> x | None -> "" in Some (user, mail) with _ -> None let get_cas_validation_v2 server ~state ticket = let url = let cas_validate = Eliom_service.extern ~prefix:server ~path:[ "serviceValidate" ] ~meth: (Eliom_service.Get Eliom_parameter.(string "service" ** string "ticket")) () in let service = preapply ~service:cas_validate (cas_self ~state, ticket) in Eliom_uri.make_string_uri ~absolute:true ~service () in let* r, body = Cohttp_lwt_unix.Client.get (Uri.of_string url) in if Cohttp.(Code.code_of_status (Response.status r)) = 200 then let* info = Cohttp_lwt.Body.to_string body in return @@ parse_cas_validation_v2 info else return_none let parse_cas_validation_v1 info = match next_lf info 0 with | Some i -> ( match String.sub info 0 i with | "yes" -> let x = let& j = next_lf info (i + 1) in Some (String.sub info (i + 1) (j - i - 1), "") in `Yes x | "no" -> `No | _ -> `Error `Parsing) | None -> `Error `Parsing let get_cas_validation_v1 server ~state ticket = let url = let cas_validate = Eliom_service.extern ~prefix:server ~path:[ "validate" ] ~meth: (Eliom_service.Get Eliom_parameter.(string "service" ** string "ticket")) () in let service = preapply ~service:cas_validate (cas_self ~state, ticket) in Eliom_uri.make_string_uri ~absolute:true ~service () in let* _, body = Cohttp_lwt_unix.Client.get (Uri.of_string url) in let* info = Cohttp_lwt.Body.to_string body in return (parse_cas_validation_v1 info) let get_cas_validation server ~state ticket = let* v2 = get_cas_validation_v2 server ~state ticket in match v2 with | None -> get_cas_validation_v1 server ~state ticket | Some _ -> return @@ `Yes v2 let auth_system _ a = let module X = struct let pre_login_handler _ ~state = match List.assoc_opt "server" a.Web_serializable_t.auth_config with | Some server -> let cas_login = Eliom_service.extern ~prefix:server ~path:[ "login" ] ~meth:(Eliom_service.Get Eliom_parameter.(string "service")) () in let service = preapply ~service:cas_login (cas_self ~state) in let url = Eliom_uri.make_string_uri ~service ~absolute:true () |> rewrite_prefix in return @@ Web_auth_sig.Redirection url | _ -> failwith "cas_login_handler invoked with bad config" let direct _ = failwith "direct authentication not implemented for CAS" end in (module X : Web_auth_sig.AUTH_SYSTEM) let run_post_login_handler = Web_auth.register ~auth_system:"cas" auth_system let cas_handler (state, ticket) () = run_post_login_handler ~state { Web_auth.post_login_handler = (fun _ a cont -> match (ticket, List.assoc_opt "server" a.Web_serializable_t.auth_config) with | Some x, Some server -> ( let* r = get_cas_validation server ~state x in match r with | `Yes (Some name_and_email) -> cont (Some name_and_email) | `No -> cont None | `Yes None | `Error _ -> fail_http `Bad_gateway) | None, _ -> cont None | _, None -> fail_http `Service_unavailable); } let () = Eliom_registration.Any.register ~service:login_cas cas_handler end belenios-2.2-10-gbb6b7ea8/src/web/server/common/site_common.ml0000644000175000017500000001104214476041226023104 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios open Web_common module Make (X : Pages_sig.S) = struct open X open Web_services open Eliom_service open Eliom_registration let get_preferred_gettext () = Web_i18n.get_preferred_gettext "voter" let find_election uuid = let* election = Web_persist.get_raw_election uuid in match election with | Some e -> let module W = Election.Make (struct let raw_election = e end) (Random) () in return_some (module W : Site_common_sig.ELECTION) | _ -> return_none let election_not_found () = let* l = get_preferred_gettext () in let open (val l) in Pages_common.generic_page ~title:(s_ "Not found") (s_ "This election does not exist. This may happen for elections that \ have not yet been open or have been deleted.") () >>= Html.send ~code:404 let with_election uuid f = let* x = find_election uuid in match x with None -> election_not_found () | Some election -> f election let () = File.register ~service:source_code ~content_type:"application/x-gzip" (fun () () -> return !Web_config.source_file) let () = Any.register ~service:logo (fun () () -> match !Web_config.logo with | None -> fail_http `Not_found | Some (file, content_type) -> File.send ~content_type file) let () = Any.register ~service:favicon (fun () () -> match !Web_config.favicon with | None -> fail_http `Not_found | Some (file, content_type) -> File.send ~content_type file) let redir_preapply s u () = Redirection.send (Redirection (preapply ~service:s u)) let wrap_handler f = Lwt.catch f (fun e -> Pages_common.generic_page ~title:"Error" (Printexc.to_string e) () >>= Html.send) let get_cont_state cont = let redir = match cont.path with | ContSiteHome -> Redirection home | ContSiteAdmin -> Redirection admin | ContSiteElection uuid -> Redirection (preapply ~service:election_home (uuid, ())) in fun () -> Redirection.send redir let () = Any.register ~service:set_cookie_disclaimer (fun cont () -> let* () = Eliom_reference.set Web_state.show_cookie_disclaimer false in get_cont_state cont ()) let () = Any.register ~service:election_nh_ciphertexts (fun uuid () -> let* x = find_election uuid in match x with | None -> fail_http `Not_found | Some election -> let* x = Web_persist.get_nh_ciphertexts election in String.send (x, "application/json")) let () = Any.register ~service:set_language (fun (lang, cont) () -> let* () = Eliom_reference.set Web_state.language (Some lang) in get_cont_state cont ()) let forbidden () = let* l = get_preferred_gettext () in let open (val l) in let msg = s_ "You are not allowed to access this page!" in Pages_common.generic_page ~title:(s_ "Forbidden") msg () >>= Html.send ~code:403 end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_persist.ml0000644000175000017500000016455414476041226023137 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Signatures open Belenios open Serializable_j open Common open Web_serializable_j open Web_common let get_spool_version () = let* x = Filesystem.read_file !!"version" in match x with | Some [ version ] -> return @@ int_of_string version | _ -> return 0 let elections_by_owner_cache = ref None let elections_by_owner_mutex = Lwt_mutex.create () let clear_elections_by_owner_cache () = let@ () = Lwt_mutex.with_lock elections_by_owner_mutex in elections_by_owner_cache := None; return_unit let get_draft_election uuid = Spool.get ~uuid Spool.draft let set_draft_election uuid = Spool.set ~uuid Spool.draft let get_from_data uuid f = let* x = Web_events.get_roots ~uuid in match f x with | None -> Lwt.return_none | Some x -> Web_events.get_data ~uuid x let get_setup_data uuid = let* x = let* x = Web_events.get_roots ~uuid in let&* x = x.roots_setup_data in Web_events.get_data ~uuid x in match x with | None -> assert false | Some x -> Lwt.return (setup_data_of_string x) let get_from_setup_data uuid f = let* x = Web_events.get_roots ~uuid in match x.roots_setup_data with | None -> Lwt.return_none | Some x -> ( let* x = Web_events.get_data ~uuid x in match x with | None -> Lwt.return_none | Some x -> Web_events.get_data ~uuid (f (setup_data_of_string x))) let fold_on_event_payload_hashes uuid typ last_event f accu = let rec loop e accu = let* e = Web_events.get_event ~uuid e in match e with | None -> assert false | Some e -> if e.event_typ = typ then match (e.event_payload, e.event_parent) with | Some payload, Some parent -> let* accu = f payload accu in loop parent accu | _ -> assert false else Lwt.return accu in loop last_event accu let fold_on_event_payloads uuid typ last_event f accu = fold_on_event_payload_hashes uuid typ last_event (fun payload accu -> let* x = Web_events.get_data ~uuid payload in match x with None -> assert false | Some x -> f payload x accu) accu let get_election_result uuid = get_from_data uuid (fun x -> x.roots_result) let set_election_result_hidden uuid hidden = match hidden with | None -> Spool.del ~uuid Spool.hide_result | Some d -> Spool.set ~uuid Spool.hide_result d let get_election_result_hidden uuid = let* t = Spool.get ~uuid Spool.hide_result in let&* t = t in if Datetime.compare (Datetime.now ()) t < 0 then return_some t else let* () = set_election_result_hidden uuid None in return_none let default_dates = { e_creation = None; e_finalization = None; e_tally = None; e_archive = None; e_last_mail = None; e_auto_open = None; e_auto_close = None; } let get_election_dates uuid = let* x = Spool.get ~uuid Spool.dates in Lwt.return (Option.value ~default:default_dates x) let set_election_dates uuid x = let* () = Spool.set ~uuid Spool.dates x in clear_elections_by_owner_cache () let set_election_state uuid s = let* () = match s with | `Archived -> Spool.del ~uuid Spool.state | _ -> Spool.set ~uuid Spool.state s in clear_elections_by_owner_cache () let get_raw_election uuid = get_from_setup_data uuid (fun x -> x.setup_election) let get_sized_encrypted_tally uuid = let* roots = Web_events.get_roots ~uuid in match roots.roots_encrypted_tally with | None -> Lwt.return_none | Some x -> ( let* x = Web_events.get_data ~uuid x in match x with None -> assert false | Some x -> Lwt.return_some x) let get_nh_ciphertexts election = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let* x = Web_events.get_roots ~uuid in match x.roots_last_shuffle_event with | None -> ( match x.roots_encrypted_tally with | None -> assert false | Some x -> ( let* x = Web_events.get_data ~uuid x in match x with | None -> assert false | Some x -> ( let x = sized_encrypted_tally_of_string read_hash x in let* x = Web_events.get_data ~uuid x.sized_encrypted_tally in match x with | None -> assert false | Some x -> encrypted_tally_of_string W.(sread G.of_string) x |> W.E.extract_nh_ciphertexts |> string_of_nh_ciphertexts W.(swrite G.to_string) |> return))) | Some x -> ( let* x = Web_events.get_event ~uuid x in match x with | None -> assert false | Some x -> ( match x.event_payload with | None -> assert false | Some x -> ( let* x = Web_events.get_data ~uuid x in match x with | None -> assert false | Some x -> ( let x = owned_of_string read_hash x in let* x = Web_events.get_data ~uuid x.owned_payload in match x with | None -> assert false | Some x -> let x = shuffle_of_string W.(sread G.of_string) x in return @@ string_of_nh_ciphertexts W.(swrite G.to_string) x.shuffle_ciphertexts)))) let get_latest_encrypted_tally election = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let* roots = Web_events.get_roots ~uuid in let@ tally cont = match roots.roots_encrypted_tally with | None -> return_none | Some x -> ( let* x = Web_events.get_data ~uuid x in match x with | None -> assert false | Some x -> ( let x = sized_encrypted_tally_of_string read_hash x in let* x = Web_events.get_data ~uuid x.sized_encrypted_tally in match x with | None -> assert false | Some x -> cont @@ encrypted_tally_of_string W.(sread G.of_string) x)) in let* nh = get_nh_ciphertexts election in let nh = nh_ciphertexts_of_string W.(sread G.of_string) nh in let tally = W.E.merge_nh_ciphertexts nh tally in return_some @@ string_of_encrypted_tally W.(swrite G.to_string) tally let get_trustees uuid = let* x = get_from_setup_data uuid (fun x -> x.setup_trustees) in let@ () = fun cont -> match x with None -> cont () | Some x -> return x in let msg = Printf.sprintf "missing trustees for election %s" (Uuid.unwrap uuid) in Lwt.fail (Failure msg) let get_partial_decryptions uuid = let* x = Web_events.get_roots ~uuid in match x.roots_last_pd_event with | None -> Lwt.return [] | Some x -> fold_on_event_payloads uuid `PartialDecryption x (fun _ x accu -> let x = owned_of_string read_hash x in let* pd = let* x = Web_events.get_data ~uuid x.owned_payload in match x with None -> assert false | Some x -> Lwt.return x in let x = { x with owned_payload = pd } in Lwt.return @@ (x :: accu)) [] let get_private_key uuid = Spool.get ~uuid Spool.private_key let get_private_keys uuid = Spool.get ~uuid Spool.private_keys let empty_metadata = { e_owners = []; e_auth_config = None; e_cred_authority = None; e_trustees = None; e_languages = None; e_contact = None; e_booth_version = None; } let get_election_metadata uuid = let* x = Spool.get ~uuid Spool.metadata in Lwt.return (Option.value ~default:empty_metadata x) let get_owned_shuffles uuid = let* x = Web_events.get_roots ~uuid in match x.roots_last_shuffle_event with | None -> return_none | Some x -> let* x = fold_on_event_payloads uuid `Shuffle x (fun h x accu -> return @@ ((h, owned_of_string read_hash x) :: accu)) [] in return_some x let remove_audit_cache uuid = Spool.del ~uuid Spool.audit_cache let raw_get_shuffles uuid x = let* x = Lwt_list.map_s (fun (h, o) -> let* x = Web_events.get_data ~uuid o.owned_payload in match x with None -> assert false | Some x -> Lwt.return (h, o, x)) x in Lwt.return_some x let append_to_shuffles election owned_owner shuffle_s = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let@ last cont = let* x = Spool.get ~uuid Spool.last_event in match x with None -> assert false | Some x -> cont x in let shuffle = shuffle_of_string W.(sread G.of_string) shuffle_s in let shuffle_h = Hash.hash_string shuffle_s in let* last_nh = get_nh_ciphertexts election in let last_nh = nh_ciphertexts_of_string W.(sread G.of_string) last_nh in if string_of_shuffle W.(swrite G.to_string) shuffle = shuffle_s && W.E.check_shuffle last_nh shuffle then let owned = { owned_owner; owned_payload = shuffle_h } in let owned_s = string_of_owned write_hash owned in let* () = Web_events.append ~uuid ~last [ Data shuffle_s; Data owned_s; Event (`Shuffle, Some (Hash.hash_string owned_s)); ] in return_some @@ sha256_b64 shuffle_s else return_none let get_shuffles uuid = let@ raw_election cont = let* x = get_raw_election uuid in match x with None -> Lwt.return_none | Some x -> cont x in let module W = Election.Make (struct let raw_election = raw_election end) (Random) () in let election = (module W : Site_common_sig.ELECTION) in let* x = get_owned_shuffles uuid in match x with | Some x -> raw_get_shuffles uuid x | None -> (* if we are in `Shuffling state and there are no shuffles, perform a server-side shuffle *) let@ () = fun cont -> let* state = Spool.get ~uuid Spool.state in match state with Some `Shuffling -> cont () | _ -> Lwt.return_none in let* cc = get_nh_ciphertexts election in let cc = nh_ciphertexts_of_string W.(sread G.of_string) cc in let shuffle = W.E.shuffle_ciphertexts cc in let shuffle = string_of_shuffle W.(swrite G.to_string) shuffle in let* x = append_to_shuffles election 1 shuffle in let&* _ = x in let* () = remove_audit_cache uuid in let* x = get_owned_shuffles uuid in let&* x = x in raw_get_shuffles uuid x let make_result_transaction write_result result = let payload = string_of_election_result write_result result in let open Web_events in [ Data payload; Event (`Result, Some (Hash.hash_string payload)) ] let clear_shuffle_token uuid = Spool.del ~uuid Spool.shuffle_token let internal_release_tally ~force uuid = let@ last cont = let* x = Spool.get ~uuid Spool.last_event in match x with None -> assert false | Some x -> cont x in let* metadata = get_election_metadata uuid in let trustees_with_ids = Option.value metadata.e_trustees ~default:[ "server" ] |> List.mapi (fun i x -> (i + 1, x)) in let* pds = get_partial_decryptions uuid in let@ () = fun cont -> if force then cont () else if (* check whether all trustees have done their job *) List.for_all (fun (i, x) -> x = "server" || List.exists (fun x -> x.owned_owner = i) pds) trustees_with_ids then cont () else Lwt.return_false in let@ raw_election cont = let* x = get_raw_election uuid in match x with None -> assert false | Some x -> cont x in let module W = Election.Make (struct let raw_election = raw_election end) (Random) () in let* tally = let* x = get_latest_encrypted_tally (module W) in match x with | None -> assert false | Some x -> Lwt.return @@ encrypted_tally_of_string W.(sread G.of_string) x in let* sized = let* x = get_sized_encrypted_tally uuid in match x with | None -> assert false | Some x -> let x = sized_encrypted_tally_of_string read_hash x in Lwt.return { x with sized_encrypted_tally = tally } in let* trustees = let* x = get_trustees uuid in Lwt.return @@ trustees_of_string W.(sread G.of_string) x in let* pds, transactions = let pds = List.rev_map (fun x -> let owned_payload = partial_decryption_of_string W.(sread G.of_string) x.owned_payload in { x with owned_payload }) pds in let decrypt owned_owner = let* x = get_private_key uuid in match x with | None -> assert false | Some sk -> let pd = W.E.compute_factor tally sk in let owned = { owned_owner; owned_payload = pd } in let pd = string_of_partial_decryption W.(swrite G.to_string) pd in let payload = { owned_owner; owned_payload = Hash.hash_string pd } |> string_of_owned write_hash in let transaction = let open Web_events in [ Data pd; Data payload; Event (`PartialDecryption, Some (Hash.hash_string payload)); ] in Lwt.return (owned, transaction) in Lwt_list.fold_left_s (fun ((pds, transactions) as accu) (i, t) -> if t = "server" then if List.exists (fun x -> x.owned_owner = i) pds then Lwt.return accu else let* pd, transaction = decrypt i in Lwt.return (pd :: pds, transaction :: transactions) else Lwt.return accu) (pds, []) trustees_with_ids in match W.E.compute_result sized pds trustees with | Ok result -> let result_transaction = make_result_transaction W.write_result result in let* () = List.rev (result_transaction :: transactions) |> List.flatten |> Web_events.append ~uuid ~last in let* () = remove_audit_cache uuid in let* () = set_election_state uuid `Tallied in let* dates = get_election_dates uuid in let* () = set_election_dates uuid { dates with e_tally = Some (Datetime.now ()) } in let* () = Spool.del ~uuid Spool.decryption_tokens in let* () = clear_shuffle_token uuid in Lwt.return_true | Error e -> Lwt.fail @@ Failure (Trustees.string_of_combination_error e) let raw_get_election_state ?(update = true) ?(ignore_errors = true) uuid = let* x = Spool.get ~uuid Spool.state in let@ state cont = match x with Some x -> cont x | None -> return `Archived in let now = Datetime.now () in let* dates = get_election_dates uuid in let past = function None -> false | Some t -> Datetime.compare t now < 0 in let@ () = fun cont -> match state with | `EncryptedTally when update -> ( let* hidden = get_election_result_hidden uuid in match hidden with | Some _ when not (past hidden) -> cont () | _ -> let@ () = fun cont2 -> if ignore_errors then Lwt.catch cont2 (fun _ -> cont ()) else cont2 () in let* b = internal_release_tally ~force:false uuid in return (if b then `Tallied else state)) | _ -> cont () in let new_state = match state with `Closed when past dates.e_auto_open -> `Open | x -> x in let new_state = match new_state with | `Open when past dates.e_auto_close -> `Closed | x -> x in let* () = if update && new_state <> state then set_election_state uuid new_state else return_unit in return new_state let get_election_state uuid = raw_get_election_state uuid let release_tally uuid = let* state = get_election_state uuid in match state with | `EncryptedTally -> let* b = internal_release_tally ~force:true uuid in assert b; set_election_state uuid `Tallied | _ -> Lwt.fail @@ Failure "election not in EncryptedTally state" let add_partial_decryption uuid (owned_owner, pd) = let payload = { owned_owner; owned_payload = Hash.hash_string pd } |> string_of_owned write_hash in Web_events.append ~uuid [ Data pd; Data payload; Event (`PartialDecryption, Some (Hash.hash_string payload)); ] let get_decryption_tokens uuid = Spool.get ~uuid Spool.decryption_tokens let set_decryption_tokens uuid = Spool.set ~uuid Spool.decryption_tokens type election_kind = [ `Draft | `Validated | `Tallied | `Archived ] let umap_add user x map = let xs = match IMap.find_opt user map with None -> [] | Some xs -> xs in IMap.add user (x :: xs) map let build_elections_by_owner_cache () = Lwt_unix.files_of_directory !Web_config.spool_dir |> Lwt_stream.to_list >>= Lwt_list.fold_left_s (fun accu uuid_s -> if uuid_s = "." || uuid_s = ".." then return accu else Lwt.catch (fun () -> let uuid = Uuid.wrap uuid_s in let* election = get_draft_election uuid in match election with | None -> ( let* metadata = get_election_metadata uuid in let ids = metadata.e_owners in let* election = get_raw_election uuid in match election with | None -> return accu | Some election -> let* dates = get_election_dates uuid in let* kind, date = let* state = raw_get_election_state ~update:false uuid in match state with | `Open | `Closed | `Shuffling | `EncryptedTally -> let date = Option.value dates.e_finalization ~default:default_validation_date in return (`Validated, date) | `Tallied -> let date = Option.value dates.e_tally ~default:default_tally_date in return (`Tallied, date) | `Archived -> let date = Option.value dates.e_archive ~default:default_archive_date in return (`Archived, date) in let election = Election.of_string election in let item = (kind, uuid, date, election.e_name) in return @@ List.fold_left (fun accu id -> umap_add id item accu) accu ids) | Some se -> let date = Option.value se.se_creation_date ~default:default_creation_date in let ids = se.se_owners in let item = (`Draft, uuid, date, se.se_questions.t_name) in return @@ List.fold_left (fun accu id -> umap_add id item accu) accu ids) (function | Lwt.Canceled -> Printf.ksprintf Ocsigen_messages.accesslog "Building elections_by_owner_cache canceled while \ processing %s" uuid_s; Lwt.fail Lwt.Canceled | _ -> return accu)) IMap.empty let get_elections_by_owner user = let* cache = match !elections_by_owner_cache with | Some x -> return x | None -> let@ () = Lwt_mutex.with_lock elections_by_owner_mutex in let* x = build_elections_by_owner_cache () in elections_by_owner_cache := Some x; return x in match IMap.find_opt user cache with None -> return [] | Some xs -> return xs let get_password_filename uuid = uuid /// "passwords.csv" let check_password uuid ~user ~password = let db = get_password_filename uuid in check_password_with_file ~db ~name_or_email:user ~password let get_passwords uuid = let csv = try Some (Csv.load (get_password_filename uuid)) with _ -> None in let&* csv = csv in let res = List.fold_left (fun accu line -> match line with | [ login; salt; hash ] -> SMap.add login (salt, hash) accu | _ -> accu) SMap.empty csv in return_some res type voters = { has_explicit_weights : bool; username_or_address : [ `Username | `Address ]; voter_map : Voter.t SMap.t; } module VoterCacheTypes = struct type key = uuid type value = voters end module VoterCache = Ocsigen_cache.Make (VoterCacheTypes) let get_voters_file uuid = Filesystem.read_whole_file ~uuid (string_of_election_file ESVoters) let get_all_voters uuid = let* x = get_voters_file uuid in match x with | None -> Lwt.return [] | Some x -> Lwt.return (Voter.list_of_string x) let raw_get_voter_cache uuid = let* voters = get_all_voters uuid in let voter_map = List.fold_left (fun accu x -> let _, login, _ = Voter.get x in SMap.add (String.lowercase_ascii login) x accu) SMap.empty voters in let has_explicit_weights = Belenios_core.Common.has_explicit_weights voters in let username_or_address = match voters with | [] -> `Username | (_, { login; _ }) :: _ -> ( match login with None -> `Address | Some _ -> `Username) in Lwt.return { has_explicit_weights; username_or_address; voter_map } let voter_cache = new VoterCache.cache raw_get_voter_cache ~timer:3600. 10 let dummy_voters = { has_explicit_weights = false; username_or_address = `Username; voter_map = SMap.empty; } let get_voters uuid = Lwt.catch (fun () -> voter_cache#find uuid) (fun _ -> Lwt.return dummy_voters) let get_has_explicit_weights uuid = let* x = get_voters uuid in Lwt.return x.has_explicit_weights let get_username_or_address uuid = let* x = get_voters uuid in Lwt.return x.username_or_address let get_voter uuid id = let* x = get_voters uuid in Lwt.return @@ SMap.find_opt (String.lowercase_ascii id) x.voter_map type cred_cache = { weight : Weight.t; username : string option } module CredCacheTypes = struct type key = uuid type value = cred_cache SMap.t end module CredCache = Ocsigen_cache.Make (CredCacheTypes) let get_public_creds uuid = let* x = get_from_setup_data uuid (fun x -> x.setup_credentials) in match x with | None -> assert false | Some x -> return @@ public_credentials_of_string x let raw_get_credential_cache uuid = let* x = Filesystem.read_file_single_line ~uuid "public_creds.json" in match x with | None -> let* x = get_public_creds uuid in List.fold_left (fun accu x -> let x, weight = extract_weight x in SMap.add x { weight; username = None } accu) SMap.empty x |> return | Some x -> let x = public_credentials_of_string x in List.fold_left (fun accu x -> let cred, weight, username = match String.split_on_char ',' x with | [ x ] -> (x, Weight.one, None) | [ x; y ] -> (x, Weight.of_string y, None) | [ x; ""; z ] -> (x, Weight.one, Some z) | [ x; y; z ] -> (x, Weight.of_string y, Some z) | _ -> assert false in SMap.add cred { weight; username } accu) SMap.empty x |> return let credential_cache = new CredCache.cache raw_get_credential_cache ~timer:3600. 10 let get_credential_cache uuid cred = Lwt.catch (fun () -> let* xs = credential_cache#find uuid in return @@ SMap.find cred xs) (fun _ -> Lwt.fail (Failure (Printf.sprintf "could not find credential record of %s/%s" (Uuid.unwrap uuid) cred))) let get_credential_weight uuid cred = let* x = get_credential_cache uuid cred in Lwt.return x.weight let get_ballot_weight election ballot = let module W = (val election : Site_common_sig.ELECTION) in Lwt.catch (fun () -> let ballot = W.ballot_of_string ballot in match W.get_credential ballot with | None -> failwith "missing signature" | Some credential -> get_credential_weight W.election.e_uuid (W.G.to_string credential)) (fun e -> Printf.ksprintf failwith "anomaly in get_ballot_weight (%s)" (Printexc.to_string e)) module BallotsCacheTypes = struct type key = uuid type value = Weight.t SMap.t end module BallotsCache = Ocsigen_cache.Make (BallotsCacheTypes) let fold_on_ballots uuid f accu = let* x = Web_events.get_roots ~uuid in match x.roots_last_ballot_event with | None -> Lwt.return accu | Some e -> fold_on_event_payloads uuid `Ballot e f accu let fold_on_ballots_weeded uuid f accu = let@ raw_election cont = let* x = get_raw_election uuid in match x with None -> Lwt.return accu | Some x -> cont x in let module W = Election.Make (struct let raw_election = raw_election end) (Random) () in let module GSet = Set.Make (W.G) in let* _, accu = fold_on_ballots uuid (fun _ b ((seen, accu) as x) -> let ballot = W.ballot_of_string b in match W.get_credential ballot with | None -> assert false | Some credential -> if GSet.mem credential seen then Lwt.return x else let seen = GSet.add credential seen in let* accu = f b accu in Lwt.return (seen, accu)) (GSet.empty, accu) in Lwt.return accu let raw_get_ballots uuid = let* x = get_raw_election uuid in match x with | None -> return SMap.empty | Some x -> let module W = Election.Make (struct let raw_election = x end) (Random) () in fold_on_ballots_weeded uuid (fun b accu -> let hash = sha256_b64 b in let* weight = get_ballot_weight (module W) b in return (SMap.add hash weight accu)) SMap.empty let ballots_cache = new BallotsCache.cache raw_get_ballots ~timer:3600. 10 let get_ballot_hashes uuid = let* ballots = ballots_cache#find uuid in SMap.bindings ballots |> return let get_ballot_by_hash uuid hash = Lwt.catch (fun () -> let hash = Hash.of_b64 hash in Web_events.get_data ~uuid hash) (fun _ -> Lwt.return_none) let add_ballot election last ballot = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let hash = sha256_b64 ballot in let* () = Web_events.append ~lock:false ~uuid ~last [ Data ballot; Event (`Ballot, Some (Hash.hash_string ballot)) ] in let () = ballots_cache#remove uuid in return hash let raw_compute_encrypted_tally election = let module W = (val election : Site_common_sig.ELECTION) in let module GMap = Map.Make (W.G) in let uuid = W.election.e_uuid in let@ last cont = let* x = Spool.get ~uuid Spool.last_event in match x with None -> assert false | Some x -> cont x in let* ballots = fold_on_ballots uuid (fun _ b accu -> let ballot = W.ballot_of_string b in match W.get_credential ballot with | None -> assert false | Some credential -> if GMap.mem credential accu then Lwt.return accu else Lwt.return @@ GMap.add credential ballot accu) GMap.empty in let* ballots = Lwt_list.fold_left_s (fun accu (credential, ballot) -> let* weight = get_credential_weight uuid (W.G.to_string credential) in Lwt.return @@ ((weight, ballot) :: accu)) [] (GMap.bindings ballots) in let tally = W.E.process_ballots ballots in let tally_s = string_of_encrypted_tally W.(swrite G.to_string) tally in let payload = { sized_num_tallied = List.length ballots; sized_total_weight = List.fold_left (fun accu (w, _) -> Weight.(accu + w)) Weight.zero ballots; sized_encrypted_tally = Hash.hash_string tally_s; } |> string_of_sized_encrypted_tally write_hash in let* () = Web_events.append ~uuid ~last [ Event (`EndBallots, None); Data tally_s; Data payload; Event (`EncryptedTally, Some (Hash.hash_string payload)); ] in return_unit let get_shuffle_token uuid = Spool.get ~uuid Spool.shuffle_token let gen_shuffle_token uuid tk_trustee tk_trustee_id tk_name = let tk_token = generate_token () in let t = { tk_trustee; tk_token; tk_trustee_id; tk_name } in let* () = Spool.set ~uuid Spool.shuffle_token t in return t module ExtendedRecordsCacheTypes = struct type key = uuid type value = (datetime * string) SMap.t end module ExtendedRecordsCache = Ocsigen_cache.Make (ExtendedRecordsCacheTypes) let extended_records_filename = "extended_records.jsons" let raw_get_extended_records uuid = let* x = Filesystem.read_file ~uuid extended_records_filename in let x = Option.value ~default:[] x in Lwt_list.fold_left_s (fun accu x -> let x = extended_record_of_string x in return @@ SMap.add x.r_username (x.r_date, x.r_credential) accu) SMap.empty x let dump_extended_records uuid rs = let rs = SMap.bindings rs in let extended_records = List.map (fun (r_username, (r_date, r_credential)) -> { r_username; r_date; r_credential } |> string_of_extended_record) rs in let records = List.map (fun (u, (d, _)) -> Printf.sprintf "%s %S" (string_of_datetime d) u) rs in let* () = Filesystem.write_file ~uuid extended_records_filename extended_records in Filesystem.write_file ~uuid (string_of_election_file ESRecords) records let extended_records_cache = new ExtendedRecordsCache.cache raw_get_extended_records ~timer:3600. 10 let find_extended_record uuid username = let* rs = extended_records_cache#find uuid in return (SMap.find_opt username rs) let add_extended_record uuid username r = let* rs = extended_records_cache#find uuid in let rs = SMap.add username r rs in extended_records_cache#add uuid rs; dump_extended_records uuid rs let has_voted uuid user = let* rs = extended_records_cache#find uuid in return @@ SMap.mem (string_of_user user) rs module CredMappingsCacheTypes = struct type key = uuid type value = string option SMap.t end module CredMappingsCache = Ocsigen_cache.Make (CredMappingsCacheTypes) let credential_mappings_filename = "credential_mappings.jsons" let raw_get_credential_mappings uuid = let* x = Filesystem.read_file ~uuid credential_mappings_filename in let x = Option.value ~default:[] x in Lwt_list.fold_left_s (fun accu x -> let x = credential_mapping_of_string x in return @@ SMap.add x.c_credential x.c_ballot accu) SMap.empty x let dump_credential_mappings uuid xs = SMap.fold (fun c_credential c_ballot accu -> { c_credential; c_ballot } :: accu) xs [] |> List.rev_map string_of_credential_mapping |> Filesystem.write_file ~uuid credential_mappings_filename let credential_mappings_cache = new CredMappingsCache.cache raw_get_credential_mappings ~timer:3600. 10 let init_credential_mapping uuid xs = let xs = List.fold_left (fun accu x -> let x, _ = extract_weight x in if SMap.mem x accu then failwith "trying to add duplicate credential" else SMap.add x None accu) SMap.empty xs in credential_mappings_cache#add uuid xs; dump_credential_mappings uuid xs let find_credential_mapping uuid cred = let* xs = credential_mappings_cache#find uuid in return @@ SMap.find_opt cred xs let add_credential_mapping uuid cred mapping = let* xs = credential_mappings_cache#find uuid in let xs = SMap.add cred mapping xs in credential_mappings_cache#add uuid xs; dump_credential_mappings uuid xs let get_credential_record uuid credential = let* cr_ballot = find_credential_mapping uuid credential in let&* cr_ballot = cr_ballot in let* c = get_credential_cache uuid credential in return_some { cr_ballot; cr_weight = c.weight; cr_username = c.username } let precast_ballot election ~rawballot = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let@ () = fun cont -> let hash = Hash.hash_string rawballot in let* x = Web_events.get_data ~uuid hash in match x with | None -> cont () | Some _ -> Lwt.return @@ Error `DuplicateBallot in let@ rc cont = match W.E.check_rawballot rawballot with | Error _ as x -> Lwt.return x | Ok rc -> cont rc in let@ cr cont = let* x = get_credential_record uuid rc.rc_credential in match x with | None -> Lwt.return @@ Error `InvalidCredential | Some cr -> cont cr in if rc.rc_check () then Lwt.return @@ Ok (rc.rc_credential, cr) else Lwt.return @@ Error `InvalidBallot let do_cast_ballot election ~rawballot ~user ~weight date ~precast_data = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let@ last cont = let* x = Spool.get ~uuid Spool.last_event in match x with None -> assert false | Some x -> cont x in let get_username user = match String.index_opt user ':' with | None -> user | Some i -> String.sub user (i + 1) (String.length user - i - 1) in let get_user_record user = let* x = find_extended_record uuid user in let&* _, old_credential = x in return_some old_credential in let@ x cont = let credential, cr = precast_data in let@ () = fun cont2 -> if Weight.compare cr.cr_weight weight <> 0 then cont @@ Error `WrongWeight else cont2 () in let@ () = fun cont2 -> match cr.cr_username with | Some username when get_username user <> username -> cont @@ Error `WrongUsername | Some _ -> cont2 () | None -> ( let* x = get_user_record user in match (x, cr.cr_ballot) with | None, None -> cont2 () | None, Some _ -> cont @@ Error `UsedCredential | Some _, None -> cont @@ Error `RevoteNotAllowed | Some credential', _ when credential' = credential -> cont2 () | Some _, _ -> cont @@ Error `WrongCredential) in let* x = get_credential_record uuid credential in match x with | None -> assert false | Some cr' when cr'.cr_ballot = cr.cr_ballot -> cont @@ Ok (credential, cr.cr_ballot) | Some _ -> cont @@ Error `ExpiredBallot in match x with | Error _ as x -> return x | Ok (credential, old) -> let@ hash, revote = fun cont -> match old with | None -> let* h = add_ballot election last rawballot in cont (h, false) | Some _ -> if !Web_config.deny_revote then return @@ Error `RevoteNotAllowed else let* h = add_ballot election last rawballot in cont (h, true) in let* () = add_credential_mapping uuid credential (Some hash) in let* () = add_extended_record uuid user (date, credential) in return (Ok (hash, revote)) let cast_ballot election ~rawballot ~user ~weight date ~precast_data = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in Web_election_mutex.with_lock uuid (fun () -> do_cast_ballot election ~rawballot ~user ~weight date ~precast_data) let compute_audit_cache uuid = let* election = get_raw_election uuid in match election with | None -> Printf.ksprintf failwith "compute_cache: %s does not exist" (Uuid.unwrap uuid) | Some _ -> let* voters = get_all_voters uuid in let cache_voters_hash = Hash.hash_string (Voter.list_to_string voters) in let* shuffles = let* x = get_shuffles uuid in let&* x = x in Lwt.return_some (List.map (fun (_, x, _) -> x) x) in let* encrypted_tally = let* x = get_sized_encrypted_tally uuid in let&* x = x in let x = sized_encrypted_tally_of_string read_hash x in Lwt.return_some x.sized_encrypted_tally in let* trustees = get_trustees uuid in let* cache_checksums = let* setup_data = get_setup_data uuid in let election = setup_data.setup_election in let* public_credentials = get_public_creds uuid in Election.compute_checksums ~election ~shuffles ~encrypted_tally ~trustees ~public_credentials |> Lwt.return in return { cache_voters_hash; cache_checksums; cache_threshold = None } let get_audit_cache uuid = let* cache = Spool.get ~uuid Spool.audit_cache in match cache with | Some x -> return x | None -> let* cache = compute_audit_cache uuid in let* () = Spool.set ~uuid Spool.audit_cache cache in return cache let copy_file src dst = let open Lwt_io in chars_of_file src |> chars_to_file dst let try_copy_file src dst = let* b = Filesystem.file_exists src in if b then copy_file src dst else return_unit let make_archive uuid = let uuid_s = Uuid.unwrap uuid in let* temp_dir = Lwt_preemptive.detach (fun () -> let temp_dir = Filename.temp_file "belenios" "archive" in Sys.remove temp_dir; Unix.mkdir temp_dir 0o700; Unix.mkdir (temp_dir // "public") 0o755; Unix.mkdir (temp_dir // "restricted") 0o700; temp_dir) () in let* () = Lwt_list.iter_p (fun x -> try_copy_file (uuid /// x) (temp_dir // "public" // x)) [ Uuid.unwrap uuid ^ ".bel" ] in let* () = Lwt_list.iter_p (fun x -> try_copy_file (uuid /// x) (temp_dir // "restricted" // x)) [ "voters.txt"; "records" ] in let command = Printf.ksprintf Lwt_process.shell "cd \"%s\" && zip -r archive public restricted" temp_dir in let* r = Lwt_process.exec command in match r with | Unix.WEXITED 0 -> let fname = uuid /// "archive.zip" in let fname_new = fname ^ ".new" in let* () = copy_file (temp_dir // "archive.zip") fname_new in let* () = Lwt_unix.rename fname_new fname in Filesystem.rmdir temp_dir | _ -> Printf.ksprintf Ocsigen_messages.errlog "Error while creating archive.zip for election %s, temporary directory \ left in %s" uuid_s temp_dir; return_unit let get_archive uuid = let* state = get_election_state uuid in match state with | `Tallied | `Archived -> let archive_name = uuid /// "archive.zip" in let* b = Filesystem.file_exists archive_name in let* () = if not b then make_archive uuid else return_unit in Lwt.return_some archive_name | _ -> Lwt.return_none type spool_item = Spool_item : 'a Spool.t -> spool_item let delete_sensitive_data uuid = let* () = Lwt_list.iter_p (fun (Spool_item x) -> Spool.del ~uuid x) [ Spool_item Spool.state; Spool_item Spool.private_key; Spool_item Spool.private_keys; Spool_item Spool.decryption_tokens; ] in let* () = Lwt_list.iter_p (fun x -> Filesystem.cleanup_file (uuid /// x)) [ extended_records_filename; credential_mappings_filename; "partial_decryptions.json"; "public_creds.json"; "ballots_index.json"; ] in Lwt.return_unit let archive_election uuid = let* () = delete_sensitive_data uuid in let* dates = get_election_dates uuid in set_election_dates uuid { dates with e_archive = Some (Datetime.now ()) } let delete_election uuid = let@ election cont = let* x = get_raw_election uuid in match x with None -> Lwt.return_unit | Some e -> cont e in let module W = Election.Make (struct let raw_election = election end) (Random) () in let* metadata = get_election_metadata uuid in let* () = delete_sensitive_data uuid in let de_template = { t_description = ""; t_name = W.election.e_name; t_questions = Array.map Belenios_core.Question.erase_question W.election.e_questions; t_administrator = None; t_credential_authority = None; } in let de_owners = metadata.e_owners in let* dates = get_election_dates uuid in let de_date = match dates.e_tally with | Some x -> x | None -> ( match dates.e_finalization with | Some x -> x | None -> ( match dates.e_creation with | Some x -> x | None -> default_validation_date)) in let de_authentication_method = match metadata.e_auth_config with | Some [ { auth_system = "cas"; auth_config; _ } ] -> let server = List.assoc "server" auth_config in `CAS server | Some [ { auth_system = "password"; _ } ] -> `Password | _ -> `Unknown in let de_credential_method = match metadata.e_cred_authority with | Some "server" -> `Automatic | _ -> `Manual in let* de_trustees = let open Belenios_core.Serializable_j in let* trustees = get_trustees uuid in trustees_of_string Yojson.Safe.read_json trustees |> List.map (function | `Single _ -> `Single | `Pedersen t -> `Pedersen (t.t_threshold, Array.length t.t_verification_keys)) |> Lwt.return in let* voters = get_voters uuid in let* ballots = get_ballot_hashes uuid in let* result = get_election_result uuid in let de_nb_voters = SMap.cardinal voters.voter_map in let de_has_weights = voters.has_explicit_weights in let de = { de_uuid = uuid; de_template; de_owners; de_nb_voters; de_nb_ballots = List.length ballots; de_date; de_tallied = result <> None; de_authentication_method; de_credential_method; de_trustees; de_has_weights; } in let* () = Filesystem.write_file ~uuid "deleted.json" [ string_of_deleted_election de ] in let* () = Lwt_list.iter_p (fun (Spool_item x) -> Spool.del ~uuid x) [ Spool_item Spool.last_event; Spool_item Spool.dates; Spool_item Spool.metadata; Spool_item Spool.audit_cache; Spool_item Spool.hide_result; Spool_item Spool.shuffle_token; Spool_item Spool.skipped_shufflers; ] in let* () = Lwt_list.iter_p (fun x -> Filesystem.cleanup_file (uuid /// x)) [ Uuid.unwrap uuid ^ ".bel"; "passwords.csv"; "records"; "voters.txt"; "archive.zip"; ] in clear_elections_by_owner_cache () let load_password_db uuid = let db = uuid /// "passwords.csv" in Lwt_preemptive.detach Csv.load db let rec replace_password username ((salt, hashed) as p) = function | [] -> [] | (username' :: _ :: _ :: rest as x) :: xs -> if username = String.lowercase_ascii username' then (username' :: salt :: hashed :: rest) :: xs else x :: replace_password username p xs | x :: xs -> x :: replace_password username p xs let dump_passwords uuid db = List.map (fun line -> String.concat "," line) db |> Filesystem.write_file ~uuid "passwords.csv" let regen_password election metadata user = let user = String.lowercase_ascii user in let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let title = W.election.e_name in let* voters = get_voters uuid in let show_weight = voters.has_explicit_weights in let x = SMap.find_opt (String.lowercase_ascii user) voters.voter_map in match x with | Some id -> let langs = get_languages metadata.e_languages in let* db = load_password_db uuid in let* email, x = Mails_voter.generate_password_email metadata langs title uuid id show_weight in let* () = Mails_voter.submit_bulk_emails [ email ] in let db = replace_password user x db in let* () = dump_passwords uuid db in Lwt.return_true | _ -> Lwt.return_false let get_private_creds_filename uuid = uuid /// "private_creds.txt" let get_private_creds_downloaded uuid = Filesystem.file_exists (uuid /// "private_creds.downloaded") let set_private_creds_downloaded uuid = Filesystem.write_file ~uuid "private_creds.downloaded" [] let clear_private_creds_downloaded uuid = Filesystem.cleanup_file (uuid /// "private_creds.downloaded") let get_election_file uuid f = uuid /// string_of_election_file f let validate_election uuid se s = let open Belenios_api.Serializable_j in let version = se.se_version in let uuid_s = Uuid.unwrap uuid in (* convenience tests *) let validation_error x = raise (Api_generic.Error (`ValidationError x)) in let () = if se.se_questions.t_name = "" then validation_error `NoTitle; if se.se_questions.t_questions = [||] then validation_error `NoQuestions; (match se.se_administrator with | None | Some "" -> validation_error `NoAdministrator | _ -> ()); match se.se_metadata.e_cred_authority with | None | Some "" -> validation_error `NoCredentialAuthority | _ -> () in (* check status *) let () = if s.num_voters = 0 then validation_error `NoVoters; (match s.passwords_ready with | Some false -> validation_error `MissingPasswords | Some true | None -> ()); if not s.credentials_ready then validation_error `MissingPublicCredentials; if not s.trustees_ready then validation_error `TrusteesNotReady; if not s.nh_and_weights_compatible then validation_error `WeightsAreIncompatibleWithNH in (* trustees *) let group = Group.of_string ~version se.se_group in let module G = (val group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let module K = Trustees.MakeCombinator (G) in let module KG = Trustees.MakeSimple (G) (Random) in let* trustee_names, trustees, private_keys = match se.se_trustees with | `Basic x -> let ts = x.dbp_trustees in let* trustee_names, trustees, private_key = match ts with | [] -> let private_key = KG.generate () in let public_key = KG.prove private_key in let public_key = { public_key with trustee_name = Some "server" } in Lwt.return ([ "server" ], [ `Single 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) [] ts in let private_key = match private_key with | [ x ] -> `KEY x | _ -> validation_error `NotSinglePrivateKey in Lwt.return ( List.map (fun { st_id; _ } -> st_id) ts, List.map (fun { st_public_key; st_name; _ } -> let pk = trustee_public_key_of_string (sread G.of_string) st_public_key in let pk = { pk with trustee_name = st_name } in `Single pk) ts, private_key ) in Lwt.return (trustee_names, trustees, private_key) | `Threshold x -> ( let ts = x.dtp_trustees in match x.dtp_parameters with | None -> validation_error `KeyEstablishmentNotFinished | Some tp -> let tp = threshold_parameters_of_string (sread G.of_string) tp in let named = let open Belenios_core.Serializable_j in List.combine (Array.to_list tp.t_verification_keys) ts |> List.map (fun (k, t) -> { k with trustee_name = t.stt_name }) |> Array.of_list in let tp = { tp with t_verification_keys = named } in let trustee_names = 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 (sread G.of_string) v in voutput.vo_private_key | None -> raise (Api_generic.Error (`GenericError "inconsistent state"))) ts in let server_private_key = KG.generate () in let server_public_key = KG.prove server_private_key in let server_public_key = { server_public_key with trustee_name = Some "server" } in Lwt.return ( "server" :: trustee_names, [ `Single server_public_key; `Pedersen tp ], `KEYS (server_private_key, private_keys) )) in let y = K.combine_keys trustees in (* election parameters *) let metadata = { se.se_metadata with e_trustees = Some trustee_names; e_owners = se.se_owners; } in let template = se.se_questions in let params = { e_version = se.se_version; e_description = template.t_description; e_name = template.t_name; e_questions = template.t_questions; e_uuid = uuid; e_administrator = se.se_administrator; e_credential_authority = metadata.e_cred_authority; } in let raw_election = let public_key = G.to_string y in Election.make_raw_election params ~group:se.se_group ~public_key in (* write election files to disk *) let dir = !!uuid_s in let create_file fname what xs = Lwt_io.with_file ~flags:Unix.[ O_WRONLY; O_NONBLOCK; O_CREAT; O_TRUNC ] ~perm:0o600 ~mode:Lwt_io.Output (dir // fname) (fun oc -> Lwt_list.iter_s (fun v -> let* () = Lwt_io.write oc (what v) in Lwt_io.write oc "\n") xs) in let create_whole_file fname x = Lwt_io.with_file ~flags:Unix.[ O_WRONLY; O_NONBLOCK; O_CREAT; O_TRUNC ] ~perm:0o600 ~mode:Lwt_io.Output (dir // fname) (fun oc -> Lwt_io.write oc x) in let open Belenios_core.Serializable_j in let voters = se.se_voters |> List.map (fun x -> x.sv_id) in let* () = create_whole_file "voters.txt" (Voter.list_to_string voters) in let* () = create_file "metadata.json" string_of_metadata [ metadata ] in (* initialize credentials *) let* public_creds = let fname = uuid /// "public_creds.json" in let* file = Filesystem.read_file_single_line fname in match file with | Some x -> let x = public_credentials_of_string x |> List.map strip_cred in let* () = init_credential_mapping uuid x in Lwt.return x | None -> Lwt.fail @@ Failure "no public credentials" in (* initialize events *) let* () = let raw_trustees = string_of_trustees (swrite G.to_string) trustees in let raw_public_creds = string_of_public_credentials public_creds in let setup_election = Hash.hash_string raw_election in let setup_trustees = Hash.hash_string raw_trustees in let setup_credentials = Hash.hash_string raw_public_creds in let setup_data = { setup_election; setup_trustees; setup_credentials } in let setup_data_s = string_of_setup_data setup_data in Web_events.append ~lock:false ~uuid [ Data raw_election; Data raw_trustees; Data raw_public_creds; Data setup_data_s; Event (`Setup, Some (Hash.hash_string setup_data_s)); ] in (* create file with private keys, if any *) let* () = match private_keys with | `KEY x -> create_file "private_key.json" string_of_number [ x ] | `KEYS (x, y) -> let* () = create_file "private_key.json" string_of_number [ x ] in create_file "private_keys.jsons" (fun x -> x) y in (* clean up draft *) let* () = Spool.del ~uuid Spool.draft in (* clean up private credentials, if any *) let* () = Spool.del ~uuid Spool.draft_private_credentials in let* () = clear_private_creds_downloaded uuid in (* write passwords *) let* () = match metadata.e_auth_config with | Some [ { auth_system = "password"; _ } ] -> let db = List.filter_map (fun v -> let _, login, _ = Voter.get v.sv_id in let& salt, hashed = v.sv_password in Some [ login; salt; hashed ]) se.se_voters in if db <> [] then dump_passwords uuid db else Lwt.return_unit | _ -> Lwt.return_unit in (* finish *) let* () = set_election_state uuid `Open in let* dates = get_election_dates uuid in set_election_dates uuid { dates with e_finalization = Some (Datetime.now ()) } let delete_draft uuid = let* () = Filesystem.rmdir !!(Uuid.unwrap uuid) in clear_elections_by_owner_cache () let create_draft uuid se = let* () = Lwt_unix.mkdir !!(Uuid.unwrap uuid) 0o700 in let* () = set_draft_election uuid se in let* () = clear_elections_by_owner_cache () in Lwt.return_unit let transition_to_encrypted_tally uuid = set_election_state uuid `EncryptedTally let compute_encrypted_tally election = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let* state = get_election_state uuid in match state with | `Closed -> let* () = raw_compute_encrypted_tally election in if Belenios.Election.has_nh_questions W.election then let* () = set_election_state uuid `Shuffling in Lwt.return_true else let* () = transition_to_encrypted_tally uuid in Lwt.return_true | _ -> Lwt.return_false let finish_shuffling election = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let* state = get_election_state uuid in match state with | `Shuffling -> let* () = Web_events.append ~uuid [ Event (`EndShuffles, None) ] in let* () = Spool.del ~uuid Spool.skipped_shufflers in let* () = transition_to_encrypted_tally uuid in Lwt.return_true | _ -> Lwt.return_false let get_skipped_shufflers uuid = Spool.get ~uuid Spool.skipped_shufflers let set_skipped_shufflers uuid shufflers = Spool.set ~uuid Spool.skipped_shufflers shufflers let extract_automatic_data_draft uuid_s = let uuid = Uuid.wrap uuid_s in let* se = get_draft_election uuid in let&* se = se in let t = Option.value se.se_creation_date ~default:default_creation_date in let next_t = Period.add t (Period.day days_to_delete) in return_some (`Destroy, uuid, next_t) let extract_automatic_data_validated uuid_s = let uuid = Uuid.wrap uuid_s in let* election = get_raw_election uuid in let&* _ = election in let* state = get_election_state uuid in let* dates = get_election_dates uuid in match state with | `Open | `Closed | `Shuffling | `EncryptedTally -> let t = Option.value dates.e_finalization ~default:default_validation_date in let next_t = Period.add t (Period.day days_to_delete) in return_some (`Delete, uuid, next_t) | `Tallied -> let t = Option.value dates.e_tally ~default:default_tally_date in let next_t = Period.add t (Period.day days_to_archive) in return_some (`Archive, uuid, next_t) | `Archived -> let t = Option.value dates.e_archive ~default:default_archive_date in let next_t = Period.add t (Period.day days_to_delete) in return_some (`Delete, uuid, next_t) let try_extract extract x = Lwt.catch (fun () -> extract x) (fun _ -> return_none) let get_next_actions () = Lwt_unix.files_of_directory !Web_config.spool_dir |> Lwt_stream.to_list >>= Lwt_list.filter_map_s (fun x -> if x = "." || x = ".." then return_none else let* r = try_extract extract_automatic_data_draft x in match r with | None -> try_extract extract_automatic_data_validated x | x -> return x) let set_election_state uuid state = let* allowed = let* state = get_election_state uuid in match state with | `Open | `Closed -> Lwt.return_true | _ -> Lwt.return_false in if allowed then let* () = set_election_state uuid (state : [ `Open | `Closed ] :> Web_serializable_t.election_state) in let* dates = get_election_dates uuid in let* () = set_election_dates uuid { dates with e_auto_open = None; e_auto_close = None } in Lwt.return_true else Lwt.return_false let open_election uuid = set_election_state uuid `Open let close_election uuid = set_election_state uuid `Closed let get_election_automatic_dates uuid = let open Belenios_api.Serializable_t in let* d = get_election_dates uuid in Lwt.return { auto_date_open = Option.map Datetime.to_unixfloat d.e_auto_open; auto_date_close = Option.map Datetime.to_unixfloat d.e_auto_close; } let set_election_automatic_dates uuid d = let open Belenios_api.Serializable_t in let e_auto_open = Option.map Datetime.from_unixfloat d.auto_date_open in let e_auto_close = Option.map Datetime.from_unixfloat d.auto_date_close in let* dates = get_election_dates uuid in set_election_dates uuid { dates with e_auto_open; e_auto_close } let set_draft_public_credentials uuid public_creds = let public_creds = string_of_public_credentials public_creds in Spool.set ~uuid Spool.draft_public_credentials public_creds let get_draft_public_credentials uuid = Spool.get ~uuid Spool.draft_public_credentials let get_draft_private_credentials uuid = Spool.get ~uuid Spool.draft_private_credentials let set_draft_private_credentials uuid = Spool.set ~uuid Spool.draft_private_credentials let get_records uuid = Filesystem.read_file ~uuid (string_of_election_file ESRecords) belenios-2.2-10-gbb6b7ea8/src/web/server/common/pages_voter.ml0000644000175000017500000011406414476041226023116 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Serializable_j open Common open Web_serializable_j open Web_common open Eliom_content.Html.F open Eliom_content.Html.F.Form module Make (Web_state : Web_state_sig.S) (Web_i18n : Web_i18n_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) = struct open Web_services open Pages_common let get_preferred_gettext () = Web_i18n.get_preferred_gettext "voter" let file uuid x = Eliom_service.preapply ~service:election_dir (uuid, x) let audit_footer election = let open (val election : Site_common_sig.ELECTION) in let uuid = election.e_uuid in let* l = get_preferred_gettext () in let open (val l) in return @@ div ~a:[ a_style "line-height:1.5em;" ] [ div [ div [ txt (s_ "Election fingerprint: "); code [ txt fingerprint ] ]; div [ txt (s_ "Audit data: "); a ~service:(file uuid ESRaw) [ txt (s_ "parameters") ] (); txt ", "; a ~service:(file uuid (ESArchive uuid)) [ txt (s_ "public data") ] (); txt "."; ]; ]; ] let majority_judgment_content l q r = let open (val l : Belenios_ui.I18n.GETTEXT) in let explicit_winners = List.map (List.map (fun i -> q.Question_nh_t.q_answers.(i))) r.mj_winners in let pretty_winners = List.map (fun l -> li [ (match l with | [] -> failwith "anomaly in Pages_voter.majority_judgment" | [ x ] -> markup x | l -> div [ txt (s_ "Tie:"); ul (List.map (fun x -> li [ markup x ]) l); ]); ]) explicit_winners in let valid_format = match r.mj_blank with | Some _ -> f_ "%d valid (non-blank) ballot(s)" | None -> f_ "%d valid ballot(s)" in let valid = div [ Printf.ksprintf txt valid_format r.mj_valid ] in let blank = match r.mj_blank with | Some b -> div [ Printf.ksprintf txt (f_ "%d blank ballot(s)") b ] | None -> txt "" in let invalid = "data:application/json," ^ string_of_mj_ballots r.mj_invalid in let invalid = direct_a invalid (Printf.sprintf (f_ "%d invalid ballot(s)") (Array.length r.mj_invalid)) in let invalid = div [ invalid ] in [ div [ txt (s_ "According to Majority Judgment, the ranking is:"); ol ~a:[ a_class [ "majority_judgment_ranking" ] ] pretty_winners; ]; valid; blank; invalid; ] let schulze_content l q r = let open (val l : Belenios_ui.I18n.GETTEXT) in let valid_format = match r.schulze_blank with | Some _ -> f_ "%d valid (non-blank) ballot(s)" | None -> f_ "%d valid ballot(s)" in let valid = div [ Printf.ksprintf txt valid_format r.schulze_valid ] in let blank = match r.schulze_blank with | Some b -> div [ Printf.ksprintf txt (f_ "%d blank ballot(s)") b ] | None -> txt "" in let explicit_winners = List.map (List.map (fun i -> q.Question_nh_t.q_answers.(i))) r.schulze_winners in let pretty_winners = List.map (fun l -> li [ (match l with | [] -> failwith "anomaly in Web_templates.schulze" | [ x ] -> markup x | l -> div [ txt (s_ "Tie:"); ul (List.map (fun x -> li [ markup x ]) l); ]); ]) explicit_winners in let explanation = div ~a:[ a_class [ "schulze_explanation" ] ] [ txt (s_ "A Condorcet winner is a candidate that is preferred over all \ the other candidates."); txt " "; txt (s_ "Several techniques exist to decide which candidate to elect \ when there is no Condorcet winner."); txt " "; txt (s_ "We use here the Schulze method and we refer voters to "); direct_a "https://en.wikipedia.org/wiki/Condorcet_method#Schulze_method" (s_ "the Wikipedia page"); txt (s_ " for more information."); ] in [ explanation; txt (s_ "The Schulze winners are:"); ol pretty_winners; valid; blank; ] let stv_content l q r = let open (val l : Belenios_ui.I18n.GETTEXT) in let winners = r.stv_winners |> List.map (fun i -> q.Question_nh_t.q_answers.(i)) |> List.map (fun l -> li [ txt l ]) in let invalid = ( ( r.stv_invalid |> string_of_mj_ballots |> fun x -> "data:application/json," ^ x ) |> fun x -> direct_a x (Printf.sprintf (f_ "%d invalid ballot(s)") (Array.length r.stv_invalid)) ) |> fun x -> div [ x; txt ". "; txt (s_ "A ballot is invalid if two candidates have been given the same \ preference order or if a rank is missing."); ] in let events = ( r.stv_events |> string_of_stv_events |> fun x -> "data:application/json," ^ x ) |> fun x -> direct_a x (s_ "Raw events") in let tie = if List.exists (function `TieWin _ | `TieLose _ -> true | _ -> false) r.stv_events then div [ txt (s_ "There has been at least one tie."); txt " "; txt (s_ "Many variants of STV exist, depending for example on how to \ break ties."); txt " "; txt (s_ "In our implementation, when several candidates have the same \ number of votes when they are ready to be elected or \ eliminated, we follow the order in which candidates were \ listed in the election."); txt " "; txt (s_ "Such candidates are marked as \"TieWin\" when they are \ elected and as \"TieLose\" if they have lost."); txt " "; txt (s_ "Look at the raw events for more details."); ] else txt "" in [ div [ txt (s_ "The Single Transferable Vote winners are:"); ul winners ]; tie; div [ events ]; div [ invalid ]; ] let format_question_result uuid l i r q = let open (val l : Belenios_ui.I18n.GETTEXT) in match (q, r) with | Question.Homomorphic x, `Homomorphic r -> let open Question_h_t in let answers = Array.to_list x.q_answers in let answers = match x.q_blank with | Some true -> s_ "Blank vote" :: answers | _ -> answers in let answers = List.mapi (fun j x -> tr [ td [ markup x ]; td [ txt @@ Weight.to_string r.(j) ] ]) answers in let answers = match answers with | [] -> txt "" | y :: ys -> ( match x.q_blank with | Some true -> table (ys @ [ y ]) | _ -> table (y :: ys)) in li ~a:[ a_class [ "result_question_item" ] ] [ div ~a:[ a_class [ "result_question" ] ] [ markup x.q_question ]; answers; ] | Question.NonHomomorphic (q, extra), `NonHomomorphic ballots -> let open Question_nh_t in let applied_counting_method, show_others = match Question.get_counting_method extra with | `None -> (txt "", true) | `MajorityJudgment o -> let ngrades = Array.length o.mj_extra_grades in let nchoices = Array.length q.Question_nh_t.q_answers in let blank_allowed = o.mj_extra_blank in let mj = Majority_judgment.compute ~nchoices ~ngrades ~blank_allowed ballots in let contents = majority_judgment_content l q mj in (div ~a:[ a_class [ "majority_judgment_result" ] ] contents, false) | `Schulze o -> let nchoices = Array.length q.Question_nh_t.q_answers in let blank_allowed = o.schulze_extra_blank in let r = Schulze.compute ~nchoices ~blank_allowed ballots in let contents = schulze_content l q r in (div ~a:[ a_class [ "schulze_result" ] ] contents, false) | `STV o -> let nseats = o.stv_extra_seats in let r = Stv.compute ~nseats ballots in let contents = stv_content l q r in (div ~a:[ a_class [ "stv_result" ] ] contents, false) in let others = if show_others then div [ txt (s_ "It is up to you to apply your favorite counting method."); txt " "; txt (s_ "Available methods on this server:"); txt " "; a ~service:method_schulze [ txt "Condorcet-Schulze" ] (uuid, i); txt ", "; a ~service:method_mj [ txt (s_ "Majority Judgment") ] (uuid, (i, None)); txt ", "; a ~service:method_stv [ txt (s_ "Single Transferable Vote") ] (uuid, (i, None)); txt "."; ] else txt "" in li ~a:[ a_class [ "result_question_item" ] ] [ div ~a:[ a_class [ "result_question" ] ] [ markup q.q_question ]; applied_counting_method; div [ txt (s_ "The raw results can be viewed in the "); a ~service:election_project_result [ txt (s_ "JSON result") ] ((uuid, ()), i); txt ". "; txt (s_ "It contains all submitted ballots in clear, in random \ order."); others; ]; ] | _ -> failwith "format_question_result" let election_home election state () = let* l = get_preferred_gettext () in let open (val l) in let module W = (val election : Site_common_sig.ELECTION) in let params = W.election in let uuid = params.e_uuid in let* metadata = Web_persist.get_election_metadata uuid in let* dates = Web_persist.get_election_dates uuid in let now = Datetime.now () in let state_ = match state with | `Closed -> let it_will_open = match dates.e_auto_open with | Some t when Datetime.compare now t < 0 -> span [ txt " "; txt (s_ "It will open in "); txt (format_period l (Period.sub t now)); txt "."; ] | _ -> txt "" in [ txt " "; b [ txt (s_ "This election is currently closed.") ]; it_will_open; ] | `Open -> let it_will_close = match dates.e_auto_close with | Some t when Datetime.compare now t < 0 -> span [ txt (s_ "The election will close in "); txt (format_period l (Period.sub t now)); txt "."; ] | _ -> txt "" in [ it_will_close ] | `Shuffling -> [ txt " "; b [ txt (s_ "The election is closed and being tallied.") ]; ] | `EncryptedTally -> [ txt " "; b [ txt (s_ "The election is closed and being tallied.") ]; ] | `Tallied -> [ txt " "; b [ txt (s_ "This election has been tallied.") ] ] | `Archived -> [ txt " "; b [ txt (s_ "This election is archived.") ] ] in let ballots_link = p ~a:[ a_style "text-align:center;" ] [ a ~a:[ a_style "font-size:25px;" ] ~service:election_pretty_ballots [ txt (s_ "See accepted ballots") ] (uuid, ()); ] in let* footer = audit_footer election in let go_to_the_booth = let disabled = match state with `Open -> [] | _ -> [ a_disabled () ] in let button = match get_booth_index metadata.e_booth_version with | Some i -> let (Booth election_vote) = fst booths.(i) in let uri = Eliom_uri.make_string_uri ~service:(election_vote ()) () in let a = a_id "start" :: a_user_data "uri" uri :: a_user_data "uuid" (Uuid.unwrap uuid) :: a_user_data "lang" lang :: a_style "font-size:35px;" :: disabled in Eliom_content.Html.F.button ~a [ txt (s_ "Start") ] | None -> span [ txt @@ s_ "Unsupported booth version" ] in div ~a:[ a_style "text-align:center;" ] [ div [ button ]; div [ a ~service:(Eliom_service.preapply ~service:election_cast uuid) [ txt (s_ "Advanced mode") ] (); ]; ] in let* middle = let* result = Web_persist.get_election_result uuid in let result = Option.map (election_result_of_string W.read_result) result in let* hidden = Web_persist.get_election_result_hidden uuid in let* is_admin = let* metadata = Web_persist.get_election_metadata uuid in let* site_user = Eliom_reference.get Web_state.site_user in match site_user with | Some (_, a, _) -> return @@ Accounts.check a metadata.e_owners | _ -> return_false in match result with | Some r when hidden = None || is_admin -> let* nballots, total_weight = let* x = Web_persist.get_sized_encrypted_tally uuid in match x with | None -> assert false | Some x -> let x = sized_encrypted_tally_of_string read_hash x in Lwt.return (x.sized_num_tallied, x.sized_total_weight) in let div_total_weight = if not Weight.(is_int total_weight nballots) then div [ txt (s_ "Total weight of accepted ballots:"); txt " "; txt (Weight.to_string total_weight); ] else txt "" in return @@ div [ ul (Election_result.map2 (format_question_result uuid l) r.result W.election.e_questions); div [ txt (s_ "Number of accepted ballots: "); txt (string_of_int nballots); ]; div_total_weight; div [ txt (s_ "You can also download the "); a ~service:election_dir [ txt (s_ "raw result") ] (uuid, ESResult); txt "."; ]; ] | Some _ -> let t = match hidden with | Some t -> t | None -> failwith "Impossible case in election_admin" in return @@ div [ Printf.ksprintf txt (f_ "The result of this election is currently not publicly \ available. It will be in %s.") (format_period l (Period.sub t now)); ] | None -> return go_to_the_booth in let* scd = Eliom_reference.get Web_state.show_cookie_disclaimer in let cookie_disclaimer = if scd then div ~a: [ a_class [ "cookie-disclaimer" ]; a_style "border-style: solid; border-width: 1px;"; ] [ txt (s_ "By using this site, you accept our "); direct_a !Web_config.gdpr_uri (s_ "personal data policy"); txt ". "; a ~service:set_cookie_disclaimer [ txt (s_ "Accept") ] (default_admin (ContSiteElection uuid)); ] else txt "" in let* cache = Web_persist.get_audit_cache uuid in let checksums = cache.cache_checksums in let div_admin = div [ Printf.ksprintf txt (f_ "This election is administered by %s.") (Option.value params.e_administrator ~default:"N/A"); ] in let div_voters = div ~a:[ a_id "voters" ] [ Printf.ksprintf txt (f_ "The voter list has %d voter(s) and fingerprint %s.") cache.cache_checksums.ec_num_voters (Hash.to_b64 cache.cache_voters_hash); ] in let show_weights = cache.cache_checksums.ec_weights <> None in let div_show_weights = if show_weights then div [ b [ txt (s_ "This election uses weights!") ]; br () ] else txt "" in let div_total_weight = match cache.cache_checksums.ec_weights with | Some { w_total; w_min; w_max } -> div ~a:[ a_id "weights" ] [ Printf.ksprintf txt (f_ "The total weight is %s (min: %s, max: %s).") (Weight.to_string w_total) (Weight.to_string w_min) (Weight.to_string w_max); ] | _ -> txt "" in let format_tc id xs = ul ~a:[ a_id id ] (List.map (fun x -> let name = Option.value x.tc_name ~default:"N/A" in li [ Printf.ksprintf txt "%s (%s)" name (Hash.to_b64 x.tc_checksum); ]) xs) in let div_trustees_mandatory = match checksums.ec_trustees with | [] -> txt "" | l -> div [ txt (s_ "All of the following trustees (verification keys) are \ needed to decrypt the result:"); format_tc "trustees" l; ] in let format_ttc className xs = ul ~a:[ a_class [ className ] ] (List.map (fun x -> let name = Option.value x.ttc_name ~default:"N/A" in li [ Printf.ksprintf txt "%s (%s) [%s]" name (Hash.to_b64 x.ttc_verification_key) (Hash.to_b64 x.ttc_pki_key); ]) xs) in let divs_trustees_threshold = List.map (fun x -> div [ Printf.ksprintf txt (f_ "%d of the following %d trustees (verification keys) \ [public keys] are needed to decrypt the election result:") x.ts_threshold (List.length x.ts_trustees); format_ttc "trustees_threshold" x.ts_trustees; ]) checksums.ec_trustees_threshold in let div_trustees = div (div_trustees_mandatory :: divs_trustees_threshold) in let div_credentials = div ~a:[ a_id "credentials" ] [ Printf.ksprintf txt (f_ "Credentials were generated and sent by %s and have fingerprint \ %s.") (Option.value params.e_credential_authority ~default:"N/A") (Hash.to_b64 checksums.ec_public_credentials); ] in let div_shuffles = match checksums.ec_shuffles with | None -> txt "" | Some xs -> div [ txt (s_ "Trustees shuffled the ballots in the following order:"); format_tc "shuffles" xs; ] in let div_tally = match checksums.ec_encrypted_tally with | None -> txt "" | Some x -> div ~a:[ a_id "encrypted_tally" ] [ Printf.ksprintf txt (f_ "The fingerprint of the encrypted tally is %s.") (Hash.to_b64 x); ] in let div_audit = div ~a:[ a_class [ "hybrid_box" ] ] [ div_admin; div_voters; div_total_weight; div_trustees; div_credentials; div_shuffles; div_tally; ] in let content = [ cookie_disclaimer; p state_; br (); div_show_weights; middle; br (); ballots_link; br (); div_audit; script ~a:[ a_src (static "home.js") ] (txt ""); ] in let* lang_box = lang_box (ContSiteElection uuid) in let title = params.e_name in let full_title = params.e_name in base ~lang_box ~full_title ~title ~content ~footer ~uuid () let cast_raw election () = let* l = get_preferred_gettext () in let open (val l) in let module W = (val election : Site_common_sig.ELECTION) in let params = W.election in let uuid = params.e_uuid in let form_rawballot = post_form ~service:election_submit_ballot (fun name -> [ div [ txt "Please paste your encrypted ballot in JSON format in the \ following box:"; ]; div [ textarea ~a:[ a_rows 10; a_cols 40 ] ~name () ]; div [ input ~input_type:`Submit ~value:"Submit" string ]; ]) () in let form_upload = post_form ~service:election_submit_ballot_file (fun name -> [ div [ txt "Alternatively, you can also upload a file containing your \ ballot:"; ]; div [ txt "File: "; file_input ~name () ]; div [ input ~input_type:`Submit ~value:"Submit" string ]; ]) () in let booths = let hash = Netencoding.Url.mk_url_encoded_parameters [ ("uuid", Uuid.unwrap uuid); ("lang", lang) ] in let make ~service = Eliom_uri.make_string_uri ~service ~absolute:true () |> rewrite_prefix |> fun uri -> direct_a (uri ^ "#" ^ hash) "direct link" in Web_services.booths |> Array.to_list |> List.map (fun (Booth service, name) -> let service = service () in li [ a ~service [ txt name ] (); txt " ("; make ~service; txt ")" ]) in let intro = div [ div [ txt "You can create an encrypted ballot by using the command-line \ tool "; txt "(available in the "; a ~service:source_code [ txt "sources" ] (); txt "), or any compatible booth."; txt " "; txt "A specification of encrypted ballots is also available in the \ sources."; ]; div [ txt "Booths available on this server:"; ul booths ]; div [ a ~service:Web_services.election_home [ txt "Back to election home" ] (uuid, ()); ]; ] in let content = [ intro; h3 [ txt "Submit by copy/paste" ]; form_rawballot; h3 [ txt "Submit by file" ]; form_upload; ] in let* footer = audit_footer election in let title = params.e_name in let full_title = params.e_name in base ~full_title ~title ~content ~uuid ~footer () let progress_responsive_step5 l = let open (val l : Belenios_ui.I18n.GETTEXT) in div ~a:[ a_class [ "breadcrumb" ]; a_style "padding-top: 0;" ] [ div ~a:[ a_class [ "breadcrumb__step-separator" ] ] []; div ~a:[ a_class [ "breadcrumb__step" ] ] [ span ~a:[ a_class [ "breadcrumb__step__title" ] ] [ txt (s_ "Input credential") ]; span ~a: [ a_class [ "breadcrumb__step__short-title" ]; a_title (s_ "Input credential"); ] [ txt (s_ "Step 1") ]; ]; div ~a:[ a_class [ "breadcrumb__step-separator" ] ] []; div ~a:[ a_class [ "breadcrumb__step" ] ] [ span ~a:[ a_class [ "breadcrumb__step__title" ] ] [ txt (s_ "Answer to questions") ]; span ~a: [ a_class [ "breadcrumb__step__short-title" ]; a_title (s_ "Answer to questions"); ] [ txt (s_ "Step 2") ]; ]; div ~a:[ a_class [ "breadcrumb__step-separator" ] ] []; div ~a:[ a_class [ "breadcrumb__step" ] ] [ span ~a:[ a_class [ "breadcrumb__step__title" ] ] [ txt (s_ "Review and encrypt") ]; span ~a: [ a_class [ "breadcrumb__step__short-title" ]; a_title (s_ "Review and encrypt"); ] [ txt (s_ "Step 3") ]; ]; div ~a:[ a_class [ "breadcrumb__step-separator" ] ] []; div ~a:[ a_class [ "breadcrumb__step" ] ] [ span ~a:[ a_class [ "breadcrumb__step__title" ] ] [ txt (s_ "Authenticate") ]; span ~a: [ a_class [ "breadcrumb__step__short-title" ]; a_title (s_ "Authenticate"); ] [ txt (s_ "Step 4") ]; ]; div ~a:[ a_class [ "breadcrumb__step-separator" ] ] []; div ~a:[ a_class [ "breadcrumb__step breadcrumb__step--current" ] ] [ span ~a:[ a_class [ "breadcrumb__step__title" ] ] [ txt (s_ "Confirm") ]; span ~a: [ a_class [ "breadcrumb__step__short-title" ]; a_title (s_ "Confirm"); ] [ txt (s_ "Step 5") ]; ]; div ~a:[ a_class [ "breadcrumb__step-separator" ] ] []; ] let lost_ballot election () = let* l = get_preferred_gettext () in let open (val l) in let open (val election : Site_common_sig.ELECTION) in let title = election.e_name in let full_title = election.e_name in let uuid = election.e_uuid in let* metadata = Web_persist.get_election_metadata uuid in let you_must_restart = match get_booth_index metadata.e_booth_version with | Some i -> let (Booth service) = fst Web_services.booths.(i) in let hash = Netencoding.Url.mk_url_encoded_parameters [ ("uuid", Uuid.unwrap uuid) ] in div [ txt (s_ "If you want to vote, you must "); make_a_with_hash ~service:(service ()) ~hash (s_ "start from the beginning"); txt "."; ] | None -> txt "" in let content = [ div [ b [ txt (s_ "Warning:") ]; txt " "; txt (s_ "Your vote was not recorded!"); ]; you_must_restart; div [ a ~service:Web_services.election_home [ txt (s_ "Go back to election") ] (uuid, ()); ]; ] in base ~full_title ~title ~content ~uuid () let cast_confirmed election ~result () = let* l = get_preferred_gettext () in let open (val l) in let open (val election : Site_common_sig.ELECTION) in let uuid = election.e_uuid in let name = election.e_name in let result, snippet, step_title = match result with | Ok (user, hash, revote, weight, email) -> let this_is_a_revote = if revote then span [ txt @@ s_ "This is a revote."; txt " " ] else txt "" in let your_weight_is = if not Weight.(is_int weight 1) then span [ txt (Printf.sprintf (f_ "Your weight is %s.") (Weight.to_string weight)); txt " "; ] else txt "" in ( [ txt (s_ " as user "); em [ txt user.user_name ]; txt (s_ " has been accepted."); txt " "; this_is_a_revote; your_weight_is; txt (s_ "Your smart ballot tracker is "); b ~a:[ a_id "ballot_tracker" ] [ txt hash ]; txt ". "; txt (s_ "You can check its presence in the "); a ~service:election_pretty_ballots [ txt (s_ "ballot box") ] (uuid, ()); txt (s_ " anytime during the election."); txt (if email then s_ " A confirmation e-mail has been sent to you." else ""); ], read_snippet ~lang !Web_config.success_snippet, s_ "Thank you for voting!" ) | Error e -> ( [ txt (s_ " is rejected, because "); txt (Web_common.explain_error l e); txt "."; ], Lwt.return (txt ""), s_ "FAIL!" ) in let* snippet = snippet in let content = [ progress_responsive_step5 l; div ~a:[ a_class [ "current_step" ] ] [ txt step_title ]; p ([ txt (s_ "Your ballot for "); em [ markup name ] ] @ result); snippet; p [ a ~service:Web_services.election_home [ txt (s_ "Go back to election") ] (uuid, ()); ]; ] in let title = name in let full_title = name in base ~full_title ~title ~content ~uuid () let pretty_ballots election = let* l = get_preferred_gettext () in let open (val l) in let open (val election : Site_common_sig.ELECTION) in let uuid = election.e_uuid in let* hashes = Web_persist.get_ballot_hashes uuid in let* audit_cache = Web_persist.get_audit_cache uuid in let show_weights = audit_cache.cache_checksums.ec_weights <> None in let title = election.e_name ^ " — " ^ s_ "Accepted ballots" in let nballots = ref 0 in let hashes = List.sort (fun (a, _) (b, _) -> compare_b64 a b) hashes in let ballots = List.map (fun (h, w) -> incr nballots; li [ a ~service:election_pretty_ballot [ txt h ] ((uuid, ()), h); (if show_weights then Printf.ksprintf txt " (%s)" (Weight.to_string w) else txt ""); ]) hashes in let links = p [ a ~service:Web_services.election_home [ txt (s_ "Go back to election") ] (uuid, ()); ] in let* number = let n = !nballots in let* x = Web_persist.get_sized_encrypted_tally uuid in let x = Option.map (sized_encrypted_tally_of_string read_hash) x in match x with | None -> div [ txt (string_of_int n); txt (s_ " ballot(s) have been accepted so far."); ] |> Lwt.return | Some x when x.sized_num_tallied = n -> div [ txt (string_of_int n); txt (s_ " ballot(s) have been accepted.") ] |> Lwt.return | Some x -> (* should not happen *) div [ txt (string_of_int n); txt (s_ " ballot(s) have been accepted, and "); txt (string_of_int x.sized_num_tallied); txt (s_ " have been tallied."); ] |> Lwt.return in let content = [ number; ul ballots; links ] in base ~title ~content ~uuid () let schulze q r = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Condorcet-Schulze method" in let content = schulze_content l q r in base ~title ~content () let majority_judgment_select uuid question = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Majority Judgment method" in let form = get_form ~service:method_mj (fun (uuidn, (questionn, ngradesn)) -> [ input ~input_type:`Hidden ~name:uuidn ~value:uuid (user Uuid.unwrap); input ~input_type:`Hidden ~name:questionn ~value:question int; txt (s_ "Number of grades:"); txt " "; input ~input_type:`Text ~name:ngradesn int; input ~input_type:`Submit ~value:(s_ "Continue") string; ]) in let explanation = div [ txt (s_ "In the context of Majority Judgment, a vote gives a grade to \ each candidate."); txt " "; txt (s_ "1 is the highest grade, 2 is the second highest grade, etc."); txt " "; txt (s_ "As a convenience, 0 is always interpreted as the lowest grade."); txt " "; txt (s_ "The winner is the candidate with the highest median (or the \ 2nd highest median if there is a tie, etc.)."); txt " "; txt (s_ "More information can be found "); direct_a "https://en.wikipedia.org/wiki/Majority_judgment" (s_ "here"); txt "."; ] in let explanation_grades = div [ txt (s_ "The number of different grades (Excellent, Very Good, etc.) \ typically varies from 5 to 7."); txt " "; txt (s_ "Please provide the number of grades to see the result of the \ election according to the Majority Judgment method."); ] in let content = [ explanation; br (); explanation_grades; form ] in base ~title ~content () let majority_judgment q r = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Majority Judgment method" in let content = majority_judgment_content l q r in base ~title ~content () let stv_select uuid question = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Single Transferable Vote method" in let form = get_form ~service:method_stv (fun (uuidn, (questionn, nseatsn)) -> [ input ~input_type:`Hidden ~name:uuidn ~value:uuid (user Uuid.unwrap); input ~input_type:`Hidden ~name:questionn ~value:question int; txt (s_ "Number of seats:"); txt " "; input ~input_type:`Text ~name:nseatsn int; input ~input_type:`Submit ~value:(s_ "Continue") string; ]) in let explanation = div [ txt (s_ "In the context of STV, voters rank candidates by order of \ preference."); txt " "; txt (s_ "When a candidate obtains enough votes to be elected, the votes \ are transferred to the next candidate in the voter ballot, \ with a coefficient proportional to the \"surplus\" of votes."); txt " "; txt (s_ "More information can be found "); direct_a "https://en.wikipedia.org/wiki/Single_transferable_vote" (s_ "here"); txt ". "; txt (s_ "Many variants of STV exist, we documented our choices in "); direct_a "https://gitlab.inria.fr/belenios/belenios/-/blob/master/src/lib/stv.ml" (s_ "our code of STV"); txt "."; ] in let explanation_nseats = div [ txt (s_ "Please provide the number of seats to see the result of the \ election according to the Single Transferable Vote method."); ] in let content = [ explanation; br (); explanation_nseats; form ] in base ~title ~content () let stv q r = let* l = get_preferred_gettext () in let open (val l) in let title = s_ "Single Transferable Vote method" in let content = stv_content l q r in base ~title ~content () end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_state_sig.mli0000644000175000017500000000474014476041226023567 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common open Web_common open Web_serializable_t type signup_kind = CreateAccount | ChangePassword of { username : string } type signup_env = { kind : signup_kind; service : string } module type S = sig val show_cookie_disclaimer : bool Eliom_reference.eref val site_user : (user * account * string) option Eliom_reference.eref val election_user : (uuid * user) option Eliom_reference.eref val get_election_user : uuid -> user option Lwt.t val ballot : string option Eliom_reference.eref val precast_data : (string * credential_record) option Eliom_reference.eref val cast_confirmed : (user * string * bool * Weight.t * bool, Web_common.error) result option Eliom_reference.eref val language : string option Eliom_reference.eref val signup_address : string option Eliom_reference.eref val signup_env : signup_env option Eliom_reference.eref val set_email_env : string option Eliom_reference.eref val discard : unit -> unit Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_sig.mli0000644000175000017500000000451514476041226023410 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_serializable_t type result = | Html : Html_types.div Eliom_content.Html.elt -> result | Redirection : string -> result module type AUTH_SYSTEM = sig val pre_login_handler : [ `Username | `Address ] -> state:string -> result Lwt.t val direct : Yojson.Safe.t -> string Lwt.t end type auth_system = uuid option -> auth_config -> (module AUTH_SYSTEM) module type S = sig type post_login_handler = { post_login_handler : 'a. uuid option -> auth_config -> ((string * string) option -> 'a Lwt.t) -> 'a Lwt.t; } val register : auth_system:string -> auth_system -> state:string -> post_login_handler -> Eliom_registration.Html.result Lwt.t val get_site_login_handler : string -> result Lwt.t val direct_voter_auth : uuid -> Yojson.Safe.t -> user Lwt.t end belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_elections.mli0000644000175000017500000000472214476041226023566 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_common open Web_serializable_t open Belenios_api.Serializable_t open Api_generic val get_election_status : uuid -> election_status Lwt.t val get_records : uuid -> records Lwt.t val set_postpone_date : uuid -> float option -> bool Lwt.t val get_partial_decryptions : uuid -> metadata -> partial_decryptions Lwt.t val get_shuffles : uuid -> metadata -> shuffles Lwt.t val skip_shuffler : uuid -> string -> unit Lwt.t val select_shuffler : uuid -> metadata -> string -> unit Lwt.t val dispatch : token:string option -> ifmatch:string option -> string list -> [ `GET | `POST | `PUT | `DELETE ] -> body -> result Lwt.t val direct_voter_auth : (uuid -> Yojson.Safe.t -> user Lwt.t) ref val cast_ballot : (uuid -> bool -> string -> string -> weight option -> string -> bool Lwt.t) -> (module Site_common_sig.ELECTION) -> rawballot:string -> user:user -> precast_data:string * credential_record -> (user * string * bool * weight * bool) Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_election_mutex.mli0000644000175000017500000000313214476041226024623 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common val with_lock : Uuid.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t belenios-2.2-10-gbb6b7ea8/src/web/server/common/accounts.mli0000644000175000017500000000362214476041226022565 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Web_serializable_t val create_account : email:string -> user -> account Lwt.t val get_account_by_id : int -> account option Lwt.t val get_account : user -> account option Lwt.t val update_account : account -> unit Lwt.t val add_update_hook : (account -> unit Lwt.t) -> unit type capability = Sudo val has_capability : capability -> account -> bool val check : account -> int list -> bool belenios-2.2-10-gbb6b7ea8/src/web/server/common/api_elections.ml0000644000175000017500000004637114476041226023423 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt.Syntax open Belenios_core.Common open Belenios_core.Serializable_j open Web_serializable_j open Belenios_api.Serializable_j open Web_common open Api_generic let with_administrator token metadata f = let@ token = Option.unwrap unauthorized token in match lookup_token token with | Some a when Accounts.check a metadata.e_owners -> f a | _ -> unauthorized let find_trustee_id uuid token = let* x = Web_persist.get_decryption_tokens uuid in match x with | None -> Lwt.return (int_of_string_opt token) | Some tokens -> let rec find i = function | [] -> None | t :: ts -> if t = token then Some i else find (i + 1) ts in Lwt.return (find 1 tokens) let find_trustee_private_key uuid trustee_id = let* keys = Web_persist.get_private_keys uuid in let&* keys = keys in (* there is one Pedersen trustee *) let* trustees = Web_persist.get_trustees uuid in let open Belenios_core.Serializable_j in let trustees = trustees_of_string Yojson.Safe.read_json trustees in let rec loop i ts = match ts with | [] -> Lwt.return_none (* an error, actually *) | `Single _ :: ts -> loop (i - 1) ts | `Pedersen _ :: _ -> Lwt.return_some (List.nth keys i) in loop (trustee_id - 1) trustees let with_tally_trustee token uuid f = let@ token = Option.unwrap unauthorized token in let* x = find_trustee_id uuid token in match x with | Some trustee_id -> let* tally_trustee_private_key = find_trustee_private_key uuid trustee_id in f { tally_trustee_private_key } | None -> unauthorized let get_election_status uuid = let* status_state = Web_persist.get_election_state uuid in let* d = Web_persist.get_election_dates uuid in let status_auto_archive_date = match status_state with | `Tallied -> let t = Option.value d.e_tally ~default:default_tally_date in Some (Datetime.to_unixfloat @@ Period.add t (Period.day days_to_archive)) | _ -> None in let status_auto_delete_date = match status_state with | `Open | `Closed | `Shuffling | `EncryptedTally -> let t = Option.value d.e_finalization ~default:default_validation_date in Datetime.to_unixfloat @@ Period.add t (Period.day days_to_delete) | `Tallied -> let t = Option.value d.e_tally ~default:default_tally_date in Datetime.to_unixfloat @@ Period.add t (Period.day (days_to_archive + days_to_delete)) | `Archived -> let t = Option.value d.e_archive ~default:default_archive_date in Datetime.to_unixfloat @@ Period.add t (Period.day days_to_delete) in let* postpone = Web_persist.get_election_result_hidden uuid in Lwt.return { status_state; status_auto_archive_date; status_auto_delete_date; status_postpone_date = Option.map Datetime.to_unixfloat postpone; } let get_partial_decryptions uuid metadata = let@ () = fun cont -> let* state = Web_persist.get_election_state uuid in match state with | `EncryptedTally -> cont () | _ -> Lwt.fail @@ Error `NotInExpectedState in let open Belenios_core.Serializable_j in let* pds = Web_persist.get_partial_decryptions uuid in let* trustees = Web_persist.get_trustees uuid in let trustees = trustees_of_string Yojson.Safe.read_json trustees in let threshold, npks = let rec loop trustees threshold npks = match trustees with | [] -> (threshold, npks) | `Single _ :: ts -> loop ts threshold (npks + 1) | `Pedersen t :: ts -> ( match threshold with | Some _ -> raise @@ Error (`Unsupported "two Pedersens") | None -> loop ts (Some t.t_threshold) (npks + Array.length t.t_verification_keys)) in loop trustees None 0 in let trustees = let rec loop i ts = if i <= npks then match ts with | t :: ts -> (Some t, i) :: loop (i + 1) ts | [] -> (None, i) :: loop (i + 1) ts else [] in match metadata.e_trustees with None -> loop 1 [] | Some ts -> loop 1 ts in let rec seq i j = if i >= j then [] else i :: seq (i + 1) j in let* trustee_tokens = match threshold with | None -> Lwt.return @@ List.map string_of_int (seq 1 (npks + 1)) | Some _ -> ( let* x = Web_persist.get_decryption_tokens uuid in match x with | Some x -> Lwt.return x | None -> ( match metadata.e_trustees with | None -> failwith "missing trustees in get_tokens_decrypt" | Some ts -> let ts = List.map (fun _ -> generate_token ()) ts in let* () = Web_persist.set_decryption_tokens uuid ts in Lwt.return ts)) in Lwt.return { partial_decryptions_trustees = List.combine trustees trustee_tokens |> List.map (fun ((name, id), token) -> { trustee_pd_address = Option.value name ~default:""; trustee_pd_token = token; trustee_pd_done = List.exists (fun x -> x.owned_owner = id) pds; }); partial_decryptions_threshold = threshold; } let set_postpone_date uuid date = let@ date cont = match date with | None -> cont None | Some t -> let t = Datetime.from_unixfloat t in let max = Period.add (Datetime.now ()) (Period.day days_to_publish_result) in if Datetime.compare t max > 0 then Lwt.return_false else cont (Some t) in let* () = Web_persist.set_election_result_hidden uuid date in Lwt.return_true let get_shuffles uuid metadata = let@ () = fun cont -> let* state = Web_persist.get_election_state uuid in match state with | `Shuffling -> cont () | _ -> Lwt.fail @@ Error `NotInExpectedState in let* shuffles = Web_persist.get_shuffles uuid in let shuffles = Option.value shuffles ~default:[] in let* skipped = Web_persist.get_skipped_shufflers uuid in let skipped = Option.value skipped ~default:[] in let* token = Web_persist.get_shuffle_token uuid in Lwt.return { shuffles_shufflers = (match metadata.e_trustees with None -> [ "server" ] | Some ts -> ts) |> List.mapi (fun i t -> let trustee_id = i + 1 in { shuffler_address = t; shuffler_fingerprint = List.find_map (fun (_, o, _) -> if o.owned_owner = trustee_id then Some (Hash.to_b64 o.owned_payload) else if List.mem t skipped then Some "" else None) shuffles; shuffler_token = Option.bind token (fun x -> if x.tk_trustee = t then Some x.tk_token else None); }); } let extract_names trustees = let open Belenios_core.Serializable_t in trustees |> List.map (function | `Pedersen x -> x.t_verification_keys |> Array.to_list |> List.map (fun x -> x.trustee_name) | `Single x -> [ x.trustee_name ]) |> List.flatten |> List.mapi (fun i x -> (i + 1, x)) let get_trustee_names uuid = let open Belenios_core.Serializable_j in let* trustees = Web_persist.get_trustees uuid in let trustees = trustees_of_string Yojson.Safe.read_json trustees in Lwt.return (extract_names trustees) let get_trustee_name uuid metadata trustee = match metadata.e_trustees with | None -> Lwt.return (1, None) | Some xs -> let* names = get_trustee_names uuid in Lwt.return (List.assoc trustee (List.combine xs names)) let skip_shuffler uuid trustee = let* x = Web_persist.get_shuffle_token uuid in let* () = match x with | Some x when x.tk_trustee = trustee -> Web_persist.clear_shuffle_token uuid | None -> Lwt.return_unit | _ -> Lwt.fail @@ Error `NotInExpectedState in let* x = Web_persist.get_skipped_shufflers uuid in let x = Option.value x ~default:[] in if List.mem trustee x then Lwt.fail @@ Error `NotInExpectedState else Web_persist.set_skipped_shufflers uuid (trustee :: x) let select_shuffler uuid metadata trustee = let* trustee_id, name = get_trustee_name uuid metadata trustee in let* () = Web_persist.clear_shuffle_token uuid in let* _ = Web_persist.gen_shuffle_token uuid trustee trustee_id name in Lwt.return_unit let split_voting_record = let rex = Pcre.regexp "\"(.*)(\\..*)?\" \".*:(.*)\"" in fun x -> let s = Pcre.exec ~rex x in { vr_date = Datetime.to_unixfloat @@ Datetime.wrap @@ Pcre.get_substring s 1; vr_username = Pcre.get_substring s 3; } let get_records uuid = let* x = Web_persist.get_records uuid in let x = Option.value x ~default:[] in Lwt.return @@ List.map split_voting_record x let cast_ballot send_confirmation election ~rawballot ~user ~precast_data = let module W = (val election : Site_common_sig.ELECTION) in let uuid = W.election.e_uuid in let* email, login, weight = let* x = Web_persist.get_voter uuid user.user_name in match x with | Some x -> Lwt.return @@ Voter.get x | None -> fail UnauthorizedVoter in let* show_weight = Web_persist.get_has_explicit_weights uuid in let oweight = if show_weight then Some weight else None in let user_s = string_of_user user in let* state = Web_persist.get_election_state uuid in let voting_open = state = `Open in let* () = if not voting_open then fail ElectionClosed else Lwt.return_unit in let* r = Web_persist.cast_ballot election ~rawballot ~user:user_s ~weight (Datetime.now ()) ~precast_data in match r with | Ok (hash, revote) -> let* success = send_confirmation uuid revote login email oweight hash in let () = if revote then Printf.ksprintf Ocsigen_messages.accesslog "Someone revoted in election %s" (Uuid.unwrap uuid) in Lwt.return (user, hash, revote, weight, success) | Error e -> fail (CastError e) let direct_voter_auth = ref (fun _ _ -> assert false) (* initialized in Web_main *) let dispatch_election ~token ~ifmatch endpoint method_ body uuid raw metadata = match endpoint with | [] -> ( let get () = let* x = get_election_status uuid in Lwt.return @@ string_of_election_status x in match method_ with | `GET -> handle_get get | `POST -> ( let@ () = handle_ifmatch ifmatch get in let@ _ = with_administrator token metadata in let@ request = body.run admin_request_of_string in match request with | (`Open | `Close) as x -> let doit = match x with | `Open -> Web_persist.open_election | `Close -> Web_persist.close_election in let* b = doit uuid in if b then ok else forbidden | (`ComputeEncryptedTally | `FinishShuffling) as x -> let@ () = handle_generic_error in let doit = match x with | `ComputeEncryptedTally -> Web_persist.compute_encrypted_tally | `FinishShuffling -> Web_persist.finish_shuffling in let module W = Belenios.Election.Make (struct let raw_election = raw end) (Random) () in let* b = doit (module W) in if b then ok else forbidden | `ReleaseTally -> let@ () = handle_generic_error in let* () = Web_persist.release_tally uuid in ok | `Archive -> let@ () = handle_generic_error in let* () = Web_persist.archive_election uuid in ok | `RegeneratePassword user -> let@ () = handle_generic_error in let module W = Belenios.Election.Make (struct let raw_election = raw end) (Random) () in let* b = Web_persist.regen_password (module W) metadata user in if b then ok else not_found | `SetPostponeDate date -> let@ () = handle_generic_error in let* b = set_postpone_date uuid date in if b then ok else bad_request) | `DELETE -> let@ () = handle_ifmatch ifmatch get in let@ _ = with_administrator token metadata in let@ () = handle_generic_error in let* () = Web_persist.delete_election uuid in ok | _ -> method_not_allowed) | [ "election" ] -> ( match method_ with | `GET -> Lwt.return (200, raw) | _ -> method_not_allowed) | [ "trustees" ] -> ( let get () = Web_persist.get_trustees uuid in match method_ with `GET -> handle_get get | _ -> method_not_allowed) | [ "automatic-dates" ] -> ( let get () = let* x = Web_persist.get_election_automatic_dates uuid in Lwt.return @@ string_of_election_auto_dates x in match method_ with | `GET -> handle_get get | `PUT -> let@ _ = with_administrator token metadata in let@ () = handle_ifmatch ifmatch get in let@ d = body.run election_auto_dates_of_string in let@ () = handle_generic_error in let* () = Web_persist.set_election_automatic_dates uuid d in ok | _ -> method_not_allowed) | [ "voters" ] -> ( let@ _ = with_administrator token metadata in match method_ with | `GET -> ( let@ () = handle_generic_error in let* x = Web_persist.get_voters_file uuid in match x with None -> not_found | Some x -> Lwt.return (200, x)) | _ -> method_not_allowed) | [ "records" ] -> ( let@ _ = with_administrator token metadata in match method_ with | `GET -> let@ () = handle_generic_error in let* x = get_records uuid in Lwt.return (200, string_of_records x) | _ -> method_not_allowed) | [ "partial-decryptions" ] -> ( match method_ with | `GET -> let@ _ = with_administrator token metadata in let@ () = handle_generic_error in let* x = get_partial_decryptions uuid metadata in Lwt.return (200, string_of_partial_decryptions x) | _ -> method_not_allowed) | [ "tally-trustee" ] -> ( match method_ with | `GET -> let@ x = with_tally_trustee token uuid in let@ () = handle_generic_error in Lwt.return (200, string_of_tally_trustee x) | _ -> method_not_allowed) | [ "shuffles" ] -> ( match method_ with | `GET -> let@ _ = with_administrator token metadata in let@ () = handle_generic_error in let* x = get_shuffles uuid metadata in Lwt.return (200, string_of_shuffles x) | _ -> method_not_allowed) | [ "shuffles"; shuffler ] -> ( match method_ with | `POST -> ( let@ _ = with_administrator token metadata in let@ request = body.run shuffler_request_of_string in let@ () = handle_generic_error in match request with | `Skip -> let* () = skip_shuffler uuid shuffler in ok | `Select -> let* () = select_shuffler uuid metadata shuffler in ok) | _ -> method_not_allowed) | [ "ballots" ] -> ( match method_ with | `POST -> ( let@ token = Option.unwrap unauthorized token in let@ user cont = Lwt.catch (fun () -> let json = match Base64.decode token with | Ok x -> Yojson.Safe.from_string x | Error (`Msg x) -> failwith x in let* x = !direct_voter_auth uuid json in cont x) (fun _ -> unauthorized) in let@ rawballot = body.run Fun.id in let@ () = handle_generic_error in let send_confirmation _ _ _ _ _ _ = Lwt.return_true in let module W = Belenios.Election.Make (struct let raw_election = raw end) (Random) () in let* x = Web_persist.precast_ballot (module W) ~rawballot in match x with | Error _ -> bad_request | Ok precast_data -> let* _ = cast_ballot send_confirmation (module W) ~rawballot ~user ~precast_data in ok) | _ -> method_not_allowed) | _ -> not_found let dispatch ~token ~ifmatch endpoint method_ body = match endpoint with | [] -> ( let@ token = Option.unwrap unauthorized token in let@ account = Option.unwrap unauthorized (lookup_token token) in match method_ with | `GET -> let* elections = Web_persist.get_elections_by_owner account.id in let elections = List.fold_left (fun accu (kind, summary_uuid, date, summary_name) -> let summary_date = Datetime.to_unixfloat date in match kind with | `Draft -> accu | (`Validated | `Tallied | `Archived) as x -> let summary_kind = Some x in { summary_uuid; summary_name; summary_date; summary_kind } :: accu) [] elections in Lwt.return (200, string_of_summary_list elections) | _ -> method_not_allowed) | uuid :: endpoint -> let@ uuid = Option.unwrap bad_request (Option.wrap Uuid.wrap uuid) in let* raw = Web_persist.get_raw_election uuid in let@ raw = Option.unwrap not_found raw in let* metadata = Web_persist.get_election_metadata uuid in dispatch_election ~token ~ifmatch endpoint method_ body uuid raw metadata belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_common.ml0000644000175000017500000003600114476041226022717 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_platform open Belenios_core open Platform open Common open Serializable_t open Web_serializable_j let ( let&* ) x f = match x with None -> Lwt.return_none | Some x -> f x let ( !! ) x = !Web_config.spool_dir // x let ( /// ) uuid x = !!(Uuid.unwrap uuid // x) module Datetime = Web_types.Datetime module Period = Web_types.Period module Random = struct let init_prng () = lazy (pseudo_rng (random_string secure_rng 16)) let prng = ref (init_prng ()) let () = let rec loop () = let* () = Lwt_unix.sleep 1800. in prng := init_prng (); loop () in Lwt.async loop 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 type error = | ElectionClosed | UnauthorizedVoter | CastError of Signatures.cast_error exception BeleniosWebError of error let fail e = Lwt.fail (BeleniosWebError e) let explain_error l e = let open (val l : Belenios_ui.I18n.GETTEXT) in match e with | ElectionClosed -> s_ "the election is closed" | UnauthorizedVoter -> s_ "you are not allowed to vote" | CastError (`SerializationError e) -> Printf.sprintf (f_ "your ballot has a syntax error (%s)") (Printexc.to_string e) | CastError `NonCanonical -> s_ "your ballot is not in canonical form" | CastError `InvalidBallot -> s_ "some proofs failed verification" | CastError `InvalidCredential -> s_ "your credential is invalid" | CastError `RevoteNotAllowed -> s_ "you are not allowed to revote" | CastError `UsedCredential -> s_ "your credential has already been used" | CastError `WrongCredential -> s_ "you are not allowed to vote with this credential" | CastError `WrongWeight -> s_ "your credential has a bad weight" | CastError `DuplicateBallot -> s_ "this ballot has already been accepted" | CastError `ExpiredBallot -> s_ "this ballot has expired" | CastError `WrongUsername -> s_ "your username is wrong" let decompose_seconds s = let s = float_of_int s in let h = int_of_float (s /. 3600.) in let s = s -. (float_of_int h *. 3600.) in let m = int_of_float (s /. 60.) in let s = s -. (float_of_int m *. 60.) in (h, m, int_of_float s) let format_period l x = let open (val l : Belenios_ui.I18n.GETTEXT) in let y, m, d, s = Period.ymds x in let y = if y = 0 then "" else string_of_int y ^ s_ " year(s)" in let m = if m = 0 then "" else string_of_int m ^ s_ " month(s)" in let d = if d = 0 then "" else string_of_int d ^ s_ " day(s)" in let hrs, min, sec = decompose_seconds s in let hrs = if hrs = 0 then "" else string_of_int hrs ^ s_ " hour(s)" in let min = if min = 0 then "" else string_of_int min ^ s_ " minute(s)" in let sec = if sec = 0 then "" else string_of_int sec ^ s_ " second(s)" in let approx = String.concat " " (List.filter (fun x -> x <> "") [ y; m; d; hrs; min ]) in if approx = "" then sec else approx let security_logfile = ref None let open_security_log f = let* () = match !security_logfile with | Some ic -> Lwt_io.close ic | None -> return () in let* ic = Lwt_io.( open_file ~flags:Unix.[ O_WRONLY; O_APPEND; O_CREAT ] ~perm:0o600 ~mode:output f) in security_logfile := Some ic; return () let security_log s = match !security_logfile with | None -> return () | Some ic -> Lwt_io.atomic (fun ic -> let* () = Lwt_io.write ic (string_of_datetime (Datetime.now ())) in let* () = Lwt_io.write ic ": " in let* () = Lwt_io.write_line ic (s ()) in Lwt_io.flush ic) ic let fail_http status = Lwt.fail (Ocsigen_extensions.Ocsigen_http_error (Ocsigen_cookie_map.empty, status)) let rewrite_fun = ref (fun x -> x) let rewrite_prefix x = !rewrite_fun x let set_rewrite_prefix ~src ~dst = let nsrc = String.length src in let f x = let n = String.length x in if n >= nsrc && String.sub x 0 nsrc = src then dst ^ String.sub x nsrc (n - nsrc) else x in rewrite_fun := f let get_election_home_url uuid = Printf.sprintf "%s/elections/%s/" !Web_config.prefix (Uuid.unwrap uuid) type election_file = | ESArchive of uuid | ESRaw | ESVoters | ESRecords | ESETally | ESResult let election_file_of_string = function | "election.json" -> ESRaw | "records" -> ESRecords | "voters.txt" -> ESVoters | "encrypted_tally.json" -> ESETally | "result.json" -> ESResult | x -> ( match Filename.chop_suffix_opt ~suffix:".bel" x with | Some uuid_s -> ESArchive (Uuid.wrap uuid_s) | None -> invalid_arg ("election_dir_item: " ^ x)) let string_of_election_file = function | ESArchive x -> Uuid.unwrap x ^ ".bel" | ESRaw -> "election.json" | ESRecords -> "records" | ESVoters -> "voters.txt" | ESETally -> "encrypted_tally.json" | ESResult -> "result.json" let election_file x = Eliom_parameter.user_type ~of_string:election_file_of_string ~to_string:string_of_election_file x let uuid x = Eliom_parameter.user_type ~of_string:Uuid.wrap ~to_string:Uuid.unwrap x type site_cont_path = ContSiteHome | ContSiteAdmin | ContSiteElection of uuid type site_cont_admin = Classic | Basic | New type site_cont = { path : site_cont_path; admin : site_cont_admin } let default_admin path = { path; admin = Classic } let site_cont_of_string x = let fail () = invalid_arg "site_cont_of_string" in let path, admin = match String.split_on_char '@' x with | [ path; "basic" ] -> (path, Basic) | [ path; "new" ] -> (path, New) | [ path ] -> (path, Classic) | _ -> fail () in let path = match String.split_on_char '/' path with | [ "home" ] -> ContSiteHome | [ "admin" ] -> ContSiteAdmin | [ "elections"; uuid ] -> ContSiteElection (Uuid.wrap uuid) | _ -> fail () in { path; admin } let string_of_site_cont x = let path = match x.path with | ContSiteHome -> "home" | ContSiteAdmin -> "admin" | ContSiteElection uuid -> Printf.sprintf "elections/%s" (Uuid.unwrap uuid) in let admin = match x.admin with Classic -> "" | Basic -> "@basic" | New -> "@new" in path ^ admin let site_cont x = Eliom_parameter.user_type ~of_string:site_cont_of_string ~to_string:string_of_site_cont x type privacy_cont = ContAdmin | ContSignup of string let privacy_cont_of_string x = match Pcre.split ~pat:"/" x with | [ "admin" ] -> ContAdmin | [ "signup"; service ] -> ContSignup service | _ -> invalid_arg "privacy_cont_of_string" let string_of_privacy_cont = function | ContAdmin -> "admin" | ContSignup service -> "signup/" ^ service let privacy_cont x = Eliom_parameter.user_type ~of_string:privacy_cont_of_string ~to_string:string_of_privacy_cont x type captcha_error = BadCaptcha | BadAddress type add_account_error = | UsernameTaken | AddressTaken | BadUsername | BadPassword of string | PasswordMismatch | BadSpaceInPassword include MakeGenerateToken (Random) let format_password x = if String.length x = 15 then String.sub x 0 5 ^ "-" ^ String.sub x 5 5 ^ "-" ^ String.sub x 10 5 else x let string_of_user { user_domain; user_name } = user_domain ^ ":" ^ user_name let mailer = match Sys.getenv_opt "BELENIOS_SENDMAIL" with | None -> "/usr/lib/sendmail" | Some x -> x let sendmail ?return_path message = let mailer = match return_path with | None -> mailer | Some x -> Printf.sprintf "%s -f %s" mailer x in Netsendmail.sendmail ~mailer message type mail_kind = | MailCredential of uuid | MailPassword of uuid | MailConfirmation of uuid | MailAutomaticWarning of uuid | MailAccountCreation | MailPasswordChange | MailLogin | MailSetEmail let stringuuid_of_mail_kind = function | MailCredential uuid -> ("credential", Some uuid) | MailPassword uuid -> ("password", Some uuid) | MailConfirmation uuid -> ("confirmation", Some uuid) | MailAutomaticWarning uuid -> ("autowarning", Some uuid) | MailAccountCreation -> ("account-creation", None) | MailPasswordChange -> ("password-change", None) | MailLogin -> ("login", None) | MailSetEmail -> ("set-email", None) let send_email kind ~recipient ~subject ~body = let contents = Netsendmail.compose ~from_addr:(!Web_config.server_name, !Web_config.server_mail) ~to_addrs:[ (recipient, recipient) ] ~in_charset:`Enc_utf8 ~out_charset:`Enc_utf8 ~subject body in let headers, _ = contents in let token = generate_token ~length:6 () in let date = Datetime.format ~fmt:"%Y%m%d%H%M%S" (Datetime.now ()) in let message_id = Printf.sprintf "<%s.%s@%s>" date token !Web_config.domain in headers#update_field "Message-ID" message_id; headers#update_field "Belenios-Domain" !Web_config.domain; let reason, uuid = stringuuid_of_mail_kind kind in headers#update_field "Belenios-Reason" reason; let () = match uuid with | None -> () | Some uuid -> headers#update_field "Belenios-UUID" (Uuid.unwrap uuid) in let return_path = !Web_config.return_path in let sendmail = sendmail ?return_path in let rec loop retry = Lwt.catch (fun () -> Lwt_preemptive.detach sendmail contents) (function | Unix.Unix_error (Unix.EAGAIN, _, _) when retry > 0 -> Ocsigen_messages.warning "Failed to fork for sending an e-mail; will try again in 1s"; let* () = Lwt_unix.sleep 1. in loop (retry - 1) | e -> let msg = Printf.sprintf "Failed to send an e-mail to %s: %s" recipient (Printexc.to_string e) in Ocsigen_messages.errlog msg; Lwt.return_unit) in loop 2 let get_languages xs = match xs with None -> [ "en" ] | Some xs -> xs let string_of_languages xs = String.concat " " (get_languages xs) let languages_of_string x = Pcre.split x let urlize = String.map (function '+' -> '-' | '/' -> '_' | c -> c) let unurlize = String.map (function '-' -> '+' | '_' -> '/' | c -> c) let markup x = let open Eliom_content.Html.F in let open Belenios_ui in let p = { Markup.bold = (fun _ xs -> span ~a:[ a_class [ "markup-b" ] ] xs); text = (fun _ x -> txt x); br = (fun _ -> br ()); italic = (fun _ xs -> span ~a:[ a_class [ "markup-i" ] ] xs); } in try let lexbuf = Lexing.from_string x in let xs = Markup_parser.full Markup_lexer.token lexbuf in let xs = Markup.render p xs in span xs with _ -> span ~a:[ a_class [ "markup-error" ] ] [ txt x ] let webize_trustee_public_key pk = { web_trustee_pok = pk.trustee_pok; web_trustee_public_key = pk.trustee_public_key; web_trustee_server = (if pk.trustee_name = Some "server" then Some true else None); } let unwebize_trustee_public_key pk = { trustee_pok = pk.web_trustee_pok; trustee_public_key = pk.web_trustee_public_key; trustee_name = (if pk.web_trustee_server = Some true then Some "server" else None); } let get_suitable_group_kind { t_questions; _ } = let group = ref `H in Array.iter (function | Question.NonHomomorphic _ -> group := `NH | Question.Homomorphic _ -> ()) t_questions; !group let is_group_fixed se = se.se_public_creds_received || match se.se_trustees with | `Basic x -> x.dbp_trustees <> [] | `Threshold x -> x.dtp_trustees <> [] let get_booth_index = function Some 2 -> Some 0 | _ -> None let compute_hash_link ~service ~uuid ~token = Eliom_uri.make_string_uri ~absolute:true ~service () |> (fun x -> Printf.sprintf "%s#%s-%s" x (Uuid.unwrap uuid) token) |> rewrite_prefix type credential_record = { cr_ballot : string option; cr_weight : weight; cr_username : string option; } let check_password_with_file ~db ~name_or_email ~password = let name_or_email = String.trim name_or_email |> String.lowercase_ascii in let check_name_or_email = if is_email name_or_email then function | u :: _ :: _ :: _ when String.lowercase_ascii u = name_or_email -> (* When authenticating as a voter, the username may be an email *) true | _ :: _ :: _ :: e :: _ when String.lowercase_ascii e = name_or_email -> (* When authenticating as an admin, email is 4th CSV field *) true | _ -> false else function | u :: _ :: _ :: _ when String.lowercase_ascii u = name_or_email -> true | _ -> false in let* db = Lwt_preemptive.detach Csv.load db in match List.find_opt check_name_or_email db with | Some (u :: salt :: hashed :: xs) -> if sha256_hex (salt ^ String.trim password) = hashed then let email = match xs with [] -> "" | x :: _ -> x in return_some (u, email) else return_none | _ -> return_none let default_contact = "" let default_questions = let open Question_h_t in let question = { q_answers = [| "Answer 1"; "Answer 2"; "Answer 3" |]; q_blank = None; q_min = 1; q_max = 1; q_question = "Question 1?"; } in [| Question.Homomorphic question |] let has_explicit_weights voters = List.exists (fun v -> let (_, { weight; _ }) : Voter.t = v.sv_id in weight <> None) voters let default_name = "" let default_description = "" let default_creation_date = datetime_of_string "\"2018-11-26 00:00:00.000000\"" let default_validation_date = datetime_of_string "\"2015-10-01 00:00:00.000000\"" let default_tally_date = datetime_of_string "\"2018-11-26 00:00:00.000000\"" let default_archive_date = datetime_of_string "\"2018-11-26 00:00:00.000000\"" let days_to_archive = 7 let days_to_delete = 365 let days_to_mail = 30 let days_between_mails = 7 let days_to_publish_result = 7 let max_election_name_size = 80 let max_total_weight = 100_000 let supported_booth_versions = [ 2 ] belenios-2.2-10-gbb6b7ea8/src/web/server/common/web_auth_email.ml0000644000175000017500000001726614476041226023553 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Lwt open Lwt.Syntax open Belenios_core open Common open Web_serializable_t open Web_common type login_env = { username_or_address : [ `Username | `Address ]; state : string; auth_instance : string; } module Make (Web_state : Web_state_sig.S) (Web_services : Web_services_sig.S) (Pages_common : Pages_common_sig.S) (Web_auth : Web_auth_sig.S) = struct module HashedInt = struct type t = int let equal = ( = ) let hash x = x end module Captcha_throttle = Lwt_throttle.Make (HashedInt) let captcha_throttle = Captcha_throttle.create ~rate:1 ~max:5 ~n:1 let scope = `Session (Eliom_common.create_scope_hierarchy "belenios-auth-email") let uuid_ref = Eliom_reference.eref ~scope None let env = Eliom_reference.eref ~scope None let login_env = Eliom_reference.eref ~scope None let auth_system uuid { auth_config; auth_instance; _ } = let module X = struct let pre_login_handler username_or_address ~state = let* () = Eliom_reference.set uuid_ref uuid in let site_or_election = match uuid with None -> `Site | Some _ -> `Election in match List.assoc_opt "use_captcha" auth_config with | Some "true" -> let* b = Captcha_throttle.wait captcha_throttle 0 in if b then let* challenge = Web_captcha.create_captcha () in let* fragment = Pages_common.login_email_captcha ~state None challenge "" in return @@ Web_auth_sig.Html fragment else let* fragment = Pages_common.login_email_not_now () in return @@ Web_auth_sig.Html fragment | _ -> if site_or_election = `Election then let env = { username_or_address; state; auth_instance } in let* () = Eliom_reference.set login_env (Some env) in let service = Web_services.email_election_login in let url = Eliom_uri.make_string_uri ~service ~absolute:true () |> rewrite_prefix in return @@ Web_auth_sig.Redirection url else let* fragment = Pages_common.login_email site_or_election username_or_address ~state in return @@ Web_auth_sig.Html fragment let direct _ = failwith "direct authentication not implemented for email" end in (module X : Web_auth_sig.AUTH_SYSTEM) let run_post_login_handler = Web_auth.register ~auth_system:"email" auth_system module Sender = struct type payload = unit type context = unit let send ~context:() ~address ~code = let* subject, body = Pages_common.email_email ~address ~code in send_email ~subject ~body ~recipient:address MailLogin end module Otp = Otp.Make (Sender) () let handle_email_post ~state ?(show_email_address = false) name ok = let name = String.trim name in let* address, site_or_election = let* uuid = Eliom_reference.get uuid_ref in match uuid with | None -> return ((if is_email name then Some name else None), `Site) | Some uuid -> let* address = let* x = Web_persist.get_voter uuid name in match x with | None -> Lwt.return_none | Some v -> let address, _, _ = Voter.get v in Lwt.return_some address in return (address, `Election) in match (ok, address) with | true, Some address -> let* () = Otp.generate ~context:() ~address ~payload:() in let* () = Eliom_reference.set env (Some (state, name, address)) in let* () = Eliom_reference.unset uuid_ref in let address = if show_email_address then Some address else None in Pages_common.email_login ?address site_or_election >>= Eliom_registration.Html.send | _ -> run_post_login_handler ~state { Web_auth.post_login_handler = (fun _ _ cont -> cont None) } let () = Eliom_registration.Any.register ~service:Web_services.email_election_login (fun () () -> let* env = Eliom_reference.get login_env in match env with | None -> Pages_common.authentication_impossible () >>= Eliom_registration.Html.send | Some { username_or_address; state; auth_instance } -> ( let* precast_data = Eliom_reference.get Web_state.precast_data in match precast_data with | Some (_, { cr_username = Some name; _ }) -> handle_email_post ~show_email_address:true ~state name true | _ -> let* fragment = Pages_common.login_email `Election username_or_address ~state in let* title = Pages_common.login_title `Election auth_instance in Pages_common.base ~title ~content:[ fragment ] () >>= Eliom_registration.Html.send)) let () = Eliom_registration.Any.register ~service:Web_services.email_post (fun () (state, name) -> handle_email_post ~state name true) let () = Eliom_registration.Any.register ~service:Web_services.email_captcha_post (fun () (state, (challenge, (response, name))) -> let* b = Web_captcha.check_captcha ~challenge ~response in handle_email_post ~state name b) let () = Eliom_registration.Any.register ~service:Web_services.email_login_post (fun () code -> let code = String.trim code in let* x = Eliom_reference.get env in match x with | Some (state, name, address) -> run_post_login_handler ~state { Web_auth.post_login_handler = (fun _ _ cont -> let* ok = match Otp.check ~address ~code with | Some () -> let* () = Eliom_state.discard ~scope () in return_some (name, address) | None -> return_none in cont ok); } | None -> run_post_login_handler ~state:"" { Web_auth.post_login_handler = (fun _ _ cont -> cont None) }) end belenios-2.2-10-gbb6b7ea8/src/web/server/module/0002755000175000017500000000000014476041226020237 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/server/module/dune0000644000175000017500000000015414476041226021113 0ustar stephsteph(library (name belenios_server_module) (public_name belenios-server.module) (libraries belenios-server)) belenios-2.2-10-gbb6b7ea8/src/web/server/module/main.ml0000644000175000017500000000005214476041226021510 0ustar stephstephlet () = Belenios_server.Web_main.main () belenios-2.2-10-gbb6b7ea8/src/web/server/executable/0002755000175000017500000000000014476041226021073 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/server/executable/dune0000644000175000017500000000040214476041226021743 0ustar stephsteph(executable (name server) (public_name belenios-server) (package belenios-server) (flags -linkall) (libraries ocsigenserver ocsipersist.sqlite ocsigenserver.ext.redirectmod ocsigenserver.ext.staticmod eliom belenios-platform-native belenios-server)) belenios-2.2-10-gbb6b7ea8/src/web/server/executable/server.ml0000644000175000017500000000310414476041226022727 0ustar stephstephlet () = Eliom_service.register_eliom_module "belenios" Belenios_server.Web_main.main let () = let alt_msg = "Alternate config file (default " ^ Ocsigen_config.get_config_file () ^ ")" and silent_msg = "Silent mode (error messages in errors.log only)" and pid_msg = "Specify a file where to write the PIDs of servers" and daemon_msg = "Daemon mode (detach the process)" and verbose_msg = "Verbose mode" and debug_msg = "Extremely verbose mode (debug)" and version_msg = "Display version number and exit" in try Arg.parse_argv Sys.argv [ ("-c", Arg.String Ocsigen_config.set_configfile, alt_msg); ("--config", Arg.String Ocsigen_config.set_configfile, alt_msg); ("-s", Arg.Unit Ocsigen_config.set_silent, silent_msg); ("--silent", Arg.Unit Ocsigen_config.set_silent, silent_msg); ("-p", Arg.String Ocsigen_config.set_pidfile, pid_msg); ("--pidfile", Arg.String Ocsigen_config.set_pidfile, pid_msg); ("-v", Arg.Unit Ocsigen_config.set_verbose, verbose_msg); ("--verbose", Arg.Unit Ocsigen_config.set_verbose, verbose_msg); ("--debug", Arg.Unit Ocsigen_config.set_debug, debug_msg); ("-d", Arg.Unit Ocsigen_config.set_daemon, daemon_msg); ("--daemon", Arg.Unit Ocsigen_config.set_daemon, daemon_msg); ("--version", Arg.Unit Ocsigen_config.display_version, version_msg); ] (fun _ -> ()) "usage: belenios-server [-c configfile]" with Arg.Help s -> print_endline s; exit 0 let () = Ocsigen_server.start ~config:(Ocsigen_parseconfig.parse_config ()) () belenios-2.2-10-gbb6b7ea8/src/web/static/0002755000175000017500000000000014476041226016733 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/web/static/dune0000644000175000017500000000502614476041226017612 0ustar stephsteph(install (files placeholder.png app2.css NavMenu.css MainMenu.css MainZone.css avatar.png) (section share) (package belenios-server)) (install (files tool_js.js tool_js_credgen.js tool_js_questions.js tool_js_tkeygen.js tool_js_ttkeygen.js tool_js_pd.js tool_js_shuffle.js tool_js_fingerprint.js admin_basic.js admin.js home.js checkpriv.js belenios_worker.js belenios_jslib.js) (section share) (package belenios-server)) (rule (target tool_js.js) (deps ../clients/tool/tool_js.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_credgen.js) (deps ../clients/tool/tool_js_credgen.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_questions.js) (deps ../clients/tool/tool_js_questions.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_tkeygen.js) (deps ../clients/tool/tool_js_tkeygen.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_ttkeygen.js) (deps ../clients/tool/tool_js_ttkeygen.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_pd.js) (deps ../clients/tool/tool_js_pd.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_shuffle.js) (deps ../clients/tool/tool_js_shuffle.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target tool_js_fingerprint.js) (deps ../clients/tool/tool_js_fingerprint.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target admin_basic.js) (deps ../clients/basic/admin_basic.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target admin.js) (deps ../clients/admin/admin.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target belenios_jslib.js) (deps ../clients/jslib/belenios_jslib.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target belenios_worker.js) (deps ../clients/worker/belenios_worker.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target home.js) (deps ../clients/election-home/home.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) (rule (target checkpriv.js) (deps ../clients/checkpriv/checkpriv.bc.js) (action (with-stdout-to %{target} (run ./wrap_tool.sh %{deps})))) belenios-2.2-10-gbb6b7ea8/src/web/static/MainMenu.css0000644000175000017500000000400314476041226021151 0ustar stephsteph.main-zone a { text-decoration: none; } .main-zone a:link, .main-zone a:visited { color: black; } .main-menu { flex: 1; padding-left: 2px; padding-right: 2px; padding-bottom: 10px; border-right: 1px solid black; } .main-menu > div:first-child { margin-top: 20px; } .main-menu__item, .main-menu__item-menutitle { min-height: 15px; font-size: 80%; margin-top:5px; margin-bottom:5px; padding-left:20px; } .main-menu__item:hover { background-color: #eee; } .active, .active:hover { background-color: rgb(255,160,120); } .main-menu__item-menutitle { background-color: #ddd; font-size: 90%; padding-top: 3px; padding-bottom: 3px; margin-top: 20px; } .main-menu__item-separator { width: 100%; border-top: 1px solid #ddd; } .main-menu__ddone, .main-menu__done, .main-menu__todo, .main-menu__doing, .main-menu__wip { height: 0px; position: relative; top: 3px; display: block; } .main-menu__ddone::before { font-size: 90%; color: gray; content: '\2714'; } .main-menu__done::before { font-size: 90%; color: green; content: '\2714'; } .main-menu__doing::before { font-size: 90%; color: blue; /* content: '\2014'; */ } .main-menu__wip::before { font-size: 90%; color: orange; content: '\2B58'; } .main-menu__todo::before { font-size: 90%; color: red; content: '\2718'; } .positioned { position: relative; } .main-menu__item-active { background-image: url("data:image/svg+xml;utf8,%3Csvg viewBox='0 0 10 10' xmlns='http://www.w3.org/2000/svg'%3E%3Cpath d='M 0 0 L 10 5 0 10 Z' fill='rgb(255,160,120)' stroke-width='0'/%3E%3C/svg%3E"); background-size: contain; background-repeat: no-repeat; height: 15px; width: 15px; right: -15px; display: block; position: absolute; } .unavailable { color: #666; font-style: italic; background-color: #eee; } .main-menu__button { margin-top: 5px; margin-bottom: 5px; text-align: center; } belenios-2.2-10-gbb6b7ea8/src/web/static/app2.css0000644000175000017500000000304314476041226020305 0ustar stephsteph.page-body { display:flex; } .page { max-width: 900px; } .emph { font-style: italic; } #popup { display:none; } #popup-background-filter { position:fixed; z-index: 100; top:0; left:0; bottom:0; right:0; background-color:rgba(0,0,0,0.4); z-index:99; } #popup-content { border: 3px solid black; border-radius: 5px; position: absolute; top: 50%; left: 50%; margin-right: -50%; transform: translate(-50%, -50%); z-index:100; background-color:white; padding: 10px; } #prev_lk { text-align: center; margin-top: 10px; } #prev_lk a { border: 1px solid black; border-radius: 2px; background-color: #ddd; padding: 3px; } .txt_with_a a { border-bottom: 1.5px dashed #222; } #import_block { margin-top: 20px; } #import_block h4 { margin-bottom: 5px; } #import_block ul, #import_block li { margin-top: 5px; } #inpcont { width: 20em; } #add_trustee_popup button, #add_trustee_popup div { margin: 5px; } #trustee_proc_but, #validate_but { text-align: center; margin-top: 20px; } #trustee_proc_but button, #validate_but button { font-size: 110%; } #warning { font-weight: bold; margin-top: 10px; margin-bottom: 10px; } #avail_lang { margin-top: 20px; } #avail_lang > div { font-weight: bold; } #avail_lang > table { margin-top: 3px; } #choose_lang > div { margin-top: 5px; } #choose_lang label { font-weight: bold; } #cred_gen_serv, #cred_auth_name, #cred_link { margin-left: 30px; } belenios-2.2-10-gbb6b7ea8/src/web/static/placeholder.png0000644000175000017500000002002514476041226021720 0ustar stephstephPNG  IHDRZIbKGD pHYs  tIME6}IDATxwtTe?Ν>J*!EBi"8XV^dWv]\EW|-.HA: T!H$Lc` $0s8->{=*nrBP:G;6c{9d)eb$6#%:oLpv|dvIjdX>#CbI0> n|`'IɄjԁ3M1kj$L#e o?M=yVz{"p%h%vWmAfoL4ޤ^lH<ޯy{W:@$4p5oH1_PtL&C)u{Xp >svdY `Tȶ6.`lFAUmeSp .Yc$yJ X]JCxsxJzY3^,ӥ'oI/4HF-ȸ A1U|v,)ѡjށR##xgW%P:d8Z௏\'sfs J$Ѭ.H`Xݹ.bl ( |tdQDP@WMY|2Ǎ񐗗Ǵi8xЯ uĻYc0 ::EQPP@zPD"ϋ x$kȒ%gD9_Kk-D$,Gcv3أ뗓=;;rʠīϸP}}`2 z=NP‘Pd  KBEB"z=x!N$gX|a~Y DQ񐟟(8pɓ'Ļa2'Onܹlݺo zJFI4{%bcc(֙ATr9Pۭ(Bv"K$ ZPΐȋ@eT*DEEѻwo/_L:5(g,]VKXXfDrQjgƳn5i0iT*Vȥ{/'"< ݊*: n U.>ע((**p />;$O?d Eꐝͫʞ={ۆ$pj#VE6.`HR _?tڍxdYFyZ-8"bd/zK.Z+4JPAegO>lܸ1HkFx˗c00K$館ù3*VC^e\zGl!} ^֟-GI#2ڢ<^ P% BRpҤIA] [oѴiSzeIMqd\\^@%z=-o@1tP=JYfmbI0KglNZFtŠ/d>*pL:8A@ŀ-ۻwo eeekH^^u&*j1Ӈ;!5/͟(-a&B4kw$7%a2WެV+{eԨQtڵ^{׽mѢǏv >QFa6 A˶j"a.%EEk56PRIA- #&ϛ|rq˽ǃfÇں?hbbŊ~1|pF# '!"fݢ=> =fYJs[㯁s}ڷoZ,eggƌ3*;v,:uBbZa FhDNgetg}Fll,JU$E˅<#t@\^pB0ͨTZ]ncZfܸqϚ50L&$a۱<3A]mUeY,Tx̜9ïߧf Wfr{^o민3 +Nt]$޵" ȲvhѢJΝ-܂hD) +@łVR^PYaRRR͛+e'f̘ADDA]C]ǃdٲex@Կ[nDDD I_ii)?>m_~_҃w$^^/Ln>ez$I5|-TqU륰}WioAHH& Z]{픕{,t:9q͛7͟?:] gϞ%##>4oޜZ_fQVVs=$M |>dY&//5kL&/^$IDFF֙',"Bqq1cƌh4b*t\=vl6'N7Ļ7T*T* 32A`ʕ{ａDv툊rFqnOz(G槟~ ?k,4hpM*91Ɠas69O\Z%vȱp_R ШDvd[8~8ʧwzK/~kՈ蟫 'yeN٪p`]5uQ Y۳ +BBBxXn#x߁ f\@k5µj[-E[C(D"ad=ڇV Ƈ<:!4(w՛REf\^χz3\)@NGV)}1kԀ&gsX;[WK R]ʶb}@DDz".. Ǫ+wzeJFN'6^mIYyX]^dEA l^܌G.< ;Zs'Nyv'L:40M΀wS<?^0(]KkunJOxjzV07?/Wa= F^KCVQR_. ~.Z-]Z0%pTGInz!]_aiifb&2(`?vyꩧc>}I:}ryl'ܗv id/ХǩmI Z5&=ޚw|B,!?UrGLR幵 _L]_ [*11S2e+u(0M~4D#`rLIWmQux۽5:'L&cLooO ;\%7aqC5]cE0uT|IeY+ 2t_<=yn,Ԉs.+khW ]&l>R^ |{:^/++ӧ;2}t&LNj)0K||< SNu17Q% ؞$]d9IYZ㩁5DQi9֭G :}v/^Z鈎j"IΝ;R8rH;4V44jij$Ѭt|r.rN* $`#p΢_2)~9"RUOflF!V;ɡ Z)vy,o;/AR(B?+h.P6l`FڷoOII W]UgG(OoNZGѪDb ((<>|BEZ^#(M*#{oԡEDFQO9YνtUo䆟@+~!\>wɱiçsle;^m(.(}UCON>}x衇{ٸq#+WMRn$Id?NNNYYY%|>7ndРAHD޽ټy3999WM],XQ/ d>Eᐥlcs+vbgxx;K`RI4 !+`qz(qoym]փ&k\8vΈ#HII LٷoZvy'cҥ:t[r4i҄|}q1}tZlyv;*s̡^x?O$''I<|$Y~.S>'O^|z6O/)UQ1gNZW_h_<^ϡC?̙3ILLdL2:)iELΟj2 0Foox❯2e | #F^?q'NdŘf|MFMllU$ p)8{~9G}T7ԄnAj?"B^Wزe ۶mcǎ^-x=CQ w0|^x9°ax7ٳ~OǪ}87m(ٳiժGYEQ8qB $]wAwh4;ƻQՌ7ٳgtEJ"++뚨@DÆ _mZnhZ())o8^6mJqq1999={0dȐjdee]Wիjb`6뼆MEDQ$==t:tiݺ5_|_}U=ϊתbwk^[~=}%..F!\ؽ{7{o߾u8堢׻5ksa2Xp!-[$%%嚨^J,ˬ_>zAEйb%6mԿC}UVѢE ~ϟOAAA` ћٖv C=%^1at]I©SO8rHΟ/$5@jj*6mxk:_Zpjvv6ӧO7~+Hh">SΞ=[RGա~z \%KwCd.*`|ҨQ@S},c())aҤI+LcMϞ=ٶm[@ƫdTO:+/{݊m6zP]j(t:eΜ974nHl~mbaѢEϸ\F*‘#G;v,=\cY 9dKh ZAp\c.]͊:tf=z3a&NH-qX#G"IR[Qѕɓ!= j@*Çl6_,(f͚ߔ+p.=1K8T* 駟fx"!! 0zhz}x<߿ٳgWڷjժ%^8 X,lJk+HII |̞=>8pʕ4lAl|gL:͛HoUàA5jDJJJ%iWă" " f`AfIENDB`belenios-2.2-10-gbb6b7ea8/src/web/static/wrap_tool.sh0000755000175000017500000000021414476041226021273 0ustar stephsteph#!/bin/sh set -e echo "\"use strict\";(function(g){var belenios={};" sed "s/(function(){return this}())/(g)/g" "$1" echo echo "}(this));" belenios-2.2-10-gbb6b7ea8/src/web/static/avatar.png0000644000175000017500000000267214476041226020724 0ustar stephstephPNG  IHDRW?zTXtRaw profile type exifxY 9E$q0KUntLJ^Rզ XȒO3a|:\T2q WL<W{itѳ< `_!׷.=˃+! ,kH(vjWv;cXI`RW8!$q@MR1zcba_> yk1AOIf}ٻs=.&.?/\>&ysjh>+jO6]f!岿 bn{+hkl@cZB *I*Mب!ă #s%s1.$FMtPci<|B߲k L0Fx-lOZQ;WW]#En'7||U j+͎q;LlJo%;gb<@$J1T9K H;$y;F.+g^bM*`K*T5-Z5lyrĒe3s+V]xMAv Tf>I4л \\74e ٔ]OSf34w tyq$ pp({Ż;{LkrTnJ~PLTER[_UY]TY]TY]TX\TZ]TY]UX^ZZZTY^TY]P``UX]TZ\TY]TY]TY]SY\UY^TZ\TY]UY]R[[UZ_TY]UX\TY]TY]RW\XXXTY^Q]]TX]SY]UUaSX]TY]TY]TY]TtRNS@fbKGDH pHYs  tIME9Ж 1IDATc`4&QZb;qM&&"J ALc߿IENDB`belenios-2.2-10-gbb6b7ea8/src/web/static/responsive_site.css0000644000175000017500000000174414476041226022672 0ustar stephsteph@import "../../../ext/css/style.css"; @import "../../../ext/css/superfish.css"; /* UI Components try to respect [BEM](http://getbem.com/naming/) for the naming of their CSS classes */ @import "../../../frontend/booth/components/PageHeader.css"; @import "../../../frontend/booth/components/Breadcrumb.css"; @import "../../../frontend/booth/components/PageFooter.css"; @import "../../../frontend/booth/components/NiceButton.css"; @import "../../../frontend/booth/components/NiceInput.css"; @import "./common.css"; #main { padding: 10px; } body { background: #E5E4E2; font-family: Arial, Helvetica, sans-serif; font-weight: lighter; line-height: initial; } @media screen and (max-width: 640px) { body { margin: 0; } } @media screen and (min-width: 640px) { body { margin: 8px; } } .page { max-width: 800px; margin: 0 auto; } .page-body { background: white; display: flex; flex-direction: column; } .cookie-disclaimer { padding: 10px; margin: 10px; } belenios-2.2-10-gbb6b7ea8/src/web/static/common.css0000644000175000017500000000307714476041226020742 0ustar stephstephol { list-style: decimal; } ul { list-style: disc; } #wrapper { min-height: 0px; font-size: 16px; } #header { color: #ffffff; height: auto; } #footer #bottom { line-height: 3em; } #header a { color: #ffffff; } button { cursor: pointer; } .current_step { text-align: center; font-size: 28px; padding-bottom: 28px; } .hybrid_box { border-style: solid; border-width: 1px; background: #E5E5E5; margin-top: 2em; margin-bottom: 2em; margin-left: 10%; margin-right: 10%; font-size: 80%; padding: 3px; line-height: 2.2ex; } .nh_explain { font-size: 90%; line-height: 2.2ex; font-style: italic; } .counting_method_specification { border: 1px groove; margin-bottom: 2ex; } .result_question_item { margin-bottom: 2ex; } .result_question { font-weight: bold; font-style: italic; } .result_jsquery { font-family: monospace; font-size: 90%; background-color: #EEEEEE; } .lang_box { float: right; text-align: right; } .embedded-login-form { margin: 2em; } .majority_judgment_result { margin: 1em; border: 1px solid; padding: 1em; } .schulze_result { margin: 1em; border: 1px solid; padding: 1em; } .schulze_result ol { margin-bottom: 1em; } .schulze_explanation { text-align: justify; margin-bottom: 1em; font-style: italic; font-size: 90%; } .majority_judgment_ranking { margin-top: 1em; margin-bottom: 1em; } .tooltip .tooltiptext { visibility: hidden; } .tooltip:hover .tooltiptext { visibility: visible; } belenios-2.2-10-gbb6b7ea8/src/web/static/booth.css0000644000175000017500000000027714476041226020564 0ustar stephsteph@import "../../../ext/css/style.css"; @import "../../../ext/css/superfish.css"; @import "./site.css"; #footer #bottom { line-height: 1.5em; } #ballot_tracker { font-weight: bold; } belenios-2.2-10-gbb6b7ea8/src/web/static/MainZone.css0000644000175000017500000001357214476041226021173 0ustar stephsteph.main-zone { flex: 4; margin-top: 10px; margin-bottom: 10px; margin-left: 20px; margin-right: 10px; min-height: 200px; } /* Pictures for delete / insert */ div.ins_sym { width: 1.8ex; height: 1.8ex; background-image: url("data:image/svg+xml;utf8,%3Csvg viewBox='0 0 10 10' xmlns='http://www.w3.org/2000/svg'%3E%3Ccircle cx='5' cy='5' r='4.5' stroke='black' fill='none'/%3E%3Cpath d='M 5 2 V 8 M 2 5 H 8' stroke='black'/%3E%3C/svg%3E"); background-size: cover; } div.del_sym { width: 1.8ex; height: 1.8ex; background-image: url("data:image/svg+xml;utf8,%3Csvg viewBox='0 0 10 10' xmlns='http://www.w3.org/2000/svg'%3E%3Ccircle cx='5' cy='5' r='4.5' stroke='black' fill='none'/%3E%3Cpath d='M 2.88 2.88 L 7.12 7.12 M 7.12 2.88 L 2.88 7.12' stroke='black'/%3E%3C/svg%3E"); background-size: cover; } /* Things for the question part */ .question { border: 1px solid black; border-radius: 3px; padding: 5px; background-color: #f3f3f3; margin-bottom: 10px; margin-top: 10px; margin-right: 40px; font-size: 100%; position: relative; } .fake_question { padding: 5px; margin-bottom: 20px; margin-top: 10px; margin-right: 40px; font-size: 100%; position: relative; } .blur { filter: blur(1px) opacity(70%); } .qro { transform: scale(0.8); margin-right: 0px; margin-top: 0px; margin-bottom: 0px; } .qro_container { position: relative; margin-right: 20px; margin-top: 10px; margin-bottom: 10px; } .question input { font-size: 100%; } .qtitle, .qtype, .qans { font-size: 120%; font-weight: bold; display: block; margin-bottom: 3px; margin-top: 5px; } .qtit { width: 80%; } .qtype, .qans { font-size: 110%; } .expand_sort > div, .expand_grade > div, .expand_select > div { margin-top: 5px; padding: 5px; width: 70%; border: 1px solid black; border-radius: 3px; background-color: #f8f8f8; } .expand_select > div { margin-left: 10px; margin-right: auto; width: 50%; } .expand_select input[type=number] { width: 3em; margin-top: 2px; margin-bottom: 2px; } .expand_sort > div { margin-left: auto; margin-right: auto; } .expand_grade > div { margin-left: auto; margin-right: 5px; width: 50%; } .expand_sort input[type=number] { width: 3em; } .expand_grade input, .answers input { width: 80%; } .mention, .fake_mention, .answer, .fake_answer, .new_trustee { width: 100%; margin-left: 5%; position: relative; } .answers { width: 80%; } .answer { margin-left: 5px; } .fake_answer { margin-left: 5px; margin-bottom: 6px; } .new_trustee { margin-left: 10%; margin-bottom: 6px; } .fake_mention { margin-top: 6px; } .fake_mention .d_i_side, .fake_answer .d_i_side, .new_trustee .d_i_side { top: 0px; } .fake_mention > div:first-child, .fake_answer > div:first-child, .new_trustee > div:first-child{ width: 80%; text-align: right; font-style: italic; font-size: 90%; } .fake_question > div:first-child { text-align: right; font-style: italic; font-size: 110%; } .d_i_side { display: inline-block; position: absolute; top: 5px; left: calc(80% + 15px); font-size: 100%; font-weight: bold; } .fake_question .d_i_side { font-size: 130%; left: calc(100% + 10px); } .d_i_side div { display: inline-block; margin-right: 5px; } .d_i_side_top { display: inline-block; position: absolute; top: 0px; right: -50px; font-size: 130%; font-weight: bold; } .d_i_side_top div { display: inline-block; margin-right: 5px; } .mention .d_i_side, .answer .d_i_side { display: none; } .mention:hover .d_i_side, .d_i_side:hover { display: inline-block; } .answer:hover .d_i_side, .d_i_side:hover { display: inline-block; } #previewbooth { text-align: center; } #previewbooth div { display: inline-block; border: 2px solid #ccc; border-radius: 10px; padding: 5px; background-color: #eee; font-size: 120%; margin-top: 20px; margin-bottom: 20px; } #previewbooth div:hover { background-color: #ccc; border-color: #aaa; } /* Things for the voters list part */ .main-zone__content > hr { margin-bottom: 20px; } #list_warning { text-align: center; font-size: 120%; } #list_warning strong { font-weight: bold; } #list_warning2 { text-align: center; font-style: italic; width: 80%; margin-left: auto; margin-right: auto; } .iflog, .ifw, .ifsetup, .ifopen { display: none; } #login:checked ~ table .iflog, #poids:checked ~ table .ifw, #rad_setup:checked ~ table .ifsetup, #rad_run:checked ~ table .ifopen { display: table-cell; } #rad_setup:checked ~ div.ifsetup { display: block; } #rad_run:checked ~ div.ifopen { display: block; } th { color: white; background-color: #49494b; padding: 10px; text-align: left; } th:first-child { width: 50%; } th:last-child { width: 10%; background-color: white; } .ifw { width: 10%; } .iflog { width: 30%; } td { border-bottom: 1px solid black; padding-left: 10px; } td:last-child { border-bottom: 0; } table { margin-top: 20px; margin-bottom: 20px; border-collapse: collapse; width: 100%; } #addtolist { margin-top: 20px; } #addtolist textarea { vertical-align:top; } .tooltip { position: relative; display: inline-block; } .tooltiptext { position:absolute; right:3ex; top: -3ex; line-height:2.5ex; border:1px solid black; font-size:90%; display:none; width:400px; padding:3px; background-color:#eee; } .tooltip:hover .tooltiptext { display:inline-block; } .tooltip div:first-child { display:inline-block; width:3ex; line-height:3ex; text-align:center; border-radius:1.5ex; background-color:black; color:white; } belenios-2.2-10-gbb6b7ea8/src/web/static/site.css0000644000175000017500000000025214476041226020406 0ustar stephsteph@import "../../../ext/css/style.css"; @import "../../../ext/css/superfish.css"; @import "./common.css"; #main { border-radius: 0px 0px 0px 0px; padding: 10px; } belenios-2.2-10-gbb6b7ea8/src/web/static/NavMenu.css0000644000175000017500000000106514476041226021016 0ustar stephsteph.nav-menu { display: flex; flex-direction: row; background-color: #666; color: white; justify-content: space-between; } .nav-menu__item, .nav-menu__item-blank { padding: 5px; padding-left: 10px; padding-right: 10px; border-left-style: solid; border-right-style: solid; border-top-style: solid; border-width: 2px; } .nav-menu__item:hover { background-color: #aaa; } .nav-menu__item-blank { flex-grow: 1; } #avatar { height: 1.8ex; } #nav_username { display: inline-block; margin-right: 5px; } belenios-2.2-10-gbb6b7ea8/src/common/0002755000175000017500000000000014476041226016157 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/common/api/0002755000175000017500000000000014476041226016730 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/common/api/dune0000644000175000017500000000051114476041226017601 0ustar stephsteph(library (name belenios_api) (public_name belenios-server.api) (libraries belenios)) (rule (targets serializable_t.ml serializable_t.mli) (deps serializable.atd) (action (run atdgen -t %{deps}))) (rule (targets serializable_j.ml serializable_j.mli) (deps serializable.atd) (action (run atdgen -j -j-std %{deps}))) belenios-2.2-10-gbb6b7ea8/src/common/api/serializable.atd0000644000175000017500000001562614476041226022100 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type uuid = string wrap type template = abstract type 'a trustee_public_key = abstract type cert = abstract type vinput = abstract type 'a voutput = abstract type 'a trustees = abstract type validation_error = [ NoTitle | NoQuestions | NoAdministrator | NoCredentialAuthority | NoVoters | TooManyVoters | MissingPasswords | MissingPublicCredentials | TrusteesNotReady | WeightsAreIncompatibleWithNH | NotSinglePrivateKey | KeyEstablishmentNotFinished ] type error = [ GenericError of string | NotInExpectedState | CannotChange of string | Invalid of string | Unsupported of string | Missing of string | MissingVoter of string | ValidationError of validation_error ] type request_status = { code : int; status : string; error : error; } type configured_authentication = { instance : string; system : string; } type authentication_system = [ Password | CAS | Configured of configured_authentication ] type configuration = { privacy_policy : string; belenios_version : string; belenios_build : string; spec_version : string; api_version : int; supported_crypto_versions : int list; supported_booth_versions : int list; authentications : authentication_system list; default_group : string; default_nh_group : string; max_voters : int; languages : (string * string) list ; } type api_account = { id : int; name : string; address : string; ?language : string option; default_voter_languages : string list; default_contact : string; } type authentication = [ Password | CAS of string | Configured of string ] type draft = { version : int; owners : int list; questions : template; languages : string list; ?contact : string option; booth : int; authentication : authentication; group : string; } type 'a pedersen = { threshold : int; step : int; certs : cert list ; ?vinput : vinput option; ?voutput : 'a voutput option; } type kind = [ Validated | Tallied | Archived ] type summary = { uuid : uuid; name : string; date : float; ?kind : kind option; } type summary_list = summary list type voter_list = abstract type string_list = string list type public_credentials = string list type private_credentials = abstract type 'a trustee = { ?address : string option; name : string; ?token : string option; ?state : int option; ?key : 'a option; } type basic_trustees = { trustees : abstract trustee_public_key trustee list; } type threshold_trustees = { ?threshold : int option; trustees : cert trustee list; } type draft_trustees = [ Basic of basic_trustees | Threshold of threshold_trustees ] type draft_status = { num_voters : int; ?passwords_ready : bool option; credentials_ready : bool; ?private_credentials_downloaded : bool option; trustees_ready : bool; nh_and_weights_compatible : bool; credential_authority_visited : bool; voter_authentication_visited : bool; trustees_setup_step : int; } type draft_request = [ SetDownloaded | ValidateElection | SetCredentialAuthorityVisited | SetVoterAuthenticationVisited | SetTrusteesSetupStep of int ] type trustees_request = [ Add of abstract trustee | Import of uuid | SetBasic | SetThreshold of int ] type voters_request = [ Import of uuid ] type state = [ Open | Closed | Shuffling | EncryptedTally | Tallied | Archived ] type election_status = { state : state; auto_delete_date : float; ?auto_archive_date : float option; ?postpone_date : float option; } type election_auto_dates = { ?open : float option; ?close : float option; } type voting_record = { date : float; username : string; } type records = voting_record list type admin_request = [ Open | Close | ComputeEncryptedTally | FinishShuffling | ReleaseTally | Archive | RegeneratePassword of string | SetPostponeDate of float nullable ] type trustee_pd = { address : string; token : string; done : bool; } type partial_decryptions = { trustees : trustee_pd list; ?threshold : int option; } type tally_trustee = { ?private_key : string option; } type shuffler = { address : string; ?token : string option; ?fingerprint : string option; } type shuffles = { shufflers : shuffler list; } type shuffler_request = [ Skip | Select ] belenios-2.2-10-gbb6b7ea8/src/common/tool/0002755000175000017500000000000014476041226017134 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/common/tool/tool_credgen.ml0000644000175000017500000000751514476041226022140 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_core open Signatures open Serializable_t open Common module type PARAMS = sig val version : int val uuid : string val group : string end type credentials = { priv : private_credentials; public : string list; public_with_ids : string list; } module type S = sig val derive : string -> string val generate : Voter.t list -> credentials end module Make (P : PARAMS) (M : RANDOM) () = struct let uuid = Uuid.wrap P.uuid module G = (val Belenios.Group.of_string ~version:P.version P.group : GROUP) module CG = Credential.MakeGenerate (M) module CD = Credential.MakeDerive (G) module CredSet = Map.Make (G) let derive_in_group x = if Credential.check x then let x = CD.derive uuid x in G.(g **~ x) else Printf.ksprintf failwith "invalid secret credential: %s" x let derive x = G.to_string (derive_in_group x) let generate ids = let implicit_weights = not (has_explicit_weights ids) in let privs, pubs = List.fold_left (fun (privs, pubs) id -> let _, username, weight = Voter.get id in let priv = CG.generate () in ( (username, priv) :: privs, CredSet.add (derive_in_group priv) (weight, username) pubs )) ([], CredSet.empty) ids in let serialize (e, (w, id)) = G.to_string e ^ (if implicit_weights then "," else Printf.sprintf ",%s" (Weight.to_string w)) ^ Printf.sprintf ",%s" id in let serialize_public (e, (w, _)) = G.to_string e ^ if implicit_weights then "" else Printf.sprintf ",%s" (Weight.to_string w) in let bindings = CredSet.bindings pubs in { priv = List.rev privs; public = List.map serialize_public bindings; public_with_ids = List.map serialize bindings; } end let int_length n = string_of_int n |> String.length let rec find_first n first = if int_length first = int_length (first + n) then first else find_first n (10 * first) let generate_ids n = (* choose the first id so that they all have the same length *) let first = find_first n 1 in let last = first + n - 1 in let rec loop last accu = if last < first then accu else let address = string_of_int last in let x : Voter.t = (`Plain, { address; login = None; weight = None }) in loop (last - 1) (x :: accu) in loop last [] belenios-2.2-10-gbb6b7ea8/src/common/tool/dune0000644000175000017500000000007514476041226020012 0ustar stephsteph(library (name belenios_tool_common) (libraries belenios)) belenios-2.2-10-gbb6b7ea8/src/common/tool/tool_mkelection.ml0000644000175000017500000000643614476041226022664 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core open Belenios open Serializable_j open Signatures open Common module type PARAMS = sig val version : int val uuid : string val group : string val template : string val get_trustees : unit -> string end module type S = sig val mkelection : unit -> string end module type PARSED_PARAMS = sig val version : int val uuid : uuid val template : template val group : string module G : GROUP val get_trustees : unit -> G.t trustees module Trustees : Trustees_sig.S end let parse_params p = let module P = (val p : PARAMS) in let module T = (val Trustees.get_by_version P.version) in let module R = struct let version = P.version let uuid = Uuid.wrap P.uuid let template = template_of_string P.template let group = P.group module G = (val Group.of_string ~version P.group : GROUP) let get_trustees () = P.get_trustees () |> trustees_of_string (sread G.of_string) module Trustees = T end in (module R : PARSED_PARAMS) module Make (P : PARSED_PARAMS) : S = struct open P (* Setup trustees *) module K = Trustees.MakeCombinator (G) let trustees = get_trustees () let y = K.combine_keys trustees let public_key = G.to_string y (* Setup election *) let params = { e_version = version; e_description = template.t_description; e_name = template.t_name; e_questions = template.t_questions; e_uuid = uuid; e_administrator = template.t_administrator; e_credential_authority = template.t_credential_authority; } (* Generate and serialize election.json *) let mkelection () = Election.make_raw_election params ~group ~public_key end let make params = let module P = (val parse_params params : PARSED_PARAMS) in let module R = Make (P) in (module R : S) belenios-2.2-10-gbb6b7ea8/src/common/tool/tool_credgen.mli0000644000175000017500000000073314476041226022304 0ustar stephstephopen Belenios_core.Serializable_t open Belenios_core.Common module type PARAMS = sig val version : int val uuid : string val group : string end type credentials = { priv : private_credentials; public : string list; public_with_ids : string list; } module type S = sig val derive : string -> string val generate : Voter.t list -> credentials end module Make (P : PARAMS) (M : Belenios_core.Signatures.RANDOM) () : S val generate_ids : int -> Voter.t list belenios-2.2-10-gbb6b7ea8/src/common/tool/tool_mkelection.mli0000644000175000017500000000037314476041226023027 0ustar stephstephmodule type PARAMS = sig val version : int val uuid : string val group : string val template : string val get_trustees : unit -> string end module type S = sig val mkelection : unit -> string end val make : (module PARAMS) -> (module S) belenios-2.2-10-gbb6b7ea8/src/common/tool/tool_tkeygen.ml0000644000175000017500000000512614476041226022173 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform open Belenios_core open Belenios open Platform open Serializable_j open Signatures open Common module type PARAMS = sig val group : string val version : int end module type S = sig type keypair = { id : string; priv : string; pub : string } val trustee_keygen : unit -> keypair end module Make (P : PARAMS) (M : RANDOM) () = struct module G = (val Group.of_string ~version:P.version P.group : GROUP) module Trustees = (val Trustees.get_by_version P.version) (* Generate key *) module KG = Trustees.MakeSimple (G) (M) module K = Trustees.MakeCombinator (G) type keypair = { id : string; priv : string; pub : string } let trustee_keygen () = let private_key = KG.generate () in let public_key = KG.prove private_key in assert (K.check [ `Single public_key ]); let id = String.sub (sha256_hex (G.to_string public_key.trustee_public_key)) 0 8 |> String.uppercase_ascii in let priv = string_of_number private_key in let pub = string_of_trustee_public_key (swrite G.to_string) public_key in { id; priv; pub } end belenios-2.2-10-gbb6b7ea8/src/common/tool/tool_tkeygen.mli0000644000175000017500000000041414476041226022337 0ustar stephstephmodule type PARAMS = sig val group : string val version : int end module type S = sig type keypair = { id : string; priv : string; pub : string } val trustee_keygen : unit -> keypair end module Make (P : PARAMS) (M : Belenios_core.Signatures.RANDOM) () : S belenios-2.2-10-gbb6b7ea8/src/lib/0002755000175000017500000000000014476041226015435 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/lib/v1/0002755000175000017500000000000014476041226015763 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/lib/v1/election.mli0000644000175000017500000000006114476041226020263 0ustar stephstephinclude Belenios_core.Versioned_sig.ELECTION_SIG belenios-2.2-10-gbb6b7ea8/src/lib/v1/question_h.ml0000644000175000017500000004214614476041226020500 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform open Belenios_core open Platform open Common open Signatures_core open Serializable_core_t open Question_h_t (** Helper functions *) let question_length q = Array.length q.q_answers + match q.q_blank with Some true -> 1 | _ -> 0 module Make (M : RANDOM) (G : GROUP) = struct open G let ( / ) x y = x *~ invert y let dummy_ciphertext = { alpha = G.one; beta = G.one } (** Multiply two ElGamal ciphertexts. *) let eg_combine c1 c2 = { alpha = c1.alpha *~ c2.alpha; beta = c1.beta *~ c2.beta } (** ElGamal encryption. *) let eg_encrypt y r x = { alpha = g **~ r; beta = (y **~ r) *~ (g **~ Z.of_int x) } let dummy_proof = { challenge = Z.zero; response = Z.zero } (** Fiat-Shamir non-interactive zero-knowledge proofs of knowledge *) let fs_prove gs x oracle = let w = M.random q in let commitments = Array.map (fun g -> g **~ w) gs in let challenge = oracle commitments in let response = Z.(erem (w - (x * challenge)) q) in { challenge; response } (** ZKPs for disjunctions *) let eg_disj_prove y d zkp x r { alpha; beta } = (* prove that alpha = g^r and beta = y^r/d_x *) (* the size of d is the number of disjuncts *) let n = Array.length d in assert (0 <= x && x < n); let proofs = Array.make n dummy_proof and commitments = Array.make (2 * n) g and total_challenges = ref Z.zero in (* compute fake proofs *) let f i = let challenge = M.random q in let response = M.random q in proofs.(i) <- { challenge; response }; commitments.(2 * i) <- (g **~ Z.((response + (r * challenge)) mod q)); commitments.((2 * i) + 1) <- (y **~ response) *~ ((beta *~ d.(i)) **~ challenge); total_challenges := Z.(!total_challenges + challenge) in let rec loop i = if i < x then let () = f i in loop (succ i) else if i = x then loop (succ i) else if i < n then let () = f i in loop (succ i) else () in let () = loop 0 in (total_challenges := Z.(q - (!total_challenges mod q))); (* compute genuine proof *) let p = fs_prove [| g; y |] r (fun commitx -> Array.blit commitx 0 commitments (2 * x) 2; let prefix = Printf.sprintf "prove|%s|%s,%s|" zkp (G.to_string alpha) (G.to_string beta) in Z.((G.hash prefix commitments + !total_challenges) mod q)) in proofs.(x) <- p; proofs let eg_disj_verify y d zkp proofs { alpha; beta } = G.check alpha && G.check beta && let n = Array.length d in n = Array.length proofs && let commitments = Array.make (2 * n) g and total_challenges = ref Z.zero in try for i = 0 to n - 1 do let { challenge; response } = proofs.(i) in if check_modulo q challenge && check_modulo q response then ( commitments.(2 * i) <- (g **~ response) *~ (alpha **~ challenge); commitments.((2 * i) + 1) <- (y **~ response) *~ ((beta *~ d.(i)) **~ challenge); total_challenges := Z.(!total_challenges + challenge)) else raise Exit done; (total_challenges := Z.(!total_challenges mod q)); let prefix = Printf.sprintf "prove|%s|%s,%s|" zkp (G.to_string alpha) (G.to_string beta) in Z.(hash prefix commitments =% !total_challenges) with Exit -> false (** ZKPs for blank ballots *) let make_blank_proof y zkp min max m0 c0 r0 mS cS rS = if m0 = 0 then let blank_proof = (* proof of m0 = 0 \/ mS = 0 (first is true) *) let challenge1 = M.random q in let response1 = M.random q in let commitmentA1 = g **~ Z.((response1 + (rS * challenge1)) mod q) in let commitmentB1 = (y **~ response1) *~ (cS.beta **~ challenge1) in let w = M.random q in let commitmentA0 = g **~ w and commitmentB0 = y **~ w in let prefix = Printf.sprintf "bproof0|%s|" zkp in let h = G.hash prefix [| commitmentA0; commitmentB0; commitmentA1; commitmentB1 |] in let challenge0 = Z.(erem (h - challenge1) q) in let response0 = Z.(erem (w - (r0 * challenge0)) q) in [| { challenge = challenge0; response = response0 }; { challenge = challenge1; response = response1 }; |] in let overall_proof = (* proof of m0 = 1 \/ min <= mS <= max (second is true) *) assert (min <= mS && mS <= max); let challenge0 = M.random q in let response0 = M.random q in let proof0 = { challenge = challenge0; response = response0 } in let overall_proof = Array.make (max - min + 2) proof0 in let commitments = Array.make (2 * (max - min + 2)) g in let total_challenges = ref challenge0 in commitments.(0) <- (g **~ Z.((response0 + (r0 * challenge0)) mod q)); commitments.(1) <- (y **~ response0) *~ ((c0.beta / g) **~ challenge0); let index_true = mS - min + 1 in let rec loop i = if i < max - min + 2 then if i <> index_true then ( let challenge = M.random q in let response = M.random q 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 **~ Z.((response + (rS * challenge)) mod q)); commitments.(j + 1) <- (y **~ response) *~ (nbeta **~ challenge); (total_challenges := Z.(!total_challenges + challenge)); loop (i + 1)) else loop (i + 1) else () in let () = loop 1 in let w = M.random q in let j = 2 * index_true in commitments.(j) <- g **~ w; commitments.(j + 1) <- y **~ w; let prefix = Printf.sprintf "bproof1|%s|" zkp in let h = G.hash prefix commitments in let challenge = Z.(erem (h - !total_challenges) q) in let response = Z.(erem (w - (rS * challenge)) q) in overall_proof.(index_true) <- { challenge; response }; overall_proof in (overall_proof, blank_proof) else let blank_proof = (* proof of m0 = 0 \/ mS = 0 (second is true) *) assert (mS = 0); let challenge0 = M.random q in let response0 = M.random q in let commitmentA0 = g **~ Z.((response0 + (r0 * challenge0)) mod q) in let commitmentB0 = (y **~ response0) *~ (c0.beta **~ challenge0) in let w = M.random q in let commitmentA1 = g **~ w and commitmentB1 = y **~ w in let prefix = Printf.sprintf "bproof0|%s|" zkp in let h = G.hash prefix [| commitmentA0; commitmentB0; commitmentA1; commitmentB1 |] in let challenge1 = Z.(erem (h - challenge0) q) in let response1 = Z.(erem (w - (rS * challenge1)) q) in [| { challenge = challenge0; response = response0 }; { challenge = challenge1; response = response1 }; |] in let overall_proof = (* proof of m0 = 1 \/ min <= mS <= max (first is true) *) assert (m0 = 1); let nil_proof = { challenge = Z.zero; response = Z.zero } in let overall_proof = Array.make (max - min + 2) nil_proof in let commitments = Array.make (2 * (max - min + 2)) g in let total_challenges = ref Z.zero in let rec loop i = if i < max - min + 2 then ( let challenge = M.random q in let response = M.random q 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 **~ Z.((response + (rS * challenge)) mod q)); commitments.(j + 1) <- (y **~ response) *~ (nbeta **~ challenge); (total_challenges := Z.(!total_challenges + challenge)); loop (i + 1)) else () in let () = loop 1 in let w = M.random q in commitments.(0) <- g **~ w; commitments.(1) <- y **~ w; let prefix = Printf.sprintf "bproof1|%s|" zkp in let h = G.hash prefix commitments in let challenge = Z.(erem (h - !total_challenges) q) in let response = Z.(erem (w - (r0 * challenge)) q) in overall_proof.(0) <- { challenge; response }; overall_proof in (overall_proof, blank_proof) let verify_blank_proof y zkp min max c0 cS overall_proof blank_proof = G.check c0.alpha && G.check c0.beta && G.check cS.alpha && G.check cS.beta (* check blank_proof, proof of m0 = 0 \/ mS = 0 *) && Array.length blank_proof = 2 && (try let commitments = Array.make 4 g in let total_challenges = ref Z.zero in let { challenge; response } = blank_proof.(0) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; commitments.(0) <- (g **~ response) *~ (c0.alpha **~ challenge); commitments.(1) <- (y **~ response) *~ (c0.beta **~ challenge); (total_challenges := Z.(!total_challenges + challenge)); let { challenge; response } = blank_proof.(1) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; commitments.(2) <- (g **~ response) *~ (cS.alpha **~ challenge); commitments.(3) <- (y **~ response) *~ (cS.beta **~ challenge); (total_challenges := Z.(!total_challenges + challenge)); let prefix = Printf.sprintf "bproof0|%s|" zkp in let h = G.hash prefix commitments in let total_challenges = Z.(!total_challenges mod q) in Z.(h =% total_challenges) with Exit -> false) (* check overall_proof, proof of m0 = 1 \/ min <= mS <= max *) && Array.length overall_proof = max - min + 2 && try let commitments = Array.make (2 * (max - min + 2)) g in let total_challenges = ref Z.zero in let { challenge; response } = overall_proof.(0) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; commitments.(0) <- (g **~ response) *~ (c0.alpha **~ challenge); commitments.(1) <- (y **~ response) *~ ((c0.beta / g) **~ challenge); (total_challenges := Z.(!total_challenges + challenge)); let rec loop i = if i < max - min + 2 then ( let { challenge; response } = overall_proof.(i) in if not (check_modulo q challenge && check_modulo q response) then raise Exit; let 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); (total_challenges := Z.(!total_challenges + challenge)); loop (i + 1)) else () in loop 1; let prefix = Printf.sprintf "bproof1|%s|" zkp in let h = G.hash prefix commitments in let total_challenges = Z.(!total_challenges mod q) in Z.(h =% total_challenges) with Exit -> false let invg = invert g let d01 = [| G.one; invg |] let make_d min max = let n = max - min + 1 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; d let stringify_choices choices = choices |> Array.map (fun { alpha; beta } -> Printf.sprintf "%s,%s" (G.to_string alpha) (G.to_string beta)) |> Array.to_list |> String.concat "," let create_answer q ~public_key:y ~prefix:zkp m = let n = Array.length m in let r = Array.init n (fun _ -> M.random G.q) in let choices = Array.map2 (eg_encrypt y) r m in let individual_proofs = Array.map3 (eg_disj_prove y d01 zkp) m r choices in let zkp = zkp ^ "|" ^ stringify_choices choices in match q.q_blank with | Some true -> (* index 0 is whether the ballot is blank or not, indexes 1..n-1 are the actual choices *) assert (n = Array.length q.q_answers + 1); let choices' = Array.sub choices 1 (n - 1) in let r' = Array.sub r 1 (n - 1) in let m' = Array.sub m 1 (n - 1) in let sumr = Array.fold_left Z.( + ) Z.zero r' in let summ = Array.fold_left ( + ) 0 m' in let sumc = Array.fold_left eg_combine dummy_ciphertext choices' in let overall_proof, blank_proof = make_blank_proof y zkp q.q_min q.q_max m.(0) choices.(0) r.(0) summ sumc sumr in let blank_proof = Some blank_proof in { choices; individual_proofs; overall_proof; blank_proof } | _ -> (* indexes 0..n-1 are the actual choices *) assert (n = Array.length q.q_answers); let sumr = Array.fold_left Z.( + ) Z.zero r in let summ = Array.fold_left ( + ) 0 m in let sumc = Array.fold_left eg_combine dummy_ciphertext choices in assert (q.q_min <= summ && summ <= q.q_max); let d = make_d q.q_min q.q_max in let overall_proof = eg_disj_prove y d zkp (summ - q.q_min) sumr sumc in let blank_proof = None in { choices; individual_proofs; overall_proof; blank_proof } let verify_answer q ~public_key:y ~prefix:zkp a = let n = Array.length a.choices in n = Array.length a.individual_proofs && Array.for_all2 (eg_disj_verify y d01 zkp) a.individual_proofs a.choices && let zkp = zkp ^ "|" ^ stringify_choices a.choices in match (q.q_blank, a.blank_proof) with | Some true, Some blank_proof -> n = Array.length q.q_answers + 1 && let c = Array.sub a.choices 1 (n - 1) in let sumc = Array.fold_left eg_combine dummy_ciphertext c in verify_blank_proof y zkp q.q_min q.q_max a.choices.(0) sumc a.overall_proof blank_proof | _, None -> n = Array.length q.q_answers && let sumc = Array.fold_left eg_combine dummy_ciphertext a.choices in let d = make_d q.q_min q.q_max in eg_disj_verify y d zkp a.overall_proof sumc | _, _ -> false let extract_ciphertexts _ a = `Array (Array.map (fun x -> `Atomic x) a.choices) let process_ciphertexts q es = let neutral = `Array (Array.make (question_length q) (`Atomic dummy_ciphertext)) in let ( * ) = Shape.map2 eg_combine in let rec power b n = if Z.(compare n zero) > 0 then let x = power b Z.(shift_right n 1) in (if Z.(compare (logand n one) one) = 0 then b else neutral) * x * x else neutral in let total = let open Weight in List.fold_left (fun a (w, _) -> a + w) zero es in let es = List.map (fun (w, b) -> power b (Weight.expand ~total w)) es in List.fold_left (Shape.map2 eg_combine) neutral es let compute_result ~num_tallied:total = let num_tallied = Weight.expand ~total total in let log = let module X = BabyStepGiantStep (G) in let log = X.log ~generator:G.g ~max:num_tallied in fun x -> match log x with | Some x -> x | None -> invalid_arg "Cannot compute result" in fun x -> Shape.to_array x |> Array.map (fun i -> Weight.reduce ~total (log i)) let check_result ~num_tallied x r = Array.for_all2 (fun x r -> let r = Weight.expand ~total:num_tallied r in let g' = if Z.compare r Z.zero = 0 then G.one else g **~ r in x =~ g') (Shape.to_array x) r end belenios-2.2-10-gbb6b7ea8/src/lib/v1/dune0000644000175000017500000000055114476041226016640 0ustar stephsteph(library (name belenios_v1) (public_name belenios-lib.v1) (libraries yojson atdgen belenios_platform belenios_core)) (rule (targets serializable_t.ml serializable_t.mli) (deps serializable.atd) (action (run atdgen -t %{deps}))) (rule (targets serializable_j.ml serializable_j.mli) (deps serializable.atd) (action (run atdgen -j -j-std %{deps}))) belenios-2.2-10-gbb6b7ea8/src/lib/v1/serializable.atd0000644000175000017500000000461014476041226021122 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type number = string wrap type uuid = string wrap type proof = abstract type question = abstract wrap type 'a params = { version : int; description : string; name : string; group : string; public_key : 'a; questions : question list ; uuid : uuid; ?administrator : string option; ?credential_authority : string option; } type signature = { hash : string; proof : proof; } type 'a ballot = { election_uuid : uuid; election_hash : string; credential : 'a; answers : abstract list ; ?signature : signature option; } belenios-2.2-10-gbb6b7ea8/src/lib/v1/question_h.mli0000644000175000017500000000006314476041226020641 0ustar stephstephinclude Belenios_core.Versioned_sig.QUESTION_H_SIG belenios-2.2-10-gbb6b7ea8/src/lib/v1/trustees.ml0000644000175000017500000004230414476041226020174 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform open Belenios_core open Platform open Serializable_core_t open Serializable_j open Signatures open Common exception PedersenFailure of string module MakeVerificator (G : GROUP) = struct 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 verify_cert x = let keys = cert_keys_of_string (sread G.of_string) x.s_message in verify keys.cert_verification x 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) G.(accu *~ (c.(k) **~ jk)) else accu in let computed_gsij = loop 0 Z.one G.one in loop_compute_vk (i + 1) G.(vk *~ computed_gsij)) else vk in loop_compute_vk 0 G.one) end module MakeCombinator (G : GROUP) = struct module V = MakeVerificator (G) let check_single { trustee_pok; trustee_public_key = y; _ } = G.check y && let { challenge; response } = trustee_pok in check_modulo G.q challenge && check_modulo G.q response && let commitment = G.((g **~ response) *~ (y **~ challenge)) in let zkp = "pok|" ^ G.description ^ "|" ^ G.to_string y ^ "|" in Z.(challenge =% G.hash zkp [| commitment |]) let check_pedersen t = Array.for_all V.verify_cert t.t_certs && let certs = Array.map (fun x -> cert_keys_of_string (sread G.of_string) x.s_message) t.t_certs in Array.for_all2 (fun cert x -> V.verify cert.cert_verification x) certs t.t_coefexps && let coefexps = Array.map (fun x -> (raw_coefexps_of_string (sread G.of_string) x.s_message).coefexps) t.t_coefexps in Array.for_all check_single t.t_verification_keys && let computed_vks = V.compute_verification_keys coefexps in t.t_threshold = Array.length coefexps.(0) && Array.for_all2 G.(fun vk computed_vk -> vk.trustee_public_key =~ computed_vk) t.t_verification_keys computed_vks let check trustees = trustees |> List.for_all (function | `Single t -> check_single t | `Pedersen t -> check_pedersen t) let combine_keys trustees = trustees |> List.map (function | `Single t -> t.trustee_public_key | `Pedersen p -> p.t_coefexps |> Array.map (fun x -> (raw_coefexps_of_string (sread G.of_string) x.s_message) .coefexps) |> Array.fold_left (fun accu x -> G.(accu *~ x.(0))) G.one) |> List.fold_left G.( *~ ) G.one 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) G.q mod G.q)) Z.one indexes let combine_factors trustees check partial_decryptions = (* neutral factor *) let dummy = match partial_decryptions with | x :: _ -> Shape.map (fun _ -> G.one) x.owned_payload.decryption_factors | [] -> failwith "no partial decryptions" in (* compute synthetic factor for each trustee_kind *) let fold pds_with_ids = let indexes = List.map fst pds_with_ids in List.fold_left (fun a (j, b) -> let l = lagrange indexes j in Shape.map2 G.(fun x y -> x *~ (y **~ l)) a b.decryption_factors) dummy pds_with_ids in let r = Util.compute_synthetic_factors trustees check partial_decryptions fold in (* combine all factors into one *) match r with | Ok factors -> Ok (List.fold_left (fun a b -> Shape.map2 G.( *~ ) a b) dummy factors) | Error _ as x -> x end (** Distributed key generation *) module MakeSimple (G : GROUP) (M : RANDOM) = struct open G (** Fiat-Shamir non-interactive zero-knowledge proofs of knowledge *) let fs_prove gs x oracle = let w = M.random q in let commitments = Array.map (fun g -> g **~ w) gs in let challenge = oracle commitments in let response = Z.(erem (w - (x * challenge)) q) in { challenge; response } let generate () = M.random q let prove x = let trustee_public_key = g **~ x in let zkp = "pok|" ^ G.description ^ "|" ^ G.to_string trustee_public_key ^ "|" in let trustee_pok = fs_prove [| g |] x (G.hash zkp) in { trustee_pok; trustee_public_key; trustee_name = None } end module MakePKI (G : GROUP) (M : RANDOM) = struct 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 String.init n (fun _ -> let x = M.random z58 in b58_digits.[Z.to_int x]) let derive_sk p = Z.of_hex (sha256_hex ("sk|" ^ p)) let derive_dk p = Z.of_hex (sha256_hex ("dk|" ^ p)) let sign sk s_message = let w = M.random G.q in 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 { s_message; s_signature } let encrypt y plaintext = let r = M.random G.q in let key = M.random G.q in 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 { y_alpha; y_beta; y_data } let decrypt x { y_alpha; y_beta; y_data } = 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 (swrite G.to_string) cert_keys in sign sk cert include MakeVerificator (G) end module MakeChannels (G : GROUP) (M : RANDOM) (P : PKI with type private_key = Z.t and type public_key = G.t) = struct 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 (swrite G.to_string) msg in let msg = P.sign sk msg in 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 (sread G.of_string) 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 module MakePedersen (G : GROUP) (M : RANDOM) (P : PKI with type private_key = Z.t and type public_key = G.t) (C : CHANNELS with type private_key = Z.t and type public_key = G.t) = struct type elt = G.t open G module K = MakeSimple (G) (M) module V = MakeVerificator (G) module L = MakeCombinator (G) let step1 () = let seed = P.genkey () in let sk = P.derive_sk seed in let dk = P.derive_dk seed in let cert = P.make_cert ~sk ~dk in (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 (sread G.of_string) 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 ( let a = M.random q in polynomial.(i) <- a; fill_polynomial (i + 1)) else () in let () = fill_polynomial 0 in let p_polynomial = let x = C.send sk ek (string_of_raw_polynomial { polynomial }) in string_of_encrypted_msg (swrite G.to_string) x in let coefexps = Array.map (fun x -> g **~ x) polynomial in let coefexps = string_of_raw_coefexps (swrite G.to_string) { coefexps } in let p_coefexps = P.sign sk coefexps in 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 let x = C.send sk certs.(j).cert_encryption secret in p_secrets.(j) <- string_of_encrypted_msg (swrite G.to_string) x; fill_secrets (j + 1)) else () in let () = fill_secrets 0 in { p_polynomial; p_secrets; p_coefexps } let step3_check certs i polynomial = let certs = Array.map (fun x -> cert_keys_of_string (sread G.of_string) 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 (sread G.of_string) 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 (sread G.of_string) 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 } = vinput.vi_polynomial |> encrypted_msg_of_string (sread G.of_string) |> C.recv dk vk |> 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 -> vinput.vi_secrets.(i) |> encrypted_msg_of_string (sread G.of_string) |> C.recv dk certs.(i).cert_verification |> secret_of_string |> fun x -> 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 (sread G.of_string) 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 let vo_public_key = K.prove pdk_decryption_key in let private_key = C.send sk ek pdk in let vo_private_key = string_of_encrypted_msg (swrite G.to_string) private_key in { 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 (sread G.of_string) 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 (sread G.of_string) x.s_message).coefexps) in let computed_vk = (V.compute_verification_keys coefexps).(i) in L.check [ `Single 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 (sread G.of_string) 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 (sread G.of_string) x.s_message).coefexps) in let computed_vks = V.compute_verification_keys coefexps in for j = 0 to n - 1 do let voutput = voutputs.(j) in if not (L.check [ `Single 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 belenios-2.2-10-gbb6b7ea8/src/lib/v1/mixnet.ml0000644000175000017500000002247714476041226017633 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform open Belenios_core open Platform open Common open Serializable_core_t open Signatures module Make (W : ELECTION_DATA) (M : RANDOM) = struct module G = W.G open G let randoms n = Array.init n (fun _ -> M.random G.q) let gen_permutation n = let tmp = Array.init n (fun i -> i) in let psi = Array.make n 0 in let rec loop i = if i < n then ( let k = M.random (Z.of_int Stdlib.(n - i)) in let k = Stdlib.(Z.to_int k + i) in psi.(i) <- tmp.(k); tmp.(k) <- tmp.(i); loop (succ i)) else psi in loop 0 let re_encrypt y { alpha; beta } r = { alpha = alpha *~ (g **~ r); beta = beta *~ (y **~ r) } let gen_shuffle y e = let n = Array.length e in let psi = gen_permutation n in let r = randoms n in let e = Array.map2 (re_encrypt y) e r in let e = Array.init n (fun i -> e.(psi.(i))) in (e, r, psi) let gen_permutation_commitment psi h = let n = Array.length psi in let c = Array.make n G.one and r = Array.make n Z.zero in let rec loop i = if i < n then ( let r_ = M.random G.q in r.(psi.(i)) <- r_; c.(psi.(i)) <- (g **~ r_) *~ h.(i); loop (succ i)) else (c, r) in loop 0 let get_nizkp_challenges n str = let h = sha256_hex str in Array.init n (fun i -> let i = sha256_hex (string_of_int i) in Z.(of_hex (sha256_hex (h ^ i)) mod G.q)) let get_nizkp_challenge str = let h = sha256_hex str in Z.(of_hex h mod G.q) let str_egs e = let b = Buffer.create 1024 in for i = 0 to pred (Array.length e) do let { alpha; beta } = e.(i) in Printf.bprintf b "%s,%s," (G.to_string alpha) (G.to_string beta) done; Buffer.contents b let str_elts c = let b = Buffer.create 1024 in for i = 0 to pred (Array.length c) do Printf.bprintf b "%s," (G.to_string c.(i)) done; Buffer.contents b let gen_commitment_chain c0 uu = let n = Array.length uu in let rr = randoms n in let cc = Array.make n G.one in let rec loop i = if i < n then ( let ccpred = if i = 0 then c0 else cc.(pred i) in cc.(i) <- (g **~ rr.(i)) *~ (ccpred **~ uu.(i)); loop (succ i)) else (cc, rr) in loop 0 module GMap = Map.Make (G) let make_get_generator_indep () = let to_avoid = ref GMap.empty in fun n -> let x = G.get_generator n in match GMap.find_opt x !to_avoid with | None -> to_avoid := GMap.add x n !to_avoid; x | Some n' -> Printf.ksprintf failwith "Generator #%d collides with #%d!" n n' let gen_shuffle_proof y ee ee' rr' psi = let get_generator_indep = make_get_generator_indep () in let n = Array.length ee in let h = get_generator_indep (-1) in assert (n = Array.length ee'); assert (n = Array.length rr'); assert (n = Array.length psi); let hh = Array.init n get_generator_indep in let cc, rr = gen_permutation_commitment psi hh in let str1 = str_egs ee ^ str_egs ee' ^ str_elts cc in let uu = get_nizkp_challenges n ("shuffle-challenges|" ^ W.fingerprint ^ "|" ^ str1) in let uu' = Array.init n (fun i -> uu.(psi.(i))) in let cc_hat, rr_hat = gen_commitment_chain h uu' in let w1 = M.random G.q in let w2 = M.random G.q in let w3 = M.random G.q in let w4 = M.random G.q in let ww_hat = randoms n in let ww' = randoms n in let t1 = g **~ w1 and t2 = g **~ w2 in let t3_ = Array.map2 ( **~ ) hh ww' in let t3 = Array.fold_left ( *~ ) (g **~ w3) t3_ in let t41_ = Array.map2 (fun e' w' -> e'.beta **~ w') ee' ww' in let t41 = Array.fold_left ( *~ ) (invert (y **~ w4)) t41_ in let t42_ = Array.map2 (fun e' w' -> e'.alpha **~ w') ee' ww' in let t42 = Array.fold_left ( *~ ) (invert (g **~ w4)) t42_ in let cc_hat' = Array.init n (fun i -> if i = 0 then h else cc_hat.(pred i)) in let tt_hat = Array.map3 (fun w_hat w' c_hat -> (g **~ w_hat) *~ (c_hat **~ w')) ww_hat ww' cc_hat' in let t = (t1, t2, t3, (t41, t42), tt_hat) in let str2 = str_elts [| t1; t2; t3; t41; t42 |] ^ str_elts tt_hat in let str3 = str1 ^ str_elts cc_hat ^ G.to_string y in let c = get_nizkp_challenge ("shuffle-challenge|" ^ W.fingerprint ^ "|" ^ str2 ^ str3) in let r_bar = Z.(Array.fold_left ( + ) zero rr mod G.q) in let s1 = Z.((w1 + (c * r_bar)) mod G.q) in let vv = Array.make n Z.one in for i = n - 2 downto 0 do vv.(i) <- Z.(uu'.(succ i) * vv.(succ i) mod G.q) done; let r_hat = Z.(Array.fold_left ( + ) zero (Array.map2 ( * ) rr_hat vv) mod G.q) in let s2 = Z.((w2 + (c * r_hat)) mod G.q) in let r_tilde = Z.(Array.fold_left ( + ) zero (Array.map2 ( * ) rr uu) mod G.q) in let s3 = Z.((w3 + (c * r_tilde)) mod G.q) in let r' = Z.(Array.fold_left ( + ) zero (Array.map2 ( * ) rr' uu) mod G.q) in let s4 = Z.((w4 + (c * r')) mod G.q) in let ss_hat = Array.init n (fun i -> Z.((ww_hat.(i) + (c * rr_hat.(i))) mod G.q)) in let ss' = Array.init n (fun i -> Z.((ww'.(i) + (c * uu'.(i))) mod G.q)) in let s = (s1, s2, s3, s4, ss_hat, ss') in (t, s, cc, cc_hat) let check_shuffle_proof y ee ee' proof = let get_generator_indep = make_get_generator_indep () in let n = Array.length ee in let h = get_generator_indep (-1) in n = Array.length ee' && let t, s, cc, cc_hat = proof in let t1, t2, t3, (t41, t42), tt_hat = t in let s1, s2, s3, s4, ss_hat, ss' = s in Array.for_all G.check [| t1; t2; t3; t41; t42 |] && Array.for_all (check_modulo G.q) [| s1; s2; s3; s4 |] && n = Array.length cc && n = Array.length cc_hat && n = Array.length tt_hat && n = Array.length ss_hat && n = Array.length ss' && Array.for_all G.check cc && Array.for_all G.check cc_hat && Array.for_all G.check tt_hat && Array.for_all (check_modulo G.q) ss_hat && Array.for_all (check_modulo G.q) ss' && let hh = Array.init n get_generator_indep in let str1 = str_egs ee ^ str_egs ee' ^ str_elts cc in let uu = get_nizkp_challenges n ("shuffle-challenges|" ^ W.fingerprint ^ "|" ^ str1) in let str2 = str_elts [| t1; t2; t3; t41; t42 |] ^ str_elts tt_hat in let str3 = str1 ^ str_elts cc_hat ^ G.to_string y in let c = get_nizkp_challenge ("shuffle-challenge|" ^ W.fingerprint ^ "|" ^ str2 ^ str3) in let c_bar = Array.fold_left ( *~ ) one cc *~ invert (Array.fold_left ( *~ ) one hh) in let u = Z.(Array.fold_left ( * ) one uu mod G.q) in let c_hat = (if n = 0 then h else cc_hat.(pred n)) *~ invert (h **~ u) in let c_tilde = Array.fold_left ( *~ ) one (Array.map2 ( **~ ) cc uu) in let a' = Array.fold_left ( *~ ) one (Array.map2 (fun x u -> x.beta **~ u) ee uu) in let b' = Array.fold_left ( *~ ) one (Array.map2 (fun x u -> x.alpha **~ u) ee uu) in let t1' = invert (c_bar **~ c) *~ (g **~ s1) in let t2' = invert (c_hat **~ c) *~ (g **~ s2) in let t3' = invert (c_tilde **~ c) *~ Array.fold_left ( *~ ) (g **~ s3) (Array.map2 ( **~ ) hh ss') in let t41' = Array.fold_left ( *~ ) (invert ((a' **~ c) *~ (y **~ s4))) (Array.map2 (fun x s -> x.beta **~ s) ee' ss') in let t42' = Array.fold_left ( *~ ) (invert ((b' **~ c) *~ (g **~ s4))) (Array.map2 (fun x s -> x.alpha **~ s) ee' ss') in let tt'_hat = Array.init n (fun i -> let x = if i = 0 then h else cc_hat.(pred i) in invert (cc_hat.(i) **~ c) *~ (g **~ ss_hat.(i)) *~ (x **~ ss'.(i))) in G.compare t1 t1' = 0 && G.compare t2 t2' = 0 && G.compare t3 t3' = 0 && G.compare t41 t41' = 0 && G.compare t42 t42' = 0 && Array.for_all2 (fun t t' -> G.compare t t' = 0) tt_hat tt'_hat end belenios-2.2-10-gbb6b7ea8/src/lib/v1/question_nh.mli0000644000175000017500000000006414476041226021020 0ustar stephstephinclude Belenios_core.Versioned_sig.QUESTION_NH_SIG belenios-2.2-10-gbb6b7ea8/src/lib/v1/question_nh.ml0000644000175000017500000000726214476041226020656 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform open Belenios_core open Platform open Common open Signatures_core open Serializable_core_t open Question_nh_t module Make (M : RANDOM) (G : GROUP) = struct open G let create_answer q ~public_key:y ~prefix m = assert (Array.length q.q_answers = Array.length m); let r = M.random G.q in let alpha = g **~ r and beta = (y **~ r) *~ G.of_ints m in let w = M.random G.q in let commitment = g **~ w in let zkp = Printf.sprintf "raweg|%s|%s,%s,%s|" prefix (G.to_string y) (G.to_string alpha) (G.to_string beta) in let challenge = G.hash zkp [| commitment |] in let response = Z.(erem (w - (r * challenge)) G.q) in let proof = { challenge; response } in let choices = { alpha; beta } in { choices; proof } let verify_answer _ ~public_key:y ~prefix a = let { alpha; beta } = a.choices in let { challenge; response } = a.proof in G.check alpha && G.check beta && check_modulo G.q challenge && check_modulo G.q response && let commitment = (g **~ response) *~ (alpha **~ challenge) in let zkp = Printf.sprintf "raweg|%s|%s,%s,%s|" prefix (G.to_string y) (G.to_string alpha) (G.to_string beta) in Z.(challenge =% G.hash zkp [| commitment |]) let extract_ciphertexts _ a = `Atomic a.choices let compare_ciphertexts x y = match (x, y) with | `Atomic x, `Atomic y -> let c = G.compare x.alpha y.alpha in if c = 0 then G.compare x.beta y.beta else c | _, _ -> invalid_arg "Question_nh.compare_ciphertexts" let process_ciphertexts _ es = let es = Array.map (fun (w, e) -> if not Weight.(is_int w 1) then invalid_arg "Question_nh.process_ciphertexts" else e) (Array.of_list es) in Array.fast_sort compare_ciphertexts es; `Array es let compute_result ~num_answers:n x = match x with | `Array xs -> xs |> Array.map (function | `Atomic x -> G.to_ints n x | _ -> invalid_arg "Question_nh.compute_result/1") | _ -> invalid_arg "Question_nh.compute_result/2" let check_result ~num_answers x r = r = compute_result ~num_answers x end belenios-2.2-10-gbb6b7ea8/src/lib/v1/mixnet.mli0000644000175000017500000000005714476041226017772 0ustar stephstephinclude Belenios_core.Versioned_sig.MIXNET_SIG belenios-2.2-10-gbb6b7ea8/src/lib/v1/election.ml0000644000175000017500000002662514476041226020130 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module PSerializable_j = Serializable_j open Belenios_platform open Belenios_core open Platform open Serializable_core_j open Serializable_j open PSerializable_j open Signatures open Common let of_string x = let open PSerializable_j in let params = params_of_string Yojson.Safe.read_json x in let { e_description; e_name; e_questions; e_uuid; e_administrator; e_credential_authority; _; } = params in let open Serializable_j in { e_version = 1; e_description; e_name; e_questions; e_uuid; e_administrator; e_credential_authority; } let to_string params ~group ~public_key = let open Serializable_j in let { e_description; e_name; e_questions; e_uuid; e_administrator; e_credential_authority; _; } = params in let module G = (val Group.of_string group) in let e_public_key = G.of_string public_key in let open PSerializable_j in let params = { e_version = 1; e_description; e_name; e_questions; e_uuid; e_administrator; e_credential_authority; e_group = group; e_public_key; } in string_of_params (swrite G.to_string) params module Parse (R : RAW_ELECTION) () = struct let j = params_of_string Yojson.Safe.read_json R.raw_election module G = (val Group.of_string j.e_group) let params = params_of_string (sread G.of_string) R.raw_election let election = let { e_description; e_name; e_questions; e_uuid; e_administrator; e_credential_authority; _; } = params in let open Serializable_j in { e_version = 1; e_description; e_name; e_questions; e_uuid; e_administrator; e_credential_authority; } let fingerprint = sha256_b64 R.raw_election let public_key = params.e_public_key module S = (val Question.compute_signature (Array.to_list election.e_questions)) type nonrec ballot = G.t ballot let string_of_ballot x = string_of_ballot (swrite G.to_string) x let ballot_of_string x = ballot_of_string (sread G.of_string) x let get_credential x = Some x.credential end module MakeElection (W : ELECTION_DATA) (M : RANDOM) = struct type elt = W.G.t module G = W.G module Q = Question.Make (M) (G) (Question_h.Make (M) (G)) (Question_nh.Make (M) (G)) module Mix = Mixnet.Make (W) (M) open G let election = W.election type private_key = Z.t type public_key = elt let ( / ) x y = x *~ invert y type plaintext = int array array type nonrec ballot = elt ballot type weighted_ballot = Weight.t * ballot (** Fiat-Shamir non-interactive zero-knowledge proofs of knowledge *) let fs_prove gs x oracle = let w = M.random q in let commitments = Array.map (fun g -> g **~ w) gs in let challenge = oracle commitments in let response = Z.(erem (w - (x * challenge)) q) in { challenge; response } (** Ballot creation *) let swap xs = let rec loop i accu = if i >= 0 then let x = xs.(i) in loop (pred i) (x :: accu) else Array.of_list accu in loop (pred (Array.length xs)) [] let create_answer y zkp q m = Q.create_answer q ~public_key:y ~prefix:zkp m let make_sig_prefix hash = "sig|" ^ hash ^ "|" let create_ballot ~sk m = let election_uuid = election.e_uuid in let election_hash = W.fingerprint in let credential = G.(g **~ sk) in let zkp = W.fingerprint ^ "|" ^ G.to_string credential in let answers = swap (Array.map2 (create_answer W.public_key zkp) election.e_questions m) in let ballot_without_signature = { election_uuid; election_hash; credential; answers; signature = None } in let s_hash = sha256_b64 (string_of_ballot (swrite G.to_string) ballot_without_signature) in let signature = let w = M.random q in let commitment = g **~ w in let prefix = make_sig_prefix s_hash in let challenge = G.hash prefix [| commitment |] in let response = Z.(erem (w - (sk * challenge)) q) in let s_proof = { challenge; response } in Some { s_hash; s_proof } in { election_uuid; election_hash; credential; answers; signature } (** Ballot verification *) let verify_answer y zkp q a = Q.verify_answer q ~public_key:y ~prefix:zkp a let check_ballot { election_uuid; election_hash; credential; answers; signature } = let ballot_without_signature = { election_uuid; election_hash; credential; answers; signature = None } in let expected_hash = sha256_b64 (string_of_ballot (swrite G.to_string) ballot_without_signature) in let zkp = W.fingerprint ^ "|" ^ G.to_string credential in election_uuid = election.e_uuid && election_hash = W.fingerprint && (match signature with | Some { s_hash; s_proof = { challenge; response } } -> s_hash = expected_hash && G.check credential && check_modulo q challenge && check_modulo q response && let commitment = (g **~ response) *~ (credential **~ challenge) in let prefix = make_sig_prefix s_hash in Z.(challenge =% G.hash prefix [| commitment |]) | None -> false) && Array.for_all2 (verify_answer W.public_key zkp) election.e_questions answers let check_rawballot rawballot = match ballot_of_string (sread G.of_string) rawballot with | exception e -> Error (`SerializationError e) | ballot -> if string_of_ballot (swrite G.to_string) ballot = rawballot then Ok { rc_credential = G.to_string ballot.credential; rc_check = (fun () -> check_ballot ballot); } else Error `NonCanonical let process_ballots bs = `Array (Array.mapi (fun i q -> Q.process_ciphertexts q (List.map (fun (w, b) -> (w, Q.extract_ciphertexts q b.answers.(i))) bs)) election.e_questions) let extract_nh_ciphertexts x = let x = Shape.to_shape_array x in let rec loop i accu = if i >= 0 then match election.e_questions.(i) with | Question.Homomorphic _ -> loop (i - 1) accu | Question.NonHomomorphic _ -> loop (i - 1) (Shape.to_array x.(i) :: accu) else Array.of_list accu in loop (Array.length x - 1) [] let merge_nh_ciphertexts cc x = let x = Array.copy (Shape.to_shape_array x) in let n = Array.length x and m = Array.length cc in let rec loop i j = if i < n && j < m then ( match election.e_questions.(i) with | Question.Homomorphic _ -> loop (i + 1) j | Question.NonHomomorphic _ -> x.(i) <- Shape.of_array cc.(j); loop (i + 1) (j + 1)) else ( assert (j = m); `Array x) in loop 0 0 let shuffle_ciphertexts cc = let rec loop i accu = if i >= 0 then let c = cc.(i) in let c', r', psi = Mix.gen_shuffle W.public_key c in let pi = Mix.gen_shuffle_proof W.public_key c c' r' psi in loop (i - 1) ((c', pi) :: accu) else let shuffle_ciphertexts, shuffle_proofs = Array.(split (of_list accu)) in { shuffle_ciphertexts; shuffle_proofs } in loop (Array.length cc - 1) [] let check_shuffle cc s = Array.for_all3 (Mix.check_shuffle_proof W.public_key) cc s.shuffle_ciphertexts s.shuffle_proofs type factor = elt partial_decryption let eg_factor x { alpha; _ } = let zkp = "decrypt|" ^ W.fingerprint ^ "|" ^ G.to_string (g **~ x) ^ "|" in (alpha **~ x, fs_prove [| g; alpha |] x (hash zkp)) let check_ciphertext c = Shape.forall (fun { alpha; beta } -> G.check alpha && G.check beta) c let compute_factor c x = if check_ciphertext c then let res = Shape.map (eg_factor x) c in let decryption_factors, decryption_proofs = Shape.split res in { decryption_factors; decryption_proofs } else invalid_arg "Invalid ciphertext" let check_factor c y f = let zkp = "decrypt|" ^ W.fingerprint ^ "|" ^ G.to_string y ^ "|" in Shape.forall3 (fun { alpha; _ } f { challenge; response } -> G.check f && check_modulo q challenge && check_modulo q response && let commitments = [| (g **~ response) *~ (y **~ challenge); (alpha **~ response) *~ (f **~ challenge); |] in Z.(hash zkp commitments =% challenge)) c f.decryption_factors f.decryption_proofs type result_type = W.result type result = result_type Serializable_t.election_result module Combinator = Trustees.MakeCombinator (G) let compute_result encrypted_tally partial_decryptions trustees = let num_tallied = encrypted_tally.sized_total_weight in let et = encrypted_tally.sized_encrypted_tally in let check = check_factor et in match Combinator.combine_factors trustees check partial_decryptions with | Ok factors -> let results = Shape.map2 (fun { beta; _ } f -> beta / f) et factors in let result = Q.compute_result ~num_tallied W.S.x results in Ok { result } | Error e -> Error e let check_result encrypted_tally partial_decryptions trustees { result } = let num_tallied = encrypted_tally.sized_total_weight in let encrypted_tally = encrypted_tally.sized_encrypted_tally in check_ciphertext encrypted_tally && let check = check_factor encrypted_tally in match Combinator.combine_factors trustees check partial_decryptions with | Error _ -> false | Ok factors -> let results = Shape.map2 (fun { beta; _ } f -> beta / f) encrypted_tally factors in Q.check_result ~num_tallied W.S.x results result end module Make (MakeResult : MAKE_RESULT) (R : RAW_ELECTION) (M : RANDOM) () = struct module X = Parse (R) () module Y = struct include X include MakeResult (X) end include Y module E = MakeElection (Y) (M) end belenios-2.2-10-gbb6b7ea8/src/lib/v1/group.mli0000644000175000017500000000005614476041226017621 0ustar stephstephinclude Belenios_core.Versioned_sig.GROUP_SIG belenios-2.2-10-gbb6b7ea8/src/lib/v1/group.ml0000644000175000017500000001212314476041226017446 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform open Platform open Belenios_core open Serializable_j open Signatures let get_ff_params = function | "BELENIOS-2048" -> { g = Z.of_string "2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627"; p = Z.of_string "20694785691422546401013643657505008064922989295751104097100884787057374219242717401922237254497684338129066633138078958404960054389636289796393038773905722803605973749427671376777618898589872735865049081167099310535867780980030790491654063777173764198678527273474476341835600035698305193144284561701911000786737307333564123971732897913240474578834468260652327974647951137672658693582180046317922073668860052627186363386088796882120769432366149491002923444346373222145884100586421050242120365433561201320481118852408731077014151666200162313177169372189248078507711827842317498073276598828825169183103125680162072880719"; q = Z.of_string "78571733251071885079927659812671450121821421258408794611510081919805623223441"; embedding = None; } | "RFC-3526-2048" -> { g = Z.of_string "2"; p = Z.of_string "32317006071311007300338913926423828248817941241140239112842009751400741706634354222619689417363569347117901737909704191754605873209195028853758986185622153212175412514901774520270235796078236248884246189477587641105928646099411723245426622522193230540919037680524235519125679715870117001058055877651038861847280257976054903569732561526167081339361799541336476559160368317896729073178384589680639671900977202194168647225871031411336429319536193471636533209717077448227988588565369208645296636077250268955505928362751121174096972998068410554359584866583291642136218231078990999448652468262416972035911852507045361090559"; q = Z.of_string "16158503035655503650169456963211914124408970620570119556421004875700370853317177111309844708681784673558950868954852095877302936604597514426879493092811076606087706257450887260135117898039118124442123094738793820552964323049705861622713311261096615270459518840262117759562839857935058500529027938825519430923640128988027451784866280763083540669680899770668238279580184158948364536589192294840319835950488601097084323612935515705668214659768096735818266604858538724113994294282684604322648318038625134477752964181375560587048486499034205277179792433291645821068109115539495499724326234131208486017955926253522680545279"; embedding = Some { padding = 8; bits_per_int = 8 }; } | _ -> raise Not_found let ed25519 () : (module GROUP) = match libsodium_stubs () with | None -> (module Ed25519_pure) | Some stubs -> let module S = (val stubs) in let module G = Ed25519_libsodium.Make (S) in (module G) let of_string x = match get_ff_params x with | params -> let module G = (val Group_field.make x params : Group_field.GROUP) in (module G : GROUP) | exception Not_found -> ( match x with | "Ed25519" -> ed25519 () | _ -> Printf.ksprintf failwith "unknown group: %s" x) belenios-2.2-10-gbb6b7ea8/src/lib/v1/trustees.mli0000644000175000017500000000004514476041226020341 0ustar stephstephinclude Belenios_core.Trustees_sig.S belenios-2.2-10-gbb6b7ea8/src/lib/core/0002755000175000017500000000000014476041226016365 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/lib/core/common.mli0000644000175000017500000001006714476041226020362 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform open Platform open Signatures_core val ( let@ ) : ('a -> 'b) -> 'a -> 'b val ( let& ) : 'a option -> ('a -> 'b option) -> 'b option val ( // ) : string -> string -> string module Uuid = Common_types.Uuid module Hash = Common_types.Hash module Weight = Common_types.Weight module Question_signature = Common_types.Question_signature module Election_result = Common_types.Election_result module Question_result = Common_types.Question_result module Array = Common_types.Array module Shape = Common_types.Shape val sha256_b64 : string -> string module String : sig include module type of String val drop_prefix : prefix:string -> string -> string option end module List : sig include module type of List val join : 'a -> 'a list -> 'a list end module Option : sig include module type of Option val wrap : ('a -> 'b) -> 'a -> 'b option val unwrap : 'b -> 'a option -> ('a -> 'b) -> 'b end val sread : (string -> 'a) -> 'a reader val swrite : ('a -> string) -> 'a writer val save_to : string -> (Bi_outbuf.t -> 'a -> unit) -> 'a -> unit val compare_b64 : string -> string -> int module SSet : Set.S with type elt = string module SMap : Map.S with type key = string module IMap : Map.S with type key = int val bytes_to_sample : Z.t -> int val check_modulo : Z.t -> Z.t -> bool module MakeGenerateToken (R : RANDOM) : sig val generate_token : ?length:int -> unit -> string val generate_numeric : ?length:int -> unit -> string end val sqrt : Z.t -> Z.t module BabyStepGiantStep (G : GROUP) : sig val log : generator:G.t -> max:Z.t -> G.t -> Z.t option end val split_on_br : string -> string list val split_lines : string -> string list val strip_cred : string -> string val extract_weight : string -> string * Weight.t (** Input: [str = "something[,weight]"] Output: - if [weight] is an integer > 0, return [(something, weight)] - else, return [(str, 1)] *) val re_exec_opt : rex:Re.re -> string -> Re.Group.t option val is_username : string -> bool val is_email : string -> bool val extract_email : string -> string option val map_and_concat_with_commas : ('a -> string) -> 'a array -> string module Voter : sig type t = [ `Plain | `Json ] * Serializable_core_t.voter val wrap : Yojson.Safe.t -> t val unwrap : t -> Yojson.Safe.t val to_string : t -> string val of_string : string -> t val list_to_string : t list -> string val list_of_string : string -> t list val get : t -> string * string * Weight.t val validate : t -> bool end val has_explicit_weights : Voter.t list -> bool val supported_crypto_versions : int list belenios-2.2-10-gbb6b7ea8/src/lib/core/ed25519_libsodium.ml0000644000175000017500000001274614476041226021774 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2021-2023 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 Belenios_platform.Platform open Common (** Ed25519 implementation using libsodium *) module G = Ed25519_pure let l = G.q module Make (B : Belenios_platform.Signatures.LIBSODIUM_STUBS) = struct module E = struct open B let bytes = bytes () let scalarbytes = scalarbytes () let create_point () = Bytes.create bytes let compare_points = Bytes.compare let z255 = Z.of_int 255 let of_z_generic n z = let result = Bytes.create n in let rec loop i z = if i < n then ( Bytes.set result i Z.(logand z z255 |> to_int |> char_of_int); loop (i + 1) Z.(shift_right z 8)) else result in loop 0 z let scalar_of_number z = let z = Z.erem z l in of_z_generic scalarbytes z let number_of_scalar b = let rec loop i accu = if i >= 0 then loop (i - 1) Z.( logor (shift_left accu 8) (Bytes.get b i |> int_of_char |> of_int)) else accu in loop (Bytes.length b - 1) Z.zero let hex_size = 64 let () = assert (hex_size = 2 * bytes) let point_of_string s = assert (String.length s = hex_size); of_z_generic bytes (Z.of_hex s) let string_of_point p = let raw = number_of_scalar p in let r = Z.to_hex raw in let n = String.length r in assert (n <= hex_size); if n < hex_size then String.make (hex_size - n) '0' ^ r else r end type t = { mutable pure : G.t option; mutable nacl : B.point option } let get_as_pure p = match p.pure with | Some a -> a | None -> ( match p.nacl with | Some a -> let s = E.string_of_point a in let b = G.of_string s in p.pure <- Some b; b | None -> failwith "inconsistency in Ed25519_libsodium.get_as_pure") let make_from_pure p = { pure = Some p; nacl = None } let make_from_nacl p = { pure = None; nacl = Some p } let get_as_nacl p = match p.nacl with | Some a -> a | None -> ( match p.pure with | Some a -> let s = G.to_string a in let b = E.point_of_string s in p.nacl <- Some b; b | None -> failwith "inconsistency in Ed25519_libsodium.get_as_nacl") let check p = match (p.nacl, p.pure) with | Some a, _ -> B.is_valid_point a = 1 || G.check (get_as_pure p) | _, Some a -> G.check a | None, None -> failwith "inconsistency in Ed25519_libsodium.check" let one = make_from_pure G.one let g = make_from_pure G.g let ( *~ ) a b = let r = E.create_point () in if B.add r (get_as_nacl a) (get_as_nacl b) = 0 then make_from_nacl r else make_from_pure G.(get_as_pure a *~ get_as_pure b) let ( **~ ) p n = let r = E.create_point () in if B.scalarmult r (E.scalar_of_number n) (get_as_nacl p) = 0 then make_from_nacl r else make_from_pure G.(get_as_pure p **~ n) let compare a b = match (a.pure, b.pure, a.nacl, b.nacl) with | Some c, Some d, _, _ -> G.compare c d | _, _, Some c, Some d -> E.compare_points c d | _, _, Some c, _ -> E.compare_points c (get_as_nacl b) | _, _, _, Some d -> E.compare_points (get_as_nacl a) d | _, _, None, None -> G.compare (get_as_pure a) (get_as_pure b) let ( =~ ) a b = compare a b = 0 let invert p = make_from_pure G.(invert (get_as_pure p)) let to_string p = E.string_of_point (get_as_nacl p) let of_string s = make_from_nacl (E.point_of_string s) let to_ints n p = G.to_ints n (get_as_pure p) let of_ints xs = make_from_pure (G.of_ints xs) let get_generator i = make_from_pure (G.get_generator i) let hash prefix xs = let x = prefix ^ map_and_concat_with_commas to_string xs in let z = Z.of_hex (sha256_hex x) in Z.(z mod l) let hash_to_int p = G.hash_to_int (get_as_pure p) let description = "Ed25519" let q = l let selfcheck () = check one && check g && G.compare (get_as_pure g) G.g = 0 && (g **~ Z.(l - one)) *~ g =~ one && g *~ invert g =~ one end belenios-2.2-10-gbb6b7ea8/src/lib/core/util.mli0000644000175000017500000000343014476041226020043 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Signatures open Serializable_t val compute_synthetic_factors : 'a trustee_kind list -> ('a -> 'a partial_decryption -> bool) -> 'a partial_decryption owned list -> ((int * 'a partial_decryption) list -> 'a shape) -> ('a shape list, combination_error) result belenios-2.2-10-gbb6b7ea8/src/lib/core/group_field.ml0000644000175000017500000001054014476041226021214 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform.Platform open Serializable_j open Common (** Finite field arithmetic *) let check_params { p; q; g; embedding } = (match embedding with | None -> true | Some { padding; bits_per_int } -> padding > 0 && bits_per_int > 0 && bits_per_int < 32) && Z.probab_prime p 20 > 0 && Z.probab_prime q 20 > 0 && check_modulo p g && check_modulo p q && Z.(powm g q p =% one) module type GROUP = Signatures.GROUP with type t = Z.t let make description ff_params = let { p; q; g; embedding } = ff_params in let module G = struct open Z type t = Z.t let p = p let q = q let one = Z.one let g = g let ( *~ ) a b = a * b mod p let ( **~ ) a b = powm a b p let invert x = Z.invert x p let ( =~ ) = Z.( =% ) let check x = check_modulo p x && x **~ q =~ one let to_string = Z.to_string let of_string = Z.of_string let of_ints = match embedding with | None -> fun _ -> failwith "Group_field.of_bits: missing parameters" | Some { padding; bits_per_int } -> let mask_per_int = pred (1 lsl bits_per_int) in fun xs -> let n = Array.length xs in let rec encode_int i accu = if i < n then let x = xs.(i) land mask_per_int in encode_int (succ i) (Z.shift_left accu bits_per_int + of_int x) else Z.shift_left accu padding in let rec find_element accu = if check accu then accu else find_element (accu + one) in find_element (encode_int 0 zero) let to_ints = match embedding with | None -> fun _ -> failwith "Group_field.to_bits: missing parameters" | Some { padding; bits_per_int } -> let mask_per_int = shift_left one bits_per_int - one in fun n x -> let xs = Array.make n 0 in let rec decode_int i x = if i >= 0 then ( xs.(i) <- to_int (logand x mask_per_int); decode_int (pred i) (shift_right x bits_per_int)) in decode_int (pred n) (shift_right x padding); xs let hash prefix xs = let x = prefix ^ map_and_concat_with_commas Z.to_string xs in let z = Z.of_hex (sha256_hex x) in Z.(z mod q) let hash_to_int = Z.hash_to_int let compare = Z.compare let get_generator = let cofactor = Z.((p - one) / q) in fun i -> let s = Printf.sprintf "ggen|%d" i in let h = Z.of_hex (sha256_hex s) in let h = Z.powm h cofactor p in (* it is very unlikely (but theoretically possible) that one of the following assertions fails *) assert (Z.(compare h zero) <> 0); assert (Z.(compare h one) <> 0); assert (Z.(compare h g) <> 0); h let description = description end in (module G : GROUP) belenios-2.2-10-gbb6b7ea8/src/lib/core/stv.mli0000644000175000017500000000312514476041226017703 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_t val compute : nseats:int -> stv_raw_ballots -> stv_result belenios-2.2-10-gbb6b7ea8/src/lib/core/trustees_sig.mli0000644000175000017500000000642714476041226021617 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform.Platform open Serializable_t open Signatures module type S = sig (** Simple distributed generation of an election public key. *) 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 (** [generate ()] generates a new private key. *) val prove : Z.t -> G.t trustee_public_key (** [prove x] returns the public key associated to [x] and a zero- knowledge proof of its knowledge. *) end module MakePKI (G : GROUP) (M : RANDOM) : PKI with type private_key = Z.t and type public_key = G.t module MakeChannels (G : GROUP) (M : RANDOM) (P : PKI with type private_key = Z.t and type public_key = G.t) : CHANNELS with 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 private_key = Z.t and type public_key = G.t) (C : CHANNELS with type private_key = Z.t and type public_key = G.t) : PEDERSEN with type elt = G.t module MakeCombinator (G : GROUP) : sig val check : G.t trustees -> bool (** Check consistency of a set of trustees. *) val combine_keys : G.t trustees -> G.t (** Compute the public key associated to a set of trustees. *) val combine_factors : G.t trustees -> (G.t -> G.t partial_decryption -> bool) -> G.t partial_decryption owned list -> (G.t shape, combination_error) result (** Compute synthetic decryption factors. *) end end belenios-2.2-10-gbb6b7ea8/src/lib/core/dune0000644000175000017500000000226514476041226017246 0ustar stephsteph(library (name belenios_core) (public_name belenios-lib.core) (libraries base64 hex yojson atdgen re belenios_platform) (modules_without_implementation question_sigs signatures signatures_core trustees_sig versioned_sig)) (rule (targets serializable_core_t.ml serializable_core_t.mli) (deps serializable_core.atd) (action (run atdgen -t %{deps}))) (rule (targets question_h_t.ml question_h_t.mli) (deps question_h.atd) (action (run atdgen -t %{deps}))) (rule (targets question_nh_t.ml question_nh_t.mli) (deps question_nh.atd) (action (run atdgen -t %{deps}))) (rule (targets serializable_t.ml serializable_t.mli) (deps serializable.atd) (action (run atdgen -t %{deps}))) (rule (targets serializable_core_j.ml serializable_core_j.mli) (deps serializable_core.atd) (action (run atdgen -j -j-std %{deps}))) (rule (targets question_h_j.ml question_h_j.mli) (deps question_h.atd) (action (run atdgen -j -j-std %{deps}))) (rule (targets question_nh_j.ml question_nh_j.mli) (deps question_nh.atd) (action (run atdgen -j -j-std %{deps}))) (rule (targets serializable_j.ml serializable_j.mli) (deps serializable.atd) (action (run atdgen -j -j-std %{deps}))) belenios-2.2-10-gbb6b7ea8/src/lib/core/serializable.atd0000644000175000017500000002353314476041226021531 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** {2 Predefined types} *) type number = string wrap type weight = abstract wrap type uuid = string wrap type hash = string wrap type 'a shape = abstract type 'a ciphertext = abstract type proof = abstract type question = abstract wrap (** {2 Trustees} *) type 'a trustee_public_key = { pok : proof; public_key : 'a; ?name : string option; } (** {2 Finite fields} *) type ff_embedding = { padding : int; bits_per_int : int; } type ff_params = { g : number; p : number; q : number; ?embedding : ff_embedding option; } (** {2 Elections} *) type params = { version : int; description : string; name : string; questions : question list ; uuid : uuid; ?administrator : string option; ?credential_authority : string option; } type voter = abstract wrap type voter_list = voter list type public_credentials = string list type private_credentials = (string * string) list type template = { description : string; name : string; questions : question list ; ?administrator : string option; ?credential_authority : string option; } type 'a partial_decryption = { decryption_factors : 'a shape; decryption_proofs : proof shape; } type plaintext = int list list type 'a encrypted_tally = 'a ciphertext shape type 'a sized_encrypted_tally = { num_tallied : int; total_weight : weight; encrypted_tally : 'a; } (** {2 Mixnets} *) type 'a nh_ciphertexts = 'a ciphertext list list type 'a shuffle_proof = (('a * 'a * 'a * ('a * 'a) * 'a list ) * (number * number * number * number * number list * number list ) * 'a list * 'a list ) type 'a shuffle_proofs = 'a shuffle_proof list type 'a shuffle = { ciphertexts : 'a nh_ciphertexts; proofs : 'a shuffle_proofs; } (** {2 Election result} *) type 'result election_result = { result : 'result; } (** {2 Election report} *) type trustee_checksum = { checksum : hash; ?name : string option; } type trustee_threshold_checksum = { pki_key : hash; verification_key : hash; ?name : string option } type trustee_threshold_set = { trustees : trustee_threshold_checksum list; threshold : int; } type weight_checksums = { total : weight; min : weight; max : weight; } type election_checksums = { election : hash; trustees : trustee_checksum list; trustees_threshold : trustee_threshold_set list; num_voters : int; ?weights : weight_checksums option; public_credentials : hash; ?shuffles : trustee_checksum list option; ?encrypted_tally : hash option; } type ballot_summary_item = { hash : hash; ?weight : weight option; } type ballot_summary = ballot_summary_item list (** {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 ; } type 'a trustee_kind = [ Single of 'a trustee_public_key | Pedersen of 'a threshold_parameters ] type 'a trustees = 'a trustee_kind list (** {2 Condorcet} *) type condorcet_ballots = int list list type condorcet_matrix = int list list type condorcet_beatpaths = (int * int) list list type schulze_result = { valid : int; ?blank : int option; raw : condorcet_matrix; beatpaths : condorcet_beatpaths; winners : int list list; } (** {2 Majority judgment} *) type mj_ballots = int list list type mj_matrix = int list list type mj_result = { raw : mj_matrix; valid : int; ?blank : int option; invalid : mj_ballots; winners : int list list; } (** {2 Single Transferable Vote} *) type stv_raw_ballots = int list list type stv_processed_ballots = int list list type stv_event = [ Win of int list | Lose of int | TieWin of int list | TieLose of int list ] type stv_events = stv_event list type stv_result = { ballots : stv_processed_ballots; invalid : stv_raw_ballots; events : stv_events; winners : int list; } (** {2 Event-related types} *) type location = { offset : int ; length : int ; } type archive_header = { version : int; timestamp : abstract; } type event_type = [ Setup | Ballot | EndBallots | EncryptedTally | Shuffle | EndShuffles | PartialDecryption | Result ] type setup_data = { election : hash; trustees : hash; credentials : hash; } type event = { ?parent : hash option; height : int; typ : event_type; ?payload : hash option; } type last_event = { height : int; hash : hash; pos : int ; } type roots = { ?setup_data : hash option; ?last_ballot_event : hash option; ?encrypted_tally : hash option; ?last_shuffle_event : hash option; ?last_pd_event : hash option; ?result : hash option; } type 'a owned = { owner : int; payload : 'a; } (** {2 Sealing} *) type sealing_config = (string * string list) list type file_kind = [ REG | DIR | CHR | BLK | LNK | FIFO | SOCK ] type 'a file_contents = [ REG of hash | DIR of (string * 'a) list | LNK of string ] type stats = { ?dev : int option; ?ino : int option; ?kind : file_kind option; ?perm : int option; ?nlink : int option; ?uid : int option; ?gid : int option; ?rdev : int option; ?size : int option; ?atime : float option; ?mtime : float option; ?ctime : float option; ?contents : stats file_contents option; } belenios-2.2-10-gbb6b7ea8/src/lib/core/ed25519_pure.mli0000644000175000017500000000307514476041226021124 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2021-2023 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 *) (* . *) (**************************************************************************) include Signatures.GROUP val selfcheck : unit -> bool belenios-2.2-10-gbb6b7ea8/src/lib/core/question.ml0000644000175000017500000002126614476041226020573 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Signatures_core open Common type t = | Homomorphic of Question_h_t.question | NonHomomorphic of Question_nh_t.question * Yojson.Safe.t option let rec compute_signature qs = match qs with | [] -> let module X = struct type t = unit let x = Question_signature.Nil end in (module X : QUESTION_SIGNATURE_PACK) | Homomorphic _ :: qs -> let module X = (val compute_signature qs) in let module Y = struct type t = [ `Homomorphic ] * X.t let x = Question_signature.Homomorphic X.x end in (module Y) | NonHomomorphic (q, _) :: qs -> let module X = (val compute_signature qs) in let module Y = struct type t = [ `NonHomomorphic ] * X.t let x = Question_signature.NonHomomorphic (Array.length q.Question_nh_t.q_answers, X.x) end in (module Y) let wrap x = match x with | `Assoc o -> ( match List.assoc_opt "type" o with | None -> Homomorphic (Question_h_j.question_of_string (Yojson.Safe.to_string x)) | Some (`String "NonHomomorphic") -> ( match List.assoc_opt "value" o with | None -> failwith "Question.wrap: value is missing" | Some v -> NonHomomorphic ( Question_nh_j.question_of_string (Yojson.Safe.to_string v), List.assoc_opt "extra" o )) | Some _ -> failwith "Question.wrap: unexpected type") | _ -> failwith "Question.wrap: unexpected JSON value" let unwrap = function | Homomorphic q -> Yojson.Safe.from_string (Question_h_j.string_of_question q) | NonHomomorphic (q, extra) -> let o = match extra with None -> [] | Some x -> [ ("extra", x) ] in let o = ("type", `String "NonHomomorphic") :: ( "value", Yojson.Safe.from_string (Question_nh_j.string_of_question q) ) :: o in `Assoc o type counting_method = [ `None | `MajorityJudgment of Question_nh_t.mj_extra | `Schulze of Question_nh_t.schulze_extra | `STV of Question_nh_t.stv_extra ] let get_counting_method extra = let open Question_nh_j in match extra with | Some (`Assoc o as extra) -> ( match List.assoc_opt "method" o with | Some (`String "MajorityJudgment") -> ( match extra |> Yojson.Safe.to_string |> mj_extra_of_string with | x -> `MajorityJudgment x | exception _ -> `None) | Some (`String "Schulze") -> ( match extra |> Yojson.Safe.to_string |> schulze_extra_of_string with | x -> `Schulze x | exception _ -> `None) | Some (`String "STV") -> ( match extra |> Yojson.Safe.to_string |> stv_extra_of_string with | x -> `STV x | exception _ -> `None) | _ -> `None) | _ -> `None let erase_question = function | Homomorphic q -> let open Question_h_t in Homomorphic { q_answers = Array.map (fun _ -> "") q.q_answers; q_blank = q.q_blank; q_min = q.q_min; q_max = q.q_max; q_question = ""; } | NonHomomorphic (q, extra) -> let open Question_nh_t in NonHomomorphic ( { q_answers = Array.map (fun _ -> "") q.q_answers; q_question = "" }, extra ) module Make (M : RANDOM) (G : GROUP) (QHomomorphic : Question_sigs.QUESTION_H with type elt := G.t and type question := Question_h_t.question and type answer := G.t Question_h_t.answer) (QNonHomomorphic : Question_sigs.QUESTION_NH with type elt := G.t and type question := Question_nh_t.question and type answer := G.t Question_nh_t.answer) = struct let create_answer q ~public_key ~prefix m = match q with | Homomorphic q -> let answer = QHomomorphic.create_answer q ~public_key ~prefix m in answer |> Question_h_j.string_of_answer (swrite G.to_string) |> Yojson.Safe.from_string | NonHomomorphic (q, _) -> let answer = QNonHomomorphic.create_answer q ~public_key ~prefix m in answer |> Question_nh_j.string_of_answer (swrite G.to_string) |> Yojson.Safe.from_string let verify_answer q ~public_key ~prefix a = match q with | Homomorphic q -> a |> Yojson.Safe.to_string |> Question_h_j.answer_of_string (sread G.of_string) |> QHomomorphic.verify_answer q ~public_key ~prefix | NonHomomorphic (q, _) -> a |> Yojson.Safe.to_string |> Question_nh_j.answer_of_string (sread G.of_string) |> QNonHomomorphic.verify_answer q ~public_key ~prefix let extract_ciphertexts q a = match q with | Homomorphic q -> a |> Yojson.Safe.to_string |> Question_h_j.answer_of_string (sread G.of_string) |> QHomomorphic.extract_ciphertexts q | NonHomomorphic (q, _) -> a |> Yojson.Safe.to_string |> Question_nh_j.answer_of_string (sread G.of_string) |> QNonHomomorphic.extract_ciphertexts q let process_ciphertexts q e = match q with | Homomorphic q -> QHomomorphic.process_ciphertexts q e | NonHomomorphic (q, _) -> QNonHomomorphic.process_ciphertexts q e let compute_result ~num_tallied qs x = match x with | `Atomic _ -> invalid_arg "compute_result: invalid result" | `Array xs -> let compute_h = lazy (QHomomorphic.compute_result ~num_tallied) in let rec loop : 'a. 'a Question_signature.t -> G.t Shape.t list -> 'a Election_result.t = fun (type a) (qs : a Question_signature.t) xs -> let r : a Election_result.t = match (qs, xs) with | Nil, [] -> Nil | Nil, _ -> invalid_arg "compute_result: list too long" | _, [] -> invalid_arg "compute_result: list too short" | Homomorphic qs, x :: xs -> Homomorphic (Lazy.force compute_h x, loop qs xs) | NonHomomorphic (num_answers, qs), x :: xs -> NonHomomorphic (QNonHomomorphic.compute_result ~num_answers x, loop qs xs) in r in loop qs (Array.to_list xs) let check_result ~num_tallied qs x rs = match x with | `Atomic _ -> invalid_arg "check_result: invalid result" | `Array xs -> let rec loop : 'a. 'a Question_signature.t -> G.t Shape.t list -> 'a Election_result.t -> bool = fun (type a) (qs : a Question_signature.t) xs (rs : a Election_result.t) -> match (qs, xs, rs) with | Nil, [], Nil -> true | Nil, _, Nil -> invalid_arg "check_result: list too long" | _, [], _ -> invalid_arg "check_result: list too short" | Homomorphic qs, x :: xs, Homomorphic (r, rs) -> QHomomorphic.check_result ~num_tallied x r && loop qs xs rs | NonHomomorphic (num_answers, qs), x :: xs, NonHomomorphic (r, rs) -> QNonHomomorphic.check_result ~num_answers x r && loop qs xs rs in loop qs (Array.to_list xs) rs end belenios-2.2-10-gbb6b7ea8/src/lib/core/signatures.mli0000644000175000017500000001730314476041226021256 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** Signatures *) open Belenios_platform open Platform open Serializable_t open Common include module type of Signatures_core module type ELECTION_BASE = sig module G : GROUP val election : params val fingerprint : string val public_key : G.t module S : QUESTION_SIGNATURE_PACK type ballot val string_of_ballot : ballot -> string val ballot_of_string : string -> ballot val get_credential : ballot -> G.t option end module type ELECTION_RESULT = sig type question_signature type result = question_signature Election_result.t val write_result : result writer val read_result : result reader end module type MAKE_RESULT = functor (X : ELECTION_BASE) -> ELECTION_RESULT with type question_signature := X.S.t module type ELECTION_DATA = sig include ELECTION_BASE include ELECTION_RESULT with type question_signature := S.t end type combination_error = | MissingPartialDecryption | NotEnoughPartialDecryptions | InvalidPartialDecryption module type RAW_ELECTION = sig val raw_election : string end type cast_error = [ `SerializationError of exn | `NonCanonical | `InvalidBallot | `InvalidCredential | `WrongCredential | `WrongWeight | `UsedCredential | `RevoteNotAllowed | `DuplicateBallot | `ExpiredBallot | `WrongUsername ] type rawballot_check = { rc_credential : string; rc_check : unit -> bool } (** Cryptographic primitives for an election with homomorphic tally. *) module type ELECTION_OPS = sig (** {2 Election parameters} *) (** Ballots are encrypted using public-key cryptography secured by the discrete logarithm problem. Here, we suppose private keys are integers modulo a large prime number. Public keys are members of a suitably chosen group. *) type elt type private_key = Z.t type public_key = elt (** {2 Ballots} *) type plaintext = Serializable_t.plaintext (** The plaintext equivalent of [ciphertext], i.e. the contents of a ballot. When [x] is such a value, [x.(i).(j)] is the weight (0 or 1) given to answer [j] in question [i]. *) type ballot (** A ballot ready to be transmitted, containing the encrypted answers and cryptographic proofs that they satisfy the election constraints. *) type weighted_ballot = Weight.t * ballot val create_ballot : sk:private_key -> plaintext -> ballot (** [create_ballot r answers] creates a ballot, or raises [Invalid_argument] if [answers] doesn't satisfy the election constraints. *) 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. *) val check_rawballot : string -> (rawballot_check, cast_error) Stdlib.result (** {2 Tally} *) val process_ballots : weighted_ballot list -> elt encrypted_tally val extract_nh_ciphertexts : elt encrypted_tally -> elt nh_ciphertexts val merge_nh_ciphertexts : elt nh_ciphertexts -> elt encrypted_tally -> elt encrypted_tally val shuffle_ciphertexts : elt nh_ciphertexts -> elt shuffle val check_shuffle : elt nh_ciphertexts -> elt shuffle -> bool (** {2 Partial decryptions} *) type factor = elt partial_decryption (** A decryption share. It is computed by a trustee from his or her private key share and the encrypted tally, and contains a cryptographic proof that he or she didn't cheat. *) val compute_factor : elt Serializable_t.ciphertext shape -> private_key -> factor val check_factor : elt Serializable_t.ciphertext shape -> public_key -> factor -> bool (** [check_factor c pk f] checks that [f], supposedly submitted by a trustee whose public_key is [pk], is valid with respect to the encrypted tally [c]. *) (** {2 Result} *) type result_type type result = result_type Serializable_t.election_result (** The election result. It contains the needed data to validate the result from the encrypted tally. *) val compute_result : elt encrypted_tally sized_encrypted_tally -> factor owned list -> elt trustees -> (result, combination_error) Stdlib.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 : elt encrypted_tally sized_encrypted_tally -> factor owned list -> elt trustees -> result -> bool end module type ELECTION = sig include ELECTION_DATA module E : ELECTION_OPS with type elt = G.t and type ballot = ballot and type result_type = result end module type PKI = sig type private_key type public_key val genkey : unit -> string val derive_sk : string -> private_key val derive_dk : string -> private_key val sign : private_key -> string -> signed_msg val verify : public_key -> signed_msg -> bool val encrypt : public_key -> string -> public_key encrypted_msg val decrypt : private_key -> public_key encrypted_msg -> string val make_cert : sk:private_key -> dk:private_key -> cert val verify_cert : cert -> bool end module type CHANNELS = sig type private_key type public_key val send : private_key -> public_key -> string -> public_key encrypted_msg val recv : private_key -> public_key -> public_key encrypted_msg -> string end module type PEDERSEN = sig type elt val step1 : unit -> string * cert val step1_check : cert -> bool val step2 : certs -> unit val step3 : certs -> string -> int -> polynomial val step3_check : certs -> int -> polynomial -> bool val step4 : certs -> polynomial array -> vinput array val step5 : certs -> string -> vinput -> elt voutput val step5_check : certs -> int -> polynomial array -> elt voutput -> bool val step6 : certs -> polynomial array -> elt voutput array -> elt threshold_parameters end module type MIXNET = sig type elt type 'a proof val gen_shuffle : elt -> elt ciphertext array -> elt ciphertext array * number array * int array val gen_shuffle_proof : elt -> elt ciphertext array -> elt ciphertext array -> number array -> int array -> elt proof val check_shuffle_proof : elt -> elt ciphertext array -> elt ciphertext array -> elt proof -> bool end belenios-2.2-10-gbb6b7ea8/src/lib/core/common_types.ml0000644000175000017500000002453114476041226021436 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform.Platform module Number = struct type t = Z.t let wrap = Z.of_string let unwrap = Z.to_string end module Uuid = struct type t = string let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" let min_length = 14 (* at least 82 bits of entropy *) let check token = let n = String.length token in n >= min_length && let rec loop i = if i >= 0 then match String.index_opt digits token.[i] with | Some _ -> loop (i - 1) | None -> false else true in loop (n - 1) let wrap x = if check x then x else Printf.ksprintf invalid_arg "%S is not a valid UUID" x let unwrap x = x let dummy = wrap (String.make min_length '1') end module Hash = struct type t = string let check x = String.length x = 64 && String.for_all (function '0' .. '9' | 'a' .. 'f' -> true | _ -> false) x let of_hex x = if check x then x else Printf.ksprintf invalid_arg "%S is not a valid hex-encoded hash" x let to_hex x = x let of_b64 x = match Base64.decode ~pad:true (x ^ "=") with | Ok x when String.length x = 32 -> let (`Hex x) = Hex.of_string x in x | _ -> Printf.ksprintf invalid_arg "%S is not a valid b64-encoded hash" x let to_b64 x = match Base64.encode ~pad:false (Hex.to_string (`Hex x)) with | Ok x -> x | _ -> assert false let hash_string = sha256_hex let wrap = of_hex let unwrap = to_hex end let weight_of_raw_string x = try let x = Z.of_string x in if Z.(compare x zero >= 0) then x else raise Exit with _ -> Printf.ksprintf invalid_arg "%S is not a valid weight" x let weight_of_int x = if x >= 0 then Z.of_int x else Printf.ksprintf invalid_arg "%d is not a valid weight" x let weight_of_json = function | `Int x -> weight_of_int x | `Intlit x | `String x -> weight_of_raw_string x | _ -> invalid_arg "invalid weight" let max_int31 = Z.of_string "1073741823" let json_of_weight x = if Z.(compare x max_int31 <= 0) then `Int (Z.to_int x) else `String (Z.to_string x) module Weight = struct include Z let max_expanded_weight = of_string "100000000000" let is_int x i = Z.(compare x (of_int i) = 0) let of_string x = weight_of_json (`String x) let expand ~total:_ x = x let reduce ~total:_ x = x let min a b = if compare a b < 0 then a else b let max a b = if compare a b > 0 then a else b let wrap = weight_of_json let unwrap = json_of_weight end module Question_signature = struct type _ t = | Nil : unit t | Homomorphic : 'a t -> ([ `Homomorphic ] * 'a) t | NonHomomorphic : int * 'a t -> ([ `NonHomomorphic ] * 'a) t end module Question_result = struct type t = [ `Homomorphic of Weight.t array | `NonHomomorphic of int array array ] end module Election_result = struct type _ t = | Nil : unit t | Homomorphic : Weight.t array * 'a t -> ([ `Homomorphic ] * 'a) t | NonHomomorphic : int array array * 'a t -> ([ `NonHomomorphic ] * 'a) t let wrap_homomorphic = function | `List xs -> xs |> List.map Weight.wrap |> Array.of_list | _ -> failwith "list expected in Election_result.wrap_homomorphic" let wrap_nonhomomorphic = function | `List xs -> xs |> List.map (function | `List xs -> xs |> List.map (function | `Int i -> i | _ -> failwith "int expected in \ Election_result.wrap_nonhomomorphic") |> Array.of_list | _ -> failwith "(inner) list expected in \ Election_result.wrap_nonhomomorphic") |> Array.of_list | _ -> failwith "(outer) list expected in Election_result.wrap_nonhomomorphic" let wrap s x = let x = match x with | `List x -> x | _ -> failwith "list expected in Election_result.wrap" in let rec loop : 'a. 'a Question_signature.t -> Yojson.Safe.t list -> 'a t = fun (type a) (s : a Question_signature.t) x -> let r : a t = match (s, x) with | Nil, [] -> Nil | Nil, _ -> failwith "list too long in Election_result.wrap" | Homomorphic s, x :: xs -> Homomorphic (wrap_homomorphic x, loop s xs) | NonHomomorphic (_, s), x :: xs -> NonHomomorphic (wrap_nonhomomorphic x, loop s xs) | _, [] -> failwith "list too short in Election_result.wrap" in r in loop s x let unwrap_homomorphic xs = xs |> Array.map Weight.unwrap |> fun x -> `List (Array.to_list x) let unwrap_nonhomomorphic xs = xs |> Array.map (fun ys -> ys |> Array.map (fun i -> `Int i) |> fun y -> `List (Array.to_list y)) |> fun x -> `List (Array.to_list x) let unwrap x = let rec loop : 'a. 'a t -> Yojson.Safe.t list = fun (type a) (x : a t) -> match x with | Nil -> [] | Homomorphic (x, xs) -> unwrap_homomorphic x :: loop xs | NonHomomorphic (x, xs) -> unwrap_nonhomomorphic x :: loop xs in `List (loop x) let nth x i = if i < 0 then invalid_arg "Election_result.nth: negative index" else let rec loop : 'a. int -> 'a t -> Question_result.t = fun (type a) i (xs : a t) -> match (i, xs) with | _, Nil -> invalid_arg "Election_result.nth: out of bounds" | 0, Homomorphic (x, _) -> `Homomorphic x | 0, NonHomomorphic (x, _) -> `NonHomomorphic x | i, Homomorphic (_, xs) -> loop (i - 1) xs | i, NonHomomorphic (_, xs) -> loop (i - 1) xs in loop i x let map2 (type c) f xs ys = let n = Array.length ys in let fail () = invalid_arg "Election_result.map2" in let rec loop : 'a. int -> 'a t -> c list -> c list = fun (type a) i (xs : a t) accu -> match xs with | Nil -> if i = n then List.rev accu else fail () | Homomorphic (x, xs) -> if i < n then let accu = f i (`Homomorphic x) ys.(i) :: accu in loop (i + 1) xs accu else fail () | NonHomomorphic (x, xs) -> if i < n then let accu = f i (`NonHomomorphic x) ys.(i) :: accu in loop (i + 1) xs accu else fail () in loop 0 xs [] end module Array = struct include Stdlib.Array let for_all3 f a b c = let n = Array.length a in n = Array.length b && n = Array.length c && let rec check i = if i >= 0 then f a.(i) b.(i) c.(i) && check (pred i) else true in check (pred n) let map3 f a b c = Array.mapi (fun i ai -> f ai b.(i) c.(i)) 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 Shape = struct type 'a t = [ `Atomic of 'a | `Array of 'a t array ] let of_array x = `Array (Array.map (fun x -> `Atomic x) x) let to_array = function | `Atomic _ -> invalid_arg "Shape.to_array" | `Array xs -> Array.map (function `Atomic x -> x | `Array _ -> invalid_arg "Shape.to_array") xs let to_shape_array = function | `Atomic _ -> invalid_arg "Shape.to_shape_array" | `Array xs -> xs let rec map f = function | `Atomic x -> `Atomic (f x) | `Array x -> `Array (Array.map (map f) x) let rec map2 f a b = match (a, b) with | `Atomic x, `Atomic y -> `Atomic (f x y) | `Array x, `Array y -> `Array (Array.map2 (map2 f) x y) | _, _ -> invalid_arg "Shape.map2" let rec flatten = function | `Atomic x -> [ x ] | `Array xs -> Array.map flatten xs |> Array.to_list |> List.flatten let split x = (map fst x, map snd x) let rec forall p = function | `Atomic x -> p x | `Array x -> Array.for_all (forall p) x let rec forall2 p x y = match (x, y) with | `Atomic x, `Atomic y -> p x y | `Array x, `Array y -> Array.for_all2 (forall2 p) x y | _, _ -> invalid_arg "Shape.forall2" let rec forall3 p x y z = match (x, y, z) with | `Atomic x, `Atomic y, `Atomic z -> p x y z | `Array x, `Array y, `Array z -> Array.for_all3 (forall3 p) x y z | _, _, _ -> invalid_arg "Shape.forall3" end module Atd_shape_t = struct type 'a shape = 'a Shape.t end module Atd_shape_j = struct let rec write_shape write buf = function | `Atomic x -> write buf x | `Array xs -> Atdgen_runtime.Oj_run.write_array (write_shape write) buf xs let rec read_shape read state buf = Yojson.Safe.read_space state buf; let open Lexing in if buf.lex_curr_pos >= buf.lex_buffer_len then buf.refill_buff buf; if buf.lex_curr_pos >= buf.lex_buffer_len then Yojson.json_error "Unexpected end of input"; if Bytes.get buf.lex_buffer buf.lex_curr_pos = '[' then `Array (Yojson.Safe.read_array (read_shape read) state buf) else `Atomic (read state buf) end belenios-2.2-10-gbb6b7ea8/src/lib/core/question_nh.atd0000644000175000017500000000443514476041226021417 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** {2 Predefined types} *) type 'a ciphertext = abstract type proof = abstract (** {2 Questions and answers} *) type question = { answers : string list ; question : string; } type 'a answer = { choices : 'a ciphertext; proof : proof; } (** {2 Counting methods} *) type mj_extra = { blank : bool; grades : string list ; } type schulze_extra = { blank : bool; } type stv_extra = { blank : bool; seats : int; } belenios-2.2-10-gbb6b7ea8/src/lib/core/archive.mli0000644000175000017500000000600514476041226020510 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_t open Signatures type data_or_event = Data | Event of event type record = { typ : data_or_event; hash : hash; location : location } val block_size : int val new_header : unit -> archive_header val get_timestamp : archive_header -> int64 module type IO_READER = sig include MONAD type file val get_pos : file -> int64 t val set_pos : file -> int64 -> unit t val read_block : file -> bytes -> unit t end module type ARCHIVE_READER = sig type 'a m type archive val read_header : archive -> archive_header m val read_record : archive -> record m end module MakeReader (M : IO_READER) : ARCHIVE_READER with type 'a m := 'a M.t and type archive = M.file module type IO_WRITER = sig include MONAD type file val get_pos : file -> int64 t val write_block : file -> bytes -> unit t end module type ARCHIVE_WRITER = sig type 'a m type archive val write_header : archive -> archive_header -> unit m val write_record : archive -> timestamp:int64 -> data_or_event -> string -> record m end module MakeWriter (M : IO_WRITER) : ARCHIVE_WRITER with type 'a m := 'a M.t and type archive = M.file module type IO_ARCHIVER = sig include MONAD val get_hash : hash -> string option t end module type ARCHIVER = sig type 'a m type archive val write_archive : archive -> archive_header -> event -> unit m end module MakeArchiver (M : IO_ARCHIVER) (W : ARCHIVE_WRITER with type 'a m := 'a M.t) : ARCHIVER with type 'a m := 'a M.t and type archive := W.archive belenios-2.2-10-gbb6b7ea8/src/lib/core/question_sigs.mli0000644000175000017500000000534614476041226021772 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Common open Serializable_core_t module type QUESTION_CORE = sig type question type answer type elt val create_answer : question -> public_key:elt -> prefix:string -> int array -> answer val verify_answer : question -> public_key:elt -> prefix:string -> answer -> bool val extract_ciphertexts : question -> answer -> elt ciphertext Shape.t val process_ciphertexts : question -> (Weight.t * elt ciphertext Shape.t) list -> elt ciphertext Shape.t end module type QUESTION_H = sig include QUESTION_CORE val compute_result : num_tallied:Weight.t -> elt Shape.t -> Weight.t array val check_result : num_tallied:Weight.t -> elt Shape.t -> Weight.t array -> bool end module type QUESTION_NH = sig include QUESTION_CORE val compute_result : num_answers:int -> elt Shape.t -> int array array val check_result : num_answers:int -> elt Shape.t -> int array array -> bool end module type QUESTION = sig include QUESTION_CORE val compute_result : num_tallied:Weight.t -> 'a Question_signature.t -> elt Shape.t -> 'a Election_result.t val check_result : num_tallied:Weight.t -> 'a Question_signature.t -> elt Shape.t -> 'a Election_result.t -> bool end belenios-2.2-10-gbb6b7ea8/src/lib/core/ed25519_pure.ml0000644000175000017500000001772614476041226020763 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2021-2023 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 Belenios_platform.Platform open Common (** Pure OCaml implementation of Ed25519 group *) (* https://en.wikipedia.org/wiki/EdDSA *) let q = Z.(shift_left one 255 - of_int 19) let l = Z.(shift_left one 252 + of_string "27742317777372353535851937790883648493") module F = struct let zero = Z.zero let one = Z.one let of_int = Z.of_int let compare = Z.compare let reduce x = Z.erem x q let double a = reduce Z.(shift_left a 1) let ( + ) a b = reduce Z.(a + b) let ( * ) a b = reduce Z.(a * b) let ( - ) a b = reduce Z.(a - b) let invert a = Z.invert a q end let a = F.(zero - one) let d = F.(zero - (of_int 121665 * invert (of_int 121666))) (* https://hyperelliptic.org/EFD/g1p/auto-twisted-extended-1.html *) type t = Z.t * Z.t * Z.t * Z.t let of_coordinates (x, y) = (x, y, Z.one, F.(x * y)) let to_coordinates (x, y, z, _) = let open F in let invz = invert z in (x * invz, y * invz) let curve x y z t = let open F in let x2 = x * x and y2 = y * y and z2 = z * z and t2 = t * t in (a * x2) + y2 - z2 - (d * t2) let one = of_coordinates F.(zero, one) let g = of_coordinates ( Z.of_string "15112221349535400772501151409588531511454012693041857206046113283949847762202", Z.of_string "46316835694926478169428394003475163141307993866256225615783033603165251855960" ) (* https://hyperelliptic.org/EFD/g1p/auto-twisted.html *) let k = F.double d let ( *~ ) (x1, y1, z1, t1) (x2, y2, z2, t2) = let open F in let a = (y1 - x1) * (y2 - x2) in let b = (y1 + x1) * (y2 + x2) in let c = t1 * k * t2 in let d = z1 * double z2 in let e = b - a in let f = d - c in let g = d + c in let h = b + a in let x3 = e * f in let y3 = g * h in let t3 = e * h in let z3 = f * g in (x3, y3, z3, t3) let windowsize = 4 let windowmask = (1 lsl windowsize) - 1 let windowmaskZ = Z.of_int windowmask let windowiterations = int_of_float (ceil (255. /. float_of_int windowsize)) let ( **~ ) p n = let t = Array.make (windowmask + 1) one in t.(1) <- p; let rec init i = if i < windowmask then ( let z = t.(i / 2) in let s = z *~ z in t.(i) <- s; t.(i + 1) <- s *~ p; init (i + 2)) else () in init 2; let rec loop i s = if i >= 0 then let k = i * windowsize in let j = Z.(logand (shift_right n k) windowmaskZ |> to_int) in let s = s *~ t.(j) in let s = if i <> 0 then let rec loop i s = if i > 0 then loop (i - 1) (s *~ s) else s in loop windowsize s else s in loop (i - 1) s else s in loop (windowiterations - 1) one let compare (x1, y1, z1, _) (x2, y2, z2, _) = let a = F.(compare (x1 * z2) (x2 * z1)) in if a = 0 then F.(compare (y1 * z2) (y2 * z1)) else a let ( =~ ) p1 p2 = compare p1 p2 = 0 let check ((x, y, z, t) as p) = Z.(compare z zero > 0) && check_modulo q x && check_modulo q y && check_modulo q z && check_modulo q t && F.(compare (x * y) (z * t) = 0) && F.(compare (curve x y z t) zero = 0) && p **~ l =~ one let is_even x = Z.(compare (logand x one) zero = 0) let is_base_point = let four_fifth = F.(of_int 4 * invert (of_int 5)) in fun p -> check p && let x, y = to_coordinates p in Z.compare four_fifth y = 0 && is_even x let invert (x, y, z, t) = F.(zero - x, y, z, zero - t) let compress (x, y) = let open Z in let b = shift_left (logand x one) 255 in logxor y b let mask255 = Z.(shift_left one 255 - one) let modsqrt_check, modsqrt = (* https://www.rieselprime.de/ziki/Modular_square_root *) let open Z in let five = of_int 5 and eight = of_int 8 in let exp = (q - five) / eight in ( (fun () -> Z.(compare (q mod eight) five = 0)), fun a -> let v = powm (shift_left a 1) exp q in let i = erem (shift_left (a * v * v) 1) q in erem (a * v * (i - one)) q ) let uncompress raw = let open Z in let y = logand raw mask255 in let y2 = erem (y * y) q in let x2 = erem ((y2 - one) * invert ((d * y2) + one) q) q in let x = modsqrt x2 in if compare (erem (x * x) q) x2 = 0 then let xsign = logand x one in let rsign = shift_right raw 255 in let x = if compare xsign rsign = 0 then x else erem (zero - x) q in Some (x, y) else None let hex_size = 64 let to_string p = let r = Z.to_hex (compress (to_coordinates p)) in let n = String.length r in assert (n <= hex_size); if n < hex_size then String.make (hex_size - n) '0' ^ r else r let of_string s = assert (String.length s = hex_size); match uncompress (Z.of_hex s) with | Some p -> of_coordinates p | None -> invalid_arg "Ed25519_pure.of_string" let padding = 14 let bits_per_int = 8 let of_ints = let mask_per_int = pred (1 lsl bits_per_int) in fun xs -> (* Koblitz method *) let open Z in let n = Array.length xs in let rec encode_int i accu = if i < n then let x = xs.(i) land mask_per_int in encode_int (succ i) (shift_left accu bits_per_int + of_int x) else shift_left accu padding in let rec find_element accu = match uncompress accu with | None -> find_element Z.(accu + one) | Some p -> let p = of_coordinates p in if check p then p else find_element Z.(accu + one) in find_element (encode_int 0 Z.zero) let to_ints = let open Z in let mask_per_int = shift_left one bits_per_int - one in fun n p -> let x = compress (to_coordinates p) in let xs = Array.make n 0 in let rec decode_int i x = if i >= 0 then ( xs.(i) <- to_int (logand x mask_per_int); decode_int (pred i) (shift_right x bits_per_int)) in decode_int (pred n) (shift_right x padding); xs let hash prefix xs = let x = prefix ^ map_and_concat_with_commas to_string xs in let z = Z.of_hex (sha256_hex x) in Z.(z mod l) let hash_to_int p = let x, y = to_coordinates p in Z.(hash_to_int (shift_left x 256 + y)) let description = "Ed25519" let q = l let cofactor = Z.of_int 8 let get_generator i = let s = Printf.sprintf "ggen|%d" i in let base = Z.(shift_right (of_hex (sha256_hex s)) 2) in let rec find_element accu = match uncompress accu with | None -> find_element Z.(accu + one) | Some p -> let p = of_coordinates p in p **~ cofactor in let h = find_element base in (* it is very unlikely (but theoretically possible) that one of the following assertions fails *) assert (compare h one <> 0); assert (compare h g <> 0); h let selfcheck () = check one && is_base_point g && g **~ q =~ one && modsqrt_check () belenios-2.2-10-gbb6b7ea8/src/lib/core/schulze.mli0000644000175000017500000000316514476041226020550 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_t val compute : nchoices:int -> blank_allowed:bool -> condorcet_ballots -> schulze_result belenios-2.2-10-gbb6b7ea8/src/lib/core/question.mli0000644000175000017500000000520414476041226020736 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Signatures_core type t = | Homomorphic of Question_h_t.question | NonHomomorphic of Question_nh_t.question * Yojson.Safe.t option val compute_signature : t list -> (module QUESTION_SIGNATURE_PACK) val wrap : Yojson.Safe.t -> t val unwrap : t -> Yojson.Safe.t type counting_method = [ `None | `MajorityJudgment of Question_nh_t.mj_extra | `Schulze of Question_nh_t.schulze_extra | `STV of Question_nh_t.stv_extra ] val get_counting_method : Yojson.Safe.t option -> counting_method val erase_question : t -> t module Make (M : RANDOM) (G : GROUP) (QHomomorphic : Question_sigs.QUESTION_H with type elt := G.t and type question := Question_h_t.question and type answer := G.t Question_h_t.answer) (QNonHomomorphic : Question_sigs.QUESTION_NH with type elt := G.t and type question := Question_nh_t.question and type answer := G.t Question_nh_t.answer) : Question_sigs.QUESTION with type elt := G.t and type question := t and type answer := Yojson.Safe.t belenios-2.2-10-gbb6b7ea8/src/lib/core/ed25519_libsodium.mli0000644000175000017500000000321214476041226022131 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2021-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module Make (B : Belenios_platform.Signatures.LIBSODIUM_STUBS) : sig include Signatures.GROUP val selfcheck : unit -> bool end belenios-2.2-10-gbb6b7ea8/src/lib/core/majority_judgment.mli0000644000175000017500000000317014476041226022622 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_t val compute : ngrades:int -> nchoices:int -> blank_allowed:bool -> mj_ballots -> mj_result belenios-2.2-10-gbb6b7ea8/src/lib/core/credential.mli0000644000175000017500000000366114476041226021206 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform.Platform open Signatures open Common module MakeGenerate (M : RANDOM) : sig val generate : unit -> string end val parse : string -> [ `Valid | `Invalid | `MaybePassword ] val check : string -> bool module MakeDerive (G : GROUP) : sig val derive : Uuid.t -> string -> Z.t end module MakeParsePublicCredential (G : GROUP) : sig val parse_public_credential : string -> (Weight.t * G.t) option end belenios-2.2-10-gbb6b7ea8/src/lib/core/credential.ml0000644000175000017500000001041214476041226021025 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform.Platform open Signatures open Common let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" let token_length = 14 let n58 = Z.of_int 58 let n53 = Z.of_int 53 let format x = assert (token_length = 14); assert (String.length x = 15); String.sub x 0 3 ^ "-" ^ String.sub x 3 3 ^ "-" ^ String.sub x 6 3 ^ "-" ^ String.sub x 9 3 ^ "-" ^ String.sub x 12 3 module MakeGenerate (M : RANDOM) = struct let get_random_digit () = let x = M.random n58 in Z.to_int x let generate_raw_token () = let res = Bytes.create token_length in let rec loop i accu = if i < token_length then ( let digit = get_random_digit () in Bytes.set res i digits.[digit]; loop (i + 1) Z.((n58 * accu) + of_int digit)) else (Bytes.to_string res, accu) in loop 0 Z.zero let add_checksum (raw, value) = let checksum = 53 - Z.(to_int (value mod n53)) in raw ^ String.make 1 digits.[checksum] let generate () = let x = generate_raw_token () in format (add_checksum x) end let check_raw x = let rec loop i accu = if i < token_length then let& digit = String.index_opt digits x.[i] in loop (i + 1) Z.((n58 * accu) + of_int digit) else Some accu in match (loop 0 Z.zero, String.index_opt digits x.[token_length]) with | Some n, Some checksum -> Z.((n + of_int checksum) mod n53 =% zero) | _, _ -> false let parse x = let n = String.length x in if n = token_length + 1 then if check_raw x then `Valid else `Invalid else if n = token_length + 5 then ( assert (n = 19); if x.[3] = '-' && x.[7] = '-' && x.[11] = '-' && x.[15] = '-' then let actual = String.sub x 0 3 ^ String.sub x 4 3 ^ String.sub x 8 3 ^ String.sub x 12 3 ^ String.sub x 16 3 in if check_raw actual then `Valid else `Invalid else `Invalid) else if n = token_length + 3 then ( assert (n = 17); if x.[5] = '-' && x.[11] = '-' then `MaybePassword else `Invalid) else `Invalid let check x = match parse x with `Valid -> true | `Invalid | `MaybePassword -> false module MakeDerive (G : GROUP) = struct let derive uuid x = let uuid = Uuid.unwrap uuid in let derived = pbkdf2_utf8 ~iterations:1000 ~salt:uuid x in Z.(of_hex derived mod G.q) end module MakeParsePublicCredential (G : GROUP) = struct let parse_public_credential s = try match String.index s ',' with | exception Not_found -> let x = G.of_string s in if G.check x then Some (Weight.one, x) else None | i -> let n = String.length s in let w = Weight.of_string (String.sub s (i + 1) (n - i - 1)) in let x = G.of_string (String.sub s 0 i) in if G.check x then Some (w, x) else None with _ -> None end belenios-2.2-10-gbb6b7ea8/src/lib/core/serializable_core.atd0000644000175000017500000000436414476041226022542 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** {2 Predefined types} *) type number = string wrap type weight = abstract wrap (** {2 Basic cryptographic datastructures} *) type 'a ciphertext = { alpha : 'a; beta : 'a; } type proof = { challenge : number; response : number; } type disjunctive_proof = proof list type voter = { address : string; ?login : string option; ?weight : weight option; } type voter_list = voter list belenios-2.2-10-gbb6b7ea8/src/lib/core/schulze.ml0000644000175000017500000001624214476041226020377 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 *) (* . *) (**************************************************************************) (** A module for computing the Schulze method using both winning and losing votes (losing votes are purely secondary in the ordering). *) (* References: For the theory, see [Wikipedia](https://en.wikipedia.org/wiki/Schulze_method). However, here, we use the implementation of [CIVS](https://github.com/andrewcmyers/civs/blob/master/cgi-bin/beatpath2.pm). *) open Serializable_t (* Definitions: The strength of a direct beat by choice A over choice B is a pair (W,L) where W>L and W is the number of ballots that rank A over B, and L is the number of ballots that rank B over A. Direct beats are totally ordered, with losing votes mattering only if winning votes are tied: (W1,L1) > (W2,L2) iff (W1 > W2) or (W1 = W2 and L1 < L2) *) module Beat = struct let compare (w1, l1) (w2, l2) = if w1 > w2 then 1 else if w1 < w2 then -1 else if l1 < l2 then 1 else if l1 > l2 then -1 else 0 let min x y = if compare x y > 0 then y else x let max x y = if compare x y > 0 then x else y end (** [compute_raw n ballots] computes the raw preference matrix [m], where [m.(i).(j)] is the number of ballots where [i] beats [j]. *) let compute_raw nchoices ballots = let result = Array.make_matrix nchoices nchoices 0 in List.iter (fun ballot -> assert (nchoices = Array.length ballot); let get i = let x = ballot.(i) in if x = 0 then max_int else x in for i = 0 to nchoices - 2 do let x = get i in for j = i + 1 to nchoices - 1 do let y = get j in if x < y then result.(i).(j) <- result.(i).(j) + 1 else if y < x then result.(j).(i) <- result.(j).(i) + 1 done done) ballots; result (* The strength of a path (beatpath) is the min of the strengths of all the links along the path. To compare two choices, we look at the max of all the beatpaths between them. If the max of the beatpaths from A to B is stronger than the max of all the beatpaths from B to A, then A is ranked above B. *) (** [compute_initial_matrix m] returns a matrix which is the initial starting point for the Floyd-Warshall algorithm. Input [m] is a reference to an n-by-n matrix. For any given pair of elements ij and ji in [m], at most one is initialized to something other than (0,0): the one that contains a larger value in [m]. That element is initialized to a pair containing the larger and the smaller of the two values. Thus, diagonal elements are initialized to (0,0); if m_ij=m_ji, both are initialized to (0,0). *) let compute_initial_matrix m = let n = Array.length m in let r = Array.make_matrix n n (0, 0) in for i = 0 to n - 1 do for j = 0 to n - 1 do let x = m.(i).(j) and y = m.(j).(i) in if x > y then r.(i).(j) <- (x, y) else if x < y then r.(j).(i) <- (y, x) done done; r (** [transitive_closure m] computes the transitive (beatpath) closure of the square matrix referenced by $m. Result is destructively returned in $m itself. Implementation: Computes the transitive closure with ratings, using the Floyd-Warshall algorithm, but with min = max, + = min. This gives the necessary commutative semiring. Run time is O(n^3). A classic of dynamic programming. *) let compute_transitive_closure m = let n = Array.length m in for k = 0 to n - 1 do for i = 0 to n - 1 do for j = 0 to n - 1 do (* consider going from i to j via k, comparing to existing path *) m.(i).(j) <- Beat.(max m.(i).(j) (min m.(i).(k) m.(k).(j))) done done done (** [winner m ignore] returns the winners, according to the transitive beatpath closure in [m]. These are the choices that are unbeaten. Choices whose corresponding entry in [ignore] is [true] are ignored, others are considered both as possible winners and as beaters. *) let compute_winners m ignore = let n = Array.length m in let winners = ref [] in for i = 0 to n - 1 do if not ignore.(i) then ( let won = ref true in (try for j = 0 to n - 1 do if not ignore.(j) then if Beat.compare m.(j).(i) m.(i).(j) > 0 then ( won := false; raise Exit) done with Exit -> ()); if !won then winners := i :: !winners) done; List.rev !winners (** [rank_candidates raw] ranks the choices using the raw information in [raw], according to the beatpath winner criterion. *) let rank_candidates raw = let n = Array.length raw in let beatpaths = compute_initial_matrix raw in let ignore = Array.make n false in compute_transitive_closure beatpaths; let num_ranked = ref 0 and result = ref [] in while !num_ranked < n do let winners = compute_winners beatpaths ignore in result := winners :: !result; List.iter (fun j -> ignore.(j) <- true; incr num_ranked) winners done; (List.rev !result, beatpaths) let compute ~nchoices ~blank_allowed ballots = let n = Array.length ballots in let ballots = Array.to_list ballots in let null_ballot = Array.make nchoices 0 in let schulze_valid, schulze_blank, ballots = if blank_allowed then let rec loop valid blank ballots = function | [] -> (valid, Some blank, ballots) | ballot :: xs -> if ballot = null_ballot then loop valid (blank + 1) ballots xs else loop (valid + 1) blank (ballot :: ballots) xs in loop 0 0 [] ballots else (n, None, ballots) in let schulze_raw = compute_raw nchoices ballots in let schulze_winners, schulze_beatpaths = rank_candidates schulze_raw in { schulze_raw; schulze_valid; schulze_blank; schulze_beatpaths; schulze_winners; } belenios-2.2-10-gbb6b7ea8/src/lib/core/events.mli0000644000175000017500000000314614476041226020376 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_t val empty_roots : roots val update_roots : hash -> event -> roots -> roots belenios-2.2-10-gbb6b7ea8/src/lib/core/common.ml0000644000175000017500000002527314476041226020216 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios_platform open Platform open Signatures_core let ( let@ ) f x = f x let ( let& ) = Option.bind let ( // ) = Filename.concat module Uuid = Common_types.Uuid module Hash = Common_types.Hash module Weight = Common_types.Weight module Question_signature = Common_types.Question_signature module Election_result = Common_types.Election_result module Question_result = Common_types.Question_result module Array = Common_types.Array module Shape = Common_types.Shape let sha256_b64 x = Hash.hash_string x |> Hash.to_b64 module String = struct include String let drop_prefix ~prefix x = let prefixn = length prefix and n = length x in if n >= prefixn && sub x 0 prefixn = prefix then Some (sub x prefixn (n - prefixn)) else None end module List = struct include List let rec join sep = function | [] -> [] | [ x ] -> [ x ] | x :: xs -> x :: sep :: join sep xs end module Option = struct include Option let wrap f x = try Some (f x) with _ -> None let unwrap default x f = match x with None -> default | Some x -> f x end let sread of_string state buf = match Yojson.Safe.read_json state buf with | `String x -> of_string x | _ -> failwith "read_string" let swrite to_string buf x = Yojson.Safe.write_json buf (`String (to_string x)) let save_to filename writer x = let oc = open_out filename in let ob = Bi_outbuf.create_channel_writer oc in writer ob x; Bi_outbuf.add_char ob '\n'; Bi_outbuf.flush_channel_writer ob; close_out oc let b64_order = "+/0123456789aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ" let compare_b64 a b = let na = String.length a and nb = String.length b in let value_of c = match String.index_opt b64_order c with Some i -> i | None -> -1 in let rec loop i = match (i < na, i < nb) with | true, true -> let diff = value_of a.[i] - value_of b.[i] in if diff = 0 then loop (i + 1) else diff | true, false -> 1 | false, true -> -1 | false, false -> 0 in loop 0 module SSet = Set.Make (String) module SMap = Map.Make (String) module IMap = Map.Make (Int) (** 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 let check_modulo p x = Z.(compare x zero >= 0 && compare x p < 0) let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" let z58 = Z.of_int (String.length b58_digits) let z10 = Z.of_int 10 module MakeGenerateToken (R : Signatures_core.RANDOM) = struct let random_char () = let n = R.random z58 in b58_digits.[Z.to_int n] let generate_token ?(length = 14) () = String.init length (fun _ -> random_char ()) let generate_numeric ?(length = 6) () = let modulus = let rec loop length accu = if length > 0 then loop (length - 1) Z.(accu * z10) else accu in loop length Z.one in let n = R.random modulus in Printf.sprintf "%0*d" length (Z.to_int n) end let sqrt s = (* https://en.wikipedia.org/wiki/Integer_square_root *) let rec loop x0 = let x1 = Z.(shift_right (x0 + (s / x0)) 1) in if Z.compare x1 x0 < 0 then loop x1 else x0 in let x0 = Z.shift_right s 1 in if Z.compare x0 Z.zero > 0 then loop x0 else s module BabyStepGiantStep (G : GROUP) = struct (* https://en.wikipedia.org/wiki/Baby-step_giant-step *) let log ~generator:alpha ~max:n = let m = Z.(to_int (sqrt n + one)) in let table = Hashtbl.create m in let add_to_table x i = let h = G.hash_to_int x in let ii = match Hashtbl.find_opt table h with None -> [] | Some ii -> ii in Hashtbl.add table h (i :: ii) in let rec populate_table j cur = if j < m then ( add_to_table cur j; populate_table (j + 1) G.(cur *~ alpha)) else cur in let inv_alpha_m = G.(invert (populate_table 0 one)) in fun beta -> let rec lookup i gamma = if i < m then let r = let& jj = Hashtbl.find_opt table (G.hash_to_int gamma) in let rec find = function | [] -> None | j :: jj -> let r = Z.(((of_int i * of_int m) + of_int j) mod G.q) in if G.(alpha **~ r =~ beta) then Some r else find jj in find jj in match r with | Some r -> Some r | None -> lookup (i + 1) G.(gamma *~ inv_alpha_m) else None in lookup 0 beta end let split_on_br s = let n = String.length s in let rec loop i j accu = if j <= n - 4 then if String.sub s j 4 = "
" then loop (j + 4) (j + 4) (String.sub s i (j - i) :: accu) else loop i (j + 1) accu else List.rev (String.sub s i (n - i) :: accu) in loop 0 0 [] let split_lines str = let n = String.length str in let find i c = match String.index_from_opt str i c with None -> n | Some j -> j in let rec loop accu i = if i < n then let j = min (find i '\n') (find i '\r') in let line = String.sub str i (j - i) in let accu = if line = "" then accu else line :: accu in loop accu (j + 1) else List.rev accu in loop [] 0 let strip_cred x = match String.split_on_char ',' x with | [ _ ] | [ _; _ ] -> x | [ x; ""; _ ] -> x | [ x; y; _ ] -> Printf.sprintf "%s,%s" x y | _ -> Printf.ksprintf invalid_arg "invalid line in public credentials: %s" x let extract_weight str = try let i = String.rindex str ',' in let w = Weight.of_string (String.sub str (i + 1) (String.length str - i - 1)) in (String.sub str 0 i, w) with _ -> (str, Weight.one) let re_exec_opt ~rex x = try Some (Re.Pcre.exec ~rex x) with Not_found -> None let username_rex = "^[A-Z0-9._%+-]+$" let is_username = let rex = Re.Pcre.regexp ~flags:[ `CASELESS ] username_rex in fun x -> match re_exec_opt ~rex x with Some _ -> true | None -> false let email_rex = "[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}" let is_email = let rex = Re.Pcre.regexp ~flags:[ `CASELESS ] ("^" ^ email_rex ^ "$") in fun x -> match re_exec_opt ~rex x with Some _ -> true | None -> false let extract_email = let rex = Re.Pcre.regexp ~flags:[ `CASELESS ] ("<(" ^ email_rex ^ ")>") in fun x -> if is_email x then Some x else let& s = re_exec_opt ~rex x in Some (Re.Pcre.get_substring s 1) let split_identity_opt x = match String.split_on_char ',' x with | [ address ] -> (address, None, None) | [ address; login ] -> (address, (if login = "" then None else Some login), None) | [ address; login; weight ] -> ( address, (if login = "" then None else Some login), Some (Weight.of_string weight) ) | _ -> failwith "Common.split_identity_opt" let map_and_concat_with_commas f xs = let n = Array.length xs in let res = Buffer.create (n * 1024) in for i = 0 to n - 1 do Buffer.add_string res (f xs.(i)); Buffer.add_char res ',' done; let size = Buffer.length res - 1 in if size > 0 then Buffer.sub res 0 size else "" module Voter = struct type t = [ `Plain | `Json ] * Serializable_core_t.voter let wrap = function | `String x -> let address, login, weight = split_identity_opt x in ((`Plain, { address; login; weight }) : t) | x -> let s = Yojson.Safe.to_string x in (`Json, Serializable_core_j.voter_of_string s) let of_string x = match Serializable_core_j.voter_of_string x with | exception _ -> wrap (`String x) | o -> (`Json, o) let to_string ((typ, o) : t) = match typ with | `Json -> Serializable_core_j.string_of_voter o | `Plain -> ( match o with | { address; login = None; weight = None } -> address | { address; login = None; weight = Some weight } -> address ^ ",," ^ Weight.to_string weight | { address; login = Some login; weight = None } -> address ^ "," ^ login | { address; login = Some login; weight = Some weight } -> address ^ "," ^ login ^ "," ^ Weight.to_string weight) let unwrap ((typ, o) as x : t) = match typ with | `Json -> let s = Serializable_core_j.string_of_voter o in Yojson.Safe.from_string s | `Plain -> `String (to_string x) let list_to_string voters = if List.exists (fun (x, _) -> x = `Json) voters then Serializable_core_j.string_of_voter_list (List.map snd voters) else let b = Buffer.create 1024 in List.iter (fun x -> Buffer.add_string b (to_string x); Buffer.add_char b '\n') voters; Buffer.contents b let list_of_string x = match Serializable_core_j.voter_list_of_string x with | voters -> List.map (fun x -> (`Json, x)) voters | exception _ -> split_lines x |> List.map of_string let get ((_, { address; login; weight }) : t) = ( address, Option.value login ~default:address, Option.value weight ~default:Weight.one ) let validate ((_, { address; login; _ }) : t) = is_email address && match login with None -> true | Some login -> is_username login end let has_explicit_weights voters = List.exists (fun ((_, { weight; _ }) : Voter.t) -> weight <> None) voters let supported_crypto_versions = [ 1 ] belenios-2.2-10-gbb6b7ea8/src/lib/core/question_h.atd0000644000175000017500000000452014476041226021234 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** {2 Predefined types} *) type 'a ciphertext = abstract type disjunctive_proof = abstract (** {2 Questions and answers} *) type question = { answers : string list ; ?blank : bool option; min : int; max : int; question : string; } type 'a answer = { choices : 'a ciphertext list ; individual_proofs : disjunctive_proof list ; overall_proof : disjunctive_proof; ?blank_proof : disjunctive_proof option; } belenios-2.2-10-gbb6b7ea8/src/lib/core/signatures_core.mli0000644000175000017500000000724614476041226022273 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform open Platform (** Helpers for interacting with atd stuff *) module Json = Atdgen_runtime.Util.Json type 'a reader = 'a Json.reader type 'a writer = 'a Json.writer (** A group suitable for discrete logarithm-based cryptography. *) module type GROUP = sig (** The following interface is redundant: it is assumed, but not checked, that usual mathematical relations hold. *) type t (** The type of elements. Note that it may be larger than the group itself, hence the [check] function below. *) val check : t -> bool (** Check group membership. *) val one : t (** The neutral element of the group. *) val g : t (** A generator of the group. *) val q : Z.t (** The order of [g]. *) val ( *~ ) : t -> t -> t (** Multiplication. *) val ( **~ ) : t -> Z.t -> t (** Exponentiation. *) val ( =~ ) : t -> t -> bool (** Equality test. *) val invert : t -> t (** Inversion. *) val to_string : t -> string (** Conversion to string. *) val of_string : string -> t (** Conversion from string. *) val of_ints : int array -> t (** Convert an int array to a group element. *) val to_ints : int -> t -> int array (** Convert a group element to an int array. The first argument is the size of the array. *) val hash : string -> t array -> Z.t (** Hash an array of elements into an integer mod [q]. The string argument is a string that is prepended before computing the hash. *) val hash_to_int : t -> int (** Hash an element to a small integer. *) val compare : t -> t -> int (** A total ordering over the elements of the group. *) val get_generator : int -> t (** [get_generator i] computes generator #[i] of the group. *) val description : string end (** Monad signature. *) module type MONAD = sig type 'a t val yield : unit -> unit t val return : 'a -> 'a t val bind : 'a t -> ('a -> 'b t) -> 'b t val fail : exn -> 'a t end (** Random number generation. *) module type RANDOM = sig val random : Z.t -> Z.t (** [random q] returns a random number modulo [q]. *) end module type QUESTION_SIGNATURE_PACK = sig type t val x : t Common_types.Question_signature.t end belenios-2.2-10-gbb6b7ea8/src/lib/core/group_field.mli0000644000175000017500000000401514476041226021365 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** Finite field arithmetic *) open Belenios_platform.Platform open Serializable_t module type GROUP = Signatures.GROUP with type t = Z.t (** Multiplicative subgroup of a finite field. *) val check_params : ff_params -> bool (** Check consistency of finite field parameters. *) val make : string -> ff_params -> (module GROUP) (** [finite_field params] builds the multiplicative subgroup of F[params.p], generated by [params.g], of order [params.q]. It does not check the consistency of the parameters. *) belenios-2.2-10-gbb6b7ea8/src/lib/core/util.ml0000644000175000017500000000771414476041226017703 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Signatures open Serializable_t let count_trustees trustees = List.fold_left (fun accu x -> match x with | `Single _ -> accu + 1 | `Pedersen p -> accu + Array.length p.t_verification_keys) 0 trustees let arrange_partial_decryptions trustees partial_decryptions = let n = count_trustees trustees in let tmp = Array.make n None in let () = List.iter (fun x -> tmp.(x.owned_owner - 1) <- Some x.owned_payload) partial_decryptions in let _, accu = List.fold_left (fun (i, accu) x -> match x with | `Single _ -> (i + 1, `Single tmp.(i) :: accu) | `Pedersen p -> p.t_verification_keys |> Array.mapi (fun j _ -> tmp.(i + j)) |> fun x -> (i + Array.length x, `Pedersen x :: accu)) (0, []) trustees in List.rev accu exception CombinationError of combination_error let compute_synthetic_factors_exc trustees check partial_decryptions fold = List.map2 (fun x y -> match (x, y) with | `Single x, `Single y -> ( match y with | None -> raise (CombinationError MissingPartialDecryption) | Some y when check x.trustee_public_key y -> y.decryption_factors | _ -> raise (CombinationError InvalidPartialDecryption)) | `Pedersen x, `Pedersen y -> let length = Array.length x.t_verification_keys in assert (length = Array.length y); let check x y = match y with None -> true | Some y -> check x.trustee_public_key y in if Array.for_all2 check x.t_verification_keys y then let y = Array.mapi (fun i x -> (i + 1, x)) y in let rec take n i accu = if n > 0 then if i < length then match y.(i) with | _, None -> take n (i + 1) accu | id, Some y -> take (n - 1) (i + 1) ((id, y) :: accu) else raise (CombinationError NotEnoughPartialDecryptions) else accu in let pds_with_ids = take x.t_threshold 0 [] in fold pds_with_ids else raise (CombinationError InvalidPartialDecryption) | _ -> invalid_arg "combine_factors") trustees (arrange_partial_decryptions trustees partial_decryptions) let compute_synthetic_factors trustees check partial_decryptions fold = try Ok (compute_synthetic_factors_exc trustees check partial_decryptions fold) with CombinationError e -> Error e belenios-2.2-10-gbb6b7ea8/src/lib/core/majority_judgment.ml0000644000175000017500000001161014476041226022447 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_j let compute_matrix ~ngrades ~nchoices ~blank_allowed ballots = let n = Array.length ballots in let raw = Array.make_matrix nchoices ngrades 0 in let rec add_ballot i invalid blank valid = if i < n then ( let ballot = ballots.(i) in assert (nchoices = Array.length ballot); let rec check j = if j < nchoices then let grade = ballot.(j) in if 0 < grade && grade <= ngrades then check (j + 1) else j else j in let rec is_blank_ballot j = if j < nchoices then if ballot.(j) = 0 then is_blank_ballot (j + 1) else false else true in if check 0 = nchoices then ( let rec fill j = if j < nchoices then ( let grade = ballot.(j) - 1 in raw.(j).(grade) <- raw.(j).(grade) + 1; fill (j + 1)) else () in fill 0; add_ballot (i + 1) invalid blank (valid + 1)) else if blank_allowed && is_blank_ballot 0 then add_ballot (i + 1) invalid (blank + 1) valid else add_ballot (i + 1) (ballot :: invalid) blank valid) else (invalid, blank, valid) in let invalid, blank, valid = add_ballot 0 [] 0 0 in let blank = if blank_allowed then Some blank else ( assert (blank = 0); None) in (raw, Array.of_list invalid, blank, valid) let compute_increasing_vector grades = let sum = Array.fold_left ( + ) 0 grades in let res = Array.make sum (-1) in let ngrades = Array.length grades in let rec process i grade = if grade < ngrades then ( let x = grades.(grade) in assert (i + x <= sum); let rec fill j n = if n > 0 then ( res.(j) <- grade; fill (j + 1) (n - 1)) else j in let j = fill i x in process j (grade + 1)) else assert (i = sum) in process 0 0; res let compute_median_sequence increasing_vector = let n = Array.length increasing_vector in let tmp = Array.copy increasing_vector in let res = Array.make n 0 in for i = 0 to n - 1 do let n' = n - i in let imedian = ((n' + 1) / 2) - 1 in res.(i) <- tmp.(imedian); Array.blit tmp (imedian + 1) tmp imedian (n' - 1 - imedian) done; res let lex_compare a b = let n = Array.length a in assert (n = Array.length b); let rec loop i = if i < n then let x = a.(i) - b.(i) in if x = 0 then loop (i + 1) else x else 0 in loop 0 let compute_winners matrix = let n = Array.length matrix in let sorted = matrix |> Array.map compute_increasing_vector |> Array.map compute_median_sequence |> Array.mapi (fun i x -> (i, x)) in Array.sort (fun (_, a) (_, b) -> lex_compare a b) sorted; let rec main i accu = if i < n then let a, aa = sorted.(i) in let i', level = let rec exaequos j accu = if j < n then let b, bb = sorted.(j) in if lex_compare aa bb = 0 then exaequos (j + 1) (b :: accu) else (j, accu) else (j, accu) in exaequos (i + 1) [ a ] in main i' (level :: accu) else List.rev accu in main 0 [] let compute ~ngrades ~nchoices ~blank_allowed ballots = let mj_raw, mj_invalid, mj_blank, mj_valid = compute_matrix ~ngrades ~nchoices ~blank_allowed ballots in let mj_winners = compute_winners mj_raw in { mj_raw; mj_valid; mj_blank; mj_invalid; mj_winners } belenios-2.2-10-gbb6b7ea8/src/lib/core/common_types.mli0000644000175000017500000001025014476041226021600 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform.Platform module Number : sig type t = Z.t val wrap : string -> t val unwrap : t -> string end module Uuid : sig type t val min_length : int val dummy : t val wrap : string -> t val unwrap : t -> string end module Hash : sig type t val wrap : string -> t val unwrap : t -> string val of_hex : string -> t val to_hex : t -> string val to_b64 : t -> string val of_b64 : string -> t val hash_string : string -> t end module Weight : sig type t val wrap : Yojson.Safe.t -> t val unwrap : t -> Yojson.Safe.t val zero : t val one : t val is_int : t -> int -> bool val ( + ) : t -> t -> t val expand : total:t -> t -> Z.t val reduce : total:t -> Z.t -> t val max_expanded_weight : Z.t val min : t -> t -> t val max : t -> t -> t val of_string : string -> t val to_string : t -> string val compare : t -> t -> int end module Question_signature : sig type _ t = | Nil : unit t | Homomorphic : 'a t -> ([ `Homomorphic ] * 'a) t | NonHomomorphic : int * 'a t -> ([ `NonHomomorphic ] * 'a) t end module Question_result : sig type t = [ `Homomorphic of Weight.t array | `NonHomomorphic of int array array ] end module Election_result : sig type _ t = | Nil : unit t | Homomorphic : Weight.t array * 'a t -> ([ `Homomorphic ] * 'a) t | NonHomomorphic : int array array * 'a t -> ([ `NonHomomorphic ] * 'a) t val wrap : 'a Question_signature.t -> Yojson.Safe.t -> 'a t val unwrap : 'a t -> Yojson.Safe.t val nth : 'a t -> int -> Question_result.t val map2 : (int -> Question_result.t -> 'b -> 'c) -> 'a t -> 'b array -> 'c list end module Array : sig include module type of Stdlib.Array val for_all3 : ('a -> 'b -> 'c -> bool) -> 'a array -> 'b array -> 'c array -> bool val map3 : ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array val findi : (int -> 'a -> 'b option) -> 'a array -> 'b option end module Shape : sig type 'a t = [ `Atomic of 'a | `Array of 'a t array ] val of_array : 'a array -> 'a t val to_array : 'a t -> 'a array val to_shape_array : 'a t -> 'a t array val map : ('a -> 'b) -> 'a t -> 'b t val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val flatten : 'a t -> 'a list val split : ('a * 'b) t -> 'a t * 'b t val forall : ('a -> bool) -> 'a t -> bool val forall2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool val forall3 : ('a -> 'b -> 'c -> bool) -> 'a t -> 'b t -> 'c t -> bool end module Atd_shape_t : sig type 'a shape = 'a Shape.t end module Atd_shape_j : sig open Atdgen_runtime.Util.Json val write_shape : 'a writer -> 'a Shape.t writer val read_shape : 'a reader -> 'a Shape.t reader end belenios-2.2-10-gbb6b7ea8/src/lib/core/events.ml0000644000175000017500000000433114476041226020222 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_j let empty_roots = { roots_setup_data = None; roots_encrypted_tally = None; roots_result = None; roots_last_ballot_event = None; roots_last_shuffle_event = None; roots_last_pd_event = None; } let update_roots h event accu = match event.event_typ with | `Ballot -> { accu with roots_last_ballot_event = Some h } | `PartialDecryption -> { accu with roots_last_pd_event = Some h } | `Shuffle -> { accu with roots_last_shuffle_event = Some h } | `Setup -> { accu with roots_setup_data = event.event_payload } | `EncryptedTally -> { accu with roots_encrypted_tally = event.event_payload } | `Result -> { accu with roots_result = event.event_payload } | _ -> accu belenios-2.2-10-gbb6b7ea8/src/lib/core/versioned_sig.mli0000644000175000017500000000500114476041226021722 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Signatures module type GROUP_SIG = sig val of_string : string -> (module GROUP) end module type QUESTION_H_SIG = sig module Make (M : RANDOM) (G : GROUP) : Question_sigs.QUESTION_H with type elt := G.t and type question := Question_h_t.question and type answer := G.t Question_h_t.answer end module type QUESTION_NH_SIG = sig module Make (M : RANDOM) (G : GROUP) : Question_sigs.QUESTION_NH with type elt := G.t and type question := Question_nh_t.question and type answer := G.t Question_nh_t.answer end module type MIXNET_SIG = sig module Make (W : ELECTION_DATA) (M : RANDOM) : MIXNET with type elt := W.G.t and type 'a proof := 'a Serializable_t.shuffle_proof end module type ELECTION_SIG = sig val of_string : string -> Serializable_t.params val to_string : Serializable_t.params -> group:string -> public_key:string -> string module Make (MakeResult : MAKE_RESULT) (R : RAW_ELECTION) (M : RANDOM) () : ELECTION end belenios-2.2-10-gbb6b7ea8/src/lib/core/archive.ml0000644000175000017500000003106014476041226020336 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_j open Signatures open Common type data_or_event = Data | Event of event type record = { typ : data_or_event; hash : hash; location : location } let block_size = 512 let block_sizeL = Int64.of_int block_size let new_header () = let timestamp = Unix.time () |> Int64.of_float in { version = 1; timestamp = `String (Int64.to_string timestamp) } let get_timestamp header = match header.timestamp with | `String x | `Intlit x -> Int64.of_string x | `Int x -> Int64.of_int x | _ -> invalid_arg "get_timestamp" module type IO_READER = sig include MONAD type file val get_pos : file -> int64 t val set_pos : file -> int64 -> unit t val read_block : file -> bytes -> unit t end module type ARCHIVE_READER = sig type 'a m type archive val read_header : archive -> archive_header m val read_record : archive -> record m end let int64_of_octal x = Int64.of_string ("0o" ^ x) module MakeReader (M : IO_READER) = struct type archive = M.file let ( let* ) = M.bind let raw_read_header f buffer = let* () = M.read_block f buffer in let filename = let i = 0 in let j = Bytes.index_from buffer i '\000' in Bytes.sub_string buffer i (j - i) in let length = Bytes.sub_string buffer 124 11 |> int64_of_octal in M.return (filename, length) let raw_read_body f buffer length = assert (length <= Int64.of_int Sys.max_string_length); let length = Int64.to_int length in let result = Bytes.create length in let rec loop offset length = if length > block_size then ( let* () = M.read_block f buffer in Bytes.blit buffer 0 result offset block_size; loop (offset + block_size) (length - block_size)) else if length > 0 then ( let* () = M.read_block f buffer in Bytes.blit buffer 0 result offset length; M.return @@ Bytes.to_string result) else M.return @@ Bytes.to_string result in loop 0 length let read_header f = let buffer = Bytes.create block_size in let* filename, length = raw_read_header f buffer in let* header = raw_read_body f buffer length in if filename = "BELENIOS" then let header = archive_header_of_string header in if header.version = 1 then M.return header else M.fail (Failure "unsupported archive header") else M.fail (Failure "ill-formed archive header found") let read_record f = let buffer = Bytes.create block_size in let* filename, location_length = raw_read_header f buffer in let* location_offset = M.get_pos f in let typ, hash = let i = 0 in let j = String.index_from filename i '.' + 1 in let k = String.index_from filename j '.' + 1 in ( (match String.sub filename j (k - j - 1) with | "data" -> `Data | "event" -> `Event | _ -> assert false), String.sub filename i (j - i - 1) |> Hash.of_hex ) in let location = { location_offset; location_length } in let* typ = match typ with | `Event -> let* body = raw_read_body f buffer location_length in M.return @@ Event (event_of_string body) | `Data -> let new_pos = let open Int64 in let q = div location_length block_sizeL in let r = rem location_length block_sizeL in let blocks = add q (if r = 0L then 0L else 1L) in add location_offset (mul blocks block_sizeL) in let* () = M.set_pos f new_pos in M.return Data in M.return { typ; hash; location } end module type IO_WRITER = sig include MONAD type file val get_pos : file -> int64 t val write_block : file -> bytes -> unit t end module type ARCHIVE_WRITER = sig type 'a m type archive val write_header : archive -> archive_header -> unit m val write_record : archive -> timestamp:int64 -> data_or_event -> string -> record m end let write_to_bytes buffer pos str = Bytes.blit_string str 0 buffer pos (String.length str) let compute_checksum x = let sum = ref 0 in for i = 0 to Bytes.length x - 1 do sum := !sum + int_of_char (Bytes.get x i) done; Printf.sprintf "%06o\000 " !sum module MakeWriter (M : IO_WRITER) = struct type archive = M.file let ( let* ) = M.bind let raw_write_header f buffer filename length timestamp = (* pre-condition: buffer is filled with '\000' *) write_to_bytes buffer 0 filename; write_to_bytes buffer 100 "0000644"; write_to_bytes buffer 108 "0000000"; write_to_bytes buffer 116 "0000000"; write_to_bytes buffer 124 (Printf.sprintf "%011Lo" length); write_to_bytes buffer 136 (Printf.sprintf "%011Lo" timestamp); write_to_bytes buffer 148 " "; write_to_bytes buffer 156 "0"; write_to_bytes buffer 148 (compute_checksum buffer); M.write_block f buffer let raw_write_body f buffer body = let rec loop offset length = if length > block_size then ( Bytes.blit_string body offset buffer 0 block_size; let* () = M.write_block f buffer in loop (offset + block_size) (length - block_size)) else if length > 0 then ( Bytes.blit_string body offset buffer 0 length; for i = length to block_size - 1 do Bytes.set buffer i '\000' done; M.write_block f buffer) else M.return () in loop 0 (String.length body) let write_header f header = let buffer = Bytes.make block_size '\000' in let header_s = string_of_archive_header header in let header_n = String.length header_s |> Int64.of_int in let timestamp = get_timestamp header in let* () = raw_write_header f buffer "BELENIOS" header_n timestamp in raw_write_body f buffer header_s let write_record f ~timestamp typ payload = let location_length = String.length payload |> Int64.of_int in let hash = Hash.hash_string payload in let filename = let typ = match typ with Data -> "data" | Event _ -> "event" in Printf.sprintf "%s.%s.json" (Hash.to_hex hash) typ in let buffer = Bytes.make block_size '\000' in let* () = raw_write_header f buffer filename location_length timestamp in let* location_offset = M.get_pos f in let* () = raw_write_body f buffer payload in let location = { location_offset; location_length } in M.return { typ; hash; location } end module type IO_ARCHIVER = sig include MONAD val get_hash : hash -> string option t end module type ARCHIVER = sig type 'a m type archive val write_archive : archive -> archive_header -> event -> unit m end module MakeArchiver (M : IO_ARCHIVER) (W : ARCHIVE_WRITER with type 'a m := 'a M.t) = struct let ( let* ) = M.bind let get_hash hash = let* x = M.get_hash hash in match x with | None -> let msg = Printf.sprintf "hash %s not found" (Hash.to_hex hash) in M.fail (Failure msg) | Some x -> let actual_hash = Hash.hash_string x in if hash = actual_hash then M.return x else let msg = Printf.sprintf "hash %s found instead of %s" (Hash.to_hex actual_hash) (Hash.to_hex hash) in M.fail (Failure msg) let get_payload event = match event.event_payload with | None -> let msg = Printf.sprintf "missing payload in event %s" (string_of_event_type event.event_typ) in M.fail (Failure msg) | Some hash -> get_hash hash let write_archive archive header last = let timestamp = get_timestamp header in let* () = W.write_header archive header in let rec loop last accu = match last.event_parent with | None -> M.return accu | Some parent -> let* previous = get_hash parent in let previous = event_of_string previous in loop previous (previous :: accu) in let* events = loop last [ last ] in let rec loop height parent = function | [] -> M.return () | event :: events -> let event_s = string_of_event event in let event_h = Hash.hash_string event_s in if event.event_parent = parent && event.event_height = height then let* () = match event.event_typ with | `Ballot | `Result -> let* payload = get_payload event in let* _ = W.write_record archive ~timestamp Data payload in let* _ = W.write_record archive ~timestamp (Event event) event_s in M.return () | `EndBallots | `EndShuffles -> if event.event_payload = None then let* _ = W.write_record archive ~timestamp (Event event) event_s in M.return () else let msg = Printf.sprintf "extra payload found at height %d" height in M.fail (Failure msg) | `Setup -> let* payload = get_payload event in let setup_data = setup_data_of_string payload in let* election = get_hash setup_data.setup_election in let* trustees = get_hash setup_data.setup_trustees in let* credentials = get_hash setup_data.setup_credentials in let* _ = W.write_record archive ~timestamp Data election in let* _ = W.write_record archive ~timestamp Data trustees in let* _ = W.write_record archive ~timestamp Data credentials in let* _ = W.write_record archive ~timestamp Data payload in let* _ = W.write_record archive ~timestamp (Event event) event_s in M.return () | `EncryptedTally -> let* payload = get_payload event in let sized_et = sized_encrypted_tally_of_string read_hash payload in let et_h = sized_et.sized_encrypted_tally in let* et_s = get_hash et_h in let* _ = W.write_record archive ~timestamp Data et_s in let* _ = W.write_record archive ~timestamp Data payload in let* _ = W.write_record archive ~timestamp (Event event) event_s in M.return () | `Shuffle | `PartialDecryption -> let* payload = get_payload event in let owned = owned_of_string read_hash payload in let it_h = owned.owned_payload in let* it_s = get_hash it_h in let* _ = W.write_record archive ~timestamp Data it_s in let* _ = W.write_record archive ~timestamp Data payload in let* _ = W.write_record archive ~timestamp (Event event) event_s in M.return () in loop (height + 1) (Some event_h) events else let msg = Printf.sprintf "inconsistency at height %d" height in M.fail (Failure msg) in loop 0 None events end belenios-2.2-10-gbb6b7ea8/src/lib/core/stv.ml0000644000175000017500000001552514476041226017541 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) open Serializable_t open Common (** Transform a ballot in belenios format (e.g. [4,1,2,5,3]) into a list of choices (represented as their index in the vector) in preference order (e.g. [1,2,4,0,3]) *) let process ballot = let nchoices = Array.length ballot in let used = Array.make nchoices false in let rec lookup rank i = if i < nchoices then if ballot.(i) = rank then ( assert (not used.(i)); used.(i) <- true; Some i) else lookup rank (i + 1) else None in let rec build_preference_list rank accu = match lookup rank 0 with | Some i -> build_preference_list (rank + 1) (i :: accu) | None -> List.rev accu in let preference_list = build_preference_list 1 [] in let rec check i = if i < nchoices then if used.(i) || ballot.(i) = 0 then check (i + 1) else false else true in if check 0 then Some preference_list else None (** Here, [choices] is a map from choices to ballots that has them as first choice. This function updates [choices] with a new ballot: it assigns the ballot to its first choice, and makes sure all other choices also exist in [choices]. *) let assign choices ((_, ballot) as b) = let prepend ballots choices x = match IMap.find_opt x choices with | None -> IMap.add x ballots choices | Some bs -> IMap.add x (List.rev_append ballots bs) choices in match ballot with | [] -> choices | x :: xs -> List.fold_left (prepend []) (prepend [ b ] choices x) xs (** Here, [scores] is an association list mapping from choices to ballots and total score. This function collects all the ballots, filters out [i] from them, and multiplies [i]'s ballots by [coef]. *) let transfer coef i scores = List.fold_left (fun accu (ai, (ab, _)) -> List.fold_left (fun accu (w, b) -> let w = if ai = i then w *. coef else w in let b = List.filter (fun x -> x <> i) b in (w, b) :: accu) accu ab) [] scores (** This function performs a round of the STV algorithm. It tail-recursively calls itself until [nseats] is [0] or there is not enough remaining choices, and returns the list of events (Win|Lose|TieWin|TieLose) that occured during the process. *) let rec run quota ballots events nseats = if nseats > 0 then let choices = List.fold_left assign IMap.empty ballots in if IMap.cardinal choices <= nseats then (* there is not enough choices: they all win *) choices |> IMap.bindings |> List.map fst |> (fun x -> `Win x :: events) |> List.rev else let scores = (* for each choice, compute the sum of scores of its assigned ballots *) choices |> IMap.map (fun bs -> (bs, List.fold_left (fun accu (w, _) -> accu +. w) 0. bs)) |> IMap.bindings |> List.sort (* we sort the choices, with greater total score first, then in question order (this is our "arbitrary" tie breaking, chosen by the election administrator) *) (fun (ai, (_, aw)) (bi, (_, bw)) -> compare (bw, ai) (aw, bi)) in match scores with | (ai, (_, aw)) :: xs when aw >= quota -> (* the first choice is above the quota *) let events = match xs with | (bi, (_, bw)) :: _ when aw = bw -> (* the second choice has the same total score, we chose the first one, but log the tie *) `TieWin [ ai; bi ] :: events | _ -> events in (* note that we select a single winner, even if there are several choices above quota *) let c = (aw -. quota) /. aw in run quota (transfer c ai scores) (`Win [ ai ] :: events) (nseats - 1) | scores -> ( match List.rev scores with | (ai, (_, aw)) :: xs -> (* we select the last choice *) let events = match xs with | (bi, (_, bw)) :: _ when aw = bw -> (* the second last choice has the same total score, we chose the last one, but log the tie *) `TieLose [ ai; bi ] :: events | _ -> events in run quota (transfer 1. ai scores) (`Lose ai :: events) nseats | [] -> (* should not happen, because if there is no choices left, the condition "there is not enough choices" above should have been triggered *) assert false) else List.rev events let compute ~nseats ballots = let nballots = Array.length ballots in let rec partition accu invalid i = if i < nballots then let ballot = ballots.(i) in match process ballot with | None -> partition accu (ballot :: invalid) (i + 1) | Some x -> partition (x :: accu) invalid (i + 1) else (List.sort compare accu, Array.of_list (List.sort compare invalid)) in let stv_ballots, stv_invalid = partition [] [] 0 in let n = List.length stv_ballots in let quota = floor (float n /. float (nseats + 1)) +. 1. in let wballots = List.map (fun b -> (1., b)) stv_ballots in let stv_events = run quota wballots [] nseats in let stv_winners = stv_events |> List.map (function `Win x -> x | _ -> []) |> List.flatten in { stv_ballots; stv_invalid; stv_events; stv_winners } belenios-2.2-10-gbb6b7ea8/src/lib/shell/0002755000175000017500000000000014476041226016544 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/lib/shell/election.mli0000644000175000017500000000407614476041226021056 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) (** Election primitives *) open Belenios_core open Signatures open Serializable_t val get_version : string -> int val of_string : string -> params val election_uuid_of_string_ballot : string -> uuid val has_nh_questions : params -> bool val make_raw_election : params -> group:string -> public_key:string -> string module Make (R : RAW_ELECTION) (M : RANDOM) () : ELECTION val compute_checksums : election:hash -> trustees:string -> public_credentials:string list -> shuffles:hash owned list option -> encrypted_tally:hash option -> election_checksums belenios-2.2-10-gbb6b7ea8/src/lib/shell/dune0000644000175000017500000000017614476041226017424 0ustar stephsteph(library (name belenios) (public_name belenios-lib) (libraries yojson atdgen belenios_platform belenios_core belenios_v1)) belenios-2.2-10-gbb6b7ea8/src/lib/shell/trustees.ml0000644000175000017500000000367114476041226020761 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let get_by_version = function | 1 -> (module Belenios_v1.Trustees : Belenios_core.Trustees_sig.S) | _ -> failwith "Trustees.get_by_version: unsupported version" open Belenios_core.Signatures let string_of_combination_error = function | MissingPartialDecryption -> "a partial decryption is missing" | NotEnoughPartialDecryptions -> "not enough partial decryptions" | InvalidPartialDecryption -> "invalid partial decryption" belenios-2.2-10-gbb6b7ea8/src/lib/shell/election.ml0000644000175000017500000001541214476041226020701 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core open Serializable_j open Signatures open Common let get_version x = let j = Yojson.Safe.from_string x in match j with | `Assoc o -> ( match List.assoc_opt "version" o with | None -> 0 | Some (`Int x) -> x | _ -> failwith "Election.of_string: invalid version") | _ -> failwith "Election.of_string: invalid data" let of_string x = match get_version x with | 1 -> Belenios_v1.Election.of_string x | n -> Printf.ksprintf failwith "Election.of_string: unsupported version: %d" n let election_uuid_of_string_ballot x = let j = Yojson.Safe.from_string x in match j with | `Assoc o -> ( match List.assoc_opt "election_uuid" o with | Some (`String x) -> Uuid.wrap x | _ -> failwith "election_uuid_of_string_ballot: invalid election_uuid") | _ -> failwith "election_uuid_of_string_ballot: invalid ballot" let make_raw_election params ~group ~public_key = match params.e_version with | 1 -> Belenios_v1.Election.to_string params ~group ~public_key | n -> Printf.ksprintf invalid_arg "make_raw_election: unsupported version: %d" n module MakeResult (X : ELECTION_BASE) = struct open X type result = S.t Election_result.t let write_result buf x = Yojson.Safe.write_json buf (Election_result.unwrap x) let read_result state buf = Election_result.wrap S.x (Yojson.Safe.read_json state buf) end (** Helper functions *) let has_nh_questions e = Array.exists (function | Question.NonHomomorphic _ -> true | Question.Homomorphic _ -> false) e.e_questions module type MAKER = functor (MakeResult : MAKE_RESULT) (R : RAW_ELECTION) (M : RANDOM) () -> ELECTION module Make (R : RAW_ELECTION) (M : RANDOM) () = struct let x = match get_version R.raw_election with | 1 -> (module Belenios_v1.Election.Make : MAKER) | n -> Printf.ksprintf failwith "Election.Make: unsupported version: %d" n module X = (val x) include X (MakeResult) (R) (M) () end (** Computing checksums *) let compute_checksums ~election ~trustees ~public_credentials ~shuffles ~encrypted_tally = let ec_public_credentials = Hash.hash_string (string_of_public_credentials public_credentials) in let ec_num_voters = List.length public_credentials in let ec_weights = let w_total, min, max = List.fold_left (fun (total, min, max) cred -> match String.index cred ',' with | exception Not_found -> (Weight.(total + one), min, max) | i -> let n = String.length cred in let w = Weight.of_string (String.sub cred (i + 1) (n - i - 1)) in let total = Weight.(total + w) in let min = match min with | None -> Some w | Some w' -> Some (Weight.min w w') in let max = match max with | None -> Some w | Some w' -> Some (Weight.max w w') in (total, min, max)) (Weight.zero, None, None) public_credentials in if Weight.is_int w_total ec_num_voters then None else match (min, max) with | Some w_min, Some w_max -> Some { w_total; w_min; w_max } | _ -> failwith "inconsistent weights in credentials" in let tc_of_tpk k = let tc_checksum = Hash.hash_string (Yojson.Safe.to_string k.trustee_public_key) in let tc_name = k.trustee_name in { tc_checksum; tc_name } in let trustees = trustees_of_string Yojson.Safe.read_json trustees in let ec_trustees = trustees |> List.map (function `Single k -> [ tc_of_tpk k ] | `Pedersen _ -> []) |> List.flatten in let ec_trustees_threshold = trustees |> List.map (function | `Single _ -> [] | `Pedersen p -> let ts_trustees = List.combine (Array.to_list p.t_verification_keys) (Array.to_list p.t_certs) |> List.map (fun (key, cert) -> { ttc_name = key.trustee_name; ttc_pki_key = Hash.hash_string cert.s_message; ttc_verification_key = Hash.hash_string (Yojson.Safe.to_string key.trustee_public_key); }) in [ { ts_trustees; ts_threshold = p.t_threshold } ]) |> List.flatten in let find_trustee_name_by_id = let names = trustees |> List.map (function | `Single k -> [ k.trustee_name ] | `Pedersen t -> Array.to_list t.t_verification_keys |> List.map (fun x -> x.trustee_name)) |> List.flatten |> Array.of_list in fun id -> if 0 < id && id <= Array.length names then names.(id - 1) else None in let process_shuffles shuffles = List.map (fun x -> { tc_checksum = x.owned_payload; tc_name = find_trustee_name_by_id x.owned_owner; }) shuffles in let ec_shuffles = let& shuffles = shuffles in Some (process_shuffles shuffles) in { ec_election = election; ec_trustees; ec_trustees_threshold; ec_public_credentials; ec_shuffles; ec_encrypted_tally = encrypted_tally; ec_num_voters; ec_weights; } belenios-2.2-10-gbb6b7ea8/src/lib/shell/group.mli0000644000175000017500000000313514476041226020403 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 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 Belenios_core.Signatures val of_string : version:int -> string -> (module GROUP) belenios-2.2-10-gbb6b7ea8/src/lib/shell/group.ml0000644000175000017500000000325014476041226020230 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let of_string ~version = match version with | 1 -> Belenios_v1.Group.of_string | n -> Printf.ksprintf failwith "Group.of_string: unsupported version: %d" n belenios-2.2-10-gbb6b7ea8/src/lib/shell/trustees.mli0000644000175000017500000000324214476041226021124 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2021 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) val get_by_version : int -> (module Belenios_core.Trustees_sig.S) val string_of_combination_error : Belenios_core.Signatures.combination_error -> string belenios-2.2-10-gbb6b7ea8/src/scripts/0002755000175000017500000000000014476041226016356 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/scripts/translate_stubs/0002755000175000017500000000000014476041226021573 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/scripts/translate_stubs/gen.sh0000755000175000017500000000066514476041226022710 0ustar stephsteph#!/bin/sh make build-debug-server for LANG in $(cat po/voter/LINGUAS); do if [ ! -f frontend/translations/$LANG.json ]; then echo '{}' > frontend/translations/$LANG.json fi dune exec --build-dir=_build-debug -- src/scripts/translate_stubs/main.exe frontend/translations/en.json _build-debug/default/po/voter/$LANG.mo < frontend/translations/$LANG.json | jq --indent 4 | sponge frontend/translations/$LANG.json done belenios-2.2-10-gbb6b7ea8/src/scripts/translate_stubs/dune0000644000175000017500000000007714476041226022453 0ustar stephsteph(executable (name main) (libraries gettext-camomile yojson)) belenios-2.2-10-gbb6b7ea8/src/scripts/translate_stubs/main.ml0000644000175000017500000000250514476041226023051 0ustar stephstephopen GettextTypes module StringMap = Map.Make (String) let build_string_map mo = let map, _ = GettextMo.fold_mo Ignore (fun translation accu -> match translation with | Singular (str_id, str) -> StringMap.add str_id str accu | Plural (str_id, _, _) -> Printf.ksprintf failwith "unsupported: Plural(%S, _, _)" str_id) StringMap.empty mo in map let extract_string = function `String x -> x | _ -> failwith "string expected" let extract_assoc = function | `Assoc x -> List.map (fun (x, y) -> (x, extract_string y)) x | _ -> failwith "object expected" let translate_stubs reference target mo = let reference = extract_assoc reference in let target = extract_assoc target in let new_strings = List.filter_map (fun (str_id, str) -> match List.assoc_opt str_id target with | Some _ -> None | None -> ( match StringMap.find_opt str mo with | None -> None | Some str -> Some (str_id, str))) reference in `Assoc (List.map (fun (x, y) -> (x, `String y)) (target @ new_strings)) let () = let reference = Yojson.Safe.from_file Sys.argv.(1) in let mo = build_string_map Sys.argv.(2) in let target = Yojson.Safe.from_channel stdin in translate_stubs reference target mo |> Yojson.Safe.to_channel stdout belenios-2.2-10-gbb6b7ea8/src/scripts/checki18next/0002755000175000017500000000000014476041226020654 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/scripts/checki18next/dune0000644000175000017500000000007714476041226021534 0ustar stephsteph(executable (name checki18next) (libraries unix str yojson)) belenios-2.2-10-gbb6b7ea8/src/scripts/checki18next/reference.json0000644000175000017500000000167714476041226023516 0ustar stephsteph{"majority_judgment_alert_grade_is_mandatory_for_candidate_x":["{{candidate}}"],"alert_question_constraint_no_less_than_min":["{{count}}"],"alert_question_constraint_no_less_than_min_plural":["{{count}}"],"alert_question_constraint_no_more_than_max":["{{count}}"],"alert_question_constraint_no_more_than_max_plural":["{{count}}"],"breadcrumb_step_x":["{{step}}"],"election_uuid_is_x":["{{uuid}}"],"election_fingerprint_is_x":["{{fingerprint}}"],"preferential_voting_preference_level":["{{level}}"],"preferential_voting_without_equality_move_candidate_above_position_x":["{{index}}"],"preferential_voting_without_equality_move_candidate_below_position_x":["{{index}}"],"ask_to_select_x_answers":["{{count}}"],"ask_to_select_x_answers_plural":["{{count}}"],"ask_to_select_between_x_and_y_answers":["{{count}}","{{min}}"],"ask_to_select_between_x_and_y_answers_plural":["{{count}}","{{min}}"],"question_x_of_y":["{{number_of_questions}}","{{current_question}}"]}belenios-2.2-10-gbb6b7ea8/src/scripts/checki18next/checki18next.ml0000644000175000017500000000665514476041226023516 0ustar stephstephlet files_of_dir dir = let dir = Unix.opendir dir in let rec loop accu = match Unix.readdir dir with | f -> loop (f :: accu) | exception End_of_file -> Unix.closedir dir; accu in loop [] let find_special_strings s = let n = String.length s in let rec lookup_special accu i = if i < n then match s.[i] with | '{' -> lookup_variable accu (i + 1) | '$' -> lookup_call accu (i + 1) | _ -> lookup_special accu (i + 1) else accu and lookup_variable accu i = let rec loop depth j = if j < n then match s.[j] with | '{' -> loop (depth + 1) (j + 1) | '}' -> let depth = depth - 1 in if depth = 0 then lookup_special (String.sub s (i - 1) (j - i + 2) :: accu) (j + 1) else loop depth (j + 1) | _ -> loop depth (j + 1) else String.sub s (i - 1) (j - i + 1) :: accu in loop 1 i and lookup_call accu i = let rec loop depth j = if j < n then match s.[j] with | '(' -> loop (depth + 1) (j + 1) | ')' -> let depth = depth - 1 in if depth = 0 then lookup_special (String.sub s (i - 1) (j - i + 2) :: accu) (j + 1) else loop depth (j + 1) | _ -> loop depth (j + 1) else String.sub s (i - 1) (j - i + 1) :: accu in loop 0 i in lookup_special [] 0 let make_reference = function | `Assoc o -> `Assoc (List.filter_map (fun (k, s) -> match s with | `String s -> ( match find_special_strings s with | [] -> None | xs -> Some (k, `List (List.map (fun x -> `String x) xs))) | _ -> assert false) o) | _ -> assert false let check_substring ~substring s = let regexp = Str.regexp_string substring in match Str.search_forward regexp s 0 with | _ -> () | exception Not_found -> Printf.ksprintf failwith "%S does not appear in %S" substring s let check (reference : Yojson.Safe.t) (json : Yojson.Safe.t) = match (reference, json) with | `Assoc reference, `Assoc json -> List.iter (fun (k, specials) -> match specials with | `List specials -> ( match List.assoc_opt k json with | None | Some (`String "") -> () | Some (`String to_check) -> List.iter (function | `String substring -> check_substring ~substring to_check | _ -> assert false) specials | _ -> assert false) | _ -> assert false) reference | _ -> assert false let dir = ref "." let make_reference_ref = ref false let spec = let open Arg in [ ("--dir", Set_string dir, "dir with translations"); ("--make-reference", Set make_reference_ref, "(re-)generate reference file"); ] let () = Arg.parse spec (fun _ -> assert false) "Check i18next translation files." let ( // ) = Filename.concat let () = if !make_reference_ref then Yojson.Safe.from_channel stdin |> make_reference |> Yojson.Safe.to_channel stdout else let reference = Yojson.Safe.from_channel stdin in let translations = files_of_dir !dir |> List.filter (fun x -> x <> "." && x <> "..") |> List.map (fun x -> Yojson.Safe.from_file (!dir // x)) in List.iter (check reference) translations belenios-2.2-10-gbb6b7ea8/src/scripts/mo2json/0002755000175000017500000000000014476041226017745 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/scripts/mo2json/dune0000644000175000017500000000010214476041226020612 0ustar stephsteph(executable (name mo2json) (libraries gettext-camomile yojson)) belenios-2.2-10-gbb6b7ea8/src/scripts/mo2json/mo2json.ml0000644000175000017500000000216514476041226021670 0ustar stephstephopen GettextTypes module StringMap = Map.Make (String) let check_format_compatibility str1 str2 = let open CamlinternalFormatBasics in let open CamlinternalFormat in let (Fmt_EBB fmt1) = fmt_ebb_of_string str1 in ignore (format_of_string_format str2 (Format (fmt1, str1))) let build_string_map mo = let map, _ = GettextMo.fold_mo Ignore (fun translation accu -> match translation with | Singular (str_id, str) -> if String.contains str_id '%' then check_format_compatibility str_id str; StringMap.add str_id (str, None) accu | Plural (str_id, _, _) -> Printf.ksprintf failwith "unsupported: Plural(%S, _, _)" str_id) StringMap.empty mo in map let () = build_string_map Sys.argv.(1) |> StringMap.bindings |> List.map (fun (str_id, (str, plural)) -> match plural with | None -> (str_id, `List [ `String str ]) | Some lst -> ( str_id, `List [ `String str; `List (List.map (fun x -> `String x) lst) ] )) |> (fun x -> `Assoc x) |> Yojson.Safe.to_channel stdout belenios-2.2-10-gbb6b7ea8/src/tool/0002755000175000017500000000000014476041226015644 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/tool/tool_election.mli0000644000175000017500000000127714476041226021213 0ustar stephstephmodule type PARAMS = sig val file : string end module type S = sig type 'a m val vote : string option -> int array array -> string m val decrypt : int -> string -> (string * string) m val tdecrypt : int -> string -> string -> (string * string) m val compute_result : unit -> string m val verify_ballot : string -> unit m val verify : ?skip_ballot_check:bool -> unit -> unit m val shuffle_ciphertexts : int -> (string * string) m val checksums : unit -> string val compute_voters : (string * string) list -> string list val compute_ballot_summary : unit -> string val compute_encrypted_tally : unit -> string * string end module Make (P : PARAMS) () : S with type 'a m := 'a belenios-2.2-10-gbb6b7ea8/src/tool/election.mli0000644000175000017500000000003714476041226020147 0ustar stephstephinclude Common.CMDLINER_MODULE belenios-2.2-10-gbb6b7ea8/src/tool/sealing.mli0000644000175000017500000000003714476041226017767 0ustar stephstephinclude Common.CMDLINER_MODULE belenios-2.2-10-gbb6b7ea8/src/tool/tool_election.ml0000644000175000017500000002556314476041226021046 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module B = Belenios open Belenios_core.Serializable_j open Belenios_core.Common module type PARAMS = sig val file : string end module type S = sig type 'a m val vote : string option -> int array array -> string m val decrypt : int -> string -> (string * string) m val tdecrypt : int -> string -> string -> (string * string) m val compute_result : unit -> string m val verify_ballot : string -> unit m val verify : ?skip_ballot_check:bool -> unit -> unit m val shuffle_ciphertexts : int -> (string * string) m val checksums : unit -> string val compute_voters : (string * string) list -> string list val compute_ballot_summary : unit -> string val compute_encrypted_tally : unit -> string * string end module Make (P : PARAMS) () = struct module Getters = Tool_election_data.MakeGetters (P) module R = Random module Election = B.Election.Make (struct let raw_election = Getters.raw_election end) (R) () include Election include Tool_election_data.Make (Getters) (Election) let print_msg = prerr_endline module Trustees = (val B.Trustees.get_by_version election.e_version) module P = Trustees.MakePKI (G) (R) module C = Trustees.MakeChannels (G) (R) (P) module K = Trustees.MakeCombinator (G) (* Check trustee keys, if present *) let () = match trustees with | Some trustees -> assert (K.check trustees); let y' = K.combine_keys trustees in assert (G.(public_key =~ y')) | None -> failwith "missing trustees" let vote privcred choice = let sk = match privcred with | None -> failwith "missing private credential" | Some cred -> let module CD = Belenios_core.Credential.MakeDerive (G) in CD.derive election.e_uuid cred in let b = E.create_ballot ~sk choice in assert (E.check_ballot b); string_of_ballot b let decrypt owned_owner privkey = let sk = number_of_string privkey in let pk = G.(g **~ sk) in if Array.for_all (fun x -> not G.(x =~ pk)) (Lazy.force pks) then failwith "your key is not present in trustees"; (match Lazy.force shuffles_hash with | None | Some [] -> if B.Election.has_nh_questions election then failwith "the election has non-homomorphic questions and no shuffles were \ found" | Some shuffles -> shuffles |> List.iter (fun s -> Printf.ksprintf print_msg "I: shuffle %s has been applied" s)); if B.Election.has_nh_questions election then print_msg "I: you should check that your shuffle appears in the list of applied \ shuffles"; let tally, _ = Lazy.force encrypted_tally in let factor = E.compute_factor tally sk in assert (E.check_factor tally pk factor); let pd = string_of_partial_decryption (swrite G.to_string) factor in let opd = { owned_owner; owned_payload = Hash.hash_string pd } in (pd, string_of_owned write_hash opd) let tdecrypt owned_owner 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 (encrypted_msg_of_string (sread G.of_string) pdk) in let pdk = (partial_decryption_key_of_string pdk).pdk_decryption_key in let pvk = G.(g **~ pdk) in (match trustees with | None -> failwith "trustees are missing" | Some ts -> if not @@ List.exists (function | `Single _ -> false | `Pedersen t -> Array.exists (fun x -> G.(x.trustee_public_key =~ pvk)) t.t_verification_keys) ts then failwith "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); let pd = string_of_partial_decryption (swrite G.to_string) factor in let opd = { owned_owner; owned_payload = Hash.hash_string pd } in (pd, string_of_owned write_hash opd) let compute_result () = let pds = match Lazy.force pds with | None -> failwith "missing partial decryptions" | Some x -> x in let fill of_string (_, owned, x) = { owned with owned_payload = of_string x } in let factors = List.map (fill (partial_decryption_of_string (sread G.of_string))) pds in let tally, sized = Lazy.force encrypted_tally in let sized = { sized with sized_encrypted_tally = tally } in match trustees with | Some trustees -> ( match E.compute_result sized factors trustees with | Ok result -> string_of_election_result write_result result | Error e -> failwith (B.Trustees.string_of_combination_error e)) | None -> failwith "missing trustees" let verify_ballot raw_ballot = let ballot_box = Lazy.force unverified_ballots |> List.map (fun (h, _, _, _) -> Hash.to_b64 h) |> SSet.of_list in match pre_cast ballot_box raw_ballot with | Error e -> Printf.ksprintf failwith "error: %s in ballot %s" (string_of_cast_error e) raw_ballot | Ok _ -> print_msg "I: ballot is valid" let shuffles_check shuffles = let rtally, _ = Lazy.force raw_encrypted_tally in let cc = E.extract_nh_ciphertexts rtally in let rec loop i cc ss = match ss with | s :: ss -> if E.check_shuffle cc s then loop (i + 1) s.shuffle_ciphertexts ss else Printf.ksprintf failwith "shuffle #%d failed tests" i | [] -> true in loop 0 cc shuffles let verify ?(skip_ballot_check = false) () = let () = fsck () in (match trustees with | Some trustees -> assert (K.check trustees); assert (G.(public_key =~ K.combine_keys trustees)) | None -> failwith "missing trustees"); let () = match Lazy.force raw_ballots with | Some _ -> ( match skip_ballot_check with | false -> ignore (Lazy.force verified_ballots) | true -> ignore (Lazy.force unverified_ballots)) | None -> print_msg "I: no ballots to check" in let () = match Lazy.force shuffles with | Some shuffles -> let b = shuffles_check shuffles in assert b | None -> print_msg "I: no shuffles to check" in let () = match (Lazy.force result, trustees, Lazy.force pds) with | None, _, _ -> print_msg "I: no result to check" | _, None, _ -> failwith "missing trustees" | _, _, None -> failwith "no partial decryptions" | Some result, Some trustees, Some pds -> let fill of_string (_, owned, x) = { owned with owned_payload = of_string x } in let factors = List.map (fill (partial_decryption_of_string (sread G.of_string))) pds in let tally, sized = Lazy.force encrypted_tally in let sized = { sized with sized_encrypted_tally = tally } in if not (E.check_result sized factors trustees result) then failwith "check_result failed" in print_msg "I: all checks passed" let shuffle_ciphertexts owned_owner = let cc, _ = Lazy.force encrypted_tally in let cc = E.extract_nh_ciphertexts cc in let shuffle = E.shuffle_ciphertexts cc in let shuffle_s = string_of_shuffle (swrite G.to_string) shuffle in let owned = { owned_owner; owned_payload = Hash.hash_string shuffle_s } in (shuffle_s, string_of_owned write_hash owned) let checksums () = let election = election_hash in let shuffles = let& x = Lazy.force raw_shuffles in Some (List.map (fun (_, x, _) -> x) x) in let encrypted_tally = let _, x = Lazy.force encrypted_tally in Some x.sized_encrypted_tally in let trustees = match trustees_as_string with | None -> failwith "missing trustees" | Some x -> x in let public_credentials = match Lazy.force raw_public_creds with | None -> failwith "missing credentials" | Some x -> x in B.Election.compute_checksums ~election ~shuffles ~encrypted_tally ~trustees ~public_credentials |> string_of_election_checksums let compute_voters privcreds = let module D = Belenios_core.Credential.MakeDerive (G) in let map = List.fold_left (fun accu (id, cred) -> SMap.add G.(g **~ D.derive election.e_uuid cred |> to_string) id accu) SMap.empty privcreds in let ballots = Lazy.force verified_ballots in List.fold_left (fun accu (h, cred, _, _) -> match SMap.find_opt cred map with | None -> Printf.ksprintf failwith "Unknown public key in ballot %s" (Hash.to_b64 h) | Some id -> id :: accu) [] ballots let compute_ballot_summary () = let has_weights = match Lazy.force public_creds_weights with | None -> false | Some (b, _) -> b in Lazy.force verified_ballots |> List.rev_map (fun (bs_hash, _, w, _) -> let bs_weight = if has_weights then Some w else ( assert (Weight.is_int w 1); None) in { bs_hash; bs_weight }) |> string_of_ballot_summary let compute_encrypted_tally () = let et, sized = Lazy.force raw_encrypted_tally in ( string_of_encrypted_tally (swrite G.to_string) et, string_of_sized_encrypted_tally write_hash sized ) end belenios-2.2-10-gbb6b7ea8/src/tool/tool_events.ml0000644000175000017500000002155714476041226020547 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Serializable_j open Belenios_core.Common open Belenios_core.Events module Archive = Belenios_core.Archive let block_size = Archive.block_size type index = { map : (hash, location) Hashtbl.t; mutable roots : roots; mutable last_event : event option; file : string; mutable lines : (Archive.data_or_event * hash) list; timestamp : int64; header : archive_header; } module DirectMonad = struct type 'a t = 'a let return x = x let bind x f = f x let fail x = raise x let yield () = () end module IoReader = struct include DirectMonad type file = in_channel let get_pos = LargeFile.pos_in let set_pos = LargeFile.seek_in let read_block ic buffer = really_input ic buffer 0 block_size end module Reader = Archive.MakeReader (IoReader) module IoWriter = struct include DirectMonad type file = out_channel let get_pos = LargeFile.pos_out let write_block oc buffer = output_bytes oc buffer end module Writer = Archive.MakeWriter (IoWriter) let build_index filename = let r = Hashtbl.create 1000 in let ic = open_in filename in let header = Reader.read_header ic in let rec loop last accu lines = match Reader.read_record ic with | exception End_of_file -> (r, last, accu, lines, header) | record -> let last, accu = match record.typ with | Data -> (last, accu) | Event event -> (Some event, update_roots record.hash event accu) in Hashtbl.add r record.hash record.location; loop last accu ((record.typ, record.hash) :: lines) in Fun.protect ~finally:(fun () -> close_in ic) (fun () -> loop None empty_roots []) let get_index ~file = let map, last_event, roots, lines, header = build_index file in let timestamp = Archive.get_timestamp header in { map; roots; last_event; file; lines; timestamp; header } let gethash ~index ~filename x = match Hashtbl.find_opt index x with | None -> None | Some i -> let ic = open_in filename in Fun.protect ~finally:(fun () -> close_in ic) (fun () -> LargeFile.seek_in ic i.location_offset; assert (i.location_length <= Int64.of_int Sys.max_string_length); Some (really_input_string ic (Int64.to_int i.location_length))) let get_data i x = gethash ~index:i.map ~filename:i.file x let get_event i x = gethash ~index:i.map ~filename:i.file x |> Option.map event_of_string let get_roots i = i.roots let fold_on_event_payload_hashes index typ last_event f accu = let rec loop e accu = match get_event index e with | None -> assert false | Some e -> if e.event_typ = typ then match (e.event_payload, e.event_parent) with | Some payload, Some parent -> loop parent (f payload accu) | _ -> assert false else accu in loop last_event accu let fold_on_event_payloads index typ last_event f accu = fold_on_event_payload_hashes index typ last_event (fun payload accu -> match get_data index payload with | None -> assert false | Some x -> f x accu) accu let fsck index = let last_event = match index.last_event with None -> failwith "no events" | Some x -> x in let module IoComparer = struct include DirectMonad type file = in_channel let get_pos = LargeFile.pos_in let buffer = Bytes.create block_size let write_block ic expected = try let () = really_input ic buffer 0 block_size in if expected <> buffer then failwith "generated archive is not identical to original one" with End_of_file -> failwith "generate archive is longer than original one" end in let module Comparer = Archive.MakeWriter (IoComparer) in let module IoArchiver = struct include DirectMonad let get_hash hash = gethash ~index:index.map ~filename:index.file hash end in let module Archiver = Archive.MakeArchiver (IoArchiver) (Comparer) in let ic = open_in_bin index.file in let length = LargeFile.in_channel_length ic in Fun.protect ~finally:(fun () -> close_in ic) (fun () -> let () = Archiver.write_archive ic index.header last_event in if LargeFile.pos_in ic <> length then failwith "generated archive is shorter than original one") let starts_with ~(prefix : index) (index : index) = let rec loop x y = match (x, y) with | x :: xs, y :: ys when x = y -> loop xs ys | [], _ -> true | _ -> false in loop (List.rev prefix.lines) (List.rev index.lines) let write_header filename header = let oc = open_out_gen [ Open_wronly; Open_append; Open_creat; Open_binary ] 0o644 filename in Fun.protect ~finally:(fun () -> close_out oc) (fun () -> Writer.write_header oc header) let raw_append ~filename ~timestamp xs = let oc = open_out_gen [ Open_wronly; Open_append; Open_binary ] 0o644 filename in Fun.protect ~finally:(fun () -> close_out oc) (fun () -> List.fold_left (fun accu (typ, x) -> Writer.write_record oc ~timestamp typ x :: accu) [] xs) type append_operation = Data of string | Event of event_type * hash option let append index ops = let last_event, roots, items, lines = List.fold_left (fun (last_event, roots, items, lines) x -> match x with | Data x -> let typ = Archive.Data in let items = (typ, x) :: items in let lines = (typ, Hash.hash_string x) :: lines in (last_event, roots, items, lines) | Event (event_typ, event_payload) -> let event_parent, event_height = match last_event with | None -> (None, 0) | Some x -> ( Some (Hash.hash_string (string_of_event x)), x.event_height + 1 ) in let event = { event_parent; event_height; event_typ; event_payload } in let typ = Archive.Event event in let event_s = string_of_event event in let event_h = Hash.hash_string event_s in let roots = update_roots event_h event roots in let items = (typ, event_s) :: items in (Some event, roots, items, (typ, event_h) :: lines)) (index.last_event, index.roots, [], index.lines) ops in let items = List.rev items in let records = raw_append ~filename:index.file ~timestamp:index.timestamp items in List.iter (fun r -> Hashtbl.add index.map r.Archive.hash r.location) records; index.roots <- roots; index.last_event <- last_event; index.lines <- lines let init ~file ~election ~trustees ~public_creds = if Sys.file_exists file then Printf.ksprintf failwith "%s already exists" file; let header = Archive.new_header () in let index = { map = Hashtbl.create 1000; roots = empty_roots; last_event = None; file; lines = []; timestamp = Archive.get_timestamp header; header; } in write_header file header; let setup_election = Hash.hash_string election in let setup_trustees = Hash.hash_string trustees in let setup_credentials = Hash.hash_string public_creds in let setup_data = { setup_election; setup_trustees; setup_credentials } in let setup_data_s = string_of_setup_data setup_data in append index [ Data election; Data trustees; Data public_creds; Data setup_data_s; Event (`Setup, Some (Hash.hash_string setup_data_s)); ]; index belenios-2.2-10-gbb6b7ea8/src/tool/dune0000644000175000017500000000024414476041226016520 0ustar stephsteph(executable (name main) (public_name belenios-tool) (package belenios-tool) (libraries str cmdliner belenios-platform-native belenios belenios_tool_common)) belenios-2.2-10-gbb6b7ea8/src/tool/tool_mkarchive.mli0000644000175000017500000000003714476041226021353 0ustar stephstephinclude Common.CMDLINER_MODULE belenios-2.2-10-gbb6b7ea8/src/tool/random.ml0000644000175000017500000000340014476041226017451 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_platform open Platform open Belenios_core open Common 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) belenios-2.2-10-gbb6b7ea8/src/tool/setup.ml0000644000175000017500000004047614476041226017347 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Belenios open Belenios_platform.Platform open Belenios_core.Common open Belenios_core.Signatures open Belenios_core.Serializable_j open Belenios_tool_common open Common open Cmdliner let group_t = let doc = "Use group $(docv)." in Arg.(value & opt (some string) None & info [ "group" ] ~docv:"GROUP" ~doc) let version_t = let doc = "Use protocol version $(docv)." in Arg.( value & opt int (List.hd supported_crypto_versions) & info [ "protocol-version" ] ~docv:"VERSION" ~doc) let uuid_t = let doc = "UUID of the election." in Arg.(value & opt (some string) None & info [ "uuid" ] ~docv:"UUID" ~doc) module Tkeygen : CMDLINER_MODULE = struct open Tool_tkeygen let main group version = let@ () = wrap_main in let module P = struct let group = get_mandatory_opt "--group" group let version = version end in let module R = Make (P) (Random) () in let kp = R.trustee_keygen () in Printf.printf "I: keypair %s has been generated\n%!" kp.R.id; let pubkey = ("public", kp.R.id ^ ".pubkey", 0o444, kp.R.pub) in let privkey = ("private", kp.R.id ^ ".privkey", 0o400, kp.R.priv) in let save (kind, filename, perm, thing) = let oc = open_out_gen [ Open_wronly; Open_creat ] perm filename in output_string oc thing; output_char oc '\n'; close_out oc; Printf.printf "I: %s key saved to %s\n%!" kind filename; (* set permissions in the unlikely case where the file already existed *) Unix.chmod filename perm in save pubkey; save privkey let cmd = let doc = "generate a trustee key" in let man = [ `S "DESCRIPTION"; `P "This command is run by a trustee to generate a share of an election \ key. Such a share consists of a private key and a public key with a \ certificate. Generated files are stored in the current directory \ with a name that starts with $(i,ID), where $(i,ID) is a short \ fingerprint of the public key. The private key is stored in \ $(i,ID.privkey) and must be secured by the trustee. The public key \ is stored in $(i,ID.pubkey) and must be sent to the election \ administrator."; ] @ common_man in Cmd.v (Cmd.info "generate-trustee-key" ~doc ~man) Term.(ret (const main $ group_t $ version_t)) end module Ttkeygen : CMDLINER_MODULE = struct let main group version step certs threshold key polynomials = let@ () = wrap_main in 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 in let module G = (val Group.of_string ~version group : GROUP) in let module Trustees = (val Trustees.get_by_version version) in let module P = Trustees.MakePKI (G) (Random) in let module C = Trustees.MakeChannels (G) (Random) (P) in let module T = Trustees.MakePedersen (G) (Random) (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 (swrite G.to_string) 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 () |> List.map (voutput_of_string (sread G.of_string)) |> 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 (swrite G.to_string) 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 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 Cmd.v (Cmd.info "generate-trustee-key-threshold" ~doc ~man) Term.( ret (const main $ group_t $ version_t $ step_t $ cert_t $ threshold_t $ key_t $ polynomials_t)) end module Credgen : CMDLINER_MODULE = struct open Tool_credgen let params_priv = ("private credentials with ids", ".privcreds", 0o400) let params_pub = ("public credentials", ".pubcreds", 0o444) let save (info, ext, perm) basename f = let fname = basename ^ ext in let oc = open_out_gen [ Open_wronly; Open_creat; Open_excl ] perm fname in let count = f oc in close_out oc; Printf.printf "%d %s saved to %s\n%!" count info fname let as_json to_string things oc = output_string oc (to_string things); List.length things let main version group dir uuid count file derive = let@ () = wrap_main in let module P = struct let version = version let group = get_mandatory_opt "--group" group let uuid = get_mandatory_opt "--uuid" uuid end in let module R = Make (P) (Random) () in let action = match (count, file, derive) with | Some n, None, None -> if n < 1 then failcmd "the argument of --count must be a positive number" else `Generate (generate_ids n) | None, Some f, None -> `Generate (string_of_file f |> Voter.list_of_string) | None, None, Some c -> `Derive c | _, _, _ -> failcmd "--count, --file and --derive are mutually exclusive" in match action with | `Derive c -> print_endline (R.derive c) | `Generate ids -> let c = R.generate ids in let timestamp = Printf.sprintf "%.0f" (Unix.time ()) in let base = dir // timestamp in save params_priv base (as_json string_of_private_credentials c.priv); save params_pub base (as_json string_of_public_credentials c.public_with_ids); let h = sha256_b64 (string_of_public_credentials c.public) in Printf.printf "The fingerprint of public credentials is %s\n%!" h let count_t = let doc = "Generate $(docv) credentials." in let the_info = Arg.info [ "count" ] ~docv:"N" ~doc in Arg.(value & opt (some int) None the_info) let file_t = let doc = "Read identities from $(docv). One credential will be generated for each \ line of $(docv)." in let the_info = Arg.info [ "file" ] ~docv:"FILE" ~doc in Arg.(value & opt (some file) None the_info) let derive_t = let doc = "Derive the public key associated to a specific $(docv)." in let the_info = Arg.info [ "derive" ] ~docv:"PRIVATE_CRED" ~doc in Arg.(value & opt (some string) None the_info) let cmd = let doc = "generate credentials" in let man = [ `S "DESCRIPTION"; `P "This command is run by a credential authority to generate \ credentials for a specific election. The generated private \ credentials are stored in $(i,T.privcreds), where $(i,T) is a \ timestamp. $(i,T.privcreds) contains one credential per line. Each \ voter must be sent a credential, and $(i,T.privcreds) must be \ destroyed after dispatching is done. The associated public keys are \ stored in $(i,T.pubcreds) and must be sent to the election \ administrator."; ] @ common_man in Cmd.v (Cmd.info "generate-credentials" ~doc ~man) Term.( ret (const main $ version_t $ group_t $ dir_t $ uuid_t $ count_t $ file_t $ derive_t)) end module Mktrustees : CMDLINER_MODULE = struct let main dir = let@ () = wrap_main in let get_public_keys () = Some (lines_of_file (dir // "public_keys.jsons")) in let get_threshold () = let fn = dir // "threshold.json" in if Sys.file_exists fn then Some (string_of_file fn) else None in let get_trustees () = let singles = match get_public_keys () with | None -> [] | Some t -> t |> List.map (trustee_public_key_of_string Yojson.Safe.read_json) |> List.map (fun x -> `Single x) in let pedersens = match get_threshold () with | None -> [] | Some t -> t |> threshold_parameters_of_string Yojson.Safe.read_json |> fun x -> [ `Pedersen x ] in match singles @ pedersens with | [] -> failwith "trustees are missing" | trustees -> string_of_trustees Yojson.Safe.write_json trustees in let trustees = get_trustees () in let oc = open_out (dir // "trustees.json") in output_string oc trustees; output_char oc '\n'; close_out oc let cmd = let doc = "create a trustee parameter file" in let man = [ `S "DESCRIPTION"; `P "This command reads $(i,public_keys.jsons) and $(i,threshold.json) \ (if any). It then generates an $(i,trustees.json) file."; ] @ common_man in Cmd.v (Cmd.info "make-trustees" ~doc ~man) Term.(ret (const main $ dir_t)) end module Mkelection : CMDLINER_MODULE = struct open Tool_mkelection let main dir group version uuid template = let@ () = wrap_main in let module P = struct let version = version let group = get_mandatory_opt "--group" group let uuid = get_mandatory_opt "--uuid" uuid let template = get_mandatory_opt "--template" template |> string_of_file let get_trustees () = let fn = dir // "trustees.json" in if Sys.file_exists fn then string_of_file fn else failwith "trustees are missing" end in let module R = (val make (module P : PARAMS) : S) in let params = R.mkelection () in let oc = open_out (dir // "election.json") in output_string oc params; output_char oc '\n'; close_out oc let template_t = let doc = "Read election template from file $(docv)." in Arg.( value & opt (some file) None & info [ "template" ] ~docv:"TEMPLATE" ~doc) let cmd = let doc = "create an election public parameter file" in let man = [ `S "DESCRIPTION"; `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 Cmd.v (Cmd.info "make-election" ~doc ~man) Term.( ret (const main $ dir_t $ group_t $ version_t $ uuid_t $ template_t)) end module GenerateToken : CMDLINER_MODULE = struct let main length = let@ () = wrap_main in let module X = MakeGenerateToken (Random) in X.generate_token ~length () |> print_endline let length_t = let doc = "Token length." in Arg.(value & opt int 14 & info [ "length" ] ~docv:"L" ~doc) let cmd = let doc = "generate a token" in let man = [ `S "DESCRIPTION"; `P "This command generates a random token suitable for an election \ identifier."; ] @ common_man in Cmd.v (Cmd.info "generate-token" ~doc ~man) Term.(ret (const main $ length_t)) end let cmd = let doc = "election setup commands" in let man = common_man in let info = Cmd.info "setup" ~doc ~man in let cmds = [ Tkeygen.cmd; Ttkeygen.cmd; Credgen.cmd; Mktrustees.cmd; Mkelection.cmd; GenerateToken.cmd; ] in Cmd.group info cmds belenios-2.2-10-gbb6b7ea8/src/tool/main.mli0000644000175000017500000000002614476041226017267 0ustar stephsteph(* empty interface *) belenios-2.2-10-gbb6b7ea8/src/tool/main.ml0000644000175000017500000002772614476041226017136 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module B = Belenios open Belenios_platform.Platform open Belenios_core.Serializable_j open Belenios_core.Common open Common open Cmdliner module Bench : CMDLINER_MODULE = struct let gen n i = let j = n * i in let xs = Array.init n (fun i -> sha256_hex (string_of_int (j + i))) in Z.of_hex (xs |> Array.to_list |> String.concat "") let bench_group version group n = let@ () = wrap_main in let group = get_mandatory_opt "--group" group in let module G = (val B.Group.of_string ~version group) in let byte_length = (Z.bit_length G.q / 8) + 1 in let xs = Array.init n (fun i -> Z.(gen byte_length i mod G.q)) in let start = Unix.gettimeofday () in let ys = Array.map (fun x -> G.(g **~ x)) xs in let stop = Unix.gettimeofday () in let delta_exp = stop -. start in let start = Unix.gettimeofday () in ignore (Array.fold_left G.( *~ ) G.one ys); let stop = Unix.gettimeofday () in let delta_mul = stop -. start in Printf.printf "Bench result (size %d): %.3f s (exp), %.3f s (mul)!\n" n delta_exp delta_mul let group_t = let doc = "Use group $(docv)." in Arg.(value & opt (some string) None & info [ "group" ] ~docv:"GROUP" ~doc) let version_t = let doc = "Use protocol version $(docv)." in Arg.( value & opt int (List.hd supported_crypto_versions) & info [ "protocol-version" ] ~docv:"VERSION" ~doc) let count_t = let doc = "Do $(docv) iterations." in Arg.(value & opt int 1000 & info [ "count" ] ~docv:"COUNT" ~doc) let group_cmd = let doc = "bench group operations" in let man = [ `S "DESCRIPTION"; `P "This command performs a benchmark of group exponentiation and \ multiplication."; ] @ common_man in Cmd.v (Cmd.info "group" ~doc ~man) Term.(ret (const bench_group $ version_t $ group_t $ count_t)) let cmd = let doc = "benchmarking commands" in let man = common_man in let info = Cmd.info "bench" ~doc ~man in let cmds = [ group_cmd ] in Cmd.group info cmds end module Shasum : CMDLINER_MODULE = struct let main () = wrap_main (fun () -> chars_of_stdin () |> sha256_b64 |> print_endline) let cmd = let doc = "compute SHA256 of standard input and encode it in Base64Compact" in let man = [ `S "DESCRIPTION"; `P "This command compute the SHA256 of standard input and encode it in \ Base64Compact. This computation is frequent when auditing an \ election. This single shell command is equivalent to the following \ shell pipeline:"; `Pre "sha256sum | xxd -r -p | base64 | tr -d \"=\""; `P "but does not need each individual command to be available."; ] @ common_man in Cmd.v (Cmd.info "sha256-b64" ~doc ~man) Term.(ret (const main $ const ())) end module Events : CMDLINER_MODULE = struct let init dir election trustees public_creds = let@ () = wrap_main in let election = string_of_file election in let trustees = string_of_file trustees in let public_creds = string_of_file public_creds |> public_credentials_of_string |> List.map strip_cred |> string_of_public_credentials in let file = let election = B.Election.of_string election in (dir // Uuid.unwrap election.e_uuid) ^ ".bel" in ignore (Tool_events.init ~file ~election ~trustees ~public_creds) let add_event dir event_typ = let@ () = wrap_main in let file = dir // find_bel_in_dir dir in let index = Tool_events.get_index ~file in let event_typ = get_mandatory_opt "--type" event_typ |> Printf.sprintf "%S" |> event_type_of_string in let payloads = lines_of_stdin () in let payload = match List.rev payloads with | x :: _ -> Some (Hash.hash_string x) | _ -> None in let open Tool_events in List.map (fun x -> Data x) payloads @ [ Event (event_typ, payload) ] |> append index let election_t = let doc = "Read election parameters from file $(docv)." in Arg.( value & opt file "election.json" & info [ "election" ] ~docv:"ELECTION" ~doc) let trustees_t = let doc = "Read trustees from file $(docv)." in Arg.( value & opt file "trustees.json" & info [ "trustees" ] ~docv:"TRUSTEES" ~doc) let public_creds_t = let doc = "Read public credentials from file $(docv)." in Arg.( value & opt file "public_creds.json" & info [ "public-creds" ] ~docv:"PUBLIC-CREDS" ~doc) let event_typ_t = let doc = "Type of event." in Arg.(value & opt (some string) None & info [ "type" ] ~docv:"TYPE" ~doc) let init_cmd = let doc = "initialize events" in let man = [ `S "DESCRIPTION"; `P "This command creates $(i,UUID.bel) from election setup files."; ] @ common_man in Cmd.v (Cmd.info "init" ~doc ~man) Term.(ret (const init $ dir_t $ election_t $ trustees_t $ public_creds_t)) let add_event_cmd = let doc = "add an event" in let man = [ `S "DESCRIPTION"; `P "This command adds a new event to $(i,UUID.bel). If stdin is \ non-empty, each of its lines is added to $(i,UUID.bel) prior to the \ event, and the last line is added as payload of the event."; ] @ common_man in Cmd.v (Cmd.info "add-event" ~doc ~man) Term.(ret (const add_event $ dir_t $ event_typ_t)) let cmd = let doc = "manage archives" in let man = common_man in let info = Cmd.info "archive" ~doc ~man in Cmd.group info [ init_cmd; add_event_cmd; Tool_mkarchive.cmd ] end module Methods : CMDLINER_MODULE = struct let schulze nchoices blank_allowed = let@ () = wrap_main in let ballots = chars_of_stdin () |> condorcet_ballots_of_string in let nchoices = if nchoices = 0 then if Array.length ballots > 0 then Array.length ballots.(0) else 0 else nchoices in if nchoices <= 0 then failcmd "invalid --nchoices parameter (or could not infer it)" else let blank_allowed = match blank_allowed with | None -> failcmd "--blank-allowed is missing" | Some b -> b in ballots |> Belenios_core.Schulze.compute ~nchoices ~blank_allowed |> string_of_schulze_result |> print_endline let mj nchoices ngrades blank_allowed = let@ () = wrap_main in let ballots = chars_of_stdin () |> mj_ballots_of_string in let nchoices = if nchoices = 0 then if Array.length ballots > 0 then Array.length ballots.(0) else 0 else nchoices in if nchoices <= 0 then failcmd "invalid --nchoices parameter (or could not infer it)" else let ngrades = match ngrades with | None -> failcmd "--ngrades is missing" | Some i -> if i > 0 then i else failcmd "invalid --ngrades parameter" in let blank_allowed = match blank_allowed with | None -> failcmd "--blank-allowed is missing" | Some b -> b in ballots |> Belenios_core.Majority_judgment.compute ~nchoices ~ngrades ~blank_allowed |> string_of_mj_result |> print_endline let stv nseats = let@ () = wrap_main in let nseats = match nseats with | None -> failcmd "--nseats is missing" | Some i -> if i > 0 then i else failcmd "invalid --nseats parameter" in chars_of_stdin () |> stv_raw_ballots_of_string |> Belenios_core.Stv.compute ~nseats |> string_of_stv_result |> print_endline let nchoices_t = let doc = "Number of choices. If 0, try to infer it." in Arg.(value & opt int 0 & info [ "nchoices" ] ~docv:"N" ~doc) let ngrades_t = let doc = "Number of grades." in Arg.(value & opt (some int) None & info [ "ngrades" ] ~docv:"G" ~doc) let nseats_t = let doc = "Number of seats." in Arg.(value & opt (some int) None & info [ "nseats" ] ~docv:"N" ~doc) let blank_allowed_t = let doc = "Is blank allowed?" in Arg.(value & opt (some bool) None & info [ "blank-allowed" ] ~docv:"B" ~doc) let schulze_cmd = let doc = "compute Schulze result" in let man = [ `S "DESCRIPTION"; `P "This command reads on standard input JSON-formatted ballots and \ interprets them as Condorcet rankings on $(i,N) choices. It then \ computes the result according to the Schulze method and prints it \ on standard output."; ] @ common_man in Cmd.v (Cmd.info "schulze" ~doc ~man) Term.(ret (const schulze $ nchoices_t $ blank_allowed_t)) let mj_cmd = let doc = "compute Majority Judgment result" in let man = [ `S "DESCRIPTION"; `P "This command reads on standard input JSON-formatted ballots and \ interprets them as grades (ranging from 1 (best) to $(i,G) (worst)) \ given to $(i,N) choices. It then computes the result according to \ the Majority Judgment method and prints it on standard output."; ] @ common_man in Cmd.v (Cmd.info "majority-judgment" ~doc ~man) Term.(ret (const mj $ nchoices_t $ ngrades_t $ blank_allowed_t)) let stv_cmd = let doc = "compute Single Transferable Vote result" in let man = [ `S "DESCRIPTION"; `P "This command reads on standard input JSON-formatted ballots and \ interprets them as rankings of choices (ranging from 1 (best) to \ $(i,X) (worst)). It then computes the result according to the \ Single Transferable Vote method and prints it on standard output."; ] @ common_man in Cmd.v (Cmd.info "stv" ~doc ~man) Term.(ret (const stv $ nseats_t)) let cmd = let doc = "compute result with specific counting methods" in let man = common_man in let info = Cmd.info "method" ~doc ~man in Cmd.group info [ schulze_cmd; mj_cmd; stv_cmd ] end let cmds = [ Bench.cmd; Shasum.cmd; Setup.cmd; Election.cmd; Events.cmd; Methods.cmd; Sealing.cmd; ] let default_cmd = let open Belenios_platform.Version in let version = Printf.sprintf "%s (%s)" version build in let version = if debug then version ^ " [debug]" else version in let doc = "election management tool" in let man = common_man in ( Term.(ret (const (`Help (`Pager, None)))), Cmd.info "belenios-tool" ~version ~doc ~man ) let root_cmd = let default, i = default_cmd in Cmd.(group ~default i cmds) let () = exit (Cmd.eval root_cmd) belenios-2.2-10-gbb6b7ea8/src/tool/tool_election_data.ml0000644000175000017500000002610314476041226022026 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module B = Belenios open Belenios_core.Serializable_j open Belenios_core.Signatures open Belenios_core.Common open Common module type GETTERS = sig val fsck : unit -> unit val setup_data : setup_data val raw_election : string val get_trustees : unit -> string option val get_public_creds : unit -> string list option val get_ballots : unit -> string list option val get_shuffles : unit -> (hash * hash owned * string) list option val get_pds : unit -> (hash * hash owned * string) list option val get_result : unit -> string option end module type PARAMS = sig val file : string end module MakeGetters (X : PARAMS) : GETTERS = struct let index = Tool_events.get_index ~file:X.file let roots = Tool_events.get_roots index let get_data x = Tool_events.get_data index x let fsck () = Tool_events.fsck index let setup_data = match roots.roots_setup_data with | None -> failcmd "setup data are missing" | Some x -> ( match get_data x with | None -> failcmd "could not get setup data" | Some x -> setup_data_of_string x) let raw_election = match get_data setup_data.setup_election with | None -> failcmd "could not get election" | Some x -> x let get_public_creds () = get_data setup_data.setup_credentials |> Option.map public_credentials_of_string let get_trustees () = get_data setup_data.setup_trustees let get_ballots () = match roots.roots_last_ballot_event with | None -> Some [] | Some x -> Some (Tool_events.fold_on_event_payloads index `Ballot x (fun x accu -> x :: accu) []) let get_shuffles () = let& x = roots.roots_last_shuffle_event in Tool_events.fold_on_event_payload_hashes index `Shuffle x (fun x accu -> match get_data x with | None -> failwith "could not get shuffle" | Some y -> ( let owned = owned_of_string read_hash y in match get_data owned.owned_payload with | None -> failwith "could not get shuffle payload" | Some z -> (x, owned, z) :: accu)) [] |> fun x -> Some x let get_pds () = let& x = roots.roots_last_pd_event in Tool_events.fold_on_event_payload_hashes index `PartialDecryption x (fun x accu -> match get_data x with | None -> failwith "could not get partial decryption" | Some y -> ( let owned = owned_of_string read_hash y in match get_data owned.owned_payload with | None -> failwith "could not get partial decryption payload" | Some z -> (x, owned, z) :: accu)) [] |> fun x -> Some x let get_result () = let& x = roots.roots_result in get_data x end module type ELECTION_DATA = sig type t type r val trustees_as_string : string option val trustees : t trustees option val pks : t array Lazy.t val raw_public_creds : string list option Lazy.t val public_creds_weights : (bool * weight SMap.t) option Lazy.t val raw_ballots : string list option Lazy.t val verified_ballots : (hash * string * weight * string) list Lazy.t val unverified_ballots : (hash * string * weight * string) list Lazy.t val string_of_cast_error : cast_error -> string val pre_cast : ?skip_ballot_check:bool -> SSet.t -> string -> (hash * (string * weight * string), cast_error) result val raw_encrypted_tally : (t encrypted_tally * hash sized_encrypted_tally) Lazy.t val raw_shuffles : (hash * hash owned * string) list option Lazy.t val shuffles : t shuffle list option Lazy.t val shuffles_hash : string list option Lazy.t val encrypted_tally : (t encrypted_tally * hash sized_encrypted_tally) Lazy.t val pds : (hash * hash owned * string) list option Lazy.t val result : r election_result option Lazy.t val fsck : unit -> unit val election_hash : hash end module Make (Getters : GETTERS) (Election : ELECTION) : ELECTION_DATA with type t := Election.G.t with type r := Election.result = struct include Getters include Election let trustees_as_string = get_trustees () let trustees = Option.map (trustees_of_string (sread G.of_string)) trustees_as_string let pks = lazy (let public_keys_with_pok = trustees |> Option.map (fun x -> x |> List.map (function | `Single x -> [ x ] | `Pedersen t -> Array.to_list t.t_verification_keys) |> List.flatten |> Array.of_list) in let public_keys = Option.map (Array.map (fun pk -> pk.trustee_public_key)) public_keys_with_pok in match public_keys with | Some pks -> pks | None -> failwith "missing public keys") module PPC = Belenios_core.Credential.MakeParsePublicCredential (G) let raw_public_creds = lazy (get_public_creds ()) let public_creds_weights = lazy (Lazy.force raw_public_creds |> Option.map (List.fold_left (fun (has_weights, accu) x -> let has_weights = has_weights || String.index_opt x ',' <> None in match PPC.parse_public_credential x with | Some (w, y) -> let y = G.to_string y in if SMap.mem y accu then Printf.ksprintf failwith "duplicate credential: %s" y else (has_weights, SMap.add y w accu) | None -> Printf.ksprintf failwith "%s is not a valid public credential" x) (false, SMap.empty))) let public_creds = lazy (Lazy.force public_creds_weights |> Option.map snd) let raw_ballots = lazy (get_ballots ()) let string_of_cast_error = function | `SerializationError e -> Printf.sprintf "ill-formed ballot: %s" (Printexc.to_string e) | `NonCanonical -> "ballot not in canonical form" | `InvalidBallot -> "invalid ballot" | `InvalidCredential -> "invalid credential" | `WrongCredential -> "wrong credential" | `WrongWeight -> "wrong weight" | `UsedCredential -> "used credential" | `RevoteNotAllowed -> "revote not allowed" | `DuplicateBallot -> "duplicate ballot" | `ExpiredBallot -> "expired ballot" | `WrongUsername -> "wrong username" let pre_cast ?(skip_ballot_check = false) ballot_box rawballot = let hash = Hash.hash_string rawballot in let ballot_id = Hash.to_b64 hash in let@ creds cont = match Lazy.force public_creds with | None -> failwith "missing public credentials" | Some creds -> cont creds in let is_duplicate = SSet.mem ballot_id ballot_box in let@ rc cont = match (is_duplicate, E.check_rawballot rawballot) with | true, _ -> Error `DuplicateBallot | _, (Error _ as e) -> e | _, Ok rc -> cont rc in match SMap.find_opt rc.rc_credential creds with | None -> Error `InvalidCredential | Some w when skip_ballot_check || rc.rc_check () -> Ok (hash, (rc.rc_credential, w, rawballot)) | Some _ -> Error `InvalidBallot let collect_ballots ?(skip_ballot_check = false) () = let ballot_box = let rec cast_all accu seen = function | [] -> accu | b :: bs -> ( match pre_cast seen b ~skip_ballot_check with | Error e -> Printf.ksprintf failwith "error while casting ballot %s: %s" (sha256_b64 b) (string_of_cast_error e) | Ok (hash, x) -> let ballot_id = Hash.to_b64 hash in cast_all ((hash, x) :: accu) (SSet.add ballot_id seen) bs) in match Lazy.force raw_ballots with | None -> [] | Some bs -> cast_all [] SSet.empty bs in List.fold_left (fun ((seen, bs) as accu) (h, (credential, w, b)) -> if SSet.mem credential seen then accu else (SSet.add credential seen, (h, credential, w, b) :: bs)) (SSet.empty, []) ballot_box |> snd let verified_ballots = lazy (collect_ballots ()) let unverified_ballots = lazy (collect_ballots ~skip_ballot_check:true ()) let raw_encrypted_tally = lazy (let ballots = Lazy.force verified_ballots |> List.rev_map (fun (_, _, w, b) -> (w, ballot_of_string b)) in let sized_total_weight = let open Weight in List.fold_left (fun accu (w, _) -> accu + w) zero ballots in let encrypted_tally = E.process_ballots ballots in ( encrypted_tally, { sized_num_tallied = List.length ballots; sized_total_weight; sized_encrypted_tally = Hash.hash_string (string_of_encrypted_tally (swrite G.to_string) encrypted_tally); } )) let raw_shuffles = lazy (get_shuffles ()) let shuffles_as_text = lazy (Lazy.force raw_shuffles |> Option.map (List.map (fun (_, _, x) -> x))) let shuffles = lazy (Lazy.force shuffles_as_text |> Option.map (List.map (shuffle_of_string (sread G.of_string)))) let shuffles_hash = lazy (Lazy.force shuffles_as_text |> Option.map (List.map sha256_b64)) let encrypted_tally = lazy (let raw_encrypted_tally, ntally = Lazy.force raw_encrypted_tally in match Option.map List.rev (Lazy.force shuffles) with | Some (s :: _) -> ( E.merge_nh_ciphertexts s.shuffle_ciphertexts raw_encrypted_tally, ntally ) | _ -> (raw_encrypted_tally, ntally)) let pds = lazy (get_pds ()) let result = lazy (get_result () |> Option.map (election_result_of_string read_result)) let fsck = fsck let election_hash = setup_data.setup_election end belenios-2.2-10-gbb6b7ea8/src/tool/election.ml0000644000175000017500000002707614476041226020012 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common open Belenios_core.Serializable_j open Common open Tool_election open Cmdliner let main url dir action = let@ () = wrap_main in let dir, cleanup = match (url, dir) with | Some _, None -> let tmp = Filename.temp_file "belenios" "" in Unix.unlink tmp; Unix.mkdir tmp 0o700; (tmp, true) | None, None -> (Filename.current_dir_name, false) | _, Some d -> (d, false) in Printf.eprintf "I: using directory %s\n%!" dir; let file = match url with | None -> find_bel_in_dir dir | Some u -> ( match download dir u with | Some x -> x | None -> failwith "error while downloading") in let module X = Make (struct let file = dir // file end) () in (match action with | `Vote (privcred, choice) -> let choice = match load_from_file plaintext_of_string choice with | Some [ c ] -> c | _ -> failwith "invalid choice file" and privcred = match load_from_file (fun x -> x) privcred with | Some [ cred ] -> cred | _ -> failwith "invalid credential" in print_endline (X.vote (Some privcred) choice) | `Decrypt (i, privkey) -> let privkey = match load_from_file (fun x -> x) privkey with | Some [ privkey ] -> privkey | _ -> failwith "invalid private key" in print_endline2 (X.decrypt i privkey) | `TDecrypt (i, key, pdk) -> let key = string_of_file key in let pdk = string_of_file pdk in print_endline2 (X.tdecrypt i key pdk) | `VerifyBallot b -> let ballot = match load_from_file (fun x -> x) b with | Some [ ballot ] -> ballot | _ -> failwith "invalid ballot file" in X.verify_ballot ballot | `Verify skip_ballot_check -> X.verify ~skip_ballot_check () | `ComputeResult -> print_endline (X.compute_result ()) | `Shuffle trustee_id -> print_endline2 (X.shuffle_ciphertexts trustee_id) | `Checksums -> X.checksums () |> print_endline | `ComputeVoters privcreds -> X.compute_voters privcreds |> List.iter print_endline | `ComputeBallotSummary -> X.compute_ballot_summary () |> print_endline | `ComputeEncryptedTally -> print_endline2 (X.compute_encrypted_tally ())); if cleanup then rm_rf dir let privcred_t = let doc = "Read private credential from file $(docv)." in let the_info = Arg.info [ "privcred" ] ~docv:"PRIV_CRED" ~doc in Arg.(value & opt (some file) None the_info) let privkey_t = let doc = "Read private key from file $(docv)." in let the_info = Arg.info [ "privkey" ] ~docv:"PRIV_KEY" ~doc in Arg.(value & opt (some file) None the_info) let choice_t = let doc = "Read voting choice from file $(docv)." in let the_info = Arg.info [ "choice" ] ~docv:"CHOICE" ~doc in Arg.(value & opt (some file) None the_info) let ballot_t = let doc = "Read ballot from file $(docv)." in 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 privcreds_t = let doc = "Read private credentials from file $(docv)." in let the_info = Arg.info [ "privcreds" ] ~docv:"PRIVCREDS" ~doc in Arg.(value & opt (some file) None the_info) let trustee_id_t = let doc = "Trustee identifier (an integer)." in let the_info = Arg.info [ "trustee-id" ] ~docv:"TRUSTEE-ID" ~doc in Arg.(value & opt (some int) None the_info) let skip_ballot_check_t = let doc = "Skip checking the content of each ballot." in let the_info = Arg.info [ "skip-ballot-check" ] ~docv:"SKIP-BALLOT-CHECK" ~doc in Arg.(value & flag the_info) let vote_cmd = let doc = "create a ballot" in let man = [ `S "DESCRIPTION"; `P "This command creates a ballot and prints it on standard output."; ] @ common_man in let main = Term.const (fun u d p c -> let p = get_mandatory_opt "--privcred" p in let c = get_mandatory_opt "--choice" c in main u d (`Vote (p, c))) in Cmd.v (Cmd.info "generate-ballot" ~doc ~man) Term.(ret (main $ url_t $ optdir_t $ privcred_t $ choice_t)) let verify_ballot_cmd = let doc = "verify a single ballot" in let man = [ `S "DESCRIPTION"; `P "This command performs verifications on a single ballot."; ] @ common_man in let main = Term.const (fun u d b -> let b = get_mandatory_opt "--encrypted-ballot" b in main u d (`VerifyBallot b)) in Cmd.v (Cmd.info "verify-ballot" ~doc ~man) Term.(ret (main $ url_t $ optdir_t $ ballot_t)) let verify_cmd = let doc = "verify election data" in let man = [ `S "DESCRIPTION"; `P "This command performs all possible verifications." ] @ common_man in let main = Term.const (fun u d s -> main u d (`Verify s)) in Cmd.v (Cmd.info "verify" ~doc ~man) Term.(ret (main $ url_t $ optdir_t $ skip_ballot_check_t)) let decrypt_man = [ `S "DESCRIPTION"; `P "This command is run by each trustee to perform a partial decryption."; ] @ common_man let decrypt_cmd = let doc = "perform partial decryption" in let main = Term.const (fun u d i p -> let i = get_mandatory_opt "--trustee-id" i in let p = get_mandatory_opt "--privkey" p in main u d (`Decrypt (i, p))) in Cmd.v (Cmd.info "decrypt" ~doc ~man:decrypt_man) Term.(ret (main $ url_t $ optdir_t $ trustee_id_t $ privkey_t)) let tdecrypt_cmd = let doc = "perform partial decryption (threshold version)" in let main = Term.const (fun u d i k pdk -> let i = get_mandatory_opt "--trustee-id" i in let k = get_mandatory_opt "--key" k in let pdk = get_mandatory_opt "--decryption-key" pdk in main u d (`TDecrypt (i, k, pdk))) in Cmd.v (Cmd.info "decrypt-threshold" ~doc ~man:decrypt_man) Term.(ret (main $ url_t $ optdir_t $ trustee_id_t $ key_t $ pdk_t)) let compute_result_cmd = let doc = "computes the result of an election" in let man = [ `S "DESCRIPTION"; `P "This command computes the result of an election. It assumes all \ necessary partial decryptions have been done, checks them, combines \ them into the final tally and prints the result to standard output."; ] @ common_man in Cmd.v (Cmd.info "compute-result" ~doc ~man) Term.(ret (const main $ url_t $ optdir_t $ const `ComputeResult)) let shuffle_cmd = let doc = "shuffle ciphertexts" in let man = [ `S "DESCRIPTION"; `P "This command shuffles non-homomorphic ciphertexts and prints on \ standard output the shuffle proof and the shuffled ciphertexts."; ] @ common_man in let main = Term.const (fun u d i -> let i = get_mandatory_opt "--trustee-id" i in main u d (`Shuffle i)) in Cmd.v (Cmd.info "shuffle" ~doc ~man) Term.(ret (main $ url_t $ optdir_t $ trustee_id_t)) let checksums_cmd = let doc = "compute checksums" in let man = [ `S "DESCRIPTION"; `P "This command computes checksums needed to audit an election."; ] @ common_man in Cmd.v (Cmd.info "compute-checksums" ~doc ~man) Term.(ret (const main $ url_t $ optdir_t $ const `Checksums)) let compute_voters_cmd = let doc = "compute actual voters" in let man = [ `S "DESCRIPTION"; `P "This command computes the list of voters that actually voted in an \ election, from the list of ballots and private credentials."; ] @ common_man in let main = Term.const (fun u d privcreds -> let privcreds = get_mandatory_opt "--privcreds" privcreds |> string_of_file |> Yojson.Safe.from_string |> key_value_list_of_json in main u d (`ComputeVoters privcreds)) in Cmd.v (Cmd.info "compute-voters" ~doc ~man) Term.(ret (main $ url_t $ optdir_t $ privcreds_t)) let compute_ballot_summary_cmd = let doc = "compute ballot summary" in let man = [ `S "DESCRIPTION"; `P "This command compute the hash (also known as smart ballot tracker) \ and weight of all ballots."; ] @ common_man in Cmd.v (Cmd.info "compute-ballot-summary" ~doc ~man) Term.(ret (const main $ url_t $ optdir_t $ const `ComputeBallotSummary)) let compute_encrypted_tally_cmd = let doc = "compute encrypted tally" in let man = [ `S "DESCRIPTION"; `P "This command computes the encrypted tally of the election."; ] @ common_man in let main = Term.const (fun u d -> main u d `ComputeEncryptedTally) in Cmd.v (Cmd.info "compute-encrypted-tally" ~doc ~man) Term.(ret (main $ url_t $ optdir_t)) module Verifydiff : CMDLINER_MODULE = struct open Tool_verifydiff let main dir1 dir2 = let@ () = wrap_main in match (dir1, dir2) with | Some dir1, Some dir2 -> verifydiff dir1 dir2 | _, _ -> failcmd "--dir1 or --dir2 is missing" let dir1_t = let doc = "First directory to compare." in Arg.(value & opt (some dir) None & info [ "dir1" ] ~docv:"DIR1" ~doc) let dir2_t = let doc = "Second directory to compare." in Arg.(value & opt (some dir) None & info [ "dir2" ] ~docv:"DIR2" ~doc) let cmd = let doc = "verify an election directory update" in let man = [ `S "DESCRIPTION"; `P "This command is run by an auditor on two directories $(i,DIR1) and \ $(i,DIR2). It checks that $(i,DIR2) is a valid update of $(i,DIR1)."; ] @ common_man in Cmd.v (Cmd.info "verify-diff" ~doc ~man) Term.(ret (const main $ dir1_t $ dir2_t)) end let cmds = [ vote_cmd; verify_ballot_cmd; verify_cmd; decrypt_cmd; tdecrypt_cmd; compute_result_cmd; shuffle_cmd; checksums_cmd; compute_voters_cmd; compute_ballot_summary_cmd; compute_encrypted_tally_cmd; Verifydiff.cmd; ] let cmd = let doc = "election management commands" in let man = common_man in let info = Cmd.info "election" ~doc ~man in Cmd.group info cmds belenios-2.2-10-gbb6b7ea8/src/tool/tool_verifydiff.ml0000644000175000017500000000472014476041226021371 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common open Common type verifydiff_error = NotPrefix | ErrorInFirst exception VerifydiffError of verifydiff_error let explain_error = function | NotPrefix -> "first is not a prefix of second" | ErrorInFirst -> "error in first" let () = Printexc.register_printer (function | VerifydiffError e -> Some ("verify-diff error: " ^ explain_error e) | _ -> None) let verifydiff dir1 dir2 = let file1 = dir1 // find_bel_in_dir dir1 in let file2 = dir2 // find_bel_in_dir dir2 in let () = let open Tool_events in let index1 = get_index ~file:file1 in let index2 = get_index ~file:file2 in if try fsck index1; false with _ -> true then raise (VerifydiffError ErrorInFirst); if not (starts_with ~prefix:index1 index2) then raise (VerifydiffError NotPrefix) in let module X = Tool_election.Make (struct let file = file2 end) () in X.verify () belenios-2.2-10-gbb6b7ea8/src/tool/tool_election_data.mli0000644000175000017500000000657714476041226022214 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module B = Belenios open Belenios_core.Serializable_j open Belenios_core.Signatures open Belenios_core.Common module type PARAMS = sig val file : string end module type GETTERS = sig val fsck : unit -> unit val setup_data : setup_data val raw_election : string val get_trustees : unit -> string option val get_public_creds : unit -> string list option val get_ballots : unit -> string list option val get_shuffles : unit -> (hash * hash owned * string) list option val get_pds : unit -> (hash * hash owned * string) list option val get_result : unit -> string option end module MakeGetters (X : PARAMS) : GETTERS module type ELECTION_DATA = sig type t type r val trustees_as_string : string option val trustees : t trustees option val pks : t array Lazy.t val raw_public_creds : string list option Lazy.t val public_creds_weights : (bool * weight SMap.t) option Lazy.t val raw_ballots : string list option Lazy.t val verified_ballots : (hash * string * weight * string) list Lazy.t val unverified_ballots : (hash * string * weight * string) list Lazy.t val string_of_cast_error : cast_error -> string val pre_cast : ?skip_ballot_check:bool -> SSet.t -> string -> (hash * (string * weight * string), cast_error) result val raw_encrypted_tally : (t encrypted_tally * hash sized_encrypted_tally) Lazy.t val raw_shuffles : (hash * hash owned * string) list option Lazy.t val shuffles : t shuffle list option Lazy.t val shuffles_hash : string list option Lazy.t val encrypted_tally : (t encrypted_tally * hash sized_encrypted_tally) Lazy.t val pds : (hash * hash owned * string) list option Lazy.t val result : r election_result option Lazy.t val fsck : unit -> unit val election_hash : hash end module Make (Getters : GETTERS) (Election : ELECTION) : ELECTION_DATA with type t := Election.G.t with type r := Election.result belenios-2.2-10-gbb6b7ea8/src/tool/random.mli0000644000175000017500000000005014476041226017620 0ustar stephstephinclude Belenios_core.Signatures.RANDOM belenios-2.2-10-gbb6b7ea8/src/tool/common.ml0000644000175000017500000001234614476041226017472 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Common let print_endline2 (a, b) = print_endline a; print_endline b let lines_of_stdin () = let rec loop accu = match input_line stdin with | line -> loop (line :: accu) | exception End_of_file -> List.rev accu in loop [] let chars_of_stdin () = let buf = Buffer.create 1024 in let rec loop () = match input_char stdin with | c -> Buffer.add_char buf c; loop () | exception End_of_file -> () in loop (); Buffer.contents buf let download dir url = let url, file = match String.split_on_char '/' url |> List.rev with | "" :: uuid :: _ -> (url, uuid ^ ".bel") | last :: rest -> ( match Filename.chop_suffix_opt ~suffix:".bel" last with | None -> (url ^ "/", last ^ ".bel") | Some uuid -> (String.concat "/" (List.rev ("" :: rest)), uuid ^ ".bel") ) | _ -> failwith "bad url" in Printf.eprintf "I: downloading %s%s...\n%!" url file; let target = dir // file in let command = Printf.sprintf "curl --silent --fail \"%s%s\" > \"%s\"" url file target in let r = Sys.command command in if r <> 0 then ( Sys.remove target; None) else Some file let rm_rf dir = let files = Sys.readdir dir in Array.iter (fun f -> Unix.unlink (dir // f)) files; Unix.rmdir dir exception Cmdline_error of string let failcmd fmt = Printf.ksprintf (fun x -> raise (Cmdline_error x)) fmt let get_mandatory_opt name = function | Some x -> x | None -> failcmd "%s is mandatory" name let key_value_list_of_json = function | `Assoc x as json -> x |> List.map (function | a, `String b -> (a, b) | _ -> failcmd "%s has not expected JSON type" (Yojson.Safe.to_string json)) | json -> failcmd "%s is not a proper JSON object" (Yojson.Safe.to_string json) let lines_of_file fname = let ic = open_in fname in let rec loop accu = match input_line ic with | line -> loop (line :: accu) | exception End_of_file -> close_in ic; List.rev accu in loop [] let string_of_file f = lines_of_file f |> String.concat "\n" let load_from_file of_string filename = if Sys.file_exists filename then ( Printf.eprintf "I: loading %s...\n%!" (Filename.basename filename); Some (lines_of_file filename |> List.rev_map of_string)) else None let find_bel_in_dir dir = match Sys.readdir dir |> Array.to_list |> List.filter (fun x -> Filename.check_suffix x ".bel") with | [ file ] -> file | _ -> Printf.ksprintf failwith "directory %s must contain a single .bel file" dir let wrap_main f = match f () with | () -> `Ok () | exception Cmdline_error e -> `Error (true, e) | exception Failure e -> `Error (false, e) | exception e -> `Error (false, Printexc.to_string e) let common_man = [ `S "MORE INFORMATION"; `P "This command is part of the Belenios command-line tool."; `P "To get more help on a specific subcommand, run:"; `P "$(b,belenios-tool) $(i,COMMAND) $(b,--help)"; `P "See $(i,https://www.belenios.org/)."; ] open Cmdliner module type CMDLINER_MODULE = sig val cmd : unit Cmd.t end let dir_t, optdir_t = let doc = "Use directory $(docv) for reading and writing election files." in let the_info = Arg.info [ "dir" ] ~docv:"DIR" ~doc in ( Arg.(value & opt dir Filename.current_dir_name the_info), Arg.(value & opt (some dir) None the_info) ) let url_t = let doc = "Download election files from $(docv)." in let the_info = Arg.info [ "url" ] ~docv:"URL" ~doc in Arg.(value & opt (some string) None the_info) 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) belenios-2.2-10-gbb6b7ea8/src/tool/tool_mkarchive.ml0000644000175000017500000000734214476041226021210 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Serializable_j open Belenios_core.Common open Common let get_last_event dir = let rec loop ((accu_event, accu_files) as accu) = function | [] -> accu | file :: files -> let accu_files = SSet.add file accu_files in let accu_event = if Filename.check_suffix file ".event.json" then let event_s = string_of_file (dir // file) in let event = event_of_string event_s in match accu_event with | Some old when old.event_height > event.event_height -> accu_event | _ -> Some event else accu_event in loop (accu_event, accu_files) files in loop (None, SSet.empty) (Sys.readdir dir |> Array.to_list) let mkarchive dir = let header = string_of_file (dir // "BELENIOS") |> archive_header_of_string in let last_event, files = get_last_event dir in let last_event = match last_event with Some x -> x | None -> failwith "no events found" in let module IoArchiver = struct include Tool_events.DirectMonad let get_hash hash = let hash_s = Hash.to_hex hash in let event_filename = hash_s ^ ".event.json" in let data_filename = hash_s ^ ".data.json" in if SSet.mem event_filename files then Some (string_of_file (dir // event_filename)) else if SSet.mem data_filename files then Some (string_of_file (dir // data_filename)) else None end in let module Archiver = Belenios_core.Archive.MakeArchiver (IoArchiver) (Tool_events.Writer) in set_binary_mode_out stdout true; Archiver.write_archive stdout header last_event let main dir = let@ () = wrap_main in mkarchive dir open Cmdliner let dir_t = let doc = "Read objects from directory $(docv)." in let the_info = Arg.info [ "dir" ] ~docv:"DIR" ~doc in Arg.(value & opt dir Filename.current_dir_name the_info) let cmd = let doc = "re-create an archive from an extracted archive" in let man = [ `S "DESCRIPTION"; `P "This command reads files from an extracted $(i,UUID.bel) and outputs \ (on standard output) a canonical archive containing the same files."; ] @ common_man in Cmd.v (Cmd.info "make" ~doc ~man) Term.(ret (const main $ dir_t)) belenios-2.2-10-gbb6b7ea8/src/tool/tool_events.mli0000644000175000017500000000461314476041226020712 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Signatures open Belenios_core.Serializable_t open Belenios_core.Archive type index val get_index : file:string -> index val get_data : index -> hash -> string option val get_event : index -> hash -> event option val get_roots : index -> roots val fold_on_event_payload_hashes : index -> event_type -> hash -> (hash -> 'a -> 'a) -> 'a -> 'a val fold_on_event_payloads : index -> event_type -> hash -> (string -> 'a -> 'a) -> 'a -> 'a val fsck : index -> unit val starts_with : prefix:index -> index -> bool type append_operation = Data of string | Event of event_type * hash option val append : index -> append_operation list -> unit val init : file:string -> election:string -> trustees:string -> public_creds:string -> index module DirectMonad : MONAD with type 'a t = 'a module Writer : ARCHIVE_WRITER with type 'a m := 'a and type archive = out_channel belenios-2.2-10-gbb6b7ea8/src/tool/tool_verifydiff.mli0000644000175000017500000000330014476041226021533 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) type verifydiff_error = NotPrefix | ErrorInFirst exception VerifydiffError of verifydiff_error val explain_error : verifydiff_error -> string val verifydiff : string -> string -> unit belenios-2.2-10-gbb6b7ea8/src/tool/sealing.ml0000644000175000017500000001157414476041226017626 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2022 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 Belenios_core.Serializable_j open Belenios_core.Common open Common let parse_config x = sealing_config_of_string x |> List.map (fun (r, i) -> (Str.regexp r, List.fold_left (Fun.flip SSet.add) SSet.empty i)) let find_ign cfg path = List.filter_map (fun (r, i) -> if Str.string_match r path 0 then Some i else None) cfg |> List.fold_left SSet.union SSet.empty let rec measure full cfg ign path = let make name x = if SSet.mem name ign then None else Some x in let st = Unix.LargeFile.lstat path in let st_contents = if SSet.mem "contents" ign then None else match st.st_kind with | S_CHR | S_BLK | S_FIFO | S_SOCK -> None | S_REG -> Some (`REG (Hash.hash_string (string_of_file path))) | S_LNK -> Some (`LNK (Unix.readlink path)) | S_DIR -> let files = Sys.readdir path |> Array.to_list |> List.filter (fun x -> x <> "." && x <> "..") |> List.sort String.compare |> List.map (fun x -> let path = path // x in let ign = find_ign cfg path in ((if full then path else x), measure full cfg ign path)) in Some (`DIR files) in let kind = match st.st_kind with | S_CHR -> `CHR | S_BLK -> `BLK | S_FIFO -> `FIFO | S_SOCK -> `SOCK | S_REG -> `REG | S_LNK -> `LNK | S_DIR -> `DIR in { st_dev = make "dev" st.st_dev; st_ino = make "ino" st.st_ino; st_kind = make "kind" kind; st_perm = make "perm" st.st_perm; st_nlink = make "nlink" st.st_nlink; st_uid = make "uid" st.st_uid; st_gid = make "gid" st.st_gid; st_rdev = make "rdev" st.st_rdev; st_size = make "size" st.st_size; st_atime = make "atime" st.st_atime; st_mtime = make "mtime" st.st_mtime; st_ctime = make "ctime" st.st_ctime; st_contents; } let main full cfg path = let cfg = match cfg with None -> [] | Some x -> parse_config (string_of_file x) in let ign = find_ign cfg path in let x = measure full cfg ign path in print_endline (string_of_stats x); `Ok () open Cmdliner let full_t = let doc = "Use full paths in directory contents." in let the_info = Arg.info [ "full-paths" ] ~doc in Arg.(value & flag the_info) let cfg_t = let doc = "Read configuration from $(docv). It must be a JSON file with a single \ object mapping regular expressions to properties that should be ignored. \ Regular expressions must be in OCaml's Str format. Possible properties \ are: dev, ino, kind, perm, nlink, uid, gid, rdev, size, atime, mtime, \ ctime and contents." in let the_info = Arg.info [ "config" ] ~docv:"CONFIG" ~doc in Arg.(value & opt (some file) None the_info) let path_t = let doc = "Measure path $(docv)." in let the_info = Arg.info [ "path" ] ~docv:"PATH" ~doc in Arg.(value & opt file Filename.current_dir_name the_info) let cmd = let doc = "measure a directory" in let man = [ `S "DESCRIPTION"; `P "This command recursively reads all the files in a directory and \ outputs (on standard output) a canonical representation of its \ contents. Given a suitable configuration file, this output can be a \ measure of the integrity of the system."; ] @ common_man in Cmd.v (Cmd.info "measure" ~doc ~man) Term.(ret (const main $ full_t $ cfg_t $ path_t)) belenios-2.2-10-gbb6b7ea8/src/tool/setup.mli0000644000175000017500000000003714476041226017505 0ustar stephstephinclude Common.CMDLINER_MODULE belenios-2.2-10-gbb6b7ea8/src/platform/0002755000175000017500000000000014476041226016513 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/platform/platform.mli0000644000175000017500000000547514476041226021053 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) val debug : string -> unit val sha256_hex : string -> string val pbkdf2_utf8 : iterations:int -> salt:string -> string -> string val aes_hex : key:string -> data:string -> string val encrypt : key:string -> iv:string -> plaintext:string -> string (** [key] and [iv] in hex, [plaintext] UTF8 string, [ciphertext] in hex *) val decrypt : key:string -> iv:string -> ciphertext:string -> string type rng val secure_rng : rng val pseudo_rng : string -> rng val random_string : rng -> int -> string module Z : sig type t val zero : t val one : t val of_int : int -> t val of_string : string -> t val of_hex : string -> t val ( + ) : t -> t -> t val ( - ) : t -> t -> t val ( * ) : t -> t -> t val ( / ) : t -> t -> t val ( mod ) : t -> t -> t val erem : t -> t -> t val to_int : t -> int val to_string : t -> string val to_hex : t -> string val compare : t -> t -> int val ( =% ) : t -> t -> bool val powm : t -> t -> t -> t val invert : t -> t -> t val probab_prime : t -> int -> int val bit_length : t -> int val of_bits : string -> t val shift_left : t -> int -> t val shift_right : t -> int -> t val logand : t -> t -> t val logor : t -> t -> t val logxor : t -> t -> t val hash_to_int : t -> int end val libsodium_stubs : unit -> (module Signatures.LIBSODIUM_STUBS) option belenios-2.2-10-gbb6b7ea8/src/platform/dune0000644000175000017500000000025714476041226017373 0ustar stephsteph(library (name belenios_platform) (public_name belenios-platform) (modules_without_implementation signatures) (virtual_modules platform)) (copy_files version/version.ml) belenios-2.2-10-gbb6b7ea8/src/platform/version.mli0000644000175000017500000000011314476041226020674 0ustar stephstephval version : string val build : string val spec : string val debug : bool belenios-2.2-10-gbb6b7ea8/src/platform/signatures.mli0000644000175000017500000000342414476041226021403 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2021-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) module type LIBSODIUM_STUBS = sig type scalar = bytes type point = bytes val bytes : unit -> int val scalarbytes : unit -> int val is_valid_point : point -> int val scalarmult : point -> scalar -> point -> int val add : point -> point -> point -> int end belenios-2.2-10-gbb6b7ea8/src/platform/js/0002755000175000017500000000000014476041226017127 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/platform/js/dune0000644000175000017500000000025214476041226020002 0ustar stephsteph(library (name belenios_platform_js) (public_name belenios-platform-js) (implements belenios_platform) (libraries js_of_ocaml) (preprocess (pps js_of_ocaml-ppx))) belenios-2.2-10-gbb6b7ea8/src/platform/js/platform.ml0000644000175000017500000002234514476041226021311 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 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 Js_of_ocaml let belenios = Js.Unsafe.pure_js_expr "belenios" let debug x = Firebug.console##log (Js.string x) module Sjcl = struct open Js type bits class type codec = object method fromBits : bits -> js_string t meth method toBits : js_string t -> bits meth end class type codecs = object method hex : codec t readonly_prop method utf8String : codec t readonly_prop method base64 : codec t readonly_prop end class type hash = object method hash : js_string t -> bits meth end class type hashes = object method sha256 : hash t readonly_prop end class type cipher = object method encrypt : bits -> bits meth end class type ciphers = object method aes : (bits -> cipher t) constr readonly_prop end class type mode = object method encrypt : cipher t -> bits -> bits -> bits meth method decrypt : cipher t -> bits -> bits -> bits meth end class type modes = object method ccm : mode t readonly_prop end class type random = object method randomWords : int -> bits meth end class type misc = object method pbkdf2 : js_string t -> bits -> int -> int -> bits meth end class type sjcl = object method codec : codecs t readonly_prop method hash : hashes t readonly_prop method cipher : ciphers t readonly_prop method mode : modes t readonly_prop method random : random t readonly_prop method misc : misc t readonly_prop end let sjcl : sjcl t = belenios##.sjcl let hex = sjcl##.codec##.hex let utf8String = sjcl##.codec##.utf8String let sha256 = sjcl##.hash##.sha256 let aes = sjcl##.cipher##.aes let ccm = sjcl##.mode##.ccm end let hex_fromBits x = Sjcl.hex##fromBits x |> Js.to_string let hex_toBits x = Sjcl.hex##toBits (Js.string x) let utf8String_fromBits x = Sjcl.utf8String##fromBits x |> Js.to_string let utf8String_toBits x = Sjcl.utf8String##toBits (Js.string x) let sha256 x = Sjcl.sha256##hash (Js.string x) let sha256_hex x = hex_fromBits (sha256 x) let pbkdf2_generic toBits ~iterations ~salt x = let salt = toBits salt in let derived = Sjcl.sjcl##.misc##pbkdf2 (Js.string x) salt iterations 256 in hex_fromBits derived 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 = new%js Sjcl.aes key in let output = 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 = new%js Sjcl.aes key in let ciphertext = Sjcl.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 = new%js Sjcl.aes key in let plaintext = Sjcl.ccm##decrypt prf ciphertext iv in utf8String_fromBits plaintext type rng = unit let secure_rng = () let pseudo_rng _ = () let string_of_hex hex n = String.init n (fun i -> let c = int_of_string ("0x" ^ String.sub hex (2 * i) 2) in char_of_int c) let random_string () n = let words = Sjcl.sjcl##.random##randomWords ((n / 4) + 1) in let hex_words = hex_fromBits words in string_of_hex hex_words n module BigIntCompat = struct open Js type bigint class type lib = object method _ZERO : bigint readonly_prop method _ONE : bigint readonly_prop method ofInt : int -> bigint meth method ofString : js_string t -> bigint meth method ofHex : js_string t -> bigint meth method add : bigint -> bigint -> bigint meth method subtract : bigint -> bigint -> bigint meth method multiply : bigint -> bigint -> bigint meth method divide : bigint -> bigint -> bigint meth method _mod : bigint -> bigint -> bigint meth method toInt : bigint -> int meth method toString : bigint -> js_string t meth method toHex : bigint -> js_string t meth method compare : bigint -> bigint -> int meth method modPow : bigint -> bigint -> bigint -> bigint meth method modInverse : bigint -> bigint -> bigint meth method bitLength : bigint -> int meth method isProbablePrime : bigint -> int -> int meth method shiftLeft : bigint -> int -> bigint meth method shiftRight : bigint -> int -> bigint meth method _and : bigint -> bigint -> bigint meth method _or : bigint -> bigint -> bigint meth method xor : bigint -> bigint -> bigint meth end let lib : lib t = belenios##._BigIntCompat end module Z = struct open BigIntCompat type t = bigint let zero = lib##._ZERO let one = lib##._ONE let of_hex x = lib##ofHex (Js.string x) let of_string x = lib##ofString (Js.string x) let of_int x = lib##ofInt x let ( + ) x y = lib##add x y let ( - ) x y = lib##subtract x y let ( * ) x y = lib##multiply x y let ( / ) x y = lib##divide x y let ( mod ) x y = lib##_mod x y let to_int x = lib##toInt x let to_string x = lib##toString x |> Js.to_string let to_hex x = lib##toHex x |> Js.to_string let compare x y = lib##compare x y let ( =% ) x y = compare x y = 0 let powm x y m = lib##modPow x y m let invert x m = lib##modInverse x m let bit_length x = lib##bitLength x let erem x y = let r = x mod y in if compare r zero < 0 then r + y else r let probab_prime x n = lib##isProbablePrime x n let z256 = of_int 256 let of_bits x = let n = String.length x in let rec loop res i = if i >= 0 then loop ((res * z256) + of_int (int_of_char x.[i])) (pred i) else res in loop zero (pred n) let shift_left x n = lib##shiftLeft x n let shift_right x n = lib##shiftRight x n let logand x y = lib##_and x y let logor x y = lib##_or x y let logxor x y = lib##xor x y let hash_modulus = of_int 1073741789 (* previous_prime(2^30) *) let hash_to_int x = to_int (erem x hash_modulus) end class type libsodium = object method bytes : unit -> int Js.meth method scalarbytes : unit -> int Js.meth method is_valid_point_ : int -> int Js.meth method scalarmult : int -> int -> int -> int Js.meth method add : int -> int -> int -> int Js.meth method base : int Js.readonly_prop method buffer : Typed_array.uint8Array Js.t Js.readonly_prop end let build_libsodium_stubs (libsodium : libsodium Js.t) = let module X : Signatures.LIBSODIUM_STUBS = struct type scalar = bytes type point = bytes let bytes () = libsodium##bytes () let scalarbytes () = libsodium##scalarbytes () let base = libsodium##.base let buffer = libsodium##.buffer let nbytes = bytes () let nscalarbytes = scalarbytes () let copy_to_wasm address x length = for i = 0 to length - 1 do Typed_array.set buffer (address + i) (int_of_char (Bytes.get x i)) done let copy_from_wasm x address length = for i = 0 to length - 1 do Bytes.set x i (char_of_int (Typed_array.unsafe_get buffer (address + i))) done let is_valid_point p = copy_to_wasm base p nbytes; libsodium##is_valid_point_ base let reg1 = base + nbytes let reg2 = reg1 + nscalarbytes let scalarmult q n p = copy_to_wasm reg1 n nscalarbytes; copy_to_wasm reg2 p nbytes; let r = libsodium##scalarmult base reg1 reg2 in copy_from_wasm q base nbytes; r let reg3 = reg1 + nbytes let add r p q = copy_to_wasm reg1 p nbytes; copy_to_wasm reg3 q nbytes; let result = libsodium##add base reg1 reg3 in copy_from_wasm r base nbytes; result end in (module X : Signatures.LIBSODIUM_STUBS) let libsodium_ref = ref None let libsodium_stubs () = match !libsodium_ref with | None -> Js.Optdef.iter belenios##.libsodium (fun x -> libsodium_ref := Some (build_libsodium_stubs x)); !libsodium_ref | x -> x belenios-2.2-10-gbb6b7ea8/src/platform/native/0002755000175000017500000000000014476041226020001 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/platform/native/dune0000644000175000017500000000034214476041226020654 0ustar stephsteph(library (name belenios_platform_native) (public_name belenios-platform-native) (implements belenios_platform) (foreign_stubs (language c) (names libsodium_stubs)) (c_library_flags (-lsodium)) (libraries cryptokit)) belenios-2.2-10-gbb6b7ea8/src/platform/native/platform.ml0000644000175000017500000002146414476041226022164 0ustar stephsteph(**************************************************************************) (* BELENIOS *) (* *) (* Copyright © 2012-2023 Inria *) (* *) (* This program is free software: you can redistribute it and/or modify *) (* it under the terms of the GNU Affero General Public License as *) (* published by the Free Software Foundation, either version 3 of the *) (* License, or (at your option) any later version, with the additional *) (* exemption that compiling, linking, and/or using OpenSSL is allowed. *) (* *) (* This program is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Affero General Public License for more details. *) (* *) (* You should have received a copy of the GNU Affero General Public *) (* License along with this program. If not, see *) (* . *) (**************************************************************************) let debug x = prerr_endline x let sha256_hex x = Cryptokit.( x |> hash_string (Hash.sha256 ()) |> transform_string (Hexa.encode ())) let int_msb i = let result = Bytes.create 4 in Bytes.set result 0 (char_of_int (i lsr 24)); Bytes.set result 1 (char_of_int ((i lsr 16) land 0xff)); Bytes.set result 2 (char_of_int ((i lsr 8) land 0xff)); Bytes.set result 3 (char_of_int (i land 0xff)); Bytes.to_string result let xor a b = let n = String.length a in assert (n = String.length b); String.init n (fun i -> char_of_int (int_of_char a.[i] lxor int_of_char b.[i])) let pbkdf2 ~prf ~salt ~iterations ~size password = let c = iterations - 1 in let hLen = (prf password)#hash_size in let result = Bytes.create (hLen * size) in let one_iteration i = let u = Cryptokit.hash_string (prf password) (salt ^ int_msb i) in let rec loop c u accu = if c > 0 then let u' = Cryptokit.hash_string (prf password) u in loop (c - 1) u' (xor accu u') else accu in loop c u u in for i = 1 to size do let offset = (i - 1) * hLen in String.blit (one_iteration i) 0 result offset hLen done; Bytes.to_string result let pbkdf2_generic toBits ~iterations ~salt x = let open Cryptokit in let salt = toBits salt in pbkdf2 ~prf:MAC.hmac_sha256 ~iterations ~size:1 ~salt x |> transform_string (Hexa.encode ()) let pbkdf2_utf8 = pbkdf2_generic (fun x -> x) let aes_raw ~key ~data = begin let open Cryptokit in transform_string Cipher.(aes ~mode:ECB key Encrypt) data end [@alert "-crypto"] (* OK for a single block *) 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 = aes_raw ~key ~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 data = aes_raw ~key ~data 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 data = aes_raw ~key ~data in let plaintext = ccm_decrypt prf ciphertext iv "" 64 in plaintext type rng = Cryptokit.Random.rng let secure_rng = if Version.debug && Sys.getenv_opt "BELENIOS_USE_URANDOM" <> None then Cryptokit.Random.device_rng "/dev/urandom" else Cryptokit.Random.secure_rng let pseudo_rng = Cryptokit.Random.pseudo_rng let random_string = Cryptokit.Random.string module Z = struct include Z let of_hex x = of_string_base 16 x let to_hex x = format "%x" x let ( =% ) = equal let bit_length x = Stdlib.(String.length (to_bits x) * 8) let powm x a m = if Z.compare a Z.zero = 0 then Z.one else powm_sec x a m (* Warning: no efforts have been made to be constant time in the rest of the code. *) let hash_to_int = Z.hash end module Libsodium_stubs = struct type scalar = bytes type point = bytes external bytes : unit -> int = "belenios_libsodium_ed25519_bytes" [@@noalloc] external scalarbytes : unit -> int = "belenios_libsodium_ed25519_scalarbytes" [@@noalloc] external is_valid_point : point -> int = "belenios_libsodium_ed25519_is_valid_point" [@@noalloc] external scalarmult : point -> scalar -> point -> int = "belenios_libsodium_ed25519_scalarmult" [@@noalloc] external add : point -> point -> point -> int = "belenios_libsodium_ed25519_add" [@@noalloc] end let libsodium_stubs () = Some (module Libsodium_stubs : Signatures.LIBSODIUM_STUBS) belenios-2.2-10-gbb6b7ea8/src/platform/native/libsodium_stubs.c0000644000175000017500000000430014476041226023347 0ustar stephsteph/**************************************************************************/ /* BELENIOS */ /* */ /* Copyright © 2021-2023 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 */ /* . */ /**************************************************************************/ #include #include value belenios_libsodium_ed25519_bytes() { return Val_long(crypto_core_ed25519_BYTES); } value belenios_libsodium_ed25519_scalarbytes() { return Val_long(crypto_core_ed25519_SCALARBYTES); } value belenios_libsodium_ed25519_is_valid_point(value p) { return Val_int(crypto_core_ed25519_is_valid_point(Bytes_val(p))); } value belenios_libsodium_ed25519_scalarmult(value q, value n, value p) { return Val_int(crypto_scalarmult_ed25519_noclamp(Bytes_val(q), Bytes_val(n), Bytes_val(p))); } value belenios_libsodium_ed25519_add(value r, value p, value q) { return Val_int(crypto_core_ed25519_add(Bytes_val(r), Bytes_val(p), Bytes_val(q))); } belenios-2.2-10-gbb6b7ea8/src/platform/version/0002755000175000017500000000000014476041226020200 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/src/platform/version/gen.sh0000755000175000017500000000054514476041226021312 0ustar stephsteph#!/bin/sh set -e if [ ! -f "$1" ]; then echo "Could not find VERSION!" exit 2 fi VERSION="$(head -n1 "$1")" SPEC="$(cat "$2")" BUILD="$(./get_build.sh)" if [ -n "$BELENIOS_DEBUG" ]; then DEBUG=true else DEBUG=false fi echo "let version = \"$VERSION\"" echo "let build = \"$BUILD\"" echo "let spec = \"$SPEC\"" echo "let debug = $DEBUG" belenios-2.2-10-gbb6b7ea8/src/platform/version/dune0000644000175000017500000000042714476041226021057 0ustar stephsteph(rule (target version.ml) (deps get_build.sh gen.sh (:version ../../../VERSION) (:spec_version ../../../doc/spec_version.tex) (env_var BELENIOS_DEBUG) (env_var BELENIOS_BUILD)) (action (with-stdout-to %{target} (run ./gen.sh %{version} %{spec_version})))) belenios-2.2-10-gbb6b7ea8/src/platform/version/get_build.sh0000755000175000017500000000040614476041226022473 0ustar stephsteph#!/bin/sh set -e if [ -n "$BELENIOS_BUILD" ]; then echo $BELENIOS_BUILD elif command -v git >/dev/null && git rev-parse --show-toplevel >/dev/null 2>&1; then git describe else DATE=${SOURCE_DATE_EPOCH:-$(date +%s)} date -u -d @$DATE +%Y%m%d fi belenios-2.2-10-gbb6b7ea8/MANIFEST0000644000175000017500000003767414476041226015250 0ustar stephsteph.gitignore .gitlab-ci.yml .ocamlformat AUTHORS CHANGES.md COPYING Dockerfile_base_environment Dockerfile_test_scenario_environment INSTALL.md MANIFEST Makefile README.md RELEASE_NOTES.md VERSION belenios-lib.opam belenios-platform-js.opam belenios-platform-native.opam belenios-platform.opam belenios-server.opam belenios-tool.opam belenios.opam contrib/fill_en_po.ml contrib/list_live_elections.py contrib/monitor_elections.py contrib/move_deleted_elections.sh contrib/reference_template.json contrib/send_credentials.py contrib/stats_on_deleted.sh demo/dummy_logins.txt demo/dune demo/mime.types demo/ocsigenserver.conf.in demo/password_db.csv demo/run-server.sh demo/sealing.txt demo/stop-server.sh demo/warning.html doc/.gitignore doc/API.md doc/Continuous_Integration.md doc/automated_tests.md doc/components.dot doc/election_test_scenario_1_specification.md doc/election_test_scenario_2_specification.md doc/election_test_scenario_3_specification.md doc/election_test_scenario_4_specification.md doc/fips.sage doc/frontend_booth.md doc/instructions-en.md doc/instructions-fr.md doc/load_testing.md doc/nspawn/README.md doc/nspawn/belenios-container@.service doc/nspawn/belenios-nspawn doc/nspawn/belenios-stage1.sh doc/nspawn/belenios-stage2.sh doc/nspawn/belenios-stage3.sh doc/references.bib doc/spec_version.tex doc/specification.tex doc/tool.md doc/web.md dune dune-project ext/captcha/captcha ext/captcha/dune ext/css/reset.css ext/css/style.css ext/css/styled-elements.css ext/css/superfish.css ext/images/dune ext/images/encrypting.gif ext/jsbn/BigIntCompat.js ext/jsbn/LICENSE ext/jsbn/README.md ext/jsbn/dune ext/jsbn/jsbn.js ext/jsbn/jsbn2.js ext/libsodium/LICENSE ext/libsodium/README.md ext/libsodium/build.sh ext/libsodium/dune ext/libsodium/libsodium.js ext/libsodium/libsodium.wasm ext/sjcl/LICENSE.txt ext/sjcl/README.md ext/sjcl/core/aes.js ext/sjcl/core/bitArray.js ext/sjcl/core/ccm.js ext/sjcl/core/codecBase64.js ext/sjcl/core/codecHex.js ext/sjcl/core/codecString.js ext/sjcl/core/hmac.js ext/sjcl/core/pbkdf2.js ext/sjcl/core/random.js ext/sjcl/core/sha256.js ext/sjcl/core/sjcl.js ext/sjcl/dune ext/sjcl/gen.sh frontend/.gitignore frontend/.prettierrc.json frontend/Makefile frontend/booth/app.css frontend/booth/app.js frontend/booth/color_utils.js frontend/booth/components/AllQuestionsWithPagination.js frontend/booth/components/Breadcrumb.css frontend/booth/components/Breadcrumb.js frontend/booth/components/CandidateWithCheckbox.css frontend/booth/components/CandidateWithCheckbox.js frontend/booth/components/CandidateWithRadio.js frontend/booth/components/ClassicVoteCandidatesList.css frontend/booth/components/ClassicVoteCandidatesList.js frontend/booth/components/ClassicVoteRecap.js frontend/booth/components/DisplayDependingOnWindowWidth.js frontend/booth/components/InputCredentialSection.css frontend/booth/components/InputCredentialSection.js frontend/booth/components/LoadingSpinner.css frontend/booth/components/LoadingSpinner.js frontend/booth/components/MajorityJudgmentVoteBigCandidatesList.css frontend/booth/components/MajorityJudgmentVoteBigCandidatesList.js frontend/booth/components/MajorityJudgmentVoteCandidatesList.js frontend/booth/components/MajorityJudgmentVoteRecap.js frontend/booth/components/MajorityJudgmentVoteSmallCandidatesList.css frontend/booth/components/MajorityJudgmentVoteSmallCandidatesList.js frontend/booth/components/NiceButton.css frontend/booth/components/NiceButton.js frontend/booth/components/NiceInput.css frontend/booth/components/NiceInput.js frontend/booth/components/NoUuidSection.js frontend/booth/components/PageFooter.css frontend/booth/components/PageFooter.js frontend/booth/components/PageHeader.css frontend/booth/components/PageHeader.js frontend/booth/components/PreferentialVotingCandidatesList.css frontend/booth/components/PreferentialVotingCandidatesList.js frontend/booth/components/PreferentialVotingColumn.js frontend/booth/components/PreferentialVotingVoteRecap.js frontend/booth/components/PreferentialVotingWithoutEqualityCandidatesList.js frontend/booth/components/PreferentialVotingWithoutEqualityColumn.css frontend/booth/components/PreferentialVotingWithoutEqualityColumn.js frontend/booth/components/PreferentialVotingWithoutEqualityVoteRecap.js frontend/booth/components/QuestionWithVotableAnswers.css frontend/booth/components/QuestionWithVotableAnswers.js frontend/booth/components/ReviewEncryptSection.css frontend/booth/components/ReviewEncryptSection.js frontend/booth/components/VoteNavigation.css frontend/booth/components/VoteNavigation.js frontend/booth/components/WholeVoteRecap.css frontend/booth/components/WholeVoteRecap.js frontend/booth/components/common.css frontend/booth/election_utils.js frontend/booth/i18n_init.js frontend/booth/majority_judgment_colors.js frontend/booth/select-css.css frontend/booth/shortcuts.js frontend/booth/vote.html frontend/booth/webpack.config.js frontend/bundle-css.js frontend/i18next-parser.config.js frontend/logo.png frontend/package.json frontend/translations/ar.json frontend/translations/cs.json frontend/translations/de.json frontend/translations/el.json frontend/translations/en.json frontend/translations/es.json frontend/translations/es_419.json frontend/translations/fi.json frontend/translations/fr.json frontend/translations/it.json frontend/translations/jpn_JP.json frontend/translations/lt.json frontend/translations/nb.json frontend/translations/oc.json frontend/translations/pl.json frontend/translations/pt_BR.json frontend/translations/ro.json frontend/translations/uk.json opam-bootstrap.sh po/.gitignore po/Makefile po/admin/LINGUAS po/admin/Makefile po/admin/POTFILES po/admin/ar.po po/admin/cs.po po/admin/de.po po/admin/dune po/admin/el.po po/admin/en.po po/admin/es.po po/admin/es_419.po po/admin/fr.po po/admin/it.po po/admin/messages.pot po/admin/ms.po po/admin/nb.po po/admin/nl.po po/admin/oc.po po/admin/pl.po po/admin/pt_BR.po po/admin/ro.po po/admin/tr.po po/gen-dune.sh po/voter/LINGUAS po/voter/Makefile po/voter/POTFILES po/voter/ar.po po/voter/cs.po po/voter/de.po po/voter/dune po/voter/el.po po/voter/en.po po/voter/es.po po/voter/es_419.po po/voter/fi.po po/voter/fr.po po/voter/it.po po/voter/jpn_JP.po po/voter/messages.pot po/voter/nb.po po/voter/nl.po po/voter/oc.po po/voter/pl.po po/voter/pt_BR.po po/voter/ro.po po/voter/sk.po po/voter/uk.po po/voter/zh_Hans.po requirements.txt src/common/api/dune src/common/api/serializable.atd src/common/tool/dune src/common/tool/tool_credgen.ml src/common/tool/tool_credgen.mli src/common/tool/tool_mkelection.ml src/common/tool/tool_mkelection.mli src/common/tool/tool_tkeygen.ml src/common/tool/tool_tkeygen.mli src/lib/core/archive.ml src/lib/core/archive.mli src/lib/core/common.ml src/lib/core/common.mli src/lib/core/common_types.ml src/lib/core/common_types.mli src/lib/core/credential.ml src/lib/core/credential.mli src/lib/core/dune src/lib/core/ed25519_libsodium.ml src/lib/core/ed25519_libsodium.mli src/lib/core/ed25519_pure.ml src/lib/core/ed25519_pure.mli src/lib/core/events.ml src/lib/core/events.mli src/lib/core/group_field.ml src/lib/core/group_field.mli src/lib/core/majority_judgment.ml src/lib/core/majority_judgment.mli src/lib/core/question.ml src/lib/core/question.mli src/lib/core/question_h.atd src/lib/core/question_nh.atd src/lib/core/question_sigs.mli src/lib/core/schulze.ml src/lib/core/schulze.mli src/lib/core/serializable.atd src/lib/core/serializable_core.atd src/lib/core/signatures.mli src/lib/core/signatures_core.mli src/lib/core/stv.ml src/lib/core/stv.mli src/lib/core/trustees_sig.mli src/lib/core/util.ml src/lib/core/util.mli src/lib/core/versioned_sig.mli src/lib/shell/dune src/lib/shell/election.ml src/lib/shell/election.mli src/lib/shell/group.ml src/lib/shell/group.mli src/lib/shell/trustees.ml src/lib/shell/trustees.mli src/lib/v1/dune src/lib/v1/election.ml src/lib/v1/election.mli src/lib/v1/group.ml src/lib/v1/group.mli src/lib/v1/mixnet.ml src/lib/v1/mixnet.mli src/lib/v1/question_h.ml src/lib/v1/question_h.mli src/lib/v1/question_nh.ml src/lib/v1/question_nh.mli src/lib/v1/serializable.atd src/lib/v1/trustees.ml src/lib/v1/trustees.mli src/platform/dune src/platform/js/dune src/platform/js/platform.ml src/platform/native/dune src/platform/native/libsodium_stubs.c src/platform/native/platform.ml src/platform/platform.mli src/platform/signatures.mli src/platform/version.mli src/platform/version/dune src/platform/version/gen.sh src/platform/version/get_build.sh src/scripts/checki18next/checki18next.ml src/scripts/checki18next/dune src/scripts/checki18next/reference.json src/scripts/mo2json/dune src/scripts/mo2json/mo2json.ml src/scripts/translate_stubs/dune src/scripts/translate_stubs/gen.sh src/scripts/translate_stubs/main.ml src/tool/common.ml src/tool/dune src/tool/election.ml src/tool/election.mli src/tool/main.ml src/tool/main.mli src/tool/random.ml src/tool/random.mli src/tool/sealing.ml src/tool/sealing.mli src/tool/setup.ml src/tool/setup.mli src/tool/tool_election.ml src/tool/tool_election.mli src/tool/tool_events.ml src/tool/tool_events.mli src/tool/tool_mkarchive.ml src/tool/tool_mkarchive.mli src/tool/tool_verifydiff.ml src/tool/tool_verifydiff.mli src/web/clients/admin/account.ml src/web/clients/admin/account.mli src/web/clients/admin/admin.html src/web/clients/admin/admin.ml src/web/clients/admin/admin.mli src/web/clients/admin/cache.ml src/web/clients/admin/cache.mli src/web/clients/admin/common.ml src/web/clients/admin/common.mli src/web/clients/admin/dune src/web/clients/admin/elections.ml src/web/clients/admin/elections.mli src/web/clients/admin/preview.ml src/web/clients/admin/preview.mli src/web/clients/admin/questions.ml src/web/clients/admin/questions.mli src/web/clients/admin/trustees.ml src/web/clients/admin/trustees.mli src/web/clients/basic/admin_basic.html src/web/clients/basic/admin_basic.ml src/web/clients/basic/admin_basic.mli src/web/clients/basic/common.ml src/web/clients/basic/credentials.ml src/web/clients/basic/drafts.ml src/web/clients/basic/dune src/web/clients/basic/elections.ml src/web/clients/checkpriv/checkpriv.html src/web/clients/checkpriv/checkpriv.ml src/web/clients/checkpriv/dune src/web/clients/common/common.ml src/web/clients/common/dune src/web/clients/common/i18n.ml src/web/clients/common/i18n.mli src/web/clients/common/messages.mli src/web/clients/election-home/dune src/web/clients/election-home/home.ml src/web/clients/election-home/home.mli src/web/clients/jslib/belenios_jslib.ml src/web/clients/jslib/belenios_jslib.mli src/web/clients/jslib/dune src/web/clients/tool/belenios-tool.html src/web/clients/tool/dune src/web/clients/tool/tool_js.ml src/web/clients/tool/tool_js.mli src/web/clients/tool/tool_js_credgen.ml src/web/clients/tool/tool_js_fingerprint.ml src/web/clients/tool/tool_js_i18n.mli src/web/clients/tool/tool_js_pd.ml src/web/clients/tool/tool_js_questions.ml src/web/clients/tool/tool_js_shuffle.ml src/web/clients/tool/tool_js_shuffle.mli src/web/clients/tool/tool_js_tkeygen.ml src/web/clients/tool/tool_js_ttkeygen.ml src/web/clients/worker/belenios_worker.ml src/web/clients/worker/belenios_worker.mli src/web/clients/worker/dune src/web/common/dune src/web/common/i18n.mli src/web/common/languages.ml src/web/common/languages.mli src/web/common/links.ml src/web/common/mail_formatter.ml src/web/common/mail_formatter.mli src/web/common/mails_admin.ml src/web/common/mails_admin.mli src/web/common/mails_admin_sig.mli src/web/common/markup.ml src/web/common/markup_lexer.mli src/web/common/markup_lexer.mll src/web/common/markup_parser.mly src/web/common/markup_types.mli src/web/common/pages_common.ml src/web/server/common/accounts.ml src/web/server/common/accounts.mli src/web/server/common/api_drafts.ml src/web/server/common/api_drafts.mli src/web/server/common/api_elections.ml src/web/server/common/api_elections.mli src/web/server/common/api_eliom.ml src/web/server/common/api_eliom.mli src/web/server/common/api_generic.ml src/web/server/common/api_generic.mli src/web/server/common/dune src/web/server/common/filesystem.ml src/web/server/common/filesystem.mli src/web/server/common/mails_voter.ml src/web/server/common/mails_voter.mli src/web/server/common/otp.ml src/web/server/common/otp.mli src/web/server/common/pages_admin.ml src/web/server/common/pages_admin.mli src/web/server/common/pages_admin_sig.mli src/web/server/common/pages_common.ml src/web/server/common/pages_common.mli src/web/server/common/pages_common_sig.mli src/web/server/common/pages_sig.mli src/web/server/common/pages_voter.ml src/web/server/common/pages_voter.mli src/web/server/common/pages_voter_sig.mli src/web/server/common/site_admin.ml src/web/server/common/site_admin.mli src/web/server/common/site_admin_sig.mli src/web/server/common/site_common.ml src/web/server/common/site_common.mli src/web/server/common/site_common_sig.mli src/web/server/common/site_voter.ml src/web/server/common/site_voter.mli src/web/server/common/spool.ml src/web/server/common/spool.mli src/web/server/common/web_auth.ml src/web/server/common/web_auth.mli src/web/server/common/web_auth_cas.ml src/web/server/common/web_auth_cas.mli src/web/server/common/web_auth_dummy.ml src/web/server/common/web_auth_dummy.mli src/web/server/common/web_auth_email.ml src/web/server/common/web_auth_email.mli src/web/server/common/web_auth_oidc.ml src/web/server/common/web_auth_oidc.mli src/web/server/common/web_auth_password.ml src/web/server/common/web_auth_password.mli src/web/server/common/web_auth_sig.mli src/web/server/common/web_captcha.ml src/web/server/common/web_captcha.mli src/web/server/common/web_common.ml src/web/server/common/web_common.mli src/web/server/common/web_config.ml src/web/server/common/web_config.mli src/web/server/common/web_election_mutex.ml src/web/server/common/web_election_mutex.mli src/web/server/common/web_events.ml src/web/server/common/web_events.mli src/web/server/common/web_i18n.ml src/web/server/common/web_i18n.mli src/web/server/common/web_i18n_sig.mli src/web/server/common/web_main.ml src/web/server/common/web_main.mli src/web/server/common/web_persist.ml src/web/server/common/web_persist.mli src/web/server/common/web_serializable.atd src/web/server/common/web_services.ml src/web/server/common/web_services.mli src/web/server/common/web_services_sig.mli src/web/server/common/web_signup.ml src/web/server/common/web_signup.mli src/web/server/common/web_state.ml src/web/server/common/web_state.mli src/web/server/common/web_state_sig.mli src/web/server/common/web_types.ml src/web/server/common/web_types.mli src/web/server/executable/dune src/web/server/executable/server.ml src/web/server/module/dune src/web/server/module/main.ml src/web/static/MainMenu.css src/web/static/MainZone.css src/web/static/NavMenu.css src/web/static/app2.css src/web/static/avatar.png src/web/static/booth.css src/web/static/common.css src/web/static/dune src/web/static/placeholder.png src/web/static/responsive_site.css src/web/static/site.css src/web/static/wrap_tool.sh tests/debian-votes/README.md tests/debian-votes/convert.ml tests/debian-votes/download.sh tests/debian-votes/dune tests/dune tests/selenium/load_testing_set_up.py tests/selenium/settings.py tests/selenium/test_clicker_monkey.py tests/selenium/test_fuzz_login.py tests/selenium/test_fuzz_vote.py tests/selenium/test_scenario_1.py tests/selenium/test_scenario_2.py tests/selenium/test_scenario_2_with_monkeys.py tests/selenium/test_scenario_3.py tests/selenium/test_scenario_4.py tests/selenium/test_smart_monkey.py tests/selenium/tools/sendmail_fake.sh tests/selenium/tools/sendmail_fake_to_static.sh tests/selenium/util/election_test_base.py tests/selenium/util/election_testing.py tests/selenium/util/execution.py tests/selenium/util/fake_sent_emails_manager.py tests/selenium/util/monkeys.py tests/selenium/util/page_objects.py tests/selenium/util/selenium_tools.py tests/selenium/util/state_machine.py tests/selenium/vote_with_prepared_ballots.py tests/selenium/vote_with_prepared_ballots_direct.py tests/tool/.gitignore tests/tool/Makefile tests/tool/demo-mj.sh tests/tool/demo-nh.sh tests/tool/demo-stv.sh tests/tool/demo-threshold.sh tests/tool/demo.sh tests/tool/templates/questions-mj.json tests/tool/templates/questions-nh.json tests/tool/templates/questions-stv.json tests/tool/templates/questions.json belenios-2.2-10-gbb6b7ea8/.ocamlformat0000644000175000017500000000004314476041226016400 0ustar stephstephprofile = default version = 0.26.0 belenios-2.2-10-gbb6b7ea8/requirements.txt0000644000175000017500000000012114476041226017354 0ustar stephsteph# Tools for automated tests selenium==3.141.0 hypothesis==5.6.0 urllib3==1.26.15 belenios-2.2-10-gbb6b7ea8/dune-project0000644000175000017500000000243714476041226016426 0ustar stephsteph(lang dune 2.7) (using menhir 2.0) (name belenios) (version 2.2) (generate_opam_files true) (license AGPL-3) (authors "Stéphane Glondu") (maintainers "stephane.glondu@inria.fr") (package (name belenios-platform-native) (synopsis "Native implementation of the Belenios platform") (depends (cryptokit (>= 1.17)))) (package (name belenios-platform-js) (synopsis "JavaScript implementation of the Belenios platform") (depends (js_of_ocaml (>= 4.0.0)) (js_of_ocaml-ppx (>= 4.0.0)))) (package (name belenios-platform) (synopsis "Definition of the Belenios platform")) (package (name belenios-lib) (synopsis "Belenios library") (depends (yojson (>= 2.0.2)) (atdgen (>= 2.10.0)) (belenios-platform (= :version)))) (package (name belenios-tool) (synopsis "Belenios command-line tool") (depends (cmdliner (>= 1.1.0)) (belenios-platform-native (= :version)) (belenios-lib (= :version)))) (package (name belenios-server) (synopsis "Belenios server") (depends (belenios-platform-native (= :version)) (belenios-lib (= :version)) (lwt (>= 5.6.1)) (calendar (>= 2.04)) (csv (>= 2.4)) (eliom (>= 10.0.0)) (ocamlnet (>= 4.1.9-1)))) (package (name belenios) (synopsis "Belenios meta-package") (depends (belenios-tool (= :version)) (belenios-server (= :version)))) belenios-2.2-10-gbb6b7ea8/belenios-platform-js.opam0000644000175000017500000000102114476041226021002 0ustar stephsteph# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "2.2" synopsis: "JavaScript implementation of the Belenios platform" maintainer: ["stephane.glondu@inria.fr"] authors: ["Stéphane Glondu"] license: "AGPL-3" depends: [ "dune" {>= "2.7"} "js_of_ocaml" {>= "4.0.0"} "js_of_ocaml-ppx" {>= "4.0.0"} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] belenios-2.2-10-gbb6b7ea8/Dockerfile_belenios_demo0000644000175000017500000000060414476041226020754 0ustar stephstephFROM glondu/beleniosbase:20230724-1 # alternatively, run "docker build -f Dockerfile_base_environment -t beleniosbase ." and replace with the line below # FROM beleniosbase ADD --chown=belenios . /home/belenios/ RUN . /home/belenios/.belenios/env.sh \ && make build-debug-server ENV BELENIOS_SENDMAIL=tests/selenium/tools/sendmail_fake_to_static.sh CMD ./demo/run-server.sh --debug belenios-2.2-10-gbb6b7ea8/.gitignore0000644000175000017500000000026614476041226016072 0ustar stephsteph*~ *.bbl *.blg *.dvi *.rubbercache *.install _build _build-debug _releases _run _testdata venv __pycache__ .hypothesis node_modules geckodriver.log env.sh node_modules *.stories.mjs belenios-2.2-10-gbb6b7ea8/COPYING0000644000175000017500000010333014476041226015131 0ustar stephsteph GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU Affero General Public License is a free, copyleft license for software and other kinds of works, specifically designed to ensure cooperation with the community in the case of network server software. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, our General Public Licenses are intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. Developers that use our General Public Licenses protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License which gives you legal permission to copy, distribute and/or modify the software. A secondary benefit of defending all users' freedom is that improvements made in alternate versions of the program, if they receive widespread use, become available for other developers to incorporate. Many developers of free software are heartened and encouraged by the resulting cooperation. However, in the case of software used on network servers, this result may fail to come about. The GNU General Public License permits making a modified version and letting the public access it on a server without ever releasing its source code to the public. The GNU Affero General Public License is designed specifically to ensure that, in such cases, the modified source code becomes available to the community. It requires the operator of a network server to provide the source code of the modified version running there to the users of that server. Therefore, public use of a modified version, on a publicly accessible server, gives the public access to the source code of the modified version. An older license, called the Affero General Public License and published by Affero, was designed to accomplish similar goals. This is a different license, not a version of the Affero GPL, but Affero has released a new version of the Affero GPL which permits relicensing under this license. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU Affero General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Remote Network Interaction; Use with the GNU General Public License. Notwithstanding any other provision of this License, if you modify the Program, your modified version must prominently offer all users interacting with it remotely through a computer network (if your version supports such interaction) an opportunity to receive the Corresponding Source of your version by providing access to the Corresponding Source from a network server at no charge, through some standard or customary means of facilitating copying of software. This Corresponding Source shall include the Corresponding Source for any work covered by version 3 of the GNU General Public License that is incorporated pursuant to the following paragraph. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the work with which it is combined will remain governed by version 3 of the GNU General Public License. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU Affero General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU Affero General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU Affero General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU Affero General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. You should have received a copy of the GNU Affero General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If your software can interact with users remotely through a computer network, you should also make sure that it provides a way for users to get its source. For example, if your program is a web application, its interface could display a "Source" link that leads users to an archive of the code. There are many ways you could offer source, and different solutions will be better for different programs; see section 13 for the specific requirements. You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU AGPL, see . belenios-2.2-10-gbb6b7ea8/INSTALL.md0000644000175000017500000002311114476041226015524 0ustar stephstephBelenios compilation instructions ================================= Read this document if you want to deploy your own instance of Belenios. To get help or share your experience, please use in priority the [public mailing-list](https://sympa.inria.fr/sympa/info/belenios-discuss). To give feedback on deploying an instance, you can also [mail us](mailto:contact@belenios.org). Using containers ---------------- In order to quickly run a local instance, a [demo Dockerfile](./Dockerfile_belenios_demo) is available. The following commands let you build the image and run it to make the server accessible at [localhost:8001](http://localhost:8001). Emails are not sent but only printed in a file accessible from [localhost:8001/static/mail.txt](http://localhost:8001/static/mail.txt) __Note that this is not meant for production purposes.__ ``` make clean # to avoid copying everything in the image docker build -f Dockerfile_belenios_demo -t belenios . docker run --rm --network host -it belenios ``` If you are using Linux and have root privileges, you might be interested in our documentation on [deploying Belenios using systemd-nspawn](doc/nspawn/README.md). The rest of this file documents other ways to build Belenios on standard POSIX systems. The easy way ------------ Belenios is written in OCaml and has some dependencies towards third-party OCaml libraries. The easiest and most portable way to compile Belenios from source is to use [OPAM](http://opam.ocamlpro.com/), which is a package manager for OCaml projects. The non-OCaml prerequisites are: * a POSIX system with a C compiler and a `/usr/lib/sendmail` command * on Linux, [Bubblewrap](https://github.com/projectatomic/bubblewrap) * [GMP](http://gmplib.org/) * [libsodium](https://www.libsodium.org/) * [PCRE](http://www.pcre.org/) * [pkg-config](http://www.freedesktop.org/wiki/Software/pkg-config/) * [m4](https://www.gnu.org/software/m4/) * [SQLite3](https://www.sqlite.org/) * [OpenSSL](https://www.openssl.org/) * [Wget](https://www.gnu.org/software/wget/) or [curl](http://curl.haxx.se/) * [Zip](http://www.info-zip.org/Zip.html) * [Unzip](http://www.info-zip.org/UnZip.html) * [ncurses](http://invisible-island.net/ncurses/) * [GD-SecurityImage](https://metacpan.org/release/GD-SecurityImage) * [cracklib](https://github.com/cracklib/cracklib) * [jq](https://github.com/stedolan/jq) * [npm](https://www.npmjs.com/) These libraries and tools are pretty common, and might be directly part of your operating system. On [Debian](http://www.debian.org/) and its derivatives, they can be installed with the following command: sudo apt install bubblewrap build-essential libgmp-dev libsodium-dev libpcre3-dev pkg-config m4 libssl-dev libsqlite3-dev wget ca-certificates zip unzip libncurses-dev zlib1g-dev libgd-securityimage-perl cracklib-runtime jq npm If you are unfamiliar with OCaml or OPAM, we provide an `opam-bootstrap.sh` shell script that creates a whole, hopefully self-contained, OCaml+OPAM install, and then installs all the dependencies of Belenios, everything into a single directory. You can choose the directory by setting the `BELENIOS_SYSROOT` environment variable, or it will take `~/.belenios` by default. Just run: ./opam-bootstrap.sh On a modern desktop system, this needs approximately 30 minutes and 3.3 gigabytes of disk space. If everything goes successfully, follow the given instructions to update your shell environment, then run: make build-release-server and you can skip the next two sections and go directly to the _Documentation_ section. You can also compile a debug version by using: make build-debug-server Note that this version may introduce vulnerabilities and should not be used in production! To make sure everything went well, you can run tests: make check If you are familiar with OCaml, please read the `opam-bootstrap.sh` shell script, or the following two sections to compile Belenios with your existing OCaml installation. OPAM overlay ------------ Belenios needs some OPAM packages to be patched. This is done in an opam repository overlay that you can add with the following command: opam repository add belenios-overlay $PWD/ext/opam-overlay This is automatically handled by `opam-bootstrap.sh` Command-line tool ----------------- To compile the command-line tool, you will need: * [OCaml](https://ocaml.org/) * [Dune](https://dune.build/) * [Zarith](https://github.com/ocaml/Zarith) * [Cryptokit](https://github.com/xavierleroy/cryptokit) * [Atdgen](https://github.com/ahrefs/atd) * [Yojson](https://github.com/ocaml-community/yojson) * [Cmdliner](http://erratique.ch/software/cmdliner) With OPAM, these dependencies can be installed with the following command: opam install dune atdgen zarith cryptokit cmdliner Once all the dependencies have been installed, the command-line tool can be compiled with: make It produces a single executable, `belenios-tool`, in the `_build/install/default/bin` directory. You can install it in your `PATH` (which we will assume in the guides), or refer to it with a full path. Web server ---------- The web server has the following additional dependencies: * [Calendar](http://calendar.forge.ocamlcore.org/) * [Eliom](http://ocsigen.org/eliom/) * [Csv](https://github.com/Chris00/ocaml-csv) With OPAM, you can install them with: opam install calendar eliom csv Once all the dependencies have been installed, the Eliom module can be compiled with: make build-release-server It will produce a full installation of Belenios, its libraries and its server, in the `_run/usr` directory. See `demo/ocsigenserver.conf.in` for an ocsigenserver configuration template, and the [Server administrator's guide](doc/web.md) for more information on how to use it. Documentation ------------- You will need LaTeX to compile the specification. On Debian-based systems, you can install the dependencies needed to compile the documentation with: sudo apt install texlive-latex-extra texlive-fonts-recommended texlive-fonts-extra lmodern texlive-science Once all the dependencies have been installed, the documentation can be compiled with: make doc Compiling on Windows using Cygwin --------------------------------- Windows is not yet a fully supported platform, but you can compile at least the command-line tool on Windows + 32-bit [Cygwin](http://cygwin.com/index.html). You might need the following packages: * curl * dos2unix * flexdll * gcc-core * gcc-g++ * git * gmp * libgmp-devel * libsodium-devel * libncursesw-devel * libpcre-devel * libsqlite3-devel * m4 * make * ocaml * ocaml-base * ocaml-camlp4 * ocaml-compiler-libs * openssh * patch * pkg-config * zlib-devel With these packages installed, you should be able to install OPAM by following its [installation instructions from sources](http://opam.ocaml.org/doc/Install.html#FromSources). Once OPAM is installed, follow the instructions in the _Command-line tool_ section above. Troubleshooting --------------- ### Bootstrap fails if dune is already installed The script `opam-bootstrap.sh` fails when a not suitable version of dune is already installed in your `$PATH`. This is due to [a bug in opam](https://github.com/ocaml/opam/issues/3987). If you face this issue, either uninstall dune before running `opam-bootstrap.sh`, or manage to get opam running by other means, and directly use it to install the dependencies of Belenios. ### Bootstrap fails because of an error with an OPAM package For reproducibility purposes, the `opam-bootstrap.sh` script hardcodes a specific revision of the OPAM repository. However, it may happen that this revision becomes unusable, e.g. the URL of some tarball changes. This may give errors like bad checksums when running the script. To recover from such errors, update your local copy of the OPAM repository with the following commands: source env.sh cd $OPAMROOT/../opam-repository git pull --ff-only opam update then run the `opam install` command that can be found in the `opam-bootstrap.sh` script. ### Missing sources The instructions outlined in this document and in the `opam-bootstrap.sh` script imply downloading files from third-party servers. Sometimes, these servers can be down. For example, you can get: =-=-= Installing ocamlnet.3.7.3 =-=-= ocamlnet.3.7.3 Downloading http://download.camlcity.org/download/ocamlnet-3.7.3.tar.gz [ERROR] http://download.camlcity.org/download/ocamlnet-3.7.3.tar.gz is not available ===== ERROR while installing ocamlnet.3.7.3 ===== Could not get the source for ocamlnet.3.7.3. This can be worked around with the following steps: * source the generated `env.sh` file (you must adapt it if you use an incompatible shell such as tcsh); * download the file from an alternate source (for example [Debian source packages](http://www.debian.org/distrib/packages)); * run `opam pin ` (in the example above, `` would be `ocamlnet`); * resume the installation by running again the `opam install` command found in `opam-bootstrap.sh`; * follow the instructions given at the end of `opam-bootstrap.sh`. ### Errors while compiling ocsigenserver If ocsigenserver fails to install because of a SSL-related error: * edit `opam-bootstrap.sh` by adding ` ssl=0.5.2` to the `opam install` call; * run `./opam-bootstrap.sh`. ### Errors while compiling Belenios itself If you succeeded installing all dependencies, but you get errors while compiling Belenios, maybe you installed an incompatible version of a dependency. The `opam-bootstrap.sh` script is tuned to install only compatible versions; you can have a look at it to get these versions. belenios-2.2-10-gbb6b7ea8/belenios-platform-native.opam0000644000175000017500000000075114476041226021665 0ustar stephsteph# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "2.2" synopsis: "Native implementation of the Belenios platform" maintainer: ["stephane.glondu@inria.fr"] authors: ["Stéphane Glondu"] license: "AGPL-3" depends: [ "dune" {>= "2.7"} "cryptokit" {>= "1.17"} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] belenios-2.2-10-gbb6b7ea8/RELEASE_NOTES.md0000644000175000017500000000766714476041226016470 0ustar stephsteph2.2 === * If nspawn-based containers are used, the `belenios-nspawn` script should be updated on the host. 2.0 === * The spool format has changed in an incompatible way. A migration tool, `belenios-migrate`, is provided to convert from the 1.20 format. It expects a matching `belenios-tool` in the same directory, and an `OCAMLFIND_CONF` environment variable set to the path of a `findlib.conf` file (that can be copied as is from the OPAM directory). To update an existing instance: + stop the instance + make a backup of the spool directory + run `belenios-migrate` with the path to the spool directory (make sure permissions are correct) + perform the rest of the update as usual 1.20 ==== * If you use the scripts in `doc/nspawn`, you must: + update `belenios-nspawn` in your deployment environment + in the `/srv/belenios-containers/$NAME` directory: - `mv belenios belenios-var` - `mkdir -p belenios/etc` - `chown -R 1000:1000 belenios` - `mv belenios-var belenios/var` - `mv belenios/var/ocsigenserver.conf.in belenios/etc` - move other relevant files from `belenios/var` to `belenios/etc` 1.17 ==== * To use the `belenios-server` executable, the syntax of `ocsigenserver.conf.in` changes. Please review the changes to this file since version 1.16. * With the new version of the crypto, giving all parameters of a group with an external file is no longer supported. Allowed groups are hardcoded in the source code and identified by short strings such as `BELENIOS-2048` or `RFC-3526-2048`. These strings must now be used in the configuration file. * The new notion of administrator accounts: + adds a new `accounts` directory, configured in `ocsigenserver.conf.in` + changes the format of the `owner` field of `draft.json`, `metadata.json` and `deleted.json`, which is now the account id (an integer) for new elections. The old format based on the authentication method will continue to be supported for a while, but this support may be dropped in the future. 1.15 ==== * All authentication systems available for voters must be explicitly listed in the configuration file with the new `` directive. Look at `demo/ocsigenserver.conf.in` for examples. In particular, password and (generic) CAS authentications are not shown by default. 1.11 ==== * The switch to unified trustees changed: + the format of the pool: instead of one of `public_keys.jsons` or `threshold.json`, only a single `trustees.json` is expected. The spool will be automatically converted during the first run of this version of the web server. Next versions will only support the new scheme. + the format of `deleted.json` files: `nb_trustees` and `trustees_threshold` fields have been replaced by a new `trustees` field reflecting `trustees.json` structure. No provisions were made to convert existing files. 1.7 === * To upgrade a web server running version 1.6, you need to delete the Ocsipersist store (by default the `ocsidb` file referred in the configuration file). This will archive all validated elections, and delete all draft elections. Additionally, you should clean up the data directory (the one referred in the `` directive in the configuration file) by removing all temporary files (run `rm *.*` in this directory) and private keys (`rm */private_key*.json*`). 1.1 === * To upgrade a web server running version 1.0, you need to delete the Ocsipersist store (by default the `ocsidb` file referred in the configuration file). This will archive all finalized elections, and delete all unfinalized elections (i.e. the elections being prepared). Additionally, you should clean up the data directory (the one referred in the `` directive in the configuration file) by removing all temporary files (run `rm *.*` in this directory) and private keys (`rm */private_key.json`). belenios-2.2-10-gbb6b7ea8/.dockerignore0000644000175000017500000000002714476041226016551 0ustar stephsteph**/node_modules /env.shbelenios-2.2-10-gbb6b7ea8/belenios-platform.opam0000644000175000017500000000070414476041226020377 0ustar stephsteph# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "2.2" synopsis: "Definition of the Belenios platform" maintainer: ["stephane.glondu@inria.fr"] authors: ["Stéphane Glondu"] license: "AGPL-3" depends: [ "dune" {>= "2.7"} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] belenios-2.2-10-gbb6b7ea8/belenios.opam0000644000175000017500000000076414476041226016563 0ustar stephsteph# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "2.2" synopsis: "Belenios meta-package" maintainer: ["stephane.glondu@inria.fr"] authors: ["Stéphane Glondu"] license: "AGPL-3" depends: [ "dune" {>= "2.7"} "belenios-tool" {= version} "belenios-server" {= version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] belenios-2.2-10-gbb6b7ea8/demo/0002755000175000017500000000000014476041226015024 5ustar stephstephbelenios-2.2-10-gbb6b7ea8/demo/mime.types0000644000175000017500000003570414476041226017050 0ustar stephsteph# This is a comment. I love comments. # This file controls what Internet media types are sent to the client for # given file extension(s). Sending the correct media type to the client # is important so they know how to handle the content of the file. # Extra types can either be added here or by using an AddType directive # in your config files. For more information about Internet media types, # please read RFC 2045, 2046, 2047, 2048, and 2077. The Internet media type # registry is at . # Belenios needs a custom mimetypes file because the default one does not recognize files with .mjs extension as Javascript files. # MIME type Extensions application/activemessage application/andrew-inset ez application/applefile application/atom+xml atom application/atomicmail application/batch-smtp application/beep+xml application/cals-1840 application/cnrp+xml application/commonground application/cpl+xml application/cybercash application/dca-rft application/dec-dx application/dvcs application/edi-consent application/edifact application/edi-x12 application/eshop application/font-tdpfr application/http application/hyperstudio application/iges application/index application/index.cmd application/index.obj application/index.response application/index.vnd application/iotp application/ipp application/isup application/mac-binhex40 hqx application/mac-compactpro cpt application/macwriteii application/marc application/mathematica application/mathml+xml mathml application/msword doc application/news-message-id application/news-transmission application/ocsp-request application/ocsp-response application/octet-stream bin dms lha lzh exe class so dll dmg application/oda oda application/ogg ogg application/parityfec application/pdf pdf application/pgp-encrypted application/pgp-keys application/pgp-signature application/pkcs10 application/pkcs7-mime application/pkcs7-signature application/pkix-cert application/pkix-crl application/pkixcmp application/postscript ai eps ps application/prs.alvestrand.titrax-sheet application/prs.cww application/prs.nprend application/prs.plucker application/qsig application/rdf+xml rdf application/reginfo+xml application/remote-printing application/riscos application/rtf application/sdp application/set-payment application/set-payment-initiation application/set-registration application/set-registration-initiation application/sgml application/sgml-open-catalog application/sieve application/slate application/smil smi smil application/srgs gram application/srgs+xml grxml application/timestamp-query application/timestamp-reply application/tve-trigger application/vemmi application/vnd.3gpp.pic-bw-large application/vnd.3gpp.pic-bw-small application/vnd.3gpp.pic-bw-var application/vnd.3gpp.sms application/vnd.3m.post-it-notes application/vnd.accpac.simply.aso application/vnd.accpac.simply.imp application/vnd.acucobol application/vnd.acucorp application/vnd.adobe.xfdf application/vnd.aether.imp application/vnd.amiga.ami application/vnd.anser-web-certificate-issue-initiation application/vnd.anser-web-funds-transfer-initiation application/vnd.audiograph application/vnd.blueice.multipass application/vnd.bmi application/vnd.bw-fontobject eot application/vnd.businessobjects application/vnd.canon-cpdl application/vnd.canon-lips application/vnd.cinderella application/vnd.claymore application/vnd.commerce-battelle application/vnd.commonspace application/vnd.contact.cmsg application/vnd.cosmocaller application/vnd.criticaltools.wbs+xml application/vnd.ctc-posml application/vnd.cups-postscript application/vnd.cups-raster application/vnd.cups-raw application/vnd.curl application/vnd.cybank application/vnd.data-vision.rdz application/vnd.dna application/vnd.dpgraph application/vnd.dreamfactory application/vnd.dxr application/vnd.ecdis-update application/vnd.ecowin.chart application/vnd.ecowin.filerequest application/vnd.ecowin.fileupdate application/vnd.ecowin.series application/vnd.ecowin.seriesrequest application/vnd.ecowin.seriesupdate application/vnd.enliven application/vnd.epson.esf application/vnd.epson.msf application/vnd.epson.quickanime application/vnd.epson.salt application/vnd.epson.ssf application/vnd.ericsson.quickcall application/vnd.eudora.data application/vnd.fdf application/vnd.ffsns application/vnd.fints application/vnd.flographit application/vnd.framemaker application/vnd.fsc.weblaunch application/vnd.fujitsu.oasys application/vnd.fujitsu.oasys2 application/vnd.fujitsu.oasys3 application/vnd.fujitsu.oasysgp application/vnd.fujitsu.oasysprs application/vnd.fujixerox.ddd application/vnd.fujixerox.docuworks application/vnd.fujixerox.docuworks.binder application/vnd.fut-misnet application/vnd.grafeq application/vnd.groove-account application/vnd.groove-help application/vnd.groove-identity-message application/vnd.groove-injector application/vnd.groove-tool-message application/vnd.groove-tool-template application/vnd.groove-vcard application/vnd.hbci application/vnd.hhe.lesson-player application/vnd.hp-hpgl application/vnd.hp-hpid application/vnd.hp-hps application/vnd.hp-pcl application/vnd.hp-pclxl application/vnd.httphone application/vnd.hzn-3d-crossword application/vnd.ibm.afplinedata application/vnd.ibm.electronic-media application/vnd.ibm.minipay application/vnd.ibm.modcap application/vnd.ibm.rights-management application/vnd.ibm.secure-container application/vnd.informix-visionary application/vnd.intercon.formnet application/vnd.intertrust.digibox application/vnd.intertrust.nncp application/vnd.intu.qbo application/vnd.intu.qfx application/vnd.irepository.package+xml application/vnd.is-xpr application/vnd.japannet-directory-service application/vnd.japannet-jpnstore-wakeup application/vnd.japannet-payment-wakeup application/vnd.japannet-registration application/vnd.japannet-registration-wakeup application/vnd.japannet-setstore-wakeup application/vnd.japannet-verification application/vnd.japannet-verification-wakeup application/vnd.jisp application/vnd.kde.karbon application/vnd.kde.kchart application/vnd.kde.kformula application/vnd.kde.kivio application/vnd.kde.kontour application/vnd.kde.kpresenter application/vnd.kde.kspread application/vnd.kde.kword application/vnd.kenameaapp application/vnd.koan application/vnd.liberty-request+xml application/vnd.llamagraphics.life-balance.desktop application/vnd.llamagraphics.life-balance.exchange+xml application/vnd.lotus-1-2-3 application/vnd.lotus-approach application/vnd.lotus-freelance application/vnd.lotus-notes application/vnd.lotus-organizer application/vnd.lotus-screencam application/vnd.lotus-wordpro application/vnd.mcd application/vnd.mediastation.cdkey application/vnd.meridian-slingshot application/vnd.micrografx.flo application/vnd.micrografx.igx application/vnd.mif mif application/vnd.minisoft-hp3000-save application/vnd.mitsubishi.misty-guard.trustweb application/vnd.mobius.daf application/vnd.mobius.dis application/vnd.mobius.mbk application/vnd.mobius.mqy application/vnd.mobius.msl application/vnd.mobius.plc application/vnd.mobius.txf application/vnd.mophun.application application/vnd.mophun.certificate application/vnd.motorola.flexsuite application/vnd.motorola.flexsuite.adsi application/vnd.motorola.flexsuite.fis application/vnd.motorola.flexsuite.gotap application/vnd.motorola.flexsuite.kmr application/vnd.motorola.flexsuite.ttc application/vnd.motorola.flexsuite.wem application/vnd.mozilla.xul+xml xul application/vnd.ms-artgalry application/vnd.ms-asf application/vnd.ms-excel xls application/vnd.ms-fontobject eot application/vnd.ms-lrm application/vnd.ms-powerpoint ppt application/vnd.ms-project application/vnd.ms-tnef application/vnd.ms-works application/vnd.ms-wpl application/vnd.mseq application/vnd.msign application/vnd.music-niff application/vnd.musician application/vnd.netfpx application/vnd.noblenet-directory application/vnd.noblenet-sealer application/vnd.noblenet-web application/vnd.novadigm.edm application/vnd.novadigm.edx application/vnd.novadigm.ext application/vnd.obn application/vnd.osa.netdeploy application/vnd.palm application/vnd.pg.format application/vnd.pg.osasli application/vnd.powerbuilder6 application/vnd.powerbuilder6-s application/vnd.powerbuilder7 application/vnd.powerbuilder7-s application/vnd.powerbuilder75 application/vnd.powerbuilder75-s application/vnd.previewsystems.box application/vnd.publishare-delta-tree application/vnd.pvi.ptid1 application/vnd.pwg-multiplexed application/vnd.pwg-xhtml-print+xml application/vnd.quark.quarkxpress application/vnd.rapid application/vnd.s3sms application/vnd.sealed.net application/vnd.seemail application/vnd.shana.informed.formdata application/vnd.shana.informed.formtemplate application/vnd.shana.informed.interchange application/vnd.shana.informed.package application/vnd.smaf application/vnd.sss-cod application/vnd.sss-dtf application/vnd.sss-ntf application/vnd.street-stream application/vnd.svd application/vnd.swiftview-ics application/vnd.triscape.mxs application/vnd.trueapp application/vnd.truedoc application/vnd.ufdl application/vnd.uplanet.alert application/vnd.uplanet.alert-wbxml application/vnd.uplanet.bearer-choice application/vnd.uplanet.bearer-choice-wbxml application/vnd.uplanet.cacheop application/vnd.uplanet.cacheop-wbxml application/vnd.uplanet.channel application/vnd.uplanet.channel-wbxml application/vnd.uplanet.list application/vnd.uplanet.list-wbxml application/vnd.uplanet.listcmd application/vnd.uplanet.listcmd-wbxml application/vnd.uplanet.signal application/vnd.vcx application/vnd.vectorworks application/vnd.vidsoft.vidconference application/vnd.visio application/vnd.visionary application/vnd.vividence.scriptfile application/vnd.vsf application/vnd.wap.sic application/vnd.wap.slc application/vnd.wap.wbxml wbxml application/vnd.wap.wmlc wmlc application/vnd.wap.wmlscriptc wmlsc application/vnd.webturbo application/vnd.wrq-hp3000-labelled application/vnd.wt.stf application/vnd.wv.csp+wbxml application/vnd.xara application/vnd.xfdl application/vnd.yamaha.hv-dic application/vnd.yamaha.hv-script application/vnd.yamaha.hv-voice application/vnd.yellowriver-custom-menu application/voicexml+xml vxml application/watcherinfo+xml application/whoispp-query application/whoispp-response application/wita application/wordperfect5.1 application/x-bcpio bcpio application/x-cdlink vcd application/x-chess-pgn pgn application/x-compress application/x-cpio cpio application/x-csh csh application/x-director dcr dir dxr application/x-dvi dvi application/x-font-ttf ttf application/x-font-woff woff application/x-futuresplash spl application/x-gtar gtar application/x-gzip application/x-hdf hdf application/x-javascript js mjs application/x-koan skp skd skt skm application/x-latex latex application/x-netcdf nc cdf application/x-sh sh application/x-shar shar application/x-shockwave-flash swf application/x-stuffit sit application/x-sv4cpio sv4cpio application/x-sv4crc sv4crc application/x-tar tar application/x-tcl tcl application/x-tex tex application/x-texinfo texinfo texi application/x-troff t tr roff application/x-troff-man man application/x-troff-me me application/x-troff-ms ms application/x-ustar ustar application/x-wais-source src application/x400-bp application/xhtml+xml xhtml xht application/xslt+xml xslt application/xml xml xsl application/xml-dtd dtd application/xml-external-parsed-entity application/zip zip audio/32kadpcm audio/amr audio/amr-wb audio/basic au snd audio/cn audio/dat12 audio/dsr-es201108 audio/dvi4 audio/evrc audio/evrc0 audio/g722 audio/g.722.1 audio/g723 audio/g726-16 audio/g726-24 audio/g726-32 audio/g726-40 audio/g728 audio/g729 audio/g729D audio/g729E audio/gsm audio/gsm-efr audio/l8 audio/l16 audio/l20 audio/l24 audio/lpc audio/midi mid midi kar audio/mpa audio/mpa-robust audio/mp4a-latm audio/mpeg mpga mp2 mp3 audio/parityfec audio/pcma audio/pcmu audio/prs.sid audio/qcelp audio/red audio/smv audio/smv0 audio/telephone-event audio/tone audio/vdvi audio/vnd.3gpp.iufp audio/vnd.cisco.nse audio/vnd.cns.anp1 audio/vnd.cns.inf1 audio/vnd.digital-winds audio/vnd.everad.plj audio/vnd.lucent.voice audio/vnd.nortel.vbk audio/vnd.nuera.ecelp4800 audio/vnd.nuera.ecelp7470 audio/vnd.nuera.ecelp9600 audio/vnd.octel.sbc audio/vnd.qcelp audio/vnd.rhetorex.32kadpcm audio/vnd.vmx.cvsd audio/x-aiff aif aiff aifc audio/x-alaw-basic audio/x-mpegurl m3u audio/x-pn-realaudio ram ra audio/x-pn-realaudio-plugin application/vnd.rn-realmedia rm audio/x-wav wav chemical/x-pdb pdb chemical/x-xyz xyz image/bmp bmp image/cgm cgm image/g3fax image/gif gif image/ief ief image/jpeg jpeg jpg jpe image/naplps image/png png image/prs.btif image/prs.pti image/svg+xml svg image/t38 image/tiff tiff tif image/tiff-fx image/vnd.cns.inf2 image/vnd.djvu djvu djv image/vnd.dwg image/vnd.dxf image/vnd.fastbidsheet image/vnd.fpx image/vnd.fst image/vnd.fujixerox.edmics-mmr image/vnd.fujixerox.edmics-rlc image/vnd.globalgraphics.pgb image/vnd.mix image/vnd.ms-modi image/vnd.net-fpx image/vnd.svf image/vnd.wap.wbmp wbmp image/vnd.xiff image/x-cmu-raster ras image/x-icon ico image/x-portable-anymap pnm image/x-portable-bitmap pbm image/x-portable-graymap pgm image/x-portable-pixmap ppm image/x-rgb rgb image/x-xbitmap xbm image/x-xpixmap xpm image/x-xwindowdump xwd message/delivery-status message/disposition-notification message/external-body message/http message/news message/partial message/rfc822 message/s-http message/sip message/sipfrag model/iges igs iges model/mesh msh mesh silo model/vnd.dwf model/vnd.flatland.3dml model/vnd.gdl model/vnd.gs-gdl model/vnd.gtw model/vnd.mts model/vnd.parasolid.transmit.binary model/vnd.parasolid.transmit.text model/vnd.vtu model/vrml wrl vrml multipart/alternative multipart/appledouble multipart/byteranges multipart/digest multipart/encrypted multipart/form-data multipart/header-set multipart/mixed multipart/parallel multipart/related multipart/report multipart/signed multipart/voice-message text/calendar ics ifb text/css css text/directory text/enriched text/html html htm text/parityfec text/plain asc txt text/prs.lines.tag text/rfc822-headers text/richtext rtx text/rtf rtf text/sgml sgml sgm text/t140 text/tab-separated-values tsv text/uri-list text/vnd.abc text/vnd.curl text/vnd.dmclientscript text/vnd.fly text/vnd.fmi.flexstor text/vnd.in3d.3dml text/vnd.in3d.spot text/vnd.iptc.nitf text/vnd.iptc.newsml text/vnd.latex-z text/vnd.motorola.reflex text/vnd.ms-mediapackage text/vnd.net2phone.commcenter.command text/vnd.sun.j2me.app-descriptor text/vnd.wap.si text/vnd.wap.sl text/vnd.wap.wml wml text/vnd.wap.wmlscript wmls text/x-setext etx text/xml text/xml-external-parsed-entity video/bmpeg video/bt656 video/celb video/dv video/h261 video/h263 video/h263-1998 video/h263-2000 video/jpeg video/mp1s video/mp2p video/mp2t video/mp4v-es video/mpv video/mpeg mpeg mpg mpe video/nv video/parityfec video/pointer video/quicktime qt mov video/smpte292m video/vnd.fvt video/vnd.motorola.video video/vnd.motorola.videop video/vnd.mpegurl mxu m4u video/vnd.nokia.interleaved-multimedia video/vnd.objectvideo video/vnd.vivo video/x-msvideo avi video/x-sgi-movie movie x-conference/x-cooltalk ice belenios-2.2-10-gbb6b7ea8/demo/dummy_logins.txt0000644000175000017500000000000714476041226020266 0ustar stephsteph admin belenios-2.2-10-gbb6b7ea8/demo/dune0000644000175000017500000000033614476041226015702 0ustar stephsteph(install (files (run-server.sh as belenios-start-server) (stop-server.sh as belenios-stop-server)) (section bin) (package belenios-server)) (install (files mime.types) (section share) (package belenios-server)) belenios-2.2-10-gbb6b7ea8/demo/password_db.csv0000644000175000017500000000107714476041226020053 0ustar stephstephuser1,cUf6jcdNrmlh,a57115ac8370930e0c98ea8b8c7363b1f1ac63ed13c6b4a35d0378bd0ec6b023,user1@example.com,RP91JMQkL6Lz user2,ngnP3tiMjyeu,de54c510f8aaab51b4213df32e1898d32515f59cb8e8eb82091e0e5af5f1dd1b,user2@example.com,uBSayPjIn1JE user3,AXW4PJSkt6UN,4b42cd9bc684666afb5ebbb9f53f910659ce0adc1502e0590309a54f92cf1614,user3@example.com,G8ZteLqOlSwX user4,wZqCA6cCgPsQ,d2d9a8799caab6e616f9ef190f0182b7017f5e5fdccf4ae9bd600a7192924778,user4@example.com,0QHonx90bPQE user5,TnOZ3nYSHiiH,5da391f59f8024124ec90add865a96556af38e50f884804aaa6f76004a3f0bcc,user5@example.com,hUjU6ARrBrUS belenios-2.2-10-gbb6b7ea8/demo/ocsigenserver.conf.in0000644000175000017500000000745614476041226021170 0ustar stephsteph 127.0.0.1:8001 _SHAREDIR_/mime.types _VARDIR_/log _VARDIR_/lib _VARDIR_/upload 5120kB 500 _RUNDIR_/ocsigenserver_command utf-8