-
Notifications
You must be signed in to change notification settings - Fork 1
/
sha1.f95
199 lines (180 loc) · 7.4 KB
/
sha1.f95
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
module sha1_module
use, intrinsic :: iso_fortran_env
implicit none
private
interface SHA1
module procedure SHA1Scalar, SHA1Array
end interface
public :: SHA1
contains
function SHA1Scalar(value) result(hash)
class(*), intent(in) :: value
character(len=40) :: hash
integer(int8), dimension(:), allocatable :: bytes
integer(int64) :: length
select type (value)
type is (character(len=*))
length = len(value)
allocate(bytes(((length+8)/64 + 1)*64))
bytes(:length) = transfer(value, bytes(:length))
type is (integer(int8))
length = 1
allocate(bytes(64))
bytes(1) = value
type is (integer(int16))
length = 2
allocate(bytes(64))
bytes(1:length) = transfer(value, bytes(1:length))
type is (integer(int32))
length = 4
allocate(bytes(64))
bytes(1:length) = transfer(value, bytes(1:length))
type is (integer(int64))
length = 8
allocate(bytes(64))
bytes(1:length) = transfer(value, bytes(1:length))
type is (real(real32))
length = 4
allocate(bytes(64))
bytes(1:length) = transfer(value, bytes(1:length))
type is (real(real64))
length = 8
allocate(bytes(64))
bytes(1:length) = transfer(value, bytes(1:length))
type is (real(real128))
length = 16
allocate(bytes(64))
bytes(1:length) = transfer(value, bytes(1:length))
class default
print *, "Error: Unsupported type in SHA1."
stop
end select
hash = SHA1Hash(bytes, length)
deallocate(bytes)
end function SHA1Scalar
function SHA1Array(value) result(hash)
class(*), dimension(:), intent(in) :: value
character(len=40) :: hash
integer(int8), dimension(:), allocatable :: bytes
integer(int64) :: length
integer :: i, width
select type (value)
type is (character(len=*))
length = size(value) * len(value(1))
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*len(value(i)) + 1:i*len(value(i))) = &
transfer(value(i), bytes((i - 1)*len(value(i)) + 1:i*len(value(i))))
end do
type is (integer(int8))
length = size(value)
allocate(bytes(((length + 8)/64 + 1)*64))
bytes(1:length) = value
type is (integer(int16))
width = 2
length = size(value) * width
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*width + 1:i*width) = transfer(value(i), bytes((i - 1)*width + 1:i*width))
end do
type is (integer(int32))
width = 4
length = size(value) * width
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*width + 1:i*width) = transfer(value(i), bytes((i - 1)*width + 1:i*width))
end do
type is (integer(int64))
width = 8
length = size(value) * width
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*width + 1:i*width) = transfer(value(i), bytes((i - 1)*width + 1:i*width))
end do
type is (real(real32))
width = 4
length = size(value) * width
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*width + 1:i*width) = transfer(value(i), bytes((i - 1)*width + 1:i*width))
end do
type is (real(real64))
width = 8
length = size(value) * width
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*width + 1:i*width) = transfer(value(i), bytes((i - 1)*width + 1:i*width))
end do
type is (real(real128))
width = 16
length = size(value) * width
allocate(bytes(((length + 8)/64 + 1)*64))
do i = 1,size(value)
bytes((i - 1)*width + 1:i*width) = transfer(value(i), bytes((i - 1)*width + 1:i*width))
end do
class default
print *, "Error: Unsupported type in SHA1."
stop
end select
hash = SHA1Hash(bytes, length)
deallocate(bytes)
end function SHA1Array
function SHA1Hash(bytes, length)
integer(int8), dimension(:) :: bytes
integer(int64), intent(in) :: length
character(len=40) :: SHA1Hash
integer(int32) :: h0, h1, h2, h3, h4, a, b, c, d, e, f, k, temp
integer(int32), dimension(80) :: w
integer :: i, j
bytes(length + 1) = ibset(0_int8, 7)
bytes(length + 2:) = 0_int8
bytes(size(bytes) - 7:) = transfer(length*8_int64, bytes(size(bytes) - 7:))
bytes(size(bytes) - 7:) = bytes(size(bytes):size(bytes) - 7:-1)
h0 = 1732584193_int32 ! z'67452301'
h1 = -271733879_int32 ! z'EFCDAB89'
h2 = -1732584194_int32 ! z'98BADCFE'
h3 = 271733878_int32 ! z'10325476'
h4 = -1009589776_int32 ! z'C3D2E1F0'
do i = 1,size(bytes)/64
do j = 1,16 ! take 512 bit chunk of string
w(j) = transfer(bytes((i-1)*64 + j*4:(i-1)*64 + (j-1)*4 + 1:-1), w(j)) ! is the source size less than the result size?
end do
do j = 17,80 ! Extend the sixteen 32-bit words into eighty 32-bit words
w(j) = ishftc(ieor(ieor(ieor(w(j-3), w(j-8)), w(j-14)), w(j-16)), 1)
end do
a = h0; b = h1; c = h2; d = h3; e = h4
do j = 1,80
select case (j)
case (1:20)
f = ior(iand(b, c), iand(not(b), d))
k = 1518500249_int32 ! k = z'5A827999'
case (21:40)
f = ieor(ieor(b, c), d)
k = 1859775393_int32 ! k = z'6ED9EBA1'
case (41:60)
f = ior(ior(iand(b, c), iand(b, d)), iand(c, d))
k = -1894007588_int32 ! k = z'8F1BBCDC'
case (61:80)
f = ieor(ieor(b, c), d)
k = -899497514_int32 ! k = z'CA62C1D6'
end select
temp = ishftc(a, 5) + f + e + w(j) + k
e = d
d = c
c = ishftc(b, 30)
b = a
a = temp
end do
h0 = h0 + a
h1 = h1 + b
h2 = h2 + c
h3 = h3 + d
h4 = h4 + e
end do
write(SHA1Hash(1:8), "(Z8.8)") h0
write(SHA1Hash(9:16), "(Z8.8)") h1
write(SHA1Hash(17:24), "(Z8.8)") h2
write(SHA1Hash(25:32), "(Z8.8)") h3
write(SHA1Hash(33:40), "(Z8.8)") h4
end function SHA1Hash
end module sha1_module