envSub.vbs@ 85862

Last change on this file since 85862 was 85862, checked in by vboxsync, 4 years ago
tools/env*: fixes.
Property svn:eol-style set to `CRLF` Property svn:keywords set to `Author Date Id Revision`
File size: 16.7 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format