fork(4) download
copy 
  1. ; rsa backdoor encryption
  2.  
  3. (define (digits n . args)
  4.   (let ((b (if (null? args) 10 (car args))))
  5.     (let loop ((n n) (d '()))
  6.       (if (zero? n) d
  7.           (loop (quotient n b)
  8.                 (cons (modulo n b) d))))))
  9.  
  10. (define (undigits ds . args)
  11.   (let ((b (if (null? args) 10 (car args))))
  12.     (let loop ((ds ds) (n 0))
  13.       (if (null? ds) n
  14.           (loop (cdr ds) (+ (* n b) (car ds)))))))
  15.  
  16. (define (isqrt n)
  17.   (if (not (and (positive? n) (integer? n)))
  18.       (error 'isqrt "must be positive integer")
  19.       (let loop ((x n))
  20.         (let ((y (quotient (+ x (quotient n x)) 2)))
  21.           (if (< y x) (loop y) x)))))
  22.  
  23. (define square?
  24.   (let ((q11 (make-vector 11 #f))
  25.         (q63 (make-vector 63 #f))
  26.         (q64 (make-vector 64 #f))
  27.         (q65 (make-vector 65 #f)))
  28.     (do ((k 0 (+ k 1))) ((< 5 k))
  29.       (vector-set! q11 (modulo (* k k) 11) #t))
  30.     (do ((k 0 (+ k 1))) ((< 31 k))
  31.       (vector-set! q63 (modulo (* k k) 63) #t))
  32.     (do ((k 0 (+ k 1))) ((< 31 k))
  33.       (vector-set! q64 (modulo (* k k) 64) #t))
  34.     (do ((k 0 (+ k 1))) ((< 32 k))
  35.       (vector-set! q65 (modulo (* k k) 65) #t))
  36.     (lambda (n)
  37.       (if (not (vector-ref q64 (modulo n 64))) #f
  38.         (let ((r (modulo n 45045)))
  39.           (if (not (vector-ref q63 (modulo r 63))) #f
  40.             (if (not (vector-ref q65 (modulo r 65))) #f
  41.               (if (not (vector-ref q11 (modulo r 11))) #f
  42.                 (let ((q (isqrt n)))
  43.                   (if (= (* q q) n) q #f))))))))))
  44.  
  45. (define (expm b e m)
  46.   (define (m* x y) (modulo (* x y) m))
  47.   (cond ((zero? e) 1)
  48.         ((even? e) (expm (m* b b) (/ e 2) m))
  49.         (else (m* b (expm (m* b b) (/ (- e 1) 2) m)))))
  50.  
  51. (define (euclid x y)
  52.   (let loop ((a 1) (b 0) (g x) (u 0) (v 1) (w y))
  53.     (if (zero? w) (values a b g)
  54.       (let ((q (quotient g w)))
  55.         (loop u v w (- a (* q u)) (- b (* q v)) (- g (* q w)))))))
  56.  
  57. (define (inverse x m)
  58.   (if (not (= (gcd x m) 1))
  59.       (error 'inverse "divisor must be coprime to modulus")
  60.       (call-with-values
  61.         (lambda () (euclid x m))
  62.         (lambda (a b g) (modulo a m)))))
  63.  
  64. (define (primes n) ; list of primes not exceeding n
  65.   (let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
  66.     (let loop ((i 0) (p 3) (ps (list 2)))
  67.       (cond ((< n (* p p))
  68.               (do ((i i (+ i 1)) (p p (+ p 2))
  69.                    (ps ps (if (vector-ref bits i) (cons p ps) ps)))
  70.                   ((= i len) (reverse ps))))
  71.             ((vector-ref bits i)
  72.               (do ((j (+ (* 2 i i) (* 6 i) 3) (+ j p)))
  73.                   ((<= len j) (loop (+ i 1) (+ p 2) (cons p ps)))
  74.                 (vector-set! bits j #f)))
  75.             (else (loop (+ i 1) (+ p 2) ps))))))
  76.  
  77. (define prime? ; strong pseudoprime to prime bases less than 100
  78.   (let* ((ps (primes 100)) (p100 (apply * ps)))
  79.     (lambda (n)
  80.       (define (expm b e m)
  81.         (let loop ((b b) (e e) (x 1))
  82.           (if (zero? e) x
  83.             (loop (modulo (* b b) m) (quotient e 2)
  84.                   (if (odd? e) (modulo (* b x) m) x)))))
  85.       (define (spsp? n a) ; #t if n is a strong pseudoprime base a
  86.         (do ((d (- n 1) (/ d 2)) (s 0 (+ s 1)))
  87.             ((odd? d) (if (= (expm a d n) 1) #t
  88.               (do ((r 0 (+ r 1)))
  89.                   ((or (= (expm a (* d (expt 2 r)) n) (- n 1)) (= r s))
  90.                     (< r s)))))))
  91.       (if (< n 2) #f (if (< 1 (gcd n p100)) (if (member n ps) #t #f)
  92.         (do ((ps ps (cdr ps)))
  93.             ((or (null? ps) (not (spsp? n (car ps)))) (null? ps))))))))
  94.  
  95. (define (next-prime n) ; smallest prime larger than n
  96.   (define (wheel n)
  97.     (vector-ref (vector 1 6 5 4 3 2 1 4 3 2 1 2 1 4
  98.       3 2 1 2 1 4 3 2 1 6 5 4 3 2 1 2) (modulo n 30)))
  99.   (if (< n 2) 2 (if (< n 3) 3 (if (< n 5) 5
  100.     (let loop ((p (+ n (wheel n))))
  101.       (if (prime? p) p (loop (+ p (wheel p)))))))))
  102.  
  103. (define (prev-prime n) ; largest prime smaller than n
  104.   (define (wheel n)
  105.     (vector-ref (vector 1 2 1 2 3 4 5 6 1 2 3 4 1 2
  106.       1 2 3 4 1 2 1 2 3 4 1 2 3 4 5 6) (modulo n 30)))
  107.   (if (<= n 2) #f (if (<= n 3) 2 (if (<= n 5) 3 (if (<= n 7) 5
  108.     (let loop ((p (- n (wheel n))))
  109.       (if (prime? p) p (loop (- p (wheel p))))))))))
  110.  
  111. (define random-prime ; random prime with n digits in base b
  112.   (let* (;(seed (time-second (current-time))) ; chez
  113.         ;(seed (current-seconds)) ; racket/chicken
  114.         (seed (current-time)) ; guile
  115.         ;(seed (inexact->exact (round (time->seconds (current-time))))) ; gambit
  116.          (rand ; knuth linear congruential method
  117.            (let* ((a 69069) (c 1234567) (m 4294967296))
  118.              (lambda () (set! seed (modulo (+ (* a seed) c) m))
  119.                         (/ seed m))))
  120.          (randint (lambda (lo hi) (+ lo (floor (* (rand) (- hi lo)))))))
  121.     (lambda (n . base)
  122.       (let ((b (if (pair? base) (car base) 2)))
  123.         (let loop ((p (randint 1 b)) (n (- n 1)))
  124.           (if (zero? n) (prev-prime p)
  125.             (loop (+ (* p b) (randint 0 b)) (- n 1))))))))
  126.  
  127. (define (factors n) ; fermat
  128.   (if (even? n) (cons 2 (factors (/ n 2)))
  129.     (let ((s (+ (isqrt n) 1)))
  130.       (let loop ((u (+ s s 1)) (v 1) (r (- (* s s) n)))
  131.         (cond ((positive? r) (loop u (+ v 2) (- r v)))
  132.               ((negative? r) (loop (+ u 2) v (+ r u)))
  133.               ((= (- u v) 2) (list (/ (+ u v -2) 2)))
  134.               (else (append (factors (/ (+ u v -2) 2))
  135.                             (factors (/ (- u v) 2)))))))))
  136.  
  137. (define (encipher str)
  138.   (undigits
  139.     (map (lambda (c) (- (char->integer c) 65))
  140.          (string->list str))
  141.     26))
  142.  
  143. (define (decipher x)
  144.   (list->string
  145.     (map (lambda (x) (integer->char (+ x 65)))
  146.          (digits x 26))))
  147.  
  148. (define a 11314087)
  149.  
  150. (define (backdoor x-prime e)
  151.   (let loop ((k x-prime))
  152.     (let ((x (+ (* a k) x-prime)))
  153.       (if (or (< 1 (gcd e (- x 1)))
  154.               (not (= (modulo x 4) 3))
  155.               (not (prime? x)))
  156.           (loop (+ k 1))
  157.           x))))
  158.  
  159. (define (keygen t*2 e)
  160.   (let* ((t (quotient t*2 2))
  161.          (len (quotient t 4))
  162.          (p-prime (random-prime len 2))
  163.          (q-prime (random-prime len 2))
  164.          (p (backdoor p-prime e))
  165.          (q (backdoor q-prime e))
  166.          (n (* p q))
  167.          (d (inverse e (* (- p 1) (- q 1)))))
  168.     (values n d)))
  169.  
  170. (define (crypt text modulus key)
  171.   (expm text key modulus))
  172.  
  173. (define t*2 64)
  174. (define e 65537)
  175. (define n #f)
  176. (define d #f)
  177. (call-with-values
  178.   (lambda () (keygen t*2 e))
  179.   (lambda (nn dd)
  180.     (set! n nn)
  181.     (set! d dd)))
  182.  
  183. (display n) (newline)
  184. (display d) (newline)
  185.  
  186. (display (crypt (encipher "PRAXIS") n e)) (newline)
  187. (display (decipher (crypt (crypt (encipher "PRAXIS") n e) n d))) (newline)
  188.  
  189. (display (factors (modulo n a))) (newline)
  190. (display (backdoor 157 e)) (newline)
  191. (display (backdoor 137 e)) (newline)
  192. (display (* 2375958427 1787625883)) (newline)
  193. (display (inverse e (* 2375958426 1787625882))) (newline)
  194. (display (decipher (crypt 3852399687424634890
  195.                           4247324781037166041
  196.                           646136198260976393))) (newline)
Success #stdin #stdout 0.35s 9432KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
5325156970506809321
778009032258160973
1359549520129802330
PRAXIS
(151 131)
2375958427
1787625883
4247324781037166041
646136198260976393
PRAXIS
https://ideone.com/tFdB4P
language:
Scheme (guile 2.2.4)
created:
8 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!