1//===-- lib/runtime/command.cpp ---------------------------------*- C++ -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "flang/Runtime/command.h"
10#include "flang-rt/runtime/descriptor.h"
11#include "flang-rt/runtime/environment.h"
12#include "flang-rt/runtime/stat.h"
13#include "flang-rt/runtime/terminator.h"
14#include "flang-rt/runtime/tools.h"
15#include <cerrno>
16#include <cstdlib>
17#include <limits>
18
19#ifdef _WIN32
20#include "flang/Common/windows-include.h"
21#include <direct.h>
22#define getcwd _getcwd
23#define unlink _unlink
24#define PATH_MAX MAX_PATH
25
26#ifdef _MSC_VER
27// On Windows GetCurrentProcessId returns a DWORD aka uint32_t
28#include <processthreadsapi.h>
29inline pid_t getpid() { return GetCurrentProcessId(); }
30#endif
31#else
32#include <unistd.h> //getpid() unlink()
33
34#ifndef PATH_MAX
35#define PATH_MAX 4096
36#endif
37#endif
38
39namespace Fortran::runtime {
40std::int32_t RTNAME(ArgumentCount)() {
41 int argc{executionEnvironment.argc};
42 if (argc > 1) {
43 // C counts the command name as one of the arguments, but Fortran doesn't.
44 return argc - 1;
45 }
46 return 0;
47}
48
49pid_t RTNAME(GetPID)() { return getpid(); }
50
51// Returns the length of the \p string. Assumes \p string is valid.
52static std::int64_t StringLength(const char *string) {
53 std::size_t length{std::strlen(string)};
54 if (length <= std::numeric_limits<std::int64_t>::max())
55 return static_cast<std::int64_t>(length);
56 return 0;
57}
58
59static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
60 if (offset < value.ElementBytes()) {
61 std::memset(
62 value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
63 }
64}
65
66static std::int32_t CheckAndCopyCharsToDescriptor(const Descriptor *value,
67 const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
68 bool haveValue{IsValidCharDescriptor(value)};
69
70 std::int64_t len{StringLength(rawValue)};
71 if (len <= 0) {
72 if (haveValue) {
73 FillWithSpaces(*value);
74 }
75 return ToErrmsg(errmsg, StatMissingArgument);
76 }
77
78 std::int32_t stat{StatOk};
79 if (haveValue) {
80 stat = CopyCharsToDescriptor(*value, rawValue, len, errmsg, offset);
81 }
82
83 offset += len;
84 return stat;
85}
86
87template <int KIND> struct FitsInIntegerKind {
88 bool operator()([[maybe_unused]] std::int64_t value) {
89 if constexpr (KIND >= 8) {
90 return true;
91 } else {
92 return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
93 Fortran::common::TypeCategory::Integer, KIND>>::max();
94 }
95 }
96};
97
98static bool FitsInDescriptor(
99 const Descriptor *length, std::int64_t value, Terminator &terminator) {
100 auto typeCode{length->type().GetCategoryAndKind()};
101 int kind{typeCode->second};
102 return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
103 kind, terminator, value);
104}
105
106std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
107 const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
108 int line) {
109 Terminator terminator{sourceFile, line};
110
111 if (value) {
112 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
113 FillWithSpaces(*value);
114 }
115
116 // Store 0 in case we error out later on.
117 if (length) {
118 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
119 StoreIntToDescriptor(length, 0, terminator);
120 }
121
122 if (n < 0 || n >= executionEnvironment.argc) {
123 return ToErrmsg(errmsg, StatInvalidArgumentNumber);
124 }
125
126 const char *arg{executionEnvironment.argv[n]};
127 std::int64_t argLen{StringLength(arg)};
128 if (argLen <= 0) {
129 return ToErrmsg(errmsg, StatMissingArgument);
130 }
131
132 if (length && FitsInDescriptor(length, argLen, terminator)) {
133 StoreIntToDescriptor(length, argLen, terminator);
134 }
135
136 if (value) {
137 return CopyCharsToDescriptor(*value, arg, argLen, errmsg);
138 }
139
140 return StatOk;
141}
142
143std::int32_t RTNAME(GetCommand)(const Descriptor *value,
144 const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
145 int line) {
146 Terminator terminator{sourceFile, line};
147
148 if (value) {
149 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
150 }
151
152 // Store 0 in case we error out later on.
153 if (length) {
154 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
155 StoreIntToDescriptor(length, 0, terminator);
156 }
157
158 auto shouldContinue = [&](std::int32_t stat) -> bool {
159 // We continue as long as everything is ok OR the value descriptor is
160 // too short, but we still need to compute the length.
161 return stat == StatOk || (length && stat == StatValueTooShort);
162 };
163
164 std::size_t offset{0};
165
166 if (executionEnvironment.argc == 0) {
167 return CheckAndCopyCharsToDescriptor(value, "", errmsg, offset);
168 }
169
170 // value = argv[0]
171 std::int32_t stat{CheckAndCopyCharsToDescriptor(
172 value, executionEnvironment.argv[0], errmsg, offset)};
173 if (!shouldContinue(stat)) {
174 return stat;
175 }
176
177 // value += " " + argv[1:n]
178 for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
179 stat = CheckAndCopyCharsToDescriptor(value, " ", errmsg, offset);
180 if (!shouldContinue(stat)) {
181 return stat;
182 }
183
184 stat = CheckAndCopyCharsToDescriptor(
185 value, executionEnvironment.argv[i], errmsg, offset);
186 if (!shouldContinue(stat)) {
187 return stat;
188 }
189 }
190
191 if (length && FitsInDescriptor(length, offset, terminator)) {
192 StoreIntToDescriptor(length, offset, terminator);
193 }
194
195 // value += spaces for padding
196 if (value) {
197 FillWithSpaces(*value, offset);
198 }
199
200 return stat;
201}
202
203static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
204 std::size_t s{d.ElementBytes()}; // This can be 0.
205 while (s != 0 && *d.OffsetElement(s - 1) == ' ') {
206 --s;
207 }
208 return s;
209}
210
211std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
212 const Descriptor *value, const Descriptor *length, bool trim_name,
213 const Descriptor *errmsg, const char *sourceFile, int line) {
214 Terminator terminator{sourceFile, line};
215
216 if (value) {
217 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
218 FillWithSpaces(*value);
219 }
220
221 // Store 0 in case we error out later on.
222 if (length) {
223 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
224 StoreIntToDescriptor(length, 0, terminator);
225 }
226
227 const char *rawValue{nullptr};
228 std::size_t nameLength{
229 trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
230 if (nameLength != 0) {
231 rawValue = executionEnvironment.GetEnv(
232 name.OffsetElement(), nameLength, terminator);
233 }
234 if (!rawValue) {
235 return ToErrmsg(errmsg, StatMissingEnvVariable);
236 }
237
238 std::int64_t varLen{StringLength(rawValue)};
239 if (length && FitsInDescriptor(length, varLen, terminator)) {
240 StoreIntToDescriptor(length, varLen, terminator);
241 }
242
243 if (value) {
244 return CopyCharsToDescriptor(*value, rawValue, varLen, errmsg);
245 }
246 return StatOk;
247}
248
249std::int32_t RTNAME(GetCwd)(
250 const Descriptor &cwd, const char *sourceFile, int line) {
251 Terminator terminator{sourceFile, line};
252
253 RUNTIME_CHECK(terminator, IsValidCharDescriptor(&cwd));
254
255 char *buf{(char *)AllocateMemoryOrCrash(terminator, PATH_MAX)};
256
257 if (!getcwd(buf: buf, PATH_MAX)) {
258 return StatMissingCurrentWorkDirectory;
259 }
260
261 std::int64_t strLen{StringLength(buf)};
262 std::int32_t status{CopyCharsToDescriptor(cwd, buf, strLen)};
263
264 std::free(ptr: buf);
265 return status;
266}
267
268std::int32_t RTNAME(Hostnm)(
269 const Descriptor &res, const char *sourceFile, int line) {
270 Terminator terminator{sourceFile, line};
271
272 RUNTIME_CHECK(terminator, IsValidCharDescriptor(&res));
273
274 char buf[256];
275 std::int32_t status{0};
276
277 // Fill the output with spaces. Upon success, CopyCharsToDescriptor()
278 // will overwrite part of the string with the result, so we'll end up
279 // with a padded string. If we fail to obtain the host name, we return
280 // the string of all spaces, which is the original gfortran behavior.
281 FillWithSpaces(res);
282
283#ifdef _WIN32
284
285 DWORD dwSize{sizeof(buf)};
286
287 // Note: Winsock has gethostname(), but use Win32 API GetComputerNameEx(),
288 // in order to avoid adding dependency on Winsock.
289 if (!GetComputerNameExA(ComputerNameDnsHostname, buf, &dwSize)) {
290 status = GetLastError();
291 }
292
293#else
294
295 if (gethostname(name: buf, len: sizeof(buf)) < 0) {
296 status = errno;
297 }
298
299#endif
300
301 if (status == 0) {
302 std::int64_t strLen{StringLength(buf)};
303 status = CopyCharsToDescriptor(res, buf, strLen);
304
305 // Note: if the result string is too short, then we'll return partial
306 // host name with "too short" error status.
307 }
308
309 return status;
310}
311
312std::int32_t RTNAME(PutEnv)(
313 const char *str, size_t str_length, const char *sourceFile, int line) {
314 Terminator terminator{sourceFile, line};
315
316 RUNTIME_CHECK(terminator, str && str_length);
317
318 // Note: don't trim the input string, because the user should be able
319 // to set the value to all spaces if necessary.
320
321 // While Fortran's putenv() extended intrinsic sementics loosly follow
322 // Linux C library putenv(), don't actually use putenv() on Linux, because
323 // it takes the passed string pointer and incorporates it into the
324 // environment without copy. To make this safe, one would have to copy
325 // the passed string into some allocated memory, but then there's no good
326 // way to deallocate it. Instead, use the implementation from
327 // ExecutionEnvironment, which does the right thing for both Windows and
328 // Linux.
329
330 std::int32_t status{0};
331
332 // Split the input string into name and value substrings. Note:
333 // if input string is in "name=value" form, then we set variable "name" with
334 // value "value". If the input string is in "name=" form, then we delete
335 // the variable "name".
336
337 const char *str_end = str + str_length;
338 const char *str_sep = std::find(str, str_end, '=');
339 if (str_sep == str_end) {
340 // No separator, invalid input string
341 status = EINVAL;
342 } else if ((str_sep + 1) == str_end) {
343 // "name=" form, which means we need to delete this variable
344 status = executionEnvironment.UnsetEnv(str, str_sep - str, terminator);
345 } else {
346 // Example: consider str "abc=defg", str_length = 8
347 //
348 // addr: 05 06 07 08 09 10 11 12 13
349 // str@addr: a b c = d e f g ??
350 //
351 // str = 5, str_end = 13, str_sep = 8, name length: str_sep - str = 3
352 // value ptr: str_sep + 1 = 9, value length: 4
353 //
354 status = executionEnvironment.SetEnv(
355 str, str_sep - str, str_sep + 1, str_end - str_sep - 1, terminator);
356 }
357
358 return status;
359}
360
361std::int32_t RTNAME(Unlink)(
362 const char *str, size_t strLength, const char *sourceFile, int line) {
363 Terminator terminator{sourceFile, line};
364
365 auto pathLength = TrimTrailingSpaces(str, strLength);
366 auto path = SaveDefaultCharacter(str, pathLength, terminator);
367
368 std::int32_t status{0};
369
370 if (unlink(path.get()) != 0) {
371 status = errno;
372 }
373
374 return status;
375}
376
377} // namespace Fortran::runtime
378

source code of flang-rt/lib/runtime/command.cpp