----------------------------------------------------------------------------- }\r
\r
unit lcorernd;\r
-\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
interface\r
\r
{$include lcoreconfig.inc}\r
the aim of this unit is to provide randomness in a consistent way, using OS specific methods for seeding\r
\r
this unit uses MD5 for performance and code size, but it is made so it is easy to use a different hash,\r
-as long as it is atleat 128 bits, and a multiple of the "word size" (32 bits)\r
+as long as it is at least 128 bits, and a multiple of the "word size" (32 bits)\r
\r
goals:\r
\r
\r
- for the numbers to be\r
- random: pass diehard and similar tests\r
- - unique: generate UUID's\r
+ - unique: generate UUIDs\r
- secure: difficult for a remote attacker to guess the internal state, even\r
when given some output\r
\r
typical intended uses:\r
- anything that needs random numbers without extreme demands on security or\r
speed should be able to use this\r
- - seeding other (faster) RNG's\r
- - generation of passwords, UUID's, cookies, and session keys\r
+ - seeding other (faster) RNGs\r
+ - generation of passwords, UUIDs, cookies, and session keys\r
- randomizing protocol fields to protect against spoofing attacks\r
- randomness for games\r
\r
this is not intended to be directly used for:\r
-- high securirity purposes (generating RSA root keys etc)\r
+- high security purposes (generating RSA root keys etc)\r
- needing random numbers at very high rates (disk wiping, some simulations, etc)\r
\r
performance:\r
function randombits(b:integer):longint;\r
\r
{generate a version 4 random uuid}\r
-function generate_uuid:string;\r
+function generate_uuid:ansistring;\r
\r
{$ifndef nolcorernd}\r
\r
\r
implementation\r
\r
+{$include pgtypes.inc}\r
+\r
{$ifndef nolcorernd}\r
uses\r
- {$ifdef win32}windows,activex,{$endif}\r
+ {$ifdef mswindows}windows,activex,{$endif}\r
{$ifdef unix}\r
{$ifdef ver1_0}\r
linux,\r
baseunix,unix,unixutil,sockets,\r
{$endif}\r
{$endif}\r
+ {$ifdef linux}\r
+ syscall,\r
+ {$endif}\r
fastmd5,sysutils;\r
+{$endif}\r
+\r
+const\r
+ wordsizeshift=2;\r
+ wordsize=1 shl wordsizeshift;\r
+\r
+{$ifndef nolcorernd}\r
\r
{$ifdef unix}{$include unixstuff.inc}{$endif}\r
\r
+procedure rdtsc(buf: pointer);\r
+asm\r
+ {$ifdef cpux86}\r
+ mov ecx, buf\r
+ db $0f; db $31 {rdtsc}\r
+ mov [ecx], edx\r
+ mov [ecx+4], eax\r
+ {$endif}\r
+\r
+ {$ifdef cpux64}\r
+ mov rcx, buf\r
+ rdtsc\r
+ mov [rcx], edx\r
+ mov [rcx+4], eax\r
+ {$endif}\r
+end;\r
+\r
type\r
{hashtype must be array of bytes}\r
hashtype=tmd5;\r
\r
const\r
- wordsizeshift=2;\r
- wordsize=1 shl wordsizeshift;\r
//wordsize check commented out for d3 compatibility\r
//{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}\r
hashsize=sizeof(hashtype);\r
halfhashsize=hashsize div 2;\r
hashdwords=hashsize div wordsize;\r
pooldwords=3*hashdwords;\r
- seeddwords=32;\r
+ seeddwords=40;\r
hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}\r
\r
var\r
- {the seed part of this buffer must be atleast as big as the OS seed (windows: 104 bytes, unix: 36 bytes)}\r
+ //the seed part of this buffer must be at least as big as the OS seed (windows: 120 bytes for 32 bits, 160 bytes for 64 bits, unix: 36 bytes)\r
pool:array[0..(pooldwords+seeddwords-1)] of wordtype;\r
reseedcountdown:integer;\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
+var\r
+ systemfunction036:function(var v; c:cardinal): boolean; stdcall;\r
+ rtlgenrandominited:boolean;\r
+\r
+procedure initrtlgenrandom;\r
+var\r
+ h:thandle;\r
+begin\r
+ rtlgenrandominited := true;\r
+ systemfunction036 := nil; \r
+ h := loadlibrary('advapi32.dll');\r
+ if (h <> 0) then begin\r
+ systemfunction036 := GetProcAddress(h,'SystemFunction036');\r
+ end;\r
+end;\r
+\r
function collect_seeding(var output;const bufsize:integer):integer;\r
var\r
l:packed record\r
+ rtlgenrandom:array[0..3] of longint;\r
guid:array[0..3] of longint;\r
qpcbuf:array[0..1] of longint;\r
rdtscbuf:array[0..1] of longint;\r
cursor:tpoint;\r
hs:theapstatus;\r
end absolute output;\r
- rdtsc_0,rdtsc_1:integer;\r
begin\r
result := 0;\r
if (bufsize < sizeof(l)) then exit;\r
queryperformancecounter(tlargeinteger(l.qpcbuf));\r
\r
{RDTSC}\r
- {$ifdef cpu386}\r
- asm\r
- db $0F; db $31\r
- mov rdtsc_0,eax\r
- mov rdtsc_1,edx\r
- end;\r
- l.rdtscbuf[0] := rdtsc_0;\r
- l.rdtscbuf[1] := rdtsc_1;\r
- {$endif}\r
+ rdtsc(@l.rdtscbuf);\r
+\r
{GETSYSTEMTIME}\r
getsystemtime(tsystemtime(l.systemtimebuf));\r
\r
getcursorpos(l.cursor);\r
\r
l.hs := getheapstatus;\r
+\r
+ {rtlgenrandom}\r
+ if not rtlgenrandominited then initrtlgenrandom;\r
+ if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));\r
end;\r
{$endif}\r
\r
end;\r
\r
\r
+{$ifdef linux}\r
+ {$ifdef i386}\r
+ const sys_getrandom = 355;\r
+ {$endif}\r
+\r
+ {$ifdef cpux64}\r
+ const sys_getrandom = 318;\r
+ {$endif}\r
+{$endif}\r
+\r
+\r
function collect_seeding(var output;const bufsize:integer):integer;\r
var\r
f:file;\r
a:integer;\r
l:packed record\r
- devrnd:array[0..3] of integer;\r
+ devrnd:array[0..7] of integer;\r
rdtscbuf:array[0..1] of integer;\r
tv:ttimeval;\r
pid:integer;\r
end absolute output;\r
- rdtsc_0,rdtsc_1:integer;\r
\r
begin\r
result := 0;\r
if (bufsize < sizeof(l)) then exit;\r
result := sizeof(l);\r
\r
- {/DEV/URANDOM}\r
- a := 1;\r
- assignfile(f,'/dev/urandom');\r
- filemode := 0;\r
- {$i-}reset(f,1);{$i+}\r
- a := ioresult;\r
- if (a <> 0) then begin\r
- assignfile(f,'/dev/random');\r
+ a := -1;\r
+ {$ifdef linux}\r
+ a := do_syscall(sys_getrandom,tsysparam(@l.devrnd),sizeof(l.devrnd),0);\r
+ {$endif}\r
+\r
+ if (a < sizeof(l.devrnd)) then begin\r
+ {if syscall misses or fails, fall back to /dev/urandom}\r
+ assignfile(f,'/dev/urandom');\r
+ filemode := 0;\r
{$i-}reset(f,1);{$i+}\r
a := ioresult;\r
- end;\r
- if (a = 0) then begin\r
- blockread(f,l.devrnd,sizeof(l.devrnd));\r
- closefile(f);\r
- end else begin\r
- {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
- wtmphash;\r
- move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
+ if (a <> 0) then begin\r
+ assignfile(f,'/dev/random');\r
+ {$i-}reset(f,1);{$i+}\r
+ a := ioresult;\r
+ end;\r
+ if (a = 0) then begin\r
+ blockread(f,l.devrnd,sizeof(l.devrnd));\r
+ closefile(f);\r
+ end else begin\r
+ {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
+ wtmphash;\r
+ move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
+ end;\r
end;\r
{get more randomness in case there's no /dev/random}\r
- {$ifdef cpu386}{$ASMMODE intel}\r
- asm\r
- db $0F; db $31\r
- mov rdtsc_0,eax\r
- mov rdtsc_1,edx\r
- end;\r
- l.rdtscbuf[0] := rdtsc_0;\r
- l.rdtscbuf[1] := rdtsc_1;\r
- {$endif}\r
+ rdtsc(@l.rdtscbuf);\r
\r
gettimeofday(l.tv);\r
l.pid := getpid;\r
end;\r
\r
const\r
- ch:array[0..15] of char='0123456789abcdef';\r
+ ch:array[0..15] of ansichar='0123456789abcdef';\r
\r
-function generate_uuid:string;\r
+function generate_uuid:ansistring;\r
var\r
buf:array[0..7] of word;\r
-function inttohex(w:word):string;\r
+function inttohex(w:word):ansistring;\r
begin\r
result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
end;\r
lcore.org gitweb / lcore.git / blobdiff