rsa for core
[1/4] 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
[2/4] from: holger:rebol at: 13-Apr-2001 13:59
On Fri, Apr 13, 2001 at 11:53:23AM -0700, Thomas E Conlin wrote:
> 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.
Please do not send encryption source code to the mailing list or the
script library. Redistributing encryption source code from US locations
in that manner is illegal unless you went through the proper approval
and filing procedures first.
At RT we filed the proper paperwork for our own encryption support (RSA,
DSA, Diffie Hellman, Blowfish, Rijndael/AES) in /Pro versions and
/Command 2.0, but this does not cover third-party material.
If you would like to distribute encryption source then please do so only
from places,servers etc. you control personally. If they are located
within the US then check US export regulations first (www.bxa.dc.gov).
--
Holger Kruse
[holger--rebol--com]
[3/4] from: tomc:darkwing:uoregon at: 13-Apr-2001 15:42
holger,
My apologies, I thought it had become not a big deal any more.
I remeber hearing the patent had expired ...
I just tried to check the site you mentioned but am not getting thru
is www.bxa.dc.gov the correct address?
At any rate the only part I am actually interested in is the
multiple-precision math, the encryption was an easy way to prove it
worked. I'll never mention it again.
On Fri, 13 Apr 2001, Holger Kruse wrote:
[4/4] from: holger:rebol at: 13-Apr-2001 16:01
On Fri, Apr 13, 2001 at 03:42:28PM -0700, Thomas E Conlin wrote:
> holger,
>
> My apologies, I thought it had become not a big deal any more.
> I remeber hearing the patent had expired ...
The patent has expired, but US export restrictions on cryptography
are still in place.
> I just tried to check the site you mentioned but am not getting thru
> is www.bxa.dc.gov the correct address?
Sorry, it is www.bxa.doc.gov
--
Holger Kruse
[holger--rebol--com]