envSub.vbs@ 98478

Last change on this file since 98478 was 98103, checked in by vboxsync, 2 years ago
Copyright year updates by scm.
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 98103 2023-01-17 14:15:46Z vboxsync $
2	'' @file
3	' VBScript worker for env.cmd
4	'
5
6	'
7	' Copyright (C) 2006-2023 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.
34	sub 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
42	end sub
43
44	IncludeFile "win\vbscript\helpers.vbs"
45
46
47	''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
48	' Global Variables '
49	''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
50	dim g_cntVerbose
51	g_cntVerbose = 1
52
53
54	sub LogPrint(str)
55	if g_cntVerbose > 1 then
56	WScript.StdErr.WriteLine "debug: " & str
57	end if
58	end sub
59
60	sub DbgPrint(str)
61	if g_cntVerbose > 2 then
62	WScript.StdErr.WriteLine "debug: " & str
63	end if
64	end sub
65
66
67	''
68	' The main() like function.
69	'
70	function 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
431	end function
432
433	'
434	' What crt0.o typically does:
435	'
436	WScript.Quit(Main())
437

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

Download in other formats:

Original Format