/
DigestAuthenticator.cls
246 lines (215 loc) · 7.88 KB
/
DigestAuthenticator.cls
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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "DigestAuthenticator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
''
' Digest Authenticator v3.0.8
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
'
' Custom IWebAuthenticator for Digest Authentication
' http://en.wikipedia.org/wiki/Digest_access_authentication
'
' @class DigestAuthenticator
' @implements IWebAuthenticator v4.*
' @author tim.hall.engr@gmail.com
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
Implements IWebAuthenticator
Option Explicit
' --------------------------------------------- '
' Constants and Private Variables
' --------------------------------------------- '
Private Const auth_Qop As String = "auth"
Private auth_pClientNonce As String
' --------------------------------------------- '
' Properties
' --------------------------------------------- '
Public Username As String
Public Password As String
Public Realm As String
Public ServerNonce As String
Public RequestCount As Long
Public Opaque As String
Public Property Get ClientNonce() As String
If auth_pClientNonce = "" Then
auth_pClientNonce = WebHelpers.CreateNonce
End If
ClientNonce = auth_pClientNonce
End Property
Public Property Let ClientNonce(Value As String)
auth_pClientNonce = Value
End Property
Public Property Get IsAuthenticated() As Boolean
If ServerNonce <> "" Then
IsAuthenticated = True
End If
End Property
' ============================================= '
' Public Methods
' ============================================= '
''
' Setup authenticator
'
' @param {String} Username
' @param {String} Password
''
Public Sub Setup(Username As String, Password As String)
Me.Username = Username
Me.Password = Password
End Sub
''
' Hook for taking action before a request is executed
'
' @param {WebClient} Client The client that is about to execute the request
' @param in|out {WebRequest} Request The request about to be executed
''
Private Sub IWebAuthenticator_BeforeExecute(ByVal Client As WebClient, ByRef Request As WebRequest)
If Me.IsAuthenticated Then
Me.RequestCount = Me.RequestCount + 1
Request.SetHeader "Authorization", CreateHeader(Client, Request)
End If
End Sub
''
' Hook for taking action after request has been executed
'
' @param {WebClient} Client The client that executed request
' @param {WebRequest} Request The request that was just executed
' @param in|out {WebResponse} Response to request
''
Private Sub IWebAuthenticator_AfterExecute(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Response As WebResponse)
If Response.StatusCode = 401 And Not Me.IsAuthenticated Then
WebHelpers.LogDebug "Extract Authenticate and retry 401 request " & Client.GetFullUrl(Request), "Digest.AfterExecute"
ExtractAuthenticateInformation Response
Request.SetHeader "Authorization", CreateHeader(Client, Request)
Response.Update Client.Execute(Request)
End If
End Sub
''
' Hook for updating http before send
'
' @param {WebClient} Client
' @param {WebRequest} Request
' @param in|out {WinHttpRequest} Http
''
Private Sub IWebAuthenticator_PrepareHttp(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Http As Object)
' e.g. Update option, headers, etc.
End Sub
''
' Hook for updating cURL before send
'
' @param {WebClient} Client
' @param {WebRequest} Request
' @param in|out {String} Curl
''
Private Sub IWebAuthenticator_PrepareCurl(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Curl As String)
' http://curl.haxx.se/docs/manpage.html#--digest
Curl = Curl & " --digest --user " & WebHelpers.PrepareTextForShell(Me.Username) & ":" & WebHelpers.PrepareTextForShell(Me.Password)
End Sub
''
' Create digest header for given Client and Request
'
' @internal
' @param {WebClient} Client
' @param {WebRequest} Request
' @return {String}
''
Public Function CreateHeader(Client As WebClient, Request As WebRequest) As String
Dim auth_Uri As String
auth_Uri = WebHelpers.GetUrlParts(Client.GetFullUrl(Request))("Path")
CreateHeader = "Digest " & _
"username=""" & Me.Username & """, " & _
"realm=""" & Me.Realm & """, " & _
"nonce=""" & Me.ServerNonce & """, " & _
"uri=""" & auth_Uri & """, " & _
"qop=" & auth_Qop & ", " & _
"nc=" & web_FormattedRequestCount & ", " & _
"cnonce=""" & Me.ClientNonce & """, " & _
"response=""" & web_CalculateResponse(Client, Request) & """, " & _
"opaque=""" & Me.Opaque & """"
WebHelpers.LogDebug CreateHeader, "DigestAuthenticator.CreateHeader"
End Function
''
' Extract authentication information from 401 response headers
'
' @internal
' @param {WebResponse} Response
''
Public Sub ExtractAuthenticateInformation(Response As WebResponse)
Dim auth_Header As String
Dim web_CrLf As String
auth_Header = WebHelpers.FindInKeyValues(Response.Headers, "WWW-Authenticate")
web_CrLf = VBA.Chr$(13) & VBA.Chr$(10)
If auth_Header <> "" And VBA.Left$(auth_Header, 6) = "Digest" Then
Dim auth_Lines As Variant
auth_Lines = VBA.Split(VBA.Mid$(auth_Header, 7), web_CrLf)
Dim auth_i As Integer
Dim auth_Key As String
Dim auth_Value As String
For auth_i = LBound(auth_Lines) To UBound(auth_Lines)
auth_Key = VBA.LCase$(VBA.Trim$(VBA.Mid$(auth_Lines(auth_i), 1, VBA.InStr(1, auth_Lines(auth_i), "=") - 1)))
auth_Value = VBA.Trim$(VBA.Mid$(auth_Lines(auth_i), VBA.InStr(1, auth_Lines(auth_i), "=") + 1, VBA.Len(auth_Lines(auth_i))))
' Remove quotes and trailing comma
auth_Value = VBA.Replace(auth_Value, """", "")
If VBA.Right$(auth_Value, 1) = "," Then
auth_Value = VBA.Left$(auth_Value, VBA.Len(auth_Value) - 1)
End If
' Find realm, nonce, and opaque
If auth_Key = "realm" Then Me.Realm = auth_Value
If auth_Key = "nonce" Then Me.ServerNonce = auth_Value
If auth_Key = "opaque" Then Me.Opaque = auth_Value
Next auth_i
WebHelpers.LogDebug "realm=" & Me.Realm & ", nonce=" & Me.ServerNonce & ", opaque=" & Me.Opaque, "DigestAuthenticator.ExtractAuthenticateInformation"
End If
End Sub
' ============================================= '
' Private Methods
' ============================================= '
''
' Calculate digest response fro given Client and Request
'
' @internal
' @param {WebClient} Client
' @param {WebRequest} Request
' @return {String}
''
Private Function web_CalculateResponse(web_Client As WebClient, web_Request As WebRequest) As String
Dim auth_HA1 As String
Dim auth_HA2 As String
Dim auth_Uri As String
auth_Uri = WebHelpers.GetUrlParts(web_Client.GetFullUrl(web_Request))("Path")
auth_HA1 = web_CalculateHA1
auth_HA2 = web_CalculateHA2(WebHelpers.MethodToName(web_Request.Method), auth_Uri)
web_CalculateResponse = WebHelpers.MD5(auth_HA1 & ":" & Me.ServerNonce & ":" & web_FormattedRequestCount & ":" & Me.ClientNonce & ":" & auth_Qop & ":" & auth_HA2)
End Function
''
' Calculate HA1 portion of digest response
'
' @internal
' @return {String}
''
Private Function web_CalculateHA1() As String
web_CalculateHA1 = WebHelpers.MD5(Me.Username & ":" & Me.Realm & ":" & Me.Password)
End Function
''
' Calculate HA1 portion of digest response
'
' @internal
' @return {String}
''
Private Function web_CalculateHA2(web_Method As String, web_Uri As String) As String
web_CalculateHA2 = WebHelpers.MD5(web_Method & ":" & web_Uri)
End Function
''
' Pad request count to 8 places
'
' @internal
' @return {String}
''
Private Function web_FormattedRequestCount() As String
web_FormattedRequestCount = Right("00000000" & Me.RequestCount, 8)
End Function