1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
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(len=:,kind=c_char), 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(character(len=len_trim(phrase)+1) :: c_phrase)
c_phrase = trim(phrase)//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
|
