378 lines · cpp
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-exception6//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 _WIN3220#include "flang/Common/windows-include.h"21#include <direct.h>22#define getcwd _getcwd23#define unlink _unlink24#define PATH_MAX MAX_PATH25 26#ifdef _MSC_VER27// On Windows GetCurrentProcessId returns a DWORD aka uint32_t28#include <processthreadsapi.h>29inline pid_t getpid() { return GetCurrentProcessId(); }30#endif31#else32#include <unistd.h> //getpid() unlink()33 34#ifndef PATH_MAX35#define PATH_MAX 409636#endif37#endif38 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 runtime::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 is160 // 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 padding196 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, 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(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 up279 // with a padded string. If we fail to obtain the host name, we return280 // the string of all spaces, which is the original gfortran behavior.281 FillWithSpaces(res);282 283#ifdef _WIN32284 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#else294 295 if (gethostname(buf, sizeof(buf)) < 0) {296 status = errno;297 }298 299#endif300 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 partial306 // 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 able319 // to set the value to all spaces if necessary.320 321 // While Fortran's putenv() extended intrinsic sementics loosly follow322 // Linux C library putenv(), don't actually use putenv() on Linux, because323 // it takes the passed string pointer and incorporates it into the324 // environment without copy. To make this safe, one would have to copy325 // the passed string into some allocated memory, but then there's no good326 // way to deallocate it. Instead, use the implementation from327 // ExecutionEnvironment, which does the right thing for both Windows and328 // 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" with334 // value "value". If the input string is in "name=" form, then we delete335 // 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 string341 status = EINVAL;342 } else if ((str_sep + 1) == str_end) {343 // "name=" form, which means we need to delete this variable344 status = executionEnvironment.UnsetEnv(str, str_sep - str, terminator);345 } else {346 // Example: consider str "abc=defg", str_length = 8347 //348 // addr: 05 06 07 08 09 10 11 12 13349 // str@addr: a b c = d e f g ??350 //351 // str = 5, str_end = 13, str_sep = 8, name length: str_sep - str = 3352 // value ptr: str_sep + 1 = 9, value length: 4353 //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::runtime378