Branch data 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 : 1589 : 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 : 1589 : character(kind=c_char), allocatable :: path(:)
140 : : integer :: strlen
141 : :
142 : : ! *********************************************************************
143 : :
144 : : ! Translate file name to C
145 : 1589 : strlen = len_trim(fname)
146 [ + - - + : 4767 : ABI_MALLOC(path,(strlen+1))
+ - + - -
+ - + ]
147 : 1589 : call f_to_c_string(fname, path)
148 : :
149 : : ! Get MD5 sum from C
150 : 1589 : call MD5_Digest_file(path, retval)
151 : 1589 : call c_to_f_string(retval, md5_sum_from_file)
152 : :
153 : : ! Clean up the mess
154 [ - + ]: 1589 : ABI_FREE(path)
155 : :
156 : 1589 : 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 : 1589 : 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 : 1589 : i = 1
323 [ + + - + ]: 52437 : do while(c_string(i) /= C_NULL_CHAR .and. i <= len(f_string))
324 : 50848 : f_string(i:i) = c_string(i)
325 : 50848 : i = i + 1
326 : : end do
327 [ - + - - ]: 1589 : if (i < len(f_string)) f_string(i:) = ' '
328 : :
329 : 1589 : 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 : 1589 : 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 : 1589 : strlen = len_trim(f_string)
361 : :
362 [ + + ]: 193169 : forall (i=1:strlen)
363 : : c_string(i) = f_string(i:i)
364 : : end forall
365 : 1589 : c_string(strlen+1) = C_NULL_CHAR
366 : :
367 : 1589 : end subroutine f_to_c_string
368 : :
369 : 0 : end module m_hash_md5
370 : : !!***
|
