1'*************************************************************************** 2'* _ _ ____ _ 3'* Project ___| | | | _ \| | 4'* / __| | | | |_) | | 5'* | (__| |_| | _ <| |___ 6'* \___|\___/|_| \_\_____| 7'* 8'* Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, 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.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'*************************************************************************** 28Option Explicit 29Const myVersion = "0.4.0" 30 31Const myUrl = "https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt" 32 33Const myOpenSSL = "openssl.exe" 34Dim myUseOpenSSL 35myUseOpenSSL = TRUE ' Flag: TRUE to use OpenSSL. If TRUE and is not 36 ' found then a warning is shown before continuing. 37 38Const myCdSavF = TRUE ' Flag: save downloaded data to file certdata.txt 39Const myCaBakF = TRUE ' Flag: backup existing ca-bundle certificate 40Const myAskLiF = TRUE ' Flag: display certdata.txt license agreement 41Const 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. 47Const myAskTiF = FALSE ' Flag: ask to include certificate text info 48 49' 50'******************* Nothing to configure below! ******************* 51' 52Const adTypeBinary = 1 53Const adTypeText = 2 54Const adSaveCreateNotExist = 1 55Const adSaveCreateOverWrite = 2 56Dim objShell, objNetwork, objFSO, objHttp 57Dim myBase, mySelf, myStream, myTmpFh, myCdData, myCdFile 58Dim myCaFile, myTmpName, myBakNum, myOptTxt, i 59Set objNetwork = WScript.CreateObject("WScript.Network") 60Set objShell = WScript.CreateObject("WScript.Shell") 61Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 62Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest.5.1") 63If objHttp Is Nothing Then Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest") 64myBase = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, "\")) 65mySelf = Left(WScript.ScriptName, InstrRev(WScript.ScriptName, ".") - 1) & " " & myVersion 66 67myCdFile = Mid(myUrl, InstrRev(myUrl, "/") + 1) 68myCaFile = "ca-bundle.crt" 69myTmpName = 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) 73If (myTmpName = "") Then 74 WScript.Quit 1 75End If 76myCaFile = myTmpName 77If (myCdFile = "") Then 78 MsgBox("URL does not contain filename!"), vbCritical, mySelf 79 WScript.Quit 1 80End If 81 82' Don't use OpenSSL if it's not present. 83If (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 104End If 105 106If (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 116End If 117 118' Uncomment the line below to ignore SSL invalid cert errors 119' objHttp.Option(4) = 256 + 512 + 4096 + 8192 120objHttp.SetTimeouts 0, 5000, 10000, 10000 121objHttp.Open "GET", myUrl, FALSE 122objHttp.setRequestHeader "User-Agent", WScript.ScriptName & "/" & myVersion 123objHttp.Send "" 124If Not (objHttp.Status = 200) Then 125 MsgBox("Failed to download '" & myCdFile & "': " & objHttp.Status & " - " & objHttp.StatusText), vbCritical, mySelf 126 WScript.Quit 1 127End If 128' Write received data to file if enabled 129If (myCdSavF = TRUE) Then 130 Call SaveBinaryData(myCdFile, objHttp.ResponseBody) 131End If 132' Convert data from ResponseBody instead of using ResponseText because of UTF-8 133myCdData = ConvertBinaryToUTF8(objHttp.ResponseBody) 134Set objHttp = Nothing 135' Backup exitsing ca-bundle certificate file 136If (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 148End If 149 150' Process the received data 151Dim myLines, myPattern, myInsideCert, myInsideLicense, myLicenseText, myNumCerts, myNumSkipped 152Dim myLabel, myOctets, myData, myPem, myRev, myUntrusted, j 153myNumSkipped = 0 154myNumCerts = 0 155myData = "" 156myLines = Split(myCdData, vbLf, -1) 157Set myStream = CreateObject("ADODB.Stream") 158myStream.Open 159myStream.Type = adTypeText 160myStream.Charset = "utf-8" 161myStream.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 178If (myCdSavF = TRUE) And (myUseOpenSSL = TRUE) Then 179 myStream.WriteText "## SHA256: " & FileSHA256(myCdFile) & vbLf 180End If 181myStream.WriteText "##" & vbLf & vbLf 182 183myStream.WriteText vbLf 184For 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 267Next 268 269' To stop the UTF-8 BOM from being written the stream has to be copied and 270' then saved as binary. 271Dim myCopy 272Set myCopy = CreateObject("ADODB.Stream") 273myCopy.Type = adTypeBinary 274myCopy.Open 275myStream.Position = 3 ' Skip UTF-8 BOM 276myStream.CopyTo myCopy 277myCopy.SaveToFile myCaFile, adSaveCreateOverWrite 278myCopy.Close 279myStream.Close 280Set myCopy = Nothing 281Set myStream = Nothing 282 283' Done 284objShell.PopUp "Done (" & myNumCerts & " CA certs processed, " & myNumSkipped & _ 285 " untrusted skipped).", 20, mySelf, vbInformation 286WScript.Quit 0 287 288Function 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 299End Function 300 301Function 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 310End Function 311 312Function 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 325End Function 326 327Function 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 368End Function 369 370Function MyASC(OneChar) 371 If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar) 372End 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 376Function 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 393End 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 400Function 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 411End Function 412 413Function 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 431End Function 432