From df489a1b372b2c8fdeb33bfb64146fc98f7c1e73 Mon Sep 17 00:00:00 2001 From: David Florness Date: Sun, 9 Feb 2020 19:41:17 -0700 Subject: [PATCH] Remove old hackathon stuff and make secret sharing code the norm --- secret-sharing/bulletin.rkt => bulletin.rkt | 0 secret-sharing/client.rkt => client.rkt | 0 crypto.rkt | 24 ----- main.rkt | 70 ------------- server.rkt | 110 -------------------- 5 files changed, 204 deletions(-) rename secret-sharing/bulletin.rkt => bulletin.rkt (100%) rename secret-sharing/client.rkt => client.rkt (100%) delete mode 100644 crypto.rkt delete mode 100644 main.rkt delete mode 100644 server.rkt diff --git a/secret-sharing/bulletin.rkt b/bulletin.rkt similarity index 100% rename from secret-sharing/bulletin.rkt rename to bulletin.rkt diff --git a/secret-sharing/client.rkt b/client.rkt similarity index 100% rename from secret-sharing/client.rkt rename to client.rkt diff --git a/crypto.rkt b/crypto.rkt deleted file mode 100644 index fb90c7a..0000000 --- a/crypto.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require math/number-theory) - -(provide keylen e gen-key) - -(define keylen 1024) -(define e 65537) - -(define (gen-key) - (define (gen) - (let* ([p (random-prime (expt 2 (/ keylen 2)))] - [q (random-prime (expt 2 (/ keylen 2)))] - [λn (lcm (sub1 p) (sub1 q))]) - (if (and (eq? (gcd e λn) 1) - (not (eq? (arithmetic-shift (abs (- p q)) - (- (- (/ keylen 2) 100))) - 0))) - (values p q λn) - (gen)))) - - (let-values ([(p q λn) (gen)]) - (cons (* p q) ; n - (modular-inverse e λn) ; d - ))) diff --git a/main.rkt b/main.rkt deleted file mode 100644 index a7ec98e..0000000 --- a/main.rkt +++ /dev/null @@ -1,70 +0,0 @@ -#lang racket -(require binaryio) -(require racket/random) -(require net/url) -(require json) -(require math/number-theory) -(require "crypto.rkt") - -(define/contract (tallyard-url path) - (-> string? url?) - (string->url (string-append "http://localhost:5598" path))) - -(define candidates (read-json (get-pure-port (tallyard-url "/candidates")))) - -(define/contract (displayln-und s) - (-> string? void?) - (displayln s) - (displayln (make-string (string-length s) #\=))) - -(displayln-und "Log in") - -(display "Username: ") -(define username (read-line)) -(display "Password: ") -(define password (read-line)) - -(displayln-und "You may choose among the following candidates") -(for/list ([i (in-naturals)] - [c candidates]) - (displayln (format "~a) ~a" i c))) - -(display "Your ranking: ") -(define ranking (string-split (read-line))) - -(define n (bytes->integer (port->bytes (get-pure-port (tallyard-url "/key"))) #f)) - -(define m (bytes->integer (string->bytes/utf-8 (string-join ranking ":")) #f)) - -(define r - (let gen ([r (bytes->integer - (crypto-random-bytes (/ keylen 8)) #f)]) - (if (eq? (gcd r n) 1) - r - (gen)))) - -(displayln "creating blinded message...") - -(define M (modulo (* m (expt r e)) n)) - -(displayln "asking for blinded signature...") - -(define S (bytes->integer - (port->bytes (post-pure-port (tallyard-url "/sign") - (integer->bytes M (/ keylen 8) #f))) - #f)) - -(displayln "computing real signature") - -(define s (modulo (* S (modular-inverse r n)) n)) - -(displayln "submitting signed ballot...") - -(define result (bytes->string/utf-8 - (port->bytes - (post-pure-port (tallyard-url "/vote") - (bytes-append (integer->bytes m (/ keylen 8) #f) - (integer->bytes s (/ keylen 8) #f) - ))))) - -(displayln result) diff --git a/server.rkt b/server.rkt deleted file mode 100644 index b1bff7a..0000000 --- a/server.rkt +++ /dev/null @@ -1,110 +0,0 @@ -#lang racket -(require web-server/dispatch - web-server/servlet - web-server/servlet-env - web-server/http) -(require json) -(require "crypto.rkt") -(require binaryio) -(require math/number-theory) - -(define cands (list "ohea" "rtsn" "qfuy")) -(define k (gen-key)) -(define n (car k)) -(define d (cdr k)) - -; how this is not a provided function is beyond me -(define/contract (response/json jsexpr) - (-> jsexpr? response?) - (response/full - 200 #f (current-seconds) #"application/json" - empty (list (jsexpr->bytes jsexpr)))) - -(define/contract (response/text txt) - (-> string? response?) - (response/full - 200 #f (current-seconds) #"text/plain" - empty (list (string->bytes/utf-8 txt)))) - -(define (candidates req) - (response/json cands)) - -(define votes '()) - -(define (submit-vote bstr) - (let foo ([i 0]) - (if (> (bytes-ref bstr i) 0) - (let ([s (bytes->string/utf-8 (subbytes bstr i))]) - (set! votes (cons (map string->number (string-split s ":")) votes)) - (println votes)) - (foo (add1 i))))) - -(define (vote req) - (let* ([data (request-post-data/raw req)] - [m (bytes->integer (subbytes data 0 (/ keylen 8)) #f)] - [s (bytes->integer (subbytes data (/ keylen 8) (* 2 (/ keylen 8))) #f)]) - (if (equal? m (modular-expt s e n)) - (begin - (submit-vote (subbytes data 0 (/ keylen 8))) - (response/text "vote submitted")) - (response/text "invalid signature")))) - -(define (sign req) - (let ([m (bytes->integer (request-post-data/raw req) #f)]) - (response/full - 200 #f (current-seconds) #"application/octet-stream" - empty (list (integer->bytes (modular-expt m d n) (/ keylen 8) #f))))) - -(define (key req) - (response/full - 200 #f (current-seconds) #"application/octet-stream" - empty (list (integer->bytes n (/ keylen 8) #f)))) - -(define/contract (results votes) - (-> (listof (listof (integer-in 0 (sub1 (length cands))))) - (listof (integer-in 0 (sub1 (length cands))))) - (let res ([votes votes] - [firsts (make-immutable-hash - (for/list ([i (in-range (length cands))]) - (cons i (list 0))))] - [done (list)]) - (if (empty? votes) - (if (hash-empty? firsts) - done - (let ([last-place (car (argmin cadr (hash->list firsts)))]) - (res (cdr (hash-ref firsts last-place)) - (hash-remove firsts last-place) - (cons last-place done)))) - (let ([vote (car votes)]) - (res (cdr votes) - (let insert-first ([first (car vote)] - [left (cdr vote)]) - (if (hash-has-key? firsts first) - (hash-update firsts first - (λ (p) (cons (add1 (car p)) - (if (empty? left) - (cdr p) - (cons left (cdr p)))))) - (if (empty? left) - firsts - (insert-first (car left) (cdr left))))) - done))))) - -(define (results-view req) - (response/json (results votes))) - -(define-values (dispatcher url-generator) - (dispatch-rules - [("candidates") candidates] - [("vote") #:method "post" vote] - [("sign") #:method "post" sign] - [("key") key] - [("results") results-view] - [else candidates])) - -(displayln "starting servlet...") -(serve/servlet dispatcher - #:port 5598 - #:command-line? #t - #:servlet-path "" - #:servlet-regexp #rx"") -- 2.38.4