mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-22 07:03:38 +00:00
6e79a3c84d
OCaml 4.02 introduced the 'bytes' type, a mutable string intended to replace the existing 'string' type for those cases where the byte array can be mutated. In future the 'string' type will become immutable. This is not the default now, but it can be forced using the '-safe-string' compile option. This commit changes the code so that it could be compiled using '-safe-string' (but does not actually make that change). If we detect OCaml < 4.02, we create a dummy 'Bytes' compatibility module ((nearly) an alias for the 'String' module). The only significant difference from upstream OCaml is that you must write the 'bytes' type as 'Bytes.t' in interfaces, apart from that everything else should work.
70 lines
2.1 KiB
OCaml
70 lines
2.1 KiB
OCaml
(* Read /dev/urandom.
|
|
* Copyright (C) 2013 Red Hat Inc.
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2 of the License, or
|
|
* (at your option) any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License along
|
|
* with this program; if not, write to the Free Software Foundation, Inc.,
|
|
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
*)
|
|
|
|
(* Read and return N bytes (only) from /dev/urandom.
|
|
*
|
|
* As pointed out by Edwin Török, previous versions of this had a big
|
|
* problem. They used the OCaml buffered I/O library which would read
|
|
* a lot more data than requested. This version uses unbuffered I/O
|
|
* from the Unix module.
|
|
*)
|
|
|
|
open Unix
|
|
|
|
let open_urandom_fd () = openfile "/dev/urandom" [O_RDONLY] 0
|
|
|
|
let read_byte fd =
|
|
let b = Bytes.make 1 ' ' in
|
|
fun () ->
|
|
if read fd b 0 1 = 0 then (
|
|
close fd;
|
|
raise End_of_file
|
|
);
|
|
Char.code (Bytes.unsafe_get b 0)
|
|
|
|
let urandom_bytes n =
|
|
assert (n > 0);
|
|
let ret = Bytes.make n ' ' in
|
|
let fd = open_urandom_fd () in
|
|
for i = 0 to n-1 do
|
|
Bytes.unsafe_set ret i (Char.chr (read_byte fd ()))
|
|
done;
|
|
close fd;
|
|
Bytes.to_string ret
|
|
|
|
(* Return a random number uniformly distributed in [0, upper_bound)
|
|
* avoiding modulo bias.
|
|
*)
|
|
let rec uniform_random read upper_bound =
|
|
let c = read () in
|
|
if c >= 256 mod upper_bound then c mod upper_bound
|
|
else uniform_random read upper_bound
|
|
|
|
let urandom_uniform n chars =
|
|
assert (n > 0);
|
|
let nr_chars = String.length chars in
|
|
assert (nr_chars > 0);
|
|
|
|
let ret = Bytes.make n ' ' in
|
|
let fd = open_urandom_fd () in
|
|
for i = 0 to n-1 do
|
|
Bytes.unsafe_set ret i (chars.[uniform_random (read_byte fd) nr_chars])
|
|
done;
|
|
close fd;
|
|
Bytes.to_string ret
|