FC2ブログ
--.--
--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

03.31
Sun
Gaucheで公開鍵暗号のRSAで鍵を作って暗号化・複合化するやつのてすと

素数判定にはフェルマーテストの変形みたいなのをつかいました


(use srfi-27)
(random-source-randomize! default-random-source)

(define nil ())

;先頭
(define (fst lst) (car lst))

;二番目
(define (snd lst) (cadr lst))

;三番目
(define (trd lst) (caddr lst))

;四番目
(define (fth lst) (cadddr lst))

;lastを除いた初めの部分をかえす
;(init '(1 2 3 4 5)) -> '(1 2 3 4)
(define (init lst)(reverse (cdr (reverse lst))))


;n引数の手続きにそれぞれのlst先頭でよんだ結果を返す
;(mapn (^ (a b c d e f g ...) (* a b c d e f g ...)) '(1 2 3) '(4 5 6) '(7 8 9) '(10 11 12) '(13 14 15) ...)
(define (map-n . lsts)
	(if (let loop ((lsts (cdr lsts))) (if (null? lsts) #f (if (null? (car lsts)) #t (loop (cdr lsts)))))
		nil
		(cons 
			(apply (car lsts) 
				(let loop ((lsts (cdr lsts)))
					(if (null? lsts)
						lsts
						(cons (caar lsts) (loop (cdr lsts))))))
			(apply map-n 
				(cons (car lsts) 
					(let loop ((lsts (cdr lsts)))
						(if (null? lsts)
							lsts
							(cons (cdar lsts) (loop (cdr lsts))))))))))

; n 以上 m 未満の乱数 number を求める
; n <= number < m
(define (get-random-number n m)
	(let loop ((rand (random-integer m)))
		(if (<= n rand)
			rand
			(loop (random-integer m)))))


; n bitの乱数を返す n bit目が必ず1 logbit? -> #t となる
; てかbit演算すればもっといい方法あるよね copy-bitとか
(define (get-random nbit)
	(let ((same (ash 2 (- nbit 2))))
		(get-random-number same (* same 2))))

; 冪剰余を計算する a^(ex) mod m  wikipediaの方法を参考にした
(define (expmod a ex m :optional (result 1))
	(if (zero? ex)
		result
		(if (odd? ex)
			(expmod (modulo (* a a) m) (ash ex -1) m (modulo (* result a) m))
			(expmod (modulo (* a a) m) (ash ex -1) m result))))


; フェルマーテストで素数判定
(define (fermat-test n :optional (k 50))
	(cond
		((< n 2) #f) ((= n 2) #t) ((even? n) #f)
		(else 
			(let ((a (get-random-number 2 n)))
				(cond 
					((not (= 1 (gcd a n))) #f)
					((not (= 1 (expmod a (- n 1) n)))  #f)
					(else (if (= k 0) #t (fermat-test n (- k 1)))))))))

; 拡張ユークリッド
(define (exgcd a b)
	(let loop ((one `(1 0 ,a)) (two `(0 1 ,b)))
	(let* ((q (div (- (trd one)(modulo (trd one)(trd two)))(trd two)))(result (map-n (^ (x y) (- x y)) one (map (^ (x) (* x q)) two))))
			(if (= (trd result) 1)
				(init result)
				(loop two result)))))

;文字列の先頭以外
(define (scdr str)(substring str 1 (string-length str)))


; 素数の大きさを指定. あんまでかすぎると遅くなる
(define p-size 512)
(define q-size p-size)

; 素数判定する回数
(define accuracy 50)

; 素数判定に使う関数
(define tester (cut fermat-test <> accuracy))


; n bit の適当な素数を求める
(define (getprime nbit)
	(let ((num (get-random nbit)))
		(if (tester num)
			num
			(getprime nbit))))


; 公開鍵を作る
(define (make-public-key l)
	(let ((e (get-random-number 2 l)))
		(if (= (gcd e l) 1)
			e
			(make-public-key l))))


; 秘密鍵を作る
(define (make-private-key e l)
	(let ((key (car (exgcd e l))))
		(if (< key 0) (+ key l) key)))


; 秘密鍵と公開鍵を作る
(define (make-key)
	(let* ( (p (getprime p-size)) 
			(q (getprime q-size)) 
			(n (* p q)) 
			(l (lcm (- p 1) (- q 1)))
			(e (make-public-key l)))
			(values (list e n) (list (make-private-key e l) n))))


; 数列を暗号化する
(define (encrypt data public-key)
	(let ((pub-key (fst public-key)) (number (snd public-key)))
		(map (^ (x) (expmod x pub-key number)) data)))



; 数列を復号化する
(define (decrypt data private-key)
	(let ((prv-key (fst private-key)) (number (snd private-key)))
		(map (^ (x) (expmod x prv-key number)) data)))


; 文字列を数値列に変換
(define (encode str)
	(if (string=? "" str) nil
		(cons (char->integer (string-ref str 0)) (encode (scdr str)))))


; 数値列を文字列に変換
(define (decode ints)
	(list->string 
		(let loop ((ints ints))
			(if (null? ints) nil
				(cons (integer->char (car ints)) (loop (cdr ints)))))))


; 文字列を公開鍵で暗号化
(define (str-encrypt str key)
	(encrypt (encode str) key))

; 文字列と思われる数列を復号化して文字列にする
(define (str-decrypt str key)
	(decode (decrypt str key)))


(define (main argv)
	(receive (pub-key prv-key) (make-key)
		(print pub-key)
		(print)
		(print prv-key)
		(let ((en (str-encrypt "hello,world" pub-key)))
			(print "encode: " en)
			(print "decode: " (str-decrypt en prv-key)))))

スポンサーサイト

comment 0 trackback 0
トラックバックURL
http://telracsmoratori.blog.fc2.com/tb.php/168-78536ab9
トラックバック
コメント
管理者にだけ表示を許可する
 
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。