envSub.vbs@ 96325

Last change on this file since 96325 was 93115, checked in by vboxsync, 3 years ago
scm --update-copyright-year
Property svn:eol-style set to `CRLF` Property svn:keywords set to `Author Date Id Revision`
File size: 17.1 KB

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

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

Download in other formats:

Original Format