⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

This is a [[Racket]] implementation of the [[One-time pad]] task.

We have encryption decryption and pad file management all bundled together here.

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