mirror of
https://github.com/moparisthebest/curl
synced 2024-08-13 17:03:50 -04:00
d2c6d1568e
Bring the VBScript version more in line with the perl version: - Change timestamp to UTC. - Change URL retrieval to HTTPS-only by default. - Comment out the options that disabled SSL cert checking by default. - Assume OpenSSL is present, get SHA256. And add a flag to toggle it. - Fix cert issuer name output. The cert issuer output is now ansi, converted from UTF-8. Prior to this it was corrupt UTF-8. It turns out though we can work with UTF-8 the FSO object that writes ca-bundle can't write UTF-8, so there will have to be some alternative if UTF-8 is needed (like an ADODB.Stream). - Disable the certificate text info feature. The certificate text info doesn't work properly with any recent OpenSSL.
369 lines
14 KiB
Plaintext
Executable File
369 lines
14 KiB
Plaintext
Executable File
'***************************************************************************
|
|
'* _ _ ____ _
|
|
'* Project ___| | | | _ \| |
|
|
'* / __| | | | |_) | |
|
|
'* | (__| |_| | _ <| |___
|
|
'* \___|\___/|_| \_\_____|
|
|
'*
|
|
'* Copyright (C) 1998 - 2014, Daniel Stenberg, <daniel@haxx.se>, et al.
|
|
'*
|
|
'* This software is licensed as described in the file COPYING, which
|
|
'* you should have received as part of this distribution. The terms
|
|
'* are also available at https://curl.haxx.se/docs/copyright.html.
|
|
'*
|
|
'* You may opt to use, copy, modify, merge, publish, distribute and/or sell
|
|
'* copies of the Software, and permit persons to whom the Software is
|
|
'* furnished to do so, under the terms of the COPYING file.
|
|
'*
|
|
'* This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
|
|
'* KIND, either express or implied.
|
|
'*
|
|
'***************************************************************************
|
|
'* Script to fetch certdata.txt from Mozilla.org site and create a
|
|
'* ca-bundle.crt for use with OpenSSL / libcurl / libcurl bindings
|
|
'* Requires WinHttp.WinHttpRequest.5.1 and ADODB.Stream which are part of
|
|
'* W2000 SP3 or later, WXP SP1 or later, W2003 Server SP1 or later.
|
|
'* Hacked by Guenter Knauf
|
|
'***************************************************************************
|
|
Option Explicit
|
|
Const myVersion = "0.4.0"
|
|
|
|
Const myUrl = "https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt"
|
|
Const myOpenssl = "openssl.exe"
|
|
|
|
Const myUseOpenSSL = TRUE ' Flag: set FALSE if openssl is not present
|
|
Const myCdSavF = TRUE ' Flag: save downloaded data to file certdata.txt
|
|
Const myCaBakF = TRUE ' Flag: backup existing ca-bundle certificate
|
|
Const myAskLiF = TRUE ' Flag: display certdata.txt license agreement
|
|
Const myWrapLe = 76 ' Default length of base64 output lines
|
|
|
|
' cert info code doesn't work properly with any recent openssl, leave disabled.
|
|
Const myAskTiF = FALSE ' Flag: ask to include certificate text info
|
|
|
|
'******************* Nothing to configure below! *******************
|
|
Dim objShell, objNetwork, objFSO, objHttp
|
|
Dim myBase, mySelf, myFh, myTmpFh, myCdData, myCdFile, myCaFile, myTmpName, myBakNum, myOptTxt, i
|
|
Set objNetwork = WScript.CreateObject("WScript.Network")
|
|
Set objShell = WScript.CreateObject("WScript.Shell")
|
|
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
|
|
Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest.5.1")
|
|
If objHttp Is Nothing Then Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest")
|
|
myBase = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, "\"))
|
|
mySelf = Left(WScript.ScriptName, InstrRev(WScript.ScriptName, ".") - 1) & " " & myVersion
|
|
myCdFile = Mid(myUrl, InstrRev(myUrl, "/") + 1)
|
|
myCaFile = "ca-bundle.crt"
|
|
myTmpName = InputBox("Enter output filename:", mySelf, myCaFile)
|
|
If Not (myTmpName = "") Then
|
|
myCaFile = myTmpName
|
|
End If
|
|
If (myCdFile = "") Then
|
|
MsgBox("URL does not contain filename!"), vbCritical, mySelf
|
|
WScript.Quit 1
|
|
End If
|
|
' Uncomment the line below to ignore SSL invalid cert errors
|
|
' objHttp.Option(4) = 256 + 512 + 4096 + 8192
|
|
objHttp.SetTimeouts 0, 5000, 10000, 10000
|
|
objHttp.Open "GET", myUrl, FALSE
|
|
objHttp.setRequestHeader "User-Agent", WScript.ScriptName & "/" & myVersion
|
|
objHttp.Send ""
|
|
If Not (objHttp.Status = 200) Then
|
|
MsgBox("Failed to download '" & myCdFile & "': " & objHttp.Status & " - " & objHttp.StatusText), vbCritical, mySelf
|
|
WScript.Quit 1
|
|
End If
|
|
' Write received data to file if enabled
|
|
If (myCdSavF = TRUE) Then
|
|
Call SaveBinaryData(myCdFile, objHttp.ResponseBody)
|
|
End If
|
|
' Convert data from ResponseBody instead of using ResponseText because of UTF-8
|
|
myCdData = ConvertBinaryData(objHttp.ResponseBody)
|
|
Set objHttp = Nothing
|
|
' Backup exitsing ca-bundle certificate file
|
|
If (myCaBakF = TRUE) Then
|
|
If objFSO.FileExists(myCaFile) Then
|
|
Dim myBakFile, b
|
|
b = 1
|
|
myBakFile = myCaFile & ".~" & b & "~"
|
|
While objFSO.FileExists(myBakFile)
|
|
b = b + 1
|
|
myBakFile = myCaFile & ".~" & b & "~"
|
|
Wend
|
|
Set myTmpFh = objFSO.GetFile(myCaFile)
|
|
myTmpFh.Move myBakFile
|
|
End If
|
|
End If
|
|
If (myAskTiF = TRUE) Then
|
|
If (6 = objShell.PopUp("Do you want to include text information about each certificate?" & vbLf & _
|
|
"(requires OpenSSL commandline in current directory or in search path)",, _
|
|
mySelf, vbQuestion + vbYesNo + vbDefaultButton2)) Then
|
|
myOptTxt = TRUE
|
|
Else
|
|
myOptTxt = FALSE
|
|
End If
|
|
End If
|
|
' Process the received data
|
|
Dim myLines, myPattern, myInsideCert, myInsideLicense, myLicenseText, myNumCerts, myNumSkipped
|
|
Dim myLabel, myOctets, myData, myPem, myRev, myUntrusted, j
|
|
myNumSkipped = 0
|
|
myNumCerts = 0
|
|
myData = ""
|
|
myLines = Split(myCdData, vbLf, -1)
|
|
Set myFh = objFSO.OpenTextFile(myCaFile, 2, TRUE)
|
|
myFh.Write "##" & vbLf
|
|
myFh.Write "## Bundle of CA Root Certificates" & vbLf
|
|
myFh.Write "##" & vbLf
|
|
myFh.Write "## Certificate data from Mozilla as of: " & _
|
|
ConvertDateToString(LocalDateToUTC(Now)) & " GMT" & vbLf
|
|
myFh.Write "##" & vbLf
|
|
myFh.Write "## This is a bundle of X.509 certificates of public Certificate Authorities" & vbLf
|
|
myFh.Write "## (CA). These were automatically extracted from Mozilla's root certificates" & vbLf
|
|
myFh.Write "## file (certdata.txt). This file can be found in the mozilla source tree:" & vbLf
|
|
myFh.Write "## " & myUrl & vbLf
|
|
myFh.Write "##" & vbLf
|
|
myFh.Write "## It contains the certificates in PEM format and therefore" & vbLf
|
|
myFh.Write "## can be directly used with curl / libcurl / php_curl, or with" & vbLf
|
|
myFh.Write "## an Apache+mod_ssl webserver for SSL client authentication." & vbLf
|
|
myFh.Write "## Just configure this file as the SSLCACertificateFile." & vbLf
|
|
myFh.Write "##" & vbLf
|
|
myFh.Write "## Conversion done with mk-ca-bundle.vbs version " & myVersion & "." & vbLf
|
|
If (myCdSavF = TRUE) And (myUseOpenSSL = TRUE) Then
|
|
myFh.Write "## SHA256: " & FileSHA256(myCdFile) & vbLf
|
|
End If
|
|
myFh.Write "##" & vbLf & vbLf
|
|
|
|
myFh.Write vbLf
|
|
For i = 0 To UBound(myLines)
|
|
If InstrRev(myLines(i), "CKA_LABEL ") Then
|
|
myPattern = "^CKA_LABEL\s+[A-Z0-9]+\s+""(.+?)"""
|
|
myLabel = RegExprFirst(myPattern, myLines(i))
|
|
End If
|
|
If (myInsideCert = TRUE) Then
|
|
If InstrRev(myLines(i), "END") Then
|
|
myInsideCert = FALSE
|
|
While (i < UBound(myLines)) And Not (myLines(i) = "#")
|
|
i = i + 1
|
|
If InstrRev(myLines(i), "CKA_TRUST_SERVER_AUTH CK_TRUST CKT_NSS_TRUSTED_DELEGATOR") Then
|
|
myUntrusted = FALSE
|
|
End If
|
|
Wend
|
|
If (myUntrusted = TRUE) Then
|
|
myNumSkipped = myNumSkipped + 1
|
|
Else
|
|
myFh.Write myLabel & vbLf
|
|
myFh.Write String(Len(myLabel), "=") & vbLf
|
|
myPem = "-----BEGIN CERTIFICATE-----" & vbLf & _
|
|
Base64Encode(myData) & vbLf & _
|
|
"-----END CERTIFICATE-----" & vbLf
|
|
If (myOptTxt = FALSE) Then
|
|
myFh.Write myPem & vbLf
|
|
Else
|
|
Dim myCmd, myRval, myTmpIn, myTmpOut
|
|
myTmpIn = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
|
|
myTmpOut = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
|
|
Set myTmpFh = objFSO.OpenTextFile(myTmpIn, 2, TRUE)
|
|
myTmpFh.Write myPem
|
|
myTmpFh.Close
|
|
myCmd = myOpenssl & " x509 -md5 -fingerprint -text -inform PEM" & _
|
|
" -in " & myTmpIn & " -out " & myTmpOut
|
|
myRval = objShell.Run (myCmd, 0, TRUE)
|
|
objFSO.DeleteFile myTmpIn, TRUE
|
|
If Not (myRval = 0) Then
|
|
MsgBox("Failed to process PEM cert with OpenSSL commandline!"), vbCritical, mySelf
|
|
objFSO.DeleteFile myTmpOut, TRUE
|
|
WScript.Quit 3
|
|
End If
|
|
Set myTmpFh = objFSO.OpenTextFile(myTmpOut, 1)
|
|
myFh.Write myTmpFh.ReadAll & vbLf
|
|
myTmpFh.Close
|
|
objFSO.DeleteFile myTmpOut, TRUE
|
|
End If
|
|
myNumCerts = myNumCerts + 1
|
|
End If
|
|
Else
|
|
myOctets = Split(myLines(i), "\")
|
|
For j = 1 To UBound(myOctets)
|
|
myData = myData & Chr(CByte("&o" & myOctets(j)))
|
|
Next
|
|
End If
|
|
End If
|
|
If InstrRev(myLines(i), "CVS_ID ") Then
|
|
myPattern = "^CVS_ID\s+""(.+?)"""
|
|
myRev = RegExprFirst(myPattern, myLines(i))
|
|
myFh.Write "# " & myRev & vbLf & vbLf
|
|
End If
|
|
If InstrRev(myLines(i), "CKA_VALUE MULTILINE_OCTAL") Then
|
|
myInsideCert = TRUE
|
|
myUntrusted = TRUE
|
|
myData = ""
|
|
End If
|
|
If InstrRev(myLines(i), "***** BEGIN LICENSE BLOCK *****") Then
|
|
myInsideLicense = TRUE
|
|
End If
|
|
If (myInsideLicense = TRUE) Then
|
|
myFh.Write myLines(i) & vbLf
|
|
myLicenseText = myLicenseText & Mid(myLines(i), 2) & vbLf
|
|
End If
|
|
If InstrRev(myLines(i), "***** END LICENSE BLOCK *****") Then
|
|
myInsideLicense = FALSE
|
|
If (myAskLiF = TRUE) Then
|
|
If Not (6 = objShell.PopUp(myLicenseText & vbLf & _
|
|
"Do you agree to the license shown above (required to proceed) ?",, _
|
|
mySelf, vbQuestion + vbYesNo + vbDefaultButton1)) Then
|
|
myFh.Close
|
|
objFSO.DeleteFile myCaFile, TRUE
|
|
WScript.Quit 2
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
myFh.Close
|
|
objShell.PopUp "Done (" & myNumCerts & " CA certs processed, " & myNumSkipped & _
|
|
" untrusted skipped).", 20, mySelf, vbInformation
|
|
WScript.Quit 0
|
|
|
|
Function ConvertBinaryData(arrBytes)
|
|
Dim objStream
|
|
Set objStream = CreateObject("ADODB.Stream")
|
|
objStream.Open
|
|
objStream.Type = 1
|
|
objStream.Write arrBytes
|
|
objStream.Position = 0
|
|
objStream.Type = 2
|
|
objStream.Charset = "utf-8"
|
|
ConvertBinaryData = objStream.ReadText
|
|
Set objStream = Nothing
|
|
End Function
|
|
|
|
Function SaveBinaryData(filename, data)
|
|
Const adTypeBinary = 1
|
|
Const adSaveCreateOverWrite = 2
|
|
Dim objStream
|
|
Set objStream = CreateObject("ADODB.Stream")
|
|
objStream.Type = adTypeBinary
|
|
objStream.Open
|
|
objStream.Write data
|
|
objStream.SaveToFile filename, adSaveCreateOverWrite
|
|
objStream.Close
|
|
Set objStream = Nothing
|
|
End Function
|
|
|
|
Function RegExprFirst(SearchPattern, TheString)
|
|
Dim objRegExp, Matches ' create variables.
|
|
Set objRegExp = New RegExp ' create a regular expression.
|
|
objRegExp.Pattern = SearchPattern ' sets the search pattern.
|
|
objRegExp.IgnoreCase = TRUE ' set to ignores case.
|
|
objRegExp.Global = TRUE ' set to gloabal search.
|
|
Set Matches = objRegExp.Execute(TheString) ' do the search.
|
|
If (Matches.Count) Then
|
|
RegExprFirst = Matches(0).SubMatches(0) ' return first match.
|
|
Else
|
|
RegExprFirst = ""
|
|
End If
|
|
Set objRegExp = Nothing
|
|
End Function
|
|
|
|
Function Base64Encode(inData)
|
|
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
|
Dim cOut, sOut, lWrap, I
|
|
lWrap = Int(myWrapLe * 3 / 4)
|
|
|
|
'For each group of 3 bytes
|
|
For I = 1 To Len(inData) Step 3
|
|
Dim nGroup, pOut, sGroup
|
|
|
|
'Create one long from this 3 bytes.
|
|
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
|
|
&H100 * MyASC(Mid(inData, I + 1, 1)) + _
|
|
MyASC(Mid(inData, I + 2, 1))
|
|
|
|
'Oct splits the long To 8 groups with 3 bits
|
|
nGroup = Oct(nGroup)
|
|
|
|
'Add leading zeros
|
|
nGroup = String(8 - Len(nGroup), "0") & nGroup
|
|
|
|
'Convert To base64
|
|
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) & _
|
|
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) & _
|
|
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) & _
|
|
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
|
|
|
|
'Add the part To OutPut string
|
|
sOut = sOut + pOut
|
|
|
|
'Add a new line For Each myWrapLe chars In dest
|
|
If (I < Len(inData) - 2) Then
|
|
If (I + 2) Mod lWrap = 0 Then sOut = sOut & vbLf
|
|
End If
|
|
Next
|
|
Select Case Len(inData) Mod 3
|
|
Case 1: '8 bit final
|
|
sOut = Left(sOut, Len(sOut) - 2) & "=="
|
|
Case 2: '16 bit final
|
|
sOut = Left(sOut, Len(sOut) - 1) & "="
|
|
End Select
|
|
Base64Encode = sOut
|
|
End Function
|
|
|
|
Function MyASC(OneChar)
|
|
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
|
|
End Function
|
|
|
|
' Return the date in the same format as perl to match mk-ca-bundle.pl output:
|
|
' Wed Sep 7 03:12:05 2016
|
|
Function ConvertDateToString(input)
|
|
Dim output
|
|
output = WeekDayName(WeekDay(input), TRUE) & " " & _
|
|
MonthName(Month(input), TRUE) & " "
|
|
If (Len(Day(input)) = 1) Then
|
|
output = output & " "
|
|
End If
|
|
output = output & _
|
|
Day(input) & " " & _
|
|
FormatDateTime(input, vbShortTime) & ":"
|
|
If (Len(Second(input)) = 1) Then
|
|
output = output & "0"
|
|
End If
|
|
output = output & _
|
|
Second(input) & " " & _
|
|
Year(input)
|
|
ConvertDateToString = output
|
|
End Function
|
|
|
|
' Convert local Date to UTC. Microsoft says:
|
|
' Use Win32_ComputerSystem CurrentTimeZone property, because it automatically
|
|
' adjusts the Time Zone bias for daylight saving time; Win32_Time Zone Bias
|
|
' property does not.
|
|
' https://msdn.microsoft.com/en-us/library/windows/desktop/ms696015.aspx
|
|
Function LocalDateToUTC(localdate)
|
|
Dim item, offset
|
|
For Each item In GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
|
|
offset = item.CurrentTimeZone ' the offset in minutes
|
|
Next
|
|
If (offset < 0) Then
|
|
LocalDateToUTC = DateAdd("n", ABS(offset), localdate)
|
|
Else
|
|
LocalDateToUTC = DateAdd("n", -ABS(offset), localdate)
|
|
End If
|
|
'objShell.PopUp LocalDateToUTC
|
|
End Function
|
|
|
|
Function FileSHA256(filename)
|
|
Dim cmd, rval, tmpOut, tmpFh
|
|
if (myUseOpenSSL = TRUE) Then
|
|
tmpOut = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
|
|
cmd = """" & myOpenssl & """ dgst -r -sha256 -out """ & tmpOut & """ """ & filename & """"
|
|
rval = objShell.Run(cmd, 0, TRUE)
|
|
If Not (rval = 0) Then
|
|
MsgBox("Failed to get sha256 of """ & filename & """ with OpenSSL commandline!"), vbCritical, mySelf
|
|
objFSO.DeleteFile tmpOut, TRUE
|
|
WScript.Quit 3
|
|
End If
|
|
Set tmpFh = objFSO.OpenTextFile(tmpOut, 1)
|
|
FileSHA256 = RegExprFirst("^([0-9a-f]{64}) .+", tmpFh.ReadAll)
|
|
tmpFh.Close
|
|
objFSO.DeleteFile tmpOut, TRUE
|
|
Else
|
|
FileSHA256 = ""
|
|
End If
|
|
End Function
|