[REBOL] rsa for core
From: tomc::darkwing::uoregon::edu at: 13-Apr-2001 11:53
Hi List,
I'm dumping this on the list because I need to get back to working on my
school work, and if if someone else is playing with maybe I won't have to.
if you make wonderful improvments please forward them on.
Carl & RT If you want to include this somewhere talk to me about
your plans for educational licences first.
-- Attached file included as plaintext by Listar --
-- File: rsa.r
-- Desc: rsa.r
rebol [
Title: "Core RSA"
File: %rsa.r
Author: "Tom Conlin"
Date: [2001-Feb-08 2001-Apr-13]
Email: [tomc--acm--org]
Purpose:
{mainly to keep me sane while finishing my arts&letters requirements
also because I want rebol to be able to handle big numbers.
Hopefully this will generate some interest in a multiple-pricision
math libary for rebol and I wont have to implement it all myself.
}
notes: {
this started out as a multiple-precision libary
the basic math functions all had a /base refinement
so that any 0 < base > 2^31 could be used.
I decided to hardcode the base to 24 bits for this implementation
(hence the b24b- names)
negative numbers could be implemented by having the first "digit"
in a block be signed.
}
Example: {
>> do %rsa.r
>> bobs-keys: rsa-generate-keys 2
P: 7261841 16111233
Q: [ 13873587 12066569 ]
N: [ 6005036 15379644 5820230 5646729 ]
N': [ 6005036 15379643 1462016 11023360 ]
E: [ 15253178 4110405 ]
(N',E) -> 1 4971765 1843430 13129528 10357389
[[encode common][decode commom]]
== [["6L66PrhF" "W6Es6qy8WM9GVimJ"]["S9z1HCDmyFc4ngqN W6Es6qy8WM9GVimJ"]]
>> bobs-public-key: bobs-keys/1
== ["6L66PrhF" "W6Es6qy8WM9GVimJ"]
>> bobs-private-key: bobs-keys/2
== ["S9z1HCDmyFc4ngqN W6Es6qy8WM9GVimJ"]
>> alice-says: "my cc number is 1234567890"
== "my cc number is 1234567890"
>> chucky-sees: rsa-encipher-message alice-says bobs-public-key
== "QJtjaTA2gcFFx+SxChiWeuElGpRA8KraGp0zeF79766jCDqx"
>> bob-reads: rsa-decipher-message chucky-sees bobs-private-key
== "my cc number is 1234567890"
>>
}
]
b64-b24b: func [
"convert a base64 encoded string into a block of (unsigned) 24bit integers"
s [string!] /local a b c d x result
] [
result: copy []
a: none b: none c: none d: none
foreach [a b c d] s [
append result to-integer debase rejoin [a b c d]
a: none b: none c: none d: none
]
result
]
a24b-b64: func [
{convert a single unsigned 24bit integer into it's
4-char base64 string-representation
intended to be used by b24b-b64}
n [integer!] /local a b c d x result base64
] [
if n < 256 [return enbase to-string to-char n]
base64: {ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=}
either n < 65536
[b: to-integer ((n and 15) * 4) + 1
c: to-integer ((n and 1008) / 16) + 1
d: to-integer ((n and 64512) / 1024) + 1
a: 65
] [x: n
a: ((x and 63) + 1)
x: to-integer (x / 64)
b: ((x and 63) + 1)
x: to-integer (x / 64)
c: ((x and 63) + 1)
x: to-integer (x / 64)
d: ((x and 63) + 1)
]
result: rejoin [base64/:d base64/:c base64/:b base64/:a]
]
b24b-b64: func [
{convert a block of 24bit integers into a string of base64 chars, needs a24b-b64}
blk [block!] /local b result
] [
result: copy ""
foreach b blk [append result a24b-b64 b]
result
]
{Is one block (of positive integers)
greater-than, less-than or equal-to another block
head is most significant place value -- tail least significant place value}
b24b-compare: func ["return 1|0|-1 for u greater|equal|less than v"
u [block!] v [block!] /local x y
] [
while [all [(zero? (pick u 1)) ((length? u) > 1)]] [remove u]
while [all [(zero? (pick v 1)) ((length? v) > 1)]] [remove v] ; clean-up
either (length? u) < (length? v) [-1] ; u has fewer significant digits than v
[either (length? v) < (length? u) [1] ; v has fewer significant digits than u
[;u & v have the same number of significant digits
x: u
y: v
while [not tail? x]
[either equal? (pick x 1) (pick y 1)
[ x: next x
y: next y
]
[either (pick x 1) > (pick y 1)
[return 1]
[return -1]
]
]
return 0 ; u == v
]
]
]
; I am ordering most significant place at head of block
; least significant place at tail of block
b24b-add: func ["place-wise addition of two blocks of 24bit integers"
u [block!] v [block!]
/local b result w x y carry
] [
b: 16777216 ; == ((2^24))
either (length? u) < (length? v)
[x: tail v y: tail u]
[x: tail u y: tail v]
result: copy make block! (length? head x) + 1
carry: 0
while [not head? y] [
x: back x
y: back y
w: (pick x 1) + (pick y 1) + carry
carry: to-integer (w / b)
insert result (w // b)
]
while [not head? x] [
x: back x
w: (pick x 1) + carry
carry: to-integer (w / b)
insert result (w // b)
]
if carry > 0 [insert result carry]
result
]
; specialized add with fewer tests than adding two possibaly different numbers
b24b-double: func ["doubling a block of 24bit integers"
u [block!]
/local b result w x y carry
] [
b: 16777216 ; == ((2^24))
x: tail u
result: copy []
carry: 0
while [not head? x] [
x: back x
w: (pick x 1) + (pick x 1) + carry
carry: to-integer (w / b)
insert result (w // b)
]
if carry > 0 [insert result carry]
:result
]
;returns the absolute difference--
b24b-minus: func ["keep first argument not-less-than second argument."
u [block!] v [block!]
/local result t w x y z b
] [
b: 16777216 ; == ((2^24))
w: b24b-compare u v
if zero? w [return [0]]
result: copy []
either negative? w
[t: copy/deep v
x: tail t y: tail u
print "NEGATIVE WARNING!!!"
]
[t: copy/deep u
x: tail t y: tail v
]
while [not head? y] [
x: back x ;
y: back y ;
z: back x ; carry column
w: ((pick x 1) - (pick y 1))
if negative? w [
w: (w + 16777216)
if zero? (pick z 1) [
change z b
z: back z
while [zero? (pick z 1)] [change z (b - 1) z: back z]
change z ((pick z 1) - 1)
z: back x
]
change z ((pick z 1) - 1)
]
insert result w
]
while [not head? x] [
x: back x
insert result (pick x 1)
]
while [all [(zero? (pick result 1)) ((length? result) > 1)]] [remove result]
result
]
b24b-mod: func [
{while first arg greater-than or equal-to the second arg;
subtract second from first}
u [block!] m [block!] /local result
] [; strip leading zeros
while [all [(zero? (pick u 1)) ((length? u) > 1)]] [remove u]
while [all [(zero? (pick m 1)) ((length? m) > 1)]] [remove m]
result: copy/deep u
if equal? m [0] [return result]
while [not negative? b24b-compare result m] [result: b24b-minus result m]
result
]
b24b-add-mod: func ["(u+v) mod m"
u [block!] v [block!] m [block!] /local x y result
] [
x: b24b-mod u m
y: b24b-mod v m
result: b24b-add x y
result: b24b-mod result m
]
b24b-double-mod: func ["(u+u) mod m"
u [block!] m [block!] /local x result
] [
x: b24b-mod u m
result: b24b-double x
result: b24b-mod result m
]
; I have not seen this anywhere before (i.e. in Knuth) but it works
; reduces a positive integer (base < 2^31) to half its original magnitude
; (rounding down)
b24b-half: func ["returns floor(u/2) where u is a block of 24bit integers"
u [block!]
/local result b h x y z carry
] [
b: 16777216
h: 8388608 ; half of base (I think the base may have to be even)
result: copy []
x: back tail u
insert result to-integer (pick x 1) / 2
while [not head? x] [
x: back x
if odd? (pick x 1) [
change result (pick result 1) + h
]
insert result to-integer (pick x 1) / 2
]
while [((length? result) > 1) and zero? (pick result 1)] [remove result]
result
]
; multiplication via repeated doubling/halfing (Egypt cicra 4000 B.P.)"
; an easy to implement not too quick way to multiply
; note base depends on base used in b24b-add, b24b-double & b24b-half
b24b-mult: func ["(u*v)"
u [block!] v [block!]
/local result x y
] [
x: copy u
y: copy v
if any [(equal? x [0]) (equal? y [0])] [return [0]]
if equal? x [1] [return y]
if equal? y [1] [return x]
result: [0]
while [positive? b24b-compare y [0]] [
if odd? (last y) [result: b24b-add result x]
x: b24b-double x
y: b24b-half y
]
result
]
; multiplication via repeated doubling (Egypt cicra 2000 B.C.)
b24b-mult-mod: func ["(u*v) mod m"
u [block!] v [block!] m [block!]
/local result x y
] [
x: b24b-mod u m
y: b24b-mod v m
if any [(equal? x [0]) (equal? y [0])] [return [0]]
if equal? x [1] [return y]
if equal? y [1] [return x]
result: [0]
while [positive? b24b-compare y [0]] ;y > 0
[if odd? (last y) [result: b24b-add-mod result x m]
x: b24b-double-mod x m
y: b24b-half y
]
result
]
; Itterative power mod function based on Knuth, Vol 2. sec. 4.6.3
b24b-power-mod: func ["(b^e) mod m"
b [block!] e [block!] m [block!]
/local n y z
] [
n: copy/deep e
while [all [(zero? first n) ((length? n) > 1)]] [remove n] ;cleanup input
if equal? n [0] [return [1]] ; x^0 = 1
if equal? b [0] [return [0]] ; 0^x = 0 (x <> 0)
if equal? n [1] [return copy/deep b] ; x^1 = x (x not 0)
y: [1] ; mult identity
z: copy/deep b ; wreck a copy
while [not equal? n [0]] [
if odd? (last n) [y: b24b-mult-mod y z m]
z: b24b-mult-mod z z m
n: b24b-half n
]
y
]
b24b-probable-prime: func [
"return false if the block is composite,true if block may (likely) be prime"
q [block!]
] [
equal? [1] b24b-power-mod [2] b24b-minus q [1] q
]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This Algorithm is credited to Professor Eugene Luks, University of Oregon.
; Extended Binary GCD with no divisions or negative numbers
; when a > b and a is even and b is odd (relativy prime to 'a actually) .
b24b-exbin-gcd: func [a [block!] b [block!]
/local c d x y u v t m n acc
] [
; a few sanity checks important for this rsa implementation only
if any [negative? b24b-compare a b even? (last b) odd? (last a)] [return none]
c: copy/deep a x: copy/deep a y: b24b-minus b [1]
d: copy/deep b u: [1] v: [0]
t: copy [] ; a temp for swapping
while [d > [0]] [
either even? last c
[c: b24b-half c
either (even? last x) and (even? last y)
[x: b24b-half x
y: b24b-half y
]
[x: b24b-half (b24b-add x a)
y: b24b-half (b24b-add y b)
]
if positive? b24b-compare d c [
t: c c: d d: t
t: x x: u u: t
t: y y: v v: t
]
]
[either even? last d
[d: b24b-half d
either (even? last u) and (even? last v)
[u: b24b-half u
v: b24b-half v
]
[u: b24b-half (b24b-add u a)
v: b24b-half (b24b-add v b)
]
]
[c: b24b-minus c d
either negative? b24b-compare x u
[x: b24b-minus (b24b-add x a) u
y: b24b-minus (b24b-add y b) v
]
[x: b24b-minus x u
y: b24b-minus y v
]
if positive? b24b-compare d c [
t: c c: d d: t
t: x x: u u: t
t: y y: v v: t
]
]
]
]
t: copy []
append t copy/deep c
append t copy/deep x
t
]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; end math begin rsa
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
RSA-generate-keys: func [
len [integer!] "the number of 48-bit groups in the keys"
/local p q n com enc dec cd
] [
random/seed now
p: make block! len
repeat i len [append p to-block (random 16777215)]
if even? pick p len [poke p len ((pick p len) - 1)]
while [not b24b-probable-prime p] [
for i 1 len 1 [poke p i (random 16777215)]
if even? pick p len [poke p len ((pick p len) - 1)]
]
print ["P: " p]
q: make block! len
repeat i len [append q to-block (random 16777215)]
if even? pick q len [poke q len ((pick q len) - 1)]
while [not b24b-probable-prime q] [
for i 1 len 1 [poke q i (random 16777215)]
if even? pick q len [poke q len ((pick q len) - 1)]
]
print ["Q: [" q "]"]
com: b24b-mult p q
print ["N: [" com "]"]
n: b24b-mult (b24b-minus p [1]) (b24b-minus q [1])
print ["N': [" n "]"]
enc: copy []
repeat i len [append enc to-block (random 16777215)]
if even? last enc [poke enc len ((last enc) - 1)]
cd: b24b-exbin-gcd n enc
while [not equal? cd/1 1] [
for i 1 len 1 [poke enc i (random 16777215)]
if even? last enc [poke enc len ((last enc) - 1)]
cd: b24b-exbin-gcd n enc
]
print ["E: [" enc "]"]
print ["(N',E) -> " cd]
print "[[public common][private commom]]"
enc: b24b-b64 enc
dec: b24b-b64 remove cd
com: b24b-b64 com
reduce [reduce [enc com] reduce [dec com]]
]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
RSA-encipher-message: func [
plaintext [string!] public-key [block!] ;ek[string!] ck[string!]
/local m n c e mp ciphertext
] [
plaintext: enbase plaintext
n: (length? public-key/2) - 4
;pad plaintext till mod n so we won't loose the last bite deciphering??
while[not zero? ((length? plaintext) // n) ][append plaintext "="]
c: b64-b24b public-key/2 ; ck
e: b64-b24b public-key/1 ; ek
m: plaintext
ciphertext: copy []
while [not tail? m] [
mp: b64-b24b copy/part m n
append ciphertext b24b-power-mod mp e c
m: skip m n
]
b24b-b64 ciphertext
]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
RSA-decipher-message: func [
ciphertext [string!] private-key [block!] ;dk[string!] ck[string!]
/local n m d c mp plaintext
] [
n: (length? private-key/2)
c: b64-b24b private-key/2 ;ck
d: b64-b24b private-key/1 ;dk
m: ciphertext
plaintext: copy []
while [not tail? m] [
mp: b64-b24b copy/part m n
append plaintext b24b-power-mod mp d c
m: skip m n
]
to-string debase b24b-b64 plaintext
] ;end
