Changeset 35478 in project


Ignore:
Timestamp:
04/29/18 19:59:41 (4 weeks ago)
Author:
kon
Message:

hum, urandom & random used to be timed-resources, make it so again

Location:
release/4/srfi-27/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/trunk/entropy-linux.scm

    r34779 r35478  
    77  make-entropy-source-getrandom)
    88
    9 (import scheme)
    10 
    11 (import chicken)
     9(import scheme chicken)
    1210
    1311(use entropy-source entropy-procedure)
    1412
    15 ;;; Entropy from getentropy
     13;;; Entropy from getrandom
    1614
    1715#>
    18 #if defined __GLIBC__ && defined __linux__
    19 
    20 # define _GNU_SOURCE 1
    21 # include <sys/types.h>
    22 # include <unistd.h>
    23 
    24 # if __GLIBC__ > 2 || __GLIBC_MINOR__ > 24
    25 # include <sys/random.h>
    26 
    27 static int
    28 linux_getentropy( void *buf, size_t buflen )
    29 {
    30   return getentropy( buf, buflen );
    31 }
    32 
    33 # else /* older glibc */
    34 #   include <sys/syscall.h>
    35 #   include <errno.h>
    36 
    37 static int
    38 linux_getentropy( void *buf, size_t buflen )
    39 {
    40   if( buflen > 256 ) {
    41     errno = EIO;
    42     return -1;
    43   }
    44   return syscall(SYS_getrandom, buf, buflen, 0);
    45 }
    46 
    47 # endif
    48 
    49 #endif
     16#include <sys/random.h>
    5017<#
    5118
    52 (cond-expand
    53   (linux
    54     (define (make-entropy-source-getrandom)
    55       (make-entropy-source/procedure
    56         getrandom_u8proc
    57         getrandom_f64proc
    58         "getrandom"
    59         'getrandom
    60         "Entropy from getrandom") ) )
    61   (else
    62     (define (make-entropy-source-getrandom)
    63      (void) ) ) )
     19;FIXME needs GRND_NONBLOCK loop on EAGAIN/EINTR w/ (random ?) wait & max-trys
     20;FIXME ? handle ENOSYS/EINVAL/EFAULT ?
     21
     22(define getrandom_double
     23  (foreign-lambda* double ((u8vector u8vec))
     24    ;Chicken SRFI 4 heap allocated vectors have 8-byte alignment!
     25    "double *buf = (double *) u8vec;
     26    ssize_t res = getrandom( buf, sizeof buf, 0 );
     27    if (res == sizeof buf) {
     28      C_return( (isnormal( *buf ) ? fabs( *buf ) : -1.0) );
     29    }
     30    C_return( -1.0 );"))
     31
     32(define getrandom_u8int
     33  (foreign-lambda* int ()
     34    "uint8_t buf;
     35    ssize_t res = getrandom( buf, sizeof buf, 0 );
     36    if (res == sizeof buf) {
     37      C_return( buf );
     38    }
     39    /* WRONG */
     40    C_return( buf );"))
     41
     42(define getrandom_u8proc )
     43
     44(define getrandom_f64proc
     45  )
     46
     47(define (make-entropy-source-getrandom)
     48  (make-entropy-source/procedure
     49    getrandom_u8proc
     50    getrandom_f64proc
     51    "getrandom"
     52    'getrandom
     53    "Entropy from getrandom") )
    6454
    6555(register-entropy-source! 'getrandom make-entropy-source-getrandom)
  • release/4/srfi-27/trunk/entropy-port.scm

    r34208 r35478  
    1212  make-entropy-source/file make-entropy-source/file-timed)
    1313
    14 (import scheme)
     14(import scheme chicken)
    1515
    16 (import chicken)
    17 
    18 (import
     16(use
    1917  (only type-checks check-input-port check-procedure check-symbol check-string check-number)
    20   (only type-errors warning-argument-type))
    21 (require-library type-checks type-errors)
    22 
    23 (use entropy-source entropy-support timed-resource miscmacros)
     18  (only type-errors warning-argument-type)
     19  entropy-source entropy-support
     20  timed-resource miscmacros)
    2421
    2522;;
  • release/4/srfi-27/trunk/entropy-procedure.scm

    r34208 r35478  
    88  make-entropy-source/f64procedure)
    99
    10 (import scheme)
     10(import scheme chicken)
    1111
    12 (import chicken)
    13 
    14 (import
     12(use
    1513  (only type-checks check-procedure check-symbol check-string)
    1614  entropy-source
    1715  entropy-support)
    18 (require-library type-checks entropy-source entropy-support)
    1916
    2017;;; Entropy from some procedure
  • release/4/srfi-27/trunk/entropy-support.scm

    r34780 r35478  
    1313
    1414(;export
     15  good_positive_double
    1516  make-entropic-u8/f64
    1617  entropic-u8vector-filled/f64
     
    2425  port-entropic-f64vector)
    2526
    26 (import scheme)
     27(import scheme chicken foreign)
    2728
    28 (import chicken foreign)
    29 
    30 (import
     29(use
    3130   (only extras read-byte)
    3231  (only srfi-4
     
    3635  (only lolevel move-memory!)
    3736  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    38 (require-library
    39   extras lolevel srfi-4
    40   srfi-27-vector-support)
    4137
    4238;; Double stuff
     
    5046  (foreign-lambda* bool ((u8vector u8vec) ((c-pointer double) d))
    5147    ;Chicken SRFI 4 heap allocated vectors have 8-byte alignment!
    52     "double t = *((double *) u8vec);"
    53     "if (isnormal(t)) {"
    54     "  *d = fabs(t);"
    55     "  return 1;"
    56     "}"
    57     "C_return( 0 );"))
     48    "double t = *((double *) u8vec);
     49    if (isnormal(t)) {
     50      *d = fabs(t);
     51      return 1;
     52    }
     53    C_return( 0 );"))
    5854
    5955(define good_positive_double
    6056  (foreign-lambda* double ((u8vector u8vec))
    6157    ;Chicken SRFI 4 heap allocated vectors have 8-byte alignment!
    62     "double t = *((double *) u8vec);"
    63     "C_return( (isnormal( t ) ? fabs( t ) : -1.0) );"))
     58    "double t = *((double *) u8vec);
     59    C_return( (isnormal( t ) ? fabs( t ) : -1.0) );"))
    6460
    6561(define double_peek_byte
  • release/4/srfi-27/trunk/entropy-unix.scm

    r34779 r35478  
    1414(use entropy-source entropy-port)
    1515
     16;;;
     17
     18(define-constant TIMEOUT 5.0)
     19
    1620;;; Entropy from /dev/random
    1721
    1822(define (make-entropy-source-random-device)
    19   (make-entropy-source/file
     23  (make-entropy-source/file-timed
    2024    "/dev/random"
     25    TIMEOUT
    2126    'random-device
    2227    "Entropy from random device") )
     
    2732
    2833(define (make-entropy-source-urandom-device)
    29   (make-entropy-source/file
     34  (make-entropy-source/file-timed
    3035    "/dev/urandom"
     36    TIMEOUT
    3137    'urandom-device
    3238    "Entropy from urandom device") )
Note: See TracChangeset for help on using the changeset viewer.