//===-- lib/runtime/command.cpp ---------------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// #include "flang/Runtime/command.h" #include "flang-rt/runtime/descriptor.h" #include "flang-rt/runtime/environment.h" #include "flang-rt/runtime/stat.h" #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/tools.h" #include #include #include #ifdef _WIN32 #include "flang/Common/windows-include.h" #include #define getcwd _getcwd #define unlink _unlink #define PATH_MAX MAX_PATH #ifdef _MSC_VER // On Windows GetCurrentProcessId returns a DWORD aka uint32_t #include inline pid_t getpid() { return GetCurrentProcessId(); } #endif #else #include //getpid() unlink() #ifndef PATH_MAX #define PATH_MAX 4096 #endif #endif namespace Fortran::runtime { std::int32_t RTNAME(ArgumentCount)() { int argc{executionEnvironment.argc}; if (argc > 1) { // C counts the command name as one of the arguments, but Fortran doesn't. return argc - 1; } return 0; } pid_t RTNAME(GetPID)() { return getpid(); } // Returns the length of the \p string. Assumes \p string is valid. static std::int64_t StringLength(const char *string) { std::size_t length{std::strlen(string)}; if (length <= std::numeric_limits::max()) return static_cast(length); return 0; } static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) { if (offset < value.ElementBytes()) { std::memset( value.OffsetElement(offset), ' ', value.ElementBytes() - offset); } } static std::int32_t CheckAndCopyCharsToDescriptor(const Descriptor *value, const char *rawValue, const Descriptor *errmsg, std::size_t &offset) { bool haveValue{IsValidCharDescriptor(value)}; std::int64_t len{StringLength(rawValue)}; if (len <= 0) { if (haveValue) { FillWithSpaces(*value); } return ToErrmsg(errmsg, StatMissingArgument); } std::int32_t stat{StatOk}; if (haveValue) { stat = CopyCharsToDescriptor(*value, rawValue, len, errmsg, offset); } offset += len; return stat; } template struct FitsInIntegerKind { bool operator()([[maybe_unused]] std::int64_t value) { if constexpr (KIND >= 8) { return true; } else { return value <= std::numeric_limits>::max(); } } }; static bool FitsInDescriptor( const Descriptor *length, std::int64_t value, Terminator &terminator) { auto typeCode{length->type().GetCategoryAndKind()}; int kind{typeCode->second}; return Fortran::runtime::ApplyIntegerKind( kind, terminator, value); } std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value, const Descriptor *length, const Descriptor *errmsg, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; if (value) { RUNTIME_CHECK(terminator, IsValidCharDescriptor(value)); FillWithSpaces(*value); } // Store 0 in case we error out later on. if (length) { RUNTIME_CHECK(terminator, IsValidIntDescriptor(length)); StoreIntToDescriptor(length, 0, terminator); } if (n < 0 || n >= executionEnvironment.argc) { return ToErrmsg(errmsg, StatInvalidArgumentNumber); } const char *arg{executionEnvironment.argv[n]}; std::int64_t argLen{StringLength(arg)}; if (argLen <= 0) { return ToErrmsg(errmsg, StatMissingArgument); } if (length && FitsInDescriptor(length, argLen, terminator)) { StoreIntToDescriptor(length, argLen, terminator); } if (value) { return CopyCharsToDescriptor(*value, arg, argLen, errmsg); } return StatOk; } std::int32_t RTNAME(GetCommand)(const Descriptor *value, const Descriptor *length, const Descriptor *errmsg, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; if (value) { RUNTIME_CHECK(terminator, IsValidCharDescriptor(value)); } // Store 0 in case we error out later on. if (length) { RUNTIME_CHECK(terminator, IsValidIntDescriptor(length)); StoreIntToDescriptor(length, 0, terminator); } auto shouldContinue = [&](std::int32_t stat) -> bool { // We continue as long as everything is ok OR the value descriptor is // too short, but we still need to compute the length. return stat == StatOk || (length && stat == StatValueTooShort); }; std::size_t offset{0}; if (executionEnvironment.argc == 0) { return CheckAndCopyCharsToDescriptor(value, "", errmsg, offset); } // value = argv[0] std::int32_t stat{CheckAndCopyCharsToDescriptor( value, executionEnvironment.argv[0], errmsg, offset)}; if (!shouldContinue(stat)) { return stat; } // value += " " + argv[1:n] for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) { stat = CheckAndCopyCharsToDescriptor(value, " ", errmsg, offset); if (!shouldContinue(stat)) { return stat; } stat = CheckAndCopyCharsToDescriptor( value, executionEnvironment.argv[i], errmsg, offset); if (!shouldContinue(stat)) { return stat; } } if (length && FitsInDescriptor(length, offset, terminator)) { StoreIntToDescriptor(length, offset, terminator); } // value += spaces for padding if (value) { FillWithSpaces(*value, offset); } return stat; } static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) { std::size_t s{d.ElementBytes()}; // This can be 0. while (s != 0 && *d.OffsetElement(s - 1) == ' ') { --s; } return s; } std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name, const Descriptor *value, const Descriptor *length, bool trim_name, const Descriptor *errmsg, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; if (value) { RUNTIME_CHECK(terminator, IsValidCharDescriptor(value)); FillWithSpaces(*value); } // Store 0 in case we error out later on. if (length) { RUNTIME_CHECK(terminator, IsValidIntDescriptor(length)); StoreIntToDescriptor(length, 0, terminator); } const char *rawValue{nullptr}; std::size_t nameLength{ trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()}; if (nameLength != 0) { rawValue = executionEnvironment.GetEnv( name.OffsetElement(), nameLength, terminator); } if (!rawValue) { return ToErrmsg(errmsg, StatMissingEnvVariable); } std::int64_t varLen{StringLength(rawValue)}; if (length && FitsInDescriptor(length, varLen, terminator)) { StoreIntToDescriptor(length, varLen, terminator); } if (value) { return CopyCharsToDescriptor(*value, rawValue, varLen, errmsg); } return StatOk; } std::int32_t RTNAME(GetCwd)( const Descriptor &cwd, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; RUNTIME_CHECK(terminator, IsValidCharDescriptor(&cwd)); char *buf{(char *)AllocateMemoryOrCrash(terminator, PATH_MAX)}; if (!getcwd(buf, PATH_MAX)) { return StatMissingCurrentWorkDirectory; } std::int64_t strLen{StringLength(buf)}; std::int32_t status{CopyCharsToDescriptor(cwd, buf, strLen)}; std::free(buf); return status; } std::int32_t RTNAME(Hostnm)( const Descriptor &res, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; RUNTIME_CHECK(terminator, IsValidCharDescriptor(&res)); char buf[256]; std::int32_t status{0}; // Fill the output with spaces. Upon success, CopyCharsToDescriptor() // will overwrite part of the string with the result, so we'll end up // with a padded string. If we fail to obtain the host name, we return // the string of all spaces, which is the original gfortran behavior. FillWithSpaces(res); #ifdef _WIN32 DWORD dwSize{sizeof(buf)}; // Note: Winsock has gethostname(), but use Win32 API GetComputerNameEx(), // in order to avoid adding dependency on Winsock. if (!GetComputerNameExA(ComputerNameDnsHostname, buf, &dwSize)) { status = GetLastError(); } #else if (gethostname(buf, sizeof(buf)) < 0) { status = errno; } #endif if (status == 0) { std::int64_t strLen{StringLength(buf)}; status = CopyCharsToDescriptor(res, buf, strLen); // Note: if the result string is too short, then we'll return partial // host name with "too short" error status. } return status; } std::int32_t RTNAME(PutEnv)( const char *str, size_t str_length, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; RUNTIME_CHECK(terminator, str && str_length); // Note: don't trim the input string, because the user should be able // to set the value to all spaces if necessary. // While Fortran's putenv() extended intrinsic sementics loosly follow // Linux C library putenv(), don't actually use putenv() on Linux, because // it takes the passed string pointer and incorporates it into the // environment without copy. To make this safe, one would have to copy // the passed string into some allocated memory, but then there's no good // way to deallocate it. Instead, use the implementation from // ExecutionEnvironment, which does the right thing for both Windows and // Linux. std::int32_t status{0}; // Split the input string into name and value substrings. Note: // if input string is in "name=value" form, then we set variable "name" with // value "value". If the input string is in "name=" form, then we delete // the variable "name". const char *str_end = str + str_length; const char *str_sep = std::find(str, str_end, '='); if (str_sep == str_end) { // No separator, invalid input string status = EINVAL; } else if ((str_sep + 1) == str_end) { // "name=" form, which means we need to delete this variable status = executionEnvironment.UnsetEnv(str, str_sep - str, terminator); } else { // Example: consider str "abc=defg", str_length = 8 // // addr: 05 06 07 08 09 10 11 12 13 // str@addr: a b c = d e f g ?? // // str = 5, str_end = 13, str_sep = 8, name length: str_sep - str = 3 // value ptr: str_sep + 1 = 9, value length: 4 // status = executionEnvironment.SetEnv( str, str_sep - str, str_sep + 1, str_end - str_sep - 1, terminator); } return status; } std::int32_t RTNAME(Unlink)( const char *str, size_t strLength, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; auto pathLength = TrimTrailingSpaces(str, strLength); auto path = SaveDefaultCharacter(str, pathLength, terminator); std::int32_t status{0}; if (unlink(path.get()) != 0) { status = errno; } return status; } } // namespace Fortran::runtime