| /* Implementation of the GETLOG g77 intrinsic. |
| Copyright (C) 2005-2021 Free Software Foundation, Inc. |
| Contributed by François-Xavier Coudert <coudert@clipper.ens.fr> |
| |
| This file is part of the GNU Fortran runtime library (libgfortran). |
| |
| Libgfortran is free software; you can redistribute it and/or |
| modify it under the terms of the GNU General Public |
| License as published by the Free Software Foundation; either |
| version 3 of the License, or (at your option) any later version. |
| |
| Libgfortran is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU General Public License for more details. |
| |
| Under Section 7 of GPL version 3, you are granted additional |
| permissions described in the GCC Runtime Library Exception, version |
| 3.1, as published by the Free Software Foundation. |
| |
| You should have received a copy of the GNU General Public License and |
| a copy of the GCC Runtime Library Exception along with this program; |
| see the files COPYING3 and COPYING.RUNTIME respectively. If not, see |
| <http://www.gnu.org/licenses/>. */ |
| |
| #include "libgfortran.h" |
| |
| #include <string.h> |
| |
| #ifdef HAVE_UNISTD_H |
| # if defined __MINGW32__ && defined HAVE_GETLOGIN |
| # define _POSIX 1 |
| # endif |
| #include <unistd.h> |
| #endif |
| #ifdef HAVE_PWD_H |
| #include <pwd.h> |
| #endif |
| |
| /* Windows32 version */ |
| #if defined __MINGW32__ && !defined HAVE_GETLOGIN |
| #define WIN32_LEAN_AND_MEAN |
| #include <windows.h> |
| #include <lmcons.h> /* for UNLEN */ |
| |
| static char * |
| w32_getlogin (void) |
| { |
| static char name [UNLEN + 1]; |
| DWORD namelen = sizeof (name); |
| |
| GetUserName (name, &namelen); |
| return (name[0] == 0 ? NULL : name); |
| } |
| |
| #undef getlogin |
| #define getlogin w32_getlogin |
| #define HAVE_GETLOGIN 1 |
| |
| #endif |
| |
| |
| /* GETLOG (LOGIN), g77 intrinsic for retrieving the login name for the |
| process. |
| CHARACTER(len=*), INTENT(OUT) :: LOGIN */ |
| |
| void PREFIX(getlog) (char *, gfc_charlen_type); |
| export_proto_np(PREFIX(getlog)); |
| |
| void |
| PREFIX(getlog) (char * login, gfc_charlen_type login_len) |
| { |
| char *p; |
| |
| memset (login, ' ', login_len); /* Blank the string. */ |
| |
| #if defined(HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID) |
| struct passwd pwd; |
| struct passwd *result; |
| char *buf; |
| int err; |
| /* To be pedantic, buflen should be determined by |
| sysconf(_SC_GETPW_R_SIZE_MAX), which is 1024 on some tested |
| targets; we do something simple in case the target doesn't |
| support sysconf. */ |
| static const size_t buflen = 1024; |
| buf = xmalloc (buflen); |
| err = getpwuid_r (geteuid (), &pwd, buf, buflen, &result); |
| if (err != 0 || result == NULL) |
| goto cleanup; |
| p = pwd.pw_name; |
| #elif defined(HAVE_GETPWUID) && defined(HAVE_GETEUID) |
| { |
| struct passwd *pw = getpwuid (geteuid ()); |
| if (pw) |
| p = pw->pw_name; |
| else |
| return; |
| } |
| #elif HAVE_GETLOGIN |
| p = getlogin(); |
| # else |
| return; |
| #endif |
| |
| if (p == NULL) |
| goto cleanup; |
| |
| gfc_charlen_type p_len = strlen (p); |
| if (login_len < p_len) |
| p_len = login_len; |
| memcpy (login, p, p_len); |
| |
| cleanup: |
| #if defined (HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID) |
| free (buf); |
| #else |
| ; |
| #endif |
| } |