mk-ca-bundle.vbs 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287
  1. '***************************************************************************
  2. '* _ _ ____ _
  3. '* Project ___| | | | _ \| |
  4. '* / __| | | | |_) | |
  5. '* | (__| |_| | _ <| |___
  6. '* \___|\___/|_| \_\_____|
  7. '*
  8. '* Copyright (C) 1998 - 2013, 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 http://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.3.8"
  30. Const myUrl = "http://mxr.mozilla.org/mozilla/source/security/nss/lib/ckfw/builtins/certdata.txt?raw=1"
  31. Const myOpenssl = "openssl.exe"
  32. Const myCdSavF = FALSE ' Flag: save downloaded data to file certdata.txt
  33. Const myCaBakF = TRUE ' Flag: backup existing ca-bundle certificate
  34. Const myAskLiF = TRUE ' Flag: display certdata.txt license agreement
  35. Const myAskTiF = TRUE ' Flag: ask to include certificate text info
  36. Const myWrapLe = 76 ' Default length of base64 output lines
  37. '******************* Nothing to configure below! *******************
  38. Dim objShell, objNetwork, objFSO, objHttp
  39. Dim myBase, mySelf, myFh, myTmpFh, myCdData, myCdFile, myCaFile, myTmpName, myBakNum, myOptTxt, i
  40. Set objNetwork = WScript.CreateObject("WScript.Network")
  41. Set objShell = WScript.CreateObject("WScript.Shell")
  42. Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
  43. Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest.5.1")
  44. If objHttp Is Nothing Then Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest")
  45. myBase = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, "\"))
  46. mySelf = Left(WScript.ScriptName, InstrRev(WScript.ScriptName, ".") - 1) & " " & myVersion
  47. myCdFile = Mid(myUrl, InstrRev(myUrl, "/") + 1, InstrRev(myUrl, "?") - InstrRev(myUrl, "/") - 1)
  48. myCaFile = "ca-bundle.crt"
  49. myTmpName = InputBox("Enter output filename:", mySelf, myCaFile)
  50. If Not (myTmpName = "") Then
  51. myCaFile = myTmpName
  52. End If
  53. ' Lets ignore SSL invalid cert errors
  54. objHttp.Option(4) = 256 + 512 + 4096 + 8192
  55. objHttp.SetTimeouts 0, 5000, 10000, 10000
  56. objHttp.Open "GET", myUrl, FALSE
  57. objHttp.setRequestHeader "User-Agent", WScript.ScriptName & "/" & myVersion
  58. objHttp.Send ""
  59. If Not (objHttp.statusText = "OK") Then
  60. MsgBox("Failed to download '" & myCdFile & "': " & objHttp.statusText), vbCritical, mySelf
  61. WScript.Quit 1
  62. End If
  63. ' Convert data from ResponseBody instead of using ResponseText because of UTF-8
  64. myCdData = ConvertBinaryData(objHttp.ResponseBody)
  65. Set objHttp = Nothing
  66. ' Write received data to file if enabled
  67. If (myCdSavF = TRUE) Then
  68. Set myFh = objFSO.OpenTextFile(myCdFile, 2, TRUE)
  69. myFh.Write myCdData
  70. myFh.Close
  71. End If
  72. ' Backup exitsing ca-bundle certificate file
  73. If (myCaBakF = TRUE) Then
  74. If objFSO.FileExists(myCaFile) Then
  75. Dim myBakFile, b
  76. b = 1
  77. myBakFile = myCaFile & ".~" & b & "~"
  78. While objFSO.FileExists(myBakFile)
  79. b = b + 1
  80. myBakFile = myCaFile & ".~" & b & "~"
  81. Wend
  82. Set myTmpFh = objFSO.GetFile(myCaFile)
  83. myTmpFh.Move myBakFile
  84. End If
  85. End If
  86. If (myAskTiF = TRUE) Then
  87. If (6 = objShell.PopUp("Do you want to include text information about each certificate?" & vbLf & _
  88. "(requires OpenSSL commandline in current directory or in search path)",, _
  89. mySelf, vbQuestion + vbYesNo + vbDefaultButton2)) Then
  90. myOptTxt = TRUE
  91. Else
  92. myOptTxt = FALSE
  93. End If
  94. End If
  95. ' Process the received data
  96. Dim myLines, myPattern, myInsideCert, myInsideLicense, myLicenseText, myNumCerts, myNumSkipped
  97. Dim myLabel, myOctets, myData, myPem, myRev, myUntrusted, j
  98. myNumSkipped = 0
  99. myNumCerts = 0
  100. myData = ""
  101. myLines = Split(myCdData, vbLf, -1)
  102. Set myFh = objFSO.OpenTextFile(myCaFile, 2, TRUE)
  103. myFh.Write "##" & vbLf
  104. myFh.Write "## " & myCaFile & " -- Bundle of CA Root Certificates" & vbLf
  105. myFh.Write "##" & vbLf
  106. myFh.Write "## Converted at: " & Now & vbLf
  107. myFh.Write "##" & vbLf
  108. myFh.Write "## This is a bundle of X.509 certificates of public Certificate Authorities" & vbLf
  109. myFh.Write "## (CA). These were automatically extracted from Mozilla's root certificates" & vbLf
  110. myFh.Write "## file (certdata.txt). This file can be found in the mozilla source tree:" & vbLf
  111. myFh.Write "## '/mozilla/source/security/nss/lib/ckfw/builtins/certdata.txt'" & vbLf
  112. myFh.Write "##" & vbLf
  113. myFh.Write "## It contains the certificates in PEM format and therefore" & vbLf
  114. myFh.Write "## can be directly used with curl / libcurl / php_curl, or with" & vbLf
  115. myFh.Write "## an Apache+mod_ssl webserver for SSL client authentication." & vbLf
  116. myFh.Write "## Just configure this file as the SSLCACertificateFile." & vbLf
  117. myFh.Write "##" & vbLf
  118. myFh.Write vbLf
  119. For i = 0 To UBound(myLines)
  120. If InstrRev(myLines(i), "CKA_LABEL ") Then
  121. myPattern = "^CKA_LABEL\s+[A-Z0-9]+\s+""(.+?)"""
  122. myLabel = RegExprFirst(myPattern, myLines(i))
  123. End If
  124. If (myInsideCert = TRUE) Then
  125. If InstrRev(myLines(i), "END") Then
  126. myInsideCert = FALSE
  127. While (i < UBound(myLines)) And Not (myLines(i) = "#")
  128. i = i + 1
  129. If InstrRev(myLines(i), "CKA_TRUST_SERVER_AUTH CK_TRUST CKT_NSS_TRUSTED_DELEGATOR") Then
  130. myUntrusted = FALSE
  131. End If
  132. Wend
  133. If (myUntrusted = TRUE) Then
  134. myNumSkipped = myNumSkipped + 1
  135. Else
  136. myFh.Write myLabel & vbLf
  137. myFh.Write String(Len(myLabel), "=") & vbLf
  138. myPem = "-----BEGIN CERTIFICATE-----" & vbLf & _
  139. Base64Encode(myData) & vbLf & _
  140. "-----END CERTIFICATE-----" & vbLf
  141. If (myOptTxt = FALSE) Then
  142. myFh.Write myPem & vbLf
  143. Else
  144. Dim myCmd, myRval, myTmpIn, myTmpOut
  145. myTmpIn = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
  146. myTmpOut = objFSO.GetSpecialFolder(2).Path & "\" & objFSO.GetTempName
  147. Set myTmpFh = objFSO.OpenTextFile(myTmpIn, 2, TRUE)
  148. myTmpFh.Write myPem
  149. myTmpFh.Close
  150. myCmd = myOpenssl & " x509 -md5 -fingerprint -text -inform PEM" & _
  151. " -in " & myTmpIn & " -out " & myTmpOut
  152. myRval = objShell.Run (myCmd, 0, TRUE)
  153. objFSO.DeleteFile myTmpIn, TRUE
  154. If Not (myRval = 0) Then
  155. MsgBox("Failed to process PEM cert with OpenSSL commandline!"), vbCritical, mySelf
  156. objFSO.DeleteFile myTmpOut, TRUE
  157. WScript.Quit 3
  158. End If
  159. Set myTmpFh = objFSO.OpenTextFile(myTmpOut, 1)
  160. myFh.Write myTmpFh.ReadAll & vbLf
  161. myTmpFh.Close
  162. objFSO.DeleteFile myTmpOut, TRUE
  163. End If
  164. myNumCerts = myNumCerts + 1
  165. End If
  166. Else
  167. myOctets = Split(myLines(i), "\")
  168. For j = 1 To UBound(myOctets)
  169. myData = myData & Chr(CByte("&o" & myOctets(j)))
  170. Next
  171. End If
  172. End If
  173. If InstrRev(myLines(i), "CVS_ID ") Then
  174. myPattern = "^CVS_ID\s+""(.+?)"""
  175. myRev = RegExprFirst(myPattern, myLines(i))
  176. myFh.Write "# " & myRev & vbLf & vbLf
  177. End If
  178. If InstrRev(myLines(i), "CKA_VALUE MULTILINE_OCTAL") Then
  179. myInsideCert = TRUE
  180. myUntrusted = TRUE
  181. myData = ""
  182. End If
  183. If InstrRev(myLines(i), "***** BEGIN LICENSE BLOCK *****") Then
  184. myInsideLicense = TRUE
  185. End If
  186. If (myInsideLicense = TRUE) Then
  187. myFh.Write myLines(i) & vbLf
  188. myLicenseText = myLicenseText & Mid(myLines(i), 2) & vbLf
  189. End If
  190. If InstrRev(myLines(i), "***** END LICENSE BLOCK *****") Then
  191. myInsideLicense = FALSE
  192. If (myAskLiF = TRUE) Then
  193. If Not (6 = objShell.PopUp(myLicenseText & vbLf & _
  194. "Do you agree to the license shown above (required to proceed) ?",, _
  195. mySelf, vbQuestion + vbYesNo + vbDefaultButton1)) Then
  196. myFh.Close
  197. objFSO.DeleteFile myCaFile, TRUE
  198. WScript.Quit 2
  199. End If
  200. End If
  201. End If
  202. Next
  203. myFh.Close
  204. objShell.PopUp "Done (" & myNumCerts & " CA certs processed, " & myNumSkipped & _
  205. " untrusted skipped).", 20, mySelf, vbInformation
  206. WScript.Quit 0
  207. Function ConvertBinaryData(arrBytes)
  208. Dim objStream
  209. Set objStream = CreateObject("ADODB.Stream")
  210. objStream.Open
  211. objStream.Type = 1
  212. objStream.Write arrBytes
  213. objStream.Position = 0
  214. objStream.Type = 2
  215. objStream.Charset = "ascii"
  216. ConvertBinaryData = objStream.ReadText
  217. Set objStream = Nothing
  218. End Function
  219. Function RegExprFirst(SearchPattern, TheString)
  220. Dim objRegExp, Matches ' create variables.
  221. Set objRegExp = New RegExp ' create a regular expression.
  222. objRegExp.Pattern = SearchPattern ' sets the search pattern.
  223. objRegExp.IgnoreCase = TRUE ' set to ignores case.
  224. objRegExp.Global = TRUE ' set to gloabal search.
  225. Set Matches = objRegExp.Execute(TheString) ' do the search.
  226. If (Matches.Count) Then
  227. RegExprFirst = Matches(0).SubMatches(0) ' return first match.
  228. Else
  229. RegExprFirst = ""
  230. End If
  231. Set objRegExp = Nothing
  232. End Function
  233. Function Base64Encode(inData)
  234. Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  235. Dim cOut, sOut, lWrap, I
  236. lWrap = Int(myWrapLe * 3 / 4)
  237. 'For each group of 3 bytes
  238. For I = 1 To Len(inData) Step 3
  239. Dim nGroup, pOut, sGroup
  240. 'Create one long from this 3 bytes.
  241. nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
  242. &H100 * MyASC(Mid(inData, I + 1, 1)) + _
  243. MyASC(Mid(inData, I + 2, 1))
  244. 'Oct splits the long To 8 groups with 3 bits
  245. nGroup = Oct(nGroup)
  246. 'Add leading zeros
  247. nGroup = String(8 - Len(nGroup), "0") & nGroup
  248. 'Convert To base64
  249. pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) & _
  250. Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) & _
  251. Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) & _
  252. Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
  253. 'Add the part To OutPut string
  254. sOut = sOut + pOut
  255. 'Add a new line For Each myWrapLe chars In dest
  256. If (I < Len(inData) - 2) Then
  257. If (I + 2) Mod lWrap = 0 Then sOut = sOut & vbLf
  258. End If
  259. Next
  260. Select Case Len(inData) Mod 3
  261. Case 1: '8 bit final
  262. sOut = Left(sOut, Len(sOut) - 2) & "=="
  263. Case 2: '16 bit final
  264. sOut = Left(sOut, Len(sOut) - 1) & "="
  265. End Select
  266. Base64Encode = sOut
  267. End Function
  268. Function MyASC(OneChar)
  269. If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
  270. End Function