One-time pad/Racket: Difference between revisions
Content added Content deleted
(=={{header|Racket}}== implementation added) |
(No difference)
|
Revision as of 07:53, 31 March 2015
This is a Racket implementation of the One-time pad task.
We have encryption decryption and pad file management all bundled together here.
<lang>#lang racket (require srfi/14) ; character sets
- Pseudo-Vigenere implementation
(define (vigenere-en/decrypt-from-alphabet ab... default-char)
(define ab...-cs (string->char-set ab...)) (define m (char-set-size ab...-cs)) (unless (char-set-contains? ab...-cs default-char) (error 'en/decrypt-from-alphabet "default-char:~s must be member of alphabet:~s" default-char ab...)) (define chr# (for/hash ((i (in-naturals)) (c ab...)) (values i c))) (define ord# (for/hash ((i (in-naturals)) (c ab...)) (values c i))) (define (normalise-char c) (cond [(char-set-contains? ab...-cs c) c] [(let ((C (char-upcase c))) (and (char-set-contains? ab...-cs C) C)) => values] [else default-char])) (define (encrypt k c) (hash-ref chr# (modulo (+ (hash-ref ord# k) (hash-ref ord# (normalise-char c))) m))) (define (decrypt k c) (hash-ref chr# (modulo (- (hash-ref ord# c) (hash-ref ord# k)) m))) (values ab... encrypt decrypt))
(define-values (AB... ENCRYPT DECRYPT)
;; I'm no cryptanalyst, but if (length of the alhabet mod 256 != 0), I'm concerned that there ;; *might* be some weakening of the pad (and it gives an excuse for a slightly larger character set) (vigenere-en/decrypt-from-alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ_.,!/?" #\_))
- /dev/random is good but slow. /dev/urandom is a bit faster... the racket PRNG could be too
- predictable. (But there ain't no /dev/u?random on Windows (AFAIK)
(define (default-random-number-generator rfn)
(define prng (λ () (random #x10000))) (define frng (λ () (with-input-from-file rfn (λ () (integer-bytes->integer (read-bytes 4) #f))))) (cond [(not rfn) (eprintf "WARNING: using build in PRNG~%") prng] [(not (file-exists? rfn)) (eprintf "WARNING: file:~s does not exist. Using build in PRNG~%" rfn) prng] [else frng]))
- Writes the pad to (current-output-port). If dots? is enabled, then progress is reflected on
- (current-error-port) -- /dev/random can be very slow!
(define (generate-otp
n-lines #:chars/line (c/l 48) #:chars/block (c/b 6) #:alphabet (ab... AB...) #:meta-data (meta-data #f) #:dots? (dots? #t) #:random-file-name (rfn #f) #:rng (rng (default-random-number-generator rfn))) (define ab...-len (string-length ab...)) (display "# One-time-pad") (when meta-data (printf "~%# ~s" meta-data)) (for* ((line n-lines) #:when (begin (newline) (when dots? (newline (current-error-port)))) (chr c/l)) (define rnd-int (rng)) (when (zero? (modulo chr c/b)) (write-char #\space) (when dots? (write-char #\space (current-error-port)))) (write-char (string-ref ab... (modulo rnd-int ab...-len))) (when dots? (write-char #\. (current-error-port)))) (newline) (when dots? (newline (current-error-port))) (displayln "# End one-time-pad"))
- Wraps the above to write to the given otp-file-name
(define (generate-pad-file
otp-file-name n-lines #:chars/line (c/l 48) #:chars/block (c/b 6) #:alphabet (ab... AB...) #:meta-data (mta #f) #:dots? (dots? #t) #:exists (exists 'error) #:random-file-name (rfn #f) #:rng (rng (default-random-number-generator rfn))) (with-handlers ([exn:fail:filesystem? (λ (x) (eprintf "error generating file: ~s~%" (exn-message x)) #f)]) (with-output-to-file otp-file-name #:exists exists (λ () (generate-otp n-lines #:chars/line c/l #:chars/block c/b #:alphabet ab... #:meta-data mta #:dots? dots? #:random-file-name rfn #:rng rng)))))
- OTP FILE "Management" -- scratches lines for you
(define (otp-scratch-lines f-name lines-used)
(define-values (in out) (open-input-output-file f-name #:exists 'update)) (let loop ((fp (file-position in)) (line (read-line in)) (lines-used lines-used)) (cond [(zero? lines-used) (void)] [(eof-object? line) (error "otp-scratch-lines: ran out of pad!")] [(regexp-match #px"^[#\\-]" line) (loop (file-position in) (read-line in) lines-used)] [else (define old-fp (file-position in)) (file-position out fp) (write-char #\- out) (flush-output out) (file-position in old-fp) (loop old-fp (read-line in) (sub1 lines-used))])) (close-input-port in) (close-output-port out))
- Produce two functions that taks a pad-file and a string
(define (make-pad-functions encrypt-fn decrypt-fn)
(define ((en/decrypt-from-pad crypto-fn) pad-file str) (define (use-otp-line line-chars s e lines-used) (cond [(null? s) (values (list->string (reverse e)) (add1 lines-used))] [(null? line-chars) (sub-d/e-f-p (read-line) s e (add1 lines-used))] [(char=? (car line-chars) #\space) (use-otp-line (cdr line-chars) s e lines-used)] [else (use-otp-line (cdr line-chars) (cdr s) (cons (crypto-fn (car line-chars) (car s)) e) lines-used)])) (define (sub-d/e-f-p line s e lines-used) (cond [(null? s) (values (list->string (reverse e)) lines-used)] [(eof-object? line) (error 'de/encrypt-from-pad "ran out of pad!")] [(regexp-match #px"^[#\\-]" line) (sub-d/e-f-p (read-line) s e lines-used)] [else (use-otp-line (string->list line) s e lines-used)])) (with-input-from-file pad-file (λ () (sub-d/e-f-p (read-line) (string->list str) null 0)))) (values (en/decrypt-from-pad encrypt-fn) (en/decrypt-from-pad encrypt-fn)))
(define-values (encrypt-from-pad decrypt-from-pad)
(make-pad-functions ENCRYPT DECRYPT))
- Testing
(module+ test
(generate-pad-file "test.otp" 4 #:random-file-name "/dev/urandom" ; is faster #:exists 'replace) ;; pad-file as generated (printf "Pad file as generated:~%~a~%" (file->string "test.otp")) (define-values (enc enc-lines-used) (encrypt-from-pad "test.otp" #<<EOS
Mary had a little lamb! We've heard it all before. Mary had a little lamb, and then she had some more. EOS
)) (printf "Cyphertext: ~s~%" enc) (define-values (dec dec-lines-used) (decrypt-from-pad "test.otp" enc)) (printf "Plaintext: ~s~%" dec) (printf "Scratch: ~s lines from your pad file~%" enc-lines-used) (otp-scratch-lines "test.otp" enc-lines-used) (printf "Pad file after scratching:~%~a~%" (file->string "test.otp")) )</lang>