VirtualBox

source: vbox/trunk/tools/envSub.vbs@ 96562

Last change on this file since 96562 was 96407, checked in by vboxsync, 2 years ago

scm copyright and license note update

  • Property svn:eol-style set to CRLF
  • Property svn:keywords set to Author Date Id Revision
File size: 17.4 KB
Line 
1' $Id: envSub.vbs 96407 2022-08-22 17:43:14Z vboxsync $
2'' @file
3' VBScript worker for env.cmd
4'
5
6'
7' Copyright (C) 2006-2022 Oracle and/or its affiliates.
8'
9' This file is part of VirtualBox base platform packages, as
10' available from https://www.virtualbox.org.
11'
12' This program is free software; you can redistribute it and/or
13' modify it under the terms of the GNU General Public License
14' as published by the Free Software Foundation, in version 3 of the
15' License.
16'
17' This program is distributed in the hope that it will be useful, but
18' WITHOUT ANY WARRANTY; without even the implied warranty of
19' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20' General Public License for more details.
21'
22' You should have received a copy of the GNU General Public License
23' along with this program; if not, see <https://www.gnu.org/licenses>.
24'
25' SPDX-License-Identifier: GPL-3.0-only
26'
27
28
29''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
30' Header Files
31''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
32''
33' Includes a vbscript file relative to the script.
34sub IncludeFile(strFilename)
35 dim objFile, objFileSys
36 set objFileSys = WScript.CreateObject("Scripting.FileSystemObject")
37 dim strPath : strPath = objFileSys.BuildPath(objFileSys.GetParentFolderName(Wscript.ScriptFullName), strFilename)
38 set objFile = objFileSys.openTextFile(strPath)
39 executeglobal objFile.readAll()
40 objFile.close
41 set objFileSys = nothing
42end sub
43
44IncludeFile "win\vbscript\helpers.vbs"
45
46
47''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
48' Global Variables '
49''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
50dim g_cntVerbose
51g_cntVerbose = 1
52
53
54sub LogPrint(str)
55 if g_cntVerbose > 1 then
56 WScript.StdErr.WriteLine "debug: " & str
57 end if
58end sub
59
60sub DbgPrint(str)
61 if g_cntVerbose > 2 then
62 WScript.StdErr.WriteLine "debug: " & str
63 end if
64end sub
65
66
67''
68' The main() like function.
69'
70function Main()
71 Main = 1
72
73 '
74 ' check that we're not using wscript.
75 '
76 if UCase(Right(Wscript.FullName, 11)) = "WSCRIPT.EXE" then
77 Wscript.Echo "This script must be run under CScript."
78 exit function
79 end if
80 SelfTest
81
82 '
83 ' Get our bearings.
84 '
85 dim strScriptDir
86 strScriptDir = g_objFileSys.GetParentFolderName(Wscript.ScriptFullName)
87
88 dim strRootDir
89 strRootDir = g_objFileSys.GetParentFolderName(strScriptDir)
90
91 dim strRealArch
92 strRealArch = Trim(EnvGet("PROCESSOR_ARCHITEW6432"))
93 if strRealArch = "" then strRealArch = Trim(EnvGet("PROCESSOR_ARCHITECTURE"))
94 if strRealArch = "" then strRealArch = "amd64"
95 strRealArch = LCase(strRealArch)
96 if strRealArch <> "amd64" and strRealArch <> "x86" then
97 MsgError "Unsupported host architecture: " & strRealArch ' quits
98 end if
99
100 '
101 ' Guest the default configuration.
102 '
103 dim arrTypes : arrTypes = Array("debug", "release", "profile", "strict", "dbgopt")
104 dim arrTargetAndHosts : arrTargetAndHosts = Array("win", "linux", "solaris", "darwin", "os2", "freebsd")
105 dim arrArchitectures : arrArchitectures = Array("x86", "amd64", "arm32", "arm64", "sparc32", "sparc64")
106
107 dim strType
108 strType = EnvGetDefValid("KBUILD_TYPE", "debug", arrTypes)
109
110 dim strPathDevTools
111 strPathDevTools= EnvGetDef("KBUILD_DEVTOOLS", g_objFileSys.BuildPath(strRootDir, "tools"))
112
113 dim strPathkBuild
114 strPathkBuild = EnvGetDef("KBUILD_PATH", g_objFileSys.BuildPath(strRootDir, "kBuild"))
115
116 dim strTarget, strTargetArch
117 strTarget = EnvGetDefValid("KBUILD_TARGET", "win", arrTargetAndHosts)
118 strTargetArch = EnvGetDefValid("KBUILD_TARGET_ARCH", strRealArch, arrArchitectures)
119
120 dim strHost, strHostArch
121 strHost = EnvGetDefValid("KBUILD_HOST", "win", arrTargetAndHosts)
122 strHostArch = EnvGetDefValid("KBUILD_HOST_ARCH", strRealArch, arrArchitectures)
123
124 '
125 ' Parse arguments.
126 '
127 dim arrValueOpts : arrValueOpts = Array("--type", "--arch", "--tmp-script")
128 dim arrCmdToExec : arrCmdToExec = Array()
129 dim blnDashDash : blnDashDash = false
130 dim strChdirTo : strChdirTo = strRootDir
131 dim strTmpScript : strTmpScript = g_objFileSys.BuildPath(strScriptDir, "envtmp.cmd")
132 dim i : i = 0
133 do while i < Wscript.Arguments.Count
134 dim strArg, strValue, off
135 strArg = Wscript.Arguments.item(i)
136 i = i + 1
137 if blnDashDash <> true then
138 ' Does it have an embedded value? Does it take a value?
139 off = InStr(2, strArg, "=")
140 if off <= 0 then off = InStr(2, strArg, ":")
141 if off > 0 then
142 strValue = Mid(strArg, off + 1)
143 strArg = Left(strArg, off - 1)
144 if not ArrayContainsString(arrValueOpts, strArg) then
145 MsgSyntaxError "'" & strArg & "' does not take a value" ' quits
146 end if
147 elseif ArrayContainsString(arrValueOpts, strArg) then
148 if i >= Wscript.Arguments.Count then
149 MsgSyntaxError "'" & strArg & "' takes a value" ' quits
150 end if
151 strValue = Wscript.Arguments.item(i)
152 i = i + 1
153 end if
154
155 ' Process it.
156 select case strArg
157 ' Build types:
158 case "--type"
159 if not ArrayContainsString(arrTypes, strValue) then
160 MsgSyntaxError "Invalid build type '" & strValue & "'. Valid types: " & ArrayJoinString(arrTypes, ", ") ' quits
161 else
162 strType = strValue
163 end if
164 case "--release"
165 strType = "release"
166 case "--debug"
167 strType = "debug"
168 case "--strict"
169 strType = "strict"
170 case "--dbgopt"
171 strType = "dbgopt"
172
173 ' Target architecture:
174 case "--arch"
175 if not ArrayContainsString(arrArchitectures, strValue) then
176 MsgSyntaxError "Invalid target architecture'" & strValue & "'. Valid ones: " _
177 & ArrayJoinString(arrArchitectures, ", ") ' quits
178 else
179 strTargetArch = strValue
180 end if
181 case "--amd64"
182 strTargetArch = "amd64"
183 case "--x86"
184 strTargetArch = "amd64"
185 case "--arm32"
186 strTargetArch = "arm32"
187 case "--arm64"
188 strTargetArch = "amd64"
189
190 ' Verbosity, env.sh compatibility and stuff
191 case "--quiet"
192 g_cntVerbose = 0
193 case "--verbose"
194 g_cntVerbose = g_cntVerbose + 1
195 case "--chdir"
196 strChdirTo = strValue
197 case "--no-chdir"
198 strChdirTo = ""
199
200 ' Internal.
201 case "--tmp-script"
202 strTmpScript = strValue
203
204 ' Standard options
205 case "-h", "-?", "--help"
206 Print "Sets the VBox development shell environment on Windows."
207 Print "usage: env.cmd [--type <type> | --release | --debug | --strict | --dbgopt]"
208 Print " [--arch <arch> | --amd64 | --x86 | --arm32 | --arm64]"
209 Print " [--no-chdir | --chdir <dir>] [--quiet | --verbose]"
210 Print " [--] [prog] [args...]"
211 Print "usage: env.cmd [--help | -h | -?]"
212 Print "usage: env.cmd [--version | -V]"
213 Main = 0
214 exit function
215 case "-V", "--version"
216 Print "x.y"
217 Main = 0
218 exit function
219
220 case "--"
221 blnDashDash = True
222
223 case else
224 MsgSyntaxError "Unknown option: " & strArg
225 end select
226 else
227 ' cscript may eat quoting... So we should consider using some windows API to get the raw command line
228 ' and look for the dash-dash instead. Maybe.
229 arrCmdToExec = ArrayAppend(arrCmdToExec, strArg)
230 end if
231 loop
232
233 '
234 ' Set up the environment.
235 '
236 dim str1
237
238 EnvSet "KBUILD_PATH", UnixSlashes(strPathkBuild)
239 EnvSet "KBUILD_DEVTOOLS", UnixSlashes(strPathDevTools)
240 EnvSet "KBUILD_TYPE", strType
241 EnvSet "KBUILD_TARGET", strTarget
242 EnvSet "KBUILD_TARGET_ARCH", strTargetArch
243 EnvSet "KBUILD_HOST", strHost
244 EnvSet "KBUILD_HOST_ARCH", strHostArch
245
246 ' Remove legacy variables.
247 dim arrObsolete
248 arrObsolete = Array("BUILD_TYPE", "BUILD_TARGET", "BUILD_TARGET_ARCH", "BUILD_PLATFORM", "BUILD_PLATFORM_ARCH", _
249 "PATH_DEVTOOLS", "KBUILD_TARGET_CPU", "KBUILD_PLATFORM_CPU")
250 for each str1 in arrObsolete
251 EnvUnset str1
252 next
253
254 ' cleanup path before we start adding to it
255 for each str1 in arrArchitectures
256 EnvRemovePathItem "Path", DosSlashes(strPathkBuild & "\bin\win." & str1), ";"
257 EnvRemovePathItem "Path", DosSlashes(strPathkBuild & "\bin\win." & str1 & "\wrappers"), ";"
258 EnvRemovePathItem "Path", DosSlashes(strPathDevTools & "\win." & str1) & "\bin", ";"
259 next
260
261 '
262 ' We skip the extra stuff like gnuwin32, windbg, cl.exe and mingw64 if
263 ' there is a command to execute.
264 '
265 if ArraySize(arrCmdToExec) = 0 then
266 ' Add the kbuild wrapper directory to the end of the path, these take
267 ' precedence over the dated gnuwin32 stuff.
268 EnvAppendPathItem "Path", DosSlashes(strPathkBuild & "\bin\win." & strHostArch & "\wrappers"), ";"
269
270 ' Add some gnuwin32 tools to the end of the path.
271 EnvAppendPathItem "Path", DosSlashes(strPathDevTools & "\win.x86\gnuwin32\r1\bin"), ";"
272
273 ' Add the newest debugger we can find to the front of the path.
274 dim strDir, blnStop
275 bldExitLoop = false
276 for each str1 in arrArchitectures
277 strDir = strPathDevTools & "\win." & str1 & "\sdk"
278 for each strSubDir in GetSubdirsStartingWithRVerSorted(strDir, "v")
279 if FileExists(strDir & "\" & strSubDir & "\Debuggers\" & XlateArchitectureToWin(strHostArch) & "\windbg.exe") then
280 EnvPrependPathItem "Path", DosSlashes(strDir & "\" & strSubDir & "\Debuggers\" & XlateArchitectureToWin(strHostArch)), ";"
281 bldExitLoop = true
282 exit for
283 end if
284 next
285 if bldExitLoop then exit for
286 next
287
288 ' Add VCC to the end of the path.
289 dim str2, strDir2, arrVccOldBinDirs
290 arrVccOldBinDirs = Array("\bin\" & strHostArch & "_" & strTargetArch, "\bin\" & strTargetArch, "\bin")
291 bldExitLoop = false
292 for each str1 in Array("amd64", "x86")
293 for each strDir in GetSubdirsStartingWithRVerSorted(strPathDevTools & "\win." & str1 & "\vcc", "v")
294 strDir = strPathDevTools & "\win." & str1 & "\vcc\" & strDir
295 if DirExists(strDir & "\Tools\MSVC") then
296 for each strDir2 in GetSubdirsStartingWithRVerSorted(strDir & "\Tools\MSVC", "1")
297 strDir2 = strDir & "\Tools\MSVC\" & strDir2 & "\bin\Host" & XlateArchitectureToWin(strHostArch) _
298 & "\" & XlateArchitectureToWin(strTargetArch)
299 if FileExists(strDir2 & "\cl.exe") then
300 EnvAppendPathItem "Path", DosSlashes(strDir2), ";"
301 if strTargetArch <> strHostArch then
302 EnvAppendPathItem "Path", DosSlashes(PathStripFilename(strDir2) & "\" & XlateArchitectureToWin(strHostArch)), ";"
303 end if
304 bldExitLoop = true
305 exit for
306 end if
307 next
308 elseif DirExists(strDir & "\bin") then
309 for each str2 in arrVccOldBinDirs
310 if FileExists(strDir & str2 & "\cl.exe") then
311 EnvAppendPathItem "Path", DosSlashes(strDir & str2), ";"
312 if str2 <> "\bin" then EnvAppendPathItem "Path", DosSlashes(strDir & "bin"), ";"
313 bldExitLoop = true
314 exit for
315 end if
316 next
317 end if
318 if bldExitLoop then exit for
319 next
320 if bldExitLoop then exit for
321 next
322
323 ' Add mingw64 if it's still there.
324 if strHostArch = "amd64" or strTargetArch = "amd64" then
325 str1 = strPathDev & "win.amd64\mingw-64\r1\bin"
326 if DirExists(str1) then EnvAppendPathItem "Path", DosSlashes(str1), ";"
327 end if
328 end if
329
330 ' Add the output tools and bin directories to the fron of the path, taking PATH_OUT_BASE into account.
331 dim strOutDir
332 strOutDir = EnvGetDef("PATH_OUT_BASE", strRootDir & "\out")
333 strOutDir = strOutDir & "\" & strTarget & "." & strTargetArch & "\" & strType
334 EnvPrependPathItem "Path", DosSlashes(strOutDir & "\bin\tools"), ";"
335 EnvPrependPathItem "Path", DosSlashes(strOutDir & "\bin"), ";"
336
337 ' Add kbuild binary directory to the front the the path.
338 EnvPrependPathItem "Path", DosSlashes(strPathkBuild & "\bin\win." & strHostArch), ";"
339
340 ' Finally, add the relevant tools/**/bin directories to the front of the path.
341 EnvPrependPathItem "Path", DosSlashes(strPathDevTools & "\bin"), ";"
342 if strHostArch = "amd64" then EnvPrependPathItem "Path", DosSlashes(strPathDevTools & "\win.x86\bin"), ";"
343 EnvPrependPathItem "Path", DosSlashes(strPathDevTools & "\win." & strHostArch) & "\bin", ";"
344
345 '
346 ' Export if we are not executing a program.
347 '
348 Main = g_rcScript
349 if ArraySize(arrCmdToExec) = 0 then
350 dim objTmpScript
351 set objTmpScript = g_objFileSys.CreateTextFile(strTmpScript, true, false)
352 objTmpScript.WriteLine
353
354 for each str1 in Array("Path", "KBUILD_PATH", "KBUILD_DEVTOOLS", "KBUILD_TYPE", _
355 "KBUILD_TARGET", "KBUILD_TARGET_ARCH", "KBUILD_HOST", "KBUILD_HOST_ARCH")
356 objTmpScript.WriteLine "SET " & str1 & "=" & EnvGet(str1)
357 next
358 for each str1 in arrObsolete
359 if EnvExists(str1) then objTmpScript.WriteLine "SET " & str1 & "="
360 next
361
362 if strChdirTo <> "" then
363 objTmpScript.WriteLine "CD """ & strChdirTo & """"
364 if Mid(strChdirTo, 2, 1) = ":" then
365 objTmpScript.WriteLine Left(strChdirTo, 2)
366 end if
367 end if
368
369 objTmpScript.Close()
370 '
371 ' Run the specified program.
372 '
373 ' We must redirect stderr to stdout here, because vbscript doesn't seem to
374 ' have any way to reuse the same console/stdout/stererr as we use (Exec
375 ' creates two pipes, Run a new console), nor can vbscript service two
376 ' TextStream/pipe objects at the same time without the risk of deadlocking
377 ' with the child process (we read stdout, child waits for stderr space).
378 '
379 ' So, to make it work we use kmk_redirect.exe to stuff everything into stderr
380 ' and ignore stdout.
381 '
382 else
383 if strChdirTo <> "" then
384 g_objShell.CurrentDirectory = strChdirTo
385 end if
386
387 ' Prepate the command line.
388 dim strCmdLine, str
389 strCmdLine = """" & DosSlashes(strPathkBuild) & "\bin\win." & strHostArch & "\kmk_redirect.exe"" -d1=2 -c0 -- " _
390 & """" & arrCmdToExec(0) & """"
391 for i = 1 to UBound(arrCmdToExec)
392 str = arrCmdToExec(i)
393 if InStr(1, str, " ") > 0 then '' @todo There is more stuff that needs escaping
394 strCmdLine = strCmdLine & " """ & str & """"
395 else
396 strCmdLine = strCmdLine & " " & str
397 end if
398 next
399
400 ' Start it.
401 if g_cntVerbose > 0 then MsgInfo "Executing command: " & strCmdLine
402 dim objChild
403 set objChild = g_objShell.Exec(strCmdLine)
404
405 ' The fun output / wait. As mention above, we only need to bother with stderr here.
406 dim cMsSleepMin : cMsSleepMin = 8
407 dim cMsSleepMax : cMsSleepMax = 92
408 dim cMsSleep : cMsSleep = cMsSleepMin
409 do while objChild.Status = 0
410 if not objChild.StdErr.AtEndOfStream then ' Seems this bugger might do a 0x80
411 WScript.StdErr.WriteLine objChild.StdErr.ReadLine()
412 cMsSleep = cMsSleepMin
413 elseif objChild.Status = 0 then
414 Wscript.Sleep cMsSleep
415 ' We probably only end up here once stderr is closed/disconnected (i.e. never).
416 ' This was originally written with the idea that AtEndOfStream would use
417 ' PeekNamedPipe to see if there were anything to read, rather than block.
418 ' Let's keep it for now.
419 if cMsSleep < cMsSleepMax then cMsSleep = cMsSleep + 8
420 end if
421 loop
422
423 ' Flush any remaining output on the offchance that we could get out of the above loop with pending output.
424 WScript.StdErr.Write strStdErr & objChild.StdErr.ReadAll()
425 WScript.StdOut.Write strStdOut & objChild.StdOut.ReadAll()
426
427 ' Return the exit code to our parent.
428 if g_cntVerbose > 0 then MsgInfo "Exit code = " & objChild.ExitCode
429 Main = objChild.ExitCode
430 end if
431end function
432
433'
434' What crt0.o typically does:
435'
436WScript.Quit(Main())
437
Note: See TracBrowser for help on using the repository browser.

© 2024 Oracle Support Privacy / Do Not Sell My Info Terms of Use Trademark Policy Automated Access Etiquette