module m_crypt
implicit none

    interface
        function crypt_c(phrase, setting) bind(c, name="crypt")
        use iso_c_binding
        type(c_ptr), value::phrase
        type(c_ptr), value::setting
        type(c_ptr)::crypt_c
        end function crypt_c
        
        function crypt_gensalt_c(prefix, count, rbytes, nrbytes) bind(c, name="crypt_gensalt")
        use iso_c_binding
        type(c_ptr), value::prefix
        integer(kind=c_long), value::count
        type(c_ptr), value::rbytes
        integer(kind=c_int), value::nrbytes
        type(c_ptr)::crypt_gensalt_c
        end function crypt_gensalt_c
    end interface

contains

    function hash(phrase)
    use iso_c_binding
    implicit none
    
        character(len=*), intent(in)::phrase
        character(len=:), pointer::hash
        
        character(kind=c_char), dimension(:), pointer::c_phrase
        type(c_ptr)::c_res_ptr, c_salt_ptr
        character(kind=c_char), dimension(:), pointer::c_res
        character(len=5, kind=c_char), target::prefix
        integer::i
        
        interface
            function strlen_c(cstr) bind(c, name="strlen")
            use iso_c_binding
            type(c_ptr), value::cstr
            integer(kind=c_size_t)::strlen_c
            end function strlen_c
        end interface
    
        hash => null()
        
        ! Build the salt
        prefix = "$2b$"//c_null_char
        c_salt_ptr = crypt_gensalt_c(c_loc(prefix), int(16,kind=c_long), c_null_ptr, 0)
        
        allocate(c_phrase(len_trim(phrase)+1))
        do i = 1,len_trim(phrase)
            c_phrase(i) = phrase(i:i)
        end do
        c_phrase(len_trim(phrase)+1) = c_null_char

        c_res_ptr = crypt_c(c_loc(c_phrase), c_salt_ptr)
        if(c_associated(c_res_ptr)) then
            call c_f_pointer(c_res_ptr, c_res, (/ strlen_c(c_res_ptr) /) )
            allocate(character(len=strlen_c(c_res_ptr)) :: hash)
            do i = 1, len(hash)
                hash(i:i) = c_res(i)
            end do
        end if
        
        deallocate(c_phrase)
        
    end function hash
    
    function verify_hash(phrase, hashed)
    use iso_c_binding
    implicit none
    
        character(len=*), intent(in)::phrase, hashed
        logical::verify_hash
        
        character(len=:,kind=c_char), pointer::c_phrase
        character(len=:,kind=c_char), pointer::c_hash
        
        type(c_ptr)::rehashed
        
        interface
            function strcmp_c(p1, p2) bind(c, name="strcmp")
            use iso_c_binding
            type(c_ptr), value::p1, p2
            integer(kind=c_int)::strcmp_c
            end function strcmp_c
        end interface
        
        allocate(character(len=len_trim(phrase)+1)::c_phrase)
        c_phrase = trim(phrase)//c_null_char
        
        allocate(character(len=len_trim(hashed)+1)::c_hash)
        c_hash = trim(hashed)//c_null_char
        
        rehashed = crypt_c(c_loc(c_phrase), c_loc(c_hash))
        verify_hash = (strcmp_c(rehashed, c_loc(c_hash)) == 0)
        
        deallocate(c_hash)
        deallocate(c_phrase)
    
    end function verify_hash

end module m_crypt