mk-ca-bundle.vbs@ 86643

Last change on this file since 86643 was 85671, checked in by vboxsync, 4 years ago
Export out internal curl copy to make it a lot simpler to build VBox (OSE) on Windows. bugref:9814
Property svn:eol-style set to `native`
File size: 15.8 KB

Line
1	'***************************************************************************
2	'* _ _ ____ _
3	'* Project ___\| \| \| \| _ \\| \|
4	'* / __\| \| \| \| \|_) \| \|
5	'* \| (__\| \|_\| \| _ <\| \|___
6	'* \___\|\___/\|_\| \_\_____\|
7	'*
8	'* Copyright (C) 1998 - 2014, Daniel Stenberg, <[email protected]>, et al.
9	'*
10	'* This software is licensed as described in the file COPYING, which
11	'* you should have received as part of this distribution. The terms
12	'* are also available at https://curl.haxx.se/docs/copyright.html.
13	'*
14	'* You may opt to use, copy, modify, merge, publish, distribute and/or sell
15	'* copies of the Software, and permit persons to whom the Software is
16	'* furnished to do so, under the terms of the COPYING file.
17	'*
18	'* This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
19	'* KIND, either express or implied.
20	'*
21	'***************************************************************************
22	'* Script to fetch certdata.txt from Mozilla.org site and create a
23	'* ca-bundle.crt for use with OpenSSL / libcurl / libcurl bindings
24	'* Requires WinHttp.WinHttpRequest.5.1 and ADODB.Stream which are part of
25	'* W2000 SP3 or later, WXP SP1 or later, W2003 Server SP1 or later.
26	'* Hacked by Guenter Knauf
27	'***************************************************************************
28	Option Explicit
29	Const myVersion = "0.4.0"
30
31	Const myUrl = "https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt"
32
33	Const myOpenSSL = "openssl.exe"
34	Dim myUseOpenSSL
35	myUseOpenSSL = TRUE ' Flag: TRUE to use OpenSSL. If TRUE and is not
36	' found then a warning is shown before continuing.
37
38	Const myCdSavF = TRUE ' Flag: save downloaded data to file certdata.txt
39	Const myCaBakF = TRUE ' Flag: backup existing ca-bundle certificate
40	Const myAskLiF = TRUE ' Flag: display certdata.txt license agreement
41	Const myWrapLe = 76 ' Default length of base64 output lines
42
43	' cert info code doesn't work properly with any recent openssl, leave disabled.
44	' Also: we want our certificate output by default to be as similar as possible
45	' to mk-ca-bundle.pl and setting this TRUE changes the base64 width to
46	' OpenSSL's built-in default width, which is not the same as mk-ca-bundle.pl.
47	Const myAskTiF = FALSE ' Flag: ask to include certificate text info
48
49	'
50	'***************** Nothing to configure below! *****************
51	'
52	Const adTypeBinary = 1
53	Const adTypeText = 2
54	Const adSaveCreateNotExist = 1
55	Const adSaveCreateOverWrite = 2
56	Dim objShell, objNetwork, objFSO, objHttp
57	Dim myBase, mySelf, myStream, myTmpFh, myCdData, myCdFile
58	Dim myCaFile, myTmpName, myBakNum, myOptTxt, i
59	Set objNetwork = WScript.CreateObject("WScript.Network")
60	Set objShell = WScript.CreateObject("WScript.Shell")
61	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
62	Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest.5.1")
63	If objHttp Is Nothing Then Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest")
64	myBase = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, "\"))
65	mySelf = Left(WScript.ScriptName, InstrRev(WScript.ScriptName, ".") - 1) & " " & myVersion
66
67	myCdFile = Mid(myUrl, InstrRev(myUrl, "/") + 1)
68	myCaFile = "ca-bundle.crt"
69	myTmpName = InputBox("It will take a minute to download and parse the " & _
70	"certificate data." & _
71	vbLf & vbLf & _
72	"Please enter the output filename:", mySelf, myCaFile)
73	If (myTmpName = "") Then
74	WScript.Quit 1
75	End If
76	myCaFile = myTmpName
77	If (myCdFile = "") Then
78	MsgBox("URL does not contain filename!"), vbCritical, mySelf
79	WScript.Quit 1
80	End If
81
82	' Don't use OpenSSL if it's not present.
83	If (myUseOpenSSL = TRUE) Then
84	Dim errnum
85
86	On Error Resume Next
87	Call objShell.Run("""" & myOpenSSL & """ version", 0, TRUE)
88	errnum = Err.Number
89	On Error GoTo 0
90
91	If Not (errnum = 0) Then
92	myUseOpenSSL = FALSE
93	MsgBox("OpenSSL was not found so the certificate bundle will not " & _
94	"include the SHA256 hash of the raw certificate data file " & _
95	"that was used to generate the certificates in the bundle. " & _
96	vbLf & vbLf & _
97	"This does not have any effect on the certificate output, " & _
98	"so this script will continue." & _
99	vbLf & vbLf & _
100	"If you want to set a custom location for OpenSSL or disable " & _
101	"this message then edit the variables at the start of the " & _
102	"script."), vbInformation, mySelf
103	End If
104	End If
105
106	If (myAskTiF = TRUE) And (myUseOpenSSL = TRUE) Then
107	If (6 = objShell.PopUp("Do you want to include text information about " & _
108	"each certificate?" & vbLf & _
109	"(Requires OpenSSL.exe in the current directory " & _
110	"or search path)",, _
111	mySelf, vbQuestion + vbYesNo + vbDefaultButton2)) Then
112	myOptTxt = TRUE
113	Else
114	myOptTxt = FALSE
115	End If
116	End If
117
118	' Uncomment the line below to ignore SSL invalid cert errors
119	' objHttp.Option(4) = 256 + 512 + 4096 + 8192
120	objHttp.SetTimeouts 0, 5000, 10000, 10000
121	objHttp.Open "GET", myUrl, FALSE
122	objHttp.setRequestHeader "User-Agent", WScript.ScriptName & "/" & myVersion
123	objHttp.Send ""
124	If Not (objHttp.Status = 200) Then
125	MsgBox("Failed to download '" & myCdFile & "': " & objHttp.Status & " - " & objHttp.StatusText), vbCritical, mySelf
126	WScript.Quit 1
127	End If
128	' Write received data to file if enabled
129	If (myCdSavF = TRUE) Then
130	Call SaveBinaryData(myCdFile, objHttp.ResponseBody)
131	End If
132	' Convert data from ResponseBody instead of using ResponseText because of UTF-8
133	myCdData = ConvertBinaryToUTF8(objHttp.ResponseBody)
134	Set objHttp = Nothing
135	' Backup exitsing ca-bundle certificate file
136	If (myCaBakF = TRUE) Then
137	If objFSO.FileExists(myCaFile) Then
138	Dim myBakFile, b
139	b = 1
140	myBakFile = myCaFile & ".~" & b & "~"
141	While objFSO.FileExists(myBakFile)
142	b = b + 1
143	myBakFile = myCaFile & ".~" & b & "~"
144	Wend
145	Set myTmpFh = objFSO.GetFile(myCaFile)
146	myTmpFh.Move myBakFile
147	End If
148	End If
149
150	' Process the received data
151	Dim myLines, myPattern, myInsideCert, myInsideLicense, myLicenseText, myNumCerts, myNumSkipped
152	Dim myLabel, myOctets, myData, myPem, myRev, myUntrusted, j
153	myNumSkipped = 0
154	myNumCerts = 0
155	myData = ""
156	myLines = Split(myCdData, vbLf, -1)
157	Set myStream = CreateObject("ADODB.Stream")
158	myStream.Open
159	myStream.Type = adTypeText
160	myStream.Charset = "utf-8"
161	myStream.WriteText "##" & vbLf & _
162	"## Bundle of CA Root Certificates" & vbLf & _
163	"##" & vbLf & _
164	"## Certificate data from Mozilla as of: " & _
165	ConvertDateToString(LocalDateToUTC(Now)) & " GMT" & vbLf & _
166	"##" & vbLf & _
167	"## This is a bundle of X.509 certificates of public Certificate Authorities" & vbLf & _
168	"## (CA). These were automatically extracted from Mozilla's root certificates" & vbLf & _
169	"## file (certdata.txt). This file can be found in the mozilla source tree:" & vbLf & _
170	"## " & myUrl & vbLf & _
171	"##" & vbLf & _
172	"## It contains the certificates in PEM format and therefore" & vbLf & _
173	"## can be directly used with curl / libcurl / php_curl, or with" & vbLf & _
174	"## an Apache+mod_ssl webserver for SSL client authentication." & vbLf & _
175	"## Just configure this file as the SSLCACertificateFile." & vbLf & _
176	"##" & vbLf & _
177	"## Conversion done with mk-ca-bundle.vbs version " & myVersion & "." & vbLf
178	If (myCdSavF = TRUE) And (myUseOpenSSL = TRUE) Then
179	myStream.WriteText "## SHA256: " & FileSHA256(myCdFile) & vbLf
180	End If
181	myStream.WriteText "##" & vbLf & vbLf
182
183	myStream.WriteText vbLf
184	For i = 0 To UBound(myLines)
185	If InstrRev(myLines(i), "CKA_LABEL ") Then
186	myPattern = "^CKA_LABEL\s+[A-Z0-9]+\s+""(.+?)"""
187	myLabel = RegExprFirst(myPattern, myLines(i))
188	End If
189	If (myInsideCert = TRUE) Then
190	If InstrRev(myLines(i), "END") Then
191	myInsideCert = FALSE
192	While (i < UBound(myLines)) And Not (myLines(i) = "#")
193	i = i + 1
194	If InstrRev(myLines(i), "CKA_TRUST_SERVER_AUTH CK_TRUST CKT_NSS_TRUSTED_DELEGATOR") Then
195	myUntrusted = FALSE
196	End If
197	Wend
198	If (myUntrusted = TRUE) Then
199	myNumSkipped = myNumSkipped + 1
200	Else
201	myStream.WriteText myLabel & vbLf
202	myStream.WriteText String(Len(myLabel), "=") & vbLf
203	myPem = "-----BEGIN CERTIFICATE-----" & vbLf & _
204	Base64Encode(myData) & vbLf & _
205	"-----END CERTIFICATE-----" & vbLf
206	If (myOptTxt = FALSE) Then
207	myStream.WriteText myPem & vbLf
208	Else
209	Dim myCmd, myRval, myTmpIn, myTmpOut
210	myTmpIn = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
211	myTmpOut = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
212	Set myTmpFh = objFSO.OpenTextFile(myTmpIn, 2, TRUE)
213	myTmpFh.Write myPem
214	myTmpFh.Close
215	myCmd = """" & myOpenSSL & """ x509 -md5 -fingerprint -text " & _
216	"-inform PEM -in " & myTmpIn & " -out " & myTmpOut
217	myRval = objShell.Run (myCmd, 0, TRUE)
218	objFSO.DeleteFile myTmpIn, TRUE
219	If Not (myRval = 0) Then
220	MsgBox("Failed to process PEM cert with OpenSSL commandline!"), vbCritical, mySelf
221	objFSO.DeleteFile myTmpOut, TRUE
222	WScript.Quit 3
223	End If
224	Set myTmpFh = objFSO.OpenTextFile(myTmpOut, 1)
225	myStream.WriteText myTmpFh.ReadAll & vbLf
226	myTmpFh.Close
227	objFSO.DeleteFile myTmpOut, TRUE
228	End If
229	myNumCerts = myNumCerts + 1
230	End If
231	Else
232	myOctets = Split(myLines(i), "\")
233	For j = 1 To UBound(myOctets)
234	myData = myData & Chr(CByte("&o" & myOctets(j)))
235	Next
236	End If
237	End If
238	If InstrRev(myLines(i), "CVS_ID ") Then
239	myPattern = "^CVS_ID\s+""(.+?)"""
240	myRev = RegExprFirst(myPattern, myLines(i))
241	myStream.WriteText "# " & myRev & vbLf & vbLf
242	End If
243	If InstrRev(myLines(i), "CKA_VALUE MULTILINE_OCTAL") Then
244	myInsideCert = TRUE
245	myUntrusted = TRUE
246	myData = ""
247	End If
248	If InstrRev(myLines(i), "*** BEGIN LICENSE BLOCK ***") Then
249	myInsideLicense = TRUE
250	End If
251	If (myInsideLicense = TRUE) Then
252	myStream.WriteText myLines(i) & vbLf
253	myLicenseText = myLicenseText & Mid(myLines(i), 2) & vbLf
254	End If
255	If InstrRev(myLines(i), "*** END LICENSE BLOCK ***") Then
256	myInsideLicense = FALSE
257	If (myAskLiF = TRUE) Then
258	If Not (6 = objShell.PopUp(myLicenseText & vbLf & _
259	"Do you agree to the license shown above (required to proceed) ?",, _
260	mySelf, vbQuestion + vbYesNo + vbDefaultButton1)) Then
261	myStream.Close
262	objFSO.DeleteFile myCaFile, TRUE
263	WScript.Quit 2
264	End If
265	End If
266	End If
267	Next
268
269	' To stop the UTF-8 BOM from being written the stream has to be copied and
270	' then saved as binary.
271	Dim myCopy
272	Set myCopy = CreateObject("ADODB.Stream")
273	myCopy.Type = adTypeBinary
274	myCopy.Open
275	myStream.Position = 3 ' Skip UTF-8 BOM
276	myStream.CopyTo myCopy
277	myCopy.SaveToFile myCaFile, adSaveCreateOverWrite
278	myCopy.Close
279	myStream.Close
280	Set myCopy = Nothing
281	Set myStream = Nothing
282
283	' Done
284	objShell.PopUp "Done (" & myNumCerts & " CA certs processed, " & myNumSkipped & _
285	" untrusted skipped).", 20, mySelf, vbInformation
286	WScript.Quit 0
287
288	Function ConvertBinaryToUTF8(arrBytes)
289	Dim objStream
290	Set objStream = CreateObject("ADODB.Stream")
291	objStream.Open
292	objStream.Type = adTypeBinary
293	objStream.Write arrBytes
294	objStream.Position = 0
295	objStream.Type = adTypeText
296	objStream.Charset = "utf-8"
297	ConvertBinaryToUTF8 = objStream.ReadText
298	Set objStream = Nothing
299	End Function
300
301	Function SaveBinaryData(filename, data)
302	Dim objStream
303	Set objStream = CreateObject("ADODB.Stream")
304	objStream.Type = adTypeBinary
305	objStream.Open
306	objStream.Write data
307	objStream.SaveToFile filename, adSaveCreateOverWrite
308	objStream.Close
309	Set objStream = Nothing
310	End Function
311
312	Function RegExprFirst(SearchPattern, TheString)
313	Dim objRegExp, Matches ' create variables.
314	Set objRegExp = New RegExp ' create a regular expression.
315	objRegExp.Pattern = SearchPattern ' sets the search pattern.
316	objRegExp.IgnoreCase = TRUE ' set to ignores case.
317	objRegExp.Global = TRUE ' set to global search.
318	Set Matches = objRegExp.Execute(TheString) ' do the search.
319	If (Matches.Count) Then
320	RegExprFirst = Matches(0).SubMatches(0) ' return first match.
321	Else
322	RegExprFirst = ""
323	End If
324	Set objRegExp = Nothing
325	End Function
326
327	Function Base64Encode(inData)
328	Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
329	Dim cOut, sOut, lWrap, I
330	lWrap = Int(myWrapLe * 3 / 4)
331
332	'For each group of 3 bytes
333	For I = 1 To Len(inData) Step 3
334	Dim nGroup, pOut, sGroup
335
336	'Create one long from this 3 bytes.
337	nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
338	&H100 * MyASC(Mid(inData, I + 1, 1)) + _
339	MyASC(Mid(inData, I + 2, 1))
340
341	'Oct splits the long To 8 groups with 3 bits
342	nGroup = Oct(nGroup)
343
344	'Add leading zeros
345	nGroup = String(8 - Len(nGroup), "0") & nGroup
346
347	'Convert To base64
348	pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) & _
349	Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) & _
350	Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) & _
351	Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
352
353	'Add the part To OutPut string
354	sOut = sOut + pOut
355
356	'Add a new line For Each myWrapLe chars In dest
357	If (I < Len(inData) - 2) Then
358	If (I + 2) Mod lWrap = 0 Then sOut = sOut & vbLf
359	End If
360	Next
361	Select Case Len(inData) Mod 3
362	Case 1: '8 bit final
363	sOut = Left(sOut, Len(sOut) - 2) & "=="
364	Case 2: '16 bit final
365	sOut = Left(sOut, Len(sOut) - 1) & "="
366	End Select
367	Base64Encode = sOut
368	End Function
369
370	Function MyASC(OneChar)
371	If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
372	End Function
373
374	' Return the date in the same format as perl to match mk-ca-bundle.pl output:
375	' Wed Sep 7 03:12:05 2016
376	Function ConvertDateToString(input)
377	Dim output
378	output = WeekDayName(WeekDay(input), TRUE) & " " & _
379	MonthName(Month(input), TRUE) & " "
380	If (Len(Day(input)) = 1) Then
381	output = output & " "
382	End If
383	output = output & _
384	Day(input) & " " & _
385	FormatDateTime(input, vbShortTime) & ":"
386	If (Len(Second(input)) = 1) Then
387	output = output & "0"
388	End If
389	output = output & _
390	Second(input) & " " & _
391	Year(input)
392	ConvertDateToString = output
393	End Function
394
395	' Convert local Date to UTC. Microsoft says:
396	' Use Win32_ComputerSystem CurrentTimeZone property, because it automatically
397	' adjusts the Time Zone bias for daylight saving time; Win32_Time Zone Bias
398	' property does not.
399	' https://msdn.microsoft.com/en-us/library/windows/desktop/ms696015.aspx
400	Function LocalDateToUTC(localdate)
401	Dim item, offset
402	For Each item In GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
403	offset = item.CurrentTimeZone ' the offset in minutes
404	Next
405	If (offset < 0) Then
406	LocalDateToUTC = DateAdd("n", ABS(offset), localdate)
407	Else
408	LocalDateToUTC = DateAdd("n", -ABS(offset), localdate)
409	End If
410	'objShell.PopUp LocalDateToUTC
411	End Function
412
413	Function FileSHA256(filename)
414	Dim cmd, rval, tmpOut, tmpFh
415	if (myUseOpenSSL = TRUE) Then
416	tmpOut = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
417	cmd = """" & myOpenSSL & """ dgst -r -sha256 -out """ & tmpOut & """ """ & filename & """"
418	rval = objShell.Run(cmd, 0, TRUE)
419	If Not (rval = 0) Then
420	MsgBox("Failed to get sha256 of """ & filename & """ with OpenSSL commandline!"), vbCritical, mySelf
421	objFSO.DeleteFile tmpOut, TRUE
422	WScript.Quit 3
423	End If
424	Set tmpFh = objFSO.OpenTextFile(tmpOut, 1)
425	FileSHA256 = RegExprFirst("^([0-9a-f]{64}) .+", tmpFh.ReadAll)
426	tmpFh.Close
427	objFSO.DeleteFile tmpOut, TRUE
428	Else
429	FileSHA256 = ""
430	End If
431	End Function

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format