/pliant/util/crypto/random.pli
1	abstract
2	[A true and strong pseudo random generator.] ; eol
3
4	doc
5	listing
6	function memory_true_random buffer size study
7	arg Address buffer ; arg Int size ; arg CBool study
8	[Fills the memory area with true random numbers] ; eol
9	[By true random numbers, I mean that they come from real events (the clock or the /dev/random device) rather than computations.] ; eol
10	[If 'study' is set, then the number of bits in the buffer should be high, and a basic study will be applyed on the generated sequence in order to reject a too based distribution that would obviously show that the timer did not provide random bits as expected. ] ; eol
11	[Should I say: This is slow.]
12	listing
13	function memory_strong_init bits
14	arg Int bits
15	[Initialised the strong pseudo random generator with 'bits' true random bits. ]
16	[If you never call this function, it will be automatically the first time you request bits from the strong pseudo random generator. ]
17	[So, you shoud call it only if the default number of bits defined in 'cipher_init_bits' is too low for your application. Anyway, do not request more than 2048 bits because the RC4 state contains only 2048 bits. If you really need more, you have to change 'rc4_bits' from 8 to 16 in ] ; link "rc4.pli" "rc4.pli" ; [, but modifying rc4.pli directly would make your computer incompatiable with other Pliant computers, so you would rather copy rc4.pli in random.pli and make the change local.]
18	listing
19	function memory_strong_random buffer size
20	arg Address buffer ; arg Int size
21	[Fills the memory area with strong pseudo random numbers] ; eol
22	[It's much faster.]
23	listing
24	function random_string len -> s
25	arg Int len ; arg Str s
26	[Returns a strong pseudo random string with length 'len']
27
28	doc
29	para
30	[Depending on the 'random_device' constant, we either use /etc/random device, or a Pliant algorithm based on the computer clock (implemented in 'memory_true_random' function) in order to generate the true random bits. ]
31	[In the second case, if you use a Pentium or better i386 processor, you can set 'pentium' constant to true in order to use the processor clock instead of the system one. It should be better because it changes more often, but I had more problems with it. ]
32	[Anyway, when using the clock, I use the sum of the bits instead of the last one and it revealed to be much better, also I suspect it might simply be too tricky to be discovered by my naive statistic study, but still not be random at all.]
33	para
34	[We use RC4 as the strong pseudo random generator. The key provided to RC4 is a true random bits sequence added to the timestamp, in order to reduce the probability to get two times the same sequence even if the true random bits generator is deaply biased.] ; eol
35	[In order to make the pseudo random generator even better, we continuously poke in some true random numbers that are computed from another thread.]
36
37
38	module "/pliant/language/compiler.pli"
39	module "/pliant/language/os.pli"
40	module "/pliant/language/context.pli"
41	module "/pliant/language/stream.pli"
42	module "/pliant/language/schedule/daemon.pli"
43	module "rc4.pli"
44	module "/pliant/language/schedule/pentium.pli"
45
46	module "/pliant/language/os/socket.pli"
47	module "/pliant/language/stream/openmode.pli"
48
49
50	if os_api="linux" or os_kernel="Linux"
51	function is_random_device -> rd
52	arg Str rd
53	for (var Int lap) 0 1
54	(var Stream d) open (shunt lap=0 "device:/random" "device:/urandom") in+safe
55	if d=success
56	return d:name
57	rd := ""
58	constant random_device is_random_device
59	else
60	constant random_device ""
61
62	constant fast_weak_generator true
63
64	constant initial_wait_time 0.001
65
66	constant cipher_init_bits 512 # number of bits
67	constant cipher_init_laps 10
68	constant cipher_shake_laps 3
69
70	constant trace false
71
72
73	if random_device="" and fast_weak_generator
74	compile_log "Using fast weak random generator."
75
76
77
78
79	doc
80	[The true random generator.]
81
82
83	function datetime_string -> s
84	arg Str s
85	var DateTime dt := datetime
86	s := repeat DateTime:size " "
87	memory_copy addressof:dt s:characters DateTime:size
88
89
90	if not fast_weak_generator
91
92	function ones adr size -> n
93	arg Address adr ; arg Int size n
94	n := 0
95	for (var Int i) 0 size*8-1
96	if (((adr translate uInt8 i\8) map uInt8) .and. 2^(i%8))<>0
97	n += 1
98
99	function random_bit -> b
100	arg Int b
101	if processor_is_pentium
102	pentium_counter (var uInt low) (var uInt high)
103	b := (ones addressof:low uInt:size) .and. 1
104	else
105	var DateTime dt := datetime
106	b := (ones addressof:dt DateTime:size) .and. 1
107
108
109	gvar Float wait_time := initial_wait_time
110
111	function memory_true_random buffer size study
112	arg Address buffer ; arg Int size ; arg CBool study
113	var Int done := 0
114	if random_device<>""
115	(var Stream rd) open random_device in+safe+nocache
116	while done<size and (os_socket_wait rd:stream_handle in 15)=success
117	os_read rd:stream_handle (buffer translate Byte done) 1 ; done += 1
118	if done=size
119	return
120	else
121	console "Timeout reading OS random device." eol
122	if fast_weak_generator
123	module "/pliant/admin/md5.pli"
124	var RC4Ctx ctx
125	var DateTime start := datetime
126	var Str all := ""
127	while datetime:seconds-start:seconds<2 or all:len<64
128	all += datetime_string
129	if all:len>=431
130	all := (all all:len-297 all:len)+string_md5_binary_signature:(all 0 all:len-297)
131	rc4_init ctx all cipher_init_laps
132	for (var Int i) done size-1
133	(buffer translate uInt8 i) map uInt8 := rc4_byte:ctx .and. 255
134	wait_time := 2^0.5
135	else
136	part generate
137	if trace
138	var DateTime start := datetime
139	var Int last := 0 ; var Int same := 0 ; var Int ones := 0
140	memory_clear buffer size
141	var Int bits := 8*size
142	for (var Int i) 0 bits-1
143	sleep wait_time
144	var Pointer:uInt8 b :> (buffer translate uInt8 i\8) map uInt8
145	var Int r := random_bit
146	b := b .or. r*2^(i%8)
147	if r=last
148	same += 1
149	ones += r
150	last := r
151	if study
152	var Float same_ratio := same/bits
153	var Float ones_ratio := ones/bits
154	var Float delta := 0.1 # 1/bits^0.5
155	var CBool biased := (abs same_ratio-0.5)>delta or (abs ones_ratio-0.5)>delta
156	if trace
157	console "generated " bits " random bits (sleep " wait_time " -> " (datetime:seconds-start:seconds)/bits " s): " same_ratio*100 "% same , " ones_ratio*100 "% ones , maximum delta " delta*100 "% -> " (shunt biased "failure" "success") eol
158	if biased
159	console "The random seed is biased. "
160	if wait_time<2
161	console "retrying." eol
162	wait_time *= shunt wait_time<0.5 2.6 1.3
163	restart generate
164	else
165	console "surrendering." eol
166
167
168
169
170	doc
171	[The pseudo random generator.]
172
173
174	gvar RC4Ctx ctx
175	gvar Sem sem
176	gvar CBool initialized := false
177
178
179	function memory_strong_init bits
180	arg Int bits
181	var Int len := (bits+7)\8
182	(var Str key) set (memory_allocate len addressof:key) len true
183	memory_true_random key:characters len true
184	sem request
185	rc4_init ctx datetime_string+key cipher_init_laps
186	initialized := true
187	sem release
188
189	function memory_strong_init
190	memory_strong_init cipher_init_bits
191
192	function memory_strong_random buffer size
193	arg Address buffer ; arg Int size
194	if not initialized
195	memory_strong_init
196	daemon "shake random numbers generator"
197	part shake
198	for (var Int lap) 1 cipher_shake_laps
199	if daemon_emergency
200	leave shake
201	if rc4_bits=8
202	memory_true_random addressof:(var uInt8 offset) uInt8:size false
203	memory_true_random addressof:(var uInt8 value) uInt8:size false
204	eif rc4_bits=16
205	memory_true_random addressof:(var uInt16 offset) uInt16:size false
206	memory_true_random addressof:(var uInt16 value) uInt16:size false
207	else
208	error error_id_missing "Unsupported number of bits in the RC4 implementation"
209	ctx:perm:offset := value
210	sleep 0.25
211	sem request
212	for (var Int i) 0 size-1
213	(buffer translate uInt8 i) map uInt8 := rc4_byte:ctx .and. 255
214	sem release
215
216
217	function random_string len -> s
218	arg Int len ; arg Str s
219	s set (memory_allocate len addressof:s) len true
220	memory_strong_random s:characters s:len
221
222
223	export memory_true_random memory_strong_init memory_strong_random
224	export random_string
225
226
227	doc
228	[We want to get a new random pseudo random sequence each time the program is run, so we must set 'initialized' back to false if the module is loaded from a Pliant .dump file (in other words, if it's precompiled).]
229
230	function restart p fh
231	arg Address p ; arg Int fh
232	initialized := false
233	gvar DelayedAction da
234	da function :> the_function restart Address Int
235	pliant_restore_actions append addressof:da
236