A fast CPRNG

Windows specific questions.
Josep Roca
Posts: 392
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: A fast CPRNG

Postby Josep Roca » Aug 07, 2017 19:23

Especially for Windows libraries I would suggest to use the ones provided by Microsoft (in the Windows SDK) instead of trying to create them oneself.


How? I only find propsys.lib, whereas FB wants libpropsys.dll.a.
Josep Roca
Posts: 392
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: A fast CPRNG

Postby Josep Roca » Aug 07, 2017 19:48

With languages that don't use import libraries, such PowerBasic, you declare a function to import as

DECLARE FUNCTION Foo LIB [or IMPORT] "dll name" ALIAS "Foo" (parameters) AS LONG [or wathever]

The compiler loads the needed dlls at startup and retrieves the addresses of the functions being called. If an address is not found, the application fails with a message indicating that the function "x" can't be found.

For delay loading, a syntax like

DECLARE FUNCTION Foo DELAYLOAD [or wathever] "dll name" ALIAS "Foo" (parameters) AS LONG [or wathever]

could be used. The application won't load the dll at startup, but only when you call a function that you have told in the declare that is inside the specified dll.

The first syntax is suitable for functions that exist in all Windows versions and, therefore, won't fail. The second syntax is suitable for functions that only exist in some (or one) versions of Windows.

Another advantage of not using import libraries is that for new versions of the dll you only need to update the header adding the new declares or even adding the declares in your application.
St_W
Posts: 1435
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: A fast CPRNG

Postby St_W » Aug 07, 2017 19:54

Josep Roca wrote:How? I only find propsys.lib, whereas FB wants libpropsys.dll.a.
You should be able to use propsys.lib directly. (Otherwise you can also try to just rename it.) The linker searches for multiple variants of the library name.

And of course make sure that you use the 64-bit version for 64-bit FB and the 32-bit import library for 32-bit FB. Otherwise you'll get an error like this:
ld.exe: skipping incompatible ./libname.lib when searching for -llibname

//edit: thank you for explaining how library usage is implemented in PowerBasic. Of course it can't be mapped 1:1 to FreeBasic (due to the existing library handling implementation, if one wants to keep backward-compatibility), but it definitely gives a good idea how it could work.
deltarho[1859]
Posts: 1652
Joined: Jan 02, 2017 0:34
Location: UK

Re: A fast CPRNG

Postby deltarho[1859] » Dec 11, 2017 17:31

Replace

Code: Select all

#If (ALGO = 1)
  Private Sub CleanUpCryptoRndIIBuffer
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Endif

with

Code: Select all

#If (ALGO = 1)
  Sub on_exit( ) Destructor
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Else
  Sub on_exit( ) Destructor
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Endif

We don't have to remember to call CleanUpCryptoRndIIBuffer now.
Last edited by deltarho[1859] on Dec 12, 2017 13:08, edited 1 time in total.
deltarho[1859]
Posts: 1652
Joined: Jan 02, 2017 0:34
Location: UK

Re: A fast CPRNG

Postby deltarho[1859] » Dec 11, 2017 21:09

Just had a crash on termination. Not the Destructor.

There are two ReDims, they should be 'As UByte' and not 'As Byte'. That has not been an issue until now - don't know why.
deltarho[1859]
Posts: 1652
Joined: Jan 02, 2017 0:34
Location: UK

Re: A fast CPRNG

Postby deltarho[1859] » Dec 12, 2017 13:19

The clean up dates back to CryptoRnd which used threads and the only clean up was BCryptCloseALGOrithmProvider used with 'ALGO = 1'. With CryptoRndII the thread pool objects got deleted as well. However, 'ALGO = 2' also uses thread pools so we need to clean up there as well.

The last but one post now has the correct clean up to use.

Without the correction we would get a memory leak when using 'ALGO = 2'. The leak would only occur per instance of CryptoRndII, it would not accumulate during a CryptoRndII session.

I should add that if I need cryptographic random numbers and speed is not an issue (62.8MHz for 32 bit 120.2MHz for 64 bit) then I will use 'ALGO = 2'. If I want the very best quality random numbers, with speed not an issue and I do not need to repeat sequences then I will use 'ALGO = 2' here as well. Of course, if your PC does not support Intel's RdRand then CryptoRndII will not compile with 'ALGO = 2', I reckon.
deltarho[1859]
Posts: 1652
Joined: Jan 02, 2017 0:34
Location: UK

Re: A fast CPRNG

Postby deltarho[1859] » Jan 21, 2018 19:07

I am currently reading 'Serious Cryptography: A Practical Introduction to Modern Encryption' by Jean-Philippe Aumasson, which was very recently published. From a quality perspective CryptoRndII is top drawer and it is very fast. However, even though it is a CPRNG, as opposed to a PRNG, it seems that my implementation has compromised the security aspect and should not be used in cryptographic work. The implementation is about speed and I treated the cryptographic aspect as a bonus. It was not a bonus - the cryptographic aspect went 'out of the window'.

If you are into crypto' this book is a good read, so far - only five reviews at Amazon but all five stars and it is receiving a good press.
deltarho[1859]
Posts: 1652
Joined: Jan 02, 2017 0:34
Location: UK

Re: A fast CPRNG

Postby deltarho[1859] » Oct 17, 2018 8:30

Just for the record here is the latest version of CryptoRNDII.bas

Usage:

Code: Select all

Const _WIN32_WINNT = &h0602
'#define algo 2 ' For Intel RdRand
#Include "CryptoRndII.bas"

Functions:
CryptoDW As Ulong
CryptoS As Double [0,1) ' 32-bit granularity
CryptoSX As Double ' [-1,1)
CryptoD As Double ' [0,1) ' 53-bit granularity
CryptoDX As Double ' [-1,1)
CryptoR( Byval One As Long, Byval Two As Long ) As Long
Gauss As Single

CryptoRNDII.bas

Code: Select all

#include once "windows.bi"
#include once "win/bcrypt.bi"
#inclib "bcrypt"

#ifndef ALGO
  #define ALGO 1
#endif
 
#if (ALGO = 2)
  Declare Function RtlGenRandom Lib "Advapi32.dll" Alias "SystemFunction036" _
  ( RandomBuffer As Any Ptr, RandomBufferLength As Ulong ) As Byte
#endif

Dim Shared As UByte Buffer0(), Buffer1()
Dim Shared As Long BufferSize
Dim Shared As Any Ptr ptrBuffer, ptrBaseBuffer0, ptrBaseBuffer1
Dim Shared As Any Ptr ptrBaseBuffer0plus, ptrBaseBuffer1plus
Dim Shared As Long SwitchBufferCriteria
Dim Shared Pool As PTP_POOL
Dim Shared As PTP_WORK Work0, Work0plus, Work1, Work1plus
Dim Shared hRand As BCRYPT_ALG_HANDLE

Declare Sub SwitchBuffer
Declare Sub FillBuffer( As PTP_CALLBACK_INSTANCE, As PVOID Ptr, As PTP_WORK )
Declare Sub ResetBufferPointer
Declare Sub InitializeCryptoBuffers( As Long )

#If (ALGO = 1)
  BufferSize = 128*1024
#Else
  BufferSize = 32*1024
#Endif
 
Pool = CreateThreadpool(Null)

InitializeCryptoBuffers( BufferSize )
 
Private Function CryptoDW As Ulong
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
  Asm
    mov eax, dword Ptr [ptrBuffer]
    mov eax, [eax]
    mov [Function], eax
  End Asm
 
  ptrBuffer += 4
 
End Function
 
Private Function CryptoS As Double ' [0,1)
Dim As Ulong TempVar
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
  Asm
     mov eax, dword Ptr [ptrBuffer]
     mov eax, [eax]
     mov dword Ptr [TempVar], eax
  End Asm
  ptrBuffer += 4
  Return TempVar/4294967296.0

End Function
 
Private Function CryptoSX As Double ' [-1,1]
Dim As Ulong TempVar
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
  Asm
    mov eax, dword Ptr [ptrBuffer]
    mov eax, [eax]
    mov dword Ptr [TempVar], eax 
  End Asm
  ptrBuffer += 4
  Return TempVar/2147483648.0 - 1
 
End Function
 
Private Function CryptoD As Double  ' [0,1)
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
  ' ASM by Wilbert at PureBasic forums
  Asm
    mov eax, dword Ptr [ptrBuffer]
    movd xmm0, [eax]
    movd xmm1, [eax + 4]
    punpckldq xmm0, xmm1
    psrlq xmm0, 12
    mov eax, 1
    cvtsi2sd xmm1, eax
    por xmm0, xmm1
    subsd xmm0, xmm1
    movq [Function], xmm0
  End Asm
 
  ptrBuffer += 8
 
End Function
 
Private Function CryptoDX As Double  ' [-1,1]
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
  ' ASM adapted from CryptoD by author
  Asm
    mov eax, dword Ptr [ptrBuffer]
    movd xmm0, [eax]
    movd xmm1, [eax + 4]
    punpckldq xmm0, xmm1
    psrlq xmm0, 12
    mov eax, 2
    cvtsi2sd xmm1, eax
    por xmm0, xmm1
    subsd xmm0, xmm1
    mov eax, 1
    cvtsi2sd xmm1, eax
    subsd xmm0, xmm1
    movq [Function], xmm0
  End Asm
 
  ptrBuffer += 8
 
End Function
 
Private Function CryptoR( Byval One As Long, Byval Two As Long ) As Long
Dim As Ulong TempVar
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
' ASM by John Gleason @ PowerBASIC forums
   Asm
  mov edx, dword Ptr [ptrBuffer]
  mov edx, [edx]
  mov ecx, [One]
  mov eax, [Two]
  cmp ecx, eax
  jl 0f
  xchg eax, ecx
0:
  Sub eax, ecx
  inc eax
  jz 1f
  mul edx
  Add edx, ecx
1:
  mov [Function], edx
   End Asm
   
  ptrBuffer += 4
 
End Function
 
Private Function Gauss As Single
Static As Long u2_cached
Static As Single u1, u2, x1, x2, w
 
  If u2_cached = -1 Then
    u2_cached = 0
    Function = u2
  Else
    Do
      x1 = CryptoS
      x2 = CryptoS
      w = x1 * x1 + x2 * x2
    Loop While w >= 1
    w = Sqr( -2 * Log(w)/w )
    u1 = x1 * w
    u2 = x2 * w
    u2_cached = -1
    Function = u1
  End If
 
End Function
 
Private Sub InitializeCryptoBuffers( Byval Buffer As Long )
  #If (ALGO = 1)
    BCryptOpenALGOrithmProvider Varptr(hRand), BCRYPT_RNG_ALGORITHM, 0, 0
  #endif
  If Buffer < 1024 Then
    BufferSize = 1024
  Else
    BufferSize = Buffer - Buffer Mod 8
  End If
  Redim Buffer0( 1 To BufferSize) As UByte
  ptrBaseBuffer0 = Varptr( Buffer0(1) )
  ptrBuffer = ptrBaseBuffer0
  #ifdef __FB_64BIT__
    SwitchBufferCriteria = Cast(Longint, ptrBuffer) + BufferSize
  #Else
    SwitchBufferCriteria = Cast(Long, ptrBuffer) + BufferSize
  #endif
  Work0 = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK, @FillBuffer), @ptrBaseBuffer0, Null)
  ptrBaseBuffer0plus = ptrBaseBuffer0 + BufferSize\2
  Work0plus = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer0plus, Null)
  SubmitThreadpoolWork(Work0)
  SubmitThreadpoolWork(Work0plus)
  Redim Buffer1( 1 To BufferSize) As UByte
  ptrBaseBuffer1 = Varptr( Buffer1(1) )
  Work1 = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer1, Null)
  ptrBaseBuffer1plus = ptrBaseBuffer1 + BufferSize\2
  Work1plus = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer1plus, Null)
  SubmitThreadpoolWork(Work1)
  SubmitThreadpoolWork(Work1plus)
  WaitForThreadpoolWorkCallbacks(Work0,FALSE)
  WaitForThreadpoolWorkCallbacks(Work0plus,FALSE)
  ' We don't need Work0 related objects again.
  CloseThreadpoolWork(Work0)
  CloseThreadpoolWork(Work0plus)
End Sub
 
#If (ALGO = 1)
  Sub on_exit( ) Destructor
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Else
  Sub on_exit( ) Destructor
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Endif
 
#If (ALGO = 1)
Private Sub FillBuffer( Instance As PTP_CALLBACK_INSTANCE, Context As PVOID Ptr, Work As PTP_WORK)
Dim BaseBuffer As Any Ptr

  BaseBuffer = *Context
  BCryptGenRandom( hRand, BaseBuffer, BufferSize\2, 0)
End Sub
#Else
Private Sub FillBuffer(Byval Instance As PTP_CALLBACK_INSTANCE, Byval Context As PVOID Ptr, Byval Work As PTP_WORK)
Dim BaseBuffer As Any Ptr
Dim As Long HalfBuffer
Dim As Ulong RecoverBuffer
Dim As Any Ptr ptrRecoverBuffer
 
  BaseBuffer = *Context
  ptrRecoverBuffer = Varptr(RecoverBuffer)
 
  HalfBuffer = BufferSize\2
  Asm
    mov edi, dword Ptr [HalfBuffer]
    mov esi, 0
    mov ebx, dword Ptr [BaseBuffer]
  rptRdRand:
    mov ecx, 10 ' Max number Of tries before going into a recovery
  queryAgain:
  #ifdef __FB_64BIT__
    RdRand rax
  #Else
    RdRand eax
  #endif
    jc OK ' A Random value was available
    dec ecx
    jnz queryAgain
    Call Recover ' Use RtlGenRandom For This ULong
  OK:
    #ifdef __FB_64BIT__
      mov qword Ptr [ebx + esi], rax ' Store RdRand
      Add esi, 8
    #Else
      mov dword Ptr [ebx + esi], eax ' Store RdRand
      Add esi, 4
    #endif
      cmp edi, esi
      jne rptRdRand
      jmp Done
  Recover:
  #ifndef __FB_64BIT__
    pushad ' I am playing it safe here
  #endif
  End Asm
  #ifdef __FB_64BIT__
    RtlGenRandom(ptrRecoverBuffer, 8)  ' Populate buffer
  #Else
    RtlGenRandom(ptrRecoverBuffer, 4)
  #endif
  Asm
  #ifndef __FB_64BIT__
    popad
  #endif
  #ifdef __FB_64BIT__
    mov rax, qword Ptr [ptrRecoverBuffer]
  #Else
    mov eax, dword Ptr [ptrRecoverBuffer]
  #endif
    ret
  Done:
  End Asm
 
End Sub
#Endif
 
Private Sub SwitchBuffer
  WaitForThreadpoolWorkCallbacks(Work1,FALSE)
  WaitForThreadpoolWorkCallbacks(Work1plus,FALSE)
  Swap ptrBaseBuffer0, ptrBaseBuffer1
  Swap ptrBaseBuffer0plus, ptrBaseBuffer1plus
  ptrBuffer = ptrBaseBuffer0
  #ifdef __FB_64BIT__
    SwitchBufferCriteria = Cast(Longint, ptrBuffer) + BufferSize
  #Else
    SwitchBufferCriteria = Cast(Long, ptrBuffer) + BufferSize
  #endif
  SubmitThreadpoolWork(Work1)
  SubmitThreadpoolWork(Work1plus)
End Sub
 
Private Sub ResetBufferPointer
  ptrBuffer = ptrBaseBuffer0
End Sub

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 1 guest