uuid_mod.fpp Source File

!> Create a random (version 4) Universally Unique Identifier (UUID)
!>
!> A UUID looks like "4042E716-2556-4715-90F0-C6518463B4E5" and is a
!> random 128-bit number. This is sufficiently random that we can
!> except zero collisions in any relevant timeframe, and so is useful
!> for uniquely identifing simulations, for example.
!>
!> If compiled with the preprocessor macro `GK_HAS_LIBUUID > 0`, then
!> it uses a wrapper around the C `libuuid` library (which must be
!> linked). Otherwise, uses a fallback random number generator. 
!>
!> This module contains its own implementation of the MT19937
!> psuedo-random number generator (PRNG) so that it doesn't intefere
!> with the PRNG state used in the rest of the program.
module uuid_mod
  use, intrinsic :: iso_c_binding, only: c_signed_char
  implicit none

  private

  public :: generate_uuid
  public :: uuid_len

  !> Length of the UUID character
  integer, parameter :: uuid_len = 36

contains

  !> Convert a 1-byte integer into hexadecimal
  elemental function c_signed_char_to_hex(char) result(hex)
    integer(c_signed_char), intent(in) :: char
    character(len=2) :: hex
    ! Note this almost certainly writes the result in uppercase
    write(hex, '(z2.2)') char
  end function c_signed_char_to_hex

  !> Convert an array of 1-byte integers into UUID format:
  !> "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx"
  function format_uuid(uuid_in)
    character(len=uuid_len) :: format_uuid
    character(2), dimension(0:15) :: uuid_as_hex
    character(32) :: uuid_unformatted
    integer(c_signed_char), dimension(16), intent(in) :: uuid_in
    integer :: i

    uuid_as_hex = c_signed_char_to_hex(uuid_in)

    do i = 0, 15
      uuid_unformatted(2*i+1:2*i+2) = uuid_as_hex(i)
    end do

    format_uuid = &
         uuid_unformatted(1:8) // "-" // uuid_unformatted(9:12) // "-" // &
         uuid_unformatted(13:16) // "-" // uuid_unformatted(17:20) // "-" //&
         uuid_unformatted(21:)
  end function format_uuid

  !> Generate a version 4 UUID using either the libuuid library, or
  !> our own random number generator wrapper
  function generate_uuid()
#if !GK_HAS_LIBUUID
    use mt19937, only: mt19937_type
#endif
    character(len=uuid_len) :: generate_uuid
    integer(c_signed_char), dimension(16) :: uuid_version_4

#if GK_HAS_LIBUUID
    ! Use a wrapper for the C library libuuid
    interface
      subroutine uuid_generate_c(uuid_out) bind(C, name="uuid_generate")
        import
        integer(c_signed_char), dimension(16) :: uuid_out
      end subroutine uuid_generate_c
    end interface

    call uuid_generate_c(uuid_version_4)
#else
    type(mt19937_type) :: prng
    integer :: i

    ! Always re-start the PRNG
    call prng%set_seed(get_random_seed())

    ! Generate random numbers between 0 and 255
    do i = 1, size(uuid_version_4)
      uuid_version_4(i) = int(prng%generate() * huge(uuid_version_4), kind=c_signed_char)
    end do

    ! Version must be 0100xxxx (i.e. 0x4X)
    uuid_version_4(7) = iand(uuid_version_4(7), 79_c_signed_char)
    uuid_version_4(7) = ior(uuid_version_4(7), 64_c_signed_char)

    ! Variant must be 10xxxxxx (i.e 0x8X - 0xBX)
    uuid_version_4(9) = iand(uuid_version_4(9), -65_c_signed_char)
    uuid_version_4(9) = ior(uuid_version_4(9), -127_c_signed_char)
#endif
    generate_uuid = format_uuid(uuid_version_4)
  end function generate_uuid

#if !GK_HAS_LIBUUID
  !> Uses a method for getting a nice seed for the PRNG taken from
  !> [gfortran
  !> documentation](https://gcc.gnu.org/onlinedocs/gcc-6.4.0/gfortran/RANDOM_005fSEED.html)
  function get_random_seed() result(seed)
    use, intrinsic :: iso_fortran_env, only: int64
    implicit none
    integer :: seed

    integer(int64) :: time
    integer :: time_values(8)
    ! Convert from milliseconds to larger units
    integer, parameter :: second = 1000
    integer, parameter :: minute = 60*second
    integer, parameter :: hour = 60*minute
    integer(int64), parameter :: day = 24*hour
    integer(int64), parameter :: month = 31*day
    integer(int64), parameter :: year = 365_int64*day

    integer, parameter :: un = 6544
    integer :: istat

    ! First try if the OS provides a random number generator
    open(unit=un, file="/dev/urandom", access="stream", &
         form="unformatted", action="read", status="old", iostat=istat)
    if (istat == 0) then
      read(un) seed
      close(un)
    else
      ! Fallback to using current system time
      call system_clock(time)
      if (time == 0) then
        ! It's plausible the system_clock isn't POSIX/epoch time so
        ! let's try a different method to get the time
        call date_and_time(values=time_values)
        time = (time_values(1) - 1970)*year &
             + time_values(2)*month &
             + time_values(3)*day &
             + time_values(5)*hour &
             + time_values(6)*minute &
             + time_values(7)*second &
             + time_values(8)
      end if

      ! Ideally here we'd also XOR the PID, which would help when
      ! launching multiple processes at the same time. Note that if
      ! you need a consistent UUID across MPI ranks, you'll need
      ! another function to generate one UUID and broadcast that

      ! One step of linear congruential generator
      time = mod(time, 4294967296_int64)
      time = mod(time*279470273_int64, 4294967291_int64)
      seed = int(mod(time, int(huge(0), int64)), kind(seed))
    end if
  end function get_random_seed
#endif

end module uuid_mod