generic-library/curl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
b0ccd24a72
curl/lib/mk-ca-bundle.vbs
Guenter Knauf daa96f9928 Added mk-ca-bundle.vbs script. 
The script works exactly same as the Perl one except for one thing:
when the text descriptions generated with openssl are included then
the md5 fingerprints are missing; seems openssl has either a bug or
a feature which prints the md5 fingerprint output to stdout instead
of writing them to specified file; this script could here do the same
as what the Perl scripr does (redirect stdout into file) but this
makes the script take up double the time because it needs to launch
cmd.exe 140 times (fo each openssl call). So I think for now we just
ommit the md5 fingerprints, and see if openssl will be fixed.
2010-08-20 03:02:49 +02:00

272 lines
11 KiB
Plaintext
Executable File
Raw Blame History

'***************************************************************************
'* _ _ ____ _
'* Project ___| | | | _ \| |
'* / __| | | | |_) | |
'* | (__| |_| | _ <| |___
'* \___|\___/|_| \_\_____|
'*
'* Copyright (C) 1998 - 2010, 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 http://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.3.5"
Const myUrl = "http://mxr.mozilla.org/firefox/source/security/nss/lib/ckfw/builtins/certdata.txt?raw=1"
Const myOpenssl = "openssl.exe"
Const myCdSavF = FALSE ' 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 myAskTiF = TRUE ' 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, InstrRev(myUrl, "?") - InstrRev(myUrl, "/") - 1)
myCaFile = "ca-bundle.crt"
myTmpName = InputBox("Enter output filename:", mySelf, myCaFile)
If Not (myTmpName = "") Then
myCaFile = myTmpName
End If
' Lets 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.statusText = "OK") Then
MsgBox("Failed to download '" & myCdFile & "': " & objHttp.statusText), vbCritical, mySelf
WScript.Quit 1
End If
' Convert data from ResponseBody instead of using ResponseText because of UTF-8
myCdData = ConvertBinaryData(objHttp.ResponseBody)
Set objHttp = Nothing
' Write received data to file if enabled
If (myCdSavF = TRUE) Then
Set myFh = objFSO.OpenTextFile(myCdFile, 2, TRUE)
myFh.Write myCdData
myFh.Close
End If
' 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
Dim myLabel, myOctets, myData, myPem, myRev, j
myData = ""
myLines = Split(myCdData, vbLf, -1)
Set myFh = objFSO.OpenTextFile(myCaFile, 2, TRUE)
myFh.Write "##" & vbLf
myFh.Write "## " & myCaFile & " -- Bundle of CA Root Certificates" & vbLf
myFh.Write "##" & vbLf
myFh.Write "## Converted at: " & Now & 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 "## '/mozilla/security/nss/lib/ckfw/builtins/certdata.txt'" & 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 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
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
myData = ""
myNumCerts = myNumCerts + 1
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
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).", 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 = "ascii"
ConvertBinaryData = objStream.ReadText
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, I
'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 76 chars In dest (76*3/4 = 57)
If (I < Len(inData) - 2) Then
If (I + 2) Mod 57 = 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
Reference in New Issue View Git Blame Copy Permalink