5 files changed, 0 insertions(+), 204 deletions(-)

R secret-sharing/bulletin.rkt => bulletin.rkt
R secret-sharing/client.rkt => client.rkt
D crypto.rkt
D main.rkt
D server.rkt

@@ 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
-          )))

@@ 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)

@@ 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"")