]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/intrinsics/getlog.c
PR 78534 Revert r244011
[thirdparty/gcc.git] / libgfortran / intrinsics / getlog.c
CommitLineData
f77b6ca3 1/* Implementation of the GETLOG g77 intrinsic.
cbe34bb5 2 Copyright (C) 2005-2017 Free Software Foundation, Inc.
f77b6ca3
FXC
3 Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
4
15fb94ae 5This file is part of the GNU Fortran runtime library (libgfortran).
f77b6ca3
FXC
6
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
9License as published by the Free Software Foundation; either
748086b7 10version 3 of the License, or (at your option) any later version.
f77b6ca3
FXC
11
12Libgfortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
748086b7
JJ
17Under Section 7 of GPL version 3, you are granted additional
18permissions described in the GCC Runtime Library Exception, version
193.1, as published by the Free Software Foundation.
20
21You should have received a copy of the GNU General Public License and
22a copy of the GCC Runtime Library Exception along with this program;
23see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24<http://www.gnu.org/licenses/>. */
f77b6ca3 25
f77b6ca3
FXC
26#include "libgfortran.h"
27
deeab820 28#include <string.h>
36ae8a61 29
f77b6ca3 30#ifdef HAVE_UNISTD_H
aa4042b1
TB
31# if defined __MINGW32__ && defined HAVE_GETLOGIN
32# define _POSIX 1
33# endif
f77b6ca3
FXC
34#include <unistd.h>
35#endif
6422c112
FXC
36#ifdef HAVE_PWD_H
37#include <pwd.h>
38#endif
f77b6ca3 39
86ab6320
FXC
40/* Windows32 version */
41#if defined __MINGW32__ && !defined HAVE_GETLOGIN
42#define WIN32_LEAN_AND_MEAN
43#include <windows.h>
44#include <lmcons.h> /* for UNLEN */
45
46static char *
47w32_getlogin (void)
48{
49 static char name [UNLEN + 1];
50 DWORD namelen = sizeof (name);
51
52 GetUserName (name, &namelen);
53 return (name[0] == 0 ? NULL : name);
54}
55
56#undef getlogin
57#define getlogin w32_getlogin
58#define HAVE_GETLOGIN 1
59
60#endif
61
62
f77b6ca3
FXC
63/* GETLOG (LOGIN), g77 intrinsic for retrieving the login name for the
64 process.
65 CHARACTER(len=*), INTENT(OUT) :: LOGIN */
66
f77b6ca3
FXC
67void PREFIX(getlog) (char *, gfc_charlen_type);
68export_proto_np(PREFIX(getlog));
69
deeab820 70void
f77b6ca3
FXC
71PREFIX(getlog) (char * login, gfc_charlen_type login_len)
72{
84aff3c2 73 int p_len;
f77b6ca3
FXC
74 char *p;
75
76 memset (login, ' ', login_len); /* Blank the string. */
77
23e6d4a5 78#if defined(HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID)
15fb94ae
JB
79 struct passwd pwd;
80 struct passwd *result;
81 char *buf;
82 int err;
83 /* To be pedantic, buflen should be determined by
84 sysconf(_SC_GETPW_R_SIZE_MAX), which is 1024 on some tested
85 targets; we do something simple in case the target doesn't
86 support sysconf. */
87 static const size_t buflen = 1024;
1a0fd3d3 88 buf = xmalloc (buflen);
15fb94ae
JB
89 err = getpwuid_r (geteuid (), &pwd, buf, buflen, &result);
90 if (err != 0 || result == NULL)
91 goto cleanup;
92 p = pwd.pw_name;
93#elif defined(HAVE_GETPWUID) && defined(HAVE_GETEUID)
6422c112
FXC
94 {
95 struct passwd *pw = getpwuid (geteuid ());
96 if (pw)
97 p = pw->pw_name;
98 else
99 return;
100 }
15fb94ae 101#elif HAVE_GETLOGIN
6422c112
FXC
102 p = getlogin();
103# else
104 return;
6422c112
FXC
105#endif
106
f77b6ca3 107 if (p == NULL)
15fb94ae 108 goto cleanup;
f77b6ca3 109
84aff3c2 110 p_len = strlen (p);
f77b6ca3 111 if (login_len < p_len)
15fb94ae
JB
112 p_len = login_len;
113 memcpy (login, p, p_len);
114
115 cleanup:
23e6d4a5 116#if defined (HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID)
15fb94ae 117 free (buf);
8717f52f
KT
118#else
119 ;
15fb94ae 120#endif
f77b6ca3 121}