Line data Source code
1 : !!****m* ABINIT/m_hash_md5
2 : !! NAME
3 : !! m_hash_md5
4 : !!
5 : !! FUNCTION
6 : !! This module provides resources to calculate MD5 checksums.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2016-2026 ABINIT group (Yann Pouillon)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : module m_hash_md5
23 :
24 : use, intrinsic :: iso_c_binding
25 : use m_abicore
26 :
27 : implicit none
28 :
29 : private
30 :
31 : public :: md5_check ! Checks whether two MD5 sums are identical
32 : public :: md5_sum_from_file ! Computes a MD5 sum from a file
33 : public :: md5_sum_from_string ! Computes a MD5 sum from a text string
34 :
35 : type :: md5_context_t
36 : private
37 : type(c_ptr) :: ptr = C_NULL_PTR
38 : end type md5_context_t
39 :
40 : interface
41 : function MD5_Context_New() bind(c, name="MD5_Context_New")
42 : import
43 : type(c_ptr) :: MD5_Context_New
44 : end function MD5_Context_New
45 : end interface
46 : interface
47 : subroutine MD5_Digest_File(fname, retval) bind(c, name="MD5_Digest_File")
48 : import
49 : character(kind=c_char) :: fname(*)
50 : character(kind=c_char) :: retval(33)
51 : end subroutine MD5_Digest_File
52 : end interface
53 : interface
54 : subroutine MD5_Final(retval, ctx) bind(c, name="MD5_Final")
55 : import
56 : character(kind=c_char) :: retval(33)
57 : type(c_ptr), value :: ctx
58 : end subroutine MD5_Final
59 : end interface
60 : interface
61 : subroutine MD5_Init(ctx) bind(c, name="MD5_Init")
62 : import
63 : type(c_ptr), value :: ctx
64 : end subroutine MD5_Init
65 : end interface
66 : interface
67 : subroutine MD5_Update(ctx, buffer, bufsize) bind(c, name="MD5_Update")
68 : import
69 : type(c_ptr), value :: ctx
70 : character(kind=c_char) :: buffer(*)
71 : integer(c_int), value :: bufsize
72 : end subroutine MD5_Update
73 : end interface
74 :
75 : contains !===========================================================
76 : !!***
77 :
78 : !!****f* m_hash_md5/md5_check
79 : !! NAME
80 : !! md5_check
81 : !!
82 : !! FUNCTION
83 : !! Checks whether two MD5 sums are identical.
84 : !!
85 : !! INPUTS
86 : !! sum1 = the first sum to compare
87 : !! sum2 = the second sum to compare
88 : !!
89 : !! OUTPUT
90 : !! boolean telling whether the two sums are identical
91 : !!
92 : !! NOTES
93 : !! Created a function to be able to add more operations than just checking
94 : !! the equality of the sums.
95 : !!
96 : !! SOURCE
97 :
98 0 : function md5_check(sum1,sum2)
99 :
100 : !Arguments ------------------------------------
101 : character(len=32),intent(in) :: sum1
102 : character(len=32),intent(in) :: sum2
103 :
104 : !Local variables-------------------------------
105 : logical :: md5_check
106 :
107 : ! *********************************************************************
108 :
109 0 : md5_check = ( sum1 == sum2 )
110 :
111 0 : end function md5_check
112 : !!***
113 :
114 : ! ---------------------------------------------------------------------
115 :
116 : !!****f* m_hash_md5/md5_sum_from_file
117 : !! NAME
118 : !! md5_sum_from_file
119 : !!
120 : !! FUNCTION
121 : !! Computes a MD5 sum from a file.
122 : !!
123 : !! INPUTS
124 : !! fname = path to the file
125 : !!
126 : !! OUTPUT
127 : !! String representing the MD5 sum of the file
128 : !!
129 : !! SOURCE
130 :
131 1572 : function md5_sum_from_file(fname)
132 :
133 : !Arguments ------------------------------------
134 : character(len=*),intent(in) :: fname
135 :
136 : !Local variables-------------------------------
137 : character(len=32) :: md5_sum_from_file
138 : character(kind=c_char) :: retval(33)
139 1572 : character(kind=c_char), allocatable :: path(:)
140 : integer :: strlen
141 :
142 : ! *********************************************************************
143 :
144 : ! Translate file name to C
145 1572 : strlen = len_trim(fname)
146 4716 : ABI_MALLOC(path,(strlen+1))
147 1572 : call f_to_c_string(fname, path)
148 :
149 : ! Get MD5 sum from C
150 1572 : call MD5_Digest_file(path, retval)
151 1572 : call c_to_f_string(retval, md5_sum_from_file)
152 :
153 : ! Clean up the mess
154 1572 : ABI_FREE(path)
155 :
156 1572 : end function md5_sum_from_file
157 : !!***
158 :
159 : ! ---------------------------------------------------------------------
160 :
161 : !!****f* m_hash_md5/md5_sum_from_string
162 : !! NAME
163 : !! md5_sum_from_string
164 : !!
165 : !! FUNCTION
166 : !! Computes a MD5 sum from a string.
167 : !!
168 : !! INPUTS
169 : !! text = string to process
170 : !!
171 : !! OUTPUT
172 : !! String representing the MD5 sum of the argument
173 : !!
174 : !! SOURCE
175 :
176 0 : function md5_sum_from_string(text)
177 :
178 : !Arguments ------------------------------------
179 : character(len=*), intent(in) :: text
180 :
181 : !Local variables-------------------------------
182 : character(len=32) :: md5_sum_from_string
183 : type(md5_context_t) :: ctx
184 :
185 : ! *********************************************************************
186 :
187 0 : call hash_init(ctx)
188 0 : call hash_update(ctx, text, len_trim(text))
189 0 : call hash_final(md5_sum_from_string, ctx)
190 :
191 0 : end function md5_sum_from_string
192 : !!***
193 :
194 : ! ========================= Private functions =========================
195 :
196 : !!****f* m_hash_md5/hash_final
197 : !! NAME
198 : !! hash_final
199 : !!
200 : !! FUNCTION
201 : !! Builds the final return value of the MD5 checksum.
202 : !!
203 : !! INPUTS
204 : !! ctx = MD5 context object
205 : !!
206 : !! OUTPUT
207 : !! retval = string containing the MD5 checksum
208 : !!
209 : !! SOURCE
210 :
211 0 : subroutine hash_final(retval, ctx)
212 :
213 : !Arguments ------------------------------------
214 : character(len=32), intent(out) :: retval
215 : type(md5_context_t), intent(inout) :: ctx
216 :
217 : !Local variables-------------------------------
218 : character(kind=c_char) :: c_retval(33)
219 :
220 : ! *********************************************************************
221 :
222 0 : call MD5_Final(c_retval, ctx%ptr)
223 0 : call c_to_f_string(c_retval, retval)
224 :
225 0 : end subroutine hash_final
226 : !!***
227 :
228 : ! ---------------------------------------------------------------------
229 :
230 : !!****f* m_hash_md5/hash_init
231 : !! NAME
232 : !! hash_init
233 : !!
234 : !! FUNCTION
235 : !! Checks whether two MD5 sums are identical.
236 : !!
237 : !! INPUTS
238 : !! ctx = MD5 context object
239 : !!
240 : !! SIDE EFFECTS
241 : !! ctx is reset to its intial values
242 : !!
243 : !! NOTES
244 : !! Created a function to be able to add more operations than just checking
245 : !! the equality of the sums.
246 : !!
247 : !! SOURCE
248 :
249 0 : subroutine hash_init(ctx)
250 :
251 : !Arguments ------------------------------------
252 : type(md5_context_t), intent(inout) :: ctx
253 :
254 : ! *********************************************************************
255 :
256 0 : ctx%ptr = MD5_Context_New()
257 0 : call MD5_Init(ctx%ptr)
258 :
259 0 : end subroutine hash_init
260 : !!***
261 :
262 : ! ---------------------------------------------------------------------
263 :
264 : !!****f* m_hash_md5/hash_update
265 : !! NAME
266 : !! hash_update
267 : !!
268 : !! FUNCTION
269 : !! Updates a MD5 context object.
270 : !!
271 : !! INPUTS
272 : !! ctx = MD5 context object
273 : !! buffer = data to process
274 : !! bufsize = number of bytes to process
275 : !!
276 : !! SIDE EFFECTS
277 : !! ctx gets updated with the new data
278 : !!
279 : !! SOURCE
280 :
281 0 : subroutine hash_update(ctx, buffer, bufsize)
282 :
283 : !Arguments ------------------------------------
284 : type(md5_context_t), intent(inout) :: ctx
285 : character(len=*), intent(in) :: buffer
286 : integer, intent(in) :: bufsize
287 :
288 : !Local variables-------------------------------
289 0 : character(kind=c_char), allocatable :: c_buffer(:)
290 : integer :: strlen
291 :
292 : ! *********************************************************************
293 :
294 : ! Translate buffer into C
295 0 : strlen = len_trim(buffer)
296 : ! allocate(c_buffer(strlen+1))
297 0 : ABI_MALLOC(c_buffer,(strlen+1))
298 0 : call f_to_c_string(trim(buffer), c_buffer)
299 :
300 : ! Update C MD5 context
301 0 : call MD5_Update(ctx%ptr, c_buffer, bufsize)
302 :
303 : ! Clean up the mess
304 : ! deallocate(c_buffer)
305 0 : ABI_FREE(c_buffer)
306 :
307 0 : end subroutine hash_update
308 : !!***
309 :
310 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
311 :
312 : ! Helper functions to convert between C and Fortran strings
313 : ! Based on the routines by Joseph M. Krahn
314 :
315 1572 : subroutine c_to_f_string(c_string, f_string)
316 :
317 : character(kind=c_char,len=1), intent(in) :: c_string(*)
318 : character(len=*), intent(out) :: f_string
319 :
320 : integer :: i
321 :
322 1572 : i = 1
323 51876 : do while(c_string(i) /= C_NULL_CHAR .and. i <= len(f_string))
324 50304 : f_string(i:i) = c_string(i)
325 50304 : i = i + 1
326 : end do
327 1572 : if (i < len(f_string)) f_string(i:) = ' '
328 :
329 1572 : end subroutine c_to_f_string
330 :
331 : subroutine c_to_f_string_ptr(c_string, f_string)
332 :
333 : type(c_ptr), intent(in) :: c_string
334 : character(len=*), intent(out) :: f_string
335 :
336 : character(len=1, kind=c_char), pointer :: p_chars(:)
337 : integer :: i
338 :
339 : if (.not. c_associated(c_string)) then
340 : f_string = ' '
341 : else
342 : call c_f_pointer(c_string, p_chars, [huge(0)])
343 : i = 1
344 : do while(p_chars(i) /= C_NULL_CHAR .and. i <= len(f_string))
345 : f_string(i:i) = p_chars(i)
346 : i = i + 1
347 : end do
348 : if (i < len(f_string)) f_string(i:) = ' '
349 : end if
350 :
351 : end subroutine c_to_f_string_ptr
352 :
353 1572 : subroutine f_to_c_string(f_string, c_string)
354 :
355 : character(len=*), intent(in) :: f_string
356 : character(kind=c_char,len=1), intent(out) :: c_string(len_trim(f_string)+1)
357 :
358 : integer :: i, strlen
359 :
360 1572 : strlen = len_trim(f_string)
361 :
362 205223 : forall (i=1:strlen)
363 : c_string(i) = f_string(i:i)
364 : end forall
365 1572 : c_string(strlen+1) = C_NULL_CHAR
366 :
367 1572 : end subroutine f_to_c_string
368 :
369 0 : end module m_hash_md5
370 : !!***
|
