Code:
#if 0
=====================================================================
cprng.bas
cryptographic pseudo-random number generator
compiles with either pbwin 7.0+ or pbcc 3.0+
=====================================================================
the following code provides a source of cryptographically strong random
bytes for use in creating session keys and other similar purposes. the
cprng is based on the ansi x9.17 standard for secure key generation and
uses rijndael as its cryptographic algorithm. the rijndael code consists
of a streamlined version of my full pb rijndael implementation, which is
available here:
[url="http://www.powerbasic.com/support/pbforums/showthread.php?t=23464"]http://www.powerbasic.com/support/pbforums/showthread.php?t=23464[/url]
a cryptographically strong prng produces values which are not predictable.
this quality separates such generators from other software random number
generators, which always produce a predictable stream of values regardless
of the size of a generator's period. if cryptographic strength is not
required, a cprng constitutes overkill. however, if cryptographic strength
is in fact required, [i]only[/i] a generator designed specifically for such
use is acceptable.
this pb implementation is hereby placed in the public domain. use it as
you wish. my hope is discourage reliance on home-grown encryption schemes
in favor of well-examined, strong, freely available algorithms.
in this posting, test-bed code appears below the cprng.bas file contents.
all code requires compiler releases 3.0/7.0 or later.
<u>implementation notes</u>
-- when first called, the randbytes$() function performs all necessary
initialization.
-- calling randbytes$(totalbytes&) with (totalbytes& < 1) causes the
generator to reinitialize.
-- functionality is completely self-contained; no global data is employed.
greg turgeon 9/2003
#endif
%blocksize = 16
%blockshift = 4 'shr (x \ %blocksize)
%subkey_size = (%blocksize*2*8)
%max_key_bytes = (%blocksize*2)
'-- encryption context
type rijndael_context
rounds as long
keyblocks as long '4*4-byte blocks
userkeylength as long
userkey as long ptr
inblock as long ptr
outblock as long ptr
ke as long ptr 'pointer to encryption subkey buffer
ke_buffer as string * %subkey_size 'encryption subkey buffer
se as byte ptr
te0 as long ptr
te1 as long ptr
te2 as long ptr
te3 as long ptr
rcon as long ptr
end type
'-- generator context
type cprng
seed as byte ptr
seed_buffer as string * %blocksize
key as byte ptr
key_buffer as string * %blocksize
randbytes as byte ptr
randbytes_buffer as string * %blocksize
temp1 as byte ptr
temp2 as byte ptr
temp_buffer as string * (%blocksize*2)
inblock as byte ptr 'used to access rctx.inblock & rctx.outblock
outblock as byte ptr 'as bytes instead of longs
rctx as rijndael_context
end type
'--------------------
'-- utility macros
'--------------------
'--------------------
macro zbs(total_bytes)=string$(total_bytes,0)
'--------------------
macro function makebuffer(total_bytes)
macrotemp s
local s$
s = zbs(total_bytes)
end macro =strptr(s)
'--------------------
macro function shiftlc(xx,constant_shiftval)
retval = (xx)
! shl retval, constant_shiftval
end macro =retval
'--------------------
macro function shiftrc(xx,constant_shiftval)
retval = (xx)
! shr retval, constant_shiftval
end macro =retval
'--------------------
macro function byte3(xx)
retval = (xx)
! shr retval, 24
end macro =retval
'--------------------
macro function byte2(xx)
retval = (xx)
! shr retval, 16
end macro =(retval and &hff)
'--------------------
macro function byte1(xx)
retval = (xx)
! shr retval, 8
end macro =(retval and &hff)
'--------------------
macro function byte0(xx)
retval = (xx)
end macro =(retval and &hff)
'--------------------
macro function get_block(mem_ptr)
! mov edx, mem_ptr
! mov eax, [edx]
! mov retval, eax
! add edx, 4
! mov mem_ptr, edx
end macro =retval
'--------------------
macro put_block(mem_ptr,value)
retval=value
! mov edx, retval
! mov eax, mem_ptr
! mov [eax], edx
! add eax, 4
! mov mem_ptr, eax
end macro
declare function randbytes$(byval totalbytes&)
'-- support functions (no direct access should be attempted)
declare function init_cprng&(rand as cprng)
declare function makerandbytes&(rand as cprng)
declare function set_key&(rctx as rijndael_context)
declare function encryptblock&(rctx as rijndael_context)
declare function rijndael_init&(rctx as rijndael_context)
'====================
function randbytes$(byval totalbytes&)
static rand as cprng, passes&, retval&
local buffer$, pbuffer as string ptr * %blocksize
'-- initialize cprng on first run; exit on error
if rand.seed = 0 then
if init_cprng&(rand) = 0 then exit function
end if
'-- reinitialize only
if totalbytes& < 1 then
reset rand
init_cprng& rand
exit function
end if
if (totalbytes& and &b1111) then
buffer = zbs(totalbytes& + %blocksize)
else 'if (totalbytes& mod %blocksize) = 0
buffer = zbs(totalbytes&)
end if
pbuffer = strptr(buffer)
passes = shiftrc(len(buffer),%blockshift) 'len(buffer)\%blocksize
do while passes
makerandbytes rand
@pbuffer = rand.randbytes_buffer
incr pbuffer : decr passes
loop
function = left$(buffer, totalbytes&)
end function
'====================
function init_cprng&(rand as cprng)
local x&, m as pointapi, pseed as long ptr
'-- initialize key buffer with current system time
getsystemtime byval varptr(rand.key_buffer)
'-- initialze seed buffer with various system status data
rand.seed_buffer = guid$
pseed = varptr(rand.seed_buffer)
x = getcurrentprocessid
@pseed = @pseed xor x : incr pseed
x = x xor getmodulehandle(")
@pseed = @pseed xor x : incr pseed
getcursorpos m
x = x xor m.x xor m.y
@pseed = @pseed xor x : incr pseed
x = x xor getcurrentthreadid
@pseed = @pseed xor x
'-- initialize encryption context using seed and key values
rand.rctx.userkey = varptr(rand.key_buffer)
rand.rctx.userkeylength = len(rand.key_buffer)
if set_key&(rand.rctx) then
rand.seed = varptr(rand.seed_buffer)
rand.key = varptr(rand.key_buffer)
rand.randbytes = varptr(rand.randbytes_buffer)
rand.temp1 = varptr(rand.temp_buffer)
rand.temp2 = rand.temp1 + %blocksize
rand.rctx.inblock = rand.temp1
rand.rctx.outblock = rand.temp2
encryptblock rand.rctx
'-- warm it up
makerandbytes rand
function = -1
end if
end function
'====================
function makerandbytes&(rand as cprng)
register i&
'-- advance counter & encrypt it
queryperformancecounter byval rand.temp1
queryperformancecounter byval rand.temp1+8
rand.rctx.inblock = rand.temp1
rand.rctx.outblock = rand.temp2
encryptblock rand.rctx
'-- combine saved seed w/encrypted counter
rand.inblock = rand.rctx.inblock
for i = 0 to %blocksize-1
rand.@inblock[i] = rand.@temp2[i] xor rand.@seed[i]
next i
'-- generate randon bytes that will be returned by
' randbytes$() function
rand.rctx.outblock = rand.randbytes
encryptblock rand.rctx
'-- setup for next run
for i = 0 to %blocksize-1
rand.@inblock[i] = rand.@temp2[i] xor rand.@randbytes[i]
next i
rand.rctx.outblock = rand.seed
encryptblock rand.rctx
end function
'====================
function set_key&(rctx as rijndael_context)
local i&, n&, nk&, pblock&, r&, temp&, t&, u&, v&, retval&
local in_key as long ptr, k as long ptr, s as byte ptr
rctx.rounds = 10
rctx.keyblocks = (rctx.rounds+1)*4
rijndael_init rctx
in_key = makebuffer(%max_key_bytes)
pblock = rctx.userkey
k = rctx.ke 'local copy
for i = 0 to (rctx.rounds-6)-1
@k[i] = get_block(pblock)
next i
s = rctx.se
i = rctx.rounds - 6 : nk = i : n = 0
do while i < rctx.keyblocks
temp = @k[i-1]
if n = 0 then
n = nk
t = byte2(temp)
v = shiftlc(@s[t],24)
t = byte1(temp) : u = shiftlc(@s[t],16)
v = v or u
t = byte0(temp) : u = shiftlc(@s[t],8)
v = v or u
u = @s[byte3(temp)]
temp = (v or u) xor rctx.@rcon[r] : incr r
else
if ((nk = 8) and (n = 4)) then
t = byte3(temp)
v = shiftlc(@s[t],24)
t = byte2(temp) : u = shiftlc(@s[t],16)
v = v or u
t = byte1(temp) : u = shiftlc(@s[t],8)
v = v or u
u = @s[temp and &hff]
temp = v or u
end if
end if
@k[i] = @k[i-nk] xor temp
incr i : decr n
loop
function = -1
end function
'--------------------
macro function packbytes(aa,bb,cc,dd)
aa = shiftlc(aa,24)
bb = shiftlc(bb,16)
cc = shiftlc(cc,8)
end macro = (aa or bb or cc or dd)
'--------------------
macro function enc_ta(aa,bb,cc,dd)
u = rctx.@te0[byte3(aa)]
u = u xor rctx.@te1[byte2(bb)]
u = u xor rctx.@te2[byte1(cc)]
u = u xor rctx.@te3[dd and &hff]
end macro = u
'--------------------
macro function enc_tal(aa,bb,cc,dd,ww)
u = rctx.@se[byte3(aa)] : v = shiftrc(ww,24)
a0 = u xor v
u = rctx.@se[byte2(bb)] : v = shiftrc(ww,16)
a1 = (u xor v) and &hff
u = rctx.@se[byte1(cc)] : v = shiftrc(ww,8)
a2 = (u xor v) and &hff
u = rctx.@se[dd and &hff] : v = ww
a3 = (u xor v) and &hff
retval = packbytes(a0,a1,a2,a3)
end macro = retval
'====================
function encryptblock&(rctx as rijndael_context)
local r&, t&, u&, v&, w&, pblock&, retval&, k as long ptr
local a0&, a1&, a2&, a3&, t0&, t1&, t2&, t3&, s0&, s1&, s2&, s3&
pblock = rctx.inblock
t0 = get_block(pblock) : t1 = get_block(pblock)
t2 = get_block(pblock) : t3 = get_block(pblock)
k = rctx.ke
t0 = t0 xor @k[0] : t1 = t1 xor @k[1]
t2 = t2 xor @k[2] : t3 = t3 xor @k[3]
for r = 1 to rctx.rounds-1
k = k + (4*4)
t = enc_ta(t0,t1,t2,t3) : a0 = t xor @k[0]
t = enc_ta(t1,t2,t3,t0) : a1 = t xor @k[1]
t = enc_ta(t2,t3,t0,t1) : a2 = t xor @k[2]
t = enc_ta(t3,t0,t1,t2) : a3 = t xor @k[3]
t0 = a0 : t1 = a1 : t2 = a2 : t3 = a3
next r
k = k + (4*4)
w = @k[0] : s0 = enc_tal(t0,t1,t2,t3,w)
w = @k[1] : s1 = enc_tal(t1,t2,t3,t0,w)
w = @k[2] : s2 = enc_tal(t2,t3,t0,t1,w)
w = @k[3] : s3 = enc_tal(t3,t0,t1,t2,w)
pblock = rctx.outblock
put_block(pblock,s0) : put_block(pblock,s1)
put_block(pblock,s2) : put_block(pblock,s3)
end function
'====================
function rijndael_init&(rctx as rijndael_context)
static table_buffer$, se as byte ptr
static te0 as long ptr, te1 as long ptr, te2 as long ptr, te3 as long ptr
static rcon as long ptr
rctx.ke_buffer = zbs(%subkey_size)
rctx.ke = varptr(rctx.ke_buffer)
if te0 = 0 then gosub maketables
rctx.se = se
rctx.te0 = te0
rctx.te1 = te1
rctx.te2 = te2
rctx.te3 = te3
rctx.rcon = rcon
exit function
'============
maketables:
local ss as byte ptr
local s1&, s2&, s3&, i1&, t&, u&, v&, retval&
%root = &h11b
table_buffer$ = zbs((1024*4)+(256*2)+(40))
te0 = strptr(table_buffer)
te1 = (te0+1024) : te2 = te0+(1024*2) : te3 = te0+(1024*3)
se = te0+(1024*4) : rcon = se+(256*2)
ss = codeptr(ss_table)
for i1 = 0 to 255
s1 = @ss[i1]
s2 = shiftlc(s1,1)
if (s2 >= &h100) then s2 = s2 xor %root
s3 = s2 xor s1
@se[i1] = s1 and 255
u = shiftlc(s2,24)
v = shiftlc(s1,16)
t = u or v
u = shiftlc(s1,8)
t = t or u or s3
@te0[i1] = t
u = shiftrc(t,8)
v = shiftlc(t,24)
@te1[i1] = u or v
u = shiftrc(t,16)
v = shiftlc(t,16)
@te2[i1] = u or v
u = shiftrc(t,24)
v = shiftlc(t,8)
@te3[i1] = u or v
next i1
local i&, r&
r = 1
@rcon[0] = shiftlc(r,24)
for i = 1 to 9
r = shiftlc(r,1)
if (r >= &h100) then r = r xor %root
@rcon[i] = shiftlc(r,24)
next i
return
ss_table:
! dd &h7b777c63, &hc56f6bf2, &h2b670130, &h76abd7fe
! dd &h7dc982ca, &hf04759fa, &hafa2d4ad, &hc072a49c
! dd &h2693fdb7, &hccf73f36, &hf1e5a534, &h1531d871
! dd &hc323c704, &h9a059618, &he2801207, &h75b227eb
! dd &h1a2c8309, &ha05a6e1b, &hb3d63b52, &h842fe329
! dd &hed00d153, &h5bb1fc20, &h39becb6a, &hcf584c4a
! dd &hfbaaefd0, &h85334d43, &h7f02f945, &ha89f3c50
! dd &h8f40a351, &hf5389d92, &h21dab6bc, &hd2f3ff10
! dd &hec130ccd, &h1744975f, &h3d7ea7c4, &h73195d64
! dd &hdc4f8160, &h88902a22, &h14b8ee46, &hdb0b5ede
! dd &h0a3a32e0, &h5c240649, &h62acd3c2, &h79e49591
! dd &h6d37c8e7, &ha94ed58d, &heaf4566c, &h08ae7a65
! dd &h2e2578ba, &hc6b4a61c, &h1f74dde8, &h8a8bbd4b
! dd &h66b53e70, &h0ef60348, &hb9573561, &h9e1dc186
! dd &h1198f8e1, &h948ed969, &he9871e9b, &hdf2855ce
! dd &h0d89a18c, &h6842e6bf, &h0f2d9941, &h16bb54b0
end function
'-- end cprng.bas
'=====================================================================
' tstcprng.bas
' compiles with either pbwin 7.0+ or pbcc 3.0+
'=====================================================================
#compile exe
#register none
#dim all
'============
deflng a-z
%usemacros = 1
#include "win32api.inc"
'--------------------
'-- utility macros
'--------------------
'--------------------
#if %def(%pb_win32)
macro eol=$cr
macro mbox(t)=msgbox t
#elseif %def(%pb_cc32)
macro eol=$crlf
macro mbox(t)=stdout t
#endif
'--------------------
macro entercc
#if %def(%pb_cc32)
local launched&
if (cursory = 1) and (cursorx = 1) then launched = -1
#endif
end macro
'--------------------
macro exitcc
#if %def(%pb_cc32)
if launched then
input flush
stdout "press any key to end"
waitkey$
end if
#endif
end macro
#include "cprng.bas"
declare function hex2show$(buffer$)
'====================
function pbmain&()
register i& : local t$
entercc
for i = 1 to 20
t = t + hex2show$(randbytes$(20)) + eol
next i
t = t + eol
mbox(t)
'-- reset generator
randbytes$ 0
t = "
for i = 1 to 20
t = t + hex2show$(randbytes$(20)) + eol
next i
t = t + eol
mbox(t)
exitcc
end function
'====================
function hex2show$(buffer$)
register i& : local t$, b as byte ptr
b = strptr(buffer$)
for i = 0 to len(buffer$)-1
t = t + hex$(@b[i],2) + " "
next i
function = t
end function
'-- end tstcprng.bas
------------------
-- gturgeon at compuserve dot com --